vcs.maemo.org Git - maemian/blob - 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 Maemian::copyright_file;
  22 use strict;
  23
  24 use lib "$ENV{'MAEMIAN_ROOT'}/checks/";
  25 use common_data;
  26
  27 use Spelling;
  28 use Tags;
  29 use Util;
  30
  31 use Encode qw(decode);
  32
  33 sub run {
  34
  35 my $pkg = shift;
  36 my $type = shift;
  37 my $info = shift;
  38
  39 my $ppkg = quotemeta($pkg);
  40
  41 my $found = 0;
  42 my $linked = 0;
  43
  44 # Read package contents...
  45 foreach (sort keys %{$info->index}) {
  46     my $index_info = $info->index->{$_};
  47     if (m,usr/(share/)?doc/$ppkg/copyright(\.\S+)?$,) {
  48         my $ext = $2;
  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 ($index_info->{link}) {
  63             tag "copyright-file-is-symlink", "";
  64             last;
  65         }
  66
  67         #otherwise, pass
  68         if (($ext eq '') and not $index_info->{link}) {
  69             # everything is ok.
  70             last;
  71         }
  72         fail("unhandled case: $_");
  73
  74     } elsif (m,usr/share/doc/$ppkg$, and $index_info->{link}) {
  75         my $link = $index_info->{link};
  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         # The symlink may point to a subdirectory of another /usr/share/doc
  87         # directory.  This is allowed if this package depends on link and both
  88         # packages come from the same source package.
  89         #
  90         # Policy requires that packages be built from the same source if
  91         # they're going to do this, which by my (rra's) reading means that we
  92         # should have a strict version dependency.  However, in practice the
  93         # copyright file doesn't change a lot and strict version dependencies
  94         # cause other problems (such as with arch: any / arch: all package
  95         # combinations and binNMUs).
  96         #
  97         # We therefore just require the dependency for now and don't worry
  98         # about the version number.
  99         $link =~ s,/.*,,;
 100         if (not depends_on($info, $link)) {
 101             tag 'usr-share-doc-symlink-without-dependency', $link;
 102             last;
 103         }
 104
 105         # We can only check if both packages come from the same source
 106         # if our source package is currently unpacked in the lab, too!
 107         if (-d "source") {      # yes, it's unpacked
 108
 109             # $link from the same source pkg?
 110             if (-l "source/binary/$link") {
 111                 # yes, everything is ok.
 112             } else {
 113                 # no, it is not.
 114                 tag "usr-share-doc-symlink-to-foreign-package", "$link";
 115             }
 116         } else {                # no, source is not available
 117             tag "cannot-check-whether-usr-share-doc-symlink-points-to-foreign-package", "";
 118         }
 119
 120         # everything is ok.
 121         last;
 122     } elsif (m,usr/doc/copyright/$ppkg$,) {
 123         tag "old-style-copyright-file", "";
 124         $found = 1;
 125         last;
 126     }
 127 }
 128
 129 if (not $found) {
 130     tag "no-copyright-file", "";
 131 }
 132
 133 # check that copyright is UTF-8 encoded
 134 my $line = file_is_encoded_in_non_utf8("copyright", $type, $pkg);
 135 if ($line) {
 136     tag "debian-copyright-file-uses-obsolete-national-encoding", "at line $line"
 137 }
 138
 139 # check contents of copyright file
 140 $_ = slurp_entire_file('copyright');
 141
 142 my $wrong_directory_detected = 0;
 143
 144 if (m,\<fill in (?:http/)?ftp site\>, or m/\<Must follow here\>/) {
 145     tag "helper-templates-in-copyright", "";
 146 }
 147
 148 if (m,(usr/share/common-licenses/(?:GPL|LGPL|BSD|Artistic)\.gz),) {
 149     tag "copyright-refers-to-compressed-license", $1;
 150 }
 151
 152 # Allow generic GPL references for packages licensed under the same terms as
 153 # Perl for now.  Perl references GPL version 1, which isn't in
 154 # common-licenses.
 155 #
 156 # Avoid complaining about referring to a versionless license file if the word
 157 # "version" appears nowhere in the copyright file.  This won't catch all of
 158 # our false positives for GPL references that don't include a specific version
 159 # number, but it will get the obvious ones.
 160 if (m,(usr/share/common-licenses/(L?GPL|GFDL))([^-]),i && !m,as Perl itself,i
 161     && !m,License-Alias:\s+Perl,) {
 162     my ($ref, $license, $separator) = ($1, $2, $3);
 163     if ($separator =~ /[\d\w]/) {
 164         tag 'copyright-refers-to-nonexistent-license-file', "$ref$separator";
 165     } elsif (m,\b(?:any|or)\s+later(?:\s+version)?\b,i
 166              || m,License: $license-[\d\.]+\+,i) {
 167         tag "copyright-refers-to-symlink-license", $ref;
 168     } else {
 169         tag "copyright-refers-to-versionless-license-file", $ref
 170             if /\bversion\b/;
 171     }
 172 }
 173
 174 if (m,(usr/share/common-licences),) {
 175     tag "copyright-refers-to-incorrect-directory", $1;
 176     $wrong_directory_detected = 1;
 177 }
 178
 179 if (m,usr/share/doc/copyright,) {
 180     tag "copyright-refers-to-old-directory", "";
 181     $wrong_directory_detected = 1;
 182 }
 183
 184 if (m,usr/doc/copyright,) {
 185     tag "copyright-refers-to-old-directory", "";
 186     $wrong_directory_detected = 1;
 187 }
 188
 189 # Lame check for old FSF zip code.  Try to avoid false positives from other
 190 # Cambridge, MA addresses.
 191 if (m/(?:Free\s*Software\s*Foundation.*02139|02111-1307)/s) {
 192     tag "old-fsf-address-in-copyright-file", "";
 193 }
 194
 195 # Whether the package is covered by the GPL, used later for the libssl check.
 196 my $gpl;
 197
 198 if (length($_) > 12000
 199     and ((m/\bGNU GENERAL PUBLIC LICENSE\s*TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION\b/m
 200           and m/\bVersion 2\s/)
 201          or (m/\bGNU GENERAL PUBLIC LICENSE\s*Version 3/ and m/\bTERMS AND CONDITIONS\s/))) {
 202     tag "copyright-file-contains-full-gpl-license";
 203     $gpl = 1;
 204 }
 205
 206 if (length($_) > 12000
 207     and m/\bGNU Free Documentation License\s*Version 1\.2/ and m/\b1\. APPLICABILITY AND DEFINITIONS/) {
 208     tag "copyright-file-contains-full-gfdl-license";
 209 }
 210
 211 if (length($_) > 10000
 212     and m/\bApache License\s+Version 2\.0,/
 213     and m/TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION/) {
 214     tag "copyright-file-contains-full-apache-2-license";
 215 }
 216
 217 # wtf?
 218 if ((m,common-licenses(/\S+),) && (! m,/usr/share/common-licenses/,)) {
 219     tag "copyright-does-not-refer-to-common-license-file", "$1";
 220 }
 221
 222 # This check is a bit prone to false positives, since some other licenses
 223 # mention the GPL.  Also exclude any mention of the GPL following what looks
 224 # like mail headers, since sometimes e-mail discussions of licensing are
 225 # included in the copyright file but aren't referring to the license of the
 226 # package.
 227 if (m,/usr/share/common-licenses,
 228     || m/Zope Public License/
 229     || m/LICENSE AGREEMENT FOR PYTHON 1.6.1/
 230     || m/LaTeX Project Public License/
 231     || m/(?:^From:.*^To:|^To:.*^From:).*(?:GNU General Public License|GPL)/ms
 232     || m/AFFERO GENERAL PUBLIC LICENSE/
 233     || m/GNU Free Documentation License[,\s]*Version 1\.1/
 234     || m/CeCILL FREE SOFTWARE LICENSE AGREEMENT/ #v2.0
 235     || m/FREE SOFTWARE LICENSING AGREEMENT CeCILL/ #v1.1
 236     || m/CNRI OPEN SOURCE GPL-COMPATIBLE LICENSE AGREEMENT/
 237     || m/GNU GENERAL PUBLIC LICENSE\s+Version 1/
 238     || m/compatible\s+with\s+(?:the\s+)?(?:GNU\s+)?GPL/
 239     || m/(?:GNU\s+)?GPL\W+compatible/
 240     || m/was\s+previously\s+(?:distributed\s+)?under\s+the\s+GNU/
 241     || $wrong_directory_detected) {
 242     # False positive or correct reference.  Ignore.
 243 } elsif (m/GNU Free Documentation License/i or m/\bGFDL\b/) {
 244     tag "copyright-should-refer-to-common-license-file-for-gfdl";
 245 } elsif (m/GNU (?:Lesser|Library) General Public License/i or m/\bLGPL\b/) {
 246     tag "copyright-should-refer-to-common-license-file-for-lgpl";
 247 } elsif (m/GNU General Public License/i or m/\bGPL\b/) {
 248     tag "copyright-should-refer-to-common-license-file-for-gpl";
 249     $gpl = 1;
 250 }
 251 if (m,(?:under )?(?:the )?(?:same )?(?:terms )?as Perl itself,i &&
 252     !m,usr/share/common-licenses/,) {
 253     tag "copyright-file-lacks-pointer-to-perl-license";
 254 }
 255
 256 # Checks for various packaging helper boilerplate.
 257
 258 if (m/^This copyright info was automatically extracted from the perl module\./) {
 259     tag "helper-templates-in-copyright", "";
 260 }
 261
 262 if (m,Upstream Author\(s\),) {
 263     tag "copyright-lists-upstream-authors-with-dh_make-boilerplate";
 264 }
 265
 266 if (m,url://example\.com,) {
 267     tag "copyright-has-url-from-dh_make-boilerplate";
 268 }
 269
 270 if (m{\# Please also look if there are files or directories which have a\n\# different copyright/license attached and list them here\.}) {
 271     tag "copyright-contains-dh_make-todo-boilerplate", "";
 272 }
 273 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\.}) {
 274     tag "copyright-contains-dh-make-perl-boilerplate", "";
 275 }
 276
 277 if (m,The\s+Debian\s+packaging\s+is\s+\(C\)\s+\d+,i) {
 278     tag 'copyright-with-old-dh-make-debian-copyright';
 279 }
 280
 281 # Bad licenses.
 282 if (m/(The\s+PHP\s+Licen[cs]e,?\s+version\s+2)/si) {
 283     tag 'copyright-refers-to-bad-php-license';
 284 }
 285 if (m/(The\s+PHP\s+Licen[cs]e,?\s+version\s+3\.0[^\d])/si) {
 286     tag 'copyright-refers-to-problematic-php-license';
 287 }
 288
 289 # Other flaws in the copyright phrasing or contents.
 290
 291 if ($found && !$linked && !/(?:Copyright|Copr\.|\302\251)(?:.*|[\(C\):\s]+)\b\d{4}\b|\bpublic\s+domain\b/i) {
 292     tag 'copyright-without-copyright-notice';
 293 }
 294
 295 spelling_check('spelling-error-in-copyright', $_);
 296
 297 # Now, check for linking against libssl if the package is covered by the GPL.
 298 # (This check was requested by ftp-master.)  First, see if the package is
 299 # under the GPL alone and try to exclude packages with a mix of GPL and LGPL
 300 # or Artistic licensing or with an exception or exemption.
 301 if ($gpl || m,/usr/share/common-licenses/GPL,) {
 302     unless (m,exception|exemption|/usr/share/common-licenses/(?!GPL)\S,) {
 303         my @depends;
 304         if (defined $info->field('depends')) {
 305             @depends = split (/\s*,\s*/, scalar $info->field('depends'));
 306         }
 307         if (defined $info->field('pre-depends')) {
 308             push @depends, split (/\s*,\s*/, scalar $info->field('pre-depends'));
 309         }
 310         if (grep { /^libssl[0-9.]+(?:\s|\z)/ && !/\|/ } @depends) {
 311             tag 'possible-gpl-code-linked-with-openssl';
 312         }
 313     }
 314 }
 315
 316 } # </run>
 317
 318 # -----------------------------------
 319
 320 # Returns true if the package whose information is in $info depends $package
 321 # or if $package is essential.
 322 sub depends_on {
 323     my ($info, $package) = @_;
 324     return 1 if $known_essential{$package};
 325     return 1 if $info->relation('strong')->implies($package);
 326     return 0;
 327 }
 328
 329 1;
 330
 331 # Local Variables:
 332 # indent-tabs-mode: t
 333 # cperl-indent-level: 4
 334 # End:
 335 # vim: syntax=perl ts=8 sw=4