X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-accept;h=08f6a2bc3ccb236ee02a24700e91fe5fcb907603;hp=f51f0db190b9711eb33cf2cfec0e6476c1ed9a3b;hb=6b0b3e175ec251e22d66460bd9f004f8cf6e5564;hpb=dc95c42776248b09813d8722216e1cef47310163 diff --git a/perlmail-accept b/perlmail-accept index f51f0db..08f6a2b 100755 --- a/perlmail-accept +++ b/perlmail-accept @@ -10,7 +10,7 @@ use warnings; INIT { require Sys::Syslog; - Sys::Syslog::openlog("lacemail","pid","mail"); + Sys::Syslog::openlog("perlmail","pid","mail"); my @syslogging_stack; sub syslogging_on_save { @@ -52,7 +52,7 @@ require WWW::SMS; my $HOME="/home/lace"; my $Mail="$HOME/Mail"; my @ValidUsers=qw(root lace short kratochvil _local); -my $IdleMax=120; +my $IdleMax=10; my $MaxBodySMS=0x1000; # max bytes to pass to Lingua::EN::Squeeze my $SMSmailError='short+err@ucw.cz'; my @SMSwebRcpt=qw(420 602 431329); @@ -60,8 +60,9 @@ my $SMSwebRcpt_username="lace2"; my $SMScontact=''; our($Message,$Audit,@AuditStored,$store_ignore,$store_ignorenewmail,$store_profile,$DoBell); -our(%audit_profile,@sms_squeezes,@alternates_host); # imported +our(%audit_profile,@sms_squeezes,@alternates_host,@dnsbl_whitelist); # imported my %alternates_host; # from @alternates_host +my %dnsbl_whitelist; # from @dnsbl_whitelist # from RedHat "procmail-3.22-5" # /i should be only $procmailFROM_DAEMON but how it can hurt to /i all? @@ -99,7 +100,7 @@ sub stdin exit 0; } -# FIXME: separate 'lacemail'-transfer together with lacemail-submit away +# FIXME: separate 'perlmail'-transfer together with perlmail-submit away sub inetd { die "Excessive arguments" if @ARGV; @@ -142,7 +143,7 @@ sub bell sub useridle { - return 0 if ! -e $ENV{"HOME"}."/idle"; + return 0 if ! -e "$HOME/away"; my %valid_users=map(($_=>1),@ValidUsers); my($idlebest,$linebest); for my $utmp (User::Utmp::getut(),{ "ut_line"=>"psaux" }) { @@ -406,7 +407,7 @@ my($folder,$profile,%args)=@_; push @AuditStored,$folder if $do{"did"}; return if $store_ignore || $opt_dry; $DoBell++ if $do{"bell"}; - write_message($folder); + write_message($folder) or die; smssend_tryall $store_ignorenewmail,$do{"sms"},%args if $do{"sms"}; } @@ -457,12 +458,12 @@ my($message)=@_; local $Audit=Mail::Audit->new( "emergency"=>"$Mail/emergency", "data"=>[map("$_\n",split("\n",$message))], - "log"=>"$HOME/.lacemail.log", + "log"=>"$HOME/.perlmail.log", "loglevel"=>99, ); local @AuditStored=(); do { smssend 0,$opt_smstest; return; } if $opt_smstest; - write_message("$Mail/input"); + write_message("$Mail/input") or die; audit(); warn 'Corrupted $_, repaired' if defined($save_)!=defined($_) || (defined($_) && $save_ ne $_); } @@ -480,7 +481,7 @@ sub razor2 open CHILD,'|' .'('.'(razor-check 2>&1;echo >&3 $?)' .'|sed "s/^/razor-check: /"' - .'|logger -t "lacemail['.$$.']" -p mail.crit' + .'|logger -t "perlmail['.$$.']" -p mail.crit' .') 3>&1' .'|exit `cat`' or return 0; @@ -514,10 +515,6 @@ sub Received_for return @r; } -my %dnsbl_whitelist=map(($_=>1),( - "195.250.128.83" # smtp3.vol.cz; 83.128.250.195.blackholes.five-ten-sg.com - )); - # Extended Mail::Audit::MAPS # $domain,$full,[$timeout] sub dnsbl @@ -527,8 +524,9 @@ my($domain,$full,$timeout)=@_; $timeout||=30; # sec $Mail::Audit::MAPS::host=$domain; my @hosts=map({ s/^.*://; "[$_]"; } # strip DNS part - grep({ /^([^:@]*):/ && !$alternates_host{$1} # leave only foreign hosts - && !$dnsbl_whitelist{$1}; } (Received_for())) + grep({ /^([^:@]*):/ # $1 is DNS name, $' is IP address + && !$alternates_host{$1} # leave only foreign hosts + && !$dnsbl_whitelist{$'}; } (Received_for())) ); splice @hosts,1 if !$full && @hosts; # "&& @hosts" to prevent: WARN: splice() offset past end of array { @@ -626,7 +624,7 @@ sub muttrc_aliases } # FIXME: Unify -# BEGIN lacemail-sendmail +# BEGIN perlmail-sendmail # return: Mail::Address instance or undef() sub parseone { @@ -637,7 +635,7 @@ my($line)=@_; warn "Got ".scalar(@r)." addresses while wanting just one; when parsing: $line" if 1!=@r; return $r[0]; } -# END lacemail-sendmail +# END perlmail-sendmail # FIXME: host may get multiple recipients and thus not showing "for <...>" # FIXME: muttrc_get("from") is too strict @@ -731,7 +729,7 @@ my($header,$map)=@_; $text=~s/\b\Q$from\E\b/$to/gsi; } return if $text eq $orig; - $Audit->put_header("X-LaceMail-header_remap-$header",$orig); + $Audit->put_header("X-PerlMail-header_remap-$header",$orig); $Audit->replace_header($header,$text); } @@ -760,6 +758,7 @@ open AUDIT,$filenameMyAudit or die "open \"$filenameMyAudit\": $!"; eval or die "eval \"$filenameMyAudit\": $@"; audit_init(); %alternates_host=map((lc($_)=>1),@alternates_host); + %dnsbl_whitelist=map(( $_ =>1),@dnsbl_whitelist); } close AUDIT or warn "close \"$filenameMyAudit\": $!";