vcs.maemo.org Git - maemian/blob - checks/nmu

   1 # nmu -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 2004 Jeroen van Wolffelaar
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, you can find it on the World Wide
  17 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  19 # MA 02110-1301, USA.
  20
  21 package Maemian::nmu;
  22 use strict;
  23
  24 use Maemian::Data;
  25 use Tags;
  26 use Util;
  27
  28 # Used to match Ubuntu distribution names in target distributions.
  29 our $UBUNTU_REGEX;
  30 {
  31         my $dists = Maemian::Data->new('changelog-file/ubuntu-dists');
  32         my $string = join ('|', 'ubuntu', $dists->all);
  33         $UBUNTU_REGEX = qr/$string/o;
  34 }
  35
  36 sub run {
  37
  38 my $pkg = shift;
  39 my $type = shift;
  40 my $info = shift;
  41
  42 my $changelog_mentions_nmu = 0;
  43 my $changelog_mentions_local = 0;
  44 my $changelog_mentions_qa = 0;
  45
  46 # This isn't really an NMU check, but right now no other check looks at
  47 # debian/changelog in source packages.  Catch a debian/changelog file that's a
  48 # symlink.  If it was a symlink to a file we didn't unpack, bail rather than
  49 # abort.
  50 if (-l "debfiles/changelog") {
  51     tag "changelog-is-symlink", "";
  52     return 0 unless -f "debfiles/changelog";
  53 }
  54
  55 # Get some data from the changelog file.
  56 my ($entry) = $info->changelog->data;
  57 my $distribution = $entry->Distribution;
  58 my $uploader = canonicalize($entry->Maintainer);
  59 my $changes = $entry->Changes;
  60 $changes =~ s/^(\s*\n)+//;
  61 my $firstline = (split('\n', $changes))[0];
  62
  63 # Check the first line for QA and NMU mentions.
  64 if ($firstline) {
  65         local $_ = $firstline;
  66         if (/\bnmu\b/i or /non-maintainer upload/i) {
  67                 unless (/(ackno|\back\b|confir|incorporat).*(\bnmu\b|non-maintainer)/i) {
  68                         $changelog_mentions_nmu = 1;
  69                 }
  70         }
  71         $changelog_mentions_local = 1 if /\blocal\s+package\b/i;
  72         $changelog_mentions_qa = 1 if /orphan/i or /qa (?:group )?upload/i;
  73 }
  74
  75 my $version = $info->field("version");
  76 my $maintainer = canonicalize($info->field("maintainer"));
  77 my $uploaders = $info->field("uploaders");
  78
  79 my $version_nmuness = 0;
  80 my $version_local = 0;
  81 if ($version =~ /-[^.-]+(\.[^.-]+)?(\.[^.-]+)?$/) {
  82         $version_nmuness = 1 if defined $1;
  83         $version_nmuness = 2 if defined $2;
  84 }
  85 if ($version =~ /\+nmu\d+$/) {
  86         $version_nmuness = 1;
  87 }
  88 if ($version =~ /\+b\d+$/) {
  89         $version_nmuness = 2;
  90 }
  91 if ($version =~ /local/i) {
  92         $version_local = 1;
  93 }
  94
  95 my $upload_is_nmu = $uploader ne $maintainer;
  96 if (defined $uploaders) {
  97         my @uploaders = map { canonicalize($_) } split /,/, $uploaders;
  98         $upload_is_nmu = 0 if grep /^\s*\Q$uploader\E\s*$/, @uploaders;
  99 }
 100
 101 # No such thing as NMUs in Ubuntu-land.
 102 if ($version =~ /$UBUNTU_REGEX/ or $distribution =~ /$UBUNTU_REGEX/) {
 103         $upload_is_nmu = 0;
 104         $version_nmuness = 0;
 105 }
 106
 107 if ($maintainer =~ /packages\@qa.debian.org/) {
 108         tag "orphaned-package-should-not-have-uploaders", ""
 109                 if defined $uploaders;
 110         tag "qa-upload-has-incorrect-version-number", "$version"
 111                 if $version_nmuness == 1;
 112         tag "changelog-should-mention-qa", ""
 113                 if !$changelog_mentions_qa;
 114 } else {
 115         # Local packages may be either NMUs or not.
 116         unless ($changelog_mentions_local || $version_local) {
 117                 tag "changelog-should-mention-nmu", ""
 118                     if !$changelog_mentions_nmu && $upload_is_nmu;
 119                 tag "source-nmu-has-incorrect-version-number", "$version"
 120                     if $upload_is_nmu && $version_nmuness != 1;
 121         }
 122         tag "changelog-should-not-mention-nmu", ""
 123                 if $changelog_mentions_nmu && !$upload_is_nmu;
 124         tag "maintainer-upload-has-incorrect-version-number", "$version"
 125                 if !$upload_is_nmu && $version_nmuness;
 126 }
 127
 128 }
 129
 130 # Canonicalize a maintainer address with respect to case.  E-mail addresses
 131 # are case-insensitive in the right-hand side.
 132 sub canonicalize {
 133         my ($maintainer) = @_;
 134         $maintainer =~ s/(<[^>\@]+\@)([\w.-]+)>/$1 . lc ($2)/e;
 135         return $maintainer;
 136 }
 137
 138 1;
 139
 140 # Local Variables:
 141 # indent-tabs-mode: t
 142 # cperl-indent-level: 8
 143 # End:
 144 # vim: ts=4 sw=4