checks/debian/changelog.pm

@@ -71,7 +71,7 @@ sub source {
         if ($contents =~ qr/BEGIN PGP SIGNATURE.*END PGP SIGNATURE/ms) {
 
             tag 'unreleased-changelog-distribution'
-              if lc($latest_entry->Distribution) eq 'unreleased';
+              if $latest_entry->Distribution eq 'UNRELEASED';
         }
     }
 
@@ -81,6 +81,51 @@ sub source {
         tag 'hyphen-in-upstream-part-of-debian-changelog-version',
           $latest_version->upstream
           if !$info->native && $latest_version->upstream =~ qr/-/;
+
+        # unstable, testing, and stable shouldn't be used in Debian
+        # version numbers.  unstable should get a normal version
+        # increment and testing and stable should get suite-specific
+        # versions.
+        #
+        # NMUs get a free pass because they need to work with the
+        # version number that was already there.
+        unless (length $latest_version->source_nmu) {
+            my $revision = $latest_version->maintainer_revision;
+            my $distribution = $latest_entry->Distribution;
+
+            tag 'version-refers-to-distribution',$latest_version->literal
+              if ($revision =~ /testing|(?:un)?stable/i)
+              || (
+                ($distribution eq 'unstable'|| $distribution eq 'experimental')
+                && $revision
+                =~ /woody|sarge|etch|lenny|squeeze|stretch|buster/);
+        }
+
+        my $examine = $latest_version->maintainer_revision;
+        $examine = $latest_version->upstream
+          unless $info->native;
+
+        my $candidate_pattern = qr/rc|alpha|beta|pre(?:view|release)?/;
+        my $increment_pattern = qr/[^a-z].*|\Z/;
+
+        my ($candidate_string, $increment_string)
+          = ($examine =~ m/[^~a-z]($candidate_pattern)($increment_pattern)/sm);
+        if (length $candidate_string && !length $latest_version->source_nmu) {
+
+            my $increment_string //= EMPTY;
+
+            # remove rc-part and any preceding symbol
+            my $expected = $examine;
+            $expected =~ s/[\.\+\-\:]?\Q$candidate_string\E.*//;
+
+            my $suggestion = "$expected~$candidate_string$increment_string";
+
+            tag 'rc-version-greater-than-expected-version',
+              $examine, '>',$expected, "(consider using $suggestion)",
+              if $latest_version->maintainer_revision eq '1'
+              || $latest_version->maintainer_revision=~ m,^0(?:\.1|ubuntu1)?$,
+              || $info->native;
+        }
     }
 
     if (@entries > 1) {
@@ -138,15 +183,21 @@ sub source {
               or $latest_entry->Distribution =~ /-security$/i
               or $latest_entry->Source ne $previous_entry->Source;
 
-            if ($latest_version->literal=~ /([+~]deb\d+u1|\+nmu1)$/) {
-                my $expected= substr($latest_version->literal, 0, -length($1));
+            my $expected_previous = $previous_version->literal;
+            $expected_previous = $latest_version->without_backport
+              if $latest_version->backport_release
+              && $latest_version->backport_revision
+              && $latest_version->debian_without_backport ne '0';
+
+            $expected_previous = $latest_version->without_source_nmu
+              if $latest_version->source_nmu;
+
             tag 'changelog-file-missing-explicit-entry',
                 $previous_version->literal
-                  . " -> $expected (missing) -> "
+              . " -> $expected_previous (missing) -> "
               . $latest_version->literal
-                  unless $previous_version->literal eq $expected
+              unless $previous_version->literal eq $expected_previous
               || $latest_entry->Distribution =~ /-security$/i;
-            }
 
             if (   $latest_version->epoch eq $previous_version->epoch
                 && $latest_version->upstream eq$previous_version->upstream
@@ -278,7 +329,7 @@ sub binary {
         # Some checks on the most recent entry.
         if ($changelog->entries && defined @{$changelog->entries}[0]) {
             ($news) = @{$changelog->entries};
-            if ($news->Distribution && $news->Distribution =~ /unreleased/i) {
+            if ($news->Distribution && $news->Distribution eq 'UNRELEASED') {
                 tag 'debian-news-entry-has-strange-distribution',
                   $news->Distribution;
             }
@@ -297,8 +348,21 @@ sub binary {
     # is this a native Debian package?
     # If the version is missing, we assume it to be non-native
     # as it is the most likely case.
-    my $version = $info->field('version', '0-1');
-    $native_pkg  = $info->native;
+    my $source = $info->field('source');
+    my $version;
+    if (defined $source && $source =~ m/\((.*)\)/) {
+        $version = $1;
+    } else {
+        $version = $info->field('version');
+    }
+    if (defined $version) {
+        $native_pkg = ($version !~ m/-/);
+    } else {
+        # We do not know, but assume it to non-native as it is
+        # the most likely case.
+        $native_pkg = 0;
+    }
+    $version = $info->field('version', '0-1');
     $foreign_pkg = (!$native_pkg && $version !~ m/-0\./);
     # A version of 1.2.3-0.1 could be either, so in that
     # case, both vars are false
@@ -460,7 +524,7 @@ sub binary {
             if ($latest_timestamp && $previous_timestamp) {
                 tag 'latest-changelog-entry-without-new-date'
                   unless (($latest_timestamp - $previous_timestamp) > 0
-                    or lc($latest_entry->Distribution) eq 'unreleased');
+                    or $latest_entry->Distribution eq 'UNRELEASED');
             }
 
             my $latest_dist = lc $latest_entry->Distribution;
@@ -546,38 +610,6 @@ sub binary {
               || $bug > $BUGS_NUMBER->value('max-bug');
         }
 
-        # unstable, testing, and stable shouldn't be used in Debian
-        # version numbers.  unstable should get a normal version
-        # increment and testing and stable should get suite-specific
-        # versions.
-        #
-        # NMUs get a free pass because they need to work with the
-        # version number that was already there.
-        my $changelog_version;
-        if ($info->native) {
-            $changelog_version = $latest_entry->Version || EMPTY;
-        } else {
-            if ($latest_entry->Version) {
-                ($changelog_version)
-                  = (split('-', $latest_entry->Version))[-1];
-            } else {
-                $changelog_version = EMPTY;
-            }
-        }
-        unless (not $info->native and $changelog_version =~ /\./) {
-            if (    $info->native
-                and $changelog_version =~ /testing|(?:un)?stable/i) {
-                tag 'version-refers-to-distribution', $latest_entry->Version;
-            } elsif ($changelog_version =~ /woody|sarge|etch|lenny|squeeze/) {
-                my %unreleased_dists
-                  = map { $_ => 1 } qw(unstable experimental);
-                if (exists($unreleased_dists{$latest_entry->Distribution})) {
-                    tag 'version-refers-to-distribution',
-                      $latest_entry->Version;
-                }
-            }
-        }
-
         # Compare against NEWS.Debian if available.
         if ($news and $news->Version) {
             if ($latest_entry->Version eq $news->Version) {

checks/debian/version-substvars.pm

@@ -78,7 +78,7 @@ sub source {
                 if (
                     m/^($PKGNAME_REGEX)(?: :[-a-z0-9]+)? \s*   # pkg-name $1
                        \(\s*[\>\<]?[=\>\<]\s*                  # REL 
-                        (\$[{](?:Source-|source:|binary:)(?:Upstream-)?Version[}]) # {subvar}
+                        (\$[{](?:source:|binary:)(?:Upstream-)?Version[}]) # {subvar}
                      /x
                 ) {
                     my $other = $1;

checks/fields/architecture.pm

+# fields/architecture -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::architecture;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Architecture qw(:all);
+use Lintian::Tags qw(tag);
+
+sub binary {
+    my ($pkg, undef, $info, undef, undef) = @_;
+
+    my $unsplit = $info->unfolded_field('architecture');
+
+    return
+      unless defined $unsplit;
+
+    my @list = split(m/ /o, $unsplit);
+
+    return
+      unless @list;
+
+    for my $architecture (@list) {
+        tag 'arch-wildcard-in-binary-package', $architecture
+          if is_arch_wildcard($architecture);
+    }
+
+    tag 'too-many-architectures'
+      if @list > 1;
+
+    my $architecture = $list[0];
+
+    return
+      if $architecture eq 'all';
+
+    tag 'aspell-package-not-arch-all'
+      if $pkg =~ /^aspell-[a-z]{2}(?:-.*)?$/;
+
+    tag 'documentation-package-not-architecture-independent'
+      if $pkg =~ /-docs?$/;
+
+    if ($pkg =~ /^r-(?:cran|bioc|other)-/) {
+
+        for my $file ($info->sorted_index) {
+
+            next
+              if $file->is_dir;
+
+            next
+              unless $file =~ m,^usr/lib/R/.*/DESCRIPTION,;
+
+            tag 'r-package-not-arch-all'
+              if $file->file_contents =~ m/NeedsCompilation: no/m;
+
+            last;
+        }
+    }
+
+    return;
+}
+
+sub always {
+    my (undef, $type, $info, undef, undef) = @_;
+
+    my $architecture = $info->unfolded_field('architecture');
+
+    unless (defined $architecture) {
+        tag 'no-architecture-field';
+        return;
+    }
+
+    my @list = split(m/ /o, $architecture);
+
+    for my $arch (@list) {
+
+        tag 'unknown-architecture', $arch
+          unless is_arch_or_wildcard($arch);
+    }
+
+    if (@list > 1) {    # Check for magic architecture combinations.
+
+        my %archmap;
+        my $magic = 0;
+
+        $archmap{$_}++ for (@list);
+
+        $magic++
+          if $type ne 'source' && $archmap{'all'};
+
+        if ($archmap{'any'}) {
+
+            delete $archmap{'any'};
+
+            # Allow 'all' to be present in source packages as well
+            # (#626775)
+            delete $archmap{'all'}
+              if $type eq 'source';
+
+            $magic++
+              if %archmap;
+        }
+
+        tag 'magic-arch-in-arch-list'
+          if $magic;
+    }
+
+    # Used for later tests.
+    my $arch_indep = 0;
+    $arch_indep = 1
+      if @list == 1 && $list[0] eq 'all';
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/bugs.pm

+# fields/bugs -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::bugs;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+
+sub always {
+    my ($pkg, undef, $info, undef, undef) = @_;
+
+    my $bugs = $info->unfolded_field('bugs');
+
+    return
+      unless defined $bugs;
+
+    tag 'redundant-bugs-field'
+      if $bugs =~ m,^debbugs://bugs.debian.org/?$,i;
+
+    tag 'bugs-field-does-not-refer-to-debian-infrastructure', $bugs
+      unless $bugs =~ m,\.debian\.org, or $pkg =~ /[-]dbgsym$/;
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/built-using.pm

+# fields/built-using -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::built_using;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Relation qw(:constants);
+use Lintian::Tags qw(tag);
+use Lintian::Util qw($PKGNAME_REGEX $PKGVERSION_REGEX);
+
+use constant {
+    BUILT_USING_REGEX => qr/^$PKGNAME_REGEX \(= $PKGVERSION_REGEX\)$/o,
+};
+
+sub always {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $built_using = $info->field('built-using');
+
+    return
+      unless defined $built_using;
+
+    my $built_using_rel = Lintian::Relation->new($built_using);
+    $built_using_rel->visit(
+        sub {
+            if ($_ !~ BUILT_USING_REGEX) {
+                tag 'invalid-value-in-built-using-field', $_;
+                return 1;
+            }
+            return 0;
+        },
+        VISIT_OR_CLAUSE_FULL | VISIT_STOP_FIRST_MATCH
+    );
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/checksums.pm

+# fields/checksums -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::checksums;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+
+sub source {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    tag 'no-strong-digests-in-dsc'
+      unless $info->field('checksums-sha256');
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/derivatives.pm

+# fields/derivatives -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::derivatives;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Data ();
+use Lintian::Tags qw(tag);
+
+my $DERIVATIVE_FIELDS = Lintian::Data->new(
+    'fields/derivative-fields',
+    qr/\s*\~\~\s*/,
+    sub {
+        my ($regexp, $explanation) = split(/\s*\~\~\s*/, $_[1], 2);
+        return {
+            'regexp' => qr/$regexp/,
+            'explanation' => $explanation,
+        };
+    });
+
+sub source {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    foreach my $field ($DERIVATIVE_FIELDS->all) {
+
+        my $val = $info->field($field, '-');
+        my $data = $DERIVATIVE_FIELDS->value($field);
+
+        tag 'invalid-field-for-derivative',
+          "$field: $val ($data->{'explanation'})"
+          if $val !~ m/$data->{'regexp'}/;
+    }
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/dm-upload-allowed.pm

+# fields/dm-upload-allowed -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::dm_upload_allowed;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+
+sub always {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $dmupload = $info->unfolded_field('dm-upload-allowed');
+
+    return
+      unless defined $dmupload;
+
+    tag 'dm-upload-allowed-is-obsolete';
+
+    tag 'malformed-dm-upload-allowed', $dmupload
+      unless $dmupload eq 'yes';
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/essential.pm

+# fields/essential -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::essential;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Data ();
+use Lintian::Tags qw(tag);
+
+our $KNOWN_ESSENTIAL = Lintian::Data->new('fields/essential');
+
+sub source {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $essential = $info->unfolded_field('essential');
+
+    return
+      unless defined $essential;
+
+    tag 'essential-in-source-package';
+
+    return;
+}
+
+sub always {
+    my ($pkg, undef, $info, undef, undef) = @_;
+
+    my $essential = $info->unfolded_field('essential');
+
+    return
+      unless defined $essential;
+
+    unless ($essential eq 'yes' || $essential eq 'no') {
+        tag 'unknown-essential-value';
+        return;
+    }
+
+    tag 'essential-no-not-needed'
+      if $essential eq 'no';
+
+    tag 'new-essential-package'
+      if $essential eq 'yes' && !$KNOWN_ESSENTIAL->known($pkg);
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/format.pm

+# fields/format -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::format;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+
+our @supported_source_formats = (qr/1\.0/, qr/3\.0\s*\((quilt|native)\)/);
+
+sub source {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $format = $info->unfolded_field('format');
+
+    return
+      unless defined $format;
+
+    my $supported = 0;
+    foreach my $f (@supported_source_formats){
+
+        $supported = 1
+          if $format =~ /^\s*$f\s*\z/;
+    }
+
+    tag 'unsupported-source-format', $format
+      unless $supported;
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/homepage.pm

+# fields/homepage -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::homepage;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Data ();
+use Lintian::Tags qw(tag);
+
+my $KNOWN_INSECURE_HOMEPAGE_URIS
+  = Lintian::Data->new('fields/insecure-homepage-uris');
+
+sub source {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $homepage = $info->unfolded_field('homepage');
+
+    unless (defined $homepage) {
+
+        return
+          if $info->native;
+
+        my $binary_has_homepage_field = 0;
+        for my $binary ($info->binaries) {
+
+            if (defined $info->binary_field($binary, 'homepage')) {
+                $binary_has_homepage_field = 1;
+                last;
+            }
+        }
+
+        if ($binary_has_homepage_field) {
+            tag 'homepage-in-binary-package';
+        } else {
+            tag 'no-homepage-field';
+        }
+
+        return;
+    }
+
+    return;
+}
+
+sub always {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $homepage = $info->unfolded_field('homepage');
+
+    return
+      unless defined $homepage;
+
+    my $orig = $info->field('homepage');
+
+    if ($homepage =~ /^<(?:UR[LI]:)?.*>$/i) {
+        tag 'superfluous-clutter-in-homepage', $orig;
+        $homepage = substr($homepage, 1, length($homepage) - 2);
+    }
+
+    require URI;
+    my $uri = URI->new($homepage);
+
+    # not an absolute URI or (most likely) an invalid protocol
+    tag 'bad-homepage', $orig
+      unless $uri->scheme && $uri->scheme =~ m/^(?:ftp|https?|gopher)$/o;
+
+    tag 'homepage-for-cpan-package-contains-version', $orig
+      if $homepage=~ m,/(?:search\.cpan\.org|metacpan\.org)/.*-[0-9._]+/*$,;
+
+    tag 'homepage-for-cran-package-not-canonical', $orig
+      if $homepage=~ m,/cran\.r-project\.org/web/packages/.+,;
+
+    tag 'homepage-for-bioconductor-package-not-canonical', $orig
+      if $homepage=~ m,bioconductor\.org/packages/.*/bioc/html/.*\.html*$,;
+
+    tag 'homepage-field-uses-insecure-uri', $orig
+      if $KNOWN_INSECURE_HOMEPAGE_URIS->matches_any($homepage);
+
+    tag 'homepage-refers-to-obsolete-debian-infrastructure', $orig
+      if $homepage =~ m,alioth\.debian\.org,;
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/installer-menu-item.pm

+# fields/installer-menu-item -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::installer_menu_item;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+
+sub always {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    #---- Installer-Menu-Item (udeb)
+
+    my $menu_item = $info->unfolded_field('installer-menu-item');
+
+    return
+      unless defined $menu_item;
+
+    tag 'bad-menu-item', $menu_item
+      unless $menu_item =~ /^\d+$/;
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/maintainer.pm

+# fields/maintainer -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::maintainer;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Check qw(check_maintainer);
+use Lintian::Tags qw(tag);
+
+sub source {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $maintainer = $info->unfolded_field('maintainer');
+
+    return
+      unless defined $maintainer;
+
+    my $is_list = $maintainer =~ /\@lists(?:\.alioth)?\.debian\.org\b/;
+
+    tag 'no-human-maintainers'
+      if $is_list && !defined $info->field('uploaders');
+
+    return;
+}
+
+sub always {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $maintainer = $info->unfolded_field('maintainer');
+
+    unless (defined $maintainer) {
+        tag 'no-maintainer-field';
+        return;
+    }
+
+    check_maintainer($maintainer, 'maintainer');
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/multi-arch.pm

+# fields/multi-arch -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::multi_arch;
+
+use strict;
+use warnings;
+use autodie;
+
+use List::MoreUtils qw(uniq);
+
+use Lintian::Tags qw(tag);
+use Lintian::Util qw(safe_qx);
+
+use constant EMPTY => q{};
+use constant SPACE => q{ };
+
+sub source {
+    my ($pkg, undef, $info, undef, undef) = @_;
+
+    for my $bin ($info->binaries) {
+
+        next
+          unless $info->binary_field($bin, 'multi-arch', EMPTY) eq 'same';
+
+        my $wildcard = $info->binary_field($bin, 'architecture');
+        my @arches   = split(
+            SPACE,
+            safe_qx(
+                'dpkg-architecture', '--match-wildcard',
+                $wildcard,           '--list-known'
+            ));
+
+        # include original wildcard
+        push(@arches, $wildcard);
+
+        foreach my $arch (uniq @arches) {
+
+            my $specific = "debian/$bin.lintian-overrides.$arch";
+
+            tag 'multi-arch-same-package-has-arch-specific-overrides',
+              $specific
+              if $info->index_resolved_path($specific);
+        }
+    }
+
+    return;
+}
+
+sub binary {
+    my ($pkg, undef, $info, undef, undef) = @_;
+
+    if ($pkg =~ /^x?fonts-/) {
+        tag 'font-package-not-multi-arch-foreign'
+          unless $info->field('multi-arch', 'no') =~m/^(?:foreign|allowed)$/o;
+    }
+
+    my $multi = $info->unfolded_field('multi-arch');
+
+    return
+      unless defined $multi;
+
+    my $architecture = $info->unfolded_field('architecture');
+    if (defined $architecture) {
+
+        tag 'illegal-multi-arch-value', $architecture, $multi
+          if $architecture eq 'all' && $multi eq 'same';
+    }
+
+    return;
+}
+
+sub always {
+    my ($pkg, undef, $info, undef, undef) = @_;
+
+    my $multi = $info->unfolded_field('multi-arch');
+
+    return
+      unless defined $multi;
+
+    tag 'unknown-multi-arch-value', $pkg, $multi
+      unless $multi =~ m/^(?:no|foreign|allowed|same)$/o;
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/origin.pm

+# fields/origin -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::origin;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+
+sub always {
+    my (undef, undef, $info, $proc, undef) = @_;
+
+    my $origin = $info->unfolded_field('origin');
+
+    return
+      unless defined $origin;
+
+    tag 'redundant-origin-field'
+      if lc($origin) eq 'debian';
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/package.pm

+# fields/package -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::package;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Tags qw(tag);
+use Lintian::Util qw($PKGNAME_REGEX);
+
+sub binary {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $name = $info->unfolded_field('package');
+
+    unless (defined $name) {
+        tag 'no-package-name';
+        return;
+    }
+
+    tag 'bad-package-name'
+      unless $name =~ /^$PKGNAME_REGEX$/i;
+
+    tag 'package-not-lowercase'
+      if $name =~ /[A-Z]/;
+
+    tag 'unusual-documentation-package-name'
+      if $name =~ /-docs$/;
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/priority.pm

+# fields/priority -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::priority;
+
+use strict;
+use warnings;
+use autodie;
+
+use List::MoreUtils qw(any);
+
+use Lintian::Data ();
+use Lintian::Tags qw(tag);
+
+my $KNOWN_PRIOS = Lintian::Data->new('fields/priorities');
+
+sub binary {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $priority = $info->unfolded_field('priority');
+
+    unless (defined $priority) {
+        tag 'no-priority-field';
+        return;
+    }
+}
+
+sub always {
+    my ($pkg, $type, $info, undef, undef) = @_;
+
+    my $priority = $info->unfolded_field('priority');
+
+    return
+      unless defined $priority;
+
+    if ($type eq 'source' || !$info->is_pkg_class('auto-generated')) {
+
+        tag 'priority-extra-is-replaced-by-priority-optional'
+          if $priority eq 'extra';
+
+        # Re-map to optional to avoid an additional warning from
+        # lintian
+        $priority = 'optional'
+          if $priority eq 'extra';
+    }
+
+    tag 'unknown-priority', $priority
+      unless $KNOWN_PRIOS->known($priority);
+
+    tag 'excessive-priority-for-library-package', $priority
+      if $pkg =~ m/^lib/o
+      && $pkg !~ m/-bin$/o
+      && $pkg !~ m/^libc[0-9.]+$/o
+      && (any { $_ eq $info->field('section', '') } qw(libdevel libs))
+      && (any { $_ eq $priority } qw(required important standard));
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et

checks/fields/section.pm

+# fields/section -- lintian check script (rewrite) -*- perl -*-
+#
+# Copyright (C) 2004 Marc Brockschmidt
+#
+# Parts of the code were taken from the old check script, which
+# was Copyright (C) 1998 Richard Braakman (also licensed under the
+# GPL 2 or higher)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::fields::section;
+
+use strict;
+use warnings;
+use autodie;
+
+use Lintian::Data ();
+use Lintian::Tags qw(tag);
+
+use constant EMPTY => q{};
+
+our $KNOWN_SECTIONS = Lintian::Data->new('fields/archive-sections');
+
+# Mapping of package names to section names
+my $NAME_SECTION_MAPPINGS = Lintian::Data->new(
+    'fields/name_section_mappings',
+    qr/\s*=>\s*/,
+    sub {
+        return {'regex' =>  qr/$_[0]/x, 'section' => $_[1]};
+    });
+
+our %KNOWN_ARCHIVE_PARTS = map { $_ => 1 } ('non-free', 'contrib');
+
+sub binary {
+    my ($pkg, $type, $info, undef, undef) = @_;
+
+    my $section = $info->unfolded_field('section');
+
+    unless (defined $section) {
+        tag 'no-section-field';
+        return;
+    }
+
+    return;
+}
+
+sub udeb {
+    my (undef, undef, $info, undef, undef) = @_;
+
+    my $section = $info->unfolded_field('section');
+
+    return
+      unless defined $section;
+
+    tag 'wrong-section-for-udeb', $section
+      unless $section eq 'debian-installer';
+
+    return;
+}
+
+sub always {
+    my ($pkg, $type, $info, undef, undef) = @_;
+
+    my $section = $info->unfolded_field('section');
+
+    return
+      unless defined $section;
+
+    if ($section eq EMPTY) {
+        tag 'empty-section-field';
+        return;
+    }
+
+    return
+      if $type eq 'udeb';
+
+    my @parts = split(m{/}, $section, 2);
+
+    my $division;
+    $division = $parts[0]
+      if @parts > 1;
+
+    my $group = $parts[-1];
+
+    if (defined $division) {
+        tag 'unknown-section', $section
+          unless $KNOWN_ARCHIVE_PARTS{$division};
+    }
+
+    if ($group eq 'unknown' && !length $division) {
+        tag 'section-is-dh_make-template';
+    } else {
+        tag 'unknown-section', $section
+          unless $KNOWN_SECTIONS->known($group);
+    }
+
+    # Check package name <-> section.  oldlibs is a special case; let
+    # anything go there.
+    if ($group ne 'oldlibs') {
+
+        foreach my $name_section ($NAME_SECTION_MAPPINGS->all()) {
+            my $regex= $NAME_SECTION_MAPPINGS->value($name_section)->{'regex'};
+            my $section
+              = $NAME_SECTION_MAPPINGS->value($name_section)->{'section'};
+
+            next
+              unless ($pkg =~ m{$regex});
+
+            unless ($group eq $section) {
+
+                my $better
+                  = (defined $division ? "$division/" : EMPTY) . $section;
+                tag 'wrong-section-according-to-package-name',
+                  "$pkg => $better";
+            }
+
+            last;
+        }
+    }
+
+    if ($group eq 'debug') {
+
+        tag 'wrong-section-according-to-package-name',"$pkg"
+          if $pkg !~ /-dbg(?:sym)?$/;
+    }
+
+    if ($info->is_pkg_class('transitional')) {
+
+        my $priority = $info->unfolded_field('priority') // EMPTY;
+
+        tag 'transitional-package-should-be-oldlibs-optional',
+          "$group/$priority"
+          unless $priority eq 'optional' && $group eq 'oldlibs';
+    }
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et