Annotation of /nfo/perl/scripts/dispatchmail/bin/dispatchmail

#!/usr/bin/perl

# ============================================================
#
#  dispatchmail v0.05
#    A simple mail filter done in perl 
#    with the Perl-module "Mail::Audit" 
#    available from CPAN.
#
#  $Id: dispatchmail,v 1.2 2003/01/22 05:38:44 collector Exp $
#
# ============================================================
#  $Log: dispatchmail,v $
#  Revision 1.2  2003/01/22 05:38:44  collector
#  + prepared refactoring to 'dispatchmail'
#
# ============================================================

use strict;
# don't use warnings;

use Mail::Audit;
use Data::Dumper;
use Getopt::Long;


use lib qw( /data/libs/nfo/perl/libs );
use org::netfrag::shortcuts qw( now );


# - - - - - - - - - - - - - - - - - - - -
#               options
# - - - - - - - - - - - - - - - - - - - -
my $opt_base      = '';
my $opt_rulesfile = '';
GetOptions(
  'base=s'  => \$opt_base,
  'rules=s' => \$opt_rulesfile,
);
$opt_base ||= $ENV{HOME};
$opt_base ||= $ENV{PWD};

my $LOG     = 1;        # writes reports to logfile
my $VERBOSE = 1;        # writes reports to STDOUT
my $TRACE   = 1;        # writes contents of messages to logfile

# - - - - - - - - - - - - - - - - - - - -
#
#                targets
#
#  declare and initialize some variables
#      these are mostly base paths
#      mail should be delivered to
#
# - - - - - - - - - - - - - - - - - - - -
my $USER      = $ENV{USER};
my $HOME      = $opt_base;
my $MAILDIR   = "$HOME/Mail";
my $RULESFILE = "$HOME/.dispatchmailrc.pm";
#my $LOCKFILE  = "$HOME/.procmail.lockfile";
my $LOCKFILE  = "$HOME/.dispatchmail.lockfile";
my $LOGFILE   = "$MAILDIR/.dispatchmail.log";
my $DEFAULT   = "$MAILDIR/Inbox";

# override settings
  # override $RULESFILE if given as option on the command line
  $RULESFILE = $opt_rulesfile if ($opt_rulesfile);
  # change logfile
  $LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);

  $USER ||= '';


# - - - - - - - - - - - - - - - - - - - -
#                 main
# - - - - - - - - - - - - - - - - - - - -

  # "jump" into processing of new incoming mail and get a "handler" to this mail
  my $incoming = Mail::Audit->new;

  sub traceEntry {
    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
    s2f("From:    " . gchomp($incoming->from));
    s2f("To:      " . gchomp($incoming->to));
    s2f("Subject: " . gchomp($incoming->subject));
    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
  }


  # 0.a. pre flight tracing
    my $now = now();
    report("$0 running at $now for user '$USER'.");
    traceEntry() if $TRACE;

  # 0.b. pre flight checks

     # TODO: check if $HOME is empty

     # check if $HOME exists
     if (! -e $MAILDIR) {
       my $msg = "delivery failed, base directory $MAILDIR does not exist";
       report($msg);
       forward_delivery();
     }

  # 1. include rules or fallback
    # check if $RULESFILE exists
    if (-f $RULESFILE) {
      report("Loading rules from \"$RULESFILE\".");
      require $RULESFILE;
    } else {
      #die("$RULESFILE doesn't exist");
      report("Configured rulesfile \"$RULESFILE\" doesn't exist.");
      forward_delivery();
    }

  # 2. export required stuff to rules namespace
    export_symbols();

  # 3. run dispatcher
    report("Running \"rules::dispatch\".");
    rules::dispatch();

  # 4. dispatcher didn't do anything
    report("dispatcher could not apply any filter, using default delivery");

    # the default-handler: simply accept all mails and route them to "/var/spool/mail"
    # $incoming->accept();

    # if you want to reject all mails coming through to here, do a ...
    # $incoming->reject;

    # catch all mails and route them to a "DEFAULT"-inbox
    jaccept($DEFAULT);


  # - - - - - - - - - - - - - - - - - - - -
  #          tracing & reporting
  # - - - - - - - - - - - - - - - - - - - -
  sub s2f {
    my $str = shift;
    open(FH, '>>' . $LOGFILE);
    print FH $str, "\n";
    close(FH);
  }

  sub report {
    my $msg = shift;    
    # TODO: tracing, debugging

    print $msg, "\n" if $VERBOSE;
    if ($LOG) {
      s2f($msg);
    }

  }

  # - - - - - - - - - - - - - - - - - - - -
  #             processing mail
  # - - - - - - - - - - - - - - - - - - - -

  sub compareTarget {
    my $pattern = shift;
    my $ok = 0;
    $ok = 1 if ($incoming->to =~ m/$pattern/);
    $ok = 1 if ($incoming->cc =~ m/$pattern/);
    $ok = 1 if ($incoming->bcc =~ m/$pattern/);
    return $ok;
  }

  sub jaccept {
    my $deliver_to = shift;
    
    report("ACCEPT: $deliver_to");

    # check deliver_to path
    if (! -e $deliver_to) {
      report("deliver_to path \"$deliver_to\" doesn't exist");
      forward_delivery();
      return;
    }

    $incoming->accept($deliver_to);
  }

  sub accept_spool {
    my $path = "/var/spool/mail/$USER";
    report("defaulting to spool delivery ($path)");
    $incoming->accept($path);
  }

  sub forward_delivery {
    report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
    $incoming->accept;
  }


# - - - - - - - - - - - - - - - - - - - -
#             helper functions
# - - - - - - - - - - - - - - - - - - - -

sub get_coderef {
  my $codepack = shift;
  my $method = shift;
  $codepack || return '[error]';
  $method ||= '';
  $method && ($codepack .= '::');
  return eval '\&' . $codepack . $method . ';';
}

sub export_symbols {
  #  my $callpack = 'rules';
  #  my @EXPORT = qw( incoming subject MAILDIR jaccept );
  #  foreach my $sym (@EXPORT) {
      no strict 'refs';
  #    *{"${callpack}::$sym"} = get_coderef('main', $sym);
  #  }
  {
    no strict 'refs';
    *{"rules::jaccept"}       = get_coderef('main', 'jaccept');
    *{"rules::report"}        = get_coderef('main', 'report');
    *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
  }
  $rules::MAILDIR  = $MAILDIR;
  $rules::incoming = $incoming;
}

sub gchomp {
  my $str = shift;
  chomp($str);
  return $str;
}
1	collector	1.1	#!/usr/bin/perl
2
3	collector	1.2	# ============================================================
4	collector	1.1	#
5	collector	1.2	# dispatchmail v0.05
6			# A simple mail filter done in perl
7			# with the Perl-module "Mail::Audit"
8			# available from CPAN.
9			#
10	root	1.3	# $Id: dispatchmail,v 1.2 2003/01/22 05:38:44 collector Exp $
11	collector	1.2	#
12			# ============================================================
13	root	1.3	# $Log: dispatchmail,v $
14			# Revision 1.2 2003/01/22 05:38:44 collector
15			# + prepared refactoring to 'dispatchmail'
16			#
17	collector	1.2	# ============================================================
18	collector	1.1
19			use strict;
20			# don't use warnings;
21
22			use Mail::Audit;
23			use Data::Dumper;
24			use Getopt::Long;
25
26
27	root	1.3	use lib qw( /data/libs/nfo/perl/libs );
28			use org::netfrag::shortcuts qw( now );
29
30
31
32	collector	1.1	# - - - - - - - - - - - - - - - - - - - -
33			# options
34			# - - - - - - - - - - - - - - - - - - - -
35			my $opt_base = '';
36			my $opt_rulesfile = '';
37			GetOptions(
38			'base=s' => \$opt_base,
39			'rules=s' => \$opt_rulesfile,
40			);
41			$opt_base \|\|= $ENV{HOME};
42			$opt_base \|\|= $ENV{PWD};
43
44	root	1.3	my $LOG = 1; # writes reports to logfile
45			my $VERBOSE = 1; # writes reports to STDOUT
46			my $TRACE = 1; # writes contents of messages to logfile
47	collector	1.1
48			# - - - - - - - - - - - - - - - - - - - -
49			#
50			# targets
51			#
52			# declare and initialize some variables
53			# these are mostly base paths
54			# mail should be delivered to
55			#
56			# - - - - - - - - - - - - - - - - - - - -
57			my $USER = $ENV{USER};
58			my $HOME = $opt_base;
59			my $MAILDIR = "$HOME/Mail";
60	root	1.3	my $RULESFILE = "$HOME/.dispatchmailrc.pm";
61			#my $LOCKFILE = "$HOME/.procmail.lockfile";
62			my $LOCKFILE = "$HOME/.dispatchmail.lockfile";
63			my $LOGFILE = "$MAILDIR/.dispatchmail.log";
64	collector	1.1	my $DEFAULT = "$MAILDIR/Inbox";
65
66			# override settings
67			# override $RULESFILE if given as option on the command line
68			$RULESFILE = $opt_rulesfile if ($opt_rulesfile);
69			# change logfile
70			$LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);
71
72	root	1.3	$USER \|\|= '';
73
74
75	collector	1.1
76			# - - - - - - - - - - - - - - - - - - - -
77			# main
78			# - - - - - - - - - - - - - - - - - - - -
79
80			# "jump" into processing of new incoming mail and get a "handler" to this mail
81			my $incoming = Mail::Audit->new;
82
83	root	1.3	sub traceEntry {
84			s2f('-' x 40 . ' TRACE ' . '-' x 10);
85			s2f("From: " . gchomp($incoming->from));
86			s2f("To: " . gchomp($incoming->to));
87			s2f("Subject: " . gchomp($incoming->subject));
88			s2f('-' x 40 . ' TRACE ' . '-' x 10);
89			}
90
91
92	collector	1.1	# 0.a. pre flight tracing
93	root	1.3	my $now = now();
94			report("$0 running at $now for user '$USER'.");
95			traceEntry() if $TRACE;
96	collector	1.1
97			# 0.b. pre flight checks
98
99			# TODO: check if $HOME is empty
100
101			# check if $HOME exists
102			if (! -e $MAILDIR) {
103			my $msg = "delivery failed, base directory $MAILDIR does not exist";
104			report($msg);
105	root	1.3	forward_delivery();
106	collector	1.1	}
107
108			# 1. include rules or fallback
109			# check if $RULESFILE exists
110			if (-f $RULESFILE) {
111	root	1.3	report("Loading rules from \"$RULESFILE\".");
112	collector	1.1	require $RULESFILE;
113			} else {
114			#die("$RULESFILE doesn't exist");
115	root	1.3	report("Configured rulesfile \"$RULESFILE\" doesn't exist.");
116			forward_delivery();
117	collector	1.1	}
118
119			# 2. export required stuff to rules namespace
120			export_symbols();
121
122			# 3. run dispatcher
123	root	1.3	report("Running \"rules::dispatch\".");
124	collector	1.1	rules::dispatch();
125
126			# 4. dispatcher didn't do anything
127			report("dispatcher could not apply any filter, using default delivery");
128
129			# the default-handler: simply accept all mails and route them to "/var/spool/mail"
130			# $incoming->accept();
131
132			# if you want to reject all mails coming through to here, do a ...
133			# $incoming->reject;
134
135			# catch all mails and route them to a "DEFAULT"-inbox
136			jaccept($DEFAULT);
137
138
139
140
141
142			# - - - - - - - - - - - - - - - - - - - -
143			# tracing & reporting
144			# - - - - - - - - - - - - - - - - - - - -
145			sub s2f {
146			my $str = shift;
147			open(FH, '>>' . $LOGFILE);
148			print FH $str, "\n";
149			close(FH);
150			}
151
152			sub report {
153			my $msg = shift;
154			# TODO: tracing, debugging
155
156			print $msg, "\n" if $VERBOSE;
157	root	1.3	if ($LOG) {
158	collector	1.1	s2f($msg);
159			}
160
161			}
162
163			# - - - - - - - - - - - - - - - - - - - -
164			# processing mail
165			# - - - - - - - - - - - - - - - - - - - -
166
167			sub compareTarget {
168			my $pattern = shift;
169			my $ok = 0;
170			$ok = 1 if ($incoming->to =~ m/$pattern/);
171			$ok = 1 if ($incoming->cc =~ m/$pattern/);
172			$ok = 1 if ($incoming->bcc =~ m/$pattern/);
173			return $ok;
174			}
175
176			sub jaccept {
177			my $deliver_to = shift;
178
179	root	1.3	report("ACCEPT: $deliver_to");
180	collector	1.1
181			# check deliver_to path
182			if (! -e $deliver_to) {
183			report("deliver_to path \"$deliver_to\" doesn't exist");
184	root	1.3	forward_delivery();
185	collector	1.1	return;
186			}
187
188			$incoming->accept($deliver_to);
189			}
190
191			sub accept_spool {
192			my $path = "/var/spool/mail/$USER";
193			report("defaulting to spool delivery ($path)");
194			$incoming->accept($path);
195	root	1.3	}
196
197			sub forward_delivery {
198			report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
199			$incoming->accept;
200	collector	1.1	}
201
202
203			# - - - - - - - - - - - - - - - - - - - -
204			# helper functions
205			# - - - - - - - - - - - - - - - - - - - -
206
207			sub get_coderef {
208			my $codepack = shift;
209			my $method = shift;
210			$codepack \|\| return '[error]';
211			$method \|\|= '';
212			$method && ($codepack .= '::');
213			return eval '\&' . $codepack . $method . ';';
214			}
215
216			sub export_symbols {
217			# my $callpack = 'rules';
218			# my @EXPORT = qw( incoming subject MAILDIR jaccept );
219			# foreach my $sym (@EXPORT) {
220			no strict 'refs';
221			# *{"${callpack}::$sym"} = get_coderef('main', $sym);
222			# }
223			{
224			no strict 'refs';
225			*{"rules::jaccept"} = get_coderef('main', 'jaccept');
226			*{"rules::report"} = get_coderef('main', 'report');
227			*{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
228			}
229			$rules::MAILDIR = $MAILDIR;
230			$rules::incoming = $incoming;
231			}
232
233			sub gchomp {
234			my $str = shift;
235			chomp($str);
236			return $str;
237			}
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26