X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-accept;h=55bef4a30e6dd252c943dcd0bbef5ccb38ab0d1c;hp=dad2bd38bf1f47238d6d20a5507eba66ffe99873;hb=2a51f3d04a7e9ddd4268ef31e425073cbdad167a;hpb=3c73b7403e13e8b970a4402a2ae8cee9cd9f486d diff --git a/perlmail-accept b/perlmail-accept index dad2bd3..55bef4a 100755 --- a/perlmail-accept +++ b/perlmail-accept @@ -89,6 +89,7 @@ my $opt_mode; my $opt_smstest; # 1 or $smscount my $opt_idle; my $opt_dry; +my $opt_single; sub process; @@ -101,7 +102,7 @@ sub stdin local $_; while (<>) { die "Invalid 'From ' line: $_" if $message eq "" && !/^From /; - if (/^From / && $message) { + if (!$opt_single && /^From / && $message) { process $message; $message=""; } @@ -130,8 +131,8 @@ sub inetd $length==($_=read STDIN,$message,$length) or confess "Got $_ out of required $length bytes"; $length==length $message or confess "False read return ".length($message)." instead of $length"; { - local *STDOUT; - local *STDERR; + local *STDOUT; # FIXME: fd's inherited by spawned processes are not closed this way! + local *STDERR; # FIXME: fd's inherited by spawned processes are not closed this way! local $DoBell=0; process $message; if ($DoBell) { @@ -487,32 +488,26 @@ my($message)=@_; # utility functions: # return: true (error-message or "1") if is spam -sub razor2 +sub spamassassin { - # razor-check has exit code 1 if NOT spam, code 0 if IS spam +my($cmd)=@_; + + $cmd||="$HOME/bin/spamassassin --exit-code"; + # spamassassin has exit code 1 if IS spam, code 0 if NOT spam local *CHILD; - local $SIG{"PIPE"}=sub { warn "razor2 gave me SIGPIPE: broken pipe"; }; + local $SIG{"PIPE"}=sub { warn "spamassassin gave me SIGPIPE: broken pipe"; }; # prevent Razor2's: Can't call method "log" on unblessed reference at Razor2/Client/Agent.pm line 212. local $ENV{"HOME"}=$HOME; - open CHILD,'|' - .'('.'(razor-check 2>&1;echo >&3 $?)' - .'|sed "s/^/razor-check: /"' - .'|logger -t "perlmail['.$$.']" -p mail.crit' - .') 3>&1' - .'|exit `cat`' + # 2>/dev/null to prevent error messages to corrupt inetd() output of perlmail-accept(1) + open CHILD,"|$cmd --mbox >/dev/null 2>/dev/null" or return 0; print CHILD $Message; - my $return; - { - local $/=undef(); - $return= || 1; - } - close CHILD; + my $return=close CHILD; return undef() if !WIFEXITED($?); return undef() if WIFSIGNALED($?); return undef() if WIFSTOPPED($?); - return undef() if WEXITSTATUS($?); - return $return; # is-spam + return 1 if WEXITSTATUS($?); # is-spam + return 0; # not-spam } # NOTE: returns undef() if !wantarray and the first header is unrecognized @@ -668,6 +663,7 @@ $Getopt::Long::ignorecase=0; die "GetOptions error" if !Getopt::Long::GetOptions( "inetd" ,sub { $opt_mode=\&inetd; }, "stdin" ,sub { $opt_mode=\&stdin; }, + "single!" ,\$opt_single, "dry" ,\$opt_dry, "smstest:s",sub { $opt_mode=\&stdin; $opt_smstest=($_[1] || 1); }, "idle!" ,\$opt_idle,