Bug#944887: libemail-mime-perl: fails to handle boundary="0"

[Eric Wong]

Package: libemail-mime-perl
Version: 1.946-1
Severity: normal
Tags: upstream patch

Email::MIME fails to handle mail with a boundary value of "0",
since Perl treats 0 as false.  This is a common type of bug in
Perl code.

Reading RFC 2046, the BNF for allowed boundary characters
allows 1-70 characters, so a single "0" is acceptable:

     boundary := 0*69<bchars> bcharsnospace
     bchars := bcharsnospace / " "
     bcharsnospace := DIGIT / ALPHA / "'" / "(" / ")" /
                      "+" / "_" / "," / "-" / "." /
                      "/" / ":" / "=" / "?"

>From 72e288ff88a191976be339929bed1d2c9c6d1b7a Mon Sep 17 00:00:00 2001
From: Eric Wong <e...@80x24.org>
Date: Sun, 17 Nov 2019 08:57:49 +0000
Subject: [PATCH] Email::MIME: allow "0" as boundary value

Reading RFC 2046, the BNF for allowed boundary characters
allows 1-70 characters, so a single "0" is acceptable:

     boundary := 0*69<bchars> bcharsnospace
     bchars := bcharsnospace / " "
     bcharsnospace := DIGIT / ALPHA / "'" / "(" / ")" /
                      "+" / "_" / "," / "-" / "." /
                      "/" / ":" / "=" / "?"
---
 lib/Email/MIME.pm |  6 ++++--
 t/multipart.t     | 13 ++++++++++---
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/lib/Email/MIME.pm b/lib/Email/MIME.pm
index 0997da4..b7c6e64 100644
--- a/lib/Email/MIME.pm
+++ b/lib/Email/MIME.pm
@@ -387,7 +387,9 @@ sub parts_multipart {
   # that means it's a bogus message, but a mangled result (or exception) is
   # better than endless recursion. -- rjbs, 2008-01-07
   return $self->parts_single_part
-    unless $boundary and $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;
+    unless defined($boundary) and
+           $boundary ne '' and
+           $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;
 
   $self->{body_raw} = $self->SUPER::body;
 
@@ -541,7 +543,7 @@ sub boundary_set {
   my ($self, $value) = @_;
   my $ct_header = parse_content_type($self->header('Content-Type'));
 
-  if ($value) {
+  if (defined($value) && $value ne '') {
     $ct_header->{attributes}->{boundary} = $value;
   } else {
     delete $ct_header->{attributes}->{boundary};
diff --git a/t/multipart.t b/t/multipart.t
index 6d44836..12e5eca 100644
--- a/t/multipart.t
+++ b/t/multipart.t
@@ -67,15 +67,15 @@ is $parts[2]->body_str, 'Hello';
 {
   my $email = Email::MIME->new(<<'END');
 Subject: hello
-Content-Type: multipart/mixed; boundary="bananas"
+Content-Type: multipart/mixed; boundary="0"
 
 Prelude
 
---bananas
+--0
 Content-Type: text/plain
 
 This is plain text.
---bananas--
+--0--
 
 Postlude
 END
@@ -83,6 +83,13 @@ END
   like($email->as_string, qr/Prelude/,  "prelude in string");
   like($email->as_string, qr/Postlude/, "postlude in string");
 
+  my @p;
+  $email->walk_parts(sub {
+    my $str = eval { $_[0]->body_str };
+    push(@p, $str) if defined($str);
+  });
+  is_deeply(\@p, ['This is plain text.']);
+
   $email->parts_set([ $email->subparts ]);
 
   unlike($email->as_string, qr/Prelude/,  "prelude in string");