vcs.maemo.org Git - maemian/blob - checks/watch-file

   1 # watch-file -- lintian check script -*- perl -*-
   2 #
   3 # Copyright (C) 2008 Patrick Schoenfeld
   4 # Copyright (C) 2008 Russ Allbery
   5 # Copyright (C) 2008 Raphael Geissert
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, you can find it on the World Wide
  19 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  20 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  21 # MA 02110-1301, USA.
  22
  23 package Maemian::watch_file;
  24 use strict;
  25
  26 use Maemian::Collect;
  27 use Tags;
  28
  29 sub run {
  30
  31 my $pkg = shift;
  32 my $type = shift;
  33 my $info = shift;
  34
  35 if (! -f "debfiles/watch") {
  36     tag 'debian-watch-file-is-missing' unless ($info->native);
  37     return;
  38 }
  39
  40 # Perform the other checks even if it is a native package
  41 tag 'debian-watch-file-in-native-package' if ($info->native);
  42
  43 # Check if the Debian version contains anything that resembles a repackaged
  44 # source package sign, for fine grained version mangling check
  45 my $version = $info->field('version');
  46 my $repack;
  47 if ($version =~ /(dfsg|debian|ds)/) {
  48     $repack = $1;
  49 }
  50
  51 # Gather information from the watch file and look for problems we can
  52 # diagnose on the first time through.
  53 open(WATCH, '<', 'debfiles/watch') or fail("cannot open watch file: $!");
  54 local $_;
  55 my ($watchver, $mangle, $dmangle, $nonempty, %dversions);
  56 while (<WATCH>) {
  57     next if /^\s*\#/;
  58     next if /^\s*$/;
  59     s/^\s*//;
  60
  61   CHOMP:
  62     chomp;
  63     if (s/(?<!\\)\\$//) {
  64         # This is caught by uscan.
  65         last if eof(WATCH);
  66         $_ .= <WATCH>;
  67         goto CHOMP;
  68     }
  69
  70     if (/^version\s*=\s*(\d+)(\s|\Z)/) {
  71         if (defined $watchver) {
  72             tag 'debian-watch-file-declares-multiple-versions', "line $.";
  73         }
  74         $watchver = $1;
  75         if ($watchver ne '2' and $watchver ne '3') {
  76             tag 'debian-watch-file-unknown-version', $watchver;
  77         }
  78     } else {
  79         $nonempty = 1;
  80
  81         unless (defined($watchver)) {
  82             tag 'debian-watch-file-missing-version';
  83             $watchver = 1;
  84         }
  85         # Version 1 watch files are too broken to try checking them.
  86         next if ($watchver == 1);
  87
  88         my ($opts, @opts);
  89         if (s/^opt(?:ion)?s=\"([^\"]+)\"\s+// || s/^opt(?:ion)?s=(\S+)\s+//) {
  90             $opts = $1;
  91             @opts = split(',', $opts);
  92             if (defined $repack) {
  93                 for (@opts) {
  94                     $mangle = 1 if /^[ud]?versionmangle\s*=.*($repack)/;
  95                     $dmangle = 1 if /^dversionmangle\s*=.*($repack)/;
  96                 }
  97             }
  98         }
  99         if (m%qa\.debian\.org/watch/sf\.php\?%) {
 100             tag 'debian-watch-file-uses-deprecated-sf-redirector-method',
 101                 "line $.";
 102         }
 103
 104         if (m%(https?|ftp)://((.+\.)?dl|(pr)?downloads?|ftp\d?|upload)\.(sourceforge|sf)\.net%
 105             or m%https?://(www\.)?(sourceforge|sf)\.net/project/showfiles\.php%
 106             or m%https?://(www\.)?(sourceforge|sf)\.net/projects/.+/files%) {
 107             tag 'debian-watch-file-should-use-sf-redirector', "line $.";
 108         }
 109
 110         # This bit is as-is from uscan.pl:
 111         my ($base, $filepattern, $lastversion, $action) = split ' ', $_, 4;
 112         if ($base =~ s%/([^/]*\([^/]*\)[^/]*)$%/%) {
 113             # Last component of $base has a pair of parentheses, so no
 114             # separate filepattern field; we remove the filepattern from the
 115             # end of $base and rescan the rest of the line
 116             $filepattern = $1;
 117             (undef, $lastversion, $action) = split ' ', $_, 3;
 118         }
 119         push @{$dversions{$lastversion}}, $. if (defined($lastversion));
 120     }
 121 }
 122 close WATCH;
 123
 124 # If the version of the package contains dfsg, assume that it needs to be
 125 # mangled to get reasonable matches with upstream.
 126 if ($nonempty and $repack and not $mangle) {
 127     tag 'debian-watch-file-should-mangle-version';
 128 }
 129
 130 if ($repack and $mangle and not $dmangle) {
 131     tag 'debian-watch-file-should-dversionmangle-not-uversionmangle';
 132 }
 133
 134 my $changes = $info->changelog;
 135 if (defined $changes and %dversions) {
 136     my $data = $changes->data;
 137     my %changelog_versions;
 138     my $count = 1;
 139     for my $entry (@{$data}) {
 140         my $uversion = $entry->Version;
 141         $uversion =~ s/-[^-]+$//; # revision
 142         $uversion =~ s/^\d+://; # epoch
 143         $changelog_versions{'orig'}{$entry->Version} = $count;
 144
 145         # Preserve the first value here to correctly detect old versions.
 146         $changelog_versions{'mangled'}{$uversion} = $count
 147             unless (exists($changelog_versions{'mangled'}{$uversion}));
 148         $count++;
 149     }
 150
 151     while (my ($dversion, $lines) = each %dversions) {
 152         next if (!defined($dversion) || $dversion eq 'debian');
 153         local $" = ', ';
 154         if (!$info->native && exists($changelog_versions{'orig'}{$dversion})) {
 155             tag 'debian-watch-file-specifies-wrong-upstream-version',
 156                 "$dversion: @{$lines}";
 157             next;
 158         }
 159         if (exists($changelog_versions{'mangled'}{$dversion})
 160             && $changelog_versions{'mangled'}{$dversion} != 1) {
 161             tag 'debian-watch-file-specifies-old-upstream-version',
 162                 "$dversion: @{$lines}";
 163             next;
 164         }
 165     }
 166 }
 167
 168 }
 169
 170 1;
 171
 172 # Local Variables:
 173 # indent-tabs-mode: nil
 174 # cperl-indent-level: 4
 175 # End:
 176 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround