Replace splitaddress() by Mail::Address.

[mail/checkmail.git] / checkmail.pl

diff --git a/checkmail.pl b/checkmail.pl
index e93a946..7ded360 100644 (file)
--- a/checkmail.pl
+++ b/checkmail.pl
@@ -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;
 
@@ -87,7 +86,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 +201,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 +239,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 +298,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 +330,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;
 }
 
@@ -366,6 +389,10 @@ Getopt::Std
 
 =item -
 
+Mail::Address I<(CPAN)>
+
+=item -
+
 Net::DNS I<(CPAN)>
 
 =item -
@@ -397,11 +424,6 @@ The hostname to be used for I<HELO> or I<EHLO> in the SMTP dialog.
 
 The sender address to be used for I<MAIL FROM> while testing.
 
-=item B<$config{'rand'}>
-
-A "random" local part to construct a reliably invalid address for use
-with the B<-r> option.
-
 =back
 
 =head2 Usage
@@ -505,8 +527,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<host> (MX to use)