Perl Email Troubleshooting Script

My work requires me to test various email functions throughout a broad range of systems. I often do this testing from the commandline, but there are times when you want to automate the testing, to repeat the same task many times to make sure that things are behaving reliably.

What follows is a bit of perl code I have developed over the years to test the SMTP engine on a particular host. The code requires the CPAN modules Net::SMTP, Email::MessageID, Email::Address, Time::HiRes. I use this code for all kinds of email testing– anti-spam, mail redirection, anti-virus, mail routing. The script connects directly to a defined mailserver and dumps appropriate data to it. I change that data depending on the needs of the test. The script listed below is set to send 3 messages. That is easily adjustable by redefining the value of the $count variable.

I am positive there are more efficient ways of doing this. I like my script because it is transparent. I am able to see what it is doing and understand every element of it. It makes sense to me. And when troubleshooting, that is an important quality.

#!/usr/bin/perl -w
# mailer.pl
###########################################################
# A simple perl script designed to send email via the
# Midway mailsorter system. It tries to connect to one of
# a set of predefined mailservers (chosen randomly). If
# that connection fails, it moves on to other servers in
# list. -- Once completed, it sends an explicitly-crafted
# message.
###########################################################
# Last Modified: Thu Feb 16 12:57:57 CST 2006
# By: Sean Ware 
###########################################################
use strict;

use Net::SMTP;
use Email::MessageID;
use Email::Address;
use Sys::Hostname::FQDN qw(fqdn);
use POSIX qw(strftime);

my $sourcehost=fqdn(); # Get my fully-qualifed domain name

my @desthosts=('mx1.example.com',   # List of possible mailservers
               'mx2.example.com',
               'mx3.example.com',
               'mx4.example.com');

# Set the Sender address and format it for RFC compliance
my $sender    = Email::Address->new('Joe Sender', 'joesender@example.com');
my $senderrfc = $sender->format;

# List of recipients seperated by commas-- addresses can be in a wide
# variety of formats, and parsed by Email::Address appropriately.
my @recipients = Email::Address->parse(
                 q[Joe Recipient ,
                   Jane Recipient ]
               );

# Make a list of all the recipients for the To: header
my $recipientlist = join (", ", map { $_->format; } @recipients);

# Make a RFC-2821 compliant date for the Date: header
my $date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime time);

# Subroutine to randomize the elements of an array in place. We use it
# to randomize the order in which the SMTP servers are contacted.
sub shuffle {
    my $array = shift;
    my $i;
    for ($i = @$array; --$i; ) {
        my $j = int rand ($i+1);
        next if $i == $j;
        @$array[$i,$j] = @$array[$j,$i];
    };
};

shuffle( \@desthosts );

# Main process: For every host in the list of possible SMTP relay
# hosts, attempt to connect and send the message. If unable to
# connect, move to next entry. Once mail is sucessfully delivered to
# any server, do not attempt any more SMTP relay hosts.
foreach my $desthost (@desthosts) {
    if ( my $smtp = Net::SMTP->new(
                                   Host    => $desthost,
                                   Hello   => $sourcehost,
                                   Timeout => 30,
                                   Debug   => 0,  # set to '1' for debugging
                                   ) ) {
  my $mid = Email::MessageID->new(
          host => $sourcehost,
          );
  $smtp->mail($sender->address);
  foreach (@recipients) {
      $smtp->to($_->address);
  };
  $smtp->data();
  $smtp->datasend("From: $senderrfc\n");
  $smtp->datasend("To: $recipientlist\n");
  $smtp->datasend("Message-ID: $mid\n");
  $smtp->datasend("Date: $date\n");
  $smtp->datasend("Subject: Test Message\n");
  $smtp->datasend("\n");
  $smtp->datasend("Test message sent by mailer.pl\n");
  $smtp->datasend("Source Host: $sourcehost\n");
  $smtp->datasend("Destination: $desthost\n");
  $smtp->datasend("\n");
  $smtp->datasend("This is just a test message. This is only a test.\n");
  $smtp->datasend("If this had been an actual message, it would have\n");
  $smtp->datasend("said something useful.\n");
  $smtp->dataend();
  $smtp->quit;
  last;
    } else {
        print "Net::SMTP::new\($desthost\): $!\n"; # If desired, print error
        next;
    };
};
exit 0;