/[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.4 by root, Wed Jan 22 17:58:21 2003 UTC revision 1.7 by root, Sun Mar 23 22:26:22 2003 UTC
# Line 9  Line 9 
9  #  #
10  # ============================================================  # ============================================================
11  #  $Log$  #  $Log$
12    #  Revision 1.7  2003/03/23 22:26:22  root
13    #  + header-field 'Message-ID' now included when tracing
14    #
15    #  Revision 1.6  2003/03/23 21:12:20  root
16    #  + sub jerror and related modifications
17    #
18    #  Revision 1.5  2003/01/30 23:20:21  root
19    #  + fixed and enhanced
20    #
21  #  Revision 1.4  2003/01/22 17:58:21  root  #  Revision 1.4  2003/01/22 17:58:21  root
22  #  + fixed and enhanced many things  #  + fixed and enhanced many things
23  #  - refactored code to Data::Code  #  - refactored code to Data::Code
# Line 39  use strict; Line 48  use strict;
48    
49  use base qw(  use base qw(
50    DesignPattern::Object    DesignPattern::Object
51      DesignPattern::Bridge
52  );  );
53  #  DesignPattern::Object::Logger  #  DesignPattern::Object::Logger
54    
# Line 49  use Data::Dumper; Line 59  use Data::Dumper;
59    
60  use Data::Code::Symbol qw( export_symbols );  use Data::Code::Symbol qw( export_symbols );
61  use Data::Storage::Handler::File qw( a2f );  use Data::Storage::Handler::File qw( a2f );
62  use org::netfrag::shortcuts qw( now get_chomped );  use org::netfrag::shortcuts qw( now get_chomped run_cmd );
63    
64    
65  sub _init {  sub _init {
# Line 63  sub _init { Line 73  sub _init {
73    
74  sub _init_options {  sub _init_options {
75    my $self = shift;    my $self = shift;
76    foreach (qw( user base rules LOG VERBOSE TRACE )) {    foreach (qw( user base rules LOG VERBOSE TRACE mode newsgroup )) {
77      $self->{options}->{$_} = $self->{$_};      $self->{options}->{$_} = $self->{$_};
78    }    }
79  }  }
# Line 89  sub _init_settings { Line 99  sub _init_settings {
99  sub _init_settings_paths {  sub _init_settings_paths {
100    my $self = shift;    my $self = shift;
101    $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";    $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";
102    $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";    #$self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
103      $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc";
104    #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";    #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
105    $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";    $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
106    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.mail-delivery.log";
107    $self->{settings}->{ERRLOG}    = ".dispatchmail-errors.log";    $self->{settings}->{ERRLOG}    = ".mail-delivery_errors.log";
108    $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";    $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";
109  }  }
110    
# Line 113  sub _override_settings { Line 124  sub _override_settings {
124  #                 main  #                 main
125  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
126    
127    sub traceEntry {  sub run {
     my $self = shift;  
     $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);  
     $self->appendLog("From:    " . get_chomped($self->{incoming}->from));  
     $self->appendLog("To:      " . get_chomped($self->{incoming}->to));  
     $self->appendLog("Subject: " . get_chomped($self->{incoming}->subject));  
     $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);  
   }  
   
   
 sub _run {  
   
128    my $self = shift;    my $self = shift;
129        
130      $self->{options}->{mode} ||= 'recieve';
131      my $call = '_' . $self->{options}->{mode};
132    
133    # "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
134    $self->{incoming} = Mail::Audit->new();    $self->{incoming} = Mail::Audit->new();
135    
136      my $result = $self->$call(@_);
137      return $result;
138    
139    }
140    
141    sub _recieve {
142    
143      my $self = shift;
144      
145    # 0.a. pre flight tracing    # 0.a. pre flight tracing
146      my $now = now();      my $now = now();
147      $self->report("$now - $0 running for user '$self->{settings}->{USER}'.");      $self->report("$now - $0 running for user '$self->{settings}->{USER}'.");
# Line 141  sub _run { Line 153  sub _run {
153    
154       # check if $self->{settings}->{HOME} exists       # check if $self->{settings}->{HOME} exists
155       if (! -e $self->{settings}->{MAILDIR}) {       if (! -e $self->{settings}->{MAILDIR}) {
156         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.";
157         $self->report($msg);         $self->jerror($msg);
        $self->forward_delivery();  
158       }       }
159    
160    # 1. include rules or fallback    # 1. include rules or fallback
161      # check if $self->{settings}->{RULESFILE} exists      # check if $self->{settings}->{RULESFILE} exists
162      if (-f $self->{settings}->{RULESFILE}) {      if (-f $self->{settings}->{RULESFILE}) {
163        $self->report("Loading rules from \"$self->{settings}->{RULESFILE}\".");        $self->report("RULES:  Loading from \"$self->{settings}->{RULESFILE}\".");
164        require $self->{settings}->{RULESFILE};        my $evalstr = "require '$self->{settings}->{RULESFILE}';";
165          eval($evalstr);
166          if ($@) {
167            my $msg = "ERROR:  Delivery failed, '$self->{settings}->{RULESFILE}' had syntax errors:\n$@";
168            $self->jerror($msg);
169          }
170      } else {      } else {
171        #die("$self->{settings}->{RULESFILE} doesn't exist");        #die("$self->{settings}->{RULESFILE} doesn't exist");
172        $self->report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");        $self->jerror("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
       $self->forward_delivery();  
173      }      }
174    
175    # 2. export required stuff to rules namespace    # 2. export required stuff to rules namespace
176      my @symbols = qw( jaccept report compareTarget );      my @symbols = qw( jaccept report compareTarget accept copy ignore );
177      export_symbols(\@symbols, 'rules');      export_symbols(\@symbols, 'rules');
178    
179    # 3. run dispatcher    # 3. run dispatcher
180      $self->report("Running \"rules::dispatch\".");      $self->report("RULES:  Running Perl sub \"rules::dispatch\".");
181      rules::dispatch($self);      rules::dispatch($self);
182    
183    # 4. dispatcher didn't do anything    # 4. dispatcher didn't do anything
# Line 179  sub _run { Line 194  sub _run {
194    
195  }  }
196    
197  sub run {  sub jerror {
198      my $self = shift;
199      my $msg = shift;
200      $self->report("ERROR: $msg");
201      $self->forward_delivery();
202    }
203    
204    sub _mail2news {
205    my $self = shift;    my $self = shift;
206    return $self->_run(@_);    $self->report("MAIL2NEWS: $self->{options}->{newsgroup}");
207      my $plugin = 'Newsgate';
208      $self->load($plugin);
209      $self->$plugin($self->{options}->{newsgroup});
210  }  }
211    
212    
213    
214    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
215    #          tracing & reporting    #          tracing & reporting
216    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
217      sub traceEntry {
218        my $self = shift;
219        $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
220        $self->appendLog("From:       " . get_chomped($self->{incoming}->from));
221        $self->appendLog("To:         " . get_chomped($self->{incoming}->to));
222        $self->appendLog("Subject:    " . get_chomped($self->{incoming}->subject));
223        $self->appendLog("Message-ID: " . get_chomped($self->{incoming}->get('Message-ID')));
224        $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
225      }
226    
227    sub appendLog {    sub appendLog {
228      my $self = shift;      my $self = shift;
229      my $msg = shift;      my $msg = shift;
# Line 220  sub run { Line 256  sub run {
256      return $ok;      return $ok;
257    }    }
258    
259      sub accept_spool {
260        my $self = shift;
261        my $path = "/var/spool/mail/$self->{settings}->{USER}";
262        $self->report("defaulting to spool delivery ($path)");
263        $self->{incoming}->accept($path);
264      }
265    
266      sub forward_delivery {
267        my $self = shift;
268        $self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
269        return $self->{incoming}->accept;
270      }
271    
272    
273    sub jaccept {    sub jaccept {
274      my $self = shift;      my $self = shift;
275      my $deliver_to = shift;      my $deliver_to = shift;
# Line 228  sub run { Line 278  sub run {
278    
279      # check deliver_to path      # check deliver_to path
280      if (! -e $deliver_to) {      if (! -e $deliver_to) {
281        $self->report("deliver_to path \"$deliver_to\" doesn't exist");        my $good = 0;
282        $self->forward_delivery();        $self->report("ERROR:  TARGET Path/File doesn't exist.");
283        return;        if ($self->{settings}->{AUTOCREATE_FOLDERS}) {
284            my $cmd = "touch $deliver_to";
285            $self->report("TARGET: AUTOCREATE_FOLDERS is enabled: touching TARGET.");
286            #if (mkdir $deliver_to) {
287            run_cmd($cmd);
288            # re-test TARGET - for existance now
289            if (-e $deliver_to) {
290              $good = 1;
291            } else {
292              $self->report("ERROR:  TARGET creation failed (command was: '$cmd').");
293            }
294          }
295          if (!$good) {
296            $self->forward_delivery();
297            return;
298          }
299      }      }
300    
301      $self->{incoming}->accept($deliver_to);      return $self->{incoming}->accept($deliver_to);
302    }    }
303    
304    sub accept_spool {  
305      sub accept {
306      my $self = shift;      my $self = shift;
307      my $path = "/var/spool/mail/$self->{settings}->{USER}";      return $self->jaccept(@_);
     $self->report("defaulting to spool delivery ($path)");  
     $self->{incoming}->accept($path);  
308    }    }
309    
310    sub forward_delivery {    sub copy {
311      my $self = shift;      my $self = shift;
312      $self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");      my $plugin = shift;
313      $self->{incoming}->accept;      my $deliver_to = shift;
314        
315        $self->report("COPY: $plugin: $deliver_to");
316    
317        $self->load($plugin);
318        return $self->$plugin($deliver_to);
319    }    }
320    
321      sub ignore {
322        my $self = shift;
323        $self->report("IGNORE");
324        return $self->{incoming}->ignore;
325      }
326    
327  1;  1;
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed