vcs.maemo.org Git - maemian/blob - checks/standards-version

   1 # standards-version -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   4 # Copyright (C) 2008-2009 Russ Allbery
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, you can find it on the World Wide
  18 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  19 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  20 # MA 02110-1301, USA.
  21
  22 package Maemian::standards_version;
  23 use strict;
  24
  25 use POSIX qw(strftime);
  26
  27 use Maemian::Data;
  28 use Tags;
  29 use Util;
  30
  31 our $STANDARDS = Maemian::Data->new('standards-version/release-dates', '\s+');
  32
  33 # In addition to the normal Maemian::Data structure, we also want a list of
  34 # all standards and their release dates so that we can check things like the
  35 # release date of the standard released after the one a package declared.  Do
  36 # that by pulling all data out of the Maemian::Data structure and sorting it
  37 # by release date.  We can also use this to get the current standards version.
  38 our @STANDARDS = sort { $b->[1] <=> $a->[1] }
  39     map { [ $_, $STANDARDS->value($_) ] } $STANDARDS->all;
  40 our $CURRENT   = $STANDARDS[0][0];
  41 our @CURRENT   = split(/\./, $CURRENT);
  42
  43 sub run {
  44
  45 my $pkg = shift;
  46 my $type = shift;
  47 my $info = shift;
  48
  49 # udebs aren't required to conform to policy, so they don't need
  50 # Standards-Version. (If they have it, though, it should be valid.)
  51 my $version = $info->field('standards-version');
  52 my $pkgs = $info->binaries;
  53 my $all_udeb = 1;
  54 foreach my $bin_type (values %$pkgs) {
  55     if ($bin_type ne 'udeb') {
  56         $all_udeb = 0;
  57         last;
  58     }
  59 }
  60 if (not defined $version) {
  61     tag 'no-standards-version-field' unless $all_udeb;
  62     return 0;
  63 }
  64
  65 # Check basic syntax and strip off the fourth digit.  People are allowed to
  66 # include the fourth digit if they want, but it indicates a non-normative
  67 # change in Policy and is therefore meaningless in the Standards-Version
  68 # field.
  69 unless ($version =~ m/^\s*(\d+\.\d+\.\d+)(?:\.\d+)?\s*$/) {
  70     tag 'invalid-standards-version', $version;
  71     return 0;
  72 }
  73 my $stdver = $1;
  74 my ($major, $minor, $patch) = $stdver =~ m/^(\d+)\.(\d+)\.(\d+)/;
  75
  76 # To do some date checking, we have to get the package date from the changelog
  77 # file.  If we can't find the changelog file, assume that the package was
  78 # released today, since that activates the most tags.
  79 my $changes = $info->changelog;
  80 my $pkgdate;
  81 if (defined $changes) {
  82     my ($entry) = $changes->data;
  83     $pkgdate = ($entry && $entry->Timestamp) ? $entry->Timestamp : time;
  84 } else {
  85     $pkgdate = time;
  86 }
  87
  88 # Check for packages dated prior to the date of release of the standards
  89 # version with which they claim to comply.
  90 if ($STANDARDS->known($stdver) && $STANDARDS->value($stdver) > $pkgdate) {
  91     my $package = strftime('%Y-%m-%d', gmtime $pkgdate);
  92     my $release = strftime('%Y-%m-%d', gmtime $STANDARDS->value($stdver));
  93     tag 'timewarp-standards-version', "($package < $release)";
  94 }
  95
  96 my $tag = "$version (current is $CURRENT)";
  97 if (not $STANDARDS->known($stdver)) {
  98     # Unknown standards version.  Perhaps newer?
  99     if (   ($major > $CURRENT[0])
 100         or ($major == $CURRENT[0] and $minor > $CURRENT[1])
 101         or ($major == $CURRENT[0] and $minor == $CURRENT[1]
 102             and $patch > $CURRENT[2])) {
 103         tag 'newer-standards-version', $tag;
 104     } else {
 105         tag 'invalid-standards-version', $version;
 106     }
 107 } elsif ($stdver eq $CURRENT) {
 108     # Current standard.  Nothing more to check.
 109     return 0;
 110 } else {
 111     # Otherwise, we need to see if the standard that this package declares is
 112     # both new enough to not be ancient and was the current standard at the
 113     # time the package was uploaded.
 114     #
 115     # A given standards version is considered obsolete if the version
 116     # following it has been out for at least two years (so the current version
 117     # is never obsolete).
 118     my $obsdate = time;
 119     for my $index (0 .. $#STANDARDS) {
 120         if ($STANDARDS[$index][0] eq $stdver) {
 121             $obsdate = $STANDARDS[$index - 1][1] if $index > 0;
 122             last;
 123         }
 124     }
 125     if ($obsdate + (60 * 60 * 24 * 365 * 2) < time) {
 126         tag 'ancient-standards-version', $tag;
 127     } else {
 128         # We have to get the package date from the changelog file.  If we
 129         # can't find the changelog file, always issue the tag.
 130         my $changes = $info->changelog;
 131         if (not defined $changes) {
 132             tag 'out-of-date-standards-version', $tag;
 133             return 0;
 134         }
 135         my ($entry) = $changes->data;
 136         my $timestamp = ($entry && $entry->Timestamp) ? $entry->Timestamp : 0;
 137         for my $standard (@STANDARDS) {
 138             last if $standard->[0] eq $stdver;
 139             if ($standard->[1] < $timestamp) {
 140                 tag 'out-of-date-standards-version', $tag;
 141                 last;
 142             }
 143         }
 144     }
 145 }
 146
 147 }
 148
 149 1;
 150
 151 # Local Variables:
 152 # indent-tabs-mode: nil
 153 # cperl-indent-level: 4
 154 # End:
 155 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround