#!/usr/bin/perl
# copyright-file -- lintian check script

# Copyright (C) 1998 by Christian Schwarz
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

($#ARGV == 1) or fail("syntax: copyright-file <pkg> <type>");
$pkg = shift;
$type = shift;

$ppkg = quotemeta($pkg);

# Read package contents...
open(IN,"index") or fail("cannot open index file index: $!");
while (<IN>) {
  chop;
  if (m, usr/doc/$ppkg/copyright(\.\S+)?(\s+\-\>\s+.*)?$,o) {
    my ($ext,$link) = ($1,$2);
    
    next unless ($ext eq '') or ($ext eq '.gz');
    $found = 1;
    
    if ($ext eq '.gz') {
      print "E: $pkg $type: copyright-file-compressed\n";
      last;
    }
    
    if ($link) {
      print "E: $pkg $type: copyright-file-is-symlink\n";
      last;
    }
    
    if (($ext eq '') and not $link) {
      # everything is ok.
      last;
    }
    
    fail("unhandled case: $_");
    
  } elsif (m, usr/doc/$ppkg \-\>\s+(\S+),o) {
    my ($link) = ($1);
    
    $found = 1;
    
    # check if this symlink references a directory elsewhere
    if ($link =~ m,/,) {
      print "E: $pkg $type: usr-doc-symlink-points-outside-of-usr-doc $link\n";
      last;
    }

    # this case is allowed, if this package depends on link
    # and both packages come from the same source package
    
    # depend on $link pkg?
    if (not depends_on($link)) {
      # no, it does not.
      print "E: $pkg $type: usr-doc-symlink-without-dependency $link\n";
      last;
    }

    # We can only check if both packages come from the same source
    # if our source package is currently unpacked in the lab, too!
    if (-d "source") {
      # yes, it's unpacked

      # $link from the same source pkg?
      if (-l "source/binary/$link") {
	# yes, everything is ok.
      } else {
	# no, it is not.
	print "E: $pkg $type: usr-doc-symlink-to-foreign-package\n";
      }
    } else {
      # no, source is not available
      print "I: $pkg $type: cannot-check-whether-usr-doc-symlink-points-to-foreign-package\n";
    }

    
    # everything is ok.
    last;
  } elsif (m, usr/doc/copyright/$ppkg$,o) {
    print "E: $pkg $type: old-style-copyright-file\n";
    $found = 1;
    last;
  }
}
close(IN);

if (not $found) {
  print "E: $pkg $type: no-copyright-file\n";
}

# check contents of copyright file
open(IN,"copyright") or fail("cannot open copyright file copyright: $!");
# gulp whole file
undef $/;  $_ = <IN>;
close(IN);

if (/\<fill in ftp site\>/ or /\<Must follow here\>/) {
  print "E: $pkg $type: debmake-templates-in-copyright\n";
}
  
if (m,usr/doc/copyright/(GPL|LGPL|BSD|Artistic)\.gz,) {
  print "E: $pkg $type: copyright-refers-to-compressed-license $&\n";
}
  
if (/02139/) {
  print "E: $pkg $type: old-fsf-address-in-copyright-file\n";
}

if (length($_) > 12000 and 
    /\bGNU GENERAL PUBLIC LICENSE\s*TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION\b/m and /\bVersion 2\b/) {
  print "E: $pkg $type: copyright-file-is-gpl\n";
}

exit 0;

# -----------------------------------

# returns true, if $foo depends on $bar
sub depends_on {
  my ($bar) = @_;
  
  my ($deps, $predeps);

  my $f = "fields/depends";
  if (-f $f) {
    open(I,$f) or die "cannot open depends file $f: $!";
    chop($deps = <I>);
    close(I);
  }

  $f = "fields/pre-depends";
  if (-f $f) {
    open(I,$f) or die "cannot open pre-depends file $f: $!";
    chop($predeps = <I>);
    close(I);
  }

  for (split(/\s*(?:,|\|)\s*/o,"$deps,$predeps")) {
    /^(\S+)/o or next;
    return 1 if $1 eq $bar;
  }
  
  return 0;
}

sub fail {
  if ($_[0]) {
    print STDERR "error: $_[0]\n";
  } elsif ($!) {
    print STDERR "error: $!\n";
  } else {
    print STDERR "error.\n";
  }
  exit 1;
}
