Dpkg: Catch mismatches between version strings and format versions

Ensure that a 3.0 (quilt) package has a non-native version and that
a 3.0 (native) package has a native version. To get the information,
extend Dpkg::Version with a is_native method to check whether a
version has a revision or not.

[guillem@debian.org:
 - Add is_native to history of changes.
 - Do not return an error string when returning a true result. ]

Closes: #700177

Signed-off-by: Guillem Jover <guillem@debian.org>

debian/changelog

@@ -114,6 +114,10 @@ dpkg (1.17.0) UNRELEASED; urgency=low
     Thanks to Colin Watson <cjwatson@ubuntu.com>. Closes: #697297
   * Move epoch-less or revision-less output logic to Dpkg::Version.
     Based on a patch by Bernhard R. Link <brlink@debian.org>.
+  * Catch mismatches between version strings and format versions in
+    dpkg-source. Ensure that a 3.0 (quilt) package has a non-native version
+    and that a 3.0 (native) package has a native version. Closes: #700177
+    Thanks to Bernhard R. Link <brlink@debian.org>.
 
   [ Updated programs translations ]
   * Fix typo in Spanish translation of update-alternatives.

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

@@ -27,6 +27,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Compression;
 use Dpkg::Exit;
+use Dpkg::Version;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Functions qw(erasedir);
 
@@ -64,6 +65,12 @@ sub do_extract {
 }
 
 sub can_build {
+    my ($self, $dir) = @_;
+
+    my $v = Dpkg::Version->new($self->{fields}->{'Version'});
+    return (0, _g('native package version may not have a revision'))
+        unless $v->is_native();
+
     return 1;
 }
 

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

@@ -26,6 +26,7 @@ use parent qw(Dpkg::Source::Package::V2);
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
+use Dpkg::Version;
 use Dpkg::Source::Patch;
 use Dpkg::Source::Functions qw(erasedir fs_time);
 use Dpkg::Source::Quilt;
@@ -72,6 +73,10 @@ sub can_build {
     my ($self, $dir) = @_;
     my ($code, $msg) = $self->SUPER::can_build($dir);
     return ($code, $msg) if $code == 0;
+
+    my $v = Dpkg::Version->new($self->{fields}->{'Version'});
+    return (0, _g('version does not contain a revision')) if $v->is_native();
+
     my $quilt = $self->build_quilt_object($dir);
     $msg = $quilt->find_problems();
     return (0, $msg) if $msg;

scripts/Dpkg/Version.pm

@@ -145,6 +145,17 @@ sub revision {
     return $self->{revision};
 }
 
+=item $v->is_native()
+
+Returns true if the version is native, false if it has a revision.
+
+=cut
+
+sub is_native {
+    my $self = shift;
+    return $self->{no_revision};
+}
+
 =item $v1 <=> $v2, $v1 < $v2, $v1 <= $v2, $v1 > $v2, $v1 >= $v2
 
 Numerical comparison of various versions numbers. One of the two operands
@@ -420,6 +431,8 @@ sub version_check($) {
 
 New argument: Accept an options argument in $v->as_string().
 
+New method: $v->is_native().
+
 =head1 AUTHOR
 
 Don Armstrong <don@donarmstrong.com>, Colin Watson