SSL and IPv6 support for Net::SMTP

5 files changed, 145 insertions, 3 deletions

diff --git a/MANIFEST b/MANIFEST
index ea66ab0..287142c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -38,3 +38,4 @@ t/nntp.t
 t/require.t
 t/smtp.t
 t/time.t
+t/external/smtp-ssl.t
diff --git a/Makefile.PL b/Makefile.PL
index 95feb8a..50934bf 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -76,6 +76,11 @@ if ($^O eq 'os390')
    . "    CPAN/modules/by-module/Convert/Convert-EBCDIC-x.x.tar.gz\n\n";
 }
 
+my $xt = prompt( "Should I do external tests?\n".
+  "These tests will fail if there is no internet connection or if a firewall\n".
+  "blocks or modifies some traffic.\n".
+  "[y/N]", 'n' );
+
 #--- Write the Makefile
 
 my @ppd;
@@ -97,6 +102,7 @@ WriteMakefile(
                 Socket     => 1.3,
                 IO::Socket => 1.05
               },
+  $xt =~m{^y}i ? ( test => { TESTS => 't/*.t t/external/*.t' }):(),
   dist => { DIST_DEFAULT => 'mydist', },
   (eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
   ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (
diff --git a/Net/Cmd.pm b/Net/Cmd.pm
index d1a1fed..61f6a7b 100644
--- a/Net/Cmd.pm
+++ b/Net/Cmd.pm
@@ -53,7 +53,6 @@ my %debug = ();
 
 my $tr = $^O eq 'os390' ? Convert::EBCDIC->new() : undef;
 
-
 sub toebcdic {
   my $cmd = shift;
 
diff --git a/Net/SMTP.pm b/Net/SMTP.pm
index 705b5c5..fcc124f 100644
--- a/Net/SMTP.pm
+++ b/Net/SMTP.pm
@@ -18,7 +18,31 @@ use Net::Config;
 
 $VERSION = "2.33";
 
-@ISA = qw(Net::Cmd IO::Socket::INET);
+# Code for detecting if we can use SSL
+my $ssl_class = eval {
+  require IO::Socket::SSL;
+  # first version with default CA on most platforms
+  IO::Socket::SSL->VERSION(1.968);
+} && 'IO::Socket::SSL';
+my $nossl_warn = !$ssl_class &&
+  'To use SSL please install IO::Socket::SSL with version>=1.968';
+
+# Code for detecting if we can use IPv6
+my $inet6_class =
+  eval {
+    require IO::Socket::IP;
+    IO::Socket::IP->VERSION(0.20);
+  } && 'IO::Socket::IP' ||
+  eval {
+    require IO::Socket::INET6;
+    IO::Socket::INET6->VERSION(2.62);
+  } && 'IO::Socket::INET6';
+
+sub can_ssl   { $ssl_class };
+sub can_inet6 { $inet6_class };
+
+
+@ISA = ( 'Net::Cmd', $inet6_class || 'IO::Socket::INET' );
 
 
 sub new {
@@ -33,6 +57,13 @@ sub new {
     %arg  = @_;
     $host = delete $arg{Host};
   }
+
+  if ($arg{SSL}) {
+    # SSL from start
+    die $nossl_warn if !$ssl_class;
+    $arg{Port} ||= 465;
+  }
+
   my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
   my $obj;
 
@@ -54,6 +85,11 @@ sub new {
   return undef
     unless defined $obj;
 
+  if ($arg{SSL}) {
+    Net::SMTP::_SSLified->start_SSL($obj,SSL_verifycn_name => $host,%arg)
+      or return;
+  }
+
   $obj->autoflush(1);
 
   $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
@@ -189,11 +225,22 @@ sub hello {
   }
 
   return undef unless $ok;
+  ${*$me}{net_smtp_hello_domain} = $domain;
 
   $msg[0] =~ /\A\s*(\S+)/;
   return ($1 || " ");
 }
 
+sub starttls {
+  my $self = shift;
+  $ssl_class or die $nossl_warn;
+  $self->_STARTTLS or return;
+  Net::SMTP::_SSLified->start_SSL($self,@_) or return;
+
+  # another hello after starttls to read new ESMTP capabilities
+  return $self->hello(${*$self}{net_smtp_hello_domain});
+}
+
 
 sub supports {
   my $self = shift;
@@ -531,6 +578,26 @@ sub _BDAT { shift->command("BDAT", @_) }
 sub _TURN { shift->unsupported(@_); }
 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
+sub _STARTTLS { shift->command("STARTTLS", @_)->response() == CMD_OK }
+
+
+{
+  package Net::SMTP::_SSLified;
+  our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::SMTP' );
+  sub starttls { die "SMTP connection is already in SSL mode" }
+  sub start_SSL {
+    my ($class,$smtp,%arg) = @_;
+    delete @arg{ grep { !m{^SSL_} } keys %arg };
+    ( $arg{SSL_verifycn_name} ||= $smtp->host )
+        =~s{(?<!:):[\w()]+$}{}; # strip port
+    $arg{SSL_verifycn_scheme} ||= 'smtp';
+    my $ok = $class->SUPER::start_SSL($smtp,%arg);
+    $@ = $ssl_class->errstr if !$ok;
+    return $ok;
+  }
+}
+
+
 
 1;
 
@@ -623,7 +690,12 @@ an array with hosts to try in turn. The L</host> method will return the value
 which was used to connect to the host.
 
 B<Port> - port to connect to. Format - C<PeerHost> from L<IO::Socket::INET> new method.
-Default - 25.
+Default - 25 for plain SMTP and 465 for immediate SSL.
+
+B<SSL> - If the connection should be done from start with SSL, contrary to later
+upgrade with C<starttls>.
+You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
+usually use the right arguments already.
 
 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
 to IO::Socket to allow binding the socket to a local port.
@@ -655,6 +727,14 @@ Example:
                            Debug   => 1,
                           );
 
+    # the same with direct SSL
+    $smtp = Net::SMTP->new('mailhost',
+                           Hello => 'my.mail.domain',
+                           Timeout => 30,
+                           Debug   => 1,
+                           SSL     => 1,
+                          );
+
     # Connect to the default server from Net::config
     $smtp = Net::SMTP->new(
                            Hello => 'my.mail.domain',
@@ -702,6 +782,12 @@ to connect to the host.
 
 Request a queue run for the DOMAIN given.
 
+=item starttls ( SSLARGS )
+
+Upgrade existing plain connection to SSL.
+You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
+usually use the right arguments already.
+
 =item auth ( USERNAME, PASSWORD )
 
 Attempt SASL authentication. Requires Authen::SASL module.
diff --git a/t/external/smtp-ssl.t b/t/external/smtp-ssl.t
new file mode 100644
index 0000000..94753ab
--- /dev/null
+++ b/t/external/smtp-ssl.t
@@ -0,0 +1,50 @@
+
+use strict;
+use warnings;
+use Net::SMTP;
+use Test::More;
+
+my $host = 'mail.gmx.net';
+my $debug = 0;
+
+plan skip_all => "no SSL support" if ! Net::SMTP->can_ssl;
+plan skip_all => "no verified SSL connection to $host:465 - $@" if ! eval {
+  IO::Socket::SSL->new("$host:465")
+    || die($IO::Socket::SSL::SSL_ERROR||$!);
+};
+
+plan tests => 2;
+
+SKIP: {
+  diag( "connect inet to $host:25" );
+  skip "no inet connect to $host:25",1 if ! IO::Socket::INET->new("$host:25");
+  my $smtp = Net::SMTP->new($host, Debug => $debug)
+    or skip "normal SMTP failed: $@",1;
+  skip "no STARTTLS support",1 if $smtp->message !~/STARTTLS/;
+
+  if (!$smtp->starttls) {
+    fail("starttls failed: ".$smtp->code." $@")
+  } else {
+    # we now should have access to SSL stuff
+    my $cipher = eval { $smtp->get_cipher };
+    if (!$cipher) {
+      fail("after starttls: not an SSL object");
+    } elsif ( $smtp->quit ) {
+      pass("starttls + quit ok, cipher=$cipher");
+    } else {
+      fail("quit after starttls failed: ".$smtp->code);
+    }
+  }
+}
+
+
+my $smtp = Net::SMTP->new($host, SSL => 1, Debug => $debug);
+# we now should have access to SSL stuff
+my $cipher = eval { $smtp->get_cipher };
+if (!$cipher) {
+  fail("after ssl connect: not an SSL object");
+} elsif ( $smtp->quit ) {
+  pass("ssl connect ok, cipher=$cipher");
+} else {
+  fail("quit after direct ssl failed: ".$smtp->code);
+}