X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FMIME.pm;h=1d8fcb57e2a3c633e8cf86d2bab484ca9c0e5f04;hb=refs%2Fheads%2Fdebian;hp=15078f2c18929f535e8ff83da7958c053f7e522a;hpb=7b1c7d1c4039717417d92f4e3c1a3ef5b602e005;p=debbugs.git

diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm
index 15078f2..3033f30 100644
--- a/Debbugs/MIME.pm
+++ b/Debbugs/MIME.pm
@@ -32,7 +32,7 @@ None known.
 use warnings;
 use strict;
 
-use base qw(Exporter);
+use Exporter qw(import);
 use vars qw($DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
 
 BEGIN {
@@ -42,19 +42,20 @@ BEGIN {
     @EXPORT = ();
 
     %EXPORT_TAGS = (mime => [qw(parse create_mime_message getmailbody)],
-		    rfc1522 => [qw(decode_rfc1522 encode_rfc1522)],
+		    rfc1522 => [qw(decode_rfc1522 encode_rfc1522 handle_escaped_commas)],
 		   );
     @EXPORT_OK=();
     Exporter::export_ok_tags(keys %EXPORT_TAGS);
     $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
-use File::Path;
-use File::Temp qw();
+use File::Path qw(remove_tree);
+use File::Temp qw(tempdir);
 use MIME::Parser;
+use Mail::Message::Field;
 
 use POSIX qw(strftime);
-use List::MoreUtils qw(apply);
+use List::AllUtils qw(apply);
 
 # for convert_to_utf8
 use Debbugs::UTF8 qw(convert_to_utf8);
@@ -94,7 +95,7 @@ sub parse
     my (@headerlines, @bodylines);
 
     my $parser = MIME::Parser->new();
-    my $tempdir = File::Temp::tempdir();
+    my $tempdir = tempdir(CLEANUP => 1);
     $parser->output_under($tempdir);
     my $entity = eval { $parser->parse_data($_[0]) };
 
@@ -135,7 +136,7 @@ sub parse
 	@bodylines = map {convert_to_utf8($_,$charset)} @msg[$i .. $#msg];
     }
 
-    rmtree $tempdir, 0, 1;
+    remove_tree($tempdir,{verbose => 0, safe => 1});
 
     # Remove blank lines.
     shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
@@ -193,7 +194,7 @@ sub create_mime_message{
      die "The third argument to create_mime_message must be an arrayref" unless ref($attachments) eq 'ARRAY';
 
      if ($include_date) {
-	 my %headers = apply {lc($_)} @{$headers};
+	 my %headers = apply {defined $_ ? lc($_) : ''} @{$headers};
 	 if (not exists $headers{date}) {
 	     push @{$headers},
 		 ('Date',
@@ -206,7 +207,7 @@ sub create_mime_message{
      # MIME::Entity is stupid, and doesn't rfc1522 encode its headers, so we do it for it.
      my $msg = MIME::Entity->build('Content-Type' => 'text/plain; charset=utf-8',
 				   'Encoding'     => 'quoted-printable',
-				   (map{encode_rfc1522(encode_utf8($_))} @{$headers}),
+				   (map{encode_rfc1522(encode_utf8(defined $_ ? $_:''))} @{$headers}),
 				   Data    => encode_utf8($body),
 				  );
 
@@ -357,4 +358,36 @@ sub encode_rfc1522 {
      return $string;
 }
 
+=head2
+
+    $header = handle_escaped_commas('','From: ')
+
+Handle commas in addresses which have been RFC1522 escaped and now need to be
+quoted to avoid parsing as a record separator.
+
+=cut
+
+sub handle_escaped_commas {
+    my ($modified_hdr, $orig_hdr) = @_;
+
+    my $field = Mail::Message::Field->new($orig_hdr);
+    # if the header isn't structured, it can't contain an address
+    if (not $field->isStructured()) {
+	return $modified_hdr
+    }
+    if ($field->name() !~ m/^(?:to|from|reply-to)$/) {
+	return $modified_hdr
+    }
+    my @addresses = $field->addresses();
+    if (not @addresses) {
+	return $modified_hdr
+    }
+    my @return_addresses;
+    for my $address (@addresses) {
+	$address->phrase(decode_rfc1522($address->phrase()));
+	push @return_addresses, $address->format();
+    }
+    return join(', ',@return_addresses)
+}
+
 1;