/[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.2 by joko, Wed Jan 22 07:54:24 2003 UTC
# Line 9  Line 9 
9  #  #
10  # ============================================================  # ============================================================
11  #  $Log$  #  $Log$
12    #  Revision 1.2  2003/01/22 07:54:24  joko
13    #  + replaced global variables with class-variables
14    #
15  #  Revision 1.1  2003/01/22 07:45:20  root  #  Revision 1.1  2003/01/22 07:45:20  root
16  #  + initial check-in - refactored from 'dispatchmail'  #  + initial check-in - refactored from 'dispatchmail'
17  #  #
# Line 38  use org::netfrag::shortcuts qw( now ); Line 41  use org::netfrag::shortcuts qw( now );
41    
42    
43  my $LOG     = 1;        # writes reports to logfile  my $LOG     = 1;        # writes reports to logfile
44  my $VERBOSE = 1;        # writes reports to STDOUT  my $self->{options}->{VERBOSE} = 1;     # writes reports to STDOUT
45  my $TRACE   = 1;        # writes contents of messages to logfile  my $self->{options}->{TRACE}   = 1;     # writes contents of messages to logfile
46    
47    
48  sub _init {  sub _init {
49    my $self = shift;    my $self = shift;
50    $self->_init_options();    $self->_init_options();
51      $self->_override_options();
52    $self->_init_settings();    $self->_init_settings();
53    $self->_override_settings();    $self->_override_settings();
54      $self->_run();
55  }  }
56    
57  sub _init_options {  sub _init_options {
58    my $self = shift;    my $self = shift;
59    $self->{options}->{base}   = $self->{base};    foreach (qw( base rules LOG VERBOSE TRACE )) {
60        $self->{options}->{$_} = $self->{$_};
61      }
62    }
63    
64    sub _override_options {
65      my $self = shift;
66    $self->{options}->{base} ||= $ENV{HOME};    $self->{options}->{base} ||= $ENV{HOME};
67    $self->{options}->{base} ||= $ENV{PWD};    $self->{options}->{base} ||= $ENV{PWD};
   $self->{options}->{rules}   = $self->{rules};  
68  }  }
69    
70  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
# Line 66  sub _init_options { Line 76  sub _init_options {
76  #      mail should be delivered to  #      mail should be delivered to
77  #  #
78  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
79  sub _init_paths {  sub _init_settings {
80    my $self = shift;    my $self = shift;
81    $self->{settings}->{USER}      = $ENV{USER};    $self->{settings}->{USER}      = $ENV{USER};
82    $self->{settings}->{HOME}      = $self->{options}->{base};    $self->{settings}->{HOME}      = $self->{options}->{base};
# Line 74  sub _init_paths { Line 84  sub _init_paths {
84    $self->{settings}->{RULESFILE} = "$HOME/.dispatchmailrc.pm";    $self->{settings}->{RULESFILE} = "$HOME/.dispatchmailrc.pm";
85    #$self->{settings}->{LOCKFILE}  = "$HOME/.procmail.lockfile";    #$self->{settings}->{LOCKFILE}  = "$HOME/.procmail.lockfile";
86    $self->{settings}->{LOCKFILE}  = "$HOME/.dispatchmail.lockfile";    $self->{settings}->{LOCKFILE}  = "$HOME/.dispatchmail.lockfile";
87    $self->{settings}->{LOGFILE}   = "$MAILDIR/.dispatchmail.log";    $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";
88    $self->{settings}->{DEFAULT}   = "$MAILDIR/Inbox";    $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";
89  }  }
90    
91  sub _override_settings {  sub _override_settings {
92    my $self = shift;    my $self = shift;
93    # override $RULESFILE if given as option on the command line    # override $self->{settings}->{RULESFILE} if given as option on the command line
94      $self->{settings}->{RULESFILE} =      $self->{settings}->{RULESFILE} =
95        $self->{options}->{rules} if $self->{options}->{rules};        $self->{options}->{rules} if $self->{options}->{rules};
96    # change logfile    # change logfile
# Line 96  sub _override_settings { Line 106  sub _override_settings {
106  #                 main  #                 main
107  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
108    
109    sub _run {
110      my $self = shift;
111      
112    # "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
113    my $incoming = Mail::Audit->new;    $self->{incoming} = Mail::Audit->new();
114    
115    }
116    
117    sub traceEntry {    sub traceEntry {
118      my $self = shift;
119      s2f('-' x 40 . '  TRACE  ' . '-' x 10);      s2f('-' x 40 . '  TRACE  ' . '-' x 10);
120      s2f("From:    " . gchomp($incoming->from));      s2f("From:    " . gchomp($self->{incoming}->from));
121      s2f("To:      " . gchomp($incoming->to));      s2f("To:      " . gchomp($self->{incoming}->to));
122      s2f("Subject: " . gchomp($incoming->subject));      s2f("Subject: " . gchomp($self->{incoming}->subject));
123      s2f('-' x 40 . '  TRACE  ' . '-' x 10);      s2f('-' x 40 . '  TRACE  ' . '-' x 10);
124    }    }
125    
# Line 111  sub _override_settings { Line 127  sub _override_settings {
127    # 0.a. pre flight tracing    # 0.a. pre flight tracing
128      my $now = now();      my $now = now();
129      report("$0 running at $now for user '$USER'.");      report("$0 running at $now for user '$USER'.");
130      traceEntry() if $TRACE;      traceEntry() if $self->{options}->{TRACE};
131    
132    # 0.b. pre flight checks    # 0.b. pre flight checks
133    
134       # TODO: check if $HOME is empty       # TODO: check if $HOME is empty
135    
136       # check if $HOME exists       # check if $HOME exists
137       if (! -e $MAILDIR) {       if (! -e $self->{settings}->{MAILDIR}) {
138         my $msg = "delivery failed, base directory $MAILDIR does not exist";         my $msg = "delivery failed, base directory $self->{settings}->{MAILDIR} does not exist";
139         report($msg);         report($msg);
140         forward_delivery();         forward_delivery();
141       }       }
142    
143    # 1. include rules or fallback    # 1. include rules or fallback
144      # check if $RULESFILE exists      # check if $self->{settings}->{RULESFILE} exists
145      if (-f $RULESFILE) {      if (-f $self->{settings}->{RULESFILE}) {
146        report("Loading rules from \"$RULESFILE\".");        report("Loading rules from \"$self->{settings}->{RULESFILE}\".");
147        require $RULESFILE;        require $self->{settings}->{RULESFILE};
148      } else {      } else {
149        #die("$RULESFILE doesn't exist");        #die("$self->{settings}->{RULESFILE} doesn't exist");
150        report("Configured rulesfile \"$RULESFILE\" doesn't exist.");        report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
151        forward_delivery();        forward_delivery();
152      }      }
153    
# Line 146  sub _override_settings { Line 162  sub _override_settings {
162      report("dispatcher could not apply any filter, using default delivery");      report("dispatcher could not apply any filter, using default delivery");
163    
164      # 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"
165      # $incoming->accept();      # $self->{incoming}->accept();
166    
167      # 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 ...
168      # $incoming->reject;      # $self->{incoming}->reject;
169    
170      # catch all mails and route them to a "DEFAULT"-inbox      # catch all mails and route them to a "DEFAULT"-inbox
171      jaccept($DEFAULT);      jaccept($self->{settings}->{DEFAULT});
172    
173    
174    
# Line 163  sub _override_settings { Line 179  sub _override_settings {
179    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
180    sub s2f {    sub s2f {
181      my $str = shift;      my $str = shift;
182      open(FH, '>>' . $LOGFILE);      open(FH, '>>' . $self->{settings}->{LOGFILE});
183      print FH $str, "\n";      print FH $str, "\n";
184      close(FH);      close(FH);
185    }    }
# Line 172  sub _override_settings { Line 188  sub _override_settings {
188      my $msg = shift;          my $msg = shift;    
189      # TODO: tracing, debugging      # TODO: tracing, debugging
190    
191      print $msg, "\n" if $VERBOSE;      print $msg, "\n" if $self->{options}->{VERBOSE};
192      if ($LOG) {      if ($LOG) {
193        s2f($msg);        s2f($msg);
194      }      }
# Line 186  sub _override_settings { Line 202  sub _override_settings {
202    sub compareTarget {    sub compareTarget {
203      my $pattern = shift;      my $pattern = shift;
204      my $ok = 0;      my $ok = 0;
205      $ok = 1 if ($incoming->to =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
206      $ok = 1 if ($incoming->cc =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->cc =~ m/$pattern/);
207      $ok = 1 if ($incoming->bcc =~ m/$pattern/);      $ok = 1 if ($self->{incoming}->bcc =~ m/$pattern/);
208      return $ok;      return $ok;
209    }    }
210    
# Line 204  sub _override_settings { Line 220  sub _override_settings {
220        return;        return;
221      }      }
222    
223      $incoming->accept($deliver_to);      $self->{incoming}->accept($deliver_to);
224    }    }
225    
226    sub accept_spool {    sub accept_spool {
227      my $path = "/var/spool/mail/$USER";      my $path = "/var/spool/mail/$USER";
228      report("defaulting to spool delivery ($path)");      report("defaulting to spool delivery ($path)");
229      $incoming->accept($path);      $self->{incoming}->accept($path);
230    }    }
231    
232    sub forward_delivery {    sub forward_delivery {
233      report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");      report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
234      $incoming->accept;      $self->{incoming}->accept;
235    }    }
236    
237    
# Line 245  sub export_symbols { Line 261  sub export_symbols {
261      *{"rules::report"}        = get_coderef('main', 'report');      *{"rules::report"}        = get_coderef('main', 'report');
262      *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');      *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
263    }    }
264    $rules::MAILDIR  = $MAILDIR;    $rules::MAILDIR  = $self->{settings}->{MAILDIR};
265    $rules::incoming = $incoming;    $rules::incoming = $self->{incoming};
266  }  }
267    
268  sub gchomp {  sub gchomp {
# Line 254  sub gchomp { Line 270  sub gchomp {
270    chomp($str);    chomp($str);
271    return $str;    return $str;
272  }  }
273    
274    1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed