--- /dev/null
+#! /usr/bin/perl
+#
+# $Id$
+# Copyright (C) 2002-2003 Jan Kratochvil <short@ucw.cz>
+#
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+package PerlMail::Config;
+use vars qw($VERSION);
+$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
+use strict;
+use warnings;
+
+require Exporter;
+use vars qw(@ISA @EXPORT);
+@ISA=qw(Exporter);
+@EXPORT=qw(
+ $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);
+
+require Mail::Alias;
+
+
+# perlmail-accept & perlmail-sendmail
+
+our $HOME="/home/lace";
+
+
+# perlmail-accept
+
+our $Mail="$HOME/Mail";
+our @ValidUsers=qw(root lace short kratochvil _local);
+our $IdleMax=10;
+our $MaxBodySMS=0x1000; # max bytes to pass to Lingua::EN::Squeeze
+our @SMSwebRcpt=qw(420 602 431329);
+our $SMSwebRcpt_username="lace2";
+
+
+# perlmail-submit
+
+our $Lock_pathname="/tmp/PerlMail.lock";
+our $PeerAddr="exuhome.dyn.jankratochvil.net.:852";
+#our $PeerAddr="127.0.0.1:2852";
+our $Socket_timeout=7600; # 15sec is NOT enough!
+our $DB_table="PerlMail_folder";
+our $DBI_database="short";
+our $DBI_user="short";
+our $DBI_pwd=$ENV{"HOME"}."/priv/mysql.".$DBI_user.".pwd";
+
+
+# perlmail-sendmail
+
+our $sendmail_orig=(-x ($_="/usr/sbin/sendmail-orig") ? $_ : "/usr/sbin/sendmail");
+# 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
+sub FromAddress
+{
+my($rcpt,$iserror)=@_;
+
+ my $phrase=(defined $opt_F ? $opt_F : "Jan Kratochvil");
+ {
+ last if !$is_pgp;
+ last if $iserror;
+ local *F;
+ local $_;
+ my $filename="$HOME/.gnupg/options";
+ open F,$filename or do { warn "Open \"$filename\": $!"; last; };
+ local $/="\n";
+ my @keys=map((/^\s*default-key\s+(\S+)\s*$/),<F>);
+ @keys==1 or do { warn "Found ".scalar(@keys)." 'default-key's in your \"$filename\", ignoring"; last; };
+ close F or warn "Close \"$filename\": $!";
+ my $default_key=$keys[0];
+ $default_key=~/^[[:xdigit:]]{8}$/ or do { warn "Invalid 'default-key', ignoring: $default_key"; last; };
+ return Mail::Address->new(
+ $phrase,
+ 'pgp-'.uc($default_key).'@jankratochvil.net',
+ );
+ }
+ # !$is_pgp or fallback
+ return Mail::Address->new(
+ $phrase,
+ (!$iserror ? 'rcpt' : 'rcpterr')
+ .'-'
+ .(defined($rcpt->user()) ? $rcpt->user() : "NOUSER")
+ .".AT."
+ .(defined($rcpt->host()) ? $rcpt->host() : "LOCAL")
+ .'@jankratochvil.net',
+ );
+}
+
+# RedHat sendmail-8.9.3-20/src/conf.c/HdrInfo[]/\Q/* destination fields */\E
+# FIXME: Recognize "Resent-$_" headers for -t but when we are in 'resent' mode?
+our @h_rcpt=( # case in-sensitive!
+ "To",
+ "Cc",
+ "Bcc",
+ "Apparently-To",
+ );
+# ordering matters; first header found is substituted
+# last header is subsituted if no one is found
+our @h_from=(
+ "Resent-From",
+ "From",
+ );
}
+use PerlMail::Config;
+
use Mail::Audit qw(MAPS);
require IO::Handle;
use Carp qw(cluck confess);
require WWW::SMS;
-my $HOME="/home/lace";
-my $Mail="$HOME/Mail";
-my @ValidUsers=qw(root lace short kratochvil _local);
-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);
-my $SMSwebRcpt_username="lace2";
-my $SMScontact='<short@ucw.cz>';
-
our($Message,$Audit,@AuditStored,$store_ignore,$store_ignorenewmail,$store_profile,$DoBell);
our(%audit_profile,@sms_squeezes,@alternates_host,@dnsbl_whitelist); # imported
my %alternates_host; # from @alternates_host
return map({
my $l=160;
if (!$ignorenewmail) { # send by mail
- $l-=length("Z emailu $SMSmailError: ");
+ $l-=length("Z emailu FIXME SMSmailError: ");
$l-=length(smsbuild($_,$smscount));
}
else { # send by web
use strict;
use warnings;
+use PerlMail::Config;
+
require Getopt::Long;
use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG);
require MIME::Head; # inherits Mail::Header
require File::Basename;
require Mail::Alias;
-my $sendmail_orig=(-x ($_="/usr/sbin/sendmail-orig") ? $_ : "/usr/sbin/sendmail");
-my $HOME="/home/short";
-# 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 $_ !
-my @addr_addon=(Mail::Alias->new("/etc/aliases")->exists("sentout") ? ("sentout") : ());
-my $opt_F;
-my $is_pgp;
-sub FromAddress
-{
-my($rcpt,$iserror)=@_;
-
- my $phrase=(defined $opt_F ? $opt_F : "Jan Kratochvil");
- {
- last if !$is_pgp;
- last if $iserror;
- local *F;
- local $_;
- my $filename="$HOME/.gnupg/options";
- open F,$filename or do { warn "Open \"$filename\": $!"; last; };
- local $/="\n";
- my @keys=map((/^\s*default-key\s+(\S+)\s*$/),<F>);
- @keys==1 or do { warn "Found ".scalar(@keys)." 'default-key's in your \"$filename\", ignoring"; last; };
- close F or warn "Close \"$filename\": $!";
- my $default_key=$keys[0];
- $default_key=~/^[[:xdigit:]]{8}$/ or do { warn "Invalid 'default-key', ignoring: $default_key"; last; };
- return Mail::Address->new(
- $phrase,
- 'pgp-'.uc($default_key).'@jankratochvil.net',
- );
- }
- # !$is_pgp or fallback
- return Mail::Address->new(
- $phrase,
- (!$iserror ? 'rcpt' : 'rcpterr')
- .'-'
- .(defined($rcpt->user()) ? $rcpt->user() : "NOUSER")
- .".AT."
- .(defined($rcpt->host()) ? $rcpt->host() : "LOCAL")
- .'@jankratochvil.net',
- );
-}
-
-# RedHat sendmail-8.9.3-20/src/conf.c/HdrInfo[]/\Q/* destination fields */\E
-# FIXME: Recognize "Resent-$_" headers for -t but when we are in 'resent' mode?
-my @h_rcpt=( # case in-sensitive!
- "To",
- "Cc",
- "Bcc",
- "Apparently-To",
- );
-
-# ordering matters; first header found is substituted
-# last header is subsituted if no one is found
-my @h_from=(
- "Resent-From",
- "From",
- );
-
# FIXME: modularized unification with 'perlmail-accept'
# BEGIN perlmail-accept
my $opt_q;
my $opt_t;
our $opt_f;
-#my $opt_F; # declared before &FromAddress already
+our $opt_F; # from PerlMail::Config;
my $opt_perlmail_dry_run;
my @ARGV_save=@ARGV; # for non-bm mode
die if !Getopt::Long::GetOptions(
}
# to be utilized later by &FromAddress
+our $is_pgp; # from PerlMail::Config;
$is_pgp=(1
&& do { local $_=$head->mime_attr("Content-Type"); $_ && ~m#^multipart/(?:signed|encrypted)$#; }
&& do { local $_=$head->mime_attr("Content-Type.protocol"); $_ && ~m#^application/pgp\b#; }
use strict;
use warnings;
+use PerlMail::Config;
+
use Getopt::Long;
use DBI;
use Carp qw(cluck confess);
use Fcntl qw(:flock);
-my $Lock_pathname="/tmp/PerlMail.lock";
-#my $PeerAddr="dejhome.dyn.jankratochvil.net.:852";
-my $PeerAddr="127.0.0.1:2852";
-my $Socket_timeout=7600; # 15sec is NOT enough!
-my $DB_table="PerlMail_folder";
-my $DBI_database="short";
-my $DBI_user="short";
-my $DBI_pwd=$ENV{"HOME"}."/priv/mysql.".$DBI_user.".pwd";
open DBI_PWD,$DBI_pwd or die "open \"$DBI_pwd\": $!";
$DBI_pwd=<DBI_PWD>;
close DBI_PWD or warn "close DBI_pwd: $!";
git://git.jankratochvil.net / PerlMail.git / commitdiff