From: short <> Date: Sat, 18 Oct 2003 17:47:36 +0000 (+0000) Subject: Move My-Audit to PerlMail::Config. X-Git-Tag: bp_lace~44 X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=commitdiff_plain;h=9d03569bd26dfb0f54f21063445fc9d28ed1c4d3 Move My-Audit to PerlMail::Config. --- diff --git a/MANIFEST b/MANIFEST index fabd32e..f48e998 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,6 +1,7 @@ MANIFEST Makefile.PL -My-Audit.pm perlmail-accept perlmail-submit perlmail-sendmail +PerlMail/Contacts.pm +PerlMail/Config.pm diff --git a/My-Audit.pm b/My-Audit.pm deleted file mode 100644 index 4cdbe6f..0000000 --- a/My-Audit.pm +++ /dev/null @@ -1,248 +0,0 @@ -# $Id$ - -sub audit_init -{ - %audit_profile=( - "btw" =>[], - "silent"=>["=btw" ,"did"], - "log" =>["=silent","syslog"], - "bell" =>["=log" ,"bell"], - "sms" =>["=bell" ,"sms=1"], - "crit" =>["=sms" ,"sms=3"], - ); - @sms_squeezes=( - { "SqueezeControl"=>"noconv" }, - { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, - { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, - { "SqueezeControl"=>"med" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, - { "SqueezeControl"=>"med" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, - { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, - { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, - ); - @alternates_host=( - "jabberwock.ucw.cz", # short@ucw.cz - "atrey.karlin.mff.cuni.cz", # short@atrey.karlin.mff.cuni.cz - "k332.feld.cvut.cz", # short@k332.feld.cvut.cz - ); - @dnsbl_whitelist=( - "195.250.128.83", # smtp3.vol.cz; vol.cz.multistage.blackholes.five-ten-sg.com. - "64.49.222.22", # mail.pm.org: rackspace.com.spam-support.blackholes.five-ten-sg.com. - "208.147.243.5", # gambit.liquidcomm.net: cw.net.spam-support.blackholes.five-ten-sg.com. - "213.235.135.70", # smtp.tiscali.cz: tiscali.cz.multistage.blackholes.five-ten-sg.com. - "205.139.198.11", # eniac.disaster.com: cw.net.spam-support.blackholes.five-ten-sg.com. - "127.0.0.2", # 2.0.0.127.relays.ordb.org. - "65.113.40.131", # bozo.vmware.com: qwest.net.spam-support.blackholes.five-ten-sg.com. - "66.218.85.33", # mta2.wss.scd.yahoo.com: yahoo.com.spam.blackholes.five-ten-sg.com. - "212.80.76.42", # mx2.seznam.cz: seznam.cz.free.blackholes.five-ten-sg.com. - ); -} - -sub audit -{ - # TODO: storage? - - # never spawn new mail if FROM_MAILER - # $isFROM_MAILER postponed after maillists as they may look as FROM_MAILER - #use re 'debug'; - my $isFROM_MAILER=$Audit->header()=~/$procmailFROM_MAILER/mio; - $store_ignorenewmail=(0 - || $isFROM_MAILER - || headerhas "From",'' - ); - - # spam honeypots - return if did sub { - local $_; - local $store_profile="silent"; - store "=spam" if grep /^\Qshort\@k332.feld.cvut.cz\E/i,Received_for(); - # TODO: foreign violation of RFC 822 section 4.4.4, Subject:.*Automatick.+odpov.+v.+nep.+tomnosti - store "=spam" if headeris "From",''; - store "=spam" if headeris "From",''; - store "=spam" if headeris "From",''; - store "=spam" if headeris "From",''; - store "=spam" if headeris "From",''; - store "=spam" if headeris "From",''; - store "=spam" if headeris "From",''; - { - # weak detection: files with text/html w/o text/plain are usually a spam - my @types_linear=map({ mime_type($_); } parts_linear()); - store "=spam" if grep({ $_ eq "text/html"; } @types_linear) && !grep({ $_ eq "text/plain"; } @types_linear); - } - store "=spam" if ($_=mimehead(body_first())->mime_attr("Content-Type.charset")) && /^big5/i; - }; - - # spam detection - return if did sub { - local $store_profile="silent"; - local $_; - store "=spam".($_ eq 1 ? "" : ";$_") if $_=razor2(); - }; - return if did sub { - local $store_profile="silent"; - local $_; - store "=spam" .";$_","log" if $_=dnsbl '.relays.ordb.org.' ,1; # all hosts - store "=spam" .";$_","log" if $_=dnsbl '.blackholes.mail-abuse.org.' ,1; # all hosts - # we don't check all hosts as they can be "dialup" category, FIXME: check for it - store "=spam" .";$_","log" if $_=dnsbl '.blackholes.five-ten-sg.com.',0; # just first - # I don't send viruses but viruses propagate mails of mine - store "=spam" if headeris "X-Mailer",'ravmd/8.3.2'; - }; - - # special delivery - store "=err","bell" and return if headerhas \&Received_for,''; - - # ppl-wished foreign remapping, Reply-To is left untouched! - # FIXME: modifications are now being dropped by &write_message! - header_remap("From",{ - 'kerere@post.cz' =>'kamzik@k332.feld.cvut.cz', - 'profes@mbox.vol.cz' =>'kratochvilova@egp.cz', - 'jkrouzek@mbox.vol.cz' =>'krouzek@mbox.fsv.cuni.cz', - 'jakub.gorner@lidovky.cz' =>'tonda@disnet.cz', - 'jan.kolar@videoprogress.cz' =>'jenda.kolar@volny.cz', - 'daniel.rulicek@cponline.cz' =>'daniel.rulicek@cpress.cz', - 'pavel@suse.cz' =>'pavel@ucw.cz', - }); - - # My obsolete e-mail addresses - store_muttrc_alternates "=redirect-","btw"; - - # nasty public lists with $store_ignore - { - local $store_profile="log"; - local $store_ignore; - $store_ignore="smsmail" if 1==$Audit->body() && length(join "",$Audit->body())<180; # SMS mail - $store_ignore="sms OS" if $Audit->subject()=~/^Email pro: /; # "^Email pro: gsm@sh\.cvut\.cz$"; - $store_ignore="list-moron" if grep { headeris "From",$_; } qw( - - - - - <@mujoskar.cz> - - - - - - ); - - store "=gsm" if headeris "Sender" ,''; - store "=gsmpand" if headeris "List-Post",''; - store "=9kc","log" if headeris "List-Post",''; - store "=9kcd","log" if headeris "List-Post",''; - } - - # lists - store "=mozillabug","log" if headeris "From" ,''; - store "=9ku","log" if headeris "List-Id" ,'<9000.listman.net>'; - store "=9kd","log" if headeris "Sender" ,''; - store "=spong","log" if headeris "List-Id" ,''; - store "=gtkd","silent" if headeris "List-Id" ,''; - store "=gnomevfs","log" if headeris "List-Id" ,''; - store "=mffstatnice","bell" if headeris "List-Post",''; - store "=hw","log" if headeris "List-Post",''; - store "=gnokii","log" if headeris "List-Id" ,''; - store "=winelic","log" if headeris "List-Id" ,''; - store "=wined","silent" if headeris "List-Id" ,''; - store "=winepat","silent" if headeris "List-Id" ,''; - store "=winecvs","silent" if headeris "List-Id" ,''; - store "=wineann","log" if headeris "List-Id" ,''; - store "=ros","log" if headeris "List-Id" ,''; - store "=roskernel","log" if headeris "List-Post",''; - store "=roscvs","silent" if headeris "List-Post",''; - store "=rosbug","log" if headeris "Reply-To" ,''; - store "=fsd","silent" if headeris "X-Mailing-List",''; - store "=kerneld","silent" if headeris "X-Mailing-List",''; - store "=surprise","sms" if headeris "List-Post",''; - store "=surprisesuse","sms" if headeris "Sender" ,''; - store "=tacacs","log" if headeris "Sender" ,''; - store "=tacacs","log" if headeris "Sender" ,''; - store "=tacacs","log" if headeris "List-Id" ,''; - store "=pm","sms" if headeris "Sender" ,''; - store "=radary","log" if headeris "Reply-To" ,''; - store "=dnet","log" if headeris "Sender" ,'<@lists.distributed.net>'; - store "=linux-input","log" if headeris "List-Post",''; - store "=strom","bell" if headeris "List-Post",''; - store "=netinfo","log" if headeris "Sender" ,''; - store "=saintmj","log" if headeris "From" ,''; - store "=saintmj","log" if headeris "From" ,''; - store "=4cerr","bell" if headeris "From" ,''; - store "=4c","sms" if headeris "List-Post",'<4cinfo@atrey.karlin.mff.cuni.cz>'; - store "=slashdot","bell" if headeris "From" ,''; - store "=freshmeat","bell" if headeris "From" ,''; - store "=sourceforge","bell" if headeris "From" ,''; - store "=gsmperlcvs","silent" if headeris("From" ,'') - && $Audit->subject()=~/^'.*' has been updated!$/; - store "=libtoold","log" if headeris "List-Id" ,''; - store "=libtoolpat","log" if headeris "List-Id" ,''; - # own webs - store "=energie","bell" if headeris "From" ,qr/^EnergieWeb/; - store "=ats","log" if headeris("From" ,'') - || (headeris("From",'') && headerhas("To",'')); - store "=atscasablanca","log" if headeris "From" ,''; - store "=www-sms","log" if headeris "List-Id" ,''; - - # Petr Koutecky does not mark his Stuff - store "=koutecky","log" if headeris "From" ,''; - - store "=errm","bell" if $isFROM_MAILER && !did(); - - store "==","sms" if !did; -} - -sub audit_sms_address -{ -my($obj)=@_; - - my $address=$obj->address(); - if (my $alternates=muttrc_get("alternates")) { - return "I" if $address=~/$alternates/si; - } - my %aliases=muttrc_aliases(); - if (my $alias=$aliases{lc $address}) { - local $_=$alias; - s/\b(Bus)siness$/$1/i; - s/\.ident$//i; - return $_; - } - local $_=$address; - s/\.cz$//i; - return $_; -} - -sub audit_sms -{ -my(%args)=@_; - - my $from=(@{$args{"from"}} ? join(",",map({ audit_sms_address($_); } @{$args{"from"}})) : "?"); - local $_; - - $_=$args{"subject"}; - # headers - s/(?:Re|Aw|Odp|Fw|Fwd|OT)(?:\[\d+\])?://ig; - # former subject - s/\bbylo:.*$//i; - s/\[\s*WAS:.*\]\s*$//i; - # trim - s/^\s*//s; - s/\s*$//s; - my $subject=$_; - - $_=$args{"body"}; - # max. 9 lines of .sig - s/\n-- (?:\n[^\n]*){0,9}$//gs; - # "Original Message"/"Puvodni zprava" etc. up to empty line - # "- - - Original message: - - -" is by "Lotus Notes Release 5.0.5 September 22, 2000" - s/(^|\n)[\s^\n]*(?:-----[\w\s]*-----|- - - Original message: - - -)[\s^\n]*(?:\n[^\n]+)*\n{2,}(?:\s*[^>\s].*$)?/\n/gs; - # Remove "..." lines (is it used by anyone except me?) - s/^\Q...\E$/*/gm; - # quoting "> " - s/^(?:\s*[[:upper:]]{0,3}>)+.*$/*/gm; - s/(?:^|\n)(?:\*\n+)+/\n*\n/gs; - # attributions - s/^.*\b(?:wrote|writes|napsal jste):\s*$//gm; - my $body=$_; - - return [$from,"($subject)$body"]; -} - -1; diff --git a/PerlMail/Config.pm b/PerlMail/Config.pm index e06be0c..3488829 100644 --- a/PerlMail/Config.pm +++ b/PerlMail/Config.pm @@ -31,11 +31,21 @@ use vars qw(@ISA @EXPORT); $HOME $Mail @ValidUsers $IdleMax $MaxBodySMS @SMSwebRcpt $SMSwebRcpt_username $Lock_pathname $PeerAddr $Socket_timeout $DB_table $DBI_database $DBI_user $DBI_pwd - $sendmail_orig @addr_addon &FromAddress @h_rcpt @h_from); + $sendmail_orig @addr_addon &FromAddress @h_rcpt @h_from + %audit_profile @sms_squeezes @alternates_host @dnsbl_whitelist + ); require Mail::Alias; +sub headerhas; +sub store; +sub headeris; +sub did; +sub dnsbl; +sub store_muttrc_alternates; + + # perlmail-accept & perlmail-sendmail our $HOME="/home/lace"; @@ -121,3 +131,255 @@ our @h_from=( "Resent-From", "From", ); + + +# My-Audit + +our %audit_profile=( + "btw" =>[], + "silent"=>["=btw" ,"did"], + "log" =>["=silent","syslog"], + "bell" =>["=log" ,"bell"], + "sms" =>["=bell" ,"sms=1"], + "crit" =>["=sms" ,"sms=3"], + ); +our @sms_squeezes=( + { "SqueezeControl"=>"noconv" }, + { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, + { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, + { "SqueezeControl"=>"med" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, + { "SqueezeControl"=>"med" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, + { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, + { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, + ); +our @alternates_host=( + "jabberwock.ucw.cz", # short@ucw.cz + "atrey.karlin.mff.cuni.cz", # short@atrey.karlin.mff.cuni.cz + "k332.feld.cvut.cz", # short@k332.feld.cvut.cz + ); +our @dnsbl_whitelist=( + "195.250.128.83", # smtp3.vol.cz; vol.cz.multistage.blackholes.five-ten-sg.com. + "64.49.222.22", # mail.pm.org: rackspace.com.spam-support.blackholes.five-ten-sg.com. + "208.147.243.5", # gambit.liquidcomm.net: cw.net.spam-support.blackholes.five-ten-sg.com. + "213.235.135.70", # smtp.tiscali.cz: tiscali.cz.multistage.blackholes.five-ten-sg.com. + "205.139.198.11", # eniac.disaster.com: cw.net.spam-support.blackholes.five-ten-sg.com. + "127.0.0.2", # 2.0.0.127.relays.ordb.org. + "65.113.40.131", # bozo.vmware.com: qwest.net.spam-support.blackholes.five-ten-sg.com. + "66.218.85.33", # mta2.wss.scd.yahoo.com: yahoo.com.spam.blackholes.five-ten-sg.com. + "212.80.76.42", # mx2.seznam.cz: seznam.cz.free.blackholes.five-ten-sg.com. + ); + +our $Audit; # imported +our $procmailFROM_MAILER; # imported +our $store_ignorenewmail; # imported +our $store_profile; # imported +our $store_ignore; # imported +sub audit +{ + # TODO: storage? + + # never spawn new mail if FROM_MAILER + # $isFROM_MAILER postponed after maillists as they may look as FROM_MAILER + #use re 'debug'; + my $isFROM_MAILER=$Audit->header()=~/$procmailFROM_MAILER/mio; + $store_ignorenewmail=(0 + || $isFROM_MAILER + || headerhas "From",'' + ); + + # spam honeypots + return if did sub { + local $_; + local $store_profile="silent"; + store "=spam" if grep /^\Qshort\@k332.feld.cvut.cz\E/i,Received_for(); + # TODO: foreign violation of RFC 822 section 4.4.4, Subject:.*Automatick.+odpov.+v.+nep.+tomnosti + store "=spam" if headeris "From",''; + store "=spam" if headeris "From",''; + store "=spam" if headeris "From",''; + store "=spam" if headeris "From",''; + store "=spam" if headeris "From",''; + store "=spam" if headeris "From",''; + store "=spam" if headeris "From",''; + { + # weak detection: files with text/html w/o text/plain are usually a spam + my @types_linear=map({ mime_type($_); } parts_linear()); + store "=spam" if grep({ $_ eq "text/html"; } @types_linear) && !grep({ $_ eq "text/plain"; } @types_linear); + } + store "=spam" if ($_=mimehead(body_first())->mime_attr("Content-Type.charset")) && /^big5/i; + }; + + # spam detection + return if did sub { + local $store_profile="silent"; + local $_; + store "=spam".($_ eq 1 ? "" : ";$_") if $_=razor2(); + }; + return if did sub { + local $store_profile="silent"; + local $_; + store "=spam" .";$_","log" if $_=dnsbl '.relays.ordb.org.' ,1; # all hosts + store "=spam" .";$_","log" if $_=dnsbl '.blackholes.mail-abuse.org.' ,1; # all hosts + # we don't check all hosts as they can be "dialup" category, FIXME: check for it + store "=spam" .";$_","log" if $_=dnsbl '.blackholes.five-ten-sg.com.',0; # just first + # I don't send viruses but viruses propagate mails of mine + store "=spam" if headeris "X-Mailer",'ravmd/8.3.2'; + }; + + # special delivery + store "=err","bell" and return if headerhas \&Received_for,''; + + # ppl-wished foreign remapping, Reply-To is left untouched! + # FIXME: modifications are now being dropped by &write_message! + header_remap("From",{ + 'kerere@post.cz' =>'kamzik@k332.feld.cvut.cz', + 'profes@mbox.vol.cz' =>'kratochvilova@egp.cz', + 'jkrouzek@mbox.vol.cz' =>'krouzek@mbox.fsv.cuni.cz', + 'jakub.gorner@lidovky.cz' =>'tonda@disnet.cz', + 'jan.kolar@videoprogress.cz' =>'jenda.kolar@volny.cz', + 'daniel.rulicek@cponline.cz' =>'daniel.rulicek@cpress.cz', + 'pavel@suse.cz' =>'pavel@ucw.cz', + }); + + # My obsolete e-mail addresses + store_muttrc_alternates "=redirect-","btw"; + + # nasty public lists with $store_ignore + { + local $store_profile="log"; + local $store_ignore; + $store_ignore="smsmail" if 1==$Audit->body() && length(join "",$Audit->body())<180; # SMS mail + $store_ignore="sms OS" if $Audit->subject()=~/^Email pro: /; # "^Email pro: gsm@sh\.cvut\.cz$"; + $store_ignore="list-moron" if grep { headeris "From",$_; } qw( + + + + + <@mujoskar.cz> + + + + + + ); + + store "=gsm" if headeris "Sender" ,''; + store "=gsmpand" if headeris "List-Post",''; + store "=9kc","log" if headeris "List-Post",''; + store "=9kcd","log" if headeris "List-Post",''; + } + + # lists + store "=mozillabug","log" if headeris "From" ,''; + store "=9ku","log" if headeris "List-Id" ,'<9000.listman.net>'; + store "=9kd","log" if headeris "Sender" ,''; + store "=spong","log" if headeris "List-Id" ,''; + store "=gtkd","silent" if headeris "List-Id" ,''; + store "=gnomevfs","log" if headeris "List-Id" ,''; + store "=mffstatnice","bell" if headeris "List-Post",''; + store "=hw","log" if headeris "List-Post",''; + store "=gnokii","log" if headeris "List-Id" ,''; + store "=winelic","log" if headeris "List-Id" ,''; + store "=wined","silent" if headeris "List-Id" ,''; + store "=winepat","silent" if headeris "List-Id" ,''; + store "=winecvs","silent" if headeris "List-Id" ,''; + store "=wineann","log" if headeris "List-Id" ,''; + store "=ros","log" if headeris "List-Id" ,''; + store "=roskernel","log" if headeris "List-Post",''; + store "=roscvs","silent" if headeris "List-Post",''; + store "=rosbug","log" if headeris "Reply-To" ,''; + store "=fsd","silent" if headeris "X-Mailing-List",''; + store "=kerneld","silent" if headeris "X-Mailing-List",''; + store "=surprise","sms" if headeris "List-Post",''; + store "=surprisesuse","sms" if headeris "Sender" ,''; + store "=tacacs","log" if headeris "Sender" ,''; + store "=tacacs","log" if headeris "Sender" ,''; + store "=tacacs","log" if headeris "List-Id" ,''; + store "=pm","sms" if headeris "Sender" ,''; + store "=radary","log" if headeris "Reply-To" ,''; + store "=dnet","log" if headeris "Sender" ,'<@lists.distributed.net>'; + store "=linux-input","log" if headeris "List-Post",''; + store "=strom","bell" if headeris "List-Post",''; + store "=netinfo","log" if headeris "Sender" ,''; + store "=saintmj","log" if headeris "From" ,''; + store "=saintmj","log" if headeris "From" ,''; + store "=4cerr","bell" if headeris "From" ,''; + store "=4c","sms" if headeris "List-Post",'<4cinfo@atrey.karlin.mff.cuni.cz>'; + store "=slashdot","bell" if headeris "From" ,''; + store "=freshmeat","bell" if headeris "From" ,''; + store "=sourceforge","bell" if headeris "From" ,''; + store "=gsmperlcvs","silent" if headeris("From" ,'') + && $Audit->subject()=~/^'.*' has been updated!$/; + store "=libtoold","log" if headeris "List-Id" ,''; + store "=libtoolpat","log" if headeris "List-Id" ,''; + # own webs + store "=energie","bell" if headeris "From" ,qr/^EnergieWeb/; + store "=ats","log" if headeris("From" ,'') + || (headeris("From",'') && headerhas("To",'')); + store "=atscasablanca","log" if headeris "From" ,''; + store "=www-sms","log" if headeris "List-Id" ,''; + + # Petr Koutecky does not mark his Stuff + store "=koutecky","log" if headeris "From" ,''; + + store "=errm","bell" if $isFROM_MAILER && !did(); + + store "==","sms" if !did; +} + +sub audit_sms_address +{ +my($obj)=@_; + + my $address=$obj->address(); + if (my $alternates=muttrc_get("alternates")) { + return "I" if $address=~/$alternates/si; + } + my %aliases=muttrc_aliases(); + if (my $alias=$aliases{lc $address}) { + local $_=$alias; + s/\b(Bus)siness$/$1/i; + s/\.ident$//i; + return $_; + } + local $_=$address; + s/\.cz$//i; + return $_; +} + +sub audit_sms +{ +my(%args)=@_; + + my $from=(@{$args{"from"}} ? join(",",map({ audit_sms_address($_); } @{$args{"from"}})) : "?"); + local $_; + + $_=$args{"subject"}; + # headers + s/(?:Re|Aw|Odp|Fw|Fwd|OT)(?:\[\d+\])?://ig; + # former subject + s/\bbylo:.*$//i; + s/\[\s*WAS:.*\]\s*$//i; + # trim + s/^\s*//s; + s/\s*$//s; + my $subject=$_; + + $_=$args{"body"}; + # max. 9 lines of .sig + s/\n-- (?:\n[^\n]*){0,9}$//gs; + # "Original Message"/"Puvodni zprava" etc. up to empty line + # "- - - Original message: - - -" is by "Lotus Notes Release 5.0.5 September 22, 2000" + s/(^|\n)[\s^\n]*(?:-----[\w\s]*-----|- - - Original message: - - -)[\s^\n]*(?:\n[^\n]+)*\n{2,}(?:\s*[^>\s].*$)?/\n/gs; + # Remove "..." lines (is it used by anyone except me?) + s/^\Q...\E$/*/gm; + # quoting "> " + s/^(?:\s*[[:upper:]]{0,3}>)+.*$/*/gm; + s/(?:^|\n)(?:\*\n+)+/\n*\n/gs; + # attributions + s/^.*\b(?:wrote|writes|napsal jste):\s*$//gm; + my $body=$_; + + return [$from,"($subject)$body"]; +} + +1; diff --git a/perlmail-accept b/perlmail-accept index d0909da..30e7833 100755 --- a/perlmail-accept +++ b/perlmail-accept @@ -27,7 +27,11 @@ INIT { } -use PerlMail::Config; +use File::Basename; +BEGIN { + use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0); + use PerlMail::Config; + } use Mail::Audit qw(MAPS); require IO::Handle; @@ -35,7 +39,6 @@ use Carp qw(cluck confess); use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG); require POSIX; # for ceil use User::Utmp; -require File::Basename; use Getopt::Long; require Mail::Address; require MIME::Words; @@ -728,7 +731,6 @@ my($header,$map)=@_; # MAIN -my $basedir=File::Basename::dirname($0); $Getopt::Long::ignorecase=0; die "GetOptions error" if !Getopt::Long::GetOptions( "inetd" ,sub { $opt_mode=\&inetd; }, @@ -738,21 +740,13 @@ die "GetOptions error" if !Getopt::Long::GetOptions( "idle!" ,\$opt_idle, "idletest" ,sub { syslogging_restore(); print((defined($_=useridle()) ? $_ : "")."\n"); exit 0; }, "muttrc" ,sub { syslogging_restore(); print scalar muttrc(); exit 0; }, - "d|basedir=s",\&basedir, ); # "Excessive arguments" checked in &inetd die "Missing mode" if !$opt_mode; -my $filenameMyAudit="$basedir/My-Audit.pm"; -open AUDIT,$filenameMyAudit or die "open \"$filenameMyAudit\": $!"; -{ - local $/=undef(); - 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\": $!"; +PerlMail::Config::audit_init(); +%alternates_host=map((lc($_)=>1),@alternates_host); +%dnsbl_whitelist=map(( $_ =>1),@dnsbl_whitelist); &$opt_mode(); die "NOTREACHED"; diff --git a/perlmail-sendmail b/perlmail-sendmail index 366f830..f819bcc 100755 --- a/perlmail-sendmail +++ b/perlmail-sendmail @@ -7,14 +7,16 @@ $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; use strict; use warnings; -use PerlMail::Config; +use File::Basename; +BEGIN { + use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0); + use PerlMail::Config; + } require Getopt::Long; use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG); require MIME::Head; # inherits Mail::Header require Mail::Address; -require File::Basename; -require Mail::Alias; # FIXME: modularized unification with 'perlmail-accept' diff --git a/perlmail-submit b/perlmail-submit index 6879f3d..c7fe19f 100755 --- a/perlmail-submit +++ b/perlmail-submit @@ -7,7 +7,11 @@ $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; use strict; use warnings; -use PerlMail::Config; +use File::Basename; +BEGIN { + use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0); + use PerlMail::Config; + } use Getopt::Long; use DBI;