File Coverage

lib/Mail/Toaster/Setup/Test.pm
Criterion Covered Total %
statement 21 352 5.9
branch 0 106 0.0
condition 0 58 0.0
subroutine 7 33 21.2
pod 6 26 23.0
total 34 575 5.9


line stmt bran cond sub pod time code
1             package Mail::Toaster::Setup::Test;
2 1     1   622 use strict;
  1         1  
  1         23  
3 1     1   3 use warnings;
  1         1  
  1         32  
4              
5             our $VERSION = '5.50';
6              
7 1     1   3 use Carp;
  1         1  
  1         50  
8 1     1   3 use English '-no_match_vars';
  1         1  
  1         5  
9 1     1   769 use Params::Validate qw( :all );
  1         6280  
  1         148  
10              
11 1     1   5 use lib 'lib';
  1         1  
  1         7  
12 1     1   443 use parent 'Mail::Toaster::Base';
  1         237  
  1         4  
13              
14             sub daemontools {
15 0     0 0   my $self = shift;
16              
17 0           print "checking daemontools binaries...\n";
18 0           my @bins = qw/ multilog softlimit setuidgid supervise svok svscan tai64nlocal /;
19 0           foreach my $test ( @bins ) {
20 0           my $bin = $self->util->find_bin( $test, fatal => 0, verbose=>0);
21 0           $self->pretty(" $test", -x $bin );
22             };
23              
24 0           return 1;
25             }
26              
27             sub email_send {
28 0     0 1   my $self = shift;
29 0   0       my $email = $self->conf->{toaster_admin_email} || 'root';
30 0   0       my $qdir = $self->conf->{qmail_dir} || '/var/qmail';
31 0           my $ibin = "$qdir/bin/qmail-inject";
32 0 0         if ( ! -x $ibin ) {
33 0           return $self->error("qmail-inject ($ibin) not found!");
34             };
35              
36 0           foreach ( qw/ clean spam eicar attach clam / ) {
37 0 0         open(my $INJECT, "|", "$ibin -a -f \"\" $email" ) or
38             return $self->error( "couldn't send using qmail-inject!");
39 0           my $method = 'email_send_' . $_;
40 0           $self->$method( $INJECT, $email );
41 0           close $INJECT;
42             };
43              
44 0           return 1;
45             }
46              
47             sub email_send_attach {
48 0     0 1   my ( $self, $INJECT, $email ) = @_;
49              
50 0           print "\n\t\tSending .com test attachment - should fail.\n";
51 0           print $INJECT <<"EOATTACH";
52             From: Mail Toaster Testing <$email>
53             To: Email Administrator <$email>
54             Subject: Email test (blocked attachment message)
55             Mime-Version: 1.0
56             Content-Type: multipart/mixed; boundary="gKMricLos+KVdGMg"
57             Content-Disposition: inline
58              
59             --gKMricLos+KVdGMg
60             Content-Type: text/plain; charset=us-ascii
61             Content-Disposition: inline
62              
63             This is an example of an Email message containing a virus. It should
64             trigger the virus scanner, and not be delivered.
65              
66             If you are using qmail-scanner, the server admin should get a notification.
67              
68             --gKMricLos+KVdGMg
69             Content-Type: text/plain; charset=us-ascii
70             Content-Disposition: attachment; filename="Eicar.com"
71              
72             00000000000000000000000000000000000000000000000000000000000000000000
73              
74             --gKMricLos+KVdGMg--
75              
76             EOATTACH
77              
78             }
79              
80             sub email_send_clam {
81 0     0 1   my ( $self, $INJECT, $email ) = @_;
82              
83 0           print "\n\t\tSending ClamAV test virus - should fail.\n";
84 0           print $INJECT <<EOCLAM;
85             From: Mail Toaster testing <$email>
86             To: Email Administrator <$email>
87             Subject: Email test (virus message)
88              
89             This is a viral message containing the clam.zip test virus pattern. It should be blocked by any scanning software using ClamAV.
90              
91              
92             --Apple-Mail-7-468588064
93             Content-Transfer-Encoding: base64
94             Content-Type: application/zip;
95             x-unix-mode=0644;
96             name="clam.zip"
97             Content-Disposition: attachment;
98             filename=clam.zip
99              
100             UEsDBBQAAAAIALwMJjH9PAfvAAEAACACAAAIABUAY2xhbS5leGVVVAkAA1SjO0El6E1BVXgEAOgD
101             6APzjQpgYGJgYGBh4Gf4/5+BYQeQrQjEDgxSDAQBIwPD7kIBBwbjAwEB3Z+DgwM2aDoYsKStqfy5
102             y5ChgndtwP+0Aj75fYYML5/+38J5VnGLz1nFJB4uRqaCMnEmOT8eFv1bZwRQjTwA5Degid0C8r+g
103             icGAt2uQn6uPsZGei48PA4NrRWZJQFF+cmpxMUNosGsQVNzZx9EXKJSYnuqUX+HI8Axqlj0QBLgy
104             MPgwMjIkOic6wcx8wNDXyM3IJAkMFAYGNoiYA0iPAChcwDwwGxRwjFA9zAxcEIYCODDBgAlMCkDE
105             QDTUXmSvtID8izeQaQOiQWHiGBbLAPUXsl+QwAEAUEsBAhcDFAAAAAgAvAwmMf08B+8AAQAAIAIA
106             AAgADQAAAAAAAAAAAKSBAAAAAGNsYW0uZXhlVVQFAANUoztBVXgAAFBLBQYAAAAAAQABAEMAAAA7
107             AQAAAAA=
108              
109             --Apple-Mail-7-468588064
110              
111              
112             EOCLAM
113              
114             }
115              
116             sub email_send_clean {
117 0     0 1   my ( $self, $INJECT, $email ) = @_;
118              
119 0           print "\n\t\tsending a clean message - should arrive unaltered\n";
120 0           print $INJECT <<EOCLEAN;
121             From: Mail Toaster testing <$email>
122             To: Email Administrator <$email>
123             Subject: Email test (clean message)
124              
125             This is a clean test message. It should arrive unaltered and should also pass any virus or spam checks.
126              
127             EOCLEAN
128              
129             }
130              
131             sub email_send_eicar {
132 0     0 1   my ( $self, $INJECT, $email ) = @_;
133              
134             # http://eicar.org/anti_virus_test_file.htm
135             # X5O!P%@AP[4\PZX54(P^)7CC)7}$EICAR-STANDARD-ANTIVIRUS-TEST-FILE!$H+H*
136              
137 0           print "\n\t\tSending the EICAR test virus - should fail.\n";
138 0           print $INJECT <<EOVIRUS;
139             From: Mail Toaster testing <$email'>
140             To: Email Administrator <$email>
141             Subject: Email test (eicar virus test message)
142             Mime-Version: 1.0
143             Content-Type: multipart/mixed; boundary="gKMricLos+KVdGMg"
144             Content-Disposition: inline
145              
146             --gKMricLos+KVdGMg
147             Content-Type: text/plain; charset=us-ascii
148             Content-Disposition: inline
149              
150             This is an example email containing a virus. It should trigger any good virus
151             scanner.
152              
153             If it is caught by AV software, it will not be delivered to its intended
154             recipient (the email admin). The Qmail-Scanner administrator should receive
155             an Email alerting him/her to the presence of the test virus. All other
156             software should block the message.
157              
158             --gKMricLos+KVdGMg
159             Content-Type: text/plain; charset=us-ascii
160             Content-Disposition: attachment; filename="sneaky.txt"
161              
162             X5O!P%\@AP[4\\PZX54(P^)7CC)7}\$EICAR-STANDARD-ANTIVIRUS-TEST-FILE!\$H+H*
163              
164             --gKMricLos+KVdGMg--
165              
166             EOVIRUS
167             ;
168              
169             }
170              
171             sub email_send_spam {
172 0     0 1   my ( $self, $INJECT, $email ) = @_;
173              
174 0           print "\n\t\tSending a sample spam message - should fail\n";
175              
176 0           print $INJECT 'Return-Path: sb55sb55@yahoo.com
177             Delivery-Date: Mon, 19 Feb 2001 13:57:29 +0000
178             Return-Path: <sb55sb55@yahoo.com>
179             Delivered-To: jm@netnoteinc.com
180             Received: from webnote.net (mail.webnote.net [193.120.211.219])
181             by mail.netnoteinc.com (Postfix) with ESMTP id 09C18114095
182             for <jm7@netnoteinc.com>; Mon, 19 Feb 2001 13:57:29 +0000 (GMT)
183             Received: from netsvr.Internet (USR-157-050.dr.cgocable.ca [24.226.157.50] (may be forged))
184             by webnote.net (8.9.3/8.9.3) with ESMTP id IAA29903
185             for <jm7@netnoteinc.com>; Sun, 18 Feb 2001 08:28:16 GMT
186             From: sb55sb55@yahoo.com
187             Received: from R00UqS18S (max1-45.losangeles.corecomm.net [216.214.106.173]) by netsvr.Internet with SMTP (Microsoft Exchange Internet Mail Service Version 5.5.2653.13)
188             id 1429NTL5; Sun, 18 Feb 2001 03:26:12 -0500
189             DATE: 18 Feb 01 12:29:13 AM
190             Message-ID: <9PS291LhupY>
191             Subject: anti-spam test: checking SpamAssassin [if present] (There yours for FREE!)
192             To: undisclosed-recipients:;
193              
194             Congratulations! You have been selected to receive 2 FREE 2 Day VIP Passes to Universal Studios!
195              
196             Click here http://209.61.190.180
197              
198             As an added bonus you will also be registered to receive vacations discounted 25%-75%!
199              
200              
201             @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
202             This mailing is done by an independent marketing co.
203             We apologize if this message has reached you in error.
204             Save the Planet, Save the Trees! Advertise via E mail.
205             No wasted paper! Delete with one simple keystroke!
206             Less refuse in our Dumps! This is the new way of the new millennium
207             To be removed please reply back with the word "remove" in the subject line.
208             @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
209              
210             ';
211             }
212              
213             sub imap_auth {
214 0     0 0   my $self = shift;
215 0           my %p = validate( @_, { $self->get_std_opts },);
216              
217 0 0         return $p{test_ok} if defined $p{test_ok}; # for testing only
218              
219 0           $self->imap_auth_nossl;
220 0           $self->imap_auth_ssl;
221             };
222              
223             sub imap_auth_nossl {
224 0     0 0   my $self = shift;
225              
226 0           my $r = $self->util->install_module("Mail::IMAPClient", verbose => 0);
227 0           $self->pretty("checking Mail::IMAPClient", $r );
228 0 0         if ( ! $r ) {
229 0           print "skipping imap test authentications\n";
230 0           return;
231             };
232              
233 0           eval "use Mail::IMAPClient"; ## no critic ( ProhibitStringyEval )
234 0 0         if ( $EVAL_ERROR ) {
235 0           $self->audit("unable to load Mail::IMAPClient");
236 0           return;
237             };
238              
239             # an authentication that should succeed
240             my $imap = Mail::IMAPClient->new(
241             User => $self->conf->{'toaster_test_email'} || 'test2@example.com',
242 0   0       Password => $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe',
      0        
243             Server => 'localhost',
244             );
245 0 0         if ( !defined $imap ) {
246 0           $self->pretty( "imap connection", $imap );
247 0           return;
248             };
249              
250 0           $self->pretty( "authenticate IMAP user with plain passwords",
251             $imap->IsAuthenticated );
252              
253 0 0         my @features = $imap->capability
254             or warn "Couldn't determine capability: $@\n";
255 0           $self->audit( "Your IMAP server supports: " . join( ',', @features ) );
256 0           $imap->logout;
257              
258 0           print "an authentication that should fail\n";
259             $imap = Mail::IMAPClient->new(
260             Server => 'localhost',
261             User => 'no_such_user',
262             Pass => 'hi_there_log_watcher'
263             )
264 0 0         or do {
265 0           $self->pretty( "imap connection that should fail", 0);
266 0           return 1;
267             };
268 0           $self->pretty( " imap connection", $imap->IsConnected );
269 0           $self->pretty( " test auth that should fail", !$imap->IsAuthenticated );
270 0           $imap->logout;
271 0           return;
272             };
273              
274             sub imap_auth_ssl {
275 0     0 0   my $self = shift;
276              
277 0   0       my $user = $self->conf->{'toaster_test_email'} || 'test2@example.com';
278 0   0       my $pass = $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe';
279              
280 0           my $r = $self->util->install_module( "IO::Socket::SSL", verbose => 0,);
281 0           $self->pretty( "checking IO::Socket::SSL ", $r);
282 0 0         if ( ! $r ) {
283 0           print "skipping IMAP SSL tests due to missing SSL support\n";
284 0           return;
285             };
286              
287 0           require IO::Socket::SSL;
288 0           my $socket = IO::Socket::SSL->new(
289             PeerAddr => 'localhost',
290             PeerPort => 993,
291             Proto => 'tcp',
292             SSL_verify_mode => 'SSL_VERIFY_NONE',
293             );
294 0           $self->pretty( " imap SSL connection", $socket);
295 0 0         return if ! $socket;
296              
297 0           print " connected with " . $socket->get_cipher . "\n";
298 0           print $socket ". login $user $pass\n";
299 0           ($r) = $socket->peek =~ /OK/i;
300 0 0         $self->pretty( " auth IMAP SSL with plain password", $r ? 0 : 1);
301 0           print $socket ". logout\n";
302 0           close $socket;
303              
304             # no idea why this doesn't work, so I just forge an authentication by printing directly to the socket
305             # my $imapssl = Mail::IMAPClient->new( Socket=>$socket, User=>$user, Password=>$pass) or warn "new IMAP failed: ($@)\n";
306             # $imapssl->IsAuthenticated ? print "ok\n" : print "FAILED.\n";
307              
308             # doesn't work yet because courier doesn't support CRAM-MD5 via the vchkpw auth module
309             # print "authenticating IMAP user with CRAM-MD5...";
310             # $imap->connect;
311             # $imap->authenticate;
312             # $imap->IsAuthenticated ? print "ok\n" : print "FAILED.\n";
313             #
314             # print "logging out...";
315             # $imap->logout;
316             # $imap->IsAuthenticated ? print "FAILED.\n" : print "ok.\n";
317             # $imap->IsConnected ? print "connection open.\n" : print "connection closed.\n";
318              
319             }
320              
321             sub pop3_auth {
322 0     0 0   my $self = shift;
323 0           my %p = validate( @_, { $self->get_std_opts },);
324              
325 0           $OUTPUT_AUTOFLUSH = 1;
326              
327 0           my $r = $self->util->install_module( "Mail::POP3Client", verbose => 0,);
328 0           $self->pretty("checking Mail::POP3Client", $r );
329 0           eval "use Mail::POP3Client"; ## no critic ( ProhibitStringyEval )
330 0 0         if ( $EVAL_ERROR ) {
331 0           print "unable to load Mail::POP3Client, skipping POP3 tests\n";
332 0           return;
333             };
334              
335 0           my %auths = (
336             'POP3' => { type => 'PASS', descr => 'plain text' },
337             'POP3-APOP' => { type => 'APOP', descr => 'APOP' },
338             'POP3-CRAM-MD5' => { type => 'CRAM-MD5', descr => 'CRAM-MD5' },
339             'POP3-SSL' => { type => 'PASS', descr => 'plain text', ssl => 1 },
340             'POP3-SSL-APOP' => { type => 'APOP', descr => 'APOP', ssl => 1 },
341             'POP3-SSL-CRAM-MD5' => { type => 'CRAM-MD5', descr => 'CRAM-MD5', ssl => 1 },
342             );
343              
344 0           foreach ( sort keys %auths ) {
345 0           $self->pop3_auth_prot( $_, $auths{$_} );
346             }
347              
348 0           return 1;
349             }
350              
351             sub pop3_auth_prot {
352 0     0 0   my $self = shift;
353 0           my ( $name, $v ) = @_;
354              
355 0           my $type = $v->{'type'};
356 0           my $descr = $v->{'descr'};
357              
358 0   0       my $user = $self->conf->{'toaster_test_email'} || 'test2@example.com';
359 0   0       my $pass = $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe';
360 0   0       my $host = $self->conf->{'pop3_ip_address_listen_on'} || 'localhost';
361 0 0         $host = "localhost" if ( $host =~ /system|qmail|all/i );
362              
363             my $pop = Mail::POP3Client->new(
364             HOST => $host,
365             AUTH_MODE => $type,
366 0 0         $v->{ssl} ? ( USESSL => 1 ) : (),
367             );
368              
369 0 0         if ( $v->{ssl} ) {
370             my $socket = IO::Socket::SSL->new( PeerAddr => $host,
371             PeerPort => 995,
372             SSL_verify_mode => 'SSL_VERIFY_NONE',
373             Proto => 'tcp',
374             )
375 0 0         or do { warn "No socket!"; return };
  0            
  0            
376              
377 0           $pop->Socket($socket);
378             }
379              
380 0           $pop->User($user);
381 0           $pop->Pass($pass);
382 0 0         $pop->Connect >= 0 || warn $pop->Message;
383 0           $self->pretty( " $name authentication", ($pop->State eq 'TRANSACTION'));
384              
385             # if ( my @features = $pop->Capa ) {
386             # print " POP3 server supports: " . join( ",", @features ) . "\n";
387             # }
388 0           $pop->Close;
389             }
390              
391             sub smtp_auth {
392 0     0 0   my $self = shift;
393 0           my %p = validate( @_, { $self->get_std_opts } );
394              
395 0           my @modules = ('IO::Socket::INET', 'IO::Socket::SSL', 'Net::SSLeay', 'Socket qw(:DEFAULT :crlf)','Net::SMTP_auth');
396 0           foreach ( @modules ) {
397 0           eval "use $_"; ## no critic ( ProhibitStringyEval )
398 0 0         die $@ if $@;
399 0           $self->pretty( "loading $_", 'ok' );
400             };
401              
402 0           Net::SSLeay::load_error_strings();
403 0           Net::SSLeay::SSLeay_add_ssl_algorithms();
404 0           Net::SSLeay::randomize();
405              
406 0   0       my $host = $self->conf->{'smtpd_listen_on_address'} || 'localhost';
407 0 0         $host = 'localhost' if ( $host =~ /system|qmail|all/i );
408              
409 0           my $smtp = Net::SMTP_auth->new($host);
410 0           $self->pretty( "connect to smtp port on $host", $smtp );
411 0 0         return 0 if ! defined $smtp;
412              
413 0           my @auths = $smtp->auth_types;
414 0           $self->pretty( " get list of SMTP AUTH methods", scalar @auths);
415 0           $smtp->quit;
416              
417 0           $self->smtp_auth_pass($host, \@auths);
418 0           $self->smtp_auth_fail($host, \@auths);
419             };
420              
421             sub smtp_auth_pass {
422 0     0 0   my $self = shift;
423 0           my $host = shift;
424 0 0         my $auths = shift or die "invalid params\n";
425              
426 0   0       my $user = $self->conf->{'toaster_test_email'} || 'test2@example.com';
427 0   0       my $pass = $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe';
428              
429             # test each authentication method the server advertises
430 0           foreach (@$auths) {
431              
432 0           my $smtp = Net::SMTP_auth->new($host);
433 0           my $r = $smtp->auth( $_, $user, $pass );
434 0           $self->pretty( " authentication with $_", $r );
435 0 0         next if ! $r;
436              
437 0           $smtp->mail( $self->conf->{'toaster_admin_email'} );
438 0           $smtp->to('postmaster');
439 0           $smtp->data;
440 0           $smtp->datasend("To: postmaster\n");
441 0           $smtp->datasend("\n");
442 0           $smtp->datasend("A simple test message\n");
443 0           $smtp->dataend;
444              
445 0           $smtp->quit;
446 0           $self->pretty(" sending after auth $_", 1 );
447             }
448             }
449              
450             sub smtp_auth_fail {
451 0     0 0   my $self = shift;
452 0           my $host = shift;
453 0 0         my $auths = shift or die "invalid params\n";
454              
455 0           my $user = 'non-exist@example.com';
456 0           my $pass = 'non-password';
457              
458 0           foreach (@$auths) {
459 0           my $smtp = Net::SMTP_auth->new($host);
460 0           my $r = $smtp->auth( $_, $user, $pass );
461 0           $self->pretty( " failed authentication with $_", ! $r );
462 0           $smtp->quit;
463             }
464             }
465              
466             sub run_all {
467 0     0 0   my $self = shift;
468 0           my %p = validate( @_, { $self->get_std_opts } );
469              
470 0           print "testing...\n";
471              
472 0           $self->test_qmail;
473 0           sleep 1;
474 0           $self->daemontools;
475 0           sleep 1;
476 0           $self->ucspi;
477 0           sleep 1;
478              
479 0           $self->dump_audit(quiet=>1); # clear audit history
480              
481 0           $self->supervised_procs;
482 0           sleep 1;
483 0           $self->test_logging;
484 0           sleep 1;
485 0           $self->setup->vpopmail->test;
486 0           sleep 1;
487              
488 0           $self->toaster->check_running_processes;
489 0           sleep 1;
490 0           $self->test_network;
491 0           sleep 1;
492 0           $self->crons;
493 0           sleep 1;
494              
495 0           $self->qmail->check_rcpthosts;
496 0           sleep 1;
497              
498 0 0         if ( ! $self->util->yes_or_no( "skip the mail scanner tests?", timeout => 10 ) ) {
499 0           $self->setup->simscan->test;
500 0           print "\n\nFor more ways to test your Virus scanner, go here:
501             \n\t http://www.testvirus.org/\n\n";
502             };
503 0           sleep 1;
504              
505 0 0         if ( ! $self->util->yes_or_no( "skip the authentication tests?", timeout => 10) ) {
506 0           $self->auth;
507             };
508              
509             # there's plenty more room here for more tests.
510              
511             # test DNS!
512             # make sure primary IP is not reserved IP space
513             # test reverse address for this machines IP
514             # test resulting hostname and make sure it matches
515             # make sure server's domain name has NS records
516             # test MX records for server name
517             # test for SPF records for server name
518              
519             # test for low disk space on /, qmail, and vpopmail partitions
520              
521 0           print "\ntesting complete.\n";
522             }
523              
524             sub auth {
525 0     0 0   my $self = shift;
526 0           my %p = validate( @_, { $self->get_std_opts } );
527              
528 0 0         $self->auth_setup or return;
529              
530 0           $self->imap_auth;
531 0           $self->pop3_auth;
532 0           $self->smtp_auth;
533              
534 0           print
535             "\n\nNOTICE: It is normal for some of the tests to fail. This test suite is useful for any mail server, not just a Mail::Toaster. \n\n";
536              
537             # webmail auth
538             # other ?
539             }
540              
541             sub auth_setup {
542 0     0 0   my $self = shift;
543              
544 0           my $qmail_dir = $self->conf->{qmail_dir};
545 0           my $assign = "$qmail_dir/users/assign";
546 0           my $email = $self->conf->{toaster_test_email};
547 0           my $pass = $self->conf->{toaster_test_email_pass};
548              
549 0           my $domain = ( split( '@', $email ) )[1];
550 0           print "test_auth: testing domain is: $domain.\n";
551              
552 0 0 0       if ( ! -e $assign || ! grep {/:$domain:/} `cat $assign` ) {
  0            
553 0           print "domain $domain is not set up.\n";
554 0 0         return if ! $self->util->yes_or_no( "may I add it for you?", timeout => 30 );
555              
556 0           my $vpdir = $self->conf->{vpopmail_home_dir};
557 0           system "$vpdir/bin/vadddomain $domain $pass";
558 0           system "$vpdir/bin/vadduser $email $pass";
559             }
560              
561 0 0         open( my $ASSIGN, '<', $assign) or return;
562 0 0         return if ! grep {/:$domain:/} <$ASSIGN>;
  0            
563 0           close $ASSIGN;
564              
565 0 0         if ( $OSNAME eq "freebsd" ) {
566 0 0         $self->freebsd->install_port( "p5-Mail-POP3Client" ) or return;
567 0 0         $self->freebsd->install_port( "p5-Mail-IMAPClient" ) or return;
568 0 0         $self->freebsd->install_port( "p5-Net-SMTP_auth" ) or return;
569 0 0         $self->freebsd->install_port( "p5-IO-Socket-SSL" ) or return;
570             }
571 0           return 1;
572             };
573              
574             sub crons {
575 0     0 0   my $self = shift;
576 0           my %p = validate( @_, { $self->get_std_opts },);
577              
578 0           my $tw = $self->util->find_bin( 'toaster-watcher.pl', verbose => 0);
579 0   0       my $vpopdir = $self->conf->{'vpopmail_home_dir'} || "/usr/local/vpopmail";
580              
581 0           my @crons = ( "$vpopdir/bin/clearopensmtp", $tw);
582              
583 0           my $sqcache = "/usr/local/share/sqwebmail/cleancache.pl";
584 0 0 0       push @crons, $sqcache if ( $self->conf->{'install_sqwebmail'} && -x $sqcache);
585              
586 0           print "checking cron processes\n";
587              
588 0           foreach (@crons) {
589 0 0         $self->pretty(" $_", system( $_ ) ? 0 : 1 );
590             }
591             }
592              
593             sub pretty {
594 0     0 0   my $self = shift;
595 0 0         my $mess = shift or croak "test with no args?!";
596 0           my $result = shift;
597              
598 0           my %p = validate(@_, { $self->get_std_opts } );
599 0 0         return $p{test_ok} if defined $p{test_ok};
600              
601 0           print $mess;
602 0 0         defined $result or do { print "\n"; return; };
  0            
  0            
603 0           for ( my $i = length($mess); $i <= 65; $i++ ) { print '.' };
  0            
604 0 0         print $result ? 'ok' : 'FAILED';
605 0           print "\n";
606             };
607              
608             sub test_dns {
609              
610 0     0 0   print <<'EODNS'
611             People forget to even have DNS setup on their Toaster, as Matt has said before. If someone forgot to configure DNS, chances are, little or nothing will work -- from port fetching to timely mail delivery.
612              
613             How about adding a simple DNS check to the Toaster Setup test suite? And in the meantime, you could give some sort of crude benchmark, depending on the circumstances of the test data. I am not looking for something too hefty, but something small and sturdy to make sure there is a good DNS server around answering queries reasonably fast.
614              
615             Here is a sample of some DNS lookups you could perform. What I would envision is that there were around 20 to 100 forward and reverse lookups, and that the lookups were timed. I guess you could look them up in parallel, and wait a maximum of around 15 seconds for all of the replies. The interesting thing about a lot of reverse lookups is that they often fail because no one has published them.
616              
617             Iteration 1: lookup A records.
618             Iteration 2: lookup NS records.
619             Iteration 3: lookup MX records.
620             Iteration 4: lookup TXT records.
621             Iteration 5: Repeat step 1, observe the faster response time due to caching.
622              
623             Here's a sample output! Wow.
624              
625             #toaster_setup.pl -s dnstest
626             Would you like to enter a local domain so I can test it in detail?
627             testmydomain-local.net
628             Would you like to test domains with underscores in them? (y/n)n
629             Testing /etc/rc.conf for a hostname= line...
630             This box is known as smtp.testmydomain-local.net
631             Verifying /etc/hosts exists ... Okay
632             Verifying /etc/host.conf exists ... Okay
633             Verifying /etc/nsswitch.conf exists ... Okay
634             Doing reverse lookups in in-addr.arpa using default name service....
635             Doing forward A lookups using default name service....
636             Doing forward NS lookups using default name service....
637             Doing forward MX lookups using default name service....
638             Doing forward TXT lookups using default name service....
639             Results:
640             [Any errors, like...]
641             Listing Reverses Not found:
642             10.120.187.45 (normal)
643             169.254.89.123 (normal)
644             Listing A Records Not found:
645             example.impossible.nonexistent.bogus.co.nl (normal)
646             Listing TXT Records Not found:
647             Attempting to lookup the same A records again.... Hmmm. much faster!
648             Your DNS Server (or its forwarder) seems to be caching responses. (Good)
649              
650             Checking local domain known as testmydomain-local.net
651             Checking to see if I can query the testmydomain-local.net NS servers and retrieve the entire DNS record...
652             ns1.testmydomain-local.net....yes.
653             ns256.backup-dns.com....yes.
654             ns13.ns-ns-ns.net...no.
655             Do DNS records agree on all DNS servers? Yes. identical.
656             Skipping SOA match.
657              
658             I have discovered that testmydomain-local.net has no MX records. Shame on you, this is a mail server! Please fix this issue and try again.
659              
660             I have discovered that testmydomain-local.net has no TXT records. You may need to consider an SPF v1 TXT record.
661              
662             Here is a dump of your domain records I dug up for you:
663             xoxoxoxox
664              
665             Does hostname agree with DNS? Yes. (good).
666              
667             Is this machine a CNAME for something else in DNS? No.
668              
669             Does this machine have any A records in DNS? Yes.
670             smtp.testmydomain-local.net is 192.168.41.19. This is a private IP.
671              
672             Round-Robin A Records in DNS pointing to another machine/interface?
673             No.
674              
675             Does this machine have any CNAME records in DNS? Yes. aka
676             box1.testmydomain-local.net
677             pop.testmydomain-local.net
678             webmail.testmydomain-local.net
679              
680             ***************DNS Test Output complete
681              
682             Sample Forwards:
683             The first few may be cached, and the last one should fail. Some will have no MX server, some will have many. (The second to last entry has an interesting mail exchanger and priority.) Many of these will (hopefully) not be found in even a good sized DNS cache.
684              
685             I have purposely listed a few more obscure entries to try to get the DNS server to do a full lookup.
686             localhost
687             <vpopmail_default_domain if set>
688             www.google.com
689             yahoo.com
690             nasa.gov
691             sony.co.jp
692             ctr.columbia.edu
693             time.nrc.ca
694             distancelearning.org
695             www.vatican.va
696             klipsch.com
697             simerson.net
698             warhammer.mcc.virginia.edu
699             example.net
700             foo.com
701             example.impossible.nonexistent.bogus.co.nl
702              
703             [need some obscure ones that are probably always around, plus some non-US sample domains.]
704              
705             Sample Reverses:
706             Most of these should be pretty much static. Border routers, nics and such. I was looking for a good range of IP's from different continents and providers. Help needed in some networks. I didn't try to include many that don't have a published reverse name, but many examples exist in case you want to purposely have some.
707             127.0.0.1
708             224.0.0.1
709             198.32.200.50 (the big daddy?!)
710             209.197.64.1
711             4.2.49.2
712             38.117.144.45
713             64.8.194.3
714             72.9.240.9
715             128.143.3.7
716             192.228.79.201
717             192.43.244.18
718             193.0.0.193
719             194.85.119.131
720             195.250.64.90
721             198.32.187.73
722             198.41.3.54
723             198.32.200.157
724             198.41.0.4
725             198.32.187.58
726             198.32.200.148
727             200.23.179.1
728             202.11.16.169
729             202.12.27.33
730             204.70.25.234
731             207.132.116.7
732             212.26.18.3
733             10.120.187.45
734             169.254.89.123
735              
736             [Looking to fill in some of the 12s, 50s and 209s better. Remove some 198s]
737              
738             Just a little project. I'm not sure how I could code it, but it is a little snippet I have been thinking about. I figure that if you write the code once, it would be quite a handy little feature to try on a server you are new to.
739              
740             Billy
741              
742             EODNS
743             ;
744             }
745              
746             sub test_logging {
747 0     0 0   my $self = shift;
748 0           my %p = validate( @_, { $self->get_std_opts },);
749              
750 0           print "do the logging directories exist?\n";
751 0           my $q_log = $self->conf->{'qmail_log_base'};
752 0           foreach ( '', "pop3", "send", "smtp", "submit" ) {
753 0           $self->pretty(" $q_log/$_", -d "$q_log/$_" );
754             }
755              
756 0           print "checking log files?\n";
757 0           my @active_log_files = ( "clean.log", "maildrop.log", "watcher.log",
758             "send/current", "smtp/current", "submit/current" );
759              
760 0 0         push @active_log_files, "pop3/current" if $self->conf->{'pop3_daemon'} eq 'qpop3d';
761              
762 0           foreach ( @active_log_files ) {
763 0           $self->pretty(" $_", -f "$q_log/$_" );
764             }
765             }
766              
767             sub test_network {
768 0     0 0   my $self = shift;
769 0 0         return if $self->util->yes_or_no( "skip the network listener tests?",
770             timeout => 10,
771             );
772              
773 0           my $netstat = $self->util->find_bin( 'netstat', fatal => 0, verbose=>0 );
774 0 0 0       return unless $netstat && -x $netstat;
775              
776 0 0         if ( $OSNAME eq "freebsd" ) { $netstat .= " -alS" }
  0            
777 0 0         if ( $OSNAME eq "darwin" ) { $netstat .= " -al" }
  0            
778 0 0         if ( $OSNAME eq "linux" ) { $netstat .= " -a --numeric-hosts" }
  0            
779 0           else { $netstat .= " -a" }; # should be pretty safe
780              
781 0           print "checking for listening tcp ports\n";
782 0           my @listeners = `$netstat | grep -i listen`;
783 0           foreach (qw( smtp http pop3 imap https submission pop3s imaps )) {
784 0           $self->pretty(" $_", scalar grep {/$_/} @listeners );
  0            
785             }
786              
787 0           print "checking for udp listeners\n";
788 0           my @udps;
789 0 0         push @udps, "snmp" if $self->conf->{install_snmp};
790              
791 0           foreach ( @udps ) {
792 0           $self->pretty(" $_", `$netstat | grep $_` );
793             }
794             }
795              
796             sub test_qmail {
797 0     0 0   my $self = shift;
798 0           my %p = validate( @_, { $self->get_std_opts } );
799              
800 0           my $qdir = $self->conf->{'qmail_dir'};
801 0           print "does qmail's home directory exist?\n";
802 0           $self->pretty(" $qdir", -d $qdir );
803              
804 0           print "checking qmail directory contents\n";
805 0           my @tests = qw(alias boot control man users bin doc queue);
806 0 0         push @tests, "configure" if ( $OSNAME eq "freebsd" ); # added by the port
807 0           foreach (@tests) {
808 0           $self->pretty(" $qdir/$_", -d "$qdir/$_" );
809             }
810              
811 0           print "is the qmail rc file executable?\n";
812 0           $self->pretty( " $qdir/rc", -x "$qdir/rc" );
813              
814 0           print "do the qmail users exist?\n";
815 0   0       foreach (
      0        
      0        
      0        
      0        
      0        
      0        
816             $self->conf->{'qmail_user_alias'} || 'alias',
817             $self->conf->{'qmail_user_daemon'} || 'qmaild',
818             $self->conf->{'qmail_user_passwd'} || 'qmailp',
819             $self->conf->{'qmail_user_queue'} || 'qmailq',
820             $self->conf->{'qmail_user_remote'} || 'qmailr',
821             $self->conf->{'qmail_user_send'} || 'qmails',
822             $self->conf->{'qmail_log_user'} || 'qmaill',
823             )
824             {
825 0           $self->pretty(" $_", $self->setup->user_exists($_) );
826             }
827              
828 0           print "do the qmail groups exist?\n";
829 0   0       foreach ( $self->conf->{'qmail_group'} || 'qmail',
      0        
830             $self->conf->{'qmail_log_group'} || 'qnofiles',
831             ) {
832 0           $self->pretty(" $_", scalar getgrnam($_) );
833             }
834              
835 0           print "do the qmail alias files have contents?\n";
836 0           my $q_alias = "$qdir/alias/.qmail";
837 0           foreach ( qw/ postmaster root mailer-daemon / ) {
838 0           $self->pretty( " $q_alias-$_", -s "$q_alias-$_" );
839             }
840             }
841              
842             sub supervised_procs {
843 0     0 0   my $self = shift;
844              
845 0           print "do supervise directories exist?\n";
846 0   0       my $q_sup = $self->conf->{'qmail_supervise'} || "/var/qmail/supervise";
847 0           $self->pretty(" $q_sup", -d $q_sup);
848              
849             # check supervised directories
850 0           foreach ( qw/ smtp send pop3 submit / ) {
851 0           $self->pretty( " $q_sup/$_",
852             $self->toaster->supervised_dir_test( $_, verbose=>1 ) );
853             }
854              
855 0           print "do service directories exist?\n";
856 0           my $q_ser = $self->conf->{'qmail_service'};
857              
858 0           my @active_service_dirs;
859 0           foreach ( qw/ smtp send / ) {
860 0           push @active_service_dirs, $self->toaster->service_dir_get( $_ );
861             }
862              
863             push @active_service_dirs, $self->toaster->service_dir_get( 'pop3' )
864 0 0         if $self->conf->{'pop3_daemon'} eq 'qpop3d';
865              
866             push @active_service_dirs, $self->toaster->service_dir_get( "submit" )
867 0 0         if $self->conf->{'submit_enable'};
868              
869 0           foreach ( $q_ser, @active_service_dirs ) {
870 0           $self->pretty( " $_", -d $_ );
871             }
872              
873 0           print "are the supervised services running?\n";
874 0           my $svok = $self->util->find_bin( 'svok', fatal => 0 );
875 0           foreach ( @active_service_dirs ) {
876 0 0         $self->pretty( " $_", system("$svok $_") ? 0 : 1 );
877             }
878             };
879              
880             sub ucspi {
881 0     0 0   my $self = shift;
882              
883 0           print "checking ucspi-tcp binaries...\n";
884 0           foreach (qw( tcprules tcpserver rblsmtpd tcpclient recordio )) {
885 0           $self->pretty(" $_", $self->util->find_bin( $_, fatal => 0, verbose=>0 ) );
886             }
887              
888 0 0 0       if ( $self->conf->{install_mysql} && $self->conf->{'vpopmail_mysql'} ) {
889 0           my $tcpserver = $self->util->find_bin( "tcpserver", fatal => 0, verbose=>0 );
890 0           $self->pretty( " tcpserver mysql support",
891             scalar `strings $tcpserver | grep sql`
892             );
893             }
894              
895 0           return 1;
896             }
897              
898             1;
899             __END__;
900              
901              
902             =over 4
903              
904             =item email_send
905              
906              
907             ############ email_send ####################
908             # Usage : $toaster->email_send("clean" );
909             # : $toaster->email_send("spam" );
910             # : $toaster->email_send("attach");
911             # : $toaster->email_send("virus" );
912             # : $toaster->email_send("clam" );
913             #
914             # Purpose : send test emails to test the content scanner
915             # Returns : 1 on success
916             # Parameters : type (clean, spam, attach, virus, clam)
917             # See Also : email_send_[clean|spam|...]
918              
919              
920             Email test routines for testing a mail toaster installation.
921              
922             This sends a test email of a specified type to the postmaster email address configured in toaster-watcher.conf.
923              
924              
925             =item email_send_attach
926              
927              
928             ######### email_send_attach ###############
929             # Usage : internal only
930             # Purpose : send an email with a .com attachment
931             # Parameters : an email address
932             # See Also : email_send
933              
934             Sends a sample test email to the provided address with a .com file extension. If attachment scanning is enabled, this should trigger the content scanner (simscan/qmailscanner/etc) to reject the message.
935              
936              
937             =item email_send_clam
938              
939             Sends a test clam.zip test virus pattern, testing to verify that the AV engine catches it.
940              
941              
942             =item email_send_clean
943              
944             Sends a test clean email that the email filters should not block.
945              
946              
947             =item email_send_eicar
948              
949             Sends an email message with the Eicar virus inline. It should trigger the AV engine and block the message.
950              
951              
952             =item email_send_spam
953              
954             Sends a sample spam message that SpamAssassin should block.
955              
956             =back
957              
958             =cut