checkmail.pl

   1 #! /usr/bin/perl -W
   2 #
   3 # checkmail Version 0.3 by Thomas Hochstein
   4 #
   5 # This script tries to verify the deliverability of (a) mail address(es).
   6 #
   7 # Copyright (c) 2002-2010 Thomas Hochstein <thh@inter.net>
   8 #
   9 # It can be redistributed and/or modified under the same terms under
  10 # which Perl itself is published.
  11
  12 our $VERSION = "0.3";
  13
  14 ################################# Configuration ################################
  15 # Please fill in a working configuration!
  16 my %config=(
  17             # value used for HELO/EHLO - a valid hostname you own
  18             helo => 'testhost.domain.example',
  19             # value used for MAIL FROM: - a valid address under your control
  20             from => 'mailtest@testhost.domain.example'
  21            );
  22
  23 ################################### Modules ####################################
  24 use strict;
  25 use File::Basename;
  26 use Getopt::Std;
  27 use Net::DNS;
  28 use Net::SMTP;
  29
  30 ################################# Main program #################################
  31
  32 $Getopt::Std::STANDARD_HELP_VERSION = 1;
  33 my $myself = basename($0);
  34
  35 # read commandline options
  36 my %options;
  37 getopts('Vhqlrf:m:', \%options);
  38
  39 # -V: display version
  40 if ($options{'V'}) {
  41   print "$myself v $VERSION\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
  42   print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
  43   exit(100);
  44 };
  45
  46 # -h: feed myself to perldoc
  47 if ($options{'h'}) {
  48   exec('perldoc', $0);
  49   exit(100);
  50 };
  51
  52 # display usage information if neither -f nor an address are present
  53 if (!$options{'f'} and !$ARGV[0]) {
  54   print "Usage: $myself [-hqlr] [-m <host>] <address>|-f <file>\n";
  55   print "Options: -V  display copyright and version\n";
  56   print "         -h  show documentation\n";
  57   print "         -q  quiet (no output, just exit with 0/1/2/3)\n";
  58   print "         -l  extended logging\n";
  59   print "         -r  test random address to verify verification\n";
  60   print "  -m <host>  no DNS lookup, just test this host\n";
  61   print "  <address>  mail address to check\n\n";
  62   print "  -f <file>  parse file (one address per line)\n";
  63   exit(100);
  64 };
  65
  66 # -f: open file and read addresses to @adresses
  67 my @addresses;
  68 if ($options{'f'}) {
  69  if (-e $options{'f'}) {
  70   open FILE, "<$options{'f'}" or die("$myself ERROR: Could not open file $options{'f'} for reading: $!");
  71  } else {
  72   die("$myself ERROR: File $options{'f'} does not exist!\n");
  73  };
  74  while(<FILE>) {
  75   chomp;
  76   push(@addresses,$_);
  77  };
  78  close FILE;
  79 # fill @adresses with single address to check
  80  } else {
  81   push(@addresses,$ARGV[0]);
  82 };
  83
  84 # loop over each address and test it
  85 my (%targets,$curstat,$status,$log,$message);
  86 foreach (@addresses) {
  87   my $address = $_;
  88   (undef,my $domain) = splitaddress($address);
  89   printf("  * Testing %s ...\n",$address) if !($options{'q'});
  90   $log .=  "\n===== BEGIN $address =====\n";
  91   # get list of target hosts or take host forced via -m
  92   if (!$options{'m'}) {
  93           %targets = %{gettargets($domain,\$log)};
  94   } else {
  95     $message = sprintf("Connection to %s forced by -m.\n",$options{'m'});
  96     $log .= $message;
  97     print "    $message" if !($options{'q'});
  98     # just one target host with preference 0
  99     $targets{$options{'m'}} = 0;
 100   };
 101   if (%targets) {
 102     $curstat = checkaddress($address,\%targets,\$log);
 103   } else {
 104     $curstat = 2;
 105     $message = 'DNS lookup failure';
 106     printf("  > Address is INVALID (%s).\n",$message) if !($options{'q'});
 107     $log .= $message . '.';
 108   };
 109   $log   .=  "====== END $address ======\n";
 110   $status = $curstat if (!defined($status) or $curstat > $status);
 111 };
 112
 113 print $log if ($options{'l'});
 114
 115 # status 0: valid / batch processing
 116 #        1: connection failed or temporary failure
 117 #        2: invalid
 118 #        3: cannot verify
 119 #D print "\n-> EXIT $status\n";
 120 exit($status);
 121
 122 ################################## gettargets ##################################
 123 # get mail exchanger(s) or A record(s) for a domain
 124 # IN : $domain: domain to query the DNS for
 125 # OUT: \%targets: reference to a hash containing a list of target hosts
 126 sub gettargets {
 127   my ($domain,$logr) = @_;
 128   # resolver objekt
 129   my $resolver = Net::DNS::Resolver->new(udp_timeout => 15, tcp_timeout => 15);
 130
 131   my %targets;
 132   # get MX record(s) as a list sorted by preference
 133   if (my @mxrr = mx($resolver,$domain)) {
 134     print_dns_result($domain,'MX',scalar(@mxrr),undef,$logr);
 135     foreach my $rr (@mxrr) {
 136          $targets{$rr->exchange} = $rr->preference;
 137          $$logr .= sprintf("(%d) %s\n",$rr->preference,$rr->exchange);
 138     };
 139   # no MX record found; log and try A record(s)
 140   } else {
 141     print_dns_result($domain,'MX',undef,$resolver->errorstring,$logr);
 142     print("    Falling back to A record ...\n") if !($options{'q'});
 143         # get A record(s)
 144     if (my $query = $resolver->query($domain,'A','IN')) {
 145       print_dns_result($domain,'A',$query->header->ancount,undef,$logr);
 146       foreach my $rr ($query->answer) {
 147         $targets{$rr->address} = 0;
 148         $$logr .= sprintf("- %s\n",$rr->address);
 149       };
 150     # no A record found either; log and fail
 151     } else {
 152       print_dns_result($domain,'A',undef,$resolver->errorstring,$logr);
 153       printf("    %s has neither MX nor A records - mail cannot be delivered.\n",$domain) if !($options{'q'});
 154     };
 155   };
 156   return \%targets;
 157 };
 158
 159 ################################# checkaddress #################################
 160 # test address for deliverability
 161 # IN : $address: adress to be tested
 162 #      \%targets: reference to a hash containing a list of MX hosts
 163 #      \$log    : reference to the log (to be printed out via -l)
 164 # OUT: ---
 165 #      \$log will be changed
 166 sub checkaddress {
 167   my ($address,$targetsr,$logr) = @_;
 168   my %targets = %{$targetsr};
 169   my $status;
 170   # walk %targets in order of preference
 171   foreach my $host (sort { $targets{$a} <=> $targets{$b} } keys %targets) {
 172     printf("  / Trying %s (%s) with %s\n",$host,$targets{$host} || 'A',$address) if !($options{'q'});
 173           $$logr .= sprintf("%s:\n%s\n",$host,"-" x (length($host)+1));
 174           $status = checksmtp($address,$host,$logr);
 175           last if ($status != 1);
 176   };
 177   return $status;
 178 };
 179
 180 ################################### checksmtp ##################################
 181 # connect to a remote machine on port 25 and test deliverability of a mail
 182 # address by doing the SMTP dialog until RCPT TO stage
 183 # IN : $address: address to test
 184 #      $target : target host
 185 #      \$log    : reference to the log (to be printed out via -l)
 186 # OUT: .........: reference to a hash containing a list of target hosts
 187 #      \$log will be changed
 188 sub checksmtp {
 189   my ($address,$target,$logr) = @_;
 190   my ($status);
 191   # start SMTP connection
 192   if (my $smtp = Net::SMTP->new($target,Hello => $config{'helo'},Timeout => 30)) {
 193     $$logr .= $smtp->banner; # Net::SMTP doesn't seem to support multiline greetings.
 194     $$logr .= "EHLO $config{'helo'}\n";
 195     log_smtp_reply($logr,$smtp->code,$smtp->message);
 196     $smtp->mail($config{'from'});
 197     $$logr .= "MAIL FROM:<$config{'from'}>\n";
 198     log_smtp_reply($logr,$smtp->code,$smtp->message);
 199     # test address
 200     my ($success,$code,@message) = try_rcpt_to(\$smtp,$address,$logr);
 201     # connection failure?
 202     if ($success < 0) {
 203       $status = connection_failed(@message);
 204     # delivery attempt was successful?
 205     } elsif ($success) {
 206       # -r: try random address (which should be guaranteed to be invalid)
 207       if ($options{'r'}) {
 208         (undef,my $domain) = splitaddress($address);
 209         my ($success,$code,@message) = try_rcpt_to(\$smtp,create_rand_addr($domain),$logr);
 210         # connection failure?
 211         if ($success < 0) {
 212           $status = connection_failed(@message);
 213         # verification impossible?
 214         } elsif ($success) {
 215           $status = 3;
 216           print "  > Address verificaton impossible. You'll have to send a test mail ...\n" if !($options{'q'});
 217         }
 218       }
 219       # if -r is not set or status was not set to 3: valid address
 220       if (!defined($status)) {
 221         $status = 0;
 222         print "  > Address is valid.\n" if !($options{'q'});
 223       };
 224     # delivery attempt failed?
 225     } else {
 226       $status = 2;
 227       print "  > Address is INVALID:\n" if !($options{'q'});
 228       print '    ' . join('    ',@message) if !($options{'q'});
 229     }
 230     # terminate SMTP connection
 231     $smtp->quit;
 232     $$logr .= "QUIT\n";
 233     log_smtp_reply($logr,$smtp->code,$smtp->message);
 234   } else {
 235     # SMTP connection failed / timeout
 236     $status = connection_failed();
 237     $$logr .= "---Connection failure---\n";
 238   };
 239   return $status;
 240 }
 241
 242 ################################# splitaddress #################################
 243 # split mail address into local and domain part
 244 # IN : $address: a mail address
 245 # OUT: $local : local part
 246 #      $domain: domain part
 247 sub splitaddress {
 248   my($address)=@_;
 249   (my $lp = $address) =~ s/^([^@]+)@.*/$1/;
 250   (my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;
 251   return ($lp,$domain);
 252 };
 253
 254 ############################### create_rand_addr ###############################
 255 # create a random mail address
 256 # IN : $domain: the domain part
 257 # OUT: $address: the address
 258 sub create_rand_addr {
 259   my($domain)=@_;
 260   my $allowed = 'ABCDEFGHJKLMNPQRSTUVWXYZabcdefghjkmnpqrstuvwxyz23456789-+_=';
 261   my $address = '';
 262   while (length($address) < 15) {
 263     $address .= substr($allowed, (int(rand(length($allowed)))),1);
 264   };
 265   return ($address.'@'.$domain);
 266 };
 267
 268 ################################ parse_dns_reply ###############################
 269 # parse DNS response codes and return code and description
 270 # IN : $response: a DNS response code
 271 # OUT: "$response ($desciption)"
 272 sub parse_dns_reply {
 273   my($response)=@_;
 274   my %dnsrespcodes = (NOERROR  => 'empty response',
 275                       NXDOMAIN => 'non-existent domain',
 276                       SERVFAIL => 'DNS server failure',
 277                       REFUSED  => 'DNS query refused',
 278                       FORMERR  => 'format error',
 279                       NOTIMP   => 'not implemented');
 280   if(defined($dnsrespcodes{$response})) {
 281     return sprintf('%s (%s)',$response,$dnsrespcodes{$response});
 282   } else {
 283     return $response;
 284   };
 285 };
 286
 287 ############################### print_dns_result ###############################
 288 # print and log result of DNS query
 289 # IN : $domain: domain the DNS was queried for
 290 #      $type  : record type (MX, A, ...)
 291 #      $count : number of records found
 292 #      $error : DNS response code
 293 #      \$log : reference to the log (to be printed out via -l)
 294 # OUT: ---
 295 #      \$log will be changed
 296 sub print_dns_result {
 297   my ($domain,$type,$count,$error,$logr) = @_;
 298   if (defined($count)) {
 299     printf("    %d %s record(s) found for %s\n",$count,$type,$domain) if !($options{'q'});
 300     $$logr .= sprintf("%s DNS record(s):\n",$type);
 301   } else {
 302     printf("    No %s records found for %s: %s\n",$type,$domain,parse_dns_reply($error)) if !($options{'q'});
 303     $$logr .= sprintf("No %s records found: %s\n",$type,parse_dns_reply($error));
 304   };
 305   return;
 306 };
 307
 308 ################################## try_rcpt_to #################################
 309 # send RCPT TO and return replies
 310 # IN : \$smtp    : a reference to an SMTP object
 311 #      $recipient: a mail address
 312 #      \$log     : reference to the log (to be printed out via -l)
 313 # OUT: $success: exit code (0 for false, 1 for true, -1 for tempfail)
 314 #      $code   : SMTP status code
 315 #      $message: SMTP status message
 316 #      \$log will be changed
 317 sub try_rcpt_to {
 318   my($smtpr,$recipient,$logr)=@_;
 319   $$logr .= sprintf("RCPT TO:<%s>\n",$recipient);
 320   my $success;
 321   $$smtpr->to($recipient);
 322   if ($$smtpr->code) {
 323     log_smtp_reply($logr,$$smtpr->code,$$smtpr->message);
 324     $success = analyze_smtp_reply($$smtpr->code,$$smtpr->message);
 325   } else {
 326     $success = -1;
 327     $$logr .= "---Connection failure---\n";
 328   };
 329   return ($success,$$smtpr->code,$$smtpr->message);
 330 };
 331
 332 ################################ log_smtp_reply ################################
 333 # log result of SMTP command
 334 # IN : \$log    : reference to the log (to be printed out via -l)
 335 #      $code    : SMTP status code
 336 #      @message : SMTP status message
 337 # OUT: ---
 338 #      \$log will be changed
 339 sub log_smtp_reply {
 340   my($logr,$code,@message)=@_;
 341   $$logr .= sprintf('%s %s',$code,join('- ',@message));
 342   return;
 343 }
 344
 345 ############################### analyze_smtp_reply ##############################
 346 # analyze SMTP response codes and messages
 347 # IN : $code    : SMTP status code
 348 #      @message : SMTP status message
 349 # OUT: exit code (0 for false, 1 for true, -1 for tempfail)
 350 sub analyze_smtp_reply {
 351   my($code,@message)=@_;
 352   my $type = substr($code, 0, 1);
 353   if ($type == 2) {
 354     return 1;
 355   } elsif ($type == 5) {
 356     return 0;
 357   } elsif ($type == 4) {
 358     return -1;
 359   };
 360   return -1;
 361 }
 362
 363 ############################## connection_failed ###############################
 364 # print failure message and return status 1
 365 # IN : @message : SMTP status message
 366 # OUT: 1
 367 sub connection_failed {
 368   my(@message)=@_;
 369   print "  ! Connection failed or other temporary failure.\n" if !($options{'q'});
 370   printf("    %s\n",join('    ',@message)) if @message;
 371   return 1;
 372 }
 373
 374 __END__
 375
 376 ################################ Documentation #################################
 377
 378 =head1 NAME
 379
 380 checkmail - check deliverability of a mail address
 381
 382 =head1 SYNOPSIS
 383
 384 B<checkmail> [B<-Vhqlr>] [B<-m> I<host>] I<address>|B<-f> I<file>
 385
 386 =head1 REQUIREMENTS
 387
 388 =over 2
 389
 390 =item -
 391
 392 Perl 5.8 or later
 393
 394 =item -
 395
 396 File::Basename
 397
 398 =item -
 399
 400 Getopt::Std
 401
 402 =item -
 403
 404 Net::DNS I<(CPAN)>
 405
 406 =item -
 407
 408 Net::SMTP
 409
 410 =back
 411
 412 Furthermore you'll need a working DNS installation.
 413
 414 =head1 DESCRIPTION
 415
 416 checkmail checks the vailidity / deliverability of a mail address.
 417 You may submit just one address as the last argument or a file
 418 containing one address on each line using the B<-f> option.
 419
 420 =head2 Configuration
 421
 422 For the time being, all configuration is done in the script. You have
 423 to set the following elements of the %config hash:
 424
 425 =over 4
 426
 427 =item B<$config{'helo'}>
 428
 429 The hostname to be used for I<HELO> or I<EHLO> in the SMTP dialog.
 430
 431 =item B<$config{'from'}>
 432
 433 The sender address to be used for I<MAIL FROM> while testing.
 434
 435 =back
 436
 437 =head2 Usage
 438
 439 After configuring the script you may run your first test with
 440
 441     checkmail user@example.org
 442
 443 B<checkmail> will try to determine the mail exchanger(s) (MX)
 444 responsible for I<example.org> by querying the DNS for the respective
 445 MX records and then try to connect via SMTP (on port 25) to each of
 446 them in order of precedence (if necessary). It will run through the
 447 SMTP dialog until just before the I<DATA> stage, i.e. doing I<EHLO>,
 448 I<MAIL FROM> and I<RCPT TO>. If no MX is defined, B<checkmail> will
 449 fall back to the I<example.org> host itself, provided there is at
 450 least one A record defined in the DNS. If there are neither MX nor A
 451 records for I<example.org>, mail is not deliverable and B<checkmail>
 452 will fail accordingly. If no host can be reached, B<checkmail> will
 453 fail, too. Finally B<checkmail> will fail if mail to the given
 454 recipient is not accepted by the respective host.
 455
 456 If B<checkmail> fails, you'll not be able to deliver mail to that
 457 address - at least not using the configured sender address and from
 458 the host you're testing from. However, the opposite is not true: a
 459 mail you send may still not be delivered even if a test via
 460 B<checkmail> succeeds. The receiving entity may reject your mail after
 461 the I<DATA> stage, due to content checking or without any special
 462 reason, or it may even drop, filter or bounce your mail after finally
 463 accepting it. There is no way to be sure a mail will be accepted short
 464 of sending a real mail to the address in question.
 465
 466 You may, however, try to detect hosts that will happily accept any and
 467 all recipient in the SMTP dialog and just reject your mail later on,
 468 for example to defeat exactly the kind of check you try to do.
 469 B<checkmail> will do that by submitting a recipient address that is
 470 known to be invalid; if that address is accepted, too, you'll know
 471 that you can't reliably check the validity of any address on that
 472 host. You can force that check by using the B<-r> option.
 473
 474 If you don't want to see just the results of your test, you can get a
 475 B<complete log> of the SMTP dialog by using the B<-l> option. That may be
 476 helpful to test for temporary failure conditions.
 477
 478 On the other hand you may use the B<-q> option to suppress all output;
 479 B<checkmail> will then terminate with one of the following B<exit
 480 status>:
 481
 482 =over 4
 483
 484 =item B<0>
 485
 486 address(es) seem/seems to be valid
 487
 488 =item B<1>
 489
 490 temporary error (connection failure or temporary failure)
 491
 492 =item B<2>
 493
 494 address is invalid
 495
 496 =item B<3>
 497
 498 address cannot reliably be checked (test using B<-r> failed)
 499
 500 =back
 501
 502 You can do B<batch processing> using B<-f> and submitting a file with
 503 one address on each line. In that case the exit status is set to the
 504 highest value generated by testing all addresses, i.e. it is set to
 505 B<0> if and only if no adress failed, but to B<2> if even one address
 506 failed and to B<3> if even one addresses couldn't reliably be checked.
 507
 508 And finally you can B<suppress DNS lookups> for MX and A records and
 509 just force B<checkmail> to connect to a particular host using the
 510 B<-m> option.
 511
 512 B<Please note:> You shouldn't try to validate addresses while working
 513 from a dial-up or blacklisted host. If in doubt, use the B<-l> option
 514 to have a closer look on the SMTP dialog yourself.
 515
 516 =head1 OPTIONS
 517
 518 =over 3
 519
 520 =item B<-V> (version)
 521
 522 Print out version and copyright information on B<checkmail> and exit.
 523
 524 =item B<-h> (help)
 525
 526 Print this man page and exit.
 527
 528 =item B<-q> (quit)
 529
 530 Suppress output and just terminate with a specific exit status.
 531
 532 =item B<-l> (log)
 533
 534 Log and print out the whole SMTP dialog.
 535
 536 =item B<-r> (random address)
 537
 538 Also try a reliably invalid address to catch hosts that try undermine
 539 address verification.
 540
 541 =item B<-m> I<host> (MX to use)
 542
 543 Force a connection to I<host> to check deliverability to that
 544 particular host irrespective of DNS entries. For example:
 545
 546     checkmail -m test.host.example user@domain.example
 547
 548 =item B<-f> I<file> (file)
 549
 550 Process all addresses from I<file> (one on each line).
 551
 552 =back
 553
 554 =head1 INSTALLATION
 555
 556 Just copy checkmail to some directory and get started.
 557
 558 You can run your first test with
 559
 560     checkmail user@example.org
 561
 562 =head1 ENVIRONMENT
 563
 564 See documentation of I<Net::DNS::Resolver>.
 565
 566 =head1 FILES
 567
 568 =over 4
 569
 570 =item F<checkmail.pl>
 571
 572 The script itself.
 573
 574 =back
 575
 576 =head1 BUGS
 577
 578 Please report any bugs or feature request to the author or use the
 579 bug tracker at L<http://bugs.th-h.de/>!
 580
 581 =head1 SEE ALSO
 582
 583 L<http://th-h.de/download/scripts.php> will have the current
 584 version of this program.
 585
 586 This program is maintained using the Git version control system. You
 587 may clone L<git://code.th-h.de/mail/checkmail.git> to check out the
 588 current development tree or browse it on the web via
 589 L<http://code.th-h.de/?p=mail/checkmail.git>.
 590
 591 =head1 AUTHOR
 592
 593 Thomas Hochstein <thh@inter.net>
 594
 595 =head1 COPYRIGHT AND LICENSE
 596
 597 Copyright (c) 2002-2010 Thomas Hochstein <thh@inter.net>
 598
 599 This program is free software; you may redistribute it and/or modify it
 600 under the same terms as Perl itself.
 601
 602 =cut