Sending e-mail using TLS with MIME::Lite

My mail server requires clients to STARTTLS before authenticating so the username/password doesn't get sent over the internet in an unencrypted form. The problem I kept running in to was that MIME::Lite, which IMO is by far the easiest, quickest, most natural, convenient, and intuitive way to send e-mail from perl, does not support TLS. :( Looking around, I found quite a few people who have run into this same problem, most commonly with GMail's SMTP server - they use a similar configuration.

While searching, I found a hack somebody developed which was supposed to remove this limitation. (The site appears to be down as I write this, but it was working when I initially made this, thank goodness.) I wasn't able to make it work as he had it, though I wasn't willing to give up. I started playing with it and eventually wound up with the below subroutine based on a small portion of his hack. It uses MIME::Lite (tested with version 3.027) and extends it to allow the use of SMTP servers which require STARTTLS before authentication. You can attach files using the routine - I don't know the limit of how many arguments one can use when doing function calls in perl, but the number of files you can attach is limited to ((perl_limit - 6) / 2); almost certainly more than one will ever need to attach to a single message. :)

There is an additional module required in order to use this: Net::SMTP::TLS. This module has certain dependencies as well, most notably Net::SSLeay. These were the only extra modules I had to install on my system, but YMMV depending on your specific machine's configuration.

I hope somebody finds it as useful as I certainly would have had it existed before last week. One thing to note is that this is a chunk, not a complete script, and is intended to be used as a simple sub-routine. Just copy/paste it in your script, edit the server settings/authentication tokens at the bottom as appropriate for your mail server configuration, then call it with the appropriate arguments.

Code:
###############################################################################
#                                                                             #
# Ruler's Common-Sense License:                                               #
#                                                                             #
#   You may use this script however you want to, but I don't warrant it to    #
#   be good for anything in particular, though it happens to work well for    #
#   me.  (I hate putting BS like this in, but I hate more being sued.)  If    #
#   you use this script, you must keep this license and credit to me in it    #
#   in the form of this block, even if you modify it for your own use.  If    #
#   you want to send me money for it, fantastic!  Send me a private message   #
#   on the freebsd.org forums and I'll give you my PayPal address. :-)  Even  #
#   just a simple 'thank you' would be nice.  If not, that's fine too.  All   #
#   hate mail/spam is sent directly to /dev/null                              #
#                                                       - Jim, AKA Ruler2112  #
#                                                                             #
###############################################################################
#                                                                             #
# History:                                                                    #
#                                                                             #
#   2011-10-27 by Ruler2112       Wrote initial version.                      #
#   2011-11-08 by Ruler2112       Released on freebsd.org forums.             #
#                                                                             #
###############################################################################

sub SendEmail()
  {
  my $sentfrom = shift;
  my $sendto = shift;
  my $sendcc = shift;
  my $sendbcc = shift;
  my $subject = shift;
  my $body = shift;
# The following may be repeated as often as needed in pairs
  my $filename = shift;
  my $mimetype = shift;

  my($email);
  # Add MIME::Lite hack to support TLS authentication / encryption
  use MIME::Lite;
  *MIME::Lite::send_by_smtp_tls = sub {
    my($self, @args) = @_;
    my $extract_addrs_ref =
        defined &MIME::Lite::extract_addrs
        ? \&MIME::Lite::extract_addrs
        : \&MIME::Lite::extract_full_addrs;
    my $hdr = $self->fields();
    my($from) = $extract_addrs_ref->( $self->get('From') );
    my $to = $self->get('To');
    defined($to) or Carp::croak "send_by_smtp_tls: missing 'To:' address\n";
    my @to_all = $extract_addrs_ref->($to);
    if($MIME::Lite::AUTO_CC)
      {
      foreach my $field (qw(Cc Bcc))
        {
        my $value = $self->get($field);
        push @to_all, $extract_addrs_ref->($value) if defined($value);
        }
      }
    require Net::SMTP::TLS;
    my $smtp = MIME::Lite::SMTP::TLS->new(@args) or Carp::croak("Failed to connect to mail server: $!\n");
    $smtp->mail($from);
    $smtp->to(@to_all);
    $smtp->data();
    $self->print_for_smtp($smtp);
    $smtp->dataend();
    1;
  };
  @MIME::Lite::SMTP::TLS::ISA = qw( Net::SMTP::TLS );
  sub MIME::Lite::SMTP::TLS::print { shift->datasend(@_) }
  $email = MIME::Lite->new(From    => "$sentfrom",
                           To      => "$sendto",
                           Cc      => "$sendcc",
                           Bcc     => "$sendbcc",
                           Subject => "$subject",
                           Type    => 'multipart/mixed'
                          );
  $email->attach(Type => 'text/plain',
                 Data => "$body");
  while($filename ne "")
    {
    $email->attach(Type => "$mimetype",
                   Path => "$filename");
    $filename = shift;
    $mimetype = shift;
    }
  $email->send_by_smtp_tls('mail.myserver.com',
                           Hello    => 'whereimconnectingfrom.com',
                           Port     => 25,
                           User     => 'username',
                           Password => 'password'
                          );
  return;
  }
 
Sorry - forgot to mention that you need to update line 254 of /usr/local/lib/perl5/site_perl/5.12.4/Net/SMTP/TLS.pm. The sprintf syntax in this line is wrong and will prevent this from working. Simply change the %S to %s and all will be well.

Code:
LINE 254 IS:
  $me->_command(sprintf("AUTH PLAIN %S",

CHANGE TO:
  $me->_command(sprintf("AUTH PLAIN %s",
 
Use on Amazon SES

FWIW...

I'm using this on an Ubuntu based Amazon EC2 instance to send through Amazon SES.

I had to modify TLS.pm line 402 to specify only 'TLSv1' rather than the existing 'SSLv3 TLSv1' as the SSL_version value to avoid an 'invalid SSL version' error.

Thanks for this code -- it saved me hours!

T.
 
Back
Top