From 60adc9dfcf2cc760713ca19c8b11fe88d3425c7d Mon Sep 17 00:00:00 2001 From: Pali Date: Mon, 12 Feb 2018 18:43:46 +0100 Subject: [PATCH] Do not depend on insecure module Email::Address Method Email::Address->parse is vulnerable to CVE-2015-7686 and also does not parse list of email addresses correctly. This patch replaces it by a new module Email::Address::XS. Also do not use Email::Address->parse for parsing Message-Id, In-Reply-To and References headers. They have different structure and for replying it is not needed at all. Update also unit tests for Message-Id headers. --- lib/Email/Reply.pm | 49 ++++++++++++++++++++++++++-------------------- t/test.t | 34 ++++++++++++++++++++------------ 2 files changed, 50 insertions(+), 33 deletions(-) diff --git a/lib/Email/Reply.pm b/lib/Email/Reply.pm index 9bb6ea7..f482a94 100644 --- a/lib/Email/Reply.pm +++ b/lib/Email/Reply.pm @@ -4,7 +4,7 @@ package Email::Reply; # ABSTRACT: reply to an email message use Email::Abstract 2.01; -use Email::Address 1.80; +use Email::Address::XS; use Email::MIME 1.82; use Exporter 5.57 'import'; @@ -36,7 +36,8 @@ sub _new { $self->{original} = Email::MIME->new(Email::Abstract->as_string($args{to})); ($self->{from}) = - Email::Address->parse($args{from} || $self->{original}->header('To')); + Email::Address::XS->parse($args{from} || $self->{original}->header('To')); + die 'invalid from address' if not $self->{from}; # There are three headers which may give the 'to' address. my $addr_to_parse; @@ -52,8 +53,7 @@ sub _new { die "did not find any of the headers: @headers" if not defined $addr_to_parse; # Parse it and check it succeeded. - my (@parsed) = Email::Address->parse($addr_to_parse); - foreach (@parsed) { die if not defined } + my (@parsed) = Email::Address::XS->parse($addr_to_parse); die "failed to parse address '$addr_to_parse'" if not @parsed; die "strange, '$addr_to_parse' parses to more than one address: @parsed" if @parsed != 1; $self->{to} = $parsed[0]; @@ -78,33 +78,40 @@ sub _make_headers { my @header = (From => $self->{from},); - $self->{to} - ->name((Email::Address->parse($self->{original}->header('From')))[0]->name) - unless $self->{to}->name; - push @header, To => $self->{to}; + if (not defined $self->{to}->phrase) { + my ($from) = Email::Address::XS->parse($self->{original}->header('From')); + $self->{to}->phrase($from->phrase) if defined $from; + } + push @header, To => $self->{to}->format; my $subject = $self->{original}->header('Subject') || ''; $subject = "Re: $subject" unless $subject =~ /\bRe:/i; push @header, Subject => $subject; - my ($msg_id) = Email::Address->parse($self->{original}->header('Message-ID')); - push @header, 'In-Reply-To' => $msg_id; + my $msg_id = $self->{original}->header('Message-ID'); + push @header, 'In-Reply-To' => $msg_id if $msg_id; - my @refs = Email::Address->parse($self->{original}->header('References')); - @refs = Email::Address->parse($self->{original}->header('In-Reply-To')) - unless @refs; - push @refs, $msg_id if $msg_id; - push @header, References => join ' ', @refs if @refs; + my $refs = $self->{original}->header('References') || $self->{original}->header('In-Reply-To'); + if ($msg_id) { + if ($refs) { + $refs .= ' ' . $msg_id; + } else { + $refs = $msg_id; + } + } + push @header, References => $refs if $refs; if ($self->{all}) { my @addrs = ( - Email::Address->parse($self->{original}->header('To')), - Email::Address->parse($self->{original}->header('Cc')), + map { Email::Address::XS->parse($_) } ( + $self->{original}->header('To'), + $self->{original}->header('Cc'), + ) ); unless ($self->{self}) { @addrs = grep { $_->address ne $self->{from}->address } @addrs; } - push @header, Cc => join ', ', @addrs if @addrs; + push @header, Cc => Email::Address::XS::format_email_addresses(@addrs); } $self->{header} = \@header; @@ -183,7 +190,7 @@ sub _simple { use Email::Reply; my $message = Email::Simple->new(join '', <>); - my $from = (Email::Address->parse($message->header('From'))[0]; + my $from = Email::Address::XS->parse($message->header('From')); my $reply = reply to => $message, from => '"Casey West" ', @@ -229,7 +236,7 @@ $200 so please, read up on its available plugins for what is allowed here. = C This optional parameter specifies an email address to use indicating the sender -of the reply message. It can be a string or an C object. In the +of the reply message. It can be a string or an C object. In the absence of this parameter, the first address found in the original message's C header is used. This may not always be what you want, so this parameter comes highly recommended. @@ -307,5 +314,5 @@ L, L, L, L, -L, +L, L. diff --git a/t/test.t b/t/test.t index e30f598..7f59401 100644 --- a/t/test.t +++ b/t/test.t @@ -1,4 +1,4 @@ -use Test::More tests => 16; +use Test::More tests => 18; use strict; $^W = 1; @@ -7,7 +7,7 @@ BEGIN { use_ok 'Email::Simple'; use_ok 'Email::Simple::Creator'; use_ok 'Email::MIME::Modifier'; - use_ok 'Email::Address'; + use_ok 'Email::Address::XS'; } my $response = <<__RESPONSE__; @@ -16,7 +16,7 @@ __RESPONSE__ my $simple = Email::Simple->create( header => [ - To => Email::Address->new(undef, 'casey@geeknest.com'), + To => Email::Address::XS->new(undef, 'casey@geeknest.com'), From => 'alien@titan.saturn.sol', Subject => 'Ping', ], @@ -58,9 +58,11 @@ like( $simple->header_set(Date => ()); $simple->header_set(Cc => 'martian@mars.sol, "Casey" '); -$simple->header_set('Message-ID' => '1232345@titan.saturn.sol'); +$simple->header_set('Message-ID' => '<1232345@titan.saturn.sol>'); +$simple->header_set('In-Reply-To'=> '<6789000@titan.saturn.sol>'); +$simple->header_set('References' => '<6789000@titan.saturn.sol>'); my $complex = reply to => $simple, - from => Email::Address->new('Casey West', 'human@earth.sol'), + from => Email::Address::XS->new('Casey West', 'human@earth.sol'), all => 1, self => 1, attach => 1, @@ -91,11 +93,15 @@ like( like $complex->header('from'), qr/human\@earth\.sol/, "correct from"; -like $complex->header('in-reply-to'), - qr/1232345\@titan\.saturn\.sol/, - "correct from"; +is $complex->header('in-reply-to'), + '<1232345@titan.saturn.sol>', + "correct in-reply-to"; + +is $complex->header('references'), + '<6789000@titan.saturn.sol> <1232345@titan.saturn.sol>', + "correct references"; -$complex->header_set('Message-ID' => '4506957@earth.sol'); +$complex->header_set('Message-ID' => '<4506957@earth.sol>'); my $replyreply = reply to => $complex, body => $response; @@ -103,9 +109,13 @@ like $replyreply->header('from'), qr/alien\@titan\.saturn\.sol/, "correct from"; -like $replyreply->header('in-reply-to'), - qr/4506957\@earth\.sol/, - "correct from"; +is $replyreply->header('in-reply-to'), + '<4506957@earth.sol>', + "correct in-reply-to"; + +is $replyreply->header('references'), + '<6789000@titan.saturn.sol> <1232345@titan.saturn.sol> <4506957@earth.sol>', + "correct references"; $replyreply->header_set(Date => ());