X-Git-Url: https://code.th-h.de/?p=mail%2Fcheckmail.git;a=blobdiff_plain;f=checkmail.pl;h=2d8bfb08a770c6b15f70903c2ff38e86a399e472;hp=e93a946056d4b989d6bb4ee9b59b32e770fffe9d;hb=9518c3941780f392d05b59918088fc8264a1d026;hpb=32301d53af29a1be028a61edc339275761d01f56 diff --git a/checkmail.pl b/checkmail.pl index e93a946..2d8bfb0 100644 --- a/checkmail.pl +++ b/checkmail.pl @@ -1,6 +1,6 @@ #! /usr/bin/perl -W # -# checkmail Version 0.3 by Thomas Hochstein +# checkmail Version 0.4 by Thomas Hochstein # # This script tries to verify the deliverability of (a) mail address(es). # @@ -9,7 +9,7 @@ # It can be redistributed and/or modified under the same terms under # which Perl itself is published. -our $VERSION = "0.3"; +our $VERSION = "0.4"; ################################# 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,7 +35,7 @@ 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'}) { @@ -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 $options{'s'}; +$config{'helo'} = $options{'e'} if $options{'e'}; + # -f: open file and read addresses to @adresses my @addresses; if ($options{'f'}) { @@ -87,7 +92,7 @@ if ($options{'f'}) { my (%targets,$curstat,$status,$log,$message); foreach (@addresses) { my $address = $_; - (undef,my $domain) = splitaddress($address); + 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 @@ -202,16 +207,15 @@ 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); # verification impossible? } elsif ($success) { $status = 3; @@ -241,16 +245,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 +304,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,11 +336,32 @@ 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; } @@ -346,7 +375,7 @@ checkmail - check deliverability of a mail address =head1 SYNOPSIS -B [B<-Vhqlr>] [B<-m> I] I
|B<-f> I +B [B<-Vhqlr>] [B<-m> I] [-s I] [-e I] I
|B<-f> I =head1 REQUIREMENTS @@ -366,6 +395,10 @@ Getopt::Std =item - +Mail::Address I<(CPAN)> + +=item - + Net::DNS I<(CPAN)> =item - @@ -397,13 +430,11 @@ The hostname to be used for I or I in the SMTP dialog. The sender address to be used for I while testing. -=item B<$config{'rand'}> - -A "random" local part to construct a reliably invalid address for use -with the B<-r> option. - =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 @@ -483,6 +514,9 @@ 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 @@ -505,8 +539,8 @@ Log and print out the whole SMTP dialog. =item B<-r> (random address) -Also try a reliably invalid address - defined in B<$config{'rand'}> - -to catch hosts that try undermine address verification. +Also try a reliably invalid address to catch hosts that try undermine +address verification. =item B<-m> I (MX to use) @@ -515,6 +549,14 @@ 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).