X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=PerlMail%2FConfig.pm;h=4179565e4da755b679e9f61779770a8f38ccbe7b;hb=44259a1fa77c88cfa12ead6567f50e4eb102b6f6;hp=3488829a0b84b9d4a00440c562701761b81e6a44;hpb=9d03569bd26dfb0f54f21063445fc9d28ed1c4d3;p=PerlMail.git diff --git a/PerlMail/Config.pm b/PerlMail/Config.pm index 3488829..4179565 100644 --- a/PerlMail/Config.pm +++ b/PerlMail/Config.pm @@ -1,7 +1,7 @@ #! /usr/bin/perl # # $Id$ -# Copyright (C) 2002-2003 Jan Kratochvil +# Copyright (C) 2002-2003 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -33,55 +33,128 @@ use vars qw(@ISA @EXPORT); $Lock_pathname $PeerAddr $Socket_timeout $DB_table $DBI_database $DBI_user $DBI_pwd $sendmail_orig @addr_addon &FromAddress @h_rcpt @h_from %audit_profile @sms_squeezes @alternates_host @dnsbl_whitelist + + $Audit $is_pgp $opt_F $procmailFROM_MAILER $store_ignore $store_ignorenewmail + $store_profile ); require Mail::Alias; -sub headerhas; -sub store; -sub headeris; -sub did; -sub dnsbl; -sub store_muttrc_alternates; +BEGIN { + for (qw(headerhas store headeris did dnsbl store_muttrc_alternates Received_for parts_linear mime_type + body_first mimehead spamassassin header_remap lmtp_deliver)) { + eval 'sub '.$_.' { return ::'.$_.'(@_); }'; + } + } # perlmail-accept & perlmail-sendmail +# Various configuration files location is derived from it: our $HOME="/home/lace"; # perlmail-accept +# Mail folder: our $Mail="$HOME/Mail"; +# Users respected for the 'idle' state (see $IdleMax): our @ValidUsers=qw(root lace short kratochvil _local); +# Maximum number of local console idle seconds while still considered as 'active user': our $IdleMax=10; -our $MaxBodySMS=0x1000; # max bytes to pass to Lingua::EN::Squeeze +# Maxium number of bytes to pass to Lingua::EN::Squeeze (performance optimization): +our $MaxBodySMS=0x1000; +# Telephone number to send SMSes by WWW::SMS to: our @SMSwebRcpt=qw(420 602 431329); +# Some WWW::SMS modules require username: our $SMSwebRcpt_username="lace2"; +our $lmtp_admin="cyrus"; +our $lmtp_pwd; +{ + local *F; + open F,"$HOME/priv/lmtp.${lmtp_admin}.pwd" or die; + $lmtp_pwd=; + chomp $lmtp_pwd; + close F or die; + } +our $lmtp_user_from="lace"; +our $lmtp_user_to="lacemail"; # perlmail-submit +# Global system lock for exclusive $DB_table access: our $Lock_pathname="/tmp/PerlMail.lock"; +# 'workstation' hostname and port. Hostname may be dyndns: our $PeerAddr="exuhome.dyn.jankratochvil.net.:852"; #our $PeerAddr="127.0.0.1:2852"; -our $Socket_timeout=7600; # 15sec is NOT enough! +# 15sec is NOT enough as the remote peer must complete mail store: +our $Socket_timeout=7600; +# MySQL table name: our $DB_table="PerlMail_folder"; +# MySQL database name: our $DBI_database="short"; +# MySQL user name: our $DBI_user="short"; -our $DBI_pwd=$ENV{"HOME"}."/priv/mysql.".$DBI_user.".pwd"; +# MySQL user password: +our $DBI_pwd=$HOME."/priv/mysql.".$DBI_user.".pwd"; # perlmail-sendmail +# Lists where address is generated: +my @lists=qw( + tacplus-l@disaster.com + gsm@sh.cvut.cz + n9k@pandora.cz + dev9k@pandora.cz + gsm@pandora.cz + ros-general@reactos.com + ros-kernel@reactos.com + ros-dev@reactos.com + ros-cvs@reactos.com + 4cinfo@atrey.karlin.mff.cuni.cz + libtool@gnu.org + libtool-patches@gnu.org + wine-license@winehq.org + gtk-devel-list@gnome.org + gnome-vfs-list@gnome.org + captive-announce-list@jankratochvil.net + captive-list@jankratochvil.net + captive-devel-list@jankratochvil.net + linux-ntfs-announce@lists.sourceforge.net + linux-ntfs-dev@lists.sourceforge.net + orbit-list@gnome.org + devel@kannel.org + automake@gnu.org + autoconf@gnu.org + autoconf-patches@gnu.org + wget-patches@sunsite.dk + wget@sunsite.dk + wineconf@winehq.org + prague-pm@pm.org + dev@httpd.apache.org + asterisk-perl@lists.gnuinter.net + isdn4linux@listserv.isdn4linux.de + libc-alpha@sources.redhat.com + squid-dev@squid-cache.org + ); + #4c-list@vellum.cz + +# Pathname of the original sendmail(8) binary: our $sendmail_orig=(-x ($_="/usr/sbin/sendmail-orig") ? $_ : "/usr/sbin/sendmail"); +# List of addresses to locally Bcc all mails to: # Mail-Alias-1.12 defaults to "/etc/mail/aliases" which does not exist on RedHat sendmail-8.12.5-7 # Mail-Alias-1.12 will clutter $_ ! our @addr_addon=(Mail::Alias->new("/etc/aliases")->exists("sentout") ? ("sentout") : ()); our $opt_F; # imported our $is_pgp; # imported +my %lists=map(($_=>1),@lists); +# Generate new From address for the target $rcpt of type Mail::Address. +# $iserror is true for "MAIL FROM" RFC821 address, false for "From:" RFC822 address. +# Returns: Mail::Address instance. sub FromAddress { my($rcpt,$iserror)=@_; @@ -105,10 +178,10 @@ my($rcpt,$iserror)=@_; 'pgp-'.uc($default_key).'@jankratochvil.net', ); } - # !$is_pgp or fallback + return Mail::Address->new($phrase,'lace@jankratochvil.net') if !$lists{$rcpt->address()}; return Mail::Address->new( $phrase, - (!$iserror ? 'rcpt' : 'rcpterr') + 'rcpt' .'-' .(defined($rcpt->user()) ? $rcpt->user() : "NOUSER") .".AT." @@ -135,6 +208,12 @@ our @h_from=( # My-Audit +# Setup profile names. +# First element of /^=/ form copies it referenced profile to be extended. +# 'did' =>did() subroutine will return true for it. +# 'syslog' =>Use syslog(3). +# 'bell' =>Bell sound. +# 'sms=\d+'=>Send SMS by WWW::SMS with specified maximum # of parts our %audit_profile=( "btw" =>[], "silent"=>["=btw" ,"did"], @@ -143,6 +222,7 @@ our %audit_profile=( "sms" =>["=bell" ,"sms=1"], "crit" =>["=sms" ,"sms=3"], ); +# Try the squeezing methods in this order: our @sms_squeezes=( { "SqueezeControl"=>"noconv" }, { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, @@ -152,11 +232,13 @@ our @sms_squeezes=( { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, ); +# Hostnames where we had alternate e-mail addresses: 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 ); +# Override DNS blacklists: 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. @@ -167,6 +249,11 @@ our @dnsbl_whitelist=( "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. + "64.110.204.63", # hsdbrg64-110-204-63.sasknet.sk.ca: 64.110.202.181.sasknet.sk.ca.misc.spam.blackholes.five-ten-sg.com. + "212.80.76.44", # mx1.seznam.cz: 44.76.80.212.blackholes.five-ten-sg.com. + "212.80.76.29", # prace.seznam.cz: 212.80.76.42.seznam.cz.free.blackholes.five-ten-sg.com + "193.252.22.30", # smtp1.wanadoo.fr: 30.22.252.193.blackholes.five-ten-sg.com + "213.151.87.16", # posta.dobnet.cz: 16.87.151.213.relays.ordb.org ); our $Audit; # imported @@ -176,7 +263,7 @@ our $store_profile; # imported our $store_ignore; # imported sub audit { - # TODO: storage? + $store_profile=undef(); # never spawn new mail if FROM_MAILER # $isFROM_MAILER postponed after maillists as they may look as FROM_MAILER @@ -190,7 +277,8 @@ sub audit # spam honeypots return if did sub { local $_; - local $store_profile="silent"; + # Do not local $store_file as it is our-imported + $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",''; @@ -207,23 +295,29 @@ sub audit } store "=spam" if ($_=mimehead(body_first())->mime_attr("Content-Type.charset")) && /^big5/i; }; + $store_profile=undef(); # spam detection return if did sub { - local $store_profile="silent"; + # Do not local $store_file as it is our-imported + $store_profile="silent"; local $_; - store "=spam".($_ eq 1 ? "" : ";$_") if $_=razor2(); + store "=spam".($_ eq 1 ? "" : ";$_") if $_=spamassassin(); }; + $store_profile=undef(); return if did sub { - local $store_profile="silent"; + # Do not local $store_file as it is our-imported + $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 +# 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'; + store "=spam" if $isFROM_MAILER && headeris("To",''); }; + $store_profile=undef(); # special delivery store "=err","bell" and return if headerhas \&Received_for,''; @@ -245,7 +339,8 @@ sub audit # nasty public lists with $store_ignore { - local $store_profile="log"; + # Do not local $store_file as it is our-imported + $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$"; @@ -267,6 +362,7 @@ sub audit store "=9kc","log" if headeris "List-Post",''; store "=9kcd","log" if headeris "List-Post",''; } + $store_profile=undef(); # lists store "=mozillabug","log" if headeris "From" ,''; @@ -278,23 +374,32 @@ sub audit 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 "=winelic","silent" 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 "=winepat","silent" if headeris "List-Id" ,''; + store "=winecvs","silent" if headeris "List-Id" ,''; + store "=wineann","silent" if headeris "List-Id" ,''; + store "=wineconf","silent" if headeris "List-Id" ,''; + store "=ros","silent" if headeris "List-Id" ,''; + store "=roskernel","silent" if headeris "List-Id" ,''; + store "=rosd","silent" if headeris "List-Id" ,''; + store "=roscvs","silent" if headeris "List-Id" ,''; + store "=rossvn","silent" if headeris "List-Id" ,''; + store "=rosbug","silent" if headeris "Reply-To" ,''; store "=fsd","silent" if headeris "X-Mailing-List",''; - store "=kerneld","silent" if headeris "X-Mailing-List",''; + store "=kernel","silent" if headeris "X-Mailing-List",''; + store "=kernelnet","silent" if headeris "X-Mailing-List",''; + store "=ia64","silent" if headeris "X-Mailing-List",''; + store "=linuxjap","silent" if headeris "X-Mailing-List",''; + store "=kernelann","silent" if headeris "X-Mailing-List",''; + store "=sparse","silent" if headeris "X-Mailing-List",''; + store "=smp","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 "=tacacs","silent" if headeris "Sender" ,''; + store "=tacacs","silent" if headeris "Sender" ,''; + store "=tacacs","silent" if headeris "List-Id" ,''; + store "=pm","log" 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",''; @@ -309,21 +414,68 @@ sub audit 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" ,''; + store "=libtoold","silent" if headeris "List-Id" ,''; + store "=libtoolpat","silent" if headeris "List-Id" ,''; + store "=automake","silent" if headeris "List-Id" ,''; + store "=autoconf","log" if headeris "List-Id" ,''; + store "=autoconfpat","log" if headeris "List-Id" ,''; + store "=hurd","log" if headeris "List-Id" ,''; + my %mailman=( + ''=>"=caperr", + ''=>"=caperr", + ''=>"=caperr", + '<4c-admin@>'=>"=4cerr", + ); + if (!did sub { + while ((my($mailaddr,$folder)=each(%mailman))) { + (my $maillistaddr=$mailaddr)=~s/-admin/-list$&/; + store $folder,"log" if (headeris("From",'')&&headeris("To",$mailaddr)) + || headeris("From",$maillistaddr) + || headeris("To",$maillistaddr) + || headeris("From",$mailaddr); + } + }) { + store "=cap","bell" if headeris "List-Id" ,''; + store "=capd","bell" if headeris "List-Id" ,''; + store "=capann","bell" if headeris "List-Id" ,''; + store "=4c","bell" if headeris "List-Id" ,'<4c-list.vellum.cz>'; + } + store "=ntfsann","silent" if headeris "List-Id" ,''; + store "=ntfsd","silent" if headeris "List-Id" ,''; + store "=orbit","silent" if headeris "List-Id" ,''; + store "=kand","log" if headeris "List-Id" ,''; + store "=mailmand","silent" if headeris "List-Id" ,''; + store "=asterisk-perl","log" if headeris "List-Post",''; + store "=i4l","silent" if headeris "List-Id" ,''; + store "=glibc","silent" if headeris "Mailing-List",qr/\b\Qlibc-alpha-help\E@\Qsources.redhat.com\E\b/; + store "=fedann","bell" if headeris "List-Id" ,''; + store "=fedtools","log" if headeris "List-Id" ,''; + store "=bashbug","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" ,''; + store "=httpdd","log" if headeris "list-post",''; + store "=mms2log","log" if headeris "Return-Path",''; + store "=hotelgatelog","log" if headeris "Return-Path",''; # Petr Koutecky does not mark his Stuff - store "=koutecky","log" if headeris "From" ,''; + store "=koutecky","log" if headeris "Return-Path",''; + store "=koutecky","log" if headeris "Return-Path",''; + store "=koutecky","log" if headeris "Return-Path",''; + + if (($isFROM_MAILER && !did) || !did) { + lmtp_deliver $lmtp_admin,$lmtp_pwd,$lmtp_user_from,$lmtp_user_to; + } store "=errm","bell" if $isFROM_MAILER && !did(); - store "==","sms" if !did; + if (!did) { + store "==","sms"; + spamassassin "$HOME/bin/sa-learn --ham"; + } } sub audit_sms_address @@ -346,6 +498,9 @@ my($obj)=@_; return $_; } +# $args{"from"} +# $args{"subject"} +# $args{"body"} sub audit_sms { my(%args)=@_;