merge changes from dla source branch

diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm
index 78efdf12e512f0c940222508c5163e0990fe8370..c5d73d17b3da4b7f81e8fa7879ce978d7de098a2 100644 (file)
--- a/Debbugs/Control.pm
+++ b/Debbugs/Control.pm
@@ -2402,7 +2402,7 @@ sub __calculate_merge_changes{
                 (exists $force_functions{$field}{modify_value} ?
                  $force_functions{$field}{modify_value}->($merge_status->{$field}):
                  $merge_status->{$field}),
-                value    => $merge_status->{$field},
+                value    => ref($merge_status->{$field}) eq 'HASH'?[sort keys %{$merge_status->{$field}}]:$merge_status->{$field},
                 function => $force_functions{$field}{func},
                 key      => $force_functions{$field}{key},
                 options  => $force_functions{$field}{options},

diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm
index af80f7ab5e6f5d86b734bb27a6612f71e738ebf4..a28384de59bd5ddaf9ce41d8b32f7b8dbd504779 100644 (file)
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -39,6 +39,7 @@ use Carp;
 
 use Debbugs::Common qw(getbuglocation getbugcomponent make_list);
 use Params::Validate qw(:types validate_with);
+use Encode qw(encode);
 
 =head1 NAME
 
@@ -426,7 +427,7 @@ Applies the log escape regex to the passed logfile.
 
 sub escape_log {
        my @log = @_;
-       return map { s/^([\01-\07\030])/\030$1/gm; $_ } @log;
+       return map { eval {$_ = encode("utf8",$_,Encode::FB_CROAK)}; s/^([\01-\07\030])/\030$1/gm; $_ } @log;
 }
 
 

diff --git a/Debbugs/Mail.pm b/Debbugs/Mail.pm
index ad2df8c66e493ad36c6e7a3946a865090fa5d30b..41a67802b2632154a2590e2e382245b3baad5346 100644 (file)
--- a/Debbugs/Mail.pm
+++ b/Debbugs/Mail.pm
@@ -48,6 +48,7 @@ use Mail::Address ();
 use Debbugs::MIME qw(encode_rfc1522);
 use Debbugs::Config qw(:config);
 use Params::Validate qw(:types validate_with);
+use Encode qw(encode is_utf8);
 
 use Debbugs::Packages;
 
@@ -346,6 +347,11 @@ sub send_mail_message{
      if ($param{encode_headers}) {
          $param{message} = encode_headers($param{message});
      }
+     eval {
+        if (is_utf8($param{message})) {
+            $param{message} = encode('utf8',$param{message});
+        }
+     };
 
      # First, try to send the message as is.
      eval {

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 7ca77cf5ea6c05584adfae20092c900b0bc635f2..d44d0bdea277da4add795748ab9c200cabafc3b1 100644 (file)
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -45,6 +45,7 @@ use Debbugs::Versions;
 use Debbugs::Versions::Dpkg;
 use POSIX qw(ceil);
 use File::Copy qw(copy);
+use Encode qw(decode encode);
 
 use Storable qw(dclone);
 use List::Util qw(min max);
@@ -239,6 +240,9 @@ sub read_bug{
 
     my %namemap = reverse %fields;
     for my $line (@lines) {
+       eval {
+           $line = decode("utf8",$line,Encode::FB_CROAK);
+       };
         if ($line =~ /(\S+?): (.*)/) {
             my ($name, $value) = (lc $1, $2);
            # this is a bit of a hack; we should never, ever have \r
@@ -636,11 +640,14 @@ sub makestatus {
                 # Output field names in proper case, e.g. 'Merged-With'.
                 my $properfield = $fields{$field};
                 $properfield =~ s/(?:^|(?<=-))([a-z])/\u$1/g;
-                $contents .= "$properfield: $newdata{$field}\n";
+               my $data = $newdata{$field};
+                $contents .= "$properfield: $data\n";
             }
         }
     }
-
+    eval {
+       $contents = encode("utf8",$contents,Encode::FB_CROAK);
+    };
     return $contents;
 }
 

diff --git a/scripts/service b/scripts/service
index eb10acd031a8d15755de92fba2492a899b144937..77b5ecae83627dc88bf0be2e3a693edd980bdeb1 100755 (executable)
--- a/scripts/service
+++ b/scripts/service
@@ -18,8 +18,9 @@ use Params::Validate qw(:types validate_with);
 use Debbugs::Common qw(:util :quit :misc :lock);
 
 use Debbugs::Status qw(:read :status :write :versions :hook);
+use Debbugs::Packages qw(binary_to_source);
 
-use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
+use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522 create_mime_message);
 use Debbugs::Mail qw(send_mail_message);
 use Debbugs::User;
 use Debbugs::Recipients qw(:all);
@@ -38,6 +39,7 @@ use Scalar::Util qw(looks_like_number);
 use List::Util qw(first);
 
 use Mail::RFC822::Address;
+use Encode qw(decode encode);
 
 chdir($config{spool_dir}) or
      die "Unable to chdir to spool_dir '$config{spool_dir}': $!";
@@ -114,8 +116,8 @@ if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
 my $errors = 0;
 my $controlrequestaddr= ($control ? 'control' : 'request').'@'.$config{email_domain};
 my $transcript_scalar = '';
-my $transcript = IO::Scalar->new(\$transcript_scalar) or
-     die "Unable to create new IO::Scalar";
+open my $transcript, ">:scalar:utf8", \$transcript_scalar or
+     die "Unable to create transcript scalar: $!";
 print {$transcript} "Processing commands for $controlrequestaddr:\n\n";
 
 
@@ -201,6 +203,10 @@ for ($procline=0; $procline<=$#bodylines; $procline++) {
     # Fixes #488554
     s/\xef\xbb\xbf//g;
     next unless m/\S/;
+    eval {
+       my $temp = decode("utf8",$_,Encode::FB_CROAK);
+       $_ = $temp;
+    };
     print {$transcript} "> $_\n";
     next if m/^\s*\#/;
     $action= '';
@@ -549,7 +555,7 @@ END
            set_done(@common_control_options,
                     bug          => $ref,
                     reopen       => 1,
-                    submitter    => $new_submitter,
+                    defined $new_submitter? (submitter    => $new_submitter):(),
                    );
        };
        if ($@) {
@@ -1090,22 +1096,31 @@ if (!defined $header{'subject'} || $header{'subject'} eq "") {
 # Error text here advertises how many errors there were
 my $error_text = $errors > 0 ? " (with $errors errors)":'';
 
-my $reply= <<END;
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $replyto
-${maintccs}Subject: Processed${error_text}: $header{'subject'}
-In-Reply-To: $header{'message-id'}
-END
-$reply .= <<END;
-References: $header{'message-id'}
-Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
-Precedence: bulk
-${packagepr}X-$gProject-PR-Message: transcript
-END
-
-$reply .= fill_template('mail/message_body',
-                         {body => "${transcript_scalar}Please contact me if you need assistance."},
-                       );
+my @common_headers;
+push @common_headers, 'X-Loop',$gMaintainerEmail;
+
+my $temp_transcript = ${transcript_scalar};
+eval{
+    $temp_transcript = decode("utf8",$temp_transcript,Encode::FB_CROAK);
+};
+my $reply =
+    create_mime_message([From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+                        To            => $replyto,
+                        @maintccs ? (Cc => join(', ',@maintccs)):(),
+                        Subject       => "Processed${error_text}: $header{subject}",
+                        'Message-ID'  => "<handler.s.$nn.transcript\@$gEmailDomain>",
+                        'In-Reply-To' => $header{'message-id'},
+                        References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+                        Precedence    => 'bulk',
+                        keys %affected_packages ?("X-${gProject}-PR-Package" => join(' ',keys %affected_packages)):(),
+                        keys %affected_packages ?("X-${gProject}-PR-Source" =>
+                                                  join(' ',grep {defined $_} map {binary_to_source(binary => $_)} keys %affected_packages)):(),
+                        "X-$gProject-PR-Message" => 'transcript',
+                        @common_headers,
+                       ],
+                       fill_template('mail/message_body',
+                                     {body => "${temp_transcript}Please contact me if you need assistance."},
+                                    ));
 
 my $repliedshow= join(', ',$replyto,
                      determine_recipients(recipients => \%recipients,
@@ -1113,6 +1128,7 @@ my $repliedshow= join(', ',$replyto,
                                           address_only => 1,
                                          )
                     );
+
 # -1 is the service.in log
 &filelock("lock/-1");
 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";

diff --git a/t/06_mail_handling.t b/t/06_mail_handling.t
index 8285792260cdbfee8cd45602f6f39ada2b9e8610..1cc842c2b378716e57a2dcd5bf032f47b427bff3 100644 (file)
--- a/t/06_mail_handling.t
+++ b/t/06_mail_handling.t
@@ -1,7 +1,7 @@
 # -*- mode: cperl;-*-
 # $Id: 05_mail.t,v 1.1 2005/08/17 21:46:17 don Exp $
 
-use Test::More tests => 114;
+use Test::More tests => 117;
 
 use warnings;
 use strict;
@@ -22,6 +22,7 @@ use File::Basename qw(dirname basename);
 use lib qw(t/lib);
 use DebbugsTest qw(:all);
 use Data::Dumper;
+use Encode qw(decode encode);
 
 # HTTP::Server:::Simple defines a SIG{CHLD} handler that breaks system; undef it here.
 $SIG{CHLD} = sub {};
@@ -299,6 +300,11 @@ my @control_commands =
                       status_key => 'keywords',
                       status_value => 'patch',
                      },
+      utf8_retitle => {command => 'retitle',
+                      value   => 'Thïs is a ütff8 title [♥♡☙☎]',
+                      status_key => 'subject',
+                      status_value => decode("utf8",'Thïs is a ütff8 title [♥♡☙☎]'),
+                     },
      );
 
 # In order for the archive/unarchive to work, we have to munge the summary file slightly