#!/usr/bin/perl -w
#
# checkmail.pl
##############

# (c) 2002-2005 Thomas Hochstein  <thh@inter.net>
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.

# Versionsnummer ######################
$ver = '0.2 beta (20050803)';

# Modules #############################
use Getopt::Std;
use Net::DNS;
use Net::SMTP;

# Konfiguration #######################
# Hier  passende Werte einsetzen!     #
#######################################
%config=();
# HELO-/EHLO-Parameter - a valid hostname you own
$config{'helo'} = 'testhost.domain.example';
# MAIL FROM:-Parameter - a valid address you control
$config{'from'} = 'mailtest@testhost.domain.example';
# Zufaelliger Localpart fuer -r - a valid random localpart
$config{'rand'} = 'ZOq62fow1i';

################################################################
# Hauptprogramm #######################

# Konfiguration einlesen
my %options;
getopts('hqlrf:m:', \%options);

if ($options{'h'} or (!$options{'f'} and !$ARGV[0])) {
 print "$0 v $ver\nUsage: $0 [-hqlr] [-m <host>] -f <file>|<address>\n";
 print "Options: -h  display this notice\n";
 print "         -q  quiet (no output, just exit with 0/1/2/3)\n";
 print "         -l  extended logging\n";
 print "         -r  test random address to verify verification\n";
 print "  -m <host>  no DNS lookup, just test this host\n";
 print "  -f <file>  parse file (one address per line)\n";
 print "  <address>  mail address to check\n\n";
 exit(100);
};

if ($options{'f'}) {
 if (-e $options{'f'}) {
  open FILE, "<$options{'f'}" or die("ERROR: Could not open file $options{'f'} for reading: $!");
 } else {
  die("ERROR: File $options{'f'} does not exist!\n");
 };
 $log = '';
 while(<FILE>) {
  chomp;
  ($status,$log) = checkdns($_,$log);
 };
 close FILE;
 # force exit(0)
 $status = 0;
} else {
 ($status,$log) = checkdns($ARGV[0]);
};

print $log if ($options{'l'});

# status 0: valid / batch processing
#        1: invalid
#        2: cannot verify
#        3: temporary (?) failure
exit($status);

################################################################
# Subroutinen #########################

sub checkdns {
 # - fester Host angegeben (-m)?
 # - sonst: MX-Record ermitteln
 # - bei Verbindungsproblemen naechsten MX versuchen
 # - falls kein MX vorhanden, Fallback auf A
 # -> jeweils Adresse testen via checksmtp()
 my ($address,$logging) = @_;
 my ($rr,$mailhost,$status,@mx);
 my $dnsresult = 'okay';
 # (my $lp = $address) =~ s/^([^@]+)@.*/$1/;
 (my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;

 $logging .=  "\n----- BEGIN $address -----\n";

 # DNS-Lookup unterdrueckt?
 if ($options{'m'}) {
  print "    Connection to $options{'m'} forced by -m.\n";
  $logging .=  "Connection to $options{'m'} forced by -m.\n";
  ($status,$logging) = checksmtp($options{'m'},$address,$domain,$logging);
  $logging .= "----- END $address -----\n";
  return ($status,$logging);
 };

 # Resolver-Objekt
 $resolve = Net::DNS::Resolver -> new();
 $resolve->usevc(1);
 $resolve->tcp_timeout(15);

 # MX-Record feststellen
 @mx = mx($resolve,$domain) or $dnsresult = $resolve->errorstring;
 print "    $domain (MX: $dnsresult)\n" if !($options{'q'});

 if (@mx) {
  WALKMX: foreach $rr (@mx) {
   $mailhost = $rr->exchange;
   print "    MX: $mailhost / $address\n" if !($options{'q'});
   $logging .= "Try MX: $mailhost\n";
   ($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
   last WALKMX if ($status < 3);
  };
 } elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
  # wenn kein MX-Record: A-Record feststellen
  $logging .= "MX error: $dnsresult\n";
  $dnsresult = 'okay';
  $query = $resolve->search($domain) or $dnsresult = $resolve->errorstring;
  print "    $domain (A: $dnsresult)\n" if !($options{'q'});
  if ($query) {
   foreach $rr ($query->answer) {
    next unless $rr->type eq "A";
    $mailhost = $rr->address;
    print "    A: $mailhost / $address\n" if !($options{'q'});
    $logging .= "Try A: $mailhost\n";
    ($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
   };
  } elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
   # wenn auch kein A-Record: what a pity ...
   print "  > NO DNS-RECORD (MX/A) FOUND.\n" if !($options{'q'});
   $logging .= "A error: $dnsresult\n";
   $status = 1;
  };
 };
 $logging .= "----- END $address -----\n";
 return ($status,$logging);
};

sub checksmtp {
 # - zu $mailhost verbinden, $adresse testen (SMTP-Dialog bis RCPT TO)
 # - ggf. (-r) testen, ob sicher ungueltige Adresse abgelehnt oder
 #   alles angenommen wird
 my($mailhost,$address,$domain,$logging)=@_;
 my($smtp,$status,$valid);
 $logging .= "-------------------------\n";
 CONNECT: if ($smtp = Net::SMTP->new($mailhost,Hello => $config{'helo'},Timeout => 30)) {
  $logging .= $smtp->banner;
  $logging .= "EHLO $config{'helo'}\n";
  $logging .= parse_reply($smtp->code,$smtp->message);
  $smtp->mail($config{'from'});
  $logging .= "MAIL FROM:<$config{'from'}>\n";
  $logging .= parse_reply($smtp->code,$smtp->message);
  # wird RCPT TO akzeptiert?
  $valid = $smtp->to($address);
  $logging .= "RCPT TO:<$address>\n";
  if ($smtp->code > 0) {
   # es kam eine Antwort auf RCPT TO
   $logging .= parse_reply($smtp->code,$smtp->message);
   if ($valid) {
    # RCPT TO akzeptiert
    $status = 0;
    if ($options{'r'}) {
     # werden sicher ungueltige Adressen abgewiesen?
     $valid = $smtp->to($config{'rand'}.'@'.$domain);
     $logging .= 'RCPT TO:<'.$config{'rand'}.'@'.$domain.">\n";
     if ($smtp->code > 0) {
      # es kam eine Antwort auf RCPT TO (fuer $rand)
      $logging .= parse_reply($smtp->code,$smtp->message);
      if ($valid) {
       # ungueltiges RCPT TO akzeptiert
       print "  > Sorry, cannot verify. You'll have to send a testmail ...\n" if !($options{'q'});
       $status = 2;
      };
     } else {
      # Timeout nach RCPT TO (fuer $rand)
      print "  > Temporary failure.\n" if !($options{'q'});
      $logging .= "---Timeout---\n";
      $smtp->quit;
      $status = 3;
     };
    };
    print "  > Address is valid.\n" if (!$status and !$options{'q'});
   } else {
    # RCPT TO nicht akzeptiert
    print "  > Address is INVALID.\n" if !($options{'q'});
    $status = 1;
   };
   # Verbindung beenden
   $smtp->quit;
   $logging .= "QUIT\n";
   $logging .= parse_reply($smtp->code,$smtp->message);
  } else {
   # Timeout nach RCPT TO
   print "  > Temporary failure.\n" if !($options{'q'});
   $logging .= "---Timeout---\n";
   $smtp->quit;
   $status = 3;
  };
 } else {
  # Verbindung fehlgeschlagen
  print "  > Temporary failure.\n" if !($options{'q'});
  $logging .= "---Timeout---\n";
  $status = 3;
 };
 return ($status,$logging);
};

sub parse_reply {
  my($code,$message)=@_;
  my($reply);
  $reply = $code . ' ' . $message;
  return $reply;
}