/[cvs]/nfo/perl/libs/Mail/Audit/Dispatch.pm
ViewVC logotype

Diff of /nfo/perl/libs/Mail/Audit/Dispatch.pm

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

revision 1.1 by root, Wed Jan 22 07:45:20 2003 UTC revision 1.5 by root, Thu Jan 30 23:20:21 2003 UTC
# Line 9  Line 9 
9  #  #
10  # ============================================================  # ============================================================
11  #  $Log$  #  $Log$
12    #  Revision 1.5  2003/01/30 23:20:21  root
13    #  + fixed and enhanced
14    #
15    #  Revision 1.4  2003/01/22 17:58:21  root
16    #  + fixed and enhanced many things
17    #  - refactored code to Data::Code
18    #
19    #  Revision 1.3  2003/01/22 07:55:43  joko
20    #  + replaced '$HOME' with '$self->{settings}->{HOME}'
21    #
22    #  Revision 1.2  2003/01/22 07:54:24  joko
23    #  + replaced global variables with class-variables
24    #
25  #  Revision 1.1  2003/01/22 07:45:20  root  #  Revision 1.1  2003/01/22 07:45:20  root
26  #  + initial check-in - refactored from 'dispatchmail'  #  + initial check-in - refactored from 'dispatchmail'
27  #  #
# Line 27  package Mail::Audit::Dispatch; Line 40  package Mail::Audit::Dispatch;
40  use strict;  use strict;
41  # don't use warnings;  # don't use warnings;
42    
43  use base qw( DesignPattern::Object );  use base qw(
44      DesignPattern::Object
45      DesignPattern::Bridge
46    );
47    #  DesignPattern::Object::Logger
48    
49    
50  use Mail::Audit;  use Mail::Audit;
51  use Data::Dumper;  use Data::Dumper;
52    
53    
54  use org::netfrag::shortcuts qw( now );  use Data::Code::Symbol qw( export_symbols );
55    use Data::Storage::Handler::File qw( a2f );
56    use org::netfrag::shortcuts qw( now get_chomped run_cmd );
 my $LOG     = 1;        # writes reports to logfile  
 my $VERBOSE = 1;        # writes reports to STDOUT  
 my $TRACE   = 1;        # writes contents of messages to logfile  
57    
58    
59  sub _init {  sub _init {
60    my $self = shift;    my $self = shift;
61    $self->_init_options();    $self->_init_options();
62      $self->_override_options();
63    $self->_init_settings();    $self->_init_settings();
64    $self->_override_settings();    $self->_override_settings();
65      #$self->_run();
66  }  }
67    
68  sub _init_options {  sub _init_options {
69    my $self = shift;    my $self = shift;
70    $self->{options}->{base}   = $self->{base};    foreach (qw( user base rules LOG VERBOSE TRACE mode newsgroup )) {
71        $self->{options}->{$_} = $self->{$_};
72      }
73    }
74    
75    sub _override_options {
76      my $self = shift;
77    $self->{options}->{base} ||= $ENV{HOME};    $self->{options}->{base} ||= $ENV{HOME};
78    $self->{options}->{base} ||= $ENV{PWD};    $self->{options}->{base} ||= $ENV{PWD};
   $self->{options}->{rules}   = $self->{rules};  
79  }  }
80    
81  # - - - - - - - - - - - - - - - - - - - -  sub _init_settings {
 #  
 #                targets  
 #  
 #  declare and initialize some variables  
 #      these are mostly base paths  
 #      mail should be delivered to  
 #  
 # - - - - - - - - - - - - - - - - - - - -  
 sub _init_paths {  
82    my $self = shift;    my $self = shift;
83    $self->{settings}->{USER}      = $ENV{USER};    $self->{settings}->{USER} = $self->{options}->{user} if $self->{options}->{user};
84    $self->{settings}->{HOME}      = $self->{options}->{base};    $self->{settings}->{USER} ||= '';
85    $self->{settings}->{MAILDIR}   = "$HOME/Mail";    $self->{settings}->{USER} ||= $ENV{USER};
86    $self->{settings}->{RULESFILE} = "$HOME/.dispatchmailrc.pm";  
87    #$self->{settings}->{LOCKFILE}  = "$HOME/.procmail.lockfile";    $self->{settings}->{HOME} = '../var/spool/mail/' . $self->{settings}->{USER};
88    $self->{settings}->{LOCKFILE}  = "$HOME/.dispatchmail.lockfile";    $self->{settings}->{HOME} = $self->{options}->{base} if $self->{options}->{base};
89    $self->{settings}->{LOGFILE}   = "$MAILDIR/.dispatchmail.log";  
90    $self->{settings}->{DEFAULT}   = "$MAILDIR/Inbox";    $self->_init_settings_paths();
91    }
92    
93    sub _init_settings_paths {
94      my $self = shift;
95      $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";
96      #$self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
97      $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc";
98      #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
99      $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
100      $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";
101      $self->{settings}->{ERRLOG}    = ".dispatchmail-errors.log";
102      $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";
103  }  }
104    
105  sub _override_settings {  sub _override_settings {
106    my $self = shift;    my $self = shift;
107    # override $RULESFILE if given as option on the command line    # override $self->{settings}->{RULESFILE} if given as option on the command line
108      $self->{settings}->{RULESFILE} =      $self->{settings}->{RULESFILE} =
109        $self->{options}->{rules} if $self->{options}->{rules};        $self->{options}->{rules} if $self->{options}->{rules};
110    # change logfile    # change logfile
111      $self->{settings}->{LOGFILE} =      $self->{settings}->{LOGFILE} =
112        "recievemail-emerg.log" if (! -e $self->{settings}->{MAILDIR});        $self->{settings}->{ERRLOG} if (! -e $self->{settings}->{MAILDIR});
   
     $self->{settings}->{USER} ||= '';  
113  }  }
114    
115    
# Line 96  sub _override_settings { Line 118  sub _override_settings {
118  #                 main  #                 main
119  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
120    
121    sub run {
122      my $self = shift;
123      
124      $self->{options}->{mode} ||= 'recieve';
125      my $call = '_' . $self->{options}->{mode};
126    
127    # "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
128    my $incoming = Mail::Audit->new;    $self->{incoming} = Mail::Audit->new();
129    
130    sub traceEntry {    my $result = $self->$call(@_);
131      s2f('-' x 40 . '  TRACE  ' . '-' x 10);    return $result;
132      s2f("From:    " . gchomp($incoming->from));  
133      s2f("To:      " . gchomp($incoming->to));  }
     s2f("Subject: " . gchomp($incoming->subject));  
     s2f('-' x 40 . '  TRACE  ' . '-' x 10);  
   }  
134    
135    sub _recieve {
136    
137      my $self = shift;
138      
139    # 0.a. pre flight tracing    # 0.a. pre flight tracing
140      my $now = now();      my $now = now();
141      report("$0 running at $now for user '$USER'.");      $self->report("$now - $0 running for user '$self->{settings}->{USER}'.");
142      traceEntry() if $TRACE;      $self->traceEntry() if $self->{options}->{TRACE};
143    
144    # 0.b. pre flight checks    # 0.b. pre flight checks
145    
146       # TODO: check if $HOME is empty       # TODO: check if $self->{settings}->{HOME} is empty
147    
148       # check if $HOME exists       # check if $self->{settings}->{HOME} exists
149       if (! -e $MAILDIR) {       if (! -e $self->{settings}->{MAILDIR}) {
150         my $msg = "delivery failed, base directory $MAILDIR does not exist";         my $msg = "ERROR: Delivery failed, base directory '$self->{settings}->{MAILDIR}' does not exist.";
151         report($msg);         $self->report($msg);
152         forward_delivery();         $self->forward_delivery();
153       }       }
154    
155    # 1. include rules or fallback    # 1. include rules or fallback
156      # check if $RULESFILE exists      # check if $self->{settings}->{RULESFILE} exists
157      if (-f $RULESFILE) {      if (-f $self->{settings}->{RULESFILE}) {
158        report("Loading rules from \"$RULESFILE\".");        $self->report("RULES:  Loading from \"$self->{settings}->{RULESFILE}\".");
159        require $RULESFILE;        require $self->{settings}->{RULESFILE};
160      } else {      } else {
161        #die("$RULESFILE doesn't exist");        #die("$self->{settings}->{RULESFILE} doesn't exist");
162        report("Configured rulesfile \"$RULESFILE\" doesn't exist.");        $self->report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
163        forward_delivery();        $self->forward_delivery();
164      }      }
165    
166    # 2. export required stuff to rules namespace    # 2. export required stuff to rules namespace
167      export_symbols();      my @symbols = qw( jaccept report compareTarget accept copy ignore );
168        export_symbols(\@symbols, 'rules');
169    
170    # 3. run dispatcher    # 3. run dispatcher
171      report("Running \"rules::dispatch\".");      $self->report("RULES:  Running Perl sub \"rules::dispatch\".");
172      rules::dispatch();      rules::dispatch($self);
173    
174    # 4. dispatcher didn't do anything    # 4. dispatcher didn't do anything
175      report("dispatcher could not apply any filter, using default delivery");      $self->report("dispatcher could not apply any filter, using default delivery");
176    
177      # the default-handler: simply accept all mails and route them to "/var/spool/mail"      # the default-handler: simply accept all mails and route them to "/var/spool/mail"
178      # $incoming->accept();      # $self->{incoming}->accept();
179    
180      # if you want to reject all mails coming through to here, do a ...      # if you want to reject all mails coming through to here, do a ...
181      # $incoming->reject;      # $self->{incoming}->reject;
182    
183      # catch all mails and route them to a "DEFAULT"-inbox      # catch all mails and route them to a "DEFAULT"-inbox
184      jaccept($DEFAULT);      $self->jaccept($self->{settings}->{DEFAULT});
185    
186    }
187    
188    
189    sub _mail2news {
190      my $self = shift;
191      $self->report("MAIL2NEWS: $self->{options}->{newsgroup}");
192      my $plugin = 'Newsgate';
193      $self->load($plugin);
194      $self->$plugin($self->{options}->{newsgroup});
195    }
196    
197    
198    
199    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
200    #          tracing & reporting    #          tracing & reporting
201    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
202    sub s2f {    sub traceEntry {
203      my $str = shift;      my $self = shift;
204      open(FH, '>>' . $LOGFILE);      $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
205      print FH $str, "\n";      $self->appendLog("From:    " . get_chomped($self->{incoming}->from));
206      close(FH);      $self->appendLog("To:      " . get_chomped($self->{incoming}->to));
207        $self->appendLog("Subject: " . get_chomped($self->{incoming}->subject));
208        $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
209      }
210    
211      sub appendLog {
212        my $self = shift;
213        my $msg = shift;
214        a2f($self->{settings}->{LOGFILE}, $msg);
215    }    }
216    
217    sub report {    sub report {
218        my $self = shift;
219      my $msg = shift;          my $msg = shift;    
220      # TODO: tracing, debugging      # TODO: tracing, debugging
221    
222      print $msg, "\n" if $VERBOSE;      #print STDERR $msg, "\n" if $self->{options}->{VERBOSE};
223      if ($LOG) {      if ($self->{options}->{LOG}) {
224        s2f($msg);        $self->appendLog($msg);
225      }      }
226    
227    }    }
# Line 184  sub _override_settings { Line 231  sub _override_settings {
231    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
232    
233    sub compareTarget {    sub compareTarget {
234        my $self = shift;
235      my $pattern = shift;      my $pattern = shift;
236      my $ok = 0;      my $ok = 0;
237      $ok = 1 if ($incoming->to =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
238      $ok = 1 if ($incoming->cc =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->cc =~ m/$pattern/);
239      $ok = 1 if ($incoming->bcc =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->bcc =~ m/$pattern/);
240      return $ok;      return $ok;
241    }    }
242    
243      sub accept_spool {
244        my $self = shift;
245        my $path = "/var/spool/mail/$self->{settings}->{USER}";
246        $self->report("defaulting to spool delivery ($path)");
247        $self->{incoming}->accept($path);
248      }
249    
250      sub forward_delivery {
251        my $self = shift;
252        $self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
253        return $self->{incoming}->accept;
254      }
255    
256    
257    sub jaccept {    sub jaccept {
258        my $self = shift;
259      my $deliver_to = shift;      my $deliver_to = shift;
260            
261      report("ACCEPT: $deliver_to");      $self->report("ACCEPT: $deliver_to");
262    
263      # check deliver_to path      # check deliver_to path
264      if (! -e $deliver_to) {      if (! -e $deliver_to) {
265        report("deliver_to path \"$deliver_to\" doesn't exist");        my $good = 0;
266        forward_delivery();        $self->report("ERROR:  TARGET Path/File doesn't exist.");
267        return;        if ($self->{settings}->{AUTOCREATE_FOLDERS}) {
268            my $cmd = "touch $deliver_to";
269            $self->report("TARGET: AUTOCREATE_FOLDERS is enabled: touching TARGET.");
270            #if (mkdir $deliver_to) {
271            run_cmd($cmd);
272            # re-test TARGET - for existance now
273            if (-e $deliver_to) {
274              $good = 1;
275            } else {
276              $self->report("ERROR:  TARGET creation failed (command was: '$cmd').");
277            }
278          }
279          if (!$good) {
280            $self->forward_delivery();
281            return;
282          }
283      }      }
284    
285      $incoming->accept($deliver_to);      return $self->{incoming}->accept($deliver_to);
286    }    }
287    
   sub accept_spool {  
     my $path = "/var/spool/mail/$USER";  
     report("defaulting to spool delivery ($path)");  
     $incoming->accept($path);  
   }  
288    
289    sub forward_delivery {    sub accept {
290      report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");      my $self = shift;
291      $incoming->accept;      return $self->jaccept(@_);
292    }    }
293    
294      sub copy {
295        my $self = shift;
296        my $plugin = shift;
297        my $deliver_to = shift;
298        
299        $self->report("COPY: $plugin: $deliver_to");
300    
301  # - - - - - - - - - - - - - - - - - - - -      $self->load($plugin);
302  #             helper functions      return $self->$plugin($deliver_to);
303  # - - - - - - - - - - - - - - - - - - - -    }
304    
305  sub get_coderef {    sub ignore {
306    my $codepack = shift;      my $self = shift;
307    my $method = shift;      $self->report("IGNORE");
308    $codepack || return '[error]';      return $self->{incoming}->ignore;
309    $method ||= '';    }
310    $method && ($codepack .= '::');  
311    return eval '\&' . $codepack . $method . ';';  1;
 }  
   
 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;  
 }  
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed