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

   1 # standards-version -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   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 Lintian::standards_version;
  22 use strict;
  23
  24 use Date::Parse qw(str2time);
  25 use POSIX qw(strftime);
  26 use Parse::DebianChangelog;
  27
  28 use Tags;
  29 use Util;
  30
  31 # This is a list of all known standards versions, current and older, with
  32 # their dates of publication.
  33 my @standards =
  34     ([ '3.8.0'  => '2008-06-04' ],
  35      [ '3.7.3'  => '2007-12-03' ],
  36      [ '3.7.2'  => '2006-05-03' ],
  37      [ '3.7.1'  => '2006-05-03' ],
  38      [ '3.7.0'  => '2006-04-26' ],
  39      [ '3.6.2'  => '2005-06-17' ],
  40      [ '3.6.1'  => '2003-08-19' ],
  41      [ '3.6.0'  => '2003-07-09' ],
  42      [ '3.5.10' => '2003-05-10' ],
  43      [ '3.5.9'  => '2003-03-07' ],
  44      [ '3.5.8'  => '2002-11-15' ],
  45      [ '3.5.7'  => '2002-08-31' ],
  46      [ '3.5.6'  => '2001-07-25' ],
  47      [ '3.5.5'  => '2001-06-01' ],
  48      [ '3.5.4'  => '2001-04-28' ],
  49      [ '3.5.3'  => '2001-04-15' ],
  50      [ '3.5.2'  => '2001-02-18' ],
  51      [ '3.5.1'  => '2001-02-15' ],
  52      [ '3.5.0'  => '2001-01-29' ],
  53      [ '3.2.1'  => '2000-08-24' ],
  54      [ '3.2.0'  => '2000-07-30' ],
  55      [ '3.1.1'  => '1999-11-16' ],
  56      [ '3.1.0'  => '1999-11-04' ],
  57      [ '3.0.1'  => '1999-07-15' ],
  58      [ '3.0.0'  => '1999-07-01' ],
  59      [ '2.5.1'  => '1999-04-27' ],
  60      [ '2.5.0'  => '1998-10-29' ],
  61      [ '2.4.1'  => '1998-04-14' ],
  62      [ '2.4.0'  => '1998-01-30' ],
  63      [ '2.3.0'  => '1997-09-01' ],
  64      [ '2.2.0'  => '1997-07-13' ],
  65      [ '2.1.3'  => '1997-03-15' ],
  66      [ '2.1.2'  => '1996-11-23' ],
  67      [ '2.1.1'  => '1996-09-12' ],
  68      [ '2.1.0'  => '1996-09-01' ],
  69      [ '2.0.1'  => '1996-08-31' ],
  70      [ '2.0.0'  => '1996-08-26' ],
  71      [ '0.2.1'  => '1996-08-23' ],
  72      [ '0.2.0'  => '1996-08-21' ]);
  73 my %standards = map { $$_[0] => $$_[1] } @standards;
  74 my $current = $standards[0][0];
  75 my @current = split (/\./, $current);
  76
  77 sub run {
  78
  79 my $pkg = shift;
  80 my $type = shift;
  81 my $info = shift;
  82
  83 # udebs aren't required to conform to policy, so they don't need
  84 # Standards-Version. (If they have it, though, it should be valid.)
  85 my $version = $info->field('standards-version');
  86 if (not defined $version) {
  87     tag 'no-standards-version-field' unless $type eq 'udeb';
  88     return 0;
  89 }
  90
  91 # Check basic syntax and strip off the fourth digit.  People are allowed to
  92 # include the fourth digit if they want, but it indicates a non-normative
  93 # change in Policy and is therefore meaningless in the Standards-Version
  94 # field.
  95 unless ($version =~ m/^\s*(\d+\.\d+\.\d+)(?:\.\d+)?\s*$/) {
  96     tag 'invalid-standards-version', $version;
  97     return 0;
  98 }
  99 my $stdver = $1;
 100 my ($major, $minor, $patch) = $stdver =~ m/^(\d+)\.(\d+)\.(\d+)/;
 101
 102 # To do some date checking, we have to get the package date from the changelog
 103 # file.  If we can't find the changelog file, assume that the package was
 104 # released today, since that activates the most tags.
 105 my $changes = $info->changelog;
 106 my $pkgdate;
 107 if (defined $changes) {
 108     my ($entry) = $changes->data;
 109     $pkgdate = $entry ? $entry->Timestamp : 0;
 110 } else {
 111     $pkgdate = time;
 112 }
 113
 114 # Check for packages dated prior to the date of release of the standards
 115 # version with which they claim to comply.
 116 if ($standards{$stdver} && str2time($standards{$stdver}, '+0000') > $pkgdate) {
 117     my $pretty = strftime ('%Y-%m-%d', gmtime $pkgdate);
 118     tag 'timewarp-standards-version', "($pretty < $standards{$stdver})";
 119 }
 120
 121 my $tag = "$version (current is $current)";
 122 if (not exists $standards{$stdver}) {
 123     # Unknown standards version.  Perhaps newer?
 124     if (   ($major > $current[0])
 125         or ($major == $current[0] and $minor > $current[1])
 126         or ($major == $current[0] and $minor == $current[1]
 127             and $patch > $current[2])) {
 128         tag 'newer-standards-version', $tag;
 129     } else {
 130         tag 'invalid-standards-version', $version;
 131     }
 132 } elsif ($stdver eq $current) {
 133     # Current standard.  Nothing more to check.
 134     return 0;
 135 } else {
 136     # Otherwise, we need to see if the standard that this package declares is
 137     # both new enough to not be ancient and was the current standard at the
 138     # time the package was uploaded.
 139     #
 140     # A given standards version is considered obsolete if the version
 141     # following it has been out for at least two years (so the current version
 142     # is never obsolete).
 143     my $obsdate = time;
 144     for my $index (0 .. $#standards) {
 145         if ($standards[$index][0] eq $stdver) {
 146             $obsdate = $standards[$index - 1][1] if $index > 0;
 147             last;
 148         }
 149     }
 150     if (str2time($obsdate, '+0000') + (60 * 60 * 24 * 365 * 2) < time) {
 151         tag 'ancient-standards-version', $tag;
 152     } else {
 153         # We have to get the package date from the changelog file.  If we
 154         # can't find the changelog file, always issue the tag.
 155         my $changes = $info->changelog;
 156         if (not defined $changes) {
 157             tag 'out-of-date-standards-version', $tag;
 158             return 0;
 159         }
 160         my ($entry) = $changes->data;
 161         my $timestamp = $entry ? $entry->Timestamp : 0;
 162         for my $standard (@standards) {
 163             last if $standard->[0] eq $stdver;
 164             if (str2time($standard->[1], '+0000') < $timestamp) {
 165                 tag 'out-of-date-standards-version', $tag;
 166                 last;
 167             }
 168         }
 169     }
 170 }
 171
 172 }
 173
 174 1;
 175
 176 # Local Variables:
 177 # indent-tabs-mode: nil
 178 # cperl-indent-level: 4
 179 # End:
 180 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround