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