Bug#887536: dh-make-perl depends on libemail-address-perl

[Pali Rohár]

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.rohar at gmail.com