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.
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;
}