/[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.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  #  Revision 1.4  2003/01/22 17:58:21  root
16  #  + fixed and enhanced many things  #  + fixed and enhanced many things
17  #  - refactored code to Data::Code  #  - refactored code to Data::Code
# Line 39  use strict; Line 42  use strict;
42    
43  use base qw(  use base qw(
44    DesignPattern::Object    DesignPattern::Object
45      DesignPattern::Bridge
46  );  );
47  #  DesignPattern::Object::Logger  #  DesignPattern::Object::Logger
48    
# Line 49  use Data::Dumper; Line 53  use Data::Dumper;
53    
54  use Data::Code::Symbol qw( export_symbols );  use Data::Code::Symbol qw( export_symbols );
55  use Data::Storage::Handler::File qw( a2f );  use Data::Storage::Handler::File qw( a2f );
56  use org::netfrag::shortcuts qw( now get_chomped );  use org::netfrag::shortcuts qw( now get_chomped run_cmd );
57    
58    
59  sub _init {  sub _init {
# Line 63  sub _init { Line 67  sub _init {
67    
68  sub _init_options {  sub _init_options {
69    my $self = shift;    my $self = shift;
70    foreach (qw( user base rules LOG VERBOSE TRACE )) {    foreach (qw( user base rules LOG VERBOSE TRACE mode newsgroup )) {
71      $self->{options}->{$_} = $self->{$_};      $self->{options}->{$_} = $self->{$_};
72    }    }
73  }  }
# Line 89  sub _init_settings { Line 93  sub _init_settings {
93  sub _init_settings_paths {  sub _init_settings_paths {
94    my $self = shift;    my $self = shift;
95    $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";    $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";
96    $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";    #$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";    #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
99    $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";    $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
100    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";
# Line 113  sub _override_settings { Line 118  sub _override_settings {
118  #                 main  #                 main
119  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
120    
121    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 {  
   
122    my $self = shift;    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    $self->{incoming} = Mail::Audit->new();    $self->{incoming} = Mail::Audit->new();
129    
130      my $result = $self->$call(@_);
131      return $result;
132    
133    }
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      $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 147  sub _run {
147    
148       # check if $self->{settings}->{HOME} exists       # check if $self->{settings}->{HOME} exists
149       if (! -e $self->{settings}->{MAILDIR}) {       if (! -e $self->{settings}->{MAILDIR}) {
150         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.";
151         $self->report($msg);         $self->report($msg);
152         $self->forward_delivery();         $self->forward_delivery();
153       }       }
# Line 149  sub _run { Line 155  sub _run {
155    # 1. include rules or fallback    # 1. include rules or fallback
156      # check if $self->{settings}->{RULESFILE} exists      # check if $self->{settings}->{RULESFILE} exists
157      if (-f $self->{settings}->{RULESFILE}) {      if (-f $self->{settings}->{RULESFILE}) {
158        $self->report("Loading rules from \"$self->{settings}->{RULESFILE}\".");        $self->report("RULES:  Loading from \"$self->{settings}->{RULESFILE}\".");
159        require $self->{settings}->{RULESFILE};        require $self->{settings}->{RULESFILE};
160      } else {      } else {
161        #die("$self->{settings}->{RULESFILE} doesn't exist");        #die("$self->{settings}->{RULESFILE} doesn't exist");
# Line 158  sub _run { Line 164  sub _run {
164      }      }
165    
166    # 2. export required stuff to rules namespace    # 2. export required stuff to rules namespace
167      my @symbols = qw( jaccept report compareTarget );      my @symbols = qw( jaccept report compareTarget accept copy ignore );
168      export_symbols(\@symbols, 'rules');      export_symbols(\@symbols, 'rules');
169    
170    # 3. run dispatcher    # 3. run dispatcher
171      $self->report("Running \"rules::dispatch\".");      $self->report("RULES:  Running Perl sub \"rules::dispatch\".");
172      rules::dispatch($self);      rules::dispatch($self);
173    
174    # 4. dispatcher didn't do anything    # 4. dispatcher didn't do anything
# Line 179  sub _run { Line 185  sub _run {
185    
186  }  }
187    
188  sub run {  
189    sub _mail2news {
190    my $self = shift;    my $self = shift;
191    return $self->_run(@_);    $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 traceEntry {
203        my $self = shift;
204        $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
205        $self->appendLog("From:    " . get_chomped($self->{incoming}->from));
206        $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 {    sub appendLog {
212      my $self = shift;      my $self = shift;
213      my $msg = shift;      my $msg = shift;
# Line 220  sub run { Line 240  sub run {
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;      my $self = shift;
259      my $deliver_to = shift;      my $deliver_to = shift;
# Line 228  sub run { Line 262  sub run {
262    
263      # check deliver_to path      # check deliver_to path
264      if (! -e $deliver_to) {      if (! -e $deliver_to) {
265        $self->report("deliver_to path \"$deliver_to\" doesn't exist");        my $good = 0;
266        $self->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      $self->{incoming}->accept($deliver_to);      return $self->{incoming}->accept($deliver_to);
286    }    }
287    
288    sub accept_spool {  
289      sub accept {
290      my $self = shift;      my $self = shift;
291      my $path = "/var/spool/mail/$self->{settings}->{USER}";      return $self->jaccept(@_);
     $self->report("defaulting to spool delivery ($path)");  
     $self->{incoming}->accept($path);  
292    }    }
293    
294    sub forward_delivery {    sub copy {
295      my $self = shift;      my $self = shift;
296      $self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");      my $plugin = shift;
297      $self->{incoming}->accept;      my $deliver_to = shift;
298        
299        $self->report("COPY: $plugin: $deliver_to");
300    
301        $self->load($plugin);
302        return $self->$plugin($deliver_to);
303    }    }
304    
305      sub ignore {
306        my $self = shift;
307        $self->report("IGNORE");
308        return $self->{incoming}->ignore;
309      }
310    
311  1;  1;
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed