[Mew-dist 08304] imput/imget changes
Motonori NAKAMURA
motonori at example.com
1999年 3月 27日 (土) 01:48:22 JST
・ignorepostpet を廃止して、generic なインタフェースを用意した。
Config に GetChkSbr を指定して、その中に get するメッセージを
選択するプログラムを記述する。local 及び pop に対して有効。
サンプルを見てね。
・imput で 8bit message を送出するときは、BODY=8BITMIME を指示する。
・imput --processqueue の際に、処理中のメッセージは名前を変えることで、
複数の imput から処理されることを避ける。
・POP で、メールをサーバに保存する際に必要となる、history ファイルを
サーバごとに分離した。
・SUID imget が MailDir に対して unlink が動作しない問題を解決。
睡眠不足でニートさが足りてないので、チェックして頂けると幸いです。
- motonori
*** /dev/null Sat Mar 27 01:20:32 1999
--- ./dot.im/getchk.sbr Fri Mar 26 20:59:30 1999
***************
*** 0 ****
--- 1,35 ----
+ # get messages sent to me directly
+
+ sub getchk_sub {
+ local ($href) = shift;
+
+ # if (my_addr($href->{'to'}, $href->{'cc'}) {
+ if ($href->{'to'} =~ /motonori/i || $href->{'cc'} =~ /motonori/i) {
+ return 1; # get it
+ }
+ return 0; # skip it
+ }
+
+ sub my_addr (@) {
+ my @addrs = @_;
+ my $addr;
+
+ unless (defined($ADDRESS_HASH{'init'})) {
+ $ADDRESS_HASH{'addr'} = addresses_regex();
+ unless ($ADDRESS_HASH{'addr'}) {
+ $ADDRESS_HASH{'addr'} = '^' . quotemeta(address()) . '$';
+ $ADDRESS_HASH{'addr'} =~ s/(\\\s)*\\,(\\\s)*/\$|\^/g;
+ }
+ $ADDRESS_HASH{'init'} = 1;
+ }
+ return 0 if ($ADDRESS_HASH{'addr'} eq "");
+ foreach $addr (@addrs) {
+ my $a;
+ while (($a, $addr) = fetch_addr($addr, 1), $a ne "") {
+ return 1 if ($a =~ /$ADDRESS_HASH{'addr'}/io);
+ }
+ }
+ return 0;
+ }
+
+ 1;
*** /dev/null Sat Mar 27 01:20:32 1999
--- ./dot.im/getchk.sbr.postpet Fri Mar 26 15:49:45 1999
***************
*** 0 ****
--- 1,13 ----
+ # do not get messages from PostPet
+
+ sub getchk_sub {
+ local ($href) = shift;
+
+ if ($href->{'x-mailer'} =~ /PostPet/i
+ && $href->{'content-type'} =~ /multipart.+kiritorisen/i) {
+ return 0; # skip it
+ }
+ return 1; # get it
+ }
+
+ 1;
diff -cr --new-file ../im-111-/IM/LocalMbox.pm ./IM/LocalMbox.pm
*** ../im-111-/IM/LocalMbox.pm Tue Mar 23 18:13:04 1999
--- ./IM/LocalMbox.pm Sat Mar 27 01:42:05 1999
***************
*** 17,26 ****
use Fcntl;
use IM::Config;
use IM::Util;
! use IM::MsgStore qw(store_message exec_getsbrfile);
use integer;
use strict;
! use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(local_get_msg);
--- 17,26 ----
use Fcntl;
use IM::Config;
use IM::Util;
! use IM::MsgStore qw(store_message exec_getsbrfile fsync);
use integer;
use strict;
! use vars qw(@ISA @EXPORT $getchk_hook);
@ISA = qw(Exporter);
@EXPORT = qw(local_get_msg);
***************
*** 117,122 ****
--- 117,138 ----
}
im_notice("mailbox for $user is $mbox\n");
+ $getchk_hook = getchksbr_file();
+ if ($getchk_hook) {
+ if ($getchk_hook =~ /^(\S+)$/) {
+ if ($main::INSECURE) {
+ im_warn("Sorry, GetChkSbr is ignored for SUID root script.\n");
+ } else {
+ $getchk_hook = $1; # to pass through taint check
+ if (-f $getchk_hook) {
+ require $getchk_hook;
+ } else {
+ im_err("scan subroutine file $getchk_hook not found.\n");
+ }
+ }
+ }
+ }
+
if (-d $mbox) {
# DIRECTORY
im_info("Getting new messages from maildir into $dst....\n")
***************
*** 137,142 ****
--- 153,160 ----
return -1;
}
if ($how eq 'get' && $main::opt_keep == 0) {
+ $f =~ /(.+)/; # $f is tainted yet
+ $f = $1; # clean up
unlink("$mbox/$f");
}
$msgs++;
***************
*** 171,182 ****
return -1;
}
}
! if (($msgs = &process_mbox($mbox, $dst, $how)) < 0) {
! &local_unlockmbox($mbox) if ($need_lock);
! return -1;
! }
! if ($how eq 'get') {
! &local_empty($mbox) unless ($main::opt_keep);
}
&local_unlockmbox($mbox) if ($need_lock);
return $msgs;
--- 189,236 ----
return -1;
}
}
! if ($how eq 'get' && $getchk_hook ne '' && !$main::opt_keep) {
! my $tmpmbox = expand_path('tmp_mbox');
! if (local_copymbox($mbox, $tmpmbox) < 0) {
! return -1;
! }
!
! unless (open (SAVE, "+>$mbox")) {
! im_err("can't open $mbox ($!).\n");
! close(SAVE);
! return -1;
! }
!
! if (($msgs = &process_mbox($tmpmbox, $dst, $how, $mbox)) < 0) {
! close(SAVE);
! if (local_copymbox($tmpmbox, $mbox) < 0) {
! im_err("write back to $mbox failed. $tmpmbox preserved ($!).\n");
! } else {
! unlink($tmpmbox);
! }
! &local_unlockmbox($mbox) if ($need_lock);
! return -1;
! }
!
! if (&unixp() && !&no_sync()) {
! if (fsync(fileno(SAVE)) < 0) {
! im_err("write back to $mbox failed ($!).\n");
! close(SAVE);
! unlink($tmpmbox) if (-z $tmpmbox);
! return -1;
! }
! }
!
! truncate (SAVE, tell(SAVE));
! unlink($tmpmbox);
! } else {
! if (($msgs = &process_mbox($mbox, $dst, $how, '')) < 0) {
! &local_unlockmbox($mbox) if ($need_lock);
! return -1;
! }
! if ($how eq 'get') {
! &local_empty($mbox) unless ($main::opt_keep);
! }
}
&local_unlockmbox($mbox) if ($need_lock);
return $msgs;
***************
*** 192,197 ****
--- 246,285 ----
}
}
+ sub local_copymbox ($$) {
+ my ($src, $dst) = @_;
+
+ im_debug("copy from $src to $dst\n") if (&debug('local'));
+ unless (open(SRC, "<$src")) {
+ return -1;
+ }
+ unless (open(DST, "+>$dst")) {
+ return -1;
+ }
+ while (<SRC>) {
+ unless (print DST) {
+ im_err("writing to $dst failed ($!).\n");
+ close(DST);
+ close(SRC);
+ unlink($dst) if (-z $dst);
+ return -1;
+ }
+ }
+ if (&unixp() && !&no_sync()) {
+ if (fsync(fileno(DST)) < 0) {
+ im_err("writing to $dst failed ($!).\n");
+ close(DST);
+ close(SRC);
+ unlink($dst) if (-z $dst);
+ return -1;
+ }
+ }
+ truncate (DST, -s SRC);
+ close (DST);
+ close (SRC);
+ return 0;
+ }
+
sub process_maildir ($$$) {
my ($maildir, $dst, $how) = @_;
my ($msgs, $f, $dir);
***************
*** 210,220 ****
}
foreach $f (sort {(-M $b) <=> (-M $a) || $a cmp $b} readdir(FLDR)) {
if ($f =~ /^\d+\.\d+\..+/ && -s "$dir/$f") {
! if (&process_file("$dir/$f", $dst, $how) < 0) {
closedir(FLDR);
return -1;
}
if ($how eq 'get' && $main::opt_keep == 0) {
unlink("$dir/$f");
}
$msgs++;
--- 298,312 ----
}
foreach $f (sort {(-M $b) <=> (-M $a) || $a cmp $b} readdir(FLDR)) {
if ($f =~ /^\d+\.\d+\..+/ && -s "$dir/$f") {
! my $ret = &process_file("$dir/$f", $dst, $how);
! next if ($ret > 0); # skip by rule
! if ($ret < 0) {
closedir(FLDR);
return -1;
}
if ($how eq 'get' && $main::opt_keep == 0) {
+ $f =~ /(.+)/; # $f is tainted yet
+ $f = $1; # clean up
unlink("$dir/$f");
}
$msgs++;
***************
*** 238,243 ****
--- 330,342 ----
while (<MBOX>) {
push (@Message, $_);
}
+ if ($getchk_hook ne '') {
+ my $head = lcl_store_header(\@Message);
+ unless (eval { &getchk_sub($head); }) {
+ close(MBOX);
+ return 1
+ }
+ }
if ($how eq 'get') {
if (&store_message(\@Message, $dst) < 0) {
close(MBOX);
***************
*** 249,259 ****
return 0;
}
! sub process_mbox ($$$) {
! my ($mbox, $dst, $how) = @_;
my ($format, $msgs, $length, $inheader, @Message);
local (*MBOX);
! my ($first_line);
im_info("Getting new messages from local mailbox into $dst....\n")
if ($how eq 'get');
--- 348,358 ----
return 0;
}
! sub process_mbox ($$$$) {
! my ($mbox, $dst, $how, $save) = @_;
my ($format, $msgs, $length, $inheader, @Message);
local (*MBOX);
! my ($first_line, $FIRST_LINE);
im_info("Getting new messages from local mailbox into $dst....\n")
if ($how eq 'get');
***************
*** 265,270 ****
--- 364,370 ----
chomp($first_line = <MBOX>);
if ($first_line =~ /^From /) {
$format = 'UNIX';
+ $FIRST_LINE = $first_line;
} elsif ($first_line =~ /^\001\001\001\001$/) {
$format = 'MMDF';
} elsif ($first_line =~ /^BABYL OPTIONS:/) {
***************
*** 337,347 ****
$length -= length($_) if ($length > 0);
}
}
- $msgs++ if ($#Message >= 0);
if ($Message[$#Message] eq "\n") {
pop (@Message);
}
if ($how eq 'get') {
if (&store_message(\@Message, $dst) < 0) {
close(MBOX);
--- 437,460 ----
$length -= length($_) if ($length > 0);
}
}
if ($Message[$#Message] eq "\n") {
pop (@Message);
}
+
+ if ($getchk_hook) {
+ my %head;
+ lcl_store_header(\%head, \@Message);
+ unless (eval { &getchk_sub(\%head); }) {
+ if (save_message(\@Message, $save, $format, $FIRST_LINE) < 0) {
+ close(MBOX);
+ return -1;
+ }
+ next;
+ }
+ }
+ $msgs++ if ($#Message >= 0);
+
if ($how eq 'get') {
if (&store_message(\@Message, $dst) < 0) {
close(MBOX);
***************
*** 362,367 ****
--- 475,532 ----
return $msgs;
}
+ sub save_message ($$$$) {
+ my ($msg, $save, $mode, $fline) = @_;
+
+ im_debug("saving to $save\n") if (&debug('local'));
+ if ($mode eq 'UNIX') {
+ shift(@$msg);
+ unless (print SAVE "$fline\n") {
+ im_err("writing to $save failed ($!).\n");
+ close(SAVE);
+ return -1;
+ }
+ } elsif ($mode eq 'RMAIL') {
+ if (tell(SAVE) == 0) {
+ unless (print SAVE "BABYL OPTIONS:\n") {
+ im_err("writing to $save failed ($!).\n");
+ close(SAVE);
+ return -1;
+ }
+ }
+ } elsif ($mode eq 'MMDF') {
+ if (tell(SAVE) == 0) {
+ unless (print SAVE "\001\001\001\001\n") {
+ im_err("writing to $save failed ($!).\n");
+ close(SAVE);
+ return -1;
+ }
+ }
+ }
+ foreach (@$msg) {
+ unless (print SAVE) {
+ im_err("writing to $save failed ($!).\n");
+ close(SAVE);
+ return -1;
+ }
+ }
+ if ($mode eq 'UNIX') {
+ unless (print SAVE "\n") {
+ im_err("writing to $save failed ($!).\n");
+ close(SAVE);
+ return -1;
+ }
+ } elsif ($mode eq 'RMAIL') {
+ unless (print SAVE "*** EOOH ***\n") {
+ im_err("writing to $save failed ($!).\n");
+ close(SAVE);
+ return -1;
+ }
+ } elsif ($mode eq 'MMDF') {
+ }
+ return 0;
+ }
+
sub local_empty ($) {
my $mbox = shift;
unless (truncate($mbox, 0)) {
***************
*** 453,458 ****
--- 618,661 ----
$locked_by_flock = 0;
}
return $rcode;
+ }
+
+ sub lcl_store_header ($$) {
+ my ($href, $msg) = @_;
+ my ($line);
+
+ foreach (@$msg) {
+ my $l = $_;
+ chomp($l);
+ last if ($l =~ /^$/);
+ if ($l =~ /^\s/) {
+ $l =~ s/\s+/ /;
+ $line .= $l;
+ next;
+ } else {
+ lcl_set_line($href, $line);
+ $line = $l;
+ }
+ }
+ lcl_set_line($href, $line);
+ }
+
+ sub lcl_set_line ($$) {
+ my ($href, $line) = @_;
+
+ return unless ($line =~ /^([^:]*):\s*(.*)$/);
+ my $label = lc($1);
+ return if ($label eq 'received');
+ if (defined($href->{$label})) {
+ # if ($STRUCTURED_HASH{$label}) {
+ # $href->{$label} .= ", ";
+ # } else {
+ $href->{$label} .= "\n\t";
+ # }
+ $href->{$label} .= $2;
+ } else {
+ $href->{$label} = $2;
+ }
}
1;
diff -cr --new-file ../im-111-/IM/Pop.pm ./IM/Pop.pm
*** ../im-111-/IM/Pop.pm Tue Mar 23 18:13:05 1999
--- ./IM/Pop.pm Fri Mar 26 22:03:40 1999
***************
*** 283,289 ****
# get information on the previous access
$last = 0;
if ($msgs > 0 && $main::opt_keep != 0) {
! $histfile = &pophistoryfile();
if ($histfile eq '') {
im_err("POP historyfile $histfile undefined.\n");
return -1;
--- 283,289 ----
# get information on the previous access
$last = 0;
if ($msgs > 0 && $main::opt_keep != 0) {
! $histfile = &pophistoryfile() .'-'. $host;
if ($histfile eq '') {
im_err("POP historyfile $histfile undefined.\n");
return -1;
***************
*** 439,452 ****
}
$accesstime = time;
im_info("Getting new messages into $dst....\n");
for ($i = $last; $i <= $msgs; $i++) {
! if ($main::opt_ignorepostpet) {
$head = &pop_head($i);
! if ($head->{'x-mailer'} =~ /PostPet/i
! && $head->{'content-type'} =~ /multipart.+kiritorisen/i) {
! next;
! }
}
if ($main::opt_keep != 0) {
if ($keep_proto eq 'UIDL') {
--- 439,465 ----
}
$accesstime = time;
+ my $getchk_hook = getchksbr_file();
+ if ($getchk_hook) {
+ if ($getchk_hook =~ /^(\S+)$/) {
+ if ($main::INSECURE) {
+ im_warn("Sorry, GetChkSbr is ignored for SUID root script.\n");
+ } else {
+ $getchk_hook = $1; # to pass through taint check
+ if (-f $getchk_hook) {
+ require $getchk_hook;
+ } else {
+ im_err("scan subroutine file $getchk_hook not found.\n");
+ }
+ }
+ }
+ }
+
im_info("Getting new messages into $dst....\n");
for ($i = $last; $i <= $msgs; $i++) {
! if ($getchk_hook ne '') {
$head = &pop_head($i);
! next unless (eval { &getchk_sub($head); });
}
if ($main::opt_keep != 0) {
if ($keep_proto eq 'UIDL') {
***************
*** 467,473 ****
}
$$histp{$$uidlp[$i]} = $accesstime;
} elsif ($keep_proto eq 'STATUS' || $keep_proto eq 'MSGID') {
! $head = &pop_head($i) unless ($main::opt_ignorepostpet);
my $mid = $head->{'message-id'};
next if ($mid eq '');
$mid =~ s/.*<(.*)>.*/$1/;
--- 480,486 ----
}
$$histp{$$uidlp[$i]} = $accesstime;
} elsif ($keep_proto eq 'STATUS' || $keep_proto eq 'MSGID') {
! $head = &pop_head($i) if ($getchk_hook eq '');
my $mid = $head->{'message-id'};
next if ($mid eq '');
$mid =~ s/.*<(.*)>.*/$1/;
diff -cr --new-file ../im-111-/IM/Smtp.pm ./IM/Smtp.pm
*** ../im-111-/IM/Smtp.pm Tue Mar 23 18:13:05 1999
--- ./IM/Smtp.pm Thu Mar 25 21:23:32 1999
***************
*** 174,187 ****
#
sub smtp_transact_sub ($$$$$$) {
my ($servers, $Header, $Body, $bcc, $part, $total) = @_;
! my ($i, $rc, $fail, @fatal, $msg_size);
return $rc if ($rc = &smtp_open($servers, 1));
if ($ESMTP{'SIZE'}) {
$msg_size = &message_size($Header, $Body, $part);
$rc = &tcp_command(\*SMTPd,
! "MAIL FROM:<$main::Sender> SIZE=$msg_size", '');
} else {
! $rc = &tcp_command(\*SMTPd, "MAIL FROM:<$main::Sender>", '');
}
return $rc if ($rc);
$fail = 0;
--- 174,192 ----
#
sub smtp_transact_sub ($$$$$$) {
my ($servers, $Header, $Body, $bcc, $part, $total) = @_;
! my ($i, $rc, $fail, @fatal, $msg_size, $btype);
return $rc if ($rc = &smtp_open($servers, 1));
+ if ($ESMTP{'8BITMIME'} && $main::Has_8bit_body && !$main::do_conv_8to7) {
+ $btype = ' BODY=8BIT';
+ } else {
+ $btype = '';
+ }
if ($ESMTP{'SIZE'}) {
$msg_size = &message_size($Header, $Body, $part);
$rc = &tcp_command(\*SMTPd,
! "MAIL FROM:<$main::Sender> SIZE=$msg_size$btype", '');
} else {
! $rc = &tcp_command(\*SMTPd, "MAIL FROM:<$main::Sender>$btype", '');
}
return $rc if ($rc);
$fail = 0;
diff -cr --new-file ../im-111-/dot.im/Config ./dot.im/Config
*** ../im-111-/dot.im/Config Tue Mar 23 18:01:38 1999
--- ./dot.im/Config Fri Mar 26 15:53:12 1999
***************
*** 75,80 ****
--- 75,81 ----
#MsgDBType=DB # type of database (DB, NDBM, SDBM)
## To call user defined subroutines (relative to ~/.im/)
+ #GetChkSbr=getchk.sbr # hooks for imget
#GetSbr=get.sbr # hooks for imget
#ScanSbr=scan.sbr # hooks for imget/imls
diff -cr --new-file ../im-111-/imget.in ./imget.in
*** ../im-111-/imget.in Tue Mar 23 18:13:02 1999
--- ./imget.in Fri Mar 26 15:37:08 1999
***************
*** 78,84 ****
'protokeep;s;UIDL;'=> "Protocol type to use for keeping messages on POP.\n".
"\t\t(UIDL, LAST, STATUS, MSGID)\n" .
"\t\tTimed out deletion is not supported with LAST.",
- 'ignorepostpet;b;;'=> 'Do not get messages for PostPet (effective w/ POP)',
'usecl;b;;Obey_CL' => "Use value of Content-Length header for delimitation".
".\n\t\t(effective only if source of messages is local).\n" ,
'count;i;;' => 'Number of messages to be gotten in a process (NNTP)',
--- 78,83 ----
diff -cr --new-file ../im-111-/imput.in ./imput.in
*** ../im-111-/imput.in Tue Mar 23 18:13:03 1999
--- ./imput.in Fri Mar 26 22:22:29 1999
***************
*** 1745,1755 ****
foreach $q (sort {$a <=> $b} readdir(QUEUEDIR)) {
next unless ($q =~ /^\d+$/);
# $QUEUE = 'QUEUE';
! unless (open(QUEUE, "<$queue_dir/$q")) {
! im_err("can't open $queue_dir/$q\n");
return;
}
! im_notice("processing $queue_dir/$q ...\n");
while (<QUEUE>) {
chomp;
last if (/^$/);
--- 1745,1757 ----
foreach $q (sort {$a <=> $b} readdir(QUEUEDIR)) {
next unless ($q =~ /^\d+$/);
# $QUEUE = 'QUEUE';
! rename ("$queue_dir/$q", "$queue_dir/$q.wrk");
! unless (open(QUEUE, "<$queue_dir/$q.wrk")) {
! im_err("can't open $queue_dir/$q.wrk\n");
! rename ("$queue_dir/$q.wrk", "$queue_dir/$q");
return;
}
! im_notice("processing $queue_dir/$q.wrk ...\n");
while (<QUEUE>) {
chomp;
last if (/^$/);
***************
*** 1780,1796 ****
im_debug("sending message\n") if (&debug('queue'));
$rcode = &send_message($News_flag, $partial_total);
if ($rcode == 0) {
! unlink("$queue_dir/$q");
im_info("$queue_dir/$q: sent\n");
} elsif ($rcode > 0) {
im_info("$queue_dir/$q: preserved\n");
} else {
! unlink("$queue_dir/$q");
im_warn("$queue_dir/$q: delivery failed\n");
&error_report;
}
} else {
my ($r, $t);
print "Message queued in $queue_dir/$q";
if ($Config_opt ne '') {
print " (Config: $Config_opt)\n";
--- 1782,1800 ----
im_debug("sending message\n") if (&debug('queue'));
$rcode = &send_message($News_flag, $partial_total);
if ($rcode == 0) {
! unlink("$queue_dir/$q.wrk");
im_info("$queue_dir/$q: sent\n");
} elsif ($rcode > 0) {
+ rename ("$queue_dir/$q.wrk", "$queue_dir/$q");
im_info("$queue_dir/$q: preserved\n");
} else {
! unlink("$queue_dir/$q.wrk");
im_warn("$queue_dir/$q: delivery failed\n");
&error_report;
}
} else {
my ($r, $t);
+ rename ("$queue_dir/$q.wrk", "$queue_dir/$q");
print "Message queued in $queue_dir/$q";
if ($Config_opt ne '') {
print " (Config: $Config_opt)\n";
***************
*** 1858,1863 ****
--- 1862,1868 ----
}
$max = 0;
foreach $q (readdir(QUEUEDIR)) {
+ $q =~ s/\.wrk$//;
if ($q =~ /^\d+$/) {
$max = $q if ($max < $q);
}
Mew-dist メーリングリストの案内