/[cvs]/nfo/perl/scripts/dispatchmail/bin/dispatchmail
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Wed Jan 22 07:16:51 2003 UTC (21 years, 11 months ago) by root
Branch: MAIN
Changes since 1.2: +45 -22 lines
+ sub traceEntry
+ further refactorings

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 RSS 2.0 feed