vcs.maemo.org Git - maemian/blob - nokia-lintian/checks/copyright-file

   1 # copyright-file -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz
   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::copyright_file;
  22 use strict;
  23 use Dep;
  24 use Spelling;
  25 use Tags;
  26 use Util;
  27
  28 use Encode qw(decode);
  29
  30 sub run {
  31
  32 my $pkg = shift;
  33 my $type = shift;
  34
  35 my $ppkg = quotemeta($pkg);
  36
  37 my $found = 0;
  38 my $linked = 0;
  39
  40 use lib "$ENV{'LINTIAN_ROOT'}/checks/";
  41 use common_data;
  42
  43 # Read package contents...
  44 open(IN, '<', "index") or fail("cannot open index file index: $!");
  45 while (<IN>) {
  46     chop;
  47     if (m,usr/(share/)?doc/$ppkg/copyright(\.\S+)?(\s+\-\>\s+.*)?$,) {
  48         my ($ext,$link) = ($2,$3);
  49
  50         $ext = '' if (! defined $ext);
  51         #an extension other than .gz doesn't count as copyright file
  52         next unless ($ext eq '') or ($ext eq '.gz');
  53         $found = 1;
  54
  55         #search for an extension
  56         if ($ext eq '.gz') {
  57             tag "copyright-file-compressed", "";
  58             last;
  59         }
  60
  61         #make sure copyright is not a symlink
  62         if ($link) {
  63             tag "copyright-file-is-symlink", "";
  64             last;
  65         }
  66
  67         #otherwise, pass
  68         if (($ext eq '') and not $link) {
  69             # everything is ok.
  70             last;
  71         }
  72         fail("unhandled case: $_");
  73
  74     } elsif (m,usr/share/doc/$ppkg \-\>\s+(\S+),) {
  75         my ($link) = ($1);
  76
  77         $found = 1;
  78         $linked = 1;
  79
  80         # check if this symlink references a directory elsewhere
  81         if ($link =~ m,^(\.\.)?/,) {
  82             tag "usr-share-doc-symlink-points-outside-of-usr-share-doc", "$link";
  83             last;
  84         }
  85
  86         # link might point to a subdirectory of another /usr/share/doc
  87         # directory
  88         $link =~ s,/.*,,;
  89
  90         # this case is allowed, if this package depends on link
  91         # and both packages come from the same source package
  92
  93         if (not open (VERSION, '<', "fields/version")) {
  94             fail("Can't open fields/version: $!");
  95         } else {
  96             chomp(my $our_version = <VERSION>);
  97             close VERSION;
  98
  99             # depend on $link pkg?
 100             if ((not depends_on($link, $our_version)) &&
 101                  not (exists($known_essential{$link}) &&
 102                  defined($known_essential{$link}))) {
 103                 # no, it does not.
 104
 105                 tag "usr-share-doc-symlink-without-dependency", "$link";
 106                 last;
 107             }
 108         }
 109
 110         # We can only check if both packages come from the same source
 111         # if our source package is currently unpacked in the lab, too!
 112         if (-d "source") {      # yes, it's unpacked
 113
 114             # $link from the same source pkg?
 115             if (-l "source/binary/$link") {
 116                 # yes, everything is ok.
 117             } else {
 118                 # no, it is not.
 119                 tag "usr-share-doc-symlink-to-foreign-package", "$link";
 120             }
 121         } else {                # no, source is not available
 122             tag "cannot-check-whether-usr-share-doc-symlink-points-to-foreign-package", "";
 123         }
 124
 125         # everything is ok.
 126         last;
 127     } elsif (m,usr/doc/copyright/$ppkg$,) {
 128         tag "old-style-copyright-file", "";
 129         $found = 1;
 130         last;
 131     }
 132 }
 133 close(IN);
 134
 135 if (not $found) {
 136     tag "no-copyright-file", "";
 137 }
 138
 139 # check that copyright is UTF-8 encoded
 140 my $line = file_is_encoded_in_non_utf8("copyright", $type, $pkg);
 141 if ($line) {
 142     tag "debian-copyright-file-uses-obsolete-national-encoding", "at line $line"
 143 }
 144
 145 # check contents of copyright file
 146 open(IN, '<', "copyright") or fail("cannot open copyright file copyright: $!");
 147 # gulp whole file
 148 local $/ = undef;
 149 $_ = <IN>;
 150 close(IN);
 151
 152 # We have to decode into UTF-8 to get the right length for the length
 153 # check.  For some reason, use open ':utf8' isn't sufficient.  If the
 154 # file uses a non-UTF-8 encoding, this will mangle it, but it doesn't
 155 # matter for the length check.
 156 my @lines = split ("\n", decode ('utf-8', $_));
 157 for my $i (0 .. $#lines) {
 158     if (length ($lines[$i]) > 80) {
 159         tag "debian-copyright-line-too-long", "line " . ($i+1);
 160     }
 161 }
 162
 163 my $wrong_directory_detected = 0;
 164
 165 if (m,\<fill in (http/)?ftp site\>, or m/\<Must follow here\>/) {
 166     tag "helper-templates-in-copyright", "";
 167 }
 168
 169 if (m,usr/share/common-licenses/(GPL|LGPL|BSD|Artistic)\.gz,) {
 170     tag "copyright-refers-to-compressed-license", "$&";
 171 }
 172
 173 if (m,usr/share/common-licences,) {
 174     tag "copyright-refers-to-incorrect-directory", "$&";
 175     $wrong_directory_detected = 1;
 176 }
 177
 178 if (m,usr/share/doc/copyright,) {
 179     tag "copyright-refers-to-old-directory", "";
 180     $wrong_directory_detected = 1;
 181 }
 182
 183 if (m,usr/doc/copyright,) {
 184     tag "copyright-refers-to-old-directory", "";
 185     $wrong_directory_detected = 1;
 186 }
 187
 188 # Lame check for old FSF zip code.  Try to avoid false positives from other
 189 # Cambridge, MA addresses.
 190 if (m/(Free\s*Software\s*Foundation.*02139|02111-1307)/s) {
 191     tag "old-fsf-address-in-copyright-file", "";
 192 }
 193
 194 # Whether the package is covered by the GPL, used later for the libssl check.
 195 my $gpl;
 196
 197 if (length($_) > 12000
 198     and ((m/\bGNU GENERAL PUBLIC LICENSE\s*TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION\b/m
 199           and m/\bVersion 2\s/)
 200          or (m/\bGNU GENERAL PUBLIC LICENSE\s*Version 3/ and m/\bTERMS AND CONDITIONS\s/))) {
 201     tag "copyright-file-contains-full-gpl-license";
 202     $gpl = 1;
 203 }
 204
 205 if (length($_) > 12000
 206     and m/\bGNU Free Documentation License\s*Version 1\.2/ and m/\b1\. APPLICABILITY AND DEFINITIONS/) {
 207     tag "copyright-file-contains-full-gfdl-license";
 208 }
 209
 210 if (length($_) > 10000
 211     and m/\bApache License\s+Version 2\.0,/
 212     and m/TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION/) {
 213     tag "copyright-file-contains-full-apache-2-license";
 214 }
 215
 216 if (m/^This copyright info was automatically extracted from the perl module\./) {
 217     tag "helper-templates-in-copyright", "";
 218 }
 219
 220 if (m,(under )?(the )?(same )?(terms )?as Perl itself,i &&
 221     !m,usr/share/common-licenses/,) {
 222     tag "copyright-file-lacks-pointer-to-perl-license", "";
 223 }
 224
 225 # wtf?
 226 if ((m,common-licenses(/\S+),) && (! m,/usr/share/common-licenses/,)) {
 227     tag "copyright-does-not-refer-to-common-license-file", "$1";
 228 }
 229
 230 # This check is a bit prone to false positives, since some other licenses
 231 # mention the GPL.  Also exclude any mention of the GPL following what looks
 232 # like mail headers, since sometimes e-mail discussions of licensing are
 233 # included in the copyright file but aren't referring to the license of the
 234 # package.
 235 if (m,/usr/share/common-licenses,
 236     || m/Zope Public License/
 237     || m/LICENSE AGREEMENT FOR PYTHON 1.6.1/
 238     || m/LaTeX Project Public License/
 239     || m/(^From:.*^To:|^To:.*^From:).*(GNU General Public License|GPL)/ms
 240     || m/AFFERO GENERAL PUBLIC LICENSE/
 241     || m/GNU Free Documentation License\s*Version 1\.1/
 242     || m/CeCILL FREE SOFTWARE LICENSE AGREEMENT/
 243     || m/CNRI OPEN SOURCE GPL-COMPATIBLE LICENSE AGREEMENT/
 244     || $wrong_directory_detected) {
 245     # False positive or correct reference.  Ignore.
 246 } elsif (m/GNU Free Documentation License/i or m/\bGFDL\b/) {
 247     tag "copyright-should-refer-to-common-license-file-for-gfdl";
 248 } elsif (m/GNU (Lesser|Library) General Public License/i or m/\bLGPL\b/) {
 249     tag "copyright-should-refer-to-common-license-file-for-lgpl";
 250 } elsif (m/GNU General Public License/i or m/\bGPL\b/) {
 251     tag "copyright-should-refer-to-common-license-file-for-gpl";
 252     $gpl = 1;
 253 }
 254
 255 if (m,Upstream Author\(s\),) {
 256     tag "copyright-lists-upstream-authors-with-dh_make-boilerplate";
 257 }
 258
 259 if (m,url://example\.com,) {
 260     tag "copyright-has-url-from-dh_make-boilerplate";
 261 }
 262
 263 if (m{\# Please also look if there are files or directories which have a\n\# different copyright/license attached and list them here\.}) {
 264     tag "copyright-contains-dh_make-todo-boilerplate", "";
 265 }
 266 if (m{This copyright info was automatically extracted from the perl module\.\nIt may not be accurate, so you better check the module sources\nif you don\'t want to get into legal troubles\.}) {
 267     tag "copyright-contains-dh-make-perl-boilerplate", "";
 268 }
 269
 270 if ($found && !$linked && !/(Copyright|Copr\.|\302\251)(.*|[\(C\):\s]+)\b\d{4}\b|\bpublic\s+domain\b/i) {
 271     tag 'copyright-without-copyright-notice';
 272 }
 273
 274 spelling_check('spelling-error-in-copyright', $_);
 275
 276 # Now, check for linking against libssl if the package is covered by the GPL.
 277 # (This check was requested by ftp-master.)  First, see if the package is
 278 # under the GPL alone and try to exclude packages with a mix of GPL and LGPL
 279 # or Artistic licensing or with an exception or exemption.
 280 if ($gpl || m,/usr/share/common-licenses/GPL,) {
 281     unless (m,exception|exemption|/usr/share/common-licenses/(?!GPL)\S,) {
 282         my @depends;
 283         if (open(DEP, '<', 'fields/depends')) {
 284             @depends = split (/\s*,\s*/, scalar <DEP>);
 285         }
 286         if (open(DEP, '<', 'fields/pre-depends')) {
 287             push @depends, split (/\s*,\s*/, scalar <DEP>);
 288         }
 289         close DEP;
 290         if (grep { /^libssl[0-9.]+(\s|\z)/ && !/\|/ } @depends) {
 291             tag 'possible-gpl-code-linked-with-openssl';
 292         }
 293     }
 294 }
 295
 296 } # </run>
 297
 298 # -----------------------------------
 299
 300 # returns true, if $foo depends on $bar
 301 sub depends_on {
 302     my ($package, $version) = @_;
 303
 304     my ($deps, $predeps) = ("", "");
 305
 306     my $f = "fields/depends";
 307     if (-f $f) {
 308         open(I, '<', $f) or die "cannot open depends file $f: $!";
 309         chop($deps = <I>);
 310         close(I);
 311     }
 312
 313     $f = "fields/pre-depends";
 314     if (-f $f) {
 315         open(I, '<', $f) or die "cannot open pre-depends file $f: $!";
 316         chop($predeps = <I>);
 317         close(I);
 318     }
 319
 320     return 1 if Dep::implies(Dep::parse($deps), Dep::parse($package));
 321     return 1 if Dep::implies(Dep::parse($predeps), Dep::parse($package));
 322
 323     return 0;
 324 }
 325
 326 1;
 327
 328 # Local Variables:
 329 # indent-tabs-mode: t
 330 # cperl-indent-level: 4
 331 # End:
 332 # vim: syntax=perl ts=8 sw=4