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{(?

+    $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