[pve-devel] [PATCH common 0/2] adapt PVE::Tools::sendmail to match rust-implementation

[pve-devel] [PATCH common 0/2] adapt PVE::Tools::sendmail to match rust-implementation

[Stoiko Ivanov]

The 2 patches adapt PVE::Tools::sendmail to closely match the recently merged
implementation in our rust repository - see [0].

I moved the email regex from JSONSchema to Tools to reuse it for the sendmail
function (and eliminate one of the few email-address regexes in our codebase).

I did not add a dependency on libtimedate-perl (where Date::Format is), since
we already use  Date::Parse in PVE::Certificate, without explicit dependency,
and it gets pulled in via libwww-perl -> libhttp-date-perl -> libtimedate-perl.

Glad to send an update for the dependency of course.

[0] https://lists.proxmox.com/pipermail/pbs-devel/2020-August/000423.html

Stoiko Ivanov (2):
  move email regex from JSONSchema to Tools
  sendmail-helper: only send multipart if necessary

 src/PVE/JSONSchema.pm |  4 ++--
 src/PVE/Tools.pm      | 49 +++++++++++++++++++++++++++++--------------
 2 files changed, 35 insertions(+), 18 deletions(-)

-- 
2.20.1

[pve-devel] [PATCH common 1/2] move email regex from JSONSchema to Tools

[Stoiko Ivanov]

Move the Regular expression used for matching e-mail addresses from
the verify sub in PVE::JSONSchema to PVE::Tools, so that it can be reused
in PVE::Tools::sendmail. This ensures that both uses have the same
definition of valid email addresses.

Signed-off-by: Stoiko Ivanov <s.ivanov@proxmox.com>
---
 src/PVE/JSONSchema.pm | 4 ++--
 src/PVE/Tools.pm      | 3 +++
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/PVE/JSONSchema.pm b/src/PVE/JSONSchema.pm
index 2ceb1bd..b27ffa7 100644
--- a/src/PVE/JSONSchema.pm
+++ b/src/PVE/JSONSchema.pm
@@ -7,7 +7,7 @@ use Getopt::Long;
 use Encode::Locale;
 use Encode;
 use Devel::Cycle -quiet; # todo: remove?
-use PVE::Tools qw(split_list $IPV6RE $IPV4RE);
+use PVE::Tools qw(split_list $IPV6RE $IPV4RE $EMAILRE);
 use PVE::Exception qw(raise);
 use HTTP::Status qw(:constants);
 use Net::IP qw(:PROC);
@@ -469,7 +469,7 @@ register_format('email', \&pve_verify_email);
 sub pve_verify_email {
     my ($email, $noerr) = @_;
 
-    if ($email !~ /^[\w\+\-\~]+(\.[\w\+\-\~]+)*@[a-zA-Z0-9\-]+(\.[a-zA-Z0-9\-]+)*$/) {
+    if ($email !~ /^${EMAILRE}$/) {
 	   return undef if $noerr;
 	   die "value does not look like a valid email address\n";
     }
diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index f9270d9..e849bdf 100644
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -33,6 +33,7 @@ no warnings 'portable'; # Support for 64-bit ints required
 our @EXPORT_OK = qw(
 $IPV6RE
 $IPV4RE
+$EMAILRE
 lock_file
 lock_file_full
 run_command
@@ -84,6 +85,8 @@ our $IPV6RE = "(?:" .
 
 our $IPRE = "(?:$IPV4RE|$IPV6RE)";
 
+our $EMAILRE = qr{[\w\+\-\~]+(\.[\w\+\-\~]+)*@[a-zA-Z0-9\-]+(\.[a-zA-Z0-9\-]+)*};
+
 use constant {CLONE_NEWNS   => 0x00020000,
               CLONE_NEWUTS  => 0x04000000,
               CLONE_NEWIPC  => 0x08000000,
-- 
2.20.1

[pve-devel] [PATCH common 2/2] sendmail-helper: only send multipart if necessary

[Stoiko Ivanov]

PVE::Tools::sendmail currently always sends a multipart/alternative message
irrespective of the actual content of the mail (e.g. a plain-text only mail
need not be sent as multipart message).

Additionally a few small refactorings based on the discussion
in https://lists.proxmox.com/pipermail/pbs-devel/2020-August/000423.html
and commited in 66004f22c6475ceb0146cf2df1f380f9f0274be4 in the
rust proxmox repository git://git.proxmox.com/git/proxmox.git
were carried over.

tested by creating a backup of a VM and setting an e-mail address, as well
as sending a few small mails via 'perl -e'

Signed-off-by: Stoiko Ivanov <s.ivanov@proxmox.com>
---
 src/PVE/Tools.pm | 46 ++++++++++++++++++++++++++++++----------------
 1 file changed, 30 insertions(+), 16 deletions(-)

diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index e849bdf..6aadd1f 100644
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -25,6 +25,8 @@ use Text::ParseWords;
 use String::ShellQuote;
 use Time::HiRes qw(usleep gettimeofday tv_interval alarm);
 use Scalar::Util 'weaken';
+use Date::Format qw(time2str);
+
 use PVE::Syscall;
 
 # avoid warning when parsing long hex values with hex()
@@ -1443,43 +1445,55 @@ sub sync_mountpoint {
 # mailto may be a single email string or an array of receivers
 sub sendmail {
     my ($mailto, $subject, $text, $html, $mailfrom, $author) = @_;
-    my $mail_re = qr/[^-a-zA-Z0-9+._@]/;
 
     $mailto = [ $mailto ] if !ref($mailto);
 
     foreach (@$mailto) {
 	die "illegal character in mailto address\n"
-	    if ($_ =~ $mail_re);
+	    if ($_ !~ /${EMAILRE}/);
     }
 
     my $rcvrtxt = join (', ', @$mailto);
 
     $mailfrom = $mailfrom || "root";
     die "illegal character in mailfrom address\n"
-	if $mailfrom =~ $mail_re;
+	if $mailfrom !~ /${EMAILRE}/;
 
     $author = $author || 'Proxmox VE';
 
     open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom, "--", @$mailto) ||
 	die "unable to open 'sendmail' - $!";
 
+    my $date = time2str('%a, %d %b %Y %H:%M:%S %z', time());
+
+    my $is_multipart = $text && $html;
+
     # multipart spec see https://www.ietf.org/rfc/rfc1521.txt
     my $boundary = "----_=_NextPart_001_".int(time).$$;
 
-    print MAIL "Content-Type: multipart/alternative;\n";
-    print MAIL "\tboundary=\"$boundary\"\n";
-    print MAIL "MIME-Version: 1.0\n";
+    if ($subject =~ /[^[:ascii:]]/) {
+	$subject = Encode::encode('MIME-Header', $subject);
+    }
 
-    print MAIL "FROM: $author <$mailfrom>\n";
-    print MAIL "TO: $rcvrtxt\n";
-    print MAIL "SUBJECT: $subject\n";
-    print MAIL "\n";
-    print MAIL "This is a multi-part message in MIME format.\n\n";
-    print MAIL "--$boundary\n";
+    if ($subject =~ /[^[:ascii:]]/ || $is_multipart) {
+	print MAIL "MIME-Version: 1.0\n";
+    }
+    print MAIL "From: $author <$mailfrom>\n";
+    print MAIL "To: $rcvrtxt\n";
+    print MAIL "Date: $date\n";
+    print MAIL "Subject: $subject\n";
+
+    if ($is_multipart) {
+	print MAIL "Content-Type: multipart/alternative;\n";
+	print MAIL "\tboundary=\"$boundary\"\n";
+	print MAIL "\n";
+	print MAIL "This is a multi-part message in MIME format.\n\n";
+	print MAIL "--$boundary\n";
+    }
 
     if (defined($text)) {
 	print MAIL "Content-Type: text/plain;\n";
-	print MAIL "\tcharset=\"UTF8\"\n";
+	print MAIL "\tcharset=\"UTF-8\"\n";
 	print MAIL "Content-Transfer-Encoding: 8bit\n";
 	print MAIL "\n";
 
@@ -1489,18 +1503,18 @@ sub sendmail {
 
 	print MAIL $text;
 
-	print MAIL "\n--$boundary\n";
+	print MAIL "\n--$boundary\n" if $is_multipart;
     }
 
     if (defined($html)) {
 	print MAIL "Content-Type: text/html;\n";
-	print MAIL "\tcharset=\"UTF8\"\n";
+	print MAIL "\tcharset=\"UTF-8\"\n";
 	print MAIL "Content-Transfer-Encoding: 8bit\n";
 	print MAIL "\n";
 
 	print MAIL $html;
 
-	print MAIL "\n--$boundary--\n";
+	print MAIL "\n--$boundary--\n" if $is_multipart;
     }
 
     close(MAIL);
-- 
2.20.1