Dpkg::Version::check_version() should not die by default

Add a new parameter to Dpkg::Version::check_version() to control whether
we should die in case of illegal version.

Update all check_version() calls to pass this parameter and factorize some
duplicate calls in Dpkg::Source::Package::* with a single check in
the parent class Dpkg::Source::Package.

debian/changelog

@@ -16,6 +16,8 @@ dpkg (1.15.1) UNRELEASED; urgency=low
     /usr/share/doc/dpkg/triggers.txt.gz. Closes: #519717
   * Avoid perl warnings in dpkg-gencontrol and dpkg-genchanges when the
     Architecture field is missing in a binary package. Closes: #510282
+  * Modify Dpkg::Version::check_version() to not die by default.
+    Closes: #510615
 
   [ Guillem Jover ]
   * Fix typo in dpkg output (‘unexecpted’ → ‘unexpected’). Closes: #519082

scripts/Dpkg/Source/Package.pm

@@ -24,7 +24,7 @@ use Dpkg::ErrorHandling;
 use Dpkg::Fields;
 use Dpkg::Cdata;
 use Dpkg::Checksums;
-use Dpkg::Version qw(parseversion);
+use Dpkg::Version qw(parseversion check_version);
 use Dpkg::Deps qw(@src_dep_fields);
 use Dpkg::Compression;
 use Dpkg::Exit;
@@ -324,6 +324,8 @@ sub extract {
     my $self = shift;
     my $newdirectory = $_[0];
 
+    check_version($self->{'fields'}{'Version'}, 1);
+
     # Copy orig tarballs
     if ($self->{'options'}{'copy_orig_tarballs'}) {
         my $basename = $self->get_basename();

scripts/Dpkg/Source/Package/V1.pm

@@ -27,7 +27,6 @@ use Dpkg::ErrorHandling;
 use Dpkg::Compression;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Patch;
-use Dpkg::Version qw(check_version);
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir);
 use Dpkg::Source::Package::V3::native;
@@ -75,8 +74,6 @@ sub do_extract {
 
     my $dscdir = $self->{'basedir'};
 
-    check_version($fields->{'Version'});
-
     my $basename = $self->get_basename();
     my $basenamerev = $self->get_basename(1);
 

scripts/Dpkg/Source/Package/V2.pm

@@ -27,7 +27,6 @@ use Dpkg::ErrorHandling;
 use Dpkg::Compression;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Patch;
-use Dpkg::Version qw(check_version);
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir is_binary);
 
@@ -87,8 +86,6 @@ sub do_extract {
 
     my $dscdir = $self->{'basedir'};
 
-    check_version($fields->{'Version'});
-
     my $basename = $self->get_basename();
     my $basenamerev = $self->get_basename(1);
 

scripts/Dpkg/Source/Package/V3/bzr.pm

@@ -36,7 +36,6 @@ use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::Compression;
 use Dpkg::ErrorHandling;
-use Dpkg::Version qw(check_version);
 use Dpkg::Source::Archive;
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir);
@@ -171,8 +170,6 @@ sub do_extract {
 
     my $dscdir = $self->{'basedir'};
 
-    check_version($fields->{'Version'});
-
     my $basename = $self->get_basename();
     my $basenamerev = $self->get_basename(1);
 

scripts/Dpkg/Source/Package/V3/git.pm

@@ -34,7 +34,6 @@ use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::Compression;
 use Dpkg::ErrorHandling;
-use Dpkg::Version qw(check_version);
 use Dpkg::Source::Archive;
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir);
@@ -235,8 +234,6 @@ sub do_extract {
 
     my $dscdir = $self->{'basedir'};
 
-    check_version($fields->{'Version'});
-
     my $basename = $self->get_basename();
     my $basenamerev = $self->get_basename(1);
 

scripts/Dpkg/Version.pm

@@ -198,15 +198,23 @@ sub compare_versions ($$$)
     }
 }
 
-=item check_version($version)
+=item check_version($version, $die)
 
-Check the version string and fails it it's invalid.
+If $die is false (or unset), returns true if the version is valid and
+false if it contains illegal characters. If $die is true, it dies with
+an error message if it contains illegal characters, otherwise it returns
+true.
 
 =cut
-sub check_version ($) {
-    my $version = shift || '';
-    $version =~ m/[^-+:.0-9a-zA-Z~]/o &&
-        error(_g("version number contains illegal character `%s'"), $&);
+sub check_version ($;$) {
+    my ($version, $die) = @_;
+    $version ||= "";
+
+    if ($version =~ m/[^-+:.0-9a-zA-Z~]/o) {
+        error(_g("version number contains illegal character `%s'"), $&) if $die;
+        return 0;
+    }
+    return 1;
 }
 
 =back

scripts/dpkg-buildpackage.pl

@@ -11,7 +11,6 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(:DEFAULT $warnable_error);
 use Dpkg::BuildOptions;
 use Dpkg::Compression;
-use Dpkg::Version qw(check_version);
 use Dpkg::Changelog qw(parse_changelog);
 use Dpkg::Arch qw(get_build_arch debarch_to_gnutriplet);
 use Dpkg::Vendor qw(get_current_vendor);
@@ -297,7 +296,7 @@ my $changelog = parse_changelog();
 
 my $pkg = mustsetvar($changelog->{source}, _g('source package'));
 my $version = mustsetvar($changelog->{version}, _g('source version'));
-check_version($version);
+check_version($version, 1);
 
 my $maintainer;
 if ($changedby) {

scripts/dpkg-source.pl

@@ -238,7 +238,7 @@ if ($options{'opmode'} eq 'build') {
 	    set_source_package($v);
 	    $fields->{$_} = $v;
 	} elsif (m/^Version$/) {
-	    check_version($v);
+	    check_version($v, 1);
 	    $fields->{$_} = $v;
 	} elsif (s/^X[BS]*C[BS]*-//i) {
 	    $fields->{$_} = $v;