File Coverage

lib/Mail/Toaster.pm
Criterion Covered Total %
statement 164 641 25.5
branch 42 408 10.2
condition 11 108 10.1
subroutine 32 72 44.4
pod 21 56 37.5
total 270 1285 21.0


line stmt bran cond sub pod time code
1             package Mail::Toaster;
2              
3 7     7   53056 use strict;
  7         8  
  7         168  
4 7     7   24 use warnings;
  7         7  
  7         230  
5              
6             our $VERSION = '5.52';
7              
8 7     7   24 use Carp;
  7         6  
  7         335  
9 7     7   23 use Cwd;
  7         6  
  7         321  
10             #use Data::Dumper;
11 7     7   25 use English '-no_match_vars';
  7         11  
  7         49  
12 7     7   2178 use File::Basename;
  7         8  
  7         395  
13 7     7   23 use File::Find;
  7         8  
  7         257  
14 7     7   2474 use File::stat;
  7         28231  
  7         71  
15 7     7   2401 use Params::Validate ':all';
  7         29562  
  7         1010  
16 7     7   2191 use Sys::Hostname;
  7         4304  
  7         283  
17 7     7   2444 use version;
  7         8797  
  7         31  
18              
19 7     7   337 use lib 'lib';
  7         8  
  7         43  
20 7     7   2737 use parent 'Mail::Toaster::Base';
  7         1182  
  7         34  
21              
22             sub test {
23 11     11 0 23 my $self = shift;
24 11 50       32 my $mess = shift or croak "test with no message?!";
25 11         11 my $result = shift;
26              
27 11         58 my %p = validate(@_, { $self->get_std_opts } );
28 11 50       66 return $p{test_ok} if defined $p{test_ok};
29              
30 11 50       55 return if ! $self->verbose;
31 0         0 print $mess;
32 0 0       0 defined $result or do { print "\n"; return; };
  0         0  
  0         0  
33 0         0 for ( my $i = length($mess); $i <= 65; $i++ ) { print '.' };
  0         0  
34 0 0       0 print $result ? 'ok' : 'FAILED';
35 0         0 print "\n";
36             };
37              
38             sub check {
39 1     1 1 271 my $self = shift;
40 1         12 my %p = validate(@_, { $self->get_std_opts } );
41 1         17 my %args = $self->get_std_args( %p );
42              
43 1         7 $self->check_permissions_twc; # toaster-watcher.conf
44 1         3 $self->check_permissions_tc; # toaster.conf
45              
46 1         3 $self->check_running_processes;
47 1         8 $self->check_watcher_log_size;
48              
49             # check that we can't SMTP AUTH with random user names and passwords
50              
51             # make sure the supervised processes are configured correctly.
52 1         9 foreach my $prot ( $self->get_daemons(1) ) {
53 5         24 $self->supervised_dir_test( $prot, %args );
54             };
55              
56 1         8 $self->check_cron_dccd;
57 1         12 return 1;
58             }
59              
60             sub check_permissions_tc {
61 1     1 0 1 my $self = shift;
62 1         3 my $etc = $self->get_etc;
63 1         2 my $conf = "$etc/toaster.conf";
64 1 50       18 return if ! -f $conf;
65 0         0 my $mode = $self->util->file_mode(file=>$conf, verbose=>0);
66 0         0 $self->audit( "file mode of $conf is $mode" );
67 0 0       0 my $others = substr($mode, -1, 1) and return 1;
68 0         0 return $self->util->chmod(file=>$conf, mode=>'0644');
69             };
70              
71             sub check_permissions_twc {
72 1     1 0 2 my $self = shift;
73 1         4 my $etc = $self->get_etc;
74 1         4 my $conf = "$etc/toaster-watcher.conf";
75 1 50       19 return if ! -f $conf;
76              
77 0         0 my $mode = $self->util->file_mode( file=>$conf, verbose=>0 );
78 0         0 $self->audit( "file mode of $conf is $mode." );
79 0         0 my $others = substr($mode, -1, 1);
80 0 0       0 return if $others == 0;
81 0         0 return $self->util->chmod(file=>$conf, mode=>'0600',verbose=>1);
82             };
83              
84             sub check_running_processes {
85 1     1 1 1 my $self = shift;
86 1         3 my %p = validate(@_, { $self->get_std_opts } );
87 1         5 my $conf = $self->conf;
88              
89 1         4 $self->audit( "checking running processes");
90              
91 1         3 my @processes = qw/ svscan qmail-send multilog /;
92              
93 1 50       4 push @processes, "lighttpd" if $conf->{install_lighttpd};
94 1 50       3 push @processes, "mysqld" if $conf->{install_mysqld};
95 1 50       4 push @processes, "snmpd" if $conf->{install_snmp};
96 1 50       3 push @processes, "clamd", "freshclam" if $conf->{install_clamav};
97 1 50       4 push @processes, "sqwebmaild" if $conf->{install_sqwebmail};
98 1 50       3 push @processes, "dovecot" if $conf->{install_dovecot};
99 1 50       2 push @processes, "vpopmaild" if $conf->{vpopmail_daemon};
100 1 50       2 if ( $conf->{install_courier_imap} ) {
101 1         3 push @processes, "imapd-ssl", "imapd", "pop3d-ssl";
102 1         2 my $cour = $conf->{install_courier_imap};
103 1 50 33     10 push @processes, "authdaemond" if ( $cour eq 'port' || $cour > 4 );
104             };
105              
106 1         2 foreach (@processes) {
107 11         36 $self->test( " $_", $self->util->is_process_running($_) );
108             }
109              
110 1         18 return 1;
111             }
112              
113             sub check_cron_dccd {
114 1     1 0 2 my $self = shift;
115              
116 1 50       12 return $self->audit("unable to check dcc cron jobs on $OSNAME")
117             if $OSNAME ne "freebsd";
118              
119 0 0       0 return if ! -f '/usr/local/dcc/libexec/cron-dccd';
120              
121 0         0 my $periodic_dir = '/usr/local/etc/periodic/daily';
122 0 0       0 if ( ! -d $periodic_dir ) {
123 0 0       0 $self->util->mkdir_system(dir=>$periodic_dir, mode => '0755')
124             or return $self->error("unable to create $periodic_dir");
125             };
126              
127 0         0 my $script = "$periodic_dir/501.dccd";
128 0 0       0 return 1 if -f $script;
129              
130 0         0 $self->util->file_write( $script,
131             lines => [ '#!/bin/sh', '/usr/local/dcc/libexec/cron-dccd', ],
132             mode => '0755',
133             );
134 0         0 $self->audit("created dccd nightly cron job");
135             };
136              
137             sub check_watcher_log_size {
138 1     1 0 4 my $self = shift;
139              
140 1 50       10 my $logfile = $self->conf->{toaster_watcher_log} or return;
141 1 50       80 return if ! -e $logfile;
142              
143             # make sure watcher.log is not larger than 1MB
144 0 0       0 my $size = stat($logfile)->size or return;
145 0 0       0 return if $size < 999999;
146              
147 0         0 $self->audit( "compressing $logfile! ($size)");
148 0         0 $self->util->syscmd( "gzip -f $logfile" );
149             };
150              
151             sub clear_open_smtp {
152 0     0 0 0 my $self = shift;
153              
154 0 0       0 return if ! $self->conf->{vpopmail_roaming_users};
155              
156 0         0 my $vpopdir = $self->setup->vpopmail->get_vpop_dir;
157 0         0 my $clearbin = "$vpopdir/bin/clearopensmtp";
158              
159 0 0       0 if ( ! -x $clearbin ) {
160 0         0 return $self->error( "$clearbin not executable!",fatal=>0 );
161             };
162              
163 0         0 $self->util->syscmd( $clearbin );
164             };
165              
166             sub learn_mailboxes {
167 0     0 1 0 my $self = shift;
168 0         0 my %p = validate(@_, { $self->get_std_opts } );
169 0 0       0 return $p{test_ok} if defined $p{test_ok};
170              
171             my $days = $self->conf->{maildir_learn_interval}
172 0 0       0 or return $self->error( 'learn_mailboxes: disabled', fatal => 0 );
173              
174 0         0 my $find = $self->util->find_bin( 'find', verbose=>0 );
175              
176 0         0 foreach my $d ( $self->get_maildir_paths ) { # every email box
177 0 0       0 if ( ! -d $d ) {
178 0         0 $self->audit("invalid path: $d");
179 0         0 next;
180             };
181 0         0 my ($user,$domain) = (split('/', $d))[-1,-2];
182 0         0 my $email = lc($user) . '@'. lc($domain);
183              
184 0         0 my $age = $self->conf->{maildir_learn_interval} * 86400;
185 0 0       0 if ( -f "$d/learn.log" ) {
186 0         0 $age = time - stat("$d/learn.log")->ctime;
187             };
188              
189 0         0 my $counter = $self->learn_mailbox($email, $d, $find, $age);
190 0 0 0     0 next if ! $counter->{ham} && ! $counter->{spam};
191              
192 0         0 $self->util->logfile_append( "$d/learn.log",
193             prog => $0,
194             lines => [ "trained $counter->{ham} hams and $counter->{spam} spams" ],
195             verbose => 0,
196             );
197             }
198             }
199              
200             sub learn_mailbox {
201 0     0 0 0 my ($self, $email, $d, $find, $age) = @_;
202              
203 0         0 my %counter = ( spam => 0, ham => 0 );
204 0         0 my %messages = ( ham => [], spam => [] );
205              
206 0         0 my $dspam = $self->util->find_bin('dspamc', fatal=>0);
207 0         0 foreach my $dir ( $self->get_maildir_folders( $d, $find ) ) {
208 0         0 my $type = 'ham';
209 0 0       0 $type = 'spam' if $dir =~ /(?:spam|junk)/i;
210              
211 0         0 foreach my $message ( $self->get_maildir_messages($dir, $age) ) {
212 0         0 $counter{$type}++; # throttle learning for really big maildirs
213 0 0 0     0 next if $counter{$type} > 10000 && $counter{$type} % 50 != 0;
214 0 0 0     0 next if $counter{$type} > 5000 && $counter{$type} % 25 != 0;
215 0 0 0     0 next if $counter{$type} > 2500 && $counter{$type} % 10 != 0;
216              
217 0         0 $self->train_dspam( $dspam, $type, $message, $email );
218 0         0 push @{$messages{$type}}, $message; # for SA training
  0         0  
219             };
220             };
221              
222 0         0 $self->train_spamassassin($d, \%messages );
223 0         0 return \%counter;
224             };
225              
226             sub train_spamassassin {
227 0     0 0 0 my ($self, $d, $messages ) = @_;
228              
229 0 0       0 return if ! $self->{install_spamassassin};
230 0         0 my $salearn = $self->util->find_bin('sa-learn');
231              
232 0         0 foreach my $t ( qw/ ham spam / ) {
233 0         0 my $list = $messages->{$t};
234 0 0       0 next if ! scalar @$list;
235 0         0 my $file = "$d/learned-$t-messages";
236 0         0 $self->util->file_write($file, lines => $list, verbose=>0 );
237 0         0 $self->util->syscmd( "$salearn --$t -f $file", verbose=>0 );
238             };
239             };
240              
241             sub train_dspam {
242 0     0 0 0 my ($self, $dspam, $type, $file, $email) = @_;
243 0 0       0 if ( ! $self->conf->{install_dspam} ) {
244 0         0 return $self->audit( "skip dspam training, install_dspam unset");
245             };
246 0 0       0 if ( ! -f $file ) { # file moved (due to MUA action)
247 0         0 return $self->audit( "skipping dspam train of $file, it moved");
248             };
249 0 0       0 if ( ! -x $dspam ) {
250 0         0 return $self->audit("skipping, $dspam not executable");
251             };
252 0         0 my $cmd = "$dspam --client --stdout --deliver=summary --user $email";
253 0 0       0 if ( $type eq 'ham' ) {
    0          
254 0         0 my $dspam_class = $self->get_dspam_class( $file );
255 0 0       0 if ( $dspam_class ) {
256 0 0       0 if ( $dspam_class eq 'innocent' ) {
257 0         0 $self->audit("dpam tagged innocent correctly, skip");
258 0         0 return;
259             };
260 0 0       0 if ( $dspam_class eq 'spam' ) { # dspam miss
261 0         0 $cmd .= "--class=innocent --source=error --mode=toe";
262             };
263             }
264             else {
265 0         0 $cmd .= "--class=innocent --source=corpus";
266             };
267             }
268             elsif ( $type eq 'spam' ) {
269 0         0 my $dspam_class = $self->get_dspam_class( $file );
270 0 0       0 if ( $dspam_class ) {
271 0 0       0 if ( $dspam_class eq 'spam' ) {
    0          
272 0         0 $self->audit("dpam tagged spam correctly, skipping");
273 0         0 return;
274             }
275             elsif ( $dspam_class eq 'innocent' ) {
276 0         0 $cmd .= "--class=spam --source=error --mode=toe";
277             };
278             }
279             else {
280 0         0 $cmd .= "--class=spam --source=corpus";
281             };
282             };
283 0         0 $self->audit( "$cmd < $file" );
284 0         0 my $r = `$cmd < '$file'`; # capture the stdout
285 0         0 $self->audit( $r );
286             };
287              
288             sub clean_mailboxes {
289 1     1 1 663 my $self = shift;
290 1         5 my %p = validate(@_, { $self->get_std_opts } );
291              
292 1 50       7 return $p{test_ok} if defined $p{test_ok};
293              
294             my $days = $self->conf->{maildir_clean_interval} or
295 1 50       6 return $self->audit( 'skip maildir clean, config' );
296              
297 1         7 my $clean_log = $self->get_clean_log;
298 0 0       0 if ( -M $clean_log <= $days ) {
299 0         0 return $self->audit( "skipping, $clean_log is less than $days old");
300             }
301              
302 0 0       0 $self->util->logfile_append( $clean_log,
303             prog => $0,
304             lines => ["clean_mailboxes running."],
305             ) or return;
306              
307 0         0 $self->audit( "checks passed, cleaning");
308              
309 0         0 my @every_maildir_on_server = $self->get_maildir_paths;
310 0         0 foreach my $maildir (@every_maildir_on_server) {
311              
312 0 0 0     0 if ( ! $maildir || ! -d $maildir ) {
313 0         0 $self->audit( "$maildir does not exist");
314 0         0 next;
315             };
316              
317 0         0 $self->audit( " processing $maildir");
318              
319 0         0 foreach ( qw/ ham new sent trash spam / ) {
320 0         0 my $method = 'maildir_clean_' . $_;
321 0         0 $self->$method( $maildir );
322             };
323             };
324              
325 0         0 return 1;
326             }
327              
328             sub maildir_clean_spam {
329 0     0 1 0 my $self = shift;
330 0 0       0 my $path = shift or croak "missing maildir!";
331 0 0       0 my $days = $self->conf->{maildir_clean_Spam} or return;
332 0         0 return $self->maildir_clean( "$path/Maildir/.Spam", $days);
333             };
334              
335             sub maildir_clean {
336 0     0 0 0 my ($self, $dir, $days) = @_;
337              
338 0 0       0 return $self->error("maildir_clean: $dir does not exist.",fatal=>0)
339             if ! -d $dir;
340              
341 0         0 $self->audit( "maildir_clean: $dir older than $days days." );
342              
343 0         0 my $find = $self->util->find_bin( 'find', verbose=>0 );
344 0 0       0 if ( $dir =~ /(?:cur|new)$/ ) {
345 0         0 $self->util->syscmd( "$find '$dir' -type f -mtime +$days -delete" );
346             }
347             else {
348 0         0 $self->util->syscmd( "$find '$dir/cur' -type f -mtime +$days -delete" );
349 0         0 $self->util->syscmd( "$find '$dir/new' -type f -mtime +$days -delete" );
350             };
351 0         0 return 1;
352             };
353              
354             sub maildir_clean_trash {
355 0     0 1 0 my $self = shift;
356 0 0       0 my $path = shift or croak "missing maildir!";
357 0 0       0 my $days = $self->conf->{maildir_clean_Trash} or return;
358 0         0 return $self->maildir_clean( "$path/Maildir/.Trash", $days);
359             }
360              
361             sub maildir_clean_sent {
362 0     0 1 0 my $self = shift;
363 0 0       0 my $path = shift or croak "missing maildir!";
364 0 0       0 my $days = $self->conf->{maildir_clean_Sent} or return;
365 0         0 return $self->maildir_clean( "$path/Maildir/.Sent", $days);
366             }
367              
368             sub maildir_clean_new {
369 0     0 1 0 my $self = shift;
370 0 0       0 my $path = shift or croak "missing maildir!";
371 0 0       0 my $days = $self->conf->{maildir_clean_Unread} or return;
372 0         0 return $self->maildir_clean( "$path/Maildir/new", $days);
373             }
374              
375             sub maildir_clean_ham {
376 0     0 1 0 my $self = shift;
377 0 0       0 my $path = shift or croak "missing maildir!";
378 0 0       0 my $days = $self->conf->{maildir_clean_Read} or return;
379 0         0 return $self->maildir_clean( "$path/Maildir/cur", $days);
380             }
381              
382             sub get_daemons {
383 5     5 0 8 my ($self, $active) = @_;
384 5 100       21 return qw/ smtp send pop3 submit qmail-deliverable qpsmtpd vpopmaild / if ! $active;
385              
386 1         7 my @list = qw/ send pop3 /;
387 1 50       6 push @list, 'vpopmaild' if $self->conf->{vpopmail_daemon};
388 1 50       6 push @list, 'qmail-deliverable' if $self->conf->{install_qmail_deliverable};
389              
390 1         7 my $smtpd = $self->conf->{smtpd_daemon};
391 1 50 33     20 if ( $smtpd && 'qpsmtpd' eq $smtpd ) {
392 0         0 push @list, 'qpsmtpd';
393             }
394             else {
395 1         5 push @list, 'smtp';
396             };
397              
398 1 50       4 if ( $self->conf->{submit_enable} ) {
399 1 50 33     5 if ( ! $self->conf->{submit_daemon} || 'qmail' eq $self->conf->{submit_daemon} ) {
400 1         4 push @list, 'submit';
401             };
402             }
403              
404 1         6 return @list;
405             };
406              
407             sub get_etc {
408 2     2 0 2 my $self = shift;
409 2   50     15 my $etc = $self->conf->{system_config_dir} || '/usr/local/etc';
410             };
411              
412             sub get_clean_log {
413 1     1 0 2 my $self = shift;
414              
415 1         6 my $dir = $self->get_log_dir;
416 1         5 my $clean_log = "$dir/clean.log";
417              
418 1         3 $self->audit( "clean log file is: $clean_log");
419              
420             # create the log file if it does not exist
421 1 50       17 if ( ! -e $clean_log ) {
422 1         6 $self->util->file_write( $clean_log, lines => ["created file"] );
423 0 0       0 return if ! -e $clean_log;
424             }
425 0         0 return $clean_log;
426             };
427              
428             sub get_dspam_class {
429 0     0 0 0 my ($self, $file) = @_;
430 0 0       0 if ( ! -f $file ) {
431 0         0 return $self->error( "file $file disappeared",fatal=>0 );
432             };
433 0         0 my @headers = $self->util->file_read( $file, max_lines => 20 );
434             #foreach my $h ( @headers ) { print "\t$h\n"; };
435              
436 7     7   15009 no warnings;
  7         18  
  7         525  
437 0         0 my ($dspam_status) = grep {/^X-DSPAM-Result:/} @headers;
  0         0  
438 0         0 my ($signature) = grep {/^X-DSPAM-Signature:/} @headers;
  0         0  
439 7     7   27 use warnings;
  7         7  
  7         23035  
440              
441 0 0 0     0 return if ! $dspam_status || ! $signature;
442 0 0       0 my ($class) = $dspam_status =~ /^X-DSPAM-Result:\s+([\w]+)\,/
443             or return;
444 0         0 return lc $class;
445             };
446              
447             sub get_log_dir {
448 1     1 1 4 my $self = shift;
449 1   50     2 return $self->conf->{logs_base} || $self->conf->{qmail_log_base} || '/var/log/mail';
450             }
451              
452             sub get_maildir_paths {
453 0     0 1 0 my $self = shift;
454 0         0 my %p = validate( @_, { $self->get_std_opts } );
455              
456             # this method requires a SQL query for each domain
457 0         0 my @all_domains = $self->qmail->get_domains_from_assign(fatal=> 0);
458              
459 0 0       0 return $self->error( "No domains found in qmail/users/assign",fatal=>0 )
460             unless $all_domains[0];
461              
462 0         0 my $count = @all_domains;
463 0         0 $self->audit( "get_maildir_paths: found $count domains." );
464              
465 0         0 my $vpdir = $self->setup->vpopmail->get_vpop_dir;
466              
467 0         0 my @paths;
468 0         0 foreach (@all_domains) {
469 0         0 my $domain_name = $_->{dom};
470             #$self->audit( " processing $domain_name mailboxes." );
471 0         0 my @list_of_maildirs = `$vpdir/bin/vuserinfo -d -D $domain_name`;
472 0         0 push @paths, @list_of_maildirs;
473             }
474              
475 0         0 chomp @paths;
476 0         0 my %saw;
477 0         0 my @unique_paths = grep(!$saw{$_}++, @paths);
478              
479 0         0 $self->audit( "found ". scalar @unique_paths ." mailboxes.");
480 0         0 return @unique_paths;
481             }
482              
483             sub get_maildir_folders {
484 0     0 0 0 my ( $self, $d, $find ) = @_;
485              
486 0   0     0 $find ||= $self->util->find_bin( 'find', verbose=>0 );
487 0         0 my $find_dirs = "$find '$d' -type d -name cur";
488              
489 0         0 my @dirs;
490 0         0 foreach my $maildir ( `$find_dirs` ) {
491 0         0 chomp $maildir;
492 0 0       0 next if $maildir =~ /\.Notes\/cur$/i; # not email
493 0 0       0 next if $maildir =~ /\.Apple/i; # not email
494 0 0       0 next if $maildir =~ /drafts|sent/i; # not 'received' email
495 0 0       0 next if $maildir =~ /trash|delete/i; # unknown ham/spam
496 0         0 push @dirs, $maildir;
497             };
498 0         0 return @dirs;
499             };
500              
501             sub get_maildir_messages {
502 0     0 0 0 my ($self, $dir, $age ) = @_;
503              
504 0         0 my @recents;
505 0         0 my $oldest = time - $age;
506              
507             find( { wanted =>
508 0 0 0 0   0 sub { -f && stat($_)->ctime > $oldest
509             && push @recents, $File::Find::name;
510             },
511 0         0 no_chdir=>1,
512             }, $dir );
513              
514             #print "found " . @recents . " messages in $dir\n";
515 0         0 chomp @recents;
516 0         0 return @recents;
517             };
518              
519             sub get_toaster_htdocs {
520 0     0 1 0 my $self = shift;
521              
522             # if available, use the configured location
523 0 0 0     0 if ( defined $self->conf && $self->conf->{toaster_http_docs} ) {
524 0         0 return $self->conf->{toaster_http_docs};
525             }
526              
527             # check the usual locations
528 0         0 foreach my $dir (
529             "/usr/local/www/toaster", # toaster
530             "/usr/local/www/data/mail", # legacy
531             "/usr/local/www/mail",
532             "/Library/Webserver/Documents", # Mac OS X
533             "/var/www/html", # Linux
534             "/usr/local/www/data", # FreeBSD
535             ) {
536 0 0       0 return $dir if -d $dir;
537             };
538              
539 0         0 $self->error("could not find htdocs location.");
540             }
541              
542             sub get_toaster_cgibin {
543 0     0 1 0 my $self = shift;
544              
545             # if set, use.
546 0 0       0 return $self->conf->{toaster_cgi_bin} if defined $self->conf->{toaster_cgi_bin};
547              
548             # Mail-Toaster
549 0 0       0 return "/usr/local/www/cgi-bin.mail" if -d "/usr/local/www/cgi-bin.mail";
550 0 0       0 return "/usr/local/www/cgi-bin" if -d "/usr/local/www/cgi-bin"; # FreeBSD
551 0 0       0 return "/var/www/cgi-bin" if -d "/var/www/cgi-bin"; # linux
552              
553             # Mac OS X standard location
554 0 0       0 if ( -d "/Library/WebServer/CGI-Executables" ) {
555 0         0 return "/Library/WebServer/CGI-Executables";
556             }
557              
558             # all else failed, try to predict
559 0 0       0 return $OSNAME eq "linux" ? "/var/www/cgi-bin"
    0          
    0          
560             : $OSNAME eq "darwin" ? "/Library/WebServer/CGI-Executables"
561             : $OSNAME eq "netbsd" ? "/var/apache/cgi-bin"
562             : "/usr/local/www/cgi-bin" # last resort
563             ;
564             }
565              
566             sub process_logfiles {
567 0     0 0 0 my $self = shift;
568 0         0 my $conf = $self->conf;
569              
570 0   0     0 my $pop3_logs = $conf->{pop3_log_method} || $conf->{logs_pop3d};
571 0   0     0 my $smtpd = $conf->{smtpd_daemon} || 'qmail';
572 0   0     0 my $submit = $conf->{submit_daemon} || 'qmail';
573              
574 0         0 $self->supervised_log_rotate('send' );
575 0 0       0 $self->supervised_log_rotate('smtp' ) if $smtpd eq 'qmail';
576 0 0 0     0 $self->supervised_log_rotate('submit') if $conf->{submit_enable} && $submit eq 'qmail';
577 0 0       0 $self->supervised_log_rotate('pop3' ) if $pop3_logs eq 'qpop3d';
578              
579 0         0 $self->logs->compress_yesterdays_logs( "sendlog" );
580 0 0       0 $self->logs->compress_yesterdays_logs( "smtplog" ) if $smtpd eq 'qmail';
581 0 0       0 $self->logs->compress_yesterdays_logs( "pop3log" ) if $pop3_logs eq 'qpop3d';
582              
583 0 0       0 $self->logs->purge_last_months_logs() if $conf->{logs_archive_purge};
584              
585 0         0 return 1;
586             };
587              
588             sub run_isoqlog {
589 0     0 0 0 my $self = shift;
590 0 0       0 return if ! $self->conf->{install_isoqlog};
591              
592 0 0       0 my $isoqlog = $self->util->find_bin( 'isoqlog', verbose=>0 ) or return;
593              
594 0 0       0 system "$isoqlog >/dev/null" or return 1;
595 0         0 return;
596             };
597              
598             sub run_qmailscanner {
599 0     0 0 0 my $self = shift;
600 0 0       0 $self->conf->{install_qmailscanner} or return;
601 0 0       0 $self->conf->{qs_quarantine_process} or return;
602              
603 0         0 $self->audit( "checking qmail-scanner quarantine.");
604 0         0 my @list = $self->qmail->get_qmailscanner_virus_sender_ips;
605              
606 0 0       0 return if ! $self->conf->{qs_block_virus_senders};
607 0         0 $self->qmail->UpdateVirusBlocks( ips => \@list )
608             };
609              
610             sub service_dir_get {
611 4     4 1 6 my $self = shift;
612 4 50       11 my $prot = shift or croak "missing prot!";
613              
614 4 50       9 $prot = 'smtp' if $prot eq 'smtpd'; # fix legacy use
615              
616 4         9 my %valid = map { $_ => 1 } $self->get_daemons;
  28         38  
617 4 50       11 return $self->error( "invalid service: $prot",fatal=>0) if ! $valid{$prot};
618              
619 4   50     12 my $svcdir = $self->conf->{qmail_service} || '/var/service';
620 4 50 33     122 $svcdir = "/service" if ( !-d $svcdir && -d '/service' ); # legacy
621              
622 4         7 my $dir = "$svcdir/$prot";
623              
624 4         18 $self->audit("service dir for $prot is $dir");
625 4         23 return $dir;
626             }
627              
628             sub service_symlinks {
629 0     0 1 0 my $self = shift;
630              
631 0         0 my @active_services = 'send';
632              
633 0         0 foreach my $prot ( qw/ smtp submit pop3 vpopmaild qmail_deliverabled / ) {
634 0         0 my $method = 'service_symlinks_' . $prot;
635 0 0       0 my $r = $self->$method or next;
636 0         0 push @active_services, $r;
637             };
638              
639 0         0 foreach my $prot ( @active_services ) {
640              
641 0         0 my $svcdir = $self->service_dir_get( $prot );
642 0         0 my $supdir = $self->supervise_dir_get( $prot );
643              
644 0 0       0 if ( ! -d $supdir ) {
645 0         0 $self->audit( "skip symlink $svcdir, target $supdir doesn't exist.");
646 0         0 next;
647             };
648              
649 0 0       0 if ( -e $svcdir ) {
650 0         0 $self->audit( "service_symlinks: $svcdir already exists.");
651 0         0 next;
652             }
653              
654 0         0 print "service_symlinks: creating symlink from $supdir to $svcdir\n";
655 0 0       0 symlink( $supdir, $svcdir )
656             or $self->error("couldn't symlink $supdir: $!");
657             }
658              
659 0         0 return 1;
660             }
661              
662             sub service_symlinks_pop3 {
663 0     0 0 0 my $self = shift;
664              
665 0 0 0     0 if ( $self->conf->{pop3_daemon}
666             && $self->conf->{pop3_daemon} eq 'qpop3d' ) {
667 0         0 return 'pop3';
668             };
669 0         0 $self->service_symlinks_cleanup( 'pop3' );
670 0         0 return;
671             };
672              
673             sub service_symlinks_vpopmaild {
674 0     0 0 0 my $self = shift;
675 0 0       0 my $enabled = $self->conf->{vpopmail_daemon} and return 'vpopmaild';
676 0         0 $self->service_symlinks_cleanup( 'vpopmaild' );
677 0         0 return;
678             };
679              
680             sub service_symlinks_qmail_deliverabled {
681 0     0 0 0 my $self = shift;
682             #return 'qmail-deliverabled' if $enabled;
683             #$self->service_symlinks_cleanup( 'qmail-deliverabled' );
684 0         0 return;
685             };
686              
687             sub service_symlinks_smtp {
688 0     0 0 0 my $self = shift;
689 0 0       0 my $daemon = $self->conf->{smtpd_daemon} or return 'smtp';
690              
691 0 0       0 if ( $daemon eq 'qmail' ) {
692 0         0 $self->service_symlinks_cleanup( 'qpsmtpd' );
693 0         0 return 'smtp';
694             };
695              
696 0 0       0 if ( $daemon eq 'qpsmtpd' ) {
697 0         0 $self->service_symlinks_cleanup( 'smtp' );
698 0         0 return 'qpsmtpd';
699             };
700              
701 0         0 return 'smtp';
702             }
703              
704             sub service_symlinks_submit {
705 0     0 0 0 my $self = shift;
706 0 0       0 $self->conf->{submit_enable} or return;
707              
708 0 0       0 my $daemon = $self->conf->{submit_daemon} or return 'submit';
709              
710 0 0       0 if ( $daemon eq 'qpsmtpd' ) {
711 0         0 $self->service_symlinks_cleanup( 'submit' );
712 0         0 return 'qpsmtpd';
713             };
714              
715 0         0 return 'submit';
716             }
717              
718             sub service_symlinks_cleanup {
719 0     0 0 0 my ($self, $prot) = @_;
720              
721 0         0 my $dir = $self->service_dir_get( $prot );
722              
723 0 0       0 if ( ! -e $dir ) {
724 0         0 $self->audit("$prot not enabled due to configuration settings.");
725 0         0 return;
726             };
727              
728 0         0 $self->audit("deleting $dir because $prot isn't enabled!");
729 0         0 unlink $dir;
730             }
731              
732             sub service_dir_create {
733 0     0 1 0 my $self = shift;
734 0         0 my %p = validate( @_, { $self->get_std_opts } );
735              
736 0 0       0 return $p{test_ok} if defined $p{test_ok};
737              
738 0   0     0 my $service = $self->conf->{qmail_service} || "/var/service";
739              
740 0 0       0 if ( ! -d $service ) {
741 0 0       0 mkdir( $service, oct('0775') ) or
742             return $self->error( "service_dir_create: failed to create $service: $!");
743             };
744              
745 0         0 $self->audit("$service exists");
746              
747 0 0       0 unless ( -l "/service" ) {
748 0 0       0 if ( -d "/service" ) {
749 0         0 $self->util->syscmd( "rm -rf /service", fatal=>0 );
750             }
751 0         0 symlink( "/var/service", "/service" );
752             }
753             }
754              
755             sub service_dir_test {
756 0     0 1 0 my $self = shift;
757              
758 0   0     0 my $service = $self->conf->{qmail_service} || "/var/service";
759              
760 0 0       0 return $self->error( "service_dir_test: $service is missing!",fatal=>0)
761             if !-d $service;
762              
763 0         0 $self->audit( "service_dir_test: $service already exists.");
764              
765 0 0 0     0 return $self->error( "/service symlink is missing!",fatal=>0)
766             unless ( -l "/service" && -e "/service" );
767              
768 0         0 $self->audit( "service_dir_test: /service symlink exists.");
769              
770 0         0 return 1;
771             }
772              
773             sub sqwebmail_clean_cache {
774 0     0 0 0 my $self = shift;
775 0 0       0 return 1 if ! $self->conf->{install_sqwebmail};
776 0         0 my $script = "/usr/local/share/sqwebmail/cleancache.pl";
777 0 0       0 return $self->error("unable to locate sqwebmail's cleancache.pl")
778             if ! -x $script;
779 0         0 system $script;
780             };
781              
782             sub supervise_dir_get {
783 5     5 1 7 my $self = shift;
784 5 50       16 my $prot = shift or croak "missing prot!";
785              
786 5         27 my $sdir = $self->qmail->get_supervise_dir;
787 5 50 33     49 $sdir = "/var/supervise" if ( !-d $sdir && -d '/var/supervise'); # legacy
788 5 50 33     38 $sdir = "/supervise" if ( !-d $sdir && -d '/supervise');
789 5   33     11 $sdir ||= $self->qmail->get_qmail_dir . '/supervise';
790              
791 5         10 my $dir = "$sdir/$prot";
792              
793             # expand the qmail_supervise shortcut
794 5 50       12 $dir = "$sdir/$1" if $dir =~ /^qmail_supervise\/(.*)$/;
795              
796 5         23 $self->audit( "supervise dir for $prot is $dir");
797 5         15 return $dir;
798             }
799              
800             sub supervise_dirs_create {
801 0     0 1 0 my $self = shift;
802 0         0 my %p = validate( @_, { $self->get_std_opts } );
803 0         0 my %args = $self->get_std_args( %p );
804              
805 0         0 my $supdir = $self->qmail->get_supervise_dir;
806              
807 0 0       0 return $p{test_ok} if defined $p{test_ok};
808              
809 0 0       0 if ( -d $supdir ) {
810 0         0 $self->audit( "supervise_dirs_create: $supdir, ok (exists)" );
811             }
812             else {
813 0 0       0 mkpath( $supdir, oct('0775') )
814             or $self->error( "failed to create $supdir: $!", %args);
815 0         0 $self->audit( "supervise_dirs_create: $supdir, ok" );
816             }
817              
818 0         0 foreach my $prot ( $self->get_daemons ) {
819              
820 0         0 my $protdir = $self->supervise_dir_get( $prot );
821 0 0       0 if ( -d $protdir ) {
822 0         0 $self->audit( "supervise_dirs_create: $protdir, ok (exists)" );
823 0         0 next;
824             }
825              
826 0 0       0 mkdir( $protdir, oct('0775') )
827             or $self->error( "failed to create $protdir: $!", %args );
828 0         0 $self->audit( "supervise_dirs_create: creating $protdir, ok" );
829              
830 0 0       0 mkdir( "$protdir/log", oct('0775') )
831             or $self->error( "failed to create $protdir/log: $!", %args);
832 0         0 $self->audit( "supervise_dirs_create: creating $protdir/log, ok" );
833              
834 0         0 $self->util->syscmd( "chmod +t $protdir", verbose=>0 );
835             }
836              
837 0         0 foreach my $prot ( $self->get_daemons(1) ) {
838 0         0 my $protdir = $self->supervise_dir_get( $prot );
839 0         0 my $svc_dir = $self->service_dir_get($prot);
840 0 0       0 symlink( $protdir, $svc_dir ) if ! -e "$supdir/$prot";
841             };
842             }
843              
844             sub supervised_dir_test {
845 5     5 1 7 my $self = shift;
846 5 50       14 my $prot = shift or croak "missing prot";
847 5         19 my %p = validate( @_, { $self->get_std_opts } );
848 5         29 my %args = $self->get_std_args( %p );
849              
850 5 50       19 my $dir = $self->supervise_dir_get( $prot ) or return;
851              
852 5 50       28 return $p{test_ok} if defined $p{test_ok};
853              
854 0 0 0     0 return $self->error("directory $dir does not exist", %args )
855             unless ( -d $dir || -l $dir );
856 0         0 $self->test( "exists, $dir", -d $dir );
857              
858 0 0       0 if ( ! -f "$dir/run" ) {
859 0         0 $self->qmail->install_qmail_control_files;
860 0 0       0 return $self->error("$dir/run does not exist!", %args ) if ! -f "$dir/run";
861             };
862 0         0 $self->test( "exists, $dir/run", -f "$dir/run" );
863              
864 0 0       0 return $self->error("$dir/run is not executable", %args ) if ! -x "$dir/run";
865 0         0 $self->test( "perms, $dir/run", -x "$dir/run" );
866              
867 0 0       0 return $self->error("$dir/down is present", %args ) if -f "$dir/down";
868 0         0 $self->test( "!exist, $dir/down", !-f "$dir/down" );
869              
870             my $log_method = $self->conf->{ $prot . '_log_method' }
871 0   0     0 || $self->conf->{ $prot . 'd_log_method' }
872             || "multilog";
873              
874 0 0       0 return 1 if $log_method =~ /(?:syslog|disabled)/i;
875              
876             # make sure the log directory exists
877 0 0       0 return $self->error( "$dir/log does not exist", %args ) if ! -d "$dir/log";
878 0         0 $self->test( "exists, $dir/log", -d "$dir/log" );
879              
880             # make sure the supervise/log/run file exists
881 0 0       0 if ( ! -f "$dir/log/run" ) {
882 0         0 $self->qmail->install_qmail_control_log_files;
883 0 0       0 return $self->error( "$dir/log/run does not exist", %args )
884             if ! -f "$dir/log/run";
885             };
886 0         0 $self->test( "exists, $dir/log/run", -f "$dir/log/run" );
887              
888             # check the log/run file permissions
889 0 0       0 return $self->error( "perms, $dir/log/run", %args ) if ! -x "$dir/log/run";
890 0         0 $self->test( "perms, $dir/log/run", -x "$dir/log/run" );
891              
892             # make sure the supervise/down file does not exist
893 0 0       0 return $self->error( "$dir/log/down exists", %args ) if -f "$dir/log/down";
894 0         0 $self->test( "!exist, $dir/log/down", "$dir/log/down" );
895 0         0 return 1;
896             }
897              
898             sub supervised_do_not_edit_notice {
899 1     1 0 1 my $self = shift;
900 1         2 my $vdir = shift;
901              
902 1 50       3 if ($vdir) {
903 1         5 $vdir = $self->setup->vpopmail->get_vpop_dir;
904             }
905              
906 1         9 my $qdir = $self->qmail->get_qmail_dir;
907 1   50     3 my $prefix = $self->conf->{toaster_prefix} || '/usr/local';
908              
909 1         3 my $path = "PATH=$qdir/bin";
910 1 50       4 $path .= ":$vdir/bin" if $vdir;
911 1         2 $path .= ":$prefix/bin:/usr/bin:/bin";
912              
913 1         6 return "#!/bin/sh\n
914             # NOTICE: This file is automatically updated by toaster-watcher.pl.\n
915             # Please DO NOT hand edit this file. Instead, edit toaster-watcher.conf
916             # and then run toaster-watcher.pl to make your settings active.
917             # Run: 'perldoc toaster-watcher.conf' for more detailed info.\n
918             $path
919             export PATH\n
920             ";
921             }
922              
923             sub supervised_hostname {
924 0     0 0 0 my $self = shift;
925 0 0       0 my $prot = shift or croak "missing prot!";
926              
927 0         0 $prot .= "_hostname";
928 0         0 $prot = $self->conf->{ $prot . '_hostname' };
929              
930 0 0 0     0 if ( ! $prot || $prot eq "system" ) {
931 0         0 $self->audit( "using system hostname (" . hostname() . ")" );
932 0         0 return hostname() . ' ';
933             };
934 0 0       0 if ( $prot eq "qmail" ) {
935 0         0 $self->audit( " using qmail hostname." );
936 0         0 return '\"$LOCAL" ';
937             };
938              
939 0         0 $self->audit( "using conf defined hostname ($prot).");
940 0         0 return "$prot ";
941             }
942              
943             sub supervised_multilog {
944 0     0 0 0 my $self = shift;
945 0 0       0 my $prot = shift or croak "missing prot!";
946 0         0 my %p = validate( @_, { $self->get_std_opts } );
947 0         0 my %args = $self->get_std_args( %p );
948              
949 0         0 my $setuidgid = $self->util->find_bin( 'setuidgid', fatal=>0 );
950 0         0 my $multilog = $self->util->find_bin( 'multilog', fatal=>0);
951              
952 0 0 0     0 return $self->error( "supervised_multilog: missing daemontools components!", %args)
953             unless ( -x $setuidgid && -x $multilog );
954              
955 0   0     0 my $loguser = $self->conf->{'qmail_log_user'} || "qmaill";
956 0         0 my $log_base = $self->get_log_dir;
957 0 0       0 my $logprot = $prot eq 'smtp' ? 'smtpd' : $prot;
958 0         0 my $runline = "exec $setuidgid $loguser $multilog t ";
959              
960 0   0     0 my $maxbytes = $self->conf->{ $logprot . '_log_maxsize_bytes' } || '100000';
961 0   0     0 my $method = $self->conf->{ $logprot . '_log_method' } || 'none';
962              
963 0 0       0 if ( $method eq "stats" ) { $runline .= "-* +stats s$maxbytes "; }
  0 0       0  
964 0         0 elsif ( $method eq "disabled" ) { $runline .= "-* "; }
965 0         0 else { $runline .= "s$maxbytes "; };
966              
967 0         0 $self->audit( "supervised_multilog: log method for $prot is $method");
968              
969 0 0 0     0 if ( $prot eq "send" && $self->conf->{'send_log_isoqlog'} ) {
970 0         0 $runline .= "n288 "; # keep a days worth of logs around
971             }
972              
973 0         0 $runline .= "$log_base/$prot";
974 0         0 return $runline;
975             }
976              
977             sub supervised_log_method {
978 0     0 0 0 my $self = shift;
979 0 0       0 my $prot = shift or croak "missing prot!";
980              
981 0 0       0 if ( 'syslog' eq $self->conf->{$prot . '_hostname'} ) {
982 0         0 $self->audit( " syslog logging." );
983 0         0 return "\\\n\tsplogger $prot ";
984             };
985              
986 0         0 $self->audit( " multilog logging." );
987 0         0 return "\\\n\t2>&1 ";
988             }
989              
990             sub supervised_log_rotate {
991 0     0 0 0 my $self = shift;
992 0 0       0 my $prot = shift or croak "missing prot!";
993              
994 0 0       0 return $self->error( "root privs are needed to rotate logs.",fatal=>0)
995             if $UID != 0;
996              
997 0 0       0 my $dir = $self->supervise_dir_get( $prot ) or return;
998              
999 0 0       0 return $self->error( "the supervise directory '$dir' is missing", fatal=>0)
1000             if ! -d $dir;
1001              
1002 0 0       0 return $self->error( "the supervise run file '$dir/run' is missing", fatal=>0)
1003             if ! -f "$dir/run";
1004              
1005 0         0 $self->audit( "sending ALRM signal to $prot at $dir");
1006 0 0       0 my $svc = $self->util->find_bin('svc',verbose=>0,fatal=>0) or return;
1007 0         0 system "$svc -a $dir";
1008              
1009 0         0 return 1;
1010             };
1011              
1012             sub supervise_restart {
1013 0     0 1 0 my $self = shift;
1014 0 0       0 my $dir = shift or die "missing dir\n";
1015              
1016 0 0       0 return $self->error( "supervise_restart: is not a dir: $dir" ) if !-d $dir;
1017              
1018 0         0 my $svc = $self->util->find_bin( 'svc', verbose=>0, fatal=>0 );
1019 0         0 my $svok = $self->util->find_bin( 'svok', verbose=>0, fatal=>0 );
1020              
1021 0 0       0 return $self->error( "svc not found, is daemontools installed?")
1022             if ! -x $svc;
1023              
1024 0 0       0 if ( $svok ) {
1025 0 0       0 system "$svok $dir" and
1026             return $self->error( "sorry, $dir isn't supervised!" );
1027             };
1028              
1029             # send the service a TERM signal
1030 0         0 $self->audit( "sending TERM signal to $dir" );
1031 0         0 system "$svc -t $dir";
1032 0         0 return 1;
1033             }
1034              
1035             sub supervised_tcpserver {
1036 1     1 0 2 my $self = shift;
1037 1 50       4 my $prot = shift or croak "missing prot!";
1038              
1039             # get max memory, default 4MB if unset
1040 1         12 my $mem = $self->conf->{ $prot . '_max_memory_per_connection' };
1041 1 50       6 $mem = $mem ? $mem * 1024000 : 4000000;
1042 1         7 $self->audit( "memory limited to $mem bytes" );
1043              
1044 1         3 my $softlimit = $self->util->find_bin( 'softlimit', verbose => 0);
1045 0           my $tcpserver = $self->util->find_bin( 'tcpserver', verbose => 0);
1046              
1047 0           my $exec = "exec\t$softlimit -m $mem \\\n\t$tcpserver ";
1048 0           $exec .= $self->supervised_tcpserver_mysql( $prot, $tcpserver );
1049 0 0         $exec .= "-H " if $self->conf->{ $prot . '_lookup_tcpremotehost' } == 0;
1050 0 0         $exec .= "-R " if $self->conf->{ $prot . '_lookup_tcpremoteinfo' } == 0;
1051 0 0         $exec .= "-p " if $self->conf->{ $prot . '_dns_paranoia' } == 1;
1052 0 0         $exec .= "-v " if $self->conf->{ $prot . '_verbose' };
1053              
1054 0   0       my $maxcon = $self->conf->{ $prot . '_max_connections' } || 40;
1055 0           my $maxmem = $self->conf->{ $prot . '_max_memory' };
1056              
1057 0 0         if ( $maxmem ) {
1058 0 0         if ( ( $mem / 1024000 ) * $maxcon > $maxmem ) {
1059 0           require POSIX;
1060 0           $maxcon = POSIX::floor( $maxmem / ( $mem / 1024000 ) );
1061 0           $self->qmail->_memory_explanation( $prot, $maxcon );
1062             }
1063             }
1064 0 0         $exec .= "-c$maxcon " if $maxcon != 40;
1065             $exec .= '-t' . $self->conf->{$prot.'_dns_lookup_timeout'} . ' '
1066 0 0         if $self->conf->{ $prot . '_dns_lookup_timeout' } != 26;
1067              
1068 0           $exec .= $self->supervised_tcpserver_cdb( $prot );
1069              
1070 0 0         if ( $prot =~ /^smtpd|submit$/ ) {
1071              
1072 0           my $uid = getpwnam( $self->conf->{ $prot . '_run_as_user' } );
1073 0           my $gid = getgrnam( $self->conf->{ $prot . '_run_as_group' } );
1074              
1075 0 0 0       unless ( $uid && $gid ) {
1076 0           print
1077             "uid or gid is not set!\n Check toaster_watcher.conf and make sure ${prot}_run_as_user and ${prot}_run_as_group are set to valid usernames\n";
1078 0           return 0;
1079             }
1080 0           $exec .= "\\\n\t-u $uid -g $gid ";
1081             }
1082              
1083             # default to 0 (all) if not selected
1084 0   0       my $address = $self->conf->{ $prot . '_listen_on_address' } || 0;
1085 0 0         $exec .= $address eq "all" ? "0 " : "$address ";
1086 0           $self->audit( " listening on ip $address.");
1087              
1088 0           my $port = $self->conf->{ $prot . '_listen_on_port' };
1089 0 0 0       $port ||= $prot eq "smtpd" ? "smtp"
    0          
    0          
1090             : $prot eq "submission" ? "submission"
1091             : $prot eq "pop3" ? "pop3"
1092             : die "can't figure out what port $port should listen on!\n";
1093 0           $exec .= "$port ";
1094 0           $self->audit( "listening on port $port.");
1095              
1096 0           return $exec;
1097             }
1098              
1099             sub supervised_tcpserver_mysql {
1100 0     0 0   my $self = shift;
1101 0           my ($prot, $tcpserver ) = @_;
1102              
1103 0 0         return '' if ! $self->conf->{ $prot . '_use_mysql_relay_table' };
1104              
1105             # is tcpserver mysql patch installed
1106 0           my $strings = $self->util->find_bin( 'strings', verbose=>0);
1107              
1108 0 0         if ( grep /sql/, `$strings $tcpserver` ) {
1109 0           $self->audit( "using MySQL based relay table" );
1110 0           return "-S ";
1111             }
1112              
1113 0           $self->error( "The mysql relay table option is selected but the MySQL patch for ucspi-tcp (tcpserver) is not installed! Please re-install ucspi-tcp with the patch (toaster_setup.pl -s ucspi) or disable ${prot}_use_mysql_relay_table.", fatal => 0);
1114 0           return '';
1115             };
1116              
1117             sub supervised_tcpserver_cdb {
1118 0     0 0   my ($self, $prot) = @_;
1119              
1120 0           my $cdb = $self->conf->{ $prot . '_relay_database' };
1121 0 0         return '' if ! $cdb;
1122              
1123 0   0       my $vdir = $self->conf->{'vpopmail_home_dir'} || "/usr/local/vpopmail";
1124 0           $self->audit( "relay db set to $cdb");
1125              
1126 0 0         if ( $cdb =~ /^vpopmail_home_dir\/(.*)$/ ) {
1127 0           $cdb = "$vdir/$1";
1128 0           $self->audit( " expanded to $cdb" );
1129             }
1130              
1131 0 0         if ( ! -e $cdb ) {
1132 0           $self->setup->tcp_smtp( etc_dir => "$vdir/etc" );
1133 0           $self->setup->tcp_smtp_cdb( etc_dir => "$vdir/etc" );
1134             };
1135              
1136 0 0         $self->error( "$cdb selected but not readable" ) if ! -r $cdb;
1137 0           return "\\\n\t-x $cdb ";
1138             };
1139              
1140 0     0 0   sub version { $VERSION; }
1141              
1142             1;
1143             __END__
1144              
1145             =head1 NAME
1146              
1147             Mail::Toaster - a fast, secure, full-featured mail server.
1148              
1149              
1150             =head1 SYNOPSIS
1151              
1152             functions used in: toaster-watcher.pl
1153             toaster_setup.pl
1154             qqtool.pl
1155              
1156             To expose much of what can be done with these, run toaster_setup.pl -s help and you'll get a list of the available targets.
1157              
1158             The functions in Mail::Toaster.pm are used by toaster-watcher.pl (which is run every 5 minutes via cron), as well as in toaster_setup.pl and other functions, particularly those in Qmail.pm and mailadmin.
1159              
1160              
1161             =head1 USAGE
1162              
1163             use Mail::Toaster;
1164             my $toaster = Mail::Toaster->new;
1165              
1166             # verify that processes are all running and complain if not
1167             $toaster->check();
1168              
1169             # get a list of all maildirs on the system
1170             my @all_maildirs = $toaster->get_maildir_paths();
1171              
1172             # clean up old messages over X days old
1173             $toaster->clean_mailboxes();
1174              
1175             # clean up messages in Trash folders that exceed X days
1176             foreach my $maildir ( @all_maildirs ) {
1177             $toaster->maildir_clean_trash( $maildir );
1178             };
1179              
1180             These functions can all be called indivually, see the working
1181             examples in the aforementioned scripts or the t/Toaster.t file.
1182              
1183              
1184             =head1 DESCRIPTION
1185              
1186              
1187             Mail::Toaster, Everything you need to build a industrial strength mail system.
1188              
1189             A collection of perl scripts and modules that are quite useful for building and maintaining a mail system. It was first authored for FreeBSD and has since been extended to Mac OS X, and Linux. It has become quite useful on other platforms and may grow to support other MTA's (think postfix) in the future.
1190              
1191              
1192             =head1 SUBROUTINES
1193              
1194              
1195             A separate section listing the public components of the module's interface.
1196             These normally consist of either subroutines that may be exported, or methods
1197             that may be called on objects belonging to the classes that the module provides.
1198             Name the section accordingly.
1199              
1200             In an object-oriented module, this section should begin with a sentence of the
1201             form "An object of this class represents...", to give the reader a high-level
1202             context to help them understand the methods that are subsequently described.
1203              
1204              
1205             =over 8
1206              
1207              
1208             =item new
1209              
1210             ############################################
1211             # Usage : use Mail::Toaster;
1212             # : my $toaster = Mail::Toaster->new;
1213             # Purpose : create a new Mail::Toaster object
1214             # Returns : an object to access Mail::Toaster functions
1215             # Parameters : none
1216             # Throws : no exceptions
1217              
1218              
1219             =item check
1220              
1221             ############################################
1222             # Usage : $toaster->check();
1223             # Purpose : Runs a series of tests to inform admins of server problems
1224             # Returns : prints out a series of test failures
1225             # Throws : no exceptions
1226             # See Also : toaster-watcher.pl
1227             # Comments :
1228              
1229             Performs the following tests:
1230              
1231             * check for processes that should be running.
1232             * make sure watcher.log is less than 1MB
1233             * make sure ~alias/.qmail-* exist and are not empty
1234             * verify multilog log directories are working
1235              
1236             When this is run by toaster-watcher.pl via cron, the mail server admin will get notified via email any time one of the tests fails. Otherwise, there is no output generated.
1237              
1238              
1239             =item learn_mailboxes
1240              
1241             ############################################
1242             # Usage : $toaster->learn_mailboxes();
1243             # Purpose : train SpamAssassin bayesian filters with your ham & spam
1244             # Returns : 0 - failure, 1 - success
1245             # See Also : n/a
1246             # Comments :
1247              
1248             Powers an easy to use mechanism for training SpamAssassin on what you think is ham versus spam. It does this by trawling through a mail system, finding mail messages that have arrived since the last time it ran. It passes these messages through sa-learn with the appropriate flags (sa-learn --ham|--spam) to train its bayesian filters.
1249              
1250              
1251             =item clean_mailboxes
1252              
1253             ############# clean_mailboxes ##############
1254             # Usage : $toaster->clean_mailboxes();
1255             # Purpose : cleaning out old mail messages from user mailboxes
1256             # Returns : 0 - failure, 1 - success
1257             # See Also : n/a
1258             # Comments :
1259              
1260              
1261             This sub trawls through the mail system pruning all messages that exceed the threshholds defined in toaster-watcher.conf.
1262              
1263             Peter Brezny suggests adding another option which is good. Set a window during which the cleaning script can run so that it is not running during the highest load times.
1264              
1265              
1266             =item get_toaster_cgibin
1267              
1268             Determine the location of the cgi-bin directory used for email applications.
1269              
1270              
1271             =item get_log_dir
1272              
1273             Determine where log files are stored.
1274              
1275              
1276             =item get_toaster_htdocs
1277              
1278             Determine the location of the htdocs directory used for email applications.
1279              
1280              
1281             =item maildir_clean_spam
1282              
1283             ########### maildir_clean_spam #############
1284             # Usage : $toaster->maildir_clean_spam( '/domains/example.com/user' );
1285             # Purpose : Removes spam that exceeds age as defined in t-w.conf.
1286             # Returns : 0 - failure, 1 - success
1287             # Parameters : path - path to a maildir
1288              
1289              
1290             results in the Spam folder of a maildir with messages older than X days removed.
1291              
1292              
1293             =item get_maildir_paths
1294              
1295             ############################################
1296             # Usage : $toaster->get_maildir_paths()
1297             # Purpose : build a list of email dirs to perform actions upon
1298             # Returns : an array listing every maildir on a Mail::Toaster
1299             # Throws : exception on failure, or 0 if fatal=>0
1300              
1301             This sub creates a list of all the domains on a Mail::Toaster, and then creates a list of every email box (maildir) on every domain, thus generating a list of every mailbox on the system.
1302              
1303              
1304             =item maildir_clean_trash
1305              
1306             ############################################
1307             # Usage : $toaster->maildir_clean_trash( '/domains/example.com/user' );
1308             # Purpose : expire old messages in Trash folders
1309             # Returns : 0 - failure, 1 - success
1310             # Results : a Trash folder with messages older than X days pruned
1311             # Parameters : path - path to a maildir
1312             # Throws : no exceptions
1313              
1314             Comments: Removes messages in .Trash folders that exceed the number of days defined in toaster-watcher.conf.
1315              
1316              
1317             =item maildir_clean_sent
1318              
1319             ############################################
1320             # Usage : $toaster->maildir_clean_sent( '/domains/example.com/user' );
1321             # Purpose : expire old messages in Sent folders
1322             # Returns : 0 - failure, 1 - success
1323             # Results : messages over X days in Sent folders are deleted
1324             # Parameters : path - path to a maildir
1325             # Throws : no exceptions
1326              
1327              
1328             =item maildir_clean_new
1329              
1330              
1331             ############ maildir_clean_new #############
1332             # Usage : $toaster->maildir_clean_new( '/domains/example.com/user' );
1333             # Purpose : expire unread messages older than X days
1334             # Returns : 0 - failure, 1 - success
1335             # Parameters : path - path to a maildir
1336             # Throws : no exceptions
1337              
1338             This should be set to a large value, such as 180 or 365. Odds are, if a user hasn't read their messages in that amount of time, they never will so we should clean them out.
1339              
1340              
1341             =item maildir_clean_ham
1342              
1343              
1344             ############################################
1345             # Usage : $toaster->maildir_clean_ham( '/domains/example.com/user' );
1346             # Purpose : prune read email messages
1347             # Returns : 0 - failure, 1 - success
1348             # Results : an INBOX minus read messages older than X days
1349             # Parameters : path - path to a maildir
1350             # Throws : no exceptions
1351              
1352              
1353             =item service_dir_create
1354              
1355             Create the supervised services directory (if it doesn't exist).
1356              
1357             $toaster->service_dir_create;
1358              
1359             Also sets the permissions to 775.
1360              
1361              
1362             =item service_dir_get
1363              
1364             This is necessary because things such as service directories are now in /var/service by default but older versions of my toaster installed them in /service. This will detect and adjust for that.
1365              
1366              
1367             Example
1368             $toaster->service_dir_get( 'smtp' );
1369              
1370              
1371             arguments required:
1372             prot is one of these protocols: smtp, pop3, submit, send
1373              
1374             arguments optional:
1375             verbose
1376             fatal
1377              
1378             result:
1379             0 - failure
1380             the path to a directory upon success
1381              
1382             =item service_dir_test
1383              
1384             Makes sure the service directory is set up properly
1385              
1386             $toaster->service_dir_test();
1387              
1388             Also sets the permissions to 775.
1389              
1390              
1391             =item service_symlinks
1392              
1393             Sets up the supervised mail services for Mail::Toaster
1394              
1395             $toaster->service_symlinks();
1396              
1397             This populates the supervised service directory (default: /var/service) with symlinks to the supervise control directories (typically /var/qmail/supervise/). Creates and sets permissions on the following directories and files:
1398              
1399             /var/service/pop3
1400             /var/service/smtp
1401             /var/service/send
1402             /var/service/submit
1403              
1404              
1405             =item supervise_dir_get
1406              
1407             my $dir = $toaster->supervise_dir_get( "smtp" );
1408              
1409             This sub just sets the supervise directory used by the various qmail
1410             services (qmail-smtpd, qmail-send, qmail-pop3d, qmail-submit). It sets
1411             the values according to your preferences in toaster-watcher.conf. If
1412             any settings are missing from the config, it chooses reasonable defaults.
1413              
1414             This is used primarily to allow you to set your mail system up in ways
1415             that are a different than mine, like a LWQ install.
1416              
1417              
1418             =item supervise_dirs_create
1419              
1420             Creates the qmail supervise directories.
1421              
1422             $toaster->supervise_dirs_create(verbose=>$verbose);
1423              
1424             The default directories created are:
1425              
1426             $supervise/smtp
1427             $supervise/submit
1428             $supervise/send
1429             $supervise/pop3
1430              
1431             unless otherwise specified in $self->conf
1432              
1433              
1434             =item supervised_dir_test
1435              
1436             Checks a supervised directory to see if it is set up properly for supervise to start it. It performs a bunch of tests including:
1437              
1438             * directory exists
1439             * dir/run file exists and is executable
1440             * dir/down file is not present
1441             * dir/log exists
1442             * dir/log/run exists and is executable
1443             * dir/log/down does not exist
1444              
1445             arguments required:
1446             prot - a protocol to check (smtp, pop3, send, submit)
1447              
1448             arguments optional:
1449             verbose
1450              
1451              
1452             =item supervise_restart
1453              
1454             Restarts a supervised process.
1455              
1456              
1457             =item check_running_processes
1458              
1459             Tests to see if all the processes on your Mail::Toaster that should be running in fact are.
1460              
1461             usage:
1462             $toaster->check_running_processes;
1463              
1464             arguments optional:
1465             verbose
1466              
1467              
1468              
1469             =back
1470              
1471             =head1 SEE ALSO
1472              
1473             The following man (perldoc) pages:
1474              
1475             Mail::Toaster
1476             Mail::Toaster::Conf
1477             toaster.conf
1478             toaster-watcher.conf
1479              
1480             http://www.mail-toaster.org/
1481              
1482              
1483             =head1 DIAGNOSTICS
1484              
1485             Since the functions in the module are primarily called by toaster-watcher.pl, they are designed to do their work with a minimum amount of feedback, complaining only when a problem is encountered. Whether or not they produce status messages and verbose errors is governed by the "verbose" argument which is passed to each sub/function.
1486              
1487             Status messages and verbose logging is enabled by default. toaster-watcher.pl and most of the automated tests (see t/toaster-watcher.t and t/Toaster.t) explicitely turns this off by setting verbose=>0.
1488              
1489              
1490             =head1 CONFIGURATION AND ENVIRONMENT
1491              
1492             The primary means of configuration for Mail::Toaster is via toaster-watcher.conf. It is typically installed in /usr/local/etc, but may also be found in /opt/local/etc, or simply /etc. Documentation for the man settings in toaster-watcher.conf can be found in the man page (perldoc toaster-watcher.conf).
1493              
1494              
1495             =head1 DEPENDENCIES
1496              
1497             Params::Validate - must be installed seperately
1498             POSIX (floor only - included with Perl)
1499             Mail::Toaster::Utility
1500              
1501              
1502             =head1 BUGS AND LIMITATIONS
1503              
1504             Report to author or submit patches on GitHub.
1505              
1506             =head1 AUTHOR
1507              
1508             Matt Simerson (matt@tnpi.net)
1509              
1510              
1511             =head1 COPYRIGHT AND LICENCE
1512              
1513             Copyright (c) 2004-2013, The Network People, Inc. C<< <matt@tnpi.net> >>. All rights reserved.
1514              
1515             Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1516              
1517             Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
1518              
1519             Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
1520              
1521             Neither the name of the The Network People, Inc. nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
1522              
1523             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1524              
1525             =cut