X-Git-Url: https://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Fcollection%2Fchangelog-file;fp=nokia-lintian%2Fcollection%2Fchangelog-file;h=71ff88eff0d002b85920c1e4ef40ab1121c2f5af;hb=1975b83207a518d59ef6b04c7c16233cb353ca86;hp=0000000000000000000000000000000000000000;hpb=208f636c44e0ec2b53c70aaed2399d8e9cf0e741;p=maemian diff --git a/nokia-lintian/collection/changelog-file b/nokia-lintian/collection/changelog-file new file mode 100755 index 0000000..71ff88e --- /dev/null +++ b/nokia-lintian/collection/changelog-file @@ -0,0 +1,129 @@ +#!/usr/bin/perl -w +# changelog-file -- lintian collector script + +# Copyright (C) 1998 Richard Braakman +# +# 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., 51 Franklin St, Fifth Floor, Boston, +# MA 02110-1301, USA. + +use strict; + +($#ARGV == 1) or fail("syntax: changelog-file "); +my $pkg = shift; +my $type = shift; + +-f "fields/package" or fail("changelog-file invoked in wrong directory"); + +unlink("changelog"); + +# Pick the first of these files that exists. +my @changelogs = ("unpacked/usr/share/doc/$pkg/changelog.Debian.gz", + "unpacked/usr/share/doc/$pkg/changelog.Debian", + "unpacked/usr/share/doc/$pkg/changelog.debian.gz", + "unpacked/usr/share/doc/$pkg/changelog.debian", + "unpacked/usr/share/doc/$pkg/changelog.gz", + "unpacked/usr/share/doc/$pkg/changelog", + "unpacked/usr/doc/$pkg/changelog.Debian.gz", + "unpacked/usr/doc/$pkg/changelog.Debian", + "unpacked/usr/doc/$pkg/changelog.debian.gz", + "unpacked/usr/doc/$pkg/changelog.debian", + "unpacked/usr/doc/$pkg/changelog.gz", + "unpacked/usr/doc/$pkg/changelog"); + +my $chl; + +for (@changelogs) { + if (-l $_ || -f $_) { + $chl = $_; + last; + } +} + +# If the changelog file we found was a symlink, we have to be careful. It +# could be a symlink to some file outside of the laboratory and we don't want +# to end up reading that file by mistake. Relative links within the same +# directory or to a subdirectory we accept; anything else is replaced by an +# intentinally broken symlink so that checks can do the right thing. +if (defined ($chl) && -l $chl) { + my $link = readlink $chl or fail("cannot readlink $chl: $!"); + if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(/+[^/]+)*\z%)) { + symlink('file-is-in-another-package', 'changelog') + or fail("cannot create changelog symlink: $!"); + undef $chl; + } elsif (! -f $chl) { + undef $chl; + } +} + +# If the changelog was a broken symlink, it will be undefined and we'll now +# treat it the same as if we didn't find a changelog and do nothing. If it +# was a symlink, copy the file, since otherwise the relative symlinks are +# going to break things. +if (not defined $chl) { + # no changelog found +} elsif ($chl =~ /\.gz$/) { + use lib "$ENV{'LINTIAN_ROOT'}/lib"; + use Pipeline; + + pipeline((sub { exec 'gzip', '-dc', $chl }), "changelog") == 0 + or fail("error in gzip"); +} elsif (-f $chl && -l $chl) { + local $_; + open (CHL, '<', $chl) or fail("cannot open $chl: $!"); + open (COPY, '>', 'changelog') or fail("cannot create changelog: $!"); + print COPY while ; + close CHL; + close COPY; +} else { + link($chl, "changelog") + or fail("cannot link $chl to changelog: $!"); +} + +# Extract NEWS.Debian files as well, with similar precautious. Ignore any +# symlinks to other packages here; in that case, we just won't check the file. +my $news = "unpacked/usr/share/doc/$pkg/NEWS.Debian.gz"; +if (-f $news) { + if (-l $news) { + my $link = readlink $news or fail("cannot readlink $chl: $!"); + if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(/+[^/]+)*\z%)) { + undef $news; + } elsif (! -f $news) { + undef $news; + } + } + if ($news) { + use lib "$ENV{'LINTIAN_ROOT'}/lib"; + use Pipeline; + + pipeline((sub { exec 'gzip', '-dc', $news }), "NEWS.Debian") == 0 + or fail("error in gzip"); + } +} + +exit 0; + +# ----------------------------------- + +sub fail { + if ($_[0]) { + print STDERR "internal error: $_[0]\n"; + } elsif ($!) { + print STDERR "internal error: $!\n"; + } else { + print STDERR "internal error.\n"; + } + exit 1; +}