X-Git-Url: https://code.th-h.de/?p=mail%2Fcheckmail.git;a=blobdiff_plain;f=checkmail.pl;h=27cd5c7596143902a5d059a9147b49d1fb13b3c3;hp=b7da4e254862b35881dd03ca17ad1ae8eaba77e1;hb=refs%2Fheads%2Fmaster;hpb=431fbb123350433e171c4cfda0c3f63ad3cb1ed9 diff --git a/checkmail.pl b/checkmail.pl index b7da4e2..27cd5c7 100644 --- a/checkmail.pl +++ b/checkmail.pl @@ -1,15 +1,15 @@ -#! /usr/bin/perl -W +#! /usr/bin/perl -w # -# checkmail Version 0.3 by Thomas Hochstein +# checkmail Version 0.6.3 by Thomas Hochstein # # This script tries to verify the deliverability of (a) mail address(es). # -# Copyright (c) 2002-2010 Thomas Hochstein +# Copyright (c) 2002-2016 Thomas Hochstein # # It can be redistributed and/or modified under the same terms under # which Perl itself is published. -our $VERSION = "0.3"; +our $VERSION = "0.6.3 (unreleased)"; ################################# Configuration ################################ # Please fill in a working configuration! @@ -17,15 +17,14 @@ 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' + from => 'mailtest@testhost.domain.example' ); ################################### Modules #################################### use strict; use File::Basename; use Getopt::Std; +use Mail::Address; use Net::DNS; use Net::SMTP; @@ -36,11 +35,11 @@ my $myself = basename($0); # read commandline options my %options; -getopts('Vhqlrf:m:', \%options); +getopts('Vhqlrf:m:s:e:', \%options); # -V: display version if ($options{'V'}) { - print "$myself v $VERSION\nCopyright (c) 2010 Thomas Hochstein \n"; + print "$myself v $VERSION\nCopyright (c) 2002-2016 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); }; @@ -53,18 +52,24 @@ if ($options{'h'}) { # 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 "Usage: $myself [-hqlr] [-m ] [-s ] [-e ]
|-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 " -s override configured value for MAIL FROM\n"; + print " -e override configured value for EHLO\n"; print "
mail address to check\n\n"; print " -f parse file (one address per line)\n"; exit(100); }; +# -s / -e: override configuration +$config{'from'} = $options{'s'} if defined($options{'s'}); +$config{'helo'} = $options{'e'} if $options{'e'}; + # -f: open file and read addresses to @adresses my @addresses; if ($options{'f'}) { @@ -87,28 +92,36 @@ if ($options{'f'}) { 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 { + # regexp taken from http://www.regular-expressions.info/email.html + # with escaping of "/" added two times and "*" changed to "+" + # in localpart, second alternative + if ($address !~ /^(?:[a-z0-9!#$%&'*+\/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+\/=?^_`{|}~-]+)*|"(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f]+)")@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?$/i) { + printf(" > Address <%s> is syntactically INVALID.\n",$address) if !($options{'q'}); $curstat = 2; - $message = 'DNS lookup failure'; - printf(" > Address is INVALID (%s).\n",$message) if !($options{'q'}); - $log .= $message . '.'; + } else { + my $domain = Mail::Address->new('',$address)->host; + 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"; }; - $log .= "====== END $address ======\n"; $status = $curstat if (!defined($status) or $curstat > $status); }; @@ -141,11 +154,20 @@ sub gettargets { # no MX record found; log and try A record(s) } else { print_dns_result($domain,'MX',undef,$resolver->errorstring,$logr); - print(" Falling back to A record ...\n") if !($options{'q'}); - # get A record(s) + print(" Falling back to A record(s) ...\n") if !($options{'q'}); + # get A record(s) + # may get CNAMEs instead ... if (my $query = $resolver->query($domain,'A','IN')) { - print_dns_result($domain,'A',$query->header->ancount,undef,$logr); + print_dns_result($domain,'A/CNAME',$query->header->ancount,undef,$logr); foreach my $rr ($query->answer) { + if ($rr->type ne 'A') { + # report CNAMEs and don't add them to target list + if ($rr->type eq 'CNAME') { + printf (" ~ '%s' is a CNAME for '%s' and will be resolved accordingly. \n",$rr->name,$rr->cname) if !($options{'q'}); + $$logr .= sprintf("- CNAME resolved: %s -> %s\n",$rr->name,$rr->cname); + } + next; + } $targets{$rr->address} = 0; $$logr .= sprintf("- %s\n",$rr->address); }; @@ -202,20 +224,22 @@ sub checksmtp { my ($success,$code,@message) = try_rcpt_to(\$smtp,$address,$logr); # connection failure? if ($success < 0) { - $status = connection_failed(); + $status = connection_failed(@message); # 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); + my ($success,$code,@message) = try_rcpt_to(\$smtp,create_rand_addr(Mail::Address->new('',$address)->host),$logr); # connection failure? if ($success < 0) { - $status = connection_failed(); + $status = connection_failed(@message); + # reset status - the address has been checked and _is_ valid! + $status = 3; + print " > Address verification currently impossible. You'll have to try again or send a test mail ...\n" if !($options{'q'}); # verification impossible? } elsif ($success) { $status = 3; - print " > Address verificaton impossible. You'll have to send a test mail ...\n" if !($options{'q'}); + print " > Address verification 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 @@ -241,16 +265,18 @@ sub checksmtp { 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); +############################### create_rand_addr ############################### +# create a random mail address +# IN : $domain: the domain part +# OUT: $address: the address +sub create_rand_addr { + my($domain)=@_; + my $allowed = 'ABCDEFGHJKLMNPQRSTUVWXYZabcdefghjkmnpqrstuvwxyz23456789-+_='; + my $address = ''; + while (length($address) < 15) { + $address .= substr($allowed, (int(rand(length($allowed)))),1); + }; + return ($address.'@'.$domain); }; ################################ parse_dns_reply ############################### @@ -298,16 +324,18 @@ sub print_dns_result { # 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 +# OUT: $success: exit code (0 for false, 1 for true, -1 for tempfail) # $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); + my $success; + $$smtpr->to($recipient); if ($$smtpr->code) { log_smtp_reply($logr,$$smtpr->code,$$smtpr->message); + $success = analyze_smtp_reply($$smtpr->code,$$smtpr->message); } else { $success = -1; $$logr .= "---Connection failure---\n"; @@ -328,10 +356,282 @@ sub log_smtp_reply { return; } +############################### analyze_smtp_reply ############################## +# analyze SMTP response codes and messages +# IN : $code : SMTP status code +# @message : SMTP status message +# OUT: exit code (0 for false, 1 for true, -1 for tempfail) +sub analyze_smtp_reply { + my($code,@message)=@_; + my $type = substr($code, 0, 1); + if ($type == 2) { + return 1; + } elsif ($type == 5) { + return 0; + } elsif ($type == 4) { + return -1; + }; + return -1; +} + ############################## connection_failed ############################### # print failure message and return status 1 +# IN : @message : SMTP status message # OUT: 1 sub connection_failed { - print " > Connection failure.\n" if !($options{'q'}); + my(@message)=@_; + print " ! Connection failed or other temporary failure.\n" if !($options{'q'}); + printf(" %s\n",join(' ',@message)) if @message; return 1; } + +__END__ + +################################ Documentation ################################# + +=head1 NAME + +checkmail - check deliverability of a mail address + +=head1 SYNOPSIS + +B [B<-Vhqlr>] [B<-m> I] [-s I] [-e I] I
|B<-f> I + +=head1 REQUIREMENTS + +=over 2 + +=item - + +Perl 5.8 or later + +=item - + +File::Basename + +=item - + +Getopt::Std + +=item - + +Mail::Address I<(CPAN)> + +=item - + +Net::DNS I<(CPAN)> + +=item - + +Net::SMTP + +=back + +Furthermore you'll need a working DNS installation. + +=head1 DESCRIPTION + +checkmail checks the vailidity / deliverability of a mail address. +You may submit just one address as the last argument or a file +containing one address on each line using the B<-f> option. + +=head2 Configuration + +For the time being, all configuration is done in the script. You have +to set the following elements of the %config hash: + +=over 4 + +=item B<$config{'helo'}> + +The hostname to be used for I or I in the SMTP dialog. + +=item B<$config{'from'}> + +The sender address to be used for I while testing. +May be empty ('') to set '<>' as MAIL FROM. + +=back + +You may override that configuration by using the B<-e> and B<-s> +command line options. + +=head2 Usage + +After configuring the script you may run your first test with + + checkmail user@example.org + +B will check the address for syntactic validity. If the +address is valid, it will try to determine the mail exchanger(s) (MX) +responsible for I by querying the DNS for the respective +MX records and then try to connect via SMTP (on port 25) to each of +them in order of precedence (if necessary). It will run through the +SMTP dialog until just before the I stage, i.e. doing I, +I and I. If no MX is defined, B will +fall back to the I host itself, provided there is at +least one A record defined in the DNS. CNAMEs will be accepted and +resolved here. If there are neither MX nor A records for +I, mail is not deliverable and B will fail +accordingly. If no host can be reached, B will fail, +too. Finally B will fail if mail to the given recipient +is not accepted by the respective host. + +If B fails, you'll not be able to deliver mail to that +address - at least not using the configured sender address and from +the host you're testing from. However, the opposite is not true: a +mail you send may still not be delivered even if a test via +B succeeds. The receiving entity may reject your mail after +the I stage, due to content checking or without any special +reason, or it may even drop, filter or bounce your mail after finally +accepting it. There is no way to be sure a mail will be accepted short +of sending a real mail to the address in question. + +You may, however, try to detect hosts that will happily accept any and +all recipient in the SMTP dialog and just reject your mail later on, +for example to defeat exactly the kind of check you try to do. +B will do that by submitting a recipient address that is +known to be invalid; if that address is accepted, too, you'll know +that you can't reliably check the validity of any address on that +host. You can force that check by using the B<-r> option. + +If you don't want to see just the results of your test, you can get a +B of the SMTP dialog by using the B<-l> option. That may be +helpful to test for temporary failure conditions. + +On the other hand you may use the B<-q> option to suppress all output; +B will then terminate with one of the following B: + +=over 4 + +=item B<0> + +address(es) seem/seems to be valid + +=item B<1> + +temporary error (connection failure or temporary failure) + +=item B<2> + +address is invalid + +=item B<3> + +address cannot reliably be checked (test using B<-r> failed) + +=back + +You can do B using B<-f> and submitting a file with +one address on each line. In that case the exit status is set to the +highest value generated by testing all addresses, i.e. it is set to +B<0> if and only if no adress failed, but to B<2> if even one address +failed and to B<3> if even one addresses couldn't reliably be checked. + +And finally you can B for MX and A records and +just force B to connect to a particular host using the +B<-m> option. + +B You shouldn't try to validate addresses while working +from a dial-up or blacklisted host. If in doubt, use the B<-l> option +to have a closer look on the SMTP dialog yourself. + +B To avoid shell expansion on addresses you submit to +B, use B. + +=head1 OPTIONS + +=over 3 + +=item B<-V> (version) + +Print out version and copyright information on B and exit. + +=item B<-h> (help) + +Print this man page and exit. + +=item B<-q> (quit) + +Suppress output and just terminate with a specific exit status. + +=item B<-l> (log) + +Log and print out the whole SMTP dialog. + +=item B<-r> (random address) + +Also try a reliably invalid address to catch hosts that try undermine +address verification. + +=item B<-m> I (MX to use) + +Force a connection to I to check deliverability to that +particular host irrespective of DNS entries. For example: + + checkmail -m test.host.example user@domain.example + +=item B<-s> I (value for MAIL FROM) + +Override configuration and use I for MAIL FROM. + +=item B<-e> I (value for EHLO) + +Override configuration and use I for EHLO. + +=item B<-f> I (file) + +Process all addresses from I (one on each line). + +=back + +=head1 INSTALLATION + +Just copy checkmail to some directory and get started. + +You can run your first test with + + checkmail user@example.org + +=head1 ENVIRONMENT + +See documentation of I. + +=head1 FILES + +=over 4 + +=item F + +The script itself. + +=back + +=head1 BUGS + +Please report any bugs or feature request to the author or use the +bug tracker at L! + +=head1 SEE ALSO + +L will have the current +version of this program. + +This program is maintained using the Git version control system. You +may clone L to check out the +current development tree or browse it on the web via +L. + +=head1 AUTHOR + +Thomas Hochstein + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2002-2016 Thomas Hochstein + +This program is free software; you may redistribute it and/or modify it +under the same terms as Perl itself. + +=cut