checkmail.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # checkmail.pl
   4 ##############
   5
   6 # (c) 2002-2005 Thomas Hochstein  <thh@inter.net>
   7 #
   8 # This program is free software; you can redistribute it and/or modify it under
   9 # the terms of the GNU General Public License as published by the Free
  10 # Software Foundation; either version 2 of the License, or (at your option)
  11 # any later version.
  12 # This program is distributed in the hope that it will be useful, but WITHOUT
  13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
  15 # more details.
  16
  17 # Versionsnummer ######################
  18 $ver = '0.2 beta (20050803)';
  19
  20 # Modules #############################
  21 use Getopt::Std;
  22 use Net::DNS;
  23 use Net::SMTP;
  24
  25 # Konfiguration #######################
  26 # Hier  passende Werte einsetzen!     #
  27 #######################################
  28 %config=();
  29 # HELO-/EHLO-Parameter - a valid hostname you own
  30 $config{'helo'} = 'testhost.domain.example';
  31 # MAIL FROM:-Parameter - a valid address you control
  32 $config{'from'} = 'mailtest@testhost.domain.example';
  33 # Zufaelliger Localpart fuer -r - a valid random localpart
  34 $config{'rand'} = 'ZOq62fow1i';
  35
  36 ################################################################
  37 # Hauptprogramm #######################
  38
  39 # Konfiguration einlesen
  40 my %options;
  41 getopts('hqlrf:m:', \%options);
  42
  43 if ($options{'h'} or (!$options{'f'} and !$ARGV[0])) {
  44  print "$0 v $ver\nUsage: $0 [-hqlr] [-m <host>] -f <file>|<address>\n";
  45  print "Options: -h  display this notice\n";
  46  print "         -q  quiet (no output, just exit with 0/1/2/3)\n";
  47  print "         -l  extended logging\n";
  48  print "         -r  test random address to verify verification\n";
  49  print "  -m <host>  no DNS lookup, just test this host\n";
  50  print "  -f <file>  parse file (one address per line)\n";
  51  print "  <address>  mail address to check\n\n";
  52  exit(100);
  53 };
  54
  55 if ($options{'f'}) {
  56  if (-e $options{'f'}) {
  57   open FILE, "<$options{'f'}" or die("ERROR: Could not open file $options{'f'} for reading: $!");
  58  } else {
  59   die("ERROR: File $options{'f'} does not exist!\n");
  60  };
  61  $log = '';
  62  while(<FILE>) {
  63   chomp;
  64   ($status,$log) = checkdns($_,$log);
  65  };
  66  close FILE;
  67  # force exit(0)
  68  $status = 0;
  69 } else {
  70  ($status,$log) = checkdns($ARGV[0]);
  71 };
  72
  73 print $log if ($options{'l'});
  74
  75 # status 0: valid / batch processing
  76 #        1: invalid
  77 #        2: cannot verify
  78 #        3: temporary (?) failure
  79 exit($status);
  80
  81 ################################################################
  82 # Subroutinen #########################
  83
  84 sub checkdns {
  85  # - fester Host angegeben (-m)?
  86  # - sonst: MX-Record ermitteln
  87  # - bei Verbindungsproblemen naechsten MX versuchen
  88  # - falls kein MX vorhanden, Fallback auf A
  89  # -> jeweils Adresse testen via checksmtp()
  90  my ($address,$logging) = @_;
  91  my ($rr,$mailhost,$status,@mx);
  92  my $dnsresult = 'okay';
  93  # (my $lp = $address) =~ s/^([^@]+)@.*/$1/;
  94  (my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;
  95
  96  $logging .=  "\n----- BEGIN $address -----\n";
  97
  98  # DNS-Lookup unterdrueckt?
  99  if ($options{'m'}) {
 100   print "    Connection to $options{'m'} forced by -m.\n";
 101   $logging .=  "Connection to $options{'m'} forced by -m.\n";
 102   ($status,$logging) = checksmtp($options{'m'},$address,$domain,$logging);
 103   $logging .= "----- END $address -----\n";
 104   return ($status,$logging);
 105  };
 106
 107  # Resolver-Objekt
 108  $resolve = Net::DNS::Resolver -> new();
 109  $resolve->usevc(1);
 110  $resolve->tcp_timeout(15);
 111
 112  # MX-Record feststellen
 113  @mx = mx($resolve,$domain) or $dnsresult = $resolve->errorstring;
 114  print "    $domain (MX: $dnsresult)\n" if !($options{'q'});
 115
 116  if (@mx) {
 117   WALKMX: foreach $rr (@mx) {
 118    $mailhost = $rr->exchange;
 119    print "    MX: $mailhost / $address\n" if !($options{'q'});
 120    $logging .= "Try MX: $mailhost\n";
 121    ($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
 122    last WALKMX if ($status < 3);
 123   };
 124  } elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
 125   # wenn kein MX-Record: A-Record feststellen
 126   $logging .= "MX error: $dnsresult\n";
 127   $dnsresult = 'okay';
 128   $query = $resolve->search($domain) or $dnsresult = $resolve->errorstring;
 129   print "    $domain (A: $dnsresult)\n" if !($options{'q'});
 130   if ($query) {
 131    foreach $rr ($query->answer) {
 132     next unless $rr->type eq "A";
 133     $mailhost = $rr->address;
 134     print "    A: $mailhost / $address\n" if !($options{'q'});
 135     $logging .= "Try A: $mailhost\n";
 136     ($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
 137    };
 138   } elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
 139    # wenn auch kein A-Record: what a pity ...
 140    print "  > NO DNS-RECORD (MX/A) FOUND.\n" if !($options{'q'});
 141    $logging .= "A error: $dnsresult\n";
 142    $status = 1;
 143   };
 144  };
 145  $logging .= "----- END $address -----\n";
 146  return ($status,$logging);
 147 };
 148
 149 sub checksmtp {
 150  # - zu $mailhost verbinden, $adresse testen (SMTP-Dialog bis RCPT TO)
 151  # - ggf. (-r) testen, ob sicher ungueltige Adresse abgelehnt oder
 152  #   alles angenommen wird
 153  my($mailhost,$address,$domain,$logging)=@_;
 154  my($smtp,$status,$valid);
 155  $logging .= "-------------------------\n";
 156  CONNECT: if ($smtp = Net::SMTP->new($mailhost,Hello => $config{'helo'},Timeout => 30)) {
 157   $logging .= $smtp->banner;
 158   $logging .= "EHLO $config{'helo'}\n";
 159   $logging .= parse_reply($smtp->code,$smtp->message);
 160   $smtp->mail($config{'from'});
 161   $logging .= "MAIL FROM:<$config{'from'}>\n";
 162   $logging .= parse_reply($smtp->code,$smtp->message);
 163   # wird RCPT TO akzeptiert?
 164   $valid = $smtp->to($address);
 165   $logging .= "RCPT TO:<$address>\n";
 166   if ($smtp->code > 0) {
 167    # es kam eine Antwort auf RCPT TO
 168    $logging .= parse_reply($smtp->code,$smtp->message);
 169    if ($valid) {
 170     # RCPT TO akzeptiert
 171     $status = 0;
 172     if ($options{'r'}) {
 173      # werden sicher ungueltige Adressen abgewiesen?
 174      $valid = $smtp->to($config{'rand'}.'@'.$domain);
 175      $logging .= 'RCPT TO:<'.$config{'rand'}.'@'.$domain.">\n";
 176      if ($smtp->code > 0) {
 177       # es kam eine Antwort auf RCPT TO (fuer $rand)
 178       $logging .= parse_reply($smtp->code,$smtp->message);
 179       if ($valid) {
 180        # ungueltiges RCPT TO akzeptiert
 181        print "  > Sorry, cannot verify. You'll have to send a testmail ...\n" if !($options{'q'});
 182        $status = 2;
 183       };
 184      } else {
 185       # Timeout nach RCPT TO (fuer $rand)
 186       print "  > Temporary failure.\n" if !($options{'q'});
 187       $logging .= "---Timeout---\n";
 188       $smtp->quit;
 189       $status = 3;
 190      };
 191     };
 192     print "  > Address is valid.\n" if (!$status and !$options{'q'});
 193    } else {
 194     # RCPT TO nicht akzeptiert
 195     print "  > Address is INVALID.\n" if !($options{'q'});
 196     $status = 1;
 197    };
 198    # Verbindung beenden
 199    $smtp->quit;
 200    $logging .= "QUIT\n";
 201    $logging .= parse_reply($smtp->code,$smtp->message);
 202   } else {
 203    # Timeout nach RCPT TO
 204    print "  > Temporary failure.\n" if !($options{'q'});
 205    $logging .= "---Timeout---\n";
 206    $smtp->quit;
 207    $status = 3;
 208   };
 209  } else {
 210   # Verbindung fehlgeschlagen
 211   print "  > Temporary failure.\n" if !($options{'q'});
 212   $logging .= "---Timeout---\n";
 213   $status = 3;
 214  };
 215  return ($status,$logging);
 216 };
 217
 218 sub parse_reply {
 219   my($code,$message)=@_;
 220   my($reply);
 221   $reply = $code . ' ' . $message;
 222   return $reply;
 223 }
 224