From 431fbb123350433e171c4cfda0c3f63ad3cb1ed9 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Wed, 16 Jun 2010 16:38:06 +0200 Subject: [PATCH] Complete rewrite. - use strict; - modularize code - refactor application logic - more verbose output - test MXes in order of precedence - cope with multi-line responses - slightly change meaning of exit status - batch processing: set exit status to highest generated value Fixes #9. Fixes #10. Signed-off-by: Thomas Hochstein --- checkmail.pl | 487 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 300 insertions(+), 187 deletions(-) diff --git a/checkmail.pl b/checkmail.pl index a356f09..b7da4e2 100644 --- a/checkmail.pl +++ b/checkmail.pl @@ -1,224 +1,337 @@ -#!/usr/bin/perl -w +#! /usr/bin/perl -W # -# checkmail.pl -############## - -# (c) 2002-2005 Thomas Hochstein +# checkmail Version 0.3 by Thomas Hochstein # -# 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. +# This script tries to verify the deliverability of (a) mail address(es). +# +# Copyright (c) 2002-2010 Thomas Hochstein +# +# It can be redistributed and/or modified under the same terms under +# which Perl itself is published. -# Versionsnummer ###################### -$ver = '0.2 beta (20050803)'; +our $VERSION = "0.3"; -# Modules ############################# +################################# Configuration ################################ +# Please fill in a working configuration! +my %config=( + # value used for HELO/EHLO - a valid hostname you own + helo => 'testhost.domain.example', + # value used for MAIL FROM: - a valid address under your control + from => 'mailtest@testhost.domain.example', + # a syntactically valid "random" - reliably not existing - localpart + rand => 'ZOq62fow1i' + ); + +################################### Modules #################################### +use strict; +use File::Basename; 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'; +################################# Main program ################################# -################################################################ -# Hauptprogramm ####################### +$Getopt::Std::STANDARD_HELP_VERSION = 1; +my $myself = basename($0); -# Konfiguration einlesen +# read commandline options my %options; -getopts('hqlrf:m:', \%options); +getopts('Vhqlrf:m:', \%options); -if ($options{'h'} or (!$options{'f'} and !$ARGV[0])) { - print "$0 v $ver\nUsage: $0 [-hqlr] [-m ] -f |
\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 no DNS lookup, just test this host\n"; - print " -f parse file (one address per line)\n"; - print "
mail address to check\n\n"; - exit(100); +# -V: display version +if ($options{'V'}) { + print "$myself v $VERSION\nCopyright (c) 2010 Thomas Hochstein \n"; + print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n"; + exit(100); }; +# -h: feed myself to perldoc +if ($options{'h'}) { + exec('perldoc', $0); + exit(100); +}; + +# display usage information if neither -f nor an address are present +if (!$options{'f'} and !$ARGV[0]) { + print "Usage: $myself [-hqlr] [-m ]
|-f \n"; + print "Options: -V display copyright and version\n"; + print " -h show documentation\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 no DNS lookup, just test this host\n"; + print "
mail address to check\n\n"; + print " -f parse file (one address per line)\n"; + exit(100); +}; + +# -f: open file and read addresses to @adresses +my @addresses; if ($options{'f'}) { if (-e $options{'f'}) { - open FILE, "<$options{'f'}" or die("ERROR: Could not open file $options{'f'} for reading: $!"); + open FILE, "<$options{'f'}" or die("$myself ERROR: Could not open file $options{'f'} for reading: $!"); } else { - die("ERROR: File $options{'f'} does not exist!\n"); + die("$myself ERROR: File $options{'f'} does not exist!\n"); }; - $log = ''; while() { chomp; - ($status,$log) = checkdns($_,$log); + push(@addresses,$_); }; close FILE; - # force exit(0) - $status = 0; -} else { - ($status,$log) = checkdns($ARGV[0]); +# fill @adresses with single address to check + } else { + push(@addresses,$ARGV[0]); +}; + +# loop over each address and test it +my (%targets,$curstat,$status,$log,$message); +foreach (@addresses) { + my $address = $_; + (undef,my $domain) = splitaddress($address); + printf(" * Testing %s ...\n",$address) if !($options{'q'}); + $log .= "\n===== BEGIN $address =====\n"; + # get list of target hosts or take host forced via -m + if (!$options{'m'}) { + %targets = %{gettargets($domain,\$log)}; + } else { + $message = sprintf("Connection to %s forced by -m.\n",$options{'m'}); + $log .= $message; + print " $message" if !($options{'q'}); + # just one target host with preference 0 + $targets{$options{'m'}} = 0; + }; + if (%targets) { + $curstat = checkaddress($address,\%targets,\$log); + } else { + $curstat = 2; + $message = 'DNS lookup failure'; + printf(" > Address is INVALID (%s).\n",$message) if !($options{'q'}); + $log .= $message . '.'; + }; + $log .= "====== END $address ======\n"; + $status = $curstat if (!defined($status) or $curstat > $status); }; print $log if ($options{'l'}); # status 0: valid / batch processing -# 1: invalid -# 2: cannot verify -# 3: temporary (?) failure +# 1: connection failed or temporary failure +# 2: invalid +# 3: cannot verify +#D print "\n-> EXIT $status\n"; exit($status); -################################################################ -# Subroutinen ######################### +################################## gettargets ################################## +# get mail exchanger(s) or A record(s) for a domain +# IN : $domain: domain to query the DNS for +# OUT: \%targets: reference to a hash containing a list of target hosts +sub gettargets { + my ($domain,$logr) = @_; + # resolver objekt + my $resolver = Net::DNS::Resolver->new(udp_timeout => 15, tcp_timeout => 15); -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; - }; + my %targets; + # get MX record(s) as a list sorted by preference + if (my @mxrr = mx($resolver,$domain)) { + print_dns_result($domain,'MX',scalar(@mxrr),undef,$logr); + foreach my $rr (@mxrr) { + $targets{$rr->exchange} = $rr->preference; + $$logr .= sprintf("(%d) %s\n",$rr->preference,$rr->exchange); }; - 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); + # no MX record found; log and try A record(s) } else { - # Timeout nach RCPT TO - print " > Temporary failure.\n" if !($options{'q'}); - $logging .= "---Timeout---\n"; - $smtp->quit; - $status = 3; + print_dns_result($domain,'MX',undef,$resolver->errorstring,$logr); + print(" Falling back to A record ...\n") if !($options{'q'}); + # get A record(s) + if (my $query = $resolver->query($domain,'A','IN')) { + print_dns_result($domain,'A',$query->header->ancount,undef,$logr); + foreach my $rr ($query->answer) { + $targets{$rr->address} = 0; + $$logr .= sprintf("- %s\n",$rr->address); + }; + # no A record found either; log and fail + } else { + print_dns_result($domain,'A',undef,$resolver->errorstring,$logr); + printf(" %s has neither MX nor A records - mail cannot be delivered.\n",$domain) if !($options{'q'}); + }; }; - } else { - # Verbindung fehlgeschlagen - print " > Temporary failure.\n" if !($options{'q'}); - $logging .= "---Timeout---\n"; - $status = 3; - }; - return ($status,$logging); + return \%targets; }; -sub parse_reply { - my($code,$message)=@_; - my($reply); - $reply = $code . ' ' . $message; - return $reply; +################################# checkaddress ################################# +# test address for deliverability +# IN : $address: adress to be tested +# \%targets: reference to a hash containing a list of MX hosts +# \$log : reference to the log (to be printed out via -l) +# OUT: --- +# \$log will be changed +sub checkaddress { + my ($address,$targetsr,$logr) = @_; + my %targets = %{$targetsr}; + my $status; + # walk %targets in order of preference + foreach my $host (sort { $targets{$a} <=> $targets{$b} } keys %targets) { + printf(" / Trying %s (%s) with %s\n",$host,$targets{$host} || 'A',$address) if !($options{'q'}); + $$logr .= sprintf("%s:\n%s\n",$host,"-" x (length($host)+1)); + $status = checksmtp($address,$host,$logr); + last if ($status != 1); + }; + return $status; +}; + +################################### checksmtp ################################## +# connect to a remote machine on port 25 and test deliverability of a mail +# address by doing the SMTP dialog until RCPT TO stage +# IN : $address: address to test +# $target : target host +# \$log : reference to the log (to be printed out via -l) +# OUT: .........: reference to a hash containing a list of target hosts +# \$log will be changed +sub checksmtp { + my ($address,$target,$logr) = @_; + my ($status); + # start SMTP connection + if (my $smtp = Net::SMTP->new($target,Hello => $config{'helo'},Timeout => 30)) { + $$logr .= $smtp->banner; # Net::SMTP doesn't seem to support multiline greetings. + $$logr .= "EHLO $config{'helo'}\n"; + log_smtp_reply($logr,$smtp->code,$smtp->message); + $smtp->mail($config{'from'}); + $$logr .= "MAIL FROM:<$config{'from'}>\n"; + log_smtp_reply($logr,$smtp->code,$smtp->message); + # test address + my ($success,$code,@message) = try_rcpt_to(\$smtp,$address,$logr); + # connection failure? + if ($success < 0) { + $status = connection_failed(); + # delivery attempt was successful? + } elsif ($success) { + # -r: try random address (which should be guaranteed to be invalid) + if ($options{'r'}) { + (undef,my $domain) = splitaddress($address); + my ($success,$code,@message) = try_rcpt_to(\$smtp,$config{'rand'}.'@'.$domain,$logr); + # connection failure? + if ($success < 0) { + $status = connection_failed(); + # verification impossible? + } elsif ($success) { + $status = 3; + print " > Address verificaton impossible. You'll have to send a test mail ...\n" if !($options{'q'}); + } + } + # if -r is not set or status was not set to 3: valid address + if (!defined($status)) { + $status = 0; + print " > Address is valid.\n" if !($options{'q'}); + }; + # delivery attempt failed? + } else { + $status = 2; + print " > Address is INVALID:\n" if !($options{'q'}); + print ' ' . join(' ',@message) if !($options{'q'}); + } + # terminate SMTP connection + $smtp->quit; + $$logr .= "QUIT\n"; + log_smtp_reply($logr,$smtp->code,$smtp->message); + } else { + # SMTP connection failed / timeout + $status = connection_failed(); + $$logr .= "---Connection failure---\n"; + }; + return $status; } +################################# splitaddress ################################# +# split mail address into local and domain part +# IN : $address: a mail address +# OUT: $local : local part +# $domain: domain part +sub splitaddress { + my($address)=@_; + (my $lp = $address) =~ s/^([^@]+)@.*/$1/; + (my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/; + return ($lp,$domain); +}; + +################################ parse_dns_reply ############################### +# parse DNS response codes and return code and description +# IN : $response: a DNS response code +# OUT: "$response ($desciption)" +sub parse_dns_reply { + my($response)=@_; + my %dnsrespcodes = (NOERROR => 'empty response', + NXDOMAIN => 'non-existent domain', + SERVFAIL => 'DNS server failure', + REFUSED => 'DNS query refused', + FORMERR => 'format error', + NOTIMP => 'not implemented'); + if(defined($dnsrespcodes{$response})) { + return sprintf('%s (%s)',$response,$dnsrespcodes{$response}); + } else { + return $response; + }; +}; + +############################### print_dns_result ############################### +# print and log result of DNS query +# IN : $domain: domain the DNS was queried for +# $type : record type (MX, A, ...) +# $count : number of records found +# $error : DNS response code +# \$log : reference to the log (to be printed out via -l) +# OUT: --- +# \$log will be changed +sub print_dns_result { + my ($domain,$type,$count,$error,$logr) = @_; + if (defined($count)) { + printf(" %d %s record(s) found for %s\n",$count,$type,$domain) if !($options{'q'}); + $$logr .= sprintf("%s DNS record(s):\n",$type); + } else { + printf(" No %s records found for %s: %s\n",$type,$domain,parse_dns_reply($error)) if !($options{'q'}); + $$logr .= sprintf("No %s records found: %s\n",$type,parse_dns_reply($error)); + }; + return; +}; + +################################## try_rcpt_to ################################# +# send RCPT TO and return replies +# IN : \$smtp : a reference to an SMTP object +# $recipient: a mail address +# \$log : reference to the log (to be printed out via -l) +# OUT: $success: true or false +# $code : SMTP status code +# $message: SMTP status message +# \$log will be changed +sub try_rcpt_to { + my($smtpr,$recipient,$logr)=@_; + $$logr .= sprintf("RCPT TO:<%s>\n",$recipient); + my $success = $$smtpr->to($recipient); + if ($$smtpr->code) { + log_smtp_reply($logr,$$smtpr->code,$$smtpr->message); + } else { + $success = -1; + $$logr .= "---Connection failure---\n"; + }; + return ($success,$$smtpr->code,$$smtpr->message); +}; + +################################ log_smtp_reply ################################ +# log result of SMTP command +# IN : \$log : reference to the log (to be printed out via -l) +# $code : SMTP status code +# @message : SMTP status message +# OUT: --- +# \$log will be changed +sub log_smtp_reply { + my($logr,$code,@message)=@_; + $$logr .= sprintf('%s %s',$code,join('- ',@message)); + return; +} + +############################## connection_failed ############################### +# print failure message and return status 1 +# OUT: 1 +sub connection_failed { + print " > Connection failure.\n" if !($options{'q'}); + return 1; +}