4 # Copyright (C) 2002-2003 Jan Kratochvil <short@ucw.cz>
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 package PerlMail::Config;
22 use vars qw($VERSION);
23 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
28 use vars qw(@ISA @EXPORT);
32 $Mail @ValidUsers $IdleMax $MaxBodySMS @SMSwebRcpt $SMSwebRcpt_username
33 $Lock_pathname $PeerAddr $Socket_timeout $DB_table $DBI_database $DBI_user $DBI_pwd
34 $sendmail_orig @addr_addon &FromAddress @h_rcpt @h_from);
39 # perlmail-accept & perlmail-sendmail
41 our $HOME="/home/lace";
46 our $Mail="$HOME/Mail";
47 our @ValidUsers=qw(root lace short kratochvil _local);
49 our $MaxBodySMS=0x1000; # max bytes to pass to Lingua::EN::Squeeze
50 our @SMSwebRcpt=qw(420 602 431329);
51 our $SMSwebRcpt_username="lace2";
56 our $Lock_pathname="/tmp/PerlMail.lock";
57 our $PeerAddr="exuhome.dyn.jankratochvil.net.:852";
58 #our $PeerAddr="127.0.0.1:2852";
59 our $Socket_timeout=7600; # 15sec is NOT enough!
60 our $DB_table="PerlMail_folder";
61 our $DBI_database="short";
62 our $DBI_user="short";
63 our $DBI_pwd=$ENV{"HOME"}."/priv/mysql.".$DBI_user.".pwd";
68 our $sendmail_orig=(-x ($_="/usr/sbin/sendmail-orig") ? $_ : "/usr/sbin/sendmail");
69 # Mail-Alias-1.12 defaults to "/etc/mail/aliases" which does not exist on RedHat sendmail-8.12.5-7
70 # Mail-Alias-1.12 will clutter $_ !
71 our @addr_addon=(Mail::Alias->new("/etc/aliases")->exists("sentout") ? ("sentout") : ());
73 our $opt_F; # imported
74 our $is_pgp; # imported
77 my($rcpt,$iserror)=@_;
79 my $phrase=(defined $opt_F ? $opt_F : "Jan Kratochvil");
85 my $filename="$HOME/.gnupg/options";
86 open F,$filename or do { warn "Open \"$filename\": $!"; last; };
88 my @keys=map((/^\s*default-key\s+(\S+)\s*$/),<F>);
89 @keys==1 or do { warn "Found ".scalar(@keys)." 'default-key's in your \"$filename\", ignoring"; last; };
90 close F or warn "Close \"$filename\": $!";
91 my $default_key=$keys[0];
92 $default_key=~/^[[:xdigit:]]{8}$/ or do { warn "Invalid 'default-key', ignoring: $default_key"; last; };
93 return Mail::Address->new(
95 'pgp-'.uc($default_key).'@jankratochvil.net',
98 # !$is_pgp or fallback
99 return Mail::Address->new(
101 (!$iserror ? 'rcpt' : 'rcpterr')
103 .(defined($rcpt->user()) ? $rcpt->user() : "NOUSER")
105 .(defined($rcpt->host()) ? $rcpt->host() : "LOCAL")
106 .'@jankratochvil.net',
110 # RedHat sendmail-8.9.3-20/src/conf.c/HdrInfo[]/\Q/* destination fields */\E
111 # FIXME: Recognize "Resent-$_" headers for -t but when we are in 'resent' mode?
112 our @h_rcpt=( # case in-sensitive!
118 # ordering matters; first header found is substituted
119 # last header is subsituted if no one is found