switch to Email::Sender and add options for every kind of mail encryption & authentication, RT#7285

3 files changed, 51 insertions, 94 deletions

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 9d77479..aaeaa86 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -1273,6 +1273,32 @@ worry that config_items is freeside-specific and icky.
   },
 
   {
+    'key'         => 'smtp-username',
+    'section'     => '',
+    'description' => 'Optional SMTP username for Freeside\'s outgoing mail',
+    'type'        => 'text',
+  },
+
+  {
+    'key'         => 'smtp-password',
+    'section'     => '',
+    'description' => 'Optional SMTP password for Freeside\'s outgoing mail',
+    'type'        => 'text',
+  },
+
+  {
+    'key'         => 'smtp-encryption',
+    'section'     => '',
+    'description' => 'Optional SMTP encryption method.  The STARTTLS methods require smtp-username and smtp-password to be set.',
+    'type'        => 'select',
+    'select_hash' => [ '25'           => 'None (port 25)',
+                       '25-starttls'  => 'STARTTLS (port 25)',
+                       '587-starttls' => 'STARTTLS / submission (port 587)',
+                       '465-tls'      => 'SMTPS (SSL) (port 465)',
+                     ],
+  },
+
+  {
     'key'         => 'soadefaultttl',
     'section'     => 'BIND',
     'description' => 'SOA default TTL for new domains.',
@@ -1942,7 +1968,7 @@ worry that config_items is freeside-specific and icky.
   {
     'key'         => 'cust_pkg-change_pkgpart-bill_now',
     'section'     => '',
-    'description' => "When changing packages, bill the new package immediately.  Useful for prepaid situations with RADIUS where an Expiration attribute base don the package must be present at all times.",
+    'description' => "When changing packages, bill the new package immediately.  Useful for prepaid situations with RADIUS where an Expiration attribute based on the package must be present at all times.",
     'type'        => 'checkbox',
   },
 
diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
index dca906c..39be1fb 100644
--- a/FS/FS/Misc.pm
+++ b/FS/FS/Misc.pm
@@ -216,9 +216,10 @@ encoding which, if specified, overrides the default "7bit".
 
 use vars qw( $conf );
 use Date::Format;
-use Mail::Header;
-use Mail::Internet 2.00;
 use MIME::Entity;
+use Email::Sender::Simple qw(sendmail);
+use Email::Sender::Transport::SMTP;
+use Email::Sender::Transport::SMTP::TLS;
 use FS::UID;
 
 FS::UID->install_callback( sub {
@@ -234,7 +235,6 @@ sub send_email {
 #         join("\n", map { "  $_: ". $options{$_} } keys %options ). "\n"
   }
 
-  $ENV{MAILADDRESS} = $options{'from'};
   my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
 
   my @mimeargs = ();
@@ -287,7 +287,7 @@ sub send_email {
     $domain = $1;
   } else {
     warn 'no domain found in invoice from address '. $options{'from'}.
-         '; constructing Message-ID @example.com'; 
+         '; constructing Message-ID (and saying HELO) @example.com'; 
     $domain = 'example.com';
   }
   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
@@ -333,101 +333,32 @@ sub send_email {
 
   }
 
-  my $smtpmachine = $conf->config('smtpmachine');
-  $!=0;
+  #send the email
 
-  $message->mysmtpsend( 'Host'     => $smtpmachine,
-                        'MailFrom' => $options{'from'},
-                      );
+  my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
+                   'helo' => $domain,
+                 );
 
-}
-
-#this kludges a "mysmtpsend" method into Mail::Internet for send_email above
-#now updated for MailTools v2!
-package Mail::Internet;
-
-use Mail::Address;
-use Net::SMTP;
-use Net::Domain;
-
-sub Mail::Internet::mysmtpsend($@) {
-    my ($self, %opt) = @_;
-
-    my $host     = $opt{Host};
-    my $envelope = $opt{MailFrom}; # || mailaddress();
-    my $quit     = 1;
-
-    my ($smtp, @hello);
-
-    push @hello, Hello => $opt{Hello}
-        if defined $opt{Hello};
-
-    push @hello, Port => $opt{Port}
-        if exists $opt{Port};
-
-    push @hello, Debug => $opt{Debug}
-        if exists $opt{Debug};
-
-#    if(!defined $host)
-#    {   local $SIG{__DIE__};
-#        my @hosts = qw(mailhost localhost);
-#        unshift @hosts, split /\:/, $ENV{SMTPHOSTS}
-#            if defined $ENV{SMTPHOSTS};
-#
-#        foreach $host (@hosts)
-#        {   $smtp = eval { Net::SMTP->new($host, @hello) };
-#            last if defined $smtp;
-#        }
-#    }
-#    elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
-    if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
-    {   $smtp = $host;
-        $quit = 0;
-    }
-    else
-    {   #local $SIG{__DIE__};
-        #$smtp = eval { Net::SMTP->new($host, @hello) };
-        $smtp = Net::SMTP->new($host, @hello);
-    }
+  my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
+  $smtp_opt{'port'} = $port;
 
-    unless ( defined($smtp) ) {
-      my $err = $!;
-      $err =~ s/Invalid argument/Unknown host/;
-      return "can't connect to $host: $err"
+  my $transport;
+  if ( $enc eq 'starttls' ) {
+    $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
+    $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
+  } else {
+    if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
+      $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
     }
+    $smtp_opt{'ssl'} = 1 if $enc eq 'tls';
+    $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
+  }
 
-    my $head = $self->cleaned_header_dup;
-
-    $head->delete('Bcc');
-
-    # Who is it to
-
-    my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
-    @rcpt    = map { $head->get($_) } qw(To Cc Bcc)
-        unless @rcpt;
-
-    my @addr = map {$_->address} Mail::Address->parse(@rcpt);
-    #@addr or return ();
-    return 'No valid destination addresses found!'
-	unless(@addr);
-
-    # Send it
-
-    my $ok = $smtp->mail($envelope)
-          && $smtp->to(@addr)
-          && $smtp->data(join("", @{$head->header}, "\n", @{$self->body}));
+  eval { sendmail($message, { transport => $transport }); };
+  ref($@) ? ( $@->code ? $@->code.' ' : '' ). $@->message
+          : $@;
 
-    #$quit && $smtp->quit;
-    #$ok ? @addr : ();
-    if ( $ok ) {
-      $quit && $smtp->quit;
-      return '';
-    } else {
-      return $smtp->code. ' '. $smtp->message;
-    }
 }
-package FS::Misc;
-#eokludge
 
 =item send_fax OPTION => VALUE ...
 
diff --git a/debian/control b/debian/control
index 75869a0..4ea4815 100644
--- a/debian/control
+++ b/debian/control
@@ -22,7 +22,7 @@ Description: Billing and trouble ticketing for service providers
 
 Package: freeside-lib
 Architecture: all
-Depends: ghostscript | gs-gpl, gsfonts, tetex-base, tetex-bin, libauthen-passphrase-perl, libbusiness-creditcard-perl, libcache-cache-perl, libcache-simple-timedexpiry-perl, libclass-returnvalue-perl, libcrypt-passwdmd5-perl, libdate-manip-perl, libdbd-pg-perl | libdbd-mysql-perl, libdbi-perl, libdbix-dbschema-perl (>= 0.35), libdbix-searchbuilder-perl, libdigest-sha1-perl, libfile-counterfile-perl, libfile-rsync-perl, libfrontier-rpc-perl, libhtml-format-perl, libhtml-tree-perl, libipc-run3-perl, libipc-sharelite-perl,  liblingua-en-nameparse-perl, liblocale-maketext-fuzzy-perl, liblocale-maketext-lexicon-perl, liblocale-subcountry-perl, liblog-dispatch-perl, libmailtools-perl (>= 2), libmime-perl (>= 5.424) | libmime-perl (< 5.421), libnet-domain-tld-perl, libnet-scp-perl, libnet-ssh-perl, libnet-whois-raw-perl, libnetaddr-ip-perl, libnumber-format-perl, libregexp-common-perl, libstring-approx-perl, libstring-shellquote-perl, libterm-readkey-perl, libtest-inline-perl, libtext-autoformat-perl, libtext-csv-perl, libtext-template-perl, libtext-wrapper-perl, libtie-ixhash-perl, libtime-duration-perl, libtime-modules-perl, libtimedate-perl, libuniversal-require-perl, liburi-perl, libwant-perl, libwww-perl
+Depends: ghostscript | gs-gpl, gsfonts, tetex-base, tetex-bin, libauthen-passphrase-perl, libbusiness-creditcard-perl, libcache-cache-perl, libcache-simple-timedexpiry-perl, libclass-returnvalue-perl, libcrypt-passwdmd5-perl, libdate-manip-perl, libdbd-pg-perl | libdbd-mysql-perl, libdbi-perl, libdbix-dbschema-perl (>= 0.35), libdbix-searchbuilder-perl, libdigest-sha1-perl, libfile-counterfile-perl, libfile-rsync-perl, libfrontier-rpc-perl, libhtml-format-perl, libhtml-tree-perl, libipc-run3-perl, libipc-sharelite-perl,  liblingua-en-nameparse-perl, liblocale-maketext-fuzzy-perl, liblocale-maketext-lexicon-perl, liblocale-subcountry-perl, liblog-dispatch-perl, libmailtools-perl (>= 2), libmime-perl (>= 5.424) | libmime-perl (< 5.421), libnet-domain-tld-perl, libnet-scp-perl, libnet-ssh-perl, libnet-whois-raw-perl, libnetaddr-ip-perl, libnumber-format-perl, libregexp-common-perl, libstring-approx-perl, libstring-shellquote-perl, libterm-readkey-perl, libtest-inline-perl, libtext-autoformat-perl, libtext-csv-perl, libtext-template-perl, libtext-wrapper-perl, libtie-ixhash-perl, libtime-duration-perl, libtime-modules-perl, libtimedate-perl, libuniversal-require-perl, liburi-perl, libwant-perl, libwww-perl, libemail-sender-perl, libemail-sender-transport-smtp-tls-perl
 Recommends: libdbd-pg-perl, libdbd-mysql-perl, rsync
 Suggests: libbusiness-onlinepayment-perl
 Description: Libraries for Freeside billing and trouble ticketing