/[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.3 by joko, Wed Jan 22 07:55:43 2003 UTC revision 1.4 by root, Wed Jan 22 17:58:21 2003 UTC
# Line 9  Line 9 
9  #  #
10  # ============================================================  # ============================================================
11  #  $Log$  #  $Log$
12    #  Revision 1.4  2003/01/22 17:58:21  root
13    #  + fixed and enhanced many things
14    #  - refactored code to Data::Code
15    #
16  #  Revision 1.3  2003/01/22 07:55:43  joko  #  Revision 1.3  2003/01/22 07:55:43  joko
17  #  + replaced '$HOME' with '$self->{settings}->{HOME}'  #  + replaced '$HOME' with '$self->{settings}->{HOME}'
18  #  #
# Line 33  package Mail::Audit::Dispatch; Line 37  package Mail::Audit::Dispatch;
37  use strict;  use strict;
38  # don't use warnings;  # don't use warnings;
39    
40  use base qw( DesignPattern::Object );  use base qw(
41      DesignPattern::Object
42    );
43    #  DesignPattern::Object::Logger
44    
45    
46  use Mail::Audit;  use Mail::Audit;
47  use Data::Dumper;  use Data::Dumper;
48    
49    
50  use org::netfrag::shortcuts qw( now );  use Data::Code::Symbol qw( export_symbols );
51    use Data::Storage::Handler::File qw( a2f );
52    use org::netfrag::shortcuts qw( now get_chomped );
 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  
53    
54    
55  sub _init {  sub _init {
# Line 54  sub _init { Line 58  sub _init {
58    $self->_override_options();    $self->_override_options();
59    $self->_init_settings();    $self->_init_settings();
60    $self->_override_settings();    $self->_override_settings();
61    $self->_run();    #$self->_run();
62  }  }
63    
64  sub _init_options {  sub _init_options {
65    my $self = shift;    my $self = shift;
66    foreach (qw( base rules LOG VERBOSE TRACE )) {    foreach (qw( user base rules LOG VERBOSE TRACE )) {
67      $self->{options}->{$_} = $self->{$_};      $self->{options}->{$_} = $self->{$_};
68    }    }
69  }  }
# Line 70  sub _override_options { Line 74  sub _override_options {
74    $self->{options}->{base} ||= $ENV{PWD};    $self->{options}->{base} ||= $ENV{PWD};
75  }  }
76    
 # - - - - - - - - - - - - - - - - - - - -  
 #  
 #                targets  
 #  
 #  declare and initialize some variables  
 #      these are mostly base paths  
 #      mail should be delivered to  
 #  
 # - - - - - - - - - - - - - - - - - - - -  
77  sub _init_settings {  sub _init_settings {
78    my $self = shift;    my $self = shift;
79    $self->{settings}->{USER}      = $ENV{USER};    $self->{settings}->{USER} = $self->{options}->{user} if $self->{options}->{user};
80    $self->{settings}->{HOME}      = $self->{options}->{base};    $self->{settings}->{USER} ||= '';
81      $self->{settings}->{USER} ||= $ENV{USER};
82    
83      $self->{settings}->{HOME} = '../var/spool/mail/' . $self->{settings}->{USER};
84      $self->{settings}->{HOME} = $self->{options}->{base} if $self->{options}->{base};
85    
86      $self->_init_settings_paths();
87    }
88    
89    sub _init_settings_paths {
90      my $self = shift;
91    $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";    $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";
92    $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";    $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
93    #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";    #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
94    $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";    $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
95    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";
96      $self->{settings}->{ERRLOG}    = ".dispatchmail-errors.log";
97    $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";    $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";
98  }  }
99    
# Line 98  sub _override_settings { Line 104  sub _override_settings {
104        $self->{options}->{rules} if $self->{options}->{rules};        $self->{options}->{rules} if $self->{options}->{rules};
105    # change logfile    # change logfile
106      $self->{settings}->{LOGFILE} =      $self->{settings}->{LOGFILE} =
107        "recievemail-emerg.log" if (! -e $self->{settings}->{MAILDIR});        $self->{settings}->{ERRLOG} if (! -e $self->{settings}->{MAILDIR});
   
     $self->{settings}->{USER} ||= '';  
108  }  }
109    
110    
# Line 109  sub _override_settings { Line 113  sub _override_settings {
113  #                 main  #                 main
114  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
115    
116      sub traceEntry {
117        my $self = shift;
118        $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
119        $self->appendLog("From:    " . get_chomped($self->{incoming}->from));
120        $self->appendLog("To:      " . get_chomped($self->{incoming}->to));
121        $self->appendLog("Subject: " . get_chomped($self->{incoming}->subject));
122        $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
123      }
124    
125    
126  sub _run {  sub _run {
127    
128    my $self = shift;    my $self = shift;
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    
 }  
   
   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);  
   }  
   
   
133    # 0.a. pre flight tracing    # 0.a. pre flight tracing
134      my $now = now();      my $now = now();
135      report("$0 running at $now for user '$USER'.");      $self->report("$now - $0 running for user '$self->{settings}->{USER}'.");
136      traceEntry() if $self->{options}->{TRACE};      $self->traceEntry() if $self->{options}->{TRACE};
137    
138    # 0.b. pre flight checks    # 0.b. pre flight checks
139    
# Line 138  sub _run { Line 141  sub _run {
141    
142       # check if $self->{settings}->{HOME} exists       # check if $self->{settings}->{HOME} exists
143       if (! -e $self->{settings}->{MAILDIR}) {       if (! -e $self->{settings}->{MAILDIR}) {
144         my $msg = "delivery failed, base directory $self->{settings}->{MAILDIR} does not exist";         my $msg = "Delivery failed, base directory $self->{settings}->{MAILDIR} does not exist.";
145         report($msg);         $self->report($msg);
146         forward_delivery();         $self->forward_delivery();
147       }       }
148    
149    # 1. include rules or fallback    # 1. include rules or fallback
150      # check if $self->{settings}->{RULESFILE} exists      # check if $self->{settings}->{RULESFILE} exists
151      if (-f $self->{settings}->{RULESFILE}) {      if (-f $self->{settings}->{RULESFILE}) {
152        report("Loading rules from \"$self->{settings}->{RULESFILE}\".");        $self->report("Loading rules from \"$self->{settings}->{RULESFILE}\".");
153        require $self->{settings}->{RULESFILE};        require $self->{settings}->{RULESFILE};
154      } else {      } else {
155        #die("$self->{settings}->{RULESFILE} doesn't exist");        #die("$self->{settings}->{RULESFILE} doesn't exist");
156        report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");        $self->report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
157        forward_delivery();        $self->forward_delivery();
158      }      }
159    
160    # 2. export required stuff to rules namespace    # 2. export required stuff to rules namespace
161      export_symbols();      my @symbols = qw( jaccept report compareTarget );
162        export_symbols(\@symbols, 'rules');
163    
164    # 3. run dispatcher    # 3. run dispatcher
165      report("Running \"rules::dispatch\".");      $self->report("Running \"rules::dispatch\".");
166      rules::dispatch();      rules::dispatch($self);
167    
168    # 4. dispatcher didn't do anything    # 4. dispatcher didn't do anything
169      report("dispatcher could not apply any filter, using default delivery");      $self->report("dispatcher could not apply any filter, using default delivery");
170    
171      # 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"
172      # $self->{incoming}->accept();      # $self->{incoming}->accept();
# Line 171  sub _run { Line 175  sub _run {
175      # $self->{incoming}->reject;      # $self->{incoming}->reject;
176    
177      # catch all mails and route them to a "DEFAULT"-inbox      # catch all mails and route them to a "DEFAULT"-inbox
178      jaccept($self->{settings}->{DEFAULT});      $self->jaccept($self->{settings}->{DEFAULT});
   
179    
180    }
181    
182    sub run {
183      my $self = shift;
184      return $self->_run(@_);
185    }
186    
187    
188    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
189    #          tracing & reporting    #          tracing & reporting
190    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
191    sub s2f {    sub appendLog {
192      my $str = shift;      my $self = shift;
193      open(FH, '>>' . $self->{settings}->{LOGFILE});      my $msg = shift;
194      print FH $str, "\n";      a2f($self->{settings}->{LOGFILE}, $msg);
     close(FH);  
195    }    }
196    
197    sub report {    sub report {
198        my $self = shift;
199      my $msg = shift;          my $msg = shift;    
200      # TODO: tracing, debugging      # TODO: tracing, debugging
201    
202      print $msg, "\n" if $self->{options}->{VERBOSE};      #print STDERR $msg, "\n" if $self->{options}->{VERBOSE};
203      if ($LOG) {      if ($self->{options}->{LOG}) {
204        s2f($msg);        $self->appendLog($msg);
205      }      }
206    
207    }    }
# Line 203  sub _run { Line 211  sub _run {
211    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
212    
213    sub compareTarget {    sub compareTarget {
214        my $self = shift;
215      my $pattern = shift;      my $pattern = shift;
216      my $ok = 0;      my $ok = 0;
217      $ok = 1 if ($self->{incoming}->to =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
# Line 212  sub _run { Line 221  sub _run {
221    }    }
222    
223    sub jaccept {    sub jaccept {
224        my $self = shift;
225      my $deliver_to = shift;      my $deliver_to = shift;
226            
227      report("ACCEPT: $deliver_to");      $self->report("ACCEPT: $deliver_to");
228    
229      # check deliver_to path      # check deliver_to path
230      if (! -e $deliver_to) {      if (! -e $deliver_to) {
231        report("deliver_to path \"$deliver_to\" doesn't exist");        $self->report("deliver_to path \"$deliver_to\" doesn't exist");
232        forward_delivery();        $self->forward_delivery();
233        return;        return;
234      }      }
235    
# Line 227  sub _run { Line 237  sub _run {
237    }    }
238    
239    sub accept_spool {    sub accept_spool {
240      my $path = "/var/spool/mail/$USER";      my $self = shift;
241      report("defaulting to spool delivery ($path)");      my $path = "/var/spool/mail/$self->{settings}->{USER}";
242        $self->report("defaulting to spool delivery ($path)");
243      $self->{incoming}->accept($path);      $self->{incoming}->accept($path);
244    }    }
245    
246    sub forward_delivery {    sub forward_delivery {
247      report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");      my $self = shift;
248        $self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
249      $self->{incoming}->accept;      $self->{incoming}->accept;
250    }    }
251    
252    
 # - - - - - - - - - - - - - - - - - - - -  
 #             helper functions  
 # - - - - - - - - - - - - - - - - - - - -  
   
 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');  
   }  
   $rules::MAILDIR  = $self->{settings}->{MAILDIR};  
   $rules::incoming = $self->{incoming};  
 }  
   
 sub gchomp {  
   my $str = shift;  
   chomp($str);  
   return $str;  
 }  
   
253  1;  1;
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed