From d3ad0a08dbd9e32a498a5f3335d521d6c38f4f1f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Wed, 21 Mar 2018 13:21:42 +0100
Subject: [PATCH 1/4] SSL support for Net::SMTP
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Ported to Net::SMTP 2.31 as found in Perl 5.16.3 from libnet upstream:

commit 34436780081aa8793b16f51864bce42a7cdd7e8b
Author: Steffen Ullrich <Steffen_Ullrich@genua.de>
Date:   Fri May 16 21:55:20 2014 +0200

    added tests for Net::SMTP SSL and IPv6, save arguments in Net::SMTP to apply them on starttls

IPv6 support exluded.

Check for IO::Socket::SSL version removed because we have default sane
default CA list since perl-IO-Socket-SSL-1.94-7.el7. We also set
SSL_verify_mode => SSL_VERIFY_PEER by default.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 cpan/libnet/Net/Cmd.pm  |  1 -
 cpan/libnet/Net/SMTP.pm | 72 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+), 1 deletion(-)

diff --git a/cpan/libnet/Net/Cmd.pm b/cpan/libnet/Net/Cmd.pm
index 4f0e444..29eeb14 100644
--- a/cpan/libnet/Net/Cmd.pm
+++ b/cpan/libnet/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/cpan/libnet/Net/SMTP.pm b/cpan/libnet/Net/SMTP.pm
index a28496d..6143990 100644
--- a/cpan/libnet/Net/SMTP.pm
+++ b/cpan/libnet/Net/SMTP.pm
@@ -18,6 +18,15 @@ use Net::Config;
 
 $VERSION = "2.31";
 
+# Code for detecting if we can use SSL
+my $ssl_class = eval {
+  require IO::Socket::SSL;
+} && 'IO::Socket::SSL';
+my $nossl_warn = !$ssl_class &&
+  'To use SSL please install IO::Socket::SSL';
+
+sub can_ssl   { $ssl_class };
+
 @ISA = qw(Net::Cmd IO::Socket::INET);
 
 
@@ -33,6 +42,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 +70,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);
@@ -185,11 +206,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;
@@ -527,6 +559,27 @@ 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';
+    $arg{SSL_verify_mode} ||= IO::Socket::SSL::SSL_VERIFY_PEER();
+    my $ok = $class->SUPER::start_SSL($smtp,%arg);
+    $@ = $ssl_class->errstr if !$ok;
+    return $ok;
+  }
+}
+
+
 
 1;
 
@@ -613,6 +666,11 @@ the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
 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<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.
 
@@ -643,6 +701,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',
@@ -686,6 +752,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.
-- 
2.14.3