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

Diff of /nfo/perl/scripts/dispatchmail/bin/dispatchmail

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by collector, Wed Jan 22 05:07:56 2003 UTC revision 1.3 by root, Wed Jan 22 07:16:51 2003 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
3  # ==========================================================================  # ============================================================
4  #  #
5  # recieveMail v0.04  #  dispatchmail v0.05
6  #   a simple mail filter done in perl with CPAN-module "Mail::Audit"  #    A simple mail filter done in perl
7    #    with the Perl-module "Mail::Audit"
8    #    available from CPAN.
9  #  #
10    #  $Id$
11  #  #
12  # 2002-11-09, joko@netfrag.org  # ============================================================
13  #   + recieveMail now can run globally (/etc/mail/smrsh!)  #  $Log$
14  #     + $HOME is taken from $ENV{HOME} or $ENV{PWD}  #  Revision 1.3  2003/01/22 07:16:51  root
15  #     + rules are taken from $HOME/Mail/.rules.pm  #  + sub traceEntry
16  #     + fallback mechanism(s)  #  + further refactorings
 #   + bugfixes  
 #  
 # 2002-10-14, joko@netfrag.org  
 #   + $LOGFILE is used now (recievemail.log)  
 #   + tracing (uses $LOGFILE)  
 #   + checks delivery path for existance,  
 #     changes $LOGFILE if needed  
 #    
 # 2002-07-17, joko@netfrag.org  
 #   + added filtering by target (destination-routing)  
 #     (looks in "to", "cc" and "bcc")  
 #    
 # 2001-12-05, joko@netfrag.org  
 #   + initial internal release  
 #  
 #  
 # TODO:  
 #   - more sophisticated filtering  
 #   - configuration-comfort (use perl-arrays and -hashes for rule-declaration)  
 #   - Html-Gui to add/edit/remove rules  
 #   - rule base located in LDAP (local delivery routing)  
 #   - completely hide away regex-stuff and provide simpler wildcarding  
 #     - hide needed quoting of dots (.) and ats (@) in addresses  
 #     - provide: beginsWith(string), endsWith(string), beginsAt(string, pos|regex)  
 #       - this could become a CPAN-module sometimes (?):  
 #       - "String"-Object to be inherited from gives these methods to you  
 #       - examples:  
 #         - routeTo("mbox:/path/to/mbox") if $to->beginsWith("hello");  
 #         - routeTo("fax:+4930123456")    if $subject->contains("gatefax");  
 #   - metadata:  
 #     - add some info about the context we are running in:  
 #       - console  
 #       - sendmail/normal  
 #       - sendmail/smrsh  
 #     - add some info about the user we are doing this for:  
 #       - username  
 #       - home-directory  
 #  
 # WISHLIST:  
 #   - format basic log-output similar to procmail.log  
 #   - introduce some "extended logging" including the chosen routing path  
17  #  #
18  # ==========================================================================  #  Revision 1.2  2003/01/22 05:38:44  collector
19    #  + prepared refactoring to 'dispatchmail'
20    #
21    # ============================================================
22    
23  use strict;  use strict;
24  # don't use warnings;  # don't use warnings;
# Line 63  use Data::Dumper; Line 28  use Data::Dumper;
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  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
# Line 75  GetOptions( Line 45  GetOptions(
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  #  #
# Line 85  $opt_base ||= $ENV{PWD}; Line 58  $opt_base ||= $ENV{PWD};
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 = "$MAILDIR/.rules.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
# Line 103  my $VERBOSE = 1; Line 73  my $VERBOSE = 1;
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
# Line 111  my $VERBOSE = 1; Line 84  my $VERBOSE = 1;
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("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to));      report("$0 running at $now for user '$USER'.");
99        s2f("Subject: " . gchomp($incoming->subject));      traceEntry() if $TRACE;
     }  
100    
101    # 0.b. pre flight checks    # 0.b. pre flight checks
102    
# Line 125  my $VERBOSE = 1; Line 106  my $VERBOSE = 1;
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
# Line 177  my $VERBOSE = 1; Line 158  my $VERBOSE = 1;
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    
# Line 199  my $VERBOSE = 1; Line 180  my $VERBOSE = 1;
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    
# Line 217  my $VERBOSE = 1; Line 198  my $VERBOSE = 1;
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
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed