Merge pull request #1809 from ikedas/issue-1795 by ikedas

The length of boundary lines in multipart messages could exceed 70 octets (#1795)

src/lib/Sympa.pm

@@ -806,16 +806,38 @@ sub is_listmaster {
 }
 
 # Old name: tools::get_message_id().
+#
+# Note:
+# The boundary of multipart message is generated based on this function
+# and its length, 2 octets longer, should be limited up to 70 octets
+# (See RFC 2046, 5.1.1). So as of 6.2.74, the length of the domain part will
+# be limited.  See also GH #1795.
 sub unique_message_id {
     my $that = shift;
 
-    my ($time, $usec) = Sympa::Tools::Time::gettimeofday();
     my $domain =
           (ref $that eq 'Sympa::List') ? $that->{'domain'}
         : ($that and $that ne '*') ? $that
         :                            $Conf::Conf{'domain'};
-    return sprintf '<sympa.%d.%d.%d.%d@%s>', $time, $usec, $PID,
-        (int rand 999), $domain;
+
+    my ($time, $usec) = Sympa::Tools::Time::gettimeofday();
+    my $base32 = sprintf '%s%s%s%s',
+        _base32($time, 35), _base32($usec, 20), _base32($PID, 35),
+        _base32(int(rand 1023), 10);
+
+    return sprintf '<sympa.%s@%s>', $base32, substr $domain, -39;
+}
+
+my @base32_alphabets = split '', '0123456789ABCDEFGHJKMNPQRSTVWXYZ';
+
+sub _base32 {
+    my $dec = shift;
+    my $prc = shift;
+
+    # Convert a (possiblly signed) decimal $dec to binary in $prc bits
+    # then encode it in base32.
+    my $vec = substr sprintf("%0${prc}b", $dec), -$prc;
+    return $vec =~ s/([01]{5})/$base32_alphabets[oct "0b$1"]/egr;
 }
 
 1;

src/lib/Sympa/Message/Template.pm

@@ -186,13 +186,6 @@ sub new {
             $data->{'fromlist'} = Sympa::get_address($list, 'owner');
         }
     }
-    my $unique_id = Sympa::unique_message_id($robot_id);
-    $data->{'boundary'} = sprintf '----------=_%s', $unique_id
-        unless $data->{'boundary'};
-    $data->{'boundary1'} = sprintf '---------=1_%s', $unique_id
-        unless $data->{'boundary1'};
-    $data->{'boundary2'} = sprintf '---------=2_%s', $unique_id
-        unless $data->{'boundary2'};
 
     my $self = $class->_new_from_template($that, $tpl . '.tt2',
         $who, $data, %options);
@@ -271,6 +264,15 @@ sub _new_from_template {
     die sprintf 'Wrong type of reference for $rcpt: %s', ref $rcpt
         if ref $rcpt and ref $rcpt ne 'ARRAY';
 
+    # Boundaries for multipart message.
+    my $unique_id = Sympa::unique_message_id($robot_id);
+    $data->{'boundary'} = sprintf '=_%s', $unique_id
+        unless $data->{'boundary'};
+    $data->{'boundary1'} = sprintf '=1%s', $unique_id
+        unless $data->{'boundary1'};
+    $data->{'boundary2'} = sprintf '=2%s', $unique_id
+        unless $data->{'boundary2'};
+
     ## Charset for encoding
     $data->{'charset'} ||= Conf::lang2charset($data->{'lang'});
 
@@ -327,8 +329,7 @@ sub _new_from_template {
     my $headers = "";
 
     unless ($header_ok{'message-id'}) {
-        $headers .=
-            sprintf("Message-Id: %s\n", Sympa::unique_message_id($robot_id));
+        $headers .= sprintf("Message-Id: %s\n", $unique_id);
     }
 
     unless ($header_ok{'date'}) {