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

Contents of /nfo/perl/scripts/dispatchmail/recieveMail

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Wed Jan 22 05:11:01 2003 UTC (21 years, 11 months ago) by collector
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +0 -0 lines
FILE REMOVED
- moved to bin/ and doc/

1 #!/usr/bin/perl
2
3 # ==========================================================================
4 #
5 # recieveMail v0.04
6 # a simple mail filter done in perl with CPAN-module "Mail::Audit"
7 #
8 #
9 # 2002-11-09, joko@netfrag.org
10 # + recieveMail now can run globally (/etc/mail/smrsh!)
11 # + $HOME is taken from $ENV{HOME} or $ENV{PWD}
12 # + rules are taken from $HOME/Mail/.rules.pm
13 # + fallback mechanism(s)
14 # + bugfixes
15 #
16 # 2002-10-14, joko@netfrag.org
17 # + $LOGFILE is used now (recievemail.log)
18 # + tracing (uses $LOGFILE)
19 # + checks delivery path for existance,
20 # changes $LOGFILE if needed
21 #
22 # 2002-07-17, joko@netfrag.org
23 # + added filtering by target (destination-routing)
24 # (looks in "to", "cc" and "bcc")
25 #
26 # 2001-12-05, joko@netfrag.org
27 # + initial internal release
28 #
29 #
30 # TODO:
31 # - more sophisticated filtering
32 # - configuration-comfort (use perl-arrays and -hashes for rule-declaration)
33 # - Html-Gui to add/edit/remove rules
34 # - rule base located in LDAP (local delivery routing)
35 # - completely hide away regex-stuff and provide simpler wildcarding
36 # - hide needed quoting of dots (.) and ats (@) in addresses
37 # - provide: beginsWith(string), endsWith(string), beginsAt(string, pos|regex)
38 # - this could become a CPAN-module sometimes (?):
39 # - "String"-Object to be inherited from gives these methods to you
40 # - examples:
41 # - routeTo("mbox:/path/to/mbox") if $to->beginsWith("hello");
42 # - routeTo("fax:+4930123456") if $subject->contains("gatefax");
43 # - metadata:
44 # - add some info about the context we are running in:
45 # - console
46 # - sendmail/normal
47 # - sendmail/smrsh
48 # - add some info about the user we are doing this for:
49 # - username
50 # - home-directory
51 #
52 # ==========================================================================
53
54 use strict;
55 # don't use warnings;
56
57 use Mail::Audit;
58 use Data::Dumper;
59 use Getopt::Long;
60
61
62 # - - - - - - - - - - - - - - - - - - - -
63 # options
64 # - - - - - - - - - - - - - - - - - - - -
65 my $opt_base = '';
66 my $opt_rulesfile = '';
67 GetOptions(
68 'base=s' => \$opt_base,
69 'rules=s' => \$opt_rulesfile,
70 );
71 $opt_base ||= $ENV{HOME};
72 $opt_base ||= $ENV{PWD};
73
74
75 # - - - - - - - - - - - - - - - - - - - -
76 #
77 # targets
78 #
79 # declare and initialize some variables
80 # these are mostly base paths
81 # mail should be delivered to
82 #
83 # - - - - - - - - - - - - - - - - - - - -
84 #my $HOME = "/home/joko/virtual/joko_mail";
85 my $USER = $ENV{USER};
86 my $HOME = $opt_base;
87 my $MAILDIR = "$HOME/Mail";
88 my $LOGFILE = "$MAILDIR/recievemail.log";
89 my $RULESFILE = "$MAILDIR/.rules.pm";
90 my $LOCKFILE = "$HOME/.procmail.lockfile";
91 my $DEFAULT = "$MAILDIR/Inbox";
92 my $DEBUG = 0;
93 my $TRACE = 1;
94 my $VERBOSE = 1;
95
96 # override settings
97 # override $RULESFILE if given as option on the command line
98 $RULESFILE = $opt_rulesfile if ($opt_rulesfile);
99 # change logfile
100 $LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);
101
102
103 # - - - - - - - - - - - - - - - - - - - -
104 # main
105 # - - - - - - - - - - - - - - - - - - - -
106
107 # "jump" into processing of new incoming mail and get a "handler" to this mail
108 my $incoming = Mail::Audit->new;
109
110 # 0.a. pre flight tracing
111 if ($TRACE) {
112 s2f("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to));
113 s2f("Subject: " . gchomp($incoming->subject));
114 }
115
116 # 0.b. pre flight checks
117
118 # TODO: check if $HOME is empty
119
120 # check if $HOME exists
121 if (! -e $MAILDIR) {
122 my $msg = "delivery failed, base directory $MAILDIR does not exist";
123 report($msg);
124 accept_spool();
125 }
126
127 # 1. include rules or fallback
128 # check if $RULESFILE exists
129 if (-f $RULESFILE) {
130 report("loading rules from \"$RULESFILE\"");
131 require $RULESFILE;
132 } else {
133 #die("$RULESFILE doesn't exist");
134 report("configured rulesfile \"$RULESFILE\" doesn't exist");
135 accept_spool();
136 }
137
138 # 2. export required stuff to rules namespace
139 export_symbols();
140
141 # 3. run dispatcher
142 report("running \"rules::dispatch\"");
143 rules::dispatch();
144
145 # 4. dispatcher didn't do anything
146 report("dispatcher could not apply any filter, using default delivery");
147
148 # the default-handler: simply accept all mails and route them to "/var/spool/mail"
149 # $incoming->accept();
150
151 # if you want to reject all mails coming through to here, do a ...
152 # $incoming->reject;
153
154 # catch all mails and route them to a "DEFAULT"-inbox
155 jaccept($DEFAULT);
156
157
158
159
160
161 # - - - - - - - - - - - - - - - - - - - -
162 # tracing & reporting
163 # - - - - - - - - - - - - - - - - - - - -
164 sub s2f {
165 my $str = shift;
166 open(FH, '>>' . $LOGFILE);
167 print FH $str, "\n";
168 close(FH);
169 }
170
171 sub report {
172 my $msg = shift;
173 # TODO: tracing, debugging
174
175 print $msg, "\n" if $VERBOSE;
176 if ($TRACE) {
177 s2f($msg);
178 }
179
180 }
181
182 # - - - - - - - - - - - - - - - - - - - -
183 # processing mail
184 # - - - - - - - - - - - - - - - - - - - -
185
186 sub compareTarget {
187 my $pattern = shift;
188 my $ok = 0;
189 $ok = 1 if ($incoming->to =~ m/$pattern/);
190 $ok = 1 if ($incoming->cc =~ m/$pattern/);
191 $ok = 1 if ($incoming->bcc =~ m/$pattern/);
192 return $ok;
193 }
194
195 sub jaccept {
196 my $deliver_to = shift;
197
198 report("delivering to: $deliver_to");
199
200 # check deliver_to path
201 if (! -e $deliver_to) {
202 report("deliver_to path \"$deliver_to\" doesn't exist");
203 accept_spool();
204 return;
205 }
206
207 $incoming->accept($deliver_to);
208 }
209
210 sub accept_spool {
211 my $path = "/var/spool/mail/$USER";
212 report("defaulting to spool delivery ($path)");
213 $incoming->accept($path);
214 }
215
216
217 # - - - - - - - - - - - - - - - - - - - -
218 # helper functions
219 # - - - - - - - - - - - - - - - - - - - -
220
221 sub get_coderef {
222 my $codepack = shift;
223 my $method = shift;
224 $codepack || return '[error]';
225 $method ||= '';
226 $method && ($codepack .= '::');
227 return eval '\&' . $codepack . $method . ';';
228 }
229
230 sub export_symbols {
231 # my $callpack = 'rules';
232 # my @EXPORT = qw( incoming subject MAILDIR jaccept );
233 # foreach my $sym (@EXPORT) {
234 no strict 'refs';
235 # *{"${callpack}::$sym"} = get_coderef('main', $sym);
236 # }
237 {
238 no strict 'refs';
239 *{"rules::jaccept"} = get_coderef('main', 'jaccept');
240 *{"rules::report"} = get_coderef('main', 'report');
241 *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
242 }
243 $rules::MAILDIR = $MAILDIR;
244 $rules::incoming = $incoming;
245 }
246
247 sub gchomp {
248 my $str = shift;
249 chomp($str);
250 return $str;
251 }

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed