PerlMail/Config.pm

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4 # Copyright (C) 2002-2003 Jan Kratochvil <short@ucw.cz>
   5 #
   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.
  10 #
  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.
  15 #
  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
  19
  20
  21 package PerlMail::Config;
  22 use vars qw($VERSION);
  23 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
  24 use strict;
  25 use warnings;
  26
  27 require Exporter;
  28 use vars qw(@ISA @EXPORT);
  29 @ISA=qw(Exporter);
  30 @EXPORT=qw(
  31                 $HOME
  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);
  35
  36 require Mail::Alias;
  37
  38
  39 # perlmail-accept & perlmail-sendmail
  40
  41 our $HOME="/home/lace";
  42
  43
  44 # perlmail-accept
  45
  46 our $Mail="$HOME/Mail";
  47 our @ValidUsers=qw(root lace short kratochvil _local);
  48 our $IdleMax=10;
  49 our $MaxBodySMS=0x1000; # max bytes to pass to Lingua::EN::Squeeze
  50 our @SMSwebRcpt=qw(420 602 431329);
  51 our $SMSwebRcpt_username="lace2";
  52
  53
  54 # perlmail-submit
  55
  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";
  64
  65
  66 # perlmail-sendmail
  67
  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") : ());
  72
  73 our $opt_F;     # imported
  74 our $is_pgp;    # imported
  75 sub FromAddress
  76 {
  77 my($rcpt,$iserror)=@_;
  78
  79         my $phrase=(defined $opt_F ? $opt_F : "Jan Kratochvil");
  80         {
  81                 last if !$is_pgp;
  82                 last if $iserror;
  83                 local *F;
  84                 local $_;
  85                 my $filename="$HOME/.gnupg/options";
  86                 open F,$filename or do { warn "Open \"$filename\": $!"; last; };
  87                 local $/="\n";
  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(
  94                                 $phrase,
  95                                 'pgp-'.uc($default_key).'@jankratochvil.net',
  96                                 );
  97                 }
  98         # !$is_pgp or fallback
  99         return Mail::Address->new(
 100                         $phrase,
 101                         (!$iserror ? 'rcpt' : 'rcpterr')
 102                                         .'-'
 103                                         .(defined($rcpt->user()) ? $rcpt->user() : "NOUSER")
 104                                         .".AT."
 105                                         .(defined($rcpt->host()) ? $rcpt->host() : "LOCAL")
 106                                         .'@jankratochvil.net',
 107                         );
 108 }
 109
 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!
 113                 "To",
 114                 "Cc",
 115                 "Bcc",
 116                 "Apparently-To",
 117                 );
 118 # ordering matters; first header found is substituted
 119 # last header is subsituted if no one is found
 120 our @h_from=(
 121                 "Resent-From",
 122                 "From",
 123                 );