On Saturday 19 May 2018 18:18:03 Pali Rohár wrote: > On Saturday 19 May 2018 15:28:14 gregor herrmann wrote: > > On Wed, 17 Jan 2018 20:50:05 +0100, Pali Rohár wrote: > > > > > Hi! Package dh-make-perl depends on libemail-address-perl which is > > > vulnerable to CVE-2015-7686, see bug #868170. libemail-address-perl > > > provides perl module Email::Address which is now unmaintained. There is > > > a new perl module Email::Address::XS which is API compatible replacement > > > for Email::Address and is available in libemail-address-xs-perl. Please > > > port dh-make-perl package to use libemail-address-xs-perl. > > > > dh-make-perl uses > > > > % grep -r Email::Address > > Build.PL: 'Email::Address' => 0, > > lib/DhMakePerl/Command/Packaging.pm:use Email::Address; > > lib/DhMakePerl/Command/Packaging.pm:my $EMAIL_RE = > > $Email::Address::addr_spec; > > > > And I think there is no ::addr_spec in libemail-address-xs-perl? > > Yes, Email::Address::XS does not have these regexes defined. > > > > If you need > > > help with porting let me know. > > > > > Yes, please :) > > I looked at that Packaging.pm file and I'm really not sure that it is > doing... > > For me it looks like that $PERSON_PARSE_RE just extract phrase (display > name) from the email address. For this action simple ->parse() method > should be enough and then ->phrase() would return it. > > $EMAIL_CHANGES_RE seems to extract list of pairs <name, bare_address> > which matches some specific format. So the only thing needed here is to > check if _address_ is really email address without phrase and angle > brackets. For parsing ->parse_bare_address() method can be used and then > check ->address() that returned something. > > I created patch with these changes, but I'm not sure if it is correct > due to fact that I do not know what that code should do. So it would be > needed to properly test these changes. > > Anyway, do you really need to parse email address according to RFC2822? > And is not (.*) in these cases enough? > > Here is patch: > > diff --git a/Build.PL b/Build.PL > index eb88fa8..a54fc0f 100644 > --- a/Build.PL > +++ b/Build.PL > @@ -25,7 +25,7 @@ my $builder = My::Builder->new( > 'Cwd' => 0, > 'Dpkg' => 0, > 'Dpkg::Source::Package' => '1.01', > - 'Email::Address' => 0, > + 'Email::Address::XS' => '1.01', > 'Email::Date::Format' => 0, > 'File::Basename' => 0, > 'File::Copy' => 0, > diff --git a/lib/DhMakePerl/Command/Packaging.pm > b/lib/DhMakePerl/Command/Packaging.pm > index 8f14caa..9fb9a9e 100644 > --- a/lib/DhMakePerl/Command/Packaging.pm > +++ b/lib/DhMakePerl/Command/Packaging.pm > @@ -35,6 +35,7 @@ use Debian::Control::FromCPAN; > use Debian::Dependencies; > use Debian::Rules; > use DhMakePerl::PodParser (); > +use Email::Address::XS 1.01; > use File::Basename qw(basename dirname); > use File::Find qw(find); > use File::Path (); > @@ -1210,31 +1211,6 @@ sub upsurl { > } > > > -my $ACTUAL_NAME_RE = '\pL[\s\pL\-\'\.]*\pL'; > - > -# See http://www.faqs.org/rfcs/rfc2822.html > -# Section 3.4.1 > -use Email::Address; > -my $EMAIL_RE = $Email::Address::addr_spec; > - > -my $EMAIL_CHANGES_RE = qr{ > - ^ # beginining of line > - \s+\*\s # item marker > - Email\schange:\s # email change token > - ($ACTUAL_NAME_RE) # actual name > - \s+->\s+ # gap between name and email > - ($EMAIL_RE) # email address > - $ # end of line > -}xms; > - > -my $PERSON_PARSE_RE = qr{ > - \A # beginining of string > - ($ACTUAL_NAME_RE) # actual name > - \s # gap > - \<$EMAIL_RE\> # logged email > - \z # end of string > -}xms; > - > # This is what needs fixing. > sub copyright_from_changelog { > my ( $self, $firstmaint, $firstyear ) = @_; > @@ -1248,17 +1224,23 @@ sub copyright_from_changelog { > my $date = $_->Date; > my @date_pieces = split( " ", $date ); > my $year = $date_pieces[3]; > - if (my %changes = ($_->Changes =~ m/$EMAIL_CHANGES_RE/xmsg)) { > + if (my %changes = ($_->Changes =~ > m/^\s+\*\sEmail\schange:\s+(.*?)\s+->\s+(.*?)\s*$/xmsg)) { > # This way round since we are going backward in time thru > changelog > foreach my $p (keys %changes) { > - $changes{$p} =~ s{[\s\n]+$}{}xms; > + # Parse bare email address; undef if it not an email address > + my $address = > Email::Address::XS->parse_bare_address($changes{$p})->address(); > + if ($address) { > + $changes{$p} = $address; > + } else { > + delete $changes{$p}; > + } > } > %email_changes = ( > %changes, > %email_changes > ); > } > - if (my ($name) = ($person =~ $PERSON_PARSE_RE)) { > + if (my $name = Email::Address::XS->parse($person)->phrase()) { > if (exists $email_changes{$name}) { > $person = "$name <$email_changes{$name}>"; > } > >
Seems that very similar code is in license-reconcile package. So very similar patch like above should be applied also for license-reconcile package (https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=887550). Or maybe you should de-duplicate code and having common functions only in place... -- Pali Rohár pali.ro...@gmail.com