| 11 |
# |
# |
| 12 |
# ============================================================ |
# ============================================================ |
| 13 |
# $Log$ |
# $Log$ |
| 14 |
|
# Revision 1.3 2003/01/22 07:16:51 root |
| 15 |
|
# + sub traceEntry |
| 16 |
|
# + further refactorings |
| 17 |
|
# |
| 18 |
# Revision 1.2 2003/01/22 05:38:44 collector |
# Revision 1.2 2003/01/22 05:38:44 collector |
| 19 |
# + prepared refactoring to 'dispatchmail' |
# + prepared refactoring to 'dispatchmail' |
| 20 |
# |
# |
| 28 |
use Getopt::Long; |
use Getopt::Long; |
| 29 |
|
|
| 30 |
|
|
| 31 |
|
use lib qw( /data/libs/nfo/perl/libs ); |
| 32 |
|
use org::netfrag::shortcuts qw( now ); |
| 33 |
|
|
| 34 |
|
|
| 35 |
|
|
| 36 |
# - - - - - - - - - - - - - - - - - - - - |
# - - - - - - - - - - - - - - - - - - - - |
| 37 |
# options |
# options |
| 38 |
# - - - - - - - - - - - - - - - - - - - - |
# - - - - - - - - - - - - - - - - - - - - |
| 45 |
$opt_base ||= $ENV{HOME}; |
$opt_base ||= $ENV{HOME}; |
| 46 |
$opt_base ||= $ENV{PWD}; |
$opt_base ||= $ENV{PWD}; |
| 47 |
|
|
| 48 |
|
my $LOG = 1; # writes reports to logfile |
| 49 |
|
my $VERBOSE = 1; # writes reports to STDOUT |
| 50 |
|
my $TRACE = 1; # writes contents of messages to logfile |
| 51 |
|
|
| 52 |
# - - - - - - - - - - - - - - - - - - - - |
# - - - - - - - - - - - - - - - - - - - - |
| 53 |
# |
# |
| 58 |
# mail should be delivered to |
# mail should be delivered to |
| 59 |
# |
# |
| 60 |
# - - - - - - - - - - - - - - - - - - - - |
# - - - - - - - - - - - - - - - - - - - - |
|
#my $HOME = "/home/joko/virtual/joko_mail"; |
|
| 61 |
my $USER = $ENV{USER}; |
my $USER = $ENV{USER}; |
| 62 |
my $HOME = $opt_base; |
my $HOME = $opt_base; |
| 63 |
my $MAILDIR = "$HOME/Mail"; |
my $MAILDIR = "$HOME/Mail"; |
| 64 |
my $LOGFILE = "$MAILDIR/recievemail.log"; |
my $RULESFILE = "$HOME/.dispatchmailrc.pm"; |
| 65 |
my $RULESFILE = "$HOME/.recievemailrc.pm"; |
#my $LOCKFILE = "$HOME/.procmail.lockfile"; |
| 66 |
my $LOCKFILE = "$HOME/.procmail.lockfile"; |
my $LOCKFILE = "$HOME/.dispatchmail.lockfile"; |
| 67 |
|
my $LOGFILE = "$MAILDIR/.dispatchmail.log"; |
| 68 |
my $DEFAULT = "$MAILDIR/Inbox"; |
my $DEFAULT = "$MAILDIR/Inbox"; |
|
my $DEBUG = 0; |
|
|
my $TRACE = 1; |
|
|
my $VERBOSE = 1; |
|
| 69 |
|
|
| 70 |
# override settings |
# override settings |
| 71 |
# override $RULESFILE if given as option on the command line |
# override $RULESFILE if given as option on the command line |
| 73 |
# change logfile |
# change logfile |
| 74 |
$LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR); |
$LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR); |
| 75 |
|
|
| 76 |
|
$USER ||= ''; |
| 77 |
|
|
| 78 |
|
|
| 79 |
|
|
| 80 |
# - - - - - - - - - - - - - - - - - - - - |
# - - - - - - - - - - - - - - - - - - - - |
| 81 |
# main |
# main |
| 84 |
# "jump" into processing of new incoming mail and get a "handler" to this mail |
# "jump" into processing of new incoming mail and get a "handler" to this mail |
| 85 |
my $incoming = Mail::Audit->new; |
my $incoming = Mail::Audit->new; |
| 86 |
|
|
| 87 |
|
sub traceEntry { |
| 88 |
|
s2f('-' x 40 . ' TRACE ' . '-' x 10); |
| 89 |
|
s2f("From: " . gchomp($incoming->from)); |
| 90 |
|
s2f("To: " . gchomp($incoming->to)); |
| 91 |
|
s2f("Subject: " . gchomp($incoming->subject)); |
| 92 |
|
s2f('-' x 40 . ' TRACE ' . '-' x 10); |
| 93 |
|
} |
| 94 |
|
|
| 95 |
|
|
| 96 |
# 0.a. pre flight tracing |
# 0.a. pre flight tracing |
| 97 |
if ($TRACE) { |
my $now = now(); |
| 98 |
s2f("-" x 80); |
report("$0 running at $now for user '$USER'."); |
| 99 |
s2f("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to)); |
traceEntry() if $TRACE; |
|
s2f("Subject: " . gchomp($incoming->subject)); |
|
|
} |
|
| 100 |
|
|
| 101 |
# 0.b. pre flight checks |
# 0.b. pre flight checks |
| 102 |
|
|
| 106 |
if (! -e $MAILDIR) { |
if (! -e $MAILDIR) { |
| 107 |
my $msg = "delivery failed, base directory $MAILDIR does not exist"; |
my $msg = "delivery failed, base directory $MAILDIR does not exist"; |
| 108 |
report($msg); |
report($msg); |
| 109 |
accept_spool(); |
forward_delivery(); |
| 110 |
} |
} |
| 111 |
|
|
| 112 |
# 1. include rules or fallback |
# 1. include rules or fallback |
| 113 |
# check if $RULESFILE exists |
# check if $RULESFILE exists |
| 114 |
if (-f $RULESFILE) { |
if (-f $RULESFILE) { |
| 115 |
report("loading rules from \"$RULESFILE\""); |
report("Loading rules from \"$RULESFILE\"."); |
| 116 |
require $RULESFILE; |
require $RULESFILE; |
| 117 |
} else { |
} else { |
| 118 |
#die("$RULESFILE doesn't exist"); |
#die("$RULESFILE doesn't exist"); |
| 119 |
report("configured rulesfile \"$RULESFILE\" doesn't exist"); |
report("Configured rulesfile \"$RULESFILE\" doesn't exist."); |
| 120 |
accept_spool(); |
forward_delivery(); |
| 121 |
} |
} |
| 122 |
|
|
| 123 |
# 2. export required stuff to rules namespace |
# 2. export required stuff to rules namespace |
| 124 |
export_symbols(); |
export_symbols(); |
| 125 |
|
|
| 126 |
# 3. run dispatcher |
# 3. run dispatcher |
| 127 |
report("running \"rules::dispatch\""); |
report("Running \"rules::dispatch\"."); |
| 128 |
rules::dispatch(); |
rules::dispatch(); |
| 129 |
|
|
| 130 |
# 4. dispatcher didn't do anything |
# 4. dispatcher didn't do anything |
| 158 |
# TODO: tracing, debugging |
# TODO: tracing, debugging |
| 159 |
|
|
| 160 |
print $msg, "\n" if $VERBOSE; |
print $msg, "\n" if $VERBOSE; |
| 161 |
if ($TRACE) { |
if ($LOG) { |
| 162 |
s2f($msg); |
s2f($msg); |
| 163 |
} |
} |
| 164 |
|
|
| 180 |
sub jaccept { |
sub jaccept { |
| 181 |
my $deliver_to = shift; |
my $deliver_to = shift; |
| 182 |
|
|
| 183 |
report("delivering to: $deliver_to"); |
report("ACCEPT: $deliver_to"); |
| 184 |
|
|
| 185 |
# check deliver_to path |
# check deliver_to path |
| 186 |
if (! -e $deliver_to) { |
if (! -e $deliver_to) { |
| 187 |
report("deliver_to path \"$deliver_to\" doesn't exist"); |
report("deliver_to path \"$deliver_to\" doesn't exist"); |
| 188 |
accept_spool(); |
forward_delivery(); |
| 189 |
return; |
return; |
| 190 |
} |
} |
| 191 |
|
|
| 198 |
$incoming->accept($path); |
$incoming->accept($path); |
| 199 |
} |
} |
| 200 |
|
|
| 201 |
|
sub forward_delivery { |
| 202 |
|
report("Forwarding delivery to next handler in queue (probably /var/spool/mail)."); |
| 203 |
|
$incoming->accept; |
| 204 |
|
} |
| 205 |
|
|
| 206 |
|
|
| 207 |
# - - - - - - - - - - - - - - - - - - - - |
# - - - - - - - - - - - - - - - - - - - - |
| 208 |
# helper functions |
# helper functions |