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