Bug#853991: bts: Patches for smtp+starttls:// & Net::SMTP::TLS

[Pali Rohár]

On Thursday 02 February 2017 22:25:47 Pali Rohár wrote:
> Package: devscripts
> 
> Hi! I'm sending two patches for bts to bugs as Mattia Rizzolo wanted. 
> Originally I sent those patches to devscripts-devel mailing list.

PING, more then year passed... can somebody review/comment these
patches? Mattia?

-- 
Pali Rohár
pali.ro...@gmail.com


signature.asc
Description: PGP signature

Bug#853991: bts: Patches for smtp+starttls:// & Net::SMTP::TLS

[Pali Rohár]

Package: devscripts

Hi! I'm sending two patches for bts to bugs as Mattia Rizzolo wanted. 
Originally I sent those patches to devscripts-devel mailing list.

-- 
Pali Rohár
pali.ro...@gmail.com
From 3178362c639d35c95682b822618d7d1361b9c8e1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pali=20Roh=C3=A1r?= 
Date: Wed, 7 Dec 2016 14:41:34 +0100
Subject: [PATCH] bts: Use scheme smtp+starttls:// to enfore STARTTLS
 encryption on smtp host

Net::SMTPS with doSSL => 'starttls' does not enforce STARTTLS. It enable it
only if supported by smtp server. Verification can be done by method call
supports('STARTTLS').
---
 scripts/bts.pl |   15 ++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/scripts/bts.pl b/scripts/bts.pl
index 2a650d1..b0af235 100755
--- a/scripts/bts.pl
+++ b/scripts/bts.pl
@@ -2627,13 +2627,26 @@ sub send_mail {
 	} else {
 		die "$progname: Unable to establish SMTPS connection: $smtps_broken\n";
 	}
+	} elsif ($smtphost =~ m%^smtp\+starttls://(.*)$%) {
+	my ($host, $port) = split(/:/, $1);
+	$port ||= '587';
+
+	if (have_smtps) {
+		$smtp = Net::SMTPS->new($host, Port => $port,
+		Hello => $smtphelo, doSSL => 'starttls') # NOTE: doSSL => 'starttls' does not enforce TLS
+		or die "$progname: failed to open SMTP connection to $smtphost\n($@)\n";
+		$smtp->supports('STARTTLS') # verify that TLS is enabled
+		or die "$progname: failed to issue STARTTLS command to $smtphost: Server does not support it\n";
+	} else {
+		die "$progname: Unable to establish SMTPS connection: $smtps_broken\n";
+	}
 	} else {
 	my ($host, $port) = split(/:/, $smtphost);
 	$port ||= '25';
 
 	if (have_smtps) {
 		$smtp = Net::SMTPS->new($host, Port => $port,
-		Hello => $smtphelo, doSSL => 'starttls')
+		Hello => $smtphelo, doSSL => 'starttls') # NOTE: doSSL => 'starttls' does not enforce TLS
 		or die "$progname: failed to open SMTP connection to $smtphost\n($@)\n";
 	} else {
 		$smtp = Net::SMTP->new($host, Port => $port, Hello => $smtphelo)
-- 
1.7.9.5

From d8a7763b00c6a55334f75e14a86a9eb829823500 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pali=20Roh=C3=A1r?= 
Date: Wed, 7 Dec 2016 14:57:05 +0100
Subject: [PATCH] bts: Try to use Net::SMTP::TLS when Net::SMTPS is not
 available

Net::SMTPS is provided by libnet-smtps-perl package which is not available
on older systems. Also in some cases Net::SMTP::TLS can be already
installed but Net::SMTPS not.
---
 scripts/bts.pl |   57 ++--
 1 file changed, 47 insertions(+), 10 deletions(-)

diff --git a/scripts/bts.pl b/scripts/bts.pl
index b0af235..98d2224 100755
--- a/scripts/bts.pl
+++ b/scripts/bts.pl
@@ -75,6 +75,7 @@ my $it = undef;
 my $last_user = '';
 my $lwp_broken = undef;
 my $smtps_broken = undef;
+my $smtp_tls_broken = undef;
 my $authen_sasl_broken;
 my $ua;
 
@@ -115,6 +116,23 @@ sub have_smtps() {
 return $smtps_broken ? 0 : 1;
 }
 
+sub have_smtp_tls() {
+return ($smtp_tls_broken ? 0 : 1) if defined $smtp_tls_broken;
+eval {
+   require Net::SMTP::TLS;
+};
+
+if ($@) {
+   if ($@ =~ m%^Can\'t locate Net/SMTP/TLS%) {
+   $smtp_tls_broken="the libnet-smtp-tls-perl package is not installed";
+   } else {
+   $smtp_tls_broken="couldn't load Net::SMTP::TLS: $@";
+   }
+}
+else { $smtp_tls_broken=''; }
+return $smtp_tls_broken ? 0 : 1;
+}
+
 sub have_authen_sasl() {
 return ($authen_sasl_broken ? 0 : 1) if defined $authen_sasl_broken;
 eval {
@@ -2637,8 +2655,17 @@ sub send_mail {
 		or die "$progname: failed to open SMTP connection to $smtphost\n($@)\n";
 		$smtp->supports('STARTTLS') # verify that TLS is enabled
 		or die "$progname: failed to issue STARTTLS command to $smtphost: Server does not support it\n";
+	} elsif (have_smtp_tls) {
+		if ($smtpuser) {
+		$smtppass = getpass() if not $smtppass;
+		}
+		$smtp = Net::SMTP::TLS->new($host, Port => $port,
+		Hello => $smtphelo, User => $smtpuser, Password => $smtppass)
+		or die "$progname: failed to open SMTP connection to $smtphost\n($@)\n";
+		$smtpuser = undef;
+		$smtppass = undef;
 	} else {
-		die "$progname: Unable to establish SMTPS connection: $smtps_broken\n";
+		die "$progname: Unable to establish SMTPS connection: $smtps_broken $smtp_tls_broken\n";
 	}
 	} else {
 	my ($host, $port) = split(/:/, $smtphost);
@@ -2662,18 +2689,28 @@ sub send_mail {
 		die "$progname: failed to authenticate to $smtphost: $authen_sasl_broken\n";
 	}
 	}
-	$smtp->mail($fromaddress)
-	or die "$progname: failed to set SMTP from address $fromaddress\n($@)\n";
 	my @addresses = extract_addresses($to);
 	push @addresses, extract_addresses($cc);
-	foreach my $address (@addresses) {
-	$smtp->recipient($address)
-	or die "$progname: failed to set SMTP recipient $address\n($@)\n";
+	if ($smtp->isa('Net::SMTP::TLS')) {
+