[Mew-dist 1663] IM-63 IMAP (Re: )
若宮賢二
wkenji at example.com
1997年 8月 26日 (火) 19:47:54 JST
若宮＠富士通研です。
// "motonori" = motonori at example.com (Motonori Nakamura) 氏談:
motonori> UID を使ってないところも使うようにしたのと、
motonori> imls %folder last:3 のように書くこともできるようにしました。
どうも有難うございます。ところで、UID FETCH の場合でも FETCH レスポ
ンスの `*' の直後は UID ではなく Sequence Number ということなので、
/^\* $num FETCH \(UID \d+ … の $num と \d+ は逆になりますよね？
あと、うちでは WU 版と Sun 版の IMAP サーバで試しているのですが、Sun
の方は UID FETCH へのレスポンスに含まれる UID 属性が、レスポンスの先
頭ではなく最後に付いてきます;-)。さすがに他の属性に混ぜて途中に入れ
てくるサーバはないと信じたいですが…。Cyrus などはどうでしょうか？
この二つへの対応と、
- imap_scan_folder で、`ラストUID+1'-last を指定され、かつ新着が
ない場合に last の行をもう一度表示していたバグを除去。
- RFC822 以外の FETCH ではおまけ FLAGS 属性は付いてこないので、
そのチェックを除去。
- imap_process 内の for ループを全 UID をなめる foreach に変更。
- imap_get、imap_head、imap_from で、指定されたメッセージが
なかった場合に 1 を返すように (元は imcat 向け)。
- imcat で、"$msg not found" を imap_get の返り値を見て表示する
ように。
といった変更をしてみました。UID が飛び飛びの %inbox に対して imls や
imcat、imget --mode=from などを試してみたところ、一応使えています。
[Mew-dist 1603]、[Mew-dist 1604] のパッチが当たった IM-63 へのパッチ
として添付させて頂きます。
motonori> ＃ imls のときに、本文の先頭が見られないのが残念ですね。
IMAP4rev1 対応のサーバに限ればですが、ボディのうち指定したオクテット
分だけを FETCH できますよね。でも IM は先頭の引用などを取り除いて表
示するようになっているので、あれ用に予めどのくらい FETCH しておけば
よいのか、その見積りが難しそうです…。
// Kenji | mailto:wkenji at example.com (office)
// Wakamiya | mailto:wkenji at example.com (private)
-------------- next part --------------
--- Imap.pm.in.orig Tue Aug 26 18:19:41 1997
+++ Imap.pm.in Tue Aug 26 18:30:33 1997
@@ -193,8 +193,8 @@
im_notice("getting message $num.\n");
my $resp = &send_command(\*IMAPd, "im$seq UID FETCH $num RFC822", '');
my $failed = 0;
- if ($resp =~ /^\* $num FETCH \(UID \d+ RFC822 \{(\d+)\}/i) {
- my $size = $1;
+ if ($resp =~ /^\* \d+ FETCH \((UID $num )?RFC822 \{(\d+)\}/i) {
+ my $size = $2;
while (<IMAPd>) {
$size -= length($_);
s/\r\n$/\n/;
@@ -203,10 +203,13 @@
last if ($size <= 0);
}
$resp = &next_response(\*IMAPd);
- return (-1, 0) if ($resp !~ /^\)/ && $resp !~ /^ FLAGS \(.*\)\)/);
+ return (-1, 0) if ($resp !~ /^\)/ &&
+ $resp !~ /^( FLAGS \(.*\)| UID $num)+\)/);
+ } elsif ($resp =~ /^im$seq OK/) {
+ return (1, 0);
} else {
$failed = 1;
- im_warn("FETCH command failed.\n");
+ im_warn("UID FETCH command failed.\n");
}
$resp = &next_response(\*IMAPd);
return (-1, 0) if ($resp !~ /^im$seq OK/);
@@ -224,8 +227,8 @@
local (%head);
undef %head;
if ($resp =~
- /^\* $num FETCH \(UID \d+ RFC822.SIZE (\d+) RFC822.HEADER \{(\d+)\}/i) {
- my ($size, $len) = ($1, $2);
+ /^\* \d+ FETCH \((UID $num )?RFC822.SIZE (\d+) RFC822.HEADER \{(\d+)\}/i) {
+ my ($size, $len) = ($2, $3);
my $field = '';
while (<IMAPd>) {
$len -= length($_);
@@ -250,10 +253,12 @@
# $head{'bytes:'} = $size;
$head{'kbytes:'} = int(($size + 1023) / 1024);
$resp = &next_response(\*IMAPd);
- return (-1, 0) if ($resp !~ /^\)/ && $resp !~ /^ FLAGS \(.*\)\)/);
+ return (-1, 0) if ($resp !~ /^\)/ && $resp !~ /^ UID $num\)/);
+ } elsif ($resp =~ /^im$seq OK/) {
+ return (1, 0);
} else {
$failed = 1;
- im_warn("FETCH command failed.\n");
+ im_warn("UID FETCH command failed.\n");
}
$resp = &next_response(\*IMAPd);
return (-1, 0) if ($resp !~ /^im$seq OK/);
@@ -270,8 +275,8 @@
# "im$seq UID FETCH $num RFC822.HEADER.LINES (From Date Subject)", '');
my $resp = &send_command(\*IMAPd,
"im$seq UID FETCH $num RFC822.HEADER.LINES (From)", '');
- if ($resp =~ /^\* $num FETCH \(UID \d+ RFC822.* \{(\d+)\}/i) {
- my $size = $1;
+ if ($resp =~ /^\* \d+ FETCH \((UID $num )?RFC822.* \{(\d+)\}/i) {
+ my $size = $2;
my $found = 0;
my $f;
while (<IMAPd>) {
@@ -292,10 +297,12 @@
$f = '(sender unknown)' unless ($f);
print "From $f\n";
$resp = &next_response(\*IMAPd);
- return -1 if ($resp !~ /^\)/ && $resp !~ /^ FLAGS \(.*\)\)/);
+ return (-1, 0) if ($resp !~ /^\)/ && $resp !~ /^ UID $num\)/);
+ } elsif ($resp =~ /^im$seq OK/) {
+ return 1;
} else {
$failed = 1;
- im_warn("FETCH command failed.\n");
+ im_warn("UID FETCH command failed.\n");
}
$resp = &next_response(\*IMAPd) if ($resp !~ /^im$seq/);
return -1 if ($resp !~ /^im$seq OK/);
@@ -313,8 +320,8 @@
while ($resp !~ /^im$seq/) {
if ($resp =~ /^\* NO/i) {
$failed = 1;
- } elsif ($resp =~
- /^\*\s+$num\s+FETCH\s+\(UID \d+ FLAGS\s+\((.*)\)\)/i) {
+ } elsif ($resp =~ /^\* \d+ FETCH \(UID $num FLAGS \((.*)\)\)/i ||
+ $resp =~ /^\* \d+ FETCH \(FLAGS \((.*)\) UID $num\)/i) {
$flags = $1;
}
$resp = &next_response(\*IMAPd);
@@ -470,7 +477,7 @@
# imap_process(how, host, src, dst)
sub imap_process ($$$$) {
my ($how, $host, $src, $dst) = @_;
- my ($msgs, $i);
+ my ($msgs);
return -1 if (($msgs = &imap_select($src, 1)) < 0);
if ($how eq 'check') {
if ($msgs > 0) {
@@ -480,7 +487,9 @@
}
} elsif ($how eq 'from') {
if ($msgs > 0) {
- for ($i = 1; $i <= $msgs; $i++) {
+ my @alluids = &imap_all_uids();
+ return -1 if ($alluids[0] < 0);
+ foreach $i (@alluids) {
return -1 if (&imap_from($i) < 0);
}
im_info("$msgs message(s) at $host.\n");
@@ -490,7 +499,9 @@
} elsif ($how eq 'get') {
if ($msgs > 0) {
im_info("Getting new messages from $host into $dst....\n");
- for ($i = 1; $i <= $msgs; $i++) {
+ my @alluids = &imap_all_uids();
+ return -1 if ($alluids[0] < 0);
+ foreach $i (@alluids) {
my ($rc, $message) = &imap_get($i);
return -1 if ($rc < 0);
return -1 if (&store_message($message, $dst) < 0);
@@ -592,13 +603,14 @@
my $uid, $size, $len;
my $msgset = &imap_range2set(@ranges);
+ return 0 if !$msgset;
return -1 if ($msgset < 0);
my $seq = $ImapSeq++;
my $resp = &send_command(\*IMAPd,
- "im$seq UID FETCH $msgset (UID RFC822.SIZE RFC822.HEADER)", '');
+ "im$seq UID FETCH $msgset (RFC822.SIZE RFC822.HEADER)", '');
while ($resp =~
- /^\* \d+ FETCH \(UID (\d+) RFC822.SIZE (\d+) RFC822\.HEADER \{(\d+)\}/i) {
- ($uid, $size, $len) = ($1, $2, $3);
+ /^\* \d+ FETCH \((UID (\d+) )?RFC822.SIZE (\d+) RFC822\.HEADER \{(\d+)\}/i) {
+ ($uid, $size, $len) = ($2, $3, $4);
my @hdr;
while (<IMAPd>) {
$len -= length;
@@ -608,7 +620,12 @@
last if ($len <= 0);
}
$resp = &next_response(\*IMAPd);
- return -1 if ($resp !~ /^\)/);
+ if (!$uid) {
+ return -1 if ($resp !~ /^ UID (\d+)\)/);
+ $uid = $1;
+ } else {
+ return -1 if ($resp !~ /^\)/);
+ }
my %Head;
&store_header(\%Head, join('', @hdr));
@@ -627,7 +644,7 @@
$resp = &next_response(\*IMAPd);
}
if ($resp !~ /^im$seq OK/) {
- im_warn("FETCH command failed.\n");
+ im_warn("UID FETCH command failed.\n");
return -1;
}
return 0;
@@ -635,7 +652,7 @@
sub imap_range2set (@) {
my @ranges = @_;
- my (@uids, $fromuid, $touid, $dir);
+ my (@uids, $fromuid, $dir);
my @alluids = &imap_all_uids();
return -1 if ($alluids[0] < 0);
@@ -646,8 +663,11 @@
foreach (@ranges) {
if (/^(\d+|first|last)-(\d+|first|last)$/) {
$fromuid = &imap_message_number($min, $max, $1);
- $touid = &imap_message_number($min, $max, $2);
- $_ = "$fromuid:$touid";
+ if ($fromuid > $max) {
+ $_ = '';
+ } else {
+ $_ = "$fromuid:" . &imap_message_number($min, $max, $2);
+ }
} elsif (/^(\d+|last|first):([+-]?)(\d+)$/) {
if ($1 eq 'last') {
$dir = ($2 eq '+') ? +1 : -1;
@@ -664,10 +684,15 @@
}
$_ = join(',', @uids);
} elsif (/^(\d+|first|last)$/) {
- $_ = &imap_message_number($min, $max, $1);
+ $fromuid = &imap_message_number($min, $max, $1);
+ if ($fromuid > $max) {
+ $_ = '';
+ } else {
+ $_ = $fromuid;
+ }
}
}
- return join(',', @ranges);
+ return join(',', grep($_, @ranges));
}
sub imap_all_uids () {
@@ -678,7 +703,7 @@
if ($resp =~ /^\* SEARCH (\d+( +\d+)*)/i) {
@uids = split(' ', $1);
} else {
- im_warn("SEARCH command failed.\n");
+ im_warn("UID SEARCH command failed.\n");
}
$resp = &next_response(\*IMAPd);
return (-1) if ($resp !~ /^im$seq OK/);
-------------- next part --------------
--- imcat.in.orig Tue Aug 19 21:00:05 1997
+++ imcat.in Tue Aug 26 15:13:00 1997
@@ -143,7 +143,7 @@
foreach (@$art) {
print;
}
-} elsif ($opt_src =~ /^%(.*)/) {
+} elsif ($opt_src =~ /^(%.*)/) {
# IMAP folder (%folder[:[user[/auth]]@server])
require IM::Imap && import IM::Imap;
require IM::GetPass && import IM::GetPass;
@@ -164,14 +164,13 @@
if ($msgs < 0) {
&imap_close;
im_warn("can't access to $folder\n");
- } elsif ($msgs < $msg) {
- &imap_close;
- im_warn("message $msg not found in \%$folder\n");
} else {
my ($rc, $message) = &imap_get($msg);
&imap_close;
if ($rc < 0) {
im_die("can't access to message $msg in \%$folder.\n");
+ } elsif ($rc > 0) {
+ im_warn("message $msg not found in \%$folder\n");
}
foreach (@$message) {
print;
Mew-dist メーリングリストの案内