diff --git a/checks/changes-file b/checks/changes-file new file mode 100755 index 0000000..67c5e68 --- /dev/null +++ b/checks/changes-file @@ -0,0 +1,153 @@ +# changes-file -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# +# This program is free software. It is distributed 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. + +package Lintian::changes_file; +use strict; +use Util; + +use Lintian::Tags qw(tag); +use Lintian::Check qw(check_maintainer); + +my $check_checksums = $main::check_checksums; + +sub run { + +my $pkg = shift; +my $type = shift; +my $info = shift; + +# If we don't have a Format key, something went seriously wrong. +# Tag the file and skip remaining processing. +if (!$info->field('format')) { + tag('malformed-changes-file'); + return 0; +} + +# Description is mandated by dak, but only makes sense if binary +# packages are included. Don't tag pure source uploads. +if (!$info->field('description') && $info->field('architecture') ne 'source') { + tag("no-description-in-changes-file"); +} + +# check distribution field +if (defined $info->field('distribution')) { + my $ubuntu_dists = Lintian::Data->new ('changelog-file/ubuntu-dists'); + my $ubuntu_regex = join('|', $ubuntu_dists->all); + my @distributions = split /\s+/o, $info->field('distribution'); + for my $distribution (@distributions) { + if ($distribution eq 'UNRELEASED') { + # ignore + } elsif ($info->field('version') =~ /ubuntu|$ubuntu_regex/ + or $distribution =~ /$ubuntu_regex/) { + if ($distribution !~ /^($ubuntu_regex)(-(proposed|updates|backports|security))?$/ ) { + tag("bad-ubuntu-distribution-in-changes-file", + $distribution); + } + } elsif (! (($distribution eq 'oldstable') + or ($distribution eq 'stable') + or ($distribution eq 'testing') + or ($distribution eq 'unstable') + or ($distribution eq 'experimental') + or ($distribution =~ /^\w+-backports$/) + or ($distribution =~ /^\w+-proposed-updates$/) + or ($distribution =~ /^\w+-security$/)) + ) { + # bad distribution entry + tag("bad-distribution-in-changes-file", $distribution); + } + } + + if ($#distributions > 0) { + tag("multiple-distributions-in-changes-file", + $info->field('distribution')); + } + } + + # Urgency is only recommended by Policy. + if (!$info->field('urgency')) { + tag("no-urgency-in-changes-file"); + } else { + my $urgency = lc $info->field('urgency'); + $urgency =~ s/ .*//; + unless ($urgency =~ /^(low|medium|high|critical|emergency)$/i) { + tag("bad-urgency-in-changes-file", $info->field('urgency')); + } + } + + # Changed-By is optional in Policy, but if set, must be + # syntactically correct. It's also used by dak. + if ($info->field('changed-by')) { + check_maintainer($info->field('changed-by'), 'changed-by'); + } + + my $files = $info->files; + foreach my $file (keys %$files) { + my $file_info = $files->{$file}; + + # check section + if (($file_info->{section} eq 'non-free') or + ($file_info->{section} eq 'contrib')) { + tag("bad-section-in-changes-file", $file, $file_info->{section}); + } + + foreach my $alg (qw(sha1 sha256)) { + my $checksum_info = $file_info->{checksums}{$alg}; + if (defined $checksum_info) { + if ($file_info->{size} != $checksum_info->{filesize}) { + tag( "file-size-mismatch-in-changes-file", $file, + $file_info->{size} . ' != ' . + $checksum_info->{filesize} ); + } + } + } + + # check size + my $path = readlink('changes'); + $path =~ s#/[^/]+$##; + my $filename = "$path/$file"; + my $size = -s $filename; + + if ($size ne $file_info->{size}) { + tag( "file-size-mismatch-in-changes-file", $file, + $file_info->{size} . " != $size"); + } + + # check checksums + if ($check_checksums or $file =~ /\.dsc$/) { + foreach my $alg (qw(md5 sha1 sha256)) { + next unless exists $file_info->{checksums}{$alg}; + + my $real_checksum = get_file_checksum($alg, $filename); + + if ($real_checksum ne $file_info->{checksums}{$alg}{sum}) { + tag( "checksum-mismatch-in-changes-file", $alg, $file ); + } + } + } + } +} + +1; + +# Local Variables: +# indent-tabs-mode: t +# cperl-indent-level: 4 +# End: +# vim: sw=4 ts=8 noet fdm=marker diff --git a/checks/changes-file.desc b/checks/changes-file.desc new file mode 100644 index 0000000..1c9364b --- /dev/null +++ b/checks/changes-file.desc @@ -0,0 +1,130 @@ +Check-Script: changes-file +Abbrev: chng +Type: changes +Info: This script checks for various problems with .changes files + +Tag: malformed-changes-file +Severity: serious +Certainty: certain +Info: There is no "Format" field in your .changes file. This probably + indicates some serious problem with the file. Perhaps it's not actually + a changes file, or it's not in the proper format, or it's PGP-signed + twice. + . + Since Lintian was unable to parse this .changes file, any further checks + on it were skipped. +Ref: policy 5.5 + +Tag: no-description-in-changes-file +Severity: serious +Certainty: certain +Info: There is no "Description" field in your .changes file. A + description is mandatory and is usually constructed from the descriptions + in the control file of the package by the package build tools. +Ref: policy 5.5 + +Tag: bad-distribution-in-changes-file +Severity: important +Certainty: certain +Info: You've specified an unknown target distribution for your upload in + the debian/changelog file. + . + Note that the distributions non-free and contrib are no + longer valid. You'll have to use distribution unstable and + Section: non-free/xxx or Section: contrib/xxx instead. +Ref: policy 5.6.14 + +Tag: bad-ubuntu-distribution-in-changes-file +Severity: important +Certainty: certain +Info: You've specified an unknown target distribution for your upload in + the debian/changelog file. + . + Your version string suggests this package is for Ubuntu, so your + distribution should be one of lucid, karmic, jaunty, intrepid, hardy or + dapper. + +Tag: multiple-distributions-in-changes-file +Severity: important +Certainty: possible +Info: You've specified more than one target distribution for your upload + in the *.changes file, probably via the most recent entry in the + debian/changelog file. + . + Although this syntax is valid, it is not accepted by the Debian archive + management software. This may not be a problem if this upload is + targeted at an archive other than Debian's. +Ref: policy 5.6.14 + +Tag: no-urgency-in-changes-file +Severity: normal +Certainty: certain +Info: There is no "Urgency" field in the .changes file. This field is + recommended by policy and is usually derived from the first line of the + most recent changelog entry by the package build tools. +Ref: policy 5.5 + +Tag: bad-urgency-in-changes-file +Severity: important +Certainty: certain +Info: The keyword value of the "Urgency" field in the .changes file is not + one of the allowed values of low, medium, high, critical, and emergency + (case-insensitive). This value normally taken from the first line of the + most recent entry in debian/changelog, which is probably where + the error is. +Ref: policy 5.6.17 + +Tag: file-size-mismatch-in-changes-file +Severity: serious +Certainty: certain +Info: The actual file size does not match what's listed in the + .changes file. + +Tag: checksum-mismatch-in-changes-file +Severity: serious +Certainty: certain +Info: The actual checksum does not match what's listed in the + .changes file. + +Tag: bad-section-in-changes-file +Severity: important +Certainty: certain +Info: The sections non-free and contrib are no longer + valid. Please use section non-free/xxx or + contrib/xxx instead. +Ref: policy 2.4 + +Tag: changed-by-name-missing +Severity: serious +Certainty: certain +Info: The Changed-By field seems to contain just an email address. It must + contain the package maintainer's name and email address. +Ref: policy 5.6.4 + +Tag: changed-by-address-missing +Severity: serious +Certainty: certain +Info: The Changed-By field should contain the package builder's name and + email address, with the name followed by the address inside angle + brackets (< and >). The address seems to be missing. +Ref: policy 5.6.4 + +Tag: changed-by-address-malformed +Severity: important +Certainty: certain +Info: The Changed-By field could not be parsed according to the rules in + the Policy Manual. +Ref: policy 5.6.4 + +Tag: changed-by-address-looks-weird +Severity: normal +Certainty: possible +Info: The Changed-By field does not have whitespace between the name + and the email address. + +Tag: changed-by-address-is-on-localhost +Severity: important +Certainty: certain +Info: The Changed-By address includes localhost(.localdomain), which is + an invalid e-mail address. +Ref: policy 5.6.2 diff --git a/checks/lintian.desc b/checks/lintian.desc index 8314b86..08f7f01 100644 --- a/checks/lintian.desc +++ b/checks/lintian.desc @@ -2,132 +2,6 @@ Check-Script: lintian Info: This description file is a special case. It contains the tag info for the tags produced by the lintian frontend itself. -Tag: malformed-changes-file -Severity: serious -Certainty: certain -Info: There is no "Format" field in your .changes file. This probably - indicates some serious problem with the file. Perhaps it's not actually - a changes file, or it's not in the proper format, or it's PGP-signed - twice. - . - Since Lintian was unable to parse this .changes file, it and any files - that it would have referenced were skipped. -Ref: policy 5.5 - -Tag: no-description-in-changes-file -Severity: serious -Certainty: certain -Info: There is no "Description" field in your .changes file. A - description is mandatory and is usually constructed from the descriptions - in the control file of the package by the package build tools. -Ref: policy 5.5 - -Tag: bad-distribution-in-changes-file -Severity: important -Certainty: certain -Info: You've specified an unknown target distribution for your upload in - the debian/changelog file. - . - Note that the distributions non-free and contrib are no - longer valid. You'll have to use distribution unstable and - Section: non-free/xxx or Section: contrib/xxx instead. -Ref: policy 5.6.14 - -Tag: bad-ubuntu-distribution-in-changes-file -Severity: important -Certainty: certain -Info: You've specified an unknown target distribution for your upload in - the debian/changelog file. - . - Your version string suggests this package is for Ubuntu, so your - distribution should be one of lucid, karmic, jaunty, intrepid, hardy or - dapper. - -Tag: multiple-distributions-in-changes-file -Severity: important -Certainty: possible -Info: You've specified more than one target distribution for your upload - in the *.changes file, probably via the most recent entry in the - debian/changelog file. - . - Although this syntax is valid, it is not accepted by the Debian archive - management software. This may not be a problem if this upload is - targeted at an archive other than Debian's. -Ref: policy 5.6.14 - -Tag: no-urgency-in-changes-file -Severity: normal -Certainty: certain -Info: There is no "Urgency" field in the .changes file. This field is - recommended by policy and is usually derived from the first line of the - most recent changelog entry by the package build tools. -Ref: policy 5.5 - -Tag: bad-urgency-in-changes-file -Severity: important -Certainty: certain -Info: The keyword value of the "Urgency" field in the .changes file is not - one of the allowed values of low, medium, high, critical, and emergency - (case-insensitive). This value normally taken from the first line of the - most recent entry in debian/changelog, which is probably where - the error is. -Ref: policy 5.6.17 - -Tag: file-size-mismatch-in-changes-file -Severity: serious -Certainty: certain -Info: The actual file size does not match what's listed in the - .changes file. - -Tag: checksum-mismatch-in-changes-file -Severity: serious -Certainty: certain -Info: The actual checksum does not match what's listed in the - .changes file. - -Tag: bad-section-in-changes-file -Severity: important -Certainty: certain -Info: The sections non-free and contrib are no longer - valid. Please use section non-free/xxx or - contrib/xxx instead. -Ref: policy 2.4 - -Tag: changed-by-name-missing -Severity: serious -Certainty: certain -Info: The Changed-By field seems to contain just an email address. It must - contain the package maintainer's name and email address. -Ref: policy 5.6.4 - -Tag: changed-by-address-missing -Severity: serious -Certainty: certain -Info: The Changed-By field should contain the package builder's name and - email address, with the name followed by the address inside angle - brackets (< and >). The address seems to be missing. -Ref: policy 5.6.4 - -Tag: changed-by-address-malformed -Severity: important -Certainty: certain -Info: The Changed-By field could not be parsed according to the rules in - the Policy Manual. -Ref: policy 5.6.4 - -Tag: changed-by-address-looks-weird -Severity: normal -Certainty: possible -Info: The Changed-By field does not have whitespace between the name - and the email address. - -Tag: changed-by-address-is-on-localhost -Severity: important -Certainty: certain -Info: The Changed-By address includes localhost(.localdomain), which is - an invalid e-mail address. -Ref: policy 5.6.2 - Tag: unused-override Severity: wishlist Certainty: certain diff --git a/frontend/lintian b/frontend/lintian index e0e8bdb..28700ca 100755 --- a/frontend/lintian +++ b/frontend/lintian @@ -30,7 +30,7 @@ use Getopt::Long; # {{{ Global Variables my $LINTIAN_VERSION = ""; #External Version number my $BANNER = "Lintian v$LINTIAN_VERSION"; #Version Banner - text form -my $LAB_FORMAT = 9; #Lab format Version Number +my $LAB_FORMAT = 10; #Lab format Version Number #increased whenever incompatible #changes are done to the lab #so that all packages are re-unpacked @@ -606,8 +606,6 @@ require Lintian::Output; import Lintian::Output qw(:messages); require Lintian::Command; import Lintian::Command qw(spawn reap); -require Lintian::Check; -import Lintian::Check qw(check_maintainer); require Lintian::Tags; import Lintian::Tags qw(tag); @@ -766,169 +764,7 @@ while (my $arg = shift) { } # .changes file? elsif ($arg =~ /\.changes$/) { - # get directory and filename part of $arg - my ($arg_dir, $arg_name) = $arg =~ m,(.*)/([^/]+)$,; - - v_msg("Processing changes file $arg_name ..."); - - my ($data) = read_dpkg_control($arg); - if (not defined $data) { - warning("$arg is a zero-byte file, skipping"); - next; - } - $TAGS->file_start($arg, $arg_name, '', '', 'binary'); - - # If we don't have a Format key, something went seriously wrong. - # Tag the file and skip remaining processing. - if (!$data->{'format'}) { - tag('malformed-changes-file'); - next; - } - - # Description is mandated by dak, but only makes sense if binary - # packages are included. Don't tag pure source uploads. - if (!$data->{'description'} && $data->{'architecture'} ne 'source') { - tag("no-description-in-changes-file"); - } - - # check distribution field - if (defined $data->{distribution}) { - my $ubuntu_dists = Lintian::Data->new ('changelog-file/ubuntu-dists'); - my $ubuntu_regex = join('|', $ubuntu_dists->all); - my @distributions = split /\s+/o, $data->{distribution}; - for my $distribution (@distributions) { - if ($distribution eq 'UNRELEASED') { - # ignore - } elsif ($data->{version} =~ /ubuntu|$ubuntu_regex/ - or $distribution =~ /$ubuntu_regex/) { - if ($distribution !~ /^($ubuntu_regex)(-(proposed|updates|backports|security))?$/ ) { - tag("bad-ubuntu-distribution-in-changes-file", - $distribution); - } - } elsif (! (($distribution eq 'oldstable') - or ($distribution eq 'stable') - or ($distribution eq 'testing') - or ($distribution eq 'unstable') - or ($distribution eq 'experimental') - or ($distribution =~ /^\w+-backports$/) - or ($distribution =~ /^\w+-proposed-updates$/) - or ($distribution =~ /^\w+-security$/)) - ) { - # bad distribution entry - tag("bad-distribution-in-changes-file", - $distribution); - } - } - - if ($#distributions > 0) { - tag("multiple-distributions-in-changes-file", - $data->{'distribution'}); - } - } - - # Urgency is only recommended by Policy. - if (!$data->{'urgency'}) { - tag("no-urgency-in-changes-file"); - } else { - my $urgency = lc $data->{'urgency'}; - $urgency =~ s/ .*//; - unless ($urgency =~ /^(low|medium|high|critical|emergency)$/i) { - tag("bad-urgency-in-changes-file", $data->{'urgency'}); - } - } - - # Changed-By is optional in Policy, but if set, must be - # syntactically correct. It's also used by dak. - if ($data->{'changed-by'}) { - check_maintainer($data->{'changed-by'}, 'changed-by'); - } - - # process all listed `files:' - my %files; - - my $file_list = $data->{files} || ''; - for ( split /\n/, $file_list ) { - chomp; - s/^\s+//o; - next if $_ eq ''; - - my ($md5sum,$size,$section,$priority,$file) = split(/\s+/o, $_); - - next if ($file =~ m,/,); - - $files{$file}{md5} = $md5sum; - $files{$file}{size} = $size; - - # check section - if (($section eq 'non-free') or ($section eq 'contrib')) { - tag( "bad-section-in-changes-file", $file, $section ); - } - - } - - foreach my $alg (qw(sha1 sha256)) { - my $list = $data->{"checksums-$alg"} || ''; - for ( split /\n/, $list ) { - chomp; - s/^\s+//o; - next if $_ eq ''; - - my ($checksum,$size,$file) = split(/\s+/o, $_); - $files{$file}{$alg} = $checksum; - if ($files{$file}{size} != $size) { - tag( "file-size-mismatch-in-changes-file", $file, - "$files{$file}{size} != $size" ); - } - } - } - - - foreach my $file (keys %files) { - my $filename = $arg_dir . '/' . $file; - - # check size - if (not -f $filename) { - warning("$file does not exist, exiting"); - exit 2; - } - my $size = -s _; - if ($size ne $files{$file}{size}) { - tag( "file-size-mismatch-in-changes-file", $file, - "$files{$file}{size} != $size"); - } - - # check checksums - if ($check_checksums or $file =~ /\.dsc$/) { - foreach my $alg (qw(md5 sha1 sha256)) { - next unless exists $files{$file}{$alg}; - - my $real_checksum = get_file_checksum($alg, $filename); - - if ($real_checksum ne $files{$file}{$alg}) { - tag( "checksum-mismatch-in-changes-file", $alg, $file ); - } - } - } - - # process file? - if ($file =~ /\.dsc$/) { - $schedule->add_dsc($filename); - } elsif ($file =~ /\.deb$/) { - $schedule->add_deb('b', $filename); - } elsif ($file =~ /\.udeb$/) { - $schedule->add_deb('u', $filename); - } - } - - unless ($exit_code) { - my $stats = $TAGS->statistics($arg); - if ($stats->{types}{E}) { - $exit_code = 1; - } elsif ($fail_on_warnings && $stats->{types}{W}) { - $exit_code = 1; - } - } - + $schedule->add_changes($arg); } else { fail("bad package file name $arg (neither .deb, .udeb or .dsc file)"); } @@ -1064,7 +900,7 @@ for my $f (readdir COLLDIR) { set_value($f, $p,'type',$secs[0],1); # convert Type: - my ($b,$s,$u) = ( "", "", "" );; + my ($b,$s,$u,$c) = ( "", "", "", "" );; for (split(/\s*,\s*/o,$p->{'type'})) { if ($_ eq 'binary') { $b = 'b'; @@ -1072,11 +908,13 @@ for my $f (readdir COLLDIR) { $s = 's'; } elsif ($_ eq 'udeb') { $u = 'u'; + } elsif ($_ eq 'changes') { + $c = 'c'; } else { fail("unknown type $_ specified in description file $f"); } } - $p->{'type'} = "$s$b$u"; + $p->{'type'} = "$s$b$u$c"; set_value($f,$p,'order',$secs[0],1); set_value($f,$p,'version',$secs[0],1); @@ -1129,7 +967,7 @@ for my $f (readdir CHECKDIR) { set_value($f,$p,'type',$secs[0],1); # convert Type: - my ($b,$s,$u) = ( "", "", "" ); + my ($b,$s,$u,$c) = ( "", "", "", "" ); for (split(/\s*,\s*/o,$p->{'type'})) { if ($_ eq 'binary') { $b = 'b'; @@ -1137,11 +975,13 @@ for my $f (readdir CHECKDIR) { $s = 's'; } elsif ($_ eq 'udeb') { $u = 'u'; + } elsif ($_ eq 'changes') { + $c = 'c'; } else { fail("unknown type $_ specified in description file $f"); } } - $p->{'type'} = "$s$b$u"; + $p->{'type'} = "$s$b$u$c"; set_value($f,$p,'abbrev',$secs[0],1); @@ -1330,7 +1170,8 @@ foreach my $pkg_info ($schedule->get_all) { my ($type, $pkg, $ver, $arch, $file) = @$pkg_info{qw(type package version architecture file)}; my $long_type = ($type eq 'b' ? 'binary' : - ($type eq 's' ? 'source' : 'udeb' )); + ($type eq 'c' ? 'changes' : + ($type eq 's' ? 'source' : 'udeb' ))); $TAGS->file_start($file, $pkg, $ver, $arch, $long_type); @@ -1682,6 +1523,9 @@ sub unpack_pkg { if (($type eq 'b') || ($type eq 'u')) { spawn({}, ["$LINTIAN_ROOT/unpack/unpack-binpkg-l1", $base, $file]) or return -1; + } elsif ($type eq 'c') { + spawn({}, ["$LINTIAN_ROOT/unpack/unpack-changes-l1", $base, $file]) + or return -1; } else { spawn({}, ["$LINTIAN_ROOT/unpack/unpack-srcpkg-l1", $base, $file]) or return -1; diff --git a/frontend/lintian-info b/frontend/lintian-info index bf7284b..8c69b00 100755 --- a/frontend/lintian-info +++ b/frontend/lintian-info @@ -97,7 +97,8 @@ while (<>) { my @pieces = split(/:\s+/); if ($annotate) { $type = shift @pieces if ($pieces[0] =~ /^\w$/); - $pkg = shift @pieces if ($pieces[0] =~ /^\S+( (binary|udeb))?$/); + $pkg = shift @pieces if + ($pieces[0] =~ /^\S+( (binary|changes|udeb))?$/); } else { $type = shift @pieces; $pkg = shift @pieces; diff --git a/lib/Lab.pm b/lib/Lab.pm index cc319ce..9227f50 100644 --- a/lib/Lab.pm +++ b/lib/Lab.pm @@ -60,6 +60,11 @@ sub setup { $self->{mode} = 'static'; $self->{dir} = $dir; $self->{dist} = $dist; + + if (-d "$dir" && ! -d "$dir/changes") { + mkdir("$dir/changes", 0777) + or fail("cannot create lab directory $dir/changes"); + } } else { $self->{mode} = 'temporary'; @@ -106,7 +111,7 @@ sub setup_force { } # create base directories - for my $subdir (qw( binary source udeb info )) { + for my $subdir (qw( binary source udeb changes info )) { my $fulldir = "$dir/$subdir"; if (not -d $fulldir) { mkdir($fulldir, 0777) @@ -216,6 +221,7 @@ sub delete_force { unless (delete_dir("$self->{dir}/binary", "$self->{dir}/source", "$self->{dir}/udeb", + "$self->{dir}/changes", "$self->{dir}/info")) { warning("cannot remove lab directory $self->{dir} (please remove it yourself)"); } diff --git a/lib/Lintian/Collect.pm b/lib/Lintian/Collect.pm index cf74185..e916086 100644 --- a/lib/Lintian/Collect.pm +++ b/lib/Lintian/Collect.pm @@ -31,6 +31,9 @@ sub new { } elsif ($type eq 'binary' or $type eq 'udeb') { require Lintian::Collect::Binary; $object = Lintian::Collect::Binary->new ($pkg); + } elsif ($type eq 'changes') { + require Lintian::Collect::Changes; + $object = Lintian::Collect::Changes->new ($pkg); } else { return; } @@ -56,7 +59,8 @@ sub type { # Return the value of the specified control field of the package, or undef if # that field wasn't present in the control file for the package. For source # packages, this is the *.dsc file; for binary packages, this is the control -# file in the control section of the package. +# file in the control section of the package. For .changes files, the +# information will be retrieved from the file itself. # sub field Needs-Info <> sub field { my ($self, $field) = @_; @@ -87,9 +91,9 @@ Lintian::Collect - Lintian interface to package data collection =head1 DESCRIPTION Lintian::Collect provides the shared interface to package data used by -source, binary, and udeb packages. It creates an object of the -appropriate type and provides common functions used by the collection -interface to all three types of packages. +source, binary and udeb packages and .changes files. It creates an +object of the appropriate type and provides common functions used by the +collection interface to all types of package. This module is in its infancy. Most of Lintian still reads all data from files in the laboratory whenever that data is needed and generates that @@ -115,8 +119,9 @@ It can be retrieved with the name() method. =head1 INSTANCE METHODS In addition to the instance methods documented here, see the documentation -of Lintian::Collect::Source and Lintian::Collect::Binary for instance -methods specific to source and binary / udeb packages. +of Lintian::Collect::Source, Lintian::Collect::Binary and +Lintian::Collect::Changes for instance methods specific to source and +binary / udeb packages and .changes files. =over 4 @@ -146,7 +151,8 @@ Originally written by Russ Allbery for Lintian. =head1 SEE ALSO -lintian(1), Lintian::Collect::Binary(3), Lintian::Collect::Source(3) +lintian(1), Lintian::Collect::Binary(3), Lintian::Collect::Changes(3), +Lintian::Collect::Source(3) =cut diff --git a/lib/Lintian/Collect/Changes.pm b/lib/Lintian/Collect/Changes.pm new file mode 100755 index 0000000..f0e1cfe --- /dev/null +++ b/lib/Lintian/Collect/Changes.pm @@ -0,0 +1,184 @@ +# -*- perl -*- +# Lintian::Collect::Changes -- interface to .changes file data collection + +# Copyright (C) 2010 Adam D. Barratt +# +# 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, see . + +package Lintian::Collect::Changes; + +use strict; +use warnings; +use base 'Lintian::Collect'; + +use Util; + +# Initialize a new .changes file collect object. Takes the package name, +# which is currently unused. +sub new { + my ($class, $pkg) = @_; + my $self = {}; + bless($self, $class); + return $self; +} + +# Returns information about the files referenced in the .changes file. +# sub files Needs-Info <> +sub files { + my ($self) = @_; + + return $self->{files} if exists $self->{files}; + + my %files; + + my $file_list = $self->field('files') || ''; + for (split /\n/, $file_list) { + chomp; + s/^\s+//o; + next if $_ eq ''; + + my ($md5sum,$size,$section,$priority,$file) = split(/\s+/o, $_); + next if $file =~ m,/,; + + $files{$file}{checksums}{md5} = { + 'sum' => $md5sum, 'filesize' => $size, + }; + $files{$file}{name} = $file; + $files{$file}{size} = $size; + $files{$file}{section} = $section; + $files{$file}{priority} = $priority; + } + + foreach my $alg (qw(sha1 sha256)) { + my $list = $self->field("checksums-$alg") || ''; + for (split /\n/, $list) { + chomp; + s/^\s+//o; + next if $_ eq ''; + + my ($checksum, $size, $file) = split(/\s+/o, $_); + next if $file =~ m,/,; + + $files{$file}{checksums}{$alg} = { + 'sum' => $checksum, 'filesize' => $size + }; + } + } + + $self->{files} = \%files; + return $self->{files}; +} + +=head1 NAME + +Lintian::Collect::Changes - Lintian interface to .changes file data collection + +=head1 SYNOPSIS + + my ($name, $type) = ('foobar_1.2_i386.changes', 'changes'); + my $collect = Lintian::Collect->new($name, $type); + my $files = $collect->files(); + + foreach my $file (keys %{$files}) { + my $size = $files->{$file}->{size}; + print "File $file has size $size\n"; + } + +=head1 DESCRIPTION + +Lintian::Collect::Changes provides an interface to data for .changes +files. It implements data collection methods specific to .changes +files. + +=head1 CLASS METHODS + +=over 4 + +=item new(PACKAGE) + +Creates a new Lintian::Collect::Changes object. Currently, PACKAGE is +ignored. Normally, this method should not be called directly, only via +the Lintian::Collect constructor. + +=back + +=head1 INSTANCE METHODS + +In addition to the instance methods listed below, all instance methods +documented in the Lintian::Collect module are also available. + +=over 4 + +=item files() + +Returns a reference to a hash containing information about files listed +in the .changes file. Each hash may have the following keys: + +=over 4 + +=item name + +Name of the file. + +=item size + +The size of the file in bytes. + +=item section + +The archive section to which the file belongs. + +=item priority + +The priority of the file. + +=item checksums + +A hash with the keys being checksum algorithms and the values themselves being +hashes containing + +=over 4 + +=item sum + +The result of applying the given algorithm to the file. + +=item filesize + +The size of the file as given in the .changes section relating to the given +checksum. + +=back + +=back + +=back + +=head1 AUTHOR + +Originally written by Adam D. Barratt for Lintian. + +=head1 SEE ALSO + +lintian(1), Lintian::Collect(3) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround diff --git a/lib/Lintian/Output.pm b/lib/Lintian/Output.pm index 12038a4..4405db2 100644 --- a/lib/Lintian/Output.pm +++ b/lib/Lintian/Output.pm @@ -334,8 +334,13 @@ Lintian::Output uses v_msg() for output. Called from Tags::select_pkg(). sub print_start_pkg { my ($self, $pkg_info) = @_; + my $object = "package"; + if ($pkg_info->{type} eq 'changes') { + $object = "file"; + } + $self->v_msg($self->delimiter, - "Processing $pkg_info->{type} package $pkg_info->{package} (version $pkg_info->{version}) ..."); + "Processing $pkg_info->{type} $object $pkg_info->{package} (version $pkg_info->{version}) ..."); } =item C diff --git a/lib/Lintian/Schedule.pm b/lib/Lintian/Schedule.pm index 39fa7bd..4fcc127 100644 --- a/lib/Lintian/Schedule.pm +++ b/lib/Lintian/Schedule.pm @@ -40,22 +40,27 @@ sub new { sub add_file { my ($self, $type, $file, %pkg_info) = @_; + my %long_types = ('b','binary', 'c','changes', 's','source', 'u','udeb'); my ($pkg, $ver, $arch); if ($type eq 's') { ($pkg, $ver, $arch) = (@pkg_info{qw(source version)}, 'source'); + } elsif ($type eq 'c') { + my ($filename) = $file =~ m,.*/([^/]+)\.changes$,; + ($pkg, $ver, $arch) = + ($filename, @pkg_info{qw(version architecture)}); } else { ($pkg, $ver, $arch) = @pkg_info{qw(package version architecture)}; } $pkg ||= ''; # "0" is a valid version, so we can't use || here - $ver = '' unless length $ver; + $ver = '' unless defined $ver and length $ver; $arch ||= ''; if ( $pkg =~ m,/, ) { warn(sprintf("warning: bad name for %2\$s package '%1\$s', skipping\n", - $pkg, $type eq 'b' ? 'binary' : ($type eq 's' ? 'source': 'udeb'))); + $pkg, $long_types{$type})); return 1; } @@ -66,7 +71,7 @@ sub add_file { if ( $self->{unique}{$s}++ ) { if ($self->{opts}{verbose}) { printf "N: Ignoring duplicate %s package %s (version %s)\n", - $type eq 'b' ? 'binary' : ($type eq 's' ? 'source': 'udeb'), + $long_types{$type}, $pkg, $ver; } return 1; @@ -109,10 +114,46 @@ sub add_pkg_list { close(IN); } +sub add_changes { + my ($self, $changes_file) = @_; + + my $info = get_dsc_info($changes_file); + return unless defined $info; + + my $status = $self->add_file('c', $changes_file, %$info); + # get directory and filename part of $changes_file + my ($arg_dir, $arg_name) = $changes_file =~ m,(.*)/([^/]+)$,; + my $file_list = $info->{files} || ''; + for (split /\n/, $file_list) { + chomp; + s/^\s+//o; + next if $_ eq ''; + + my ($md5sum,$size,$section,$priority,$file) = split(/\s+/o, $_); + + next if $file =~ m,/,; + + if (not -f "$arg_dir/$file") { + warning("$file does not exist, exiting"); + exit 2; + } + + if ($file =~ /\.deb$/) { + $status += $self->add_deb('b', "$arg_dir/$file"); + } elsif ($file =~ /\.udeb$/) { + $status += $self->add_deb('u', "$arg_dir/$file"); + } elsif ($file =~ /\.dsc$/) { + $status += $self->add_dsc("$arg_dir/$file"); + } + } + + return ($status ? 0 : 1); +} + # for each package (the sort is to make sure that source packages are # before the corresponding binary packages--this has the advantage that binary # can use information from the source packages if these are unpacked) -my %type_sort = ('b' => 1, 'u' => 1, 's' => 2 ); +my %type_sort = ('b' => 1, 'u' => 1, 's' => 2, 'c' => 3 ); sub get_all { return sort({$type_sort{$b->{type}} <=> $type_sort{$a->{type}}} @{$_[0]->{schedule}}); diff --git a/lib/Lintian/Tags.pm b/lib/Lintian/Tags.pm index d519b11..f4b36bb 100644 --- a/lib/Lintian/Tags.pm +++ b/lib/Lintian/Tags.pm @@ -500,14 +500,12 @@ sub file_start { tags => {}, overrides => {}, }; - if ($self->{current} && $self->{current} !~ /\.changes$/) { + if ($self->{current}) { my $info = $self->{info}{$self->{current}}; $Lintian::Output::GLOBAL->print_end_pkg($info); } $self->{current} = $file; - if ($file !~ /\.changes$/) { - $Lintian::Output::GLOBAL->print_start_pkg($self->{info}{$file}); - } + $Lintian::Output::GLOBAL->print_start_pkg($self->{info}{$file}); } =item file_overrides(OVERRIDE-FILE) diff --git a/t/changes/changed-by-localhost.tags b/t/changes/changed-by-localhost.tags index 2aec261..e260e19 100644 --- a/t/changes/changed-by-localhost.tags +++ b/t/changes/changed-by-localhost.tags @@ -1 +1 @@ -E: changed-by-localhost.changes: changed-by-address-is-on-localhost Someone +E: changed-by-localhost changes: changed-by-address-is-on-localhost Someone diff --git a/t/changes/changed-by-malformed.tags b/t/changes/changed-by-malformed.tags index 220f7b0..5347402 100644 --- a/t/changes/changed-by-malformed.tags +++ b/t/changes/changed-by-malformed.tags @@ -1,2 +1,2 @@ -E: changed-by-malformed.changes: changed-by-address-malformed Foo Baz -W: changed-by-malformed.changes: changed-by-address-looks-weird Foo Baz +E: changed-by-malformed changes: changed-by-address-malformed Foo Baz +W: changed-by-malformed changes: changed-by-address-looks-weird Foo Baz diff --git a/t/changes/changed-by-no-name.tags b/t/changes/changed-by-no-name.tags index ee84e74..795a51c 100644 --- a/t/changes/changed-by-no-name.tags +++ b/t/changes/changed-by-no-name.tags @@ -1 +1 @@ -E: changed-by-no-name.changes: changed-by-name-missing someone@example.com +E: changed-by-no-name changes: changed-by-name-missing someone@example.com diff --git a/t/changes/changes-double-signed.tags b/t/changes/changes-double-signed.tags index 38c3365..8ca3164 100644 --- a/t/changes/changes-double-signed.tags +++ b/t/changes/changes-double-signed.tags @@ -1 +1 @@ -E: changes-double-signed.changes: malformed-changes-file +E: changes-double-signed changes: malformed-changes-file diff --git a/t/runtests b/t/runtests index 3af9d08..8c7e045 100755 --- a/t/runtests +++ b/t/runtests @@ -507,7 +507,7 @@ sub test_package { open TAGS, "$RUNDIR/tags.$pkg" or fail("Cannot open $RUNDIR/tags.$pkg"); while () { next if m/^N: /; - if (not /^(.): (\S+)(?: (?:source|udeb))?: (\S+)/) { + if (not /^(.): (\S+)(?: (?:changes|source|udeb))?: (\S+)/) { print (($testdata->{'todo'} eq 'yes')? "TODO" : "E"); print ": Invalid line:\n$_"; $okay = 0; diff --git a/t/tests/distribution-multiple-bad/tags b/t/tests/distribution-multiple-bad/tags index 7539af1..7cc3bfe 100644 --- a/t/tests/distribution-multiple-bad/tags +++ b/t/tests/distribution-multiple-bad/tags @@ -1,4 +1,4 @@ -E: distribution-multiple-bad_1.0_arch.changes: bad-distribution-in-changes-file bar -E: distribution-multiple-bad_1.0_arch.changes: bad-distribution-in-changes-file foo -E: distribution-multiple-bad_1.0_arch.changes: bad-distribution-in-changes-file foo-backportss -E: distribution-multiple-bad_1.0_arch.changes: multiple-distributions-in-changes-file stable foo-backportss bar foo +E: distribution-multiple-bad_1.0_amd64 changes: bad-distribution-in-changes-file bar +E: distribution-multiple-bad_1.0_amd64 changes: bad-distribution-in-changes-file foo +E: distribution-multiple-bad_1.0_amd64 changes: bad-distribution-in-changes-file foo-backportss +E: distribution-multiple-bad_1.0_amd64 changes: multiple-distributions-in-changes-file stable foo-backportss bar foo diff --git a/t/tests/generic-empty/tags b/t/tests/generic-empty/tags index 1c49b4e..97eca4e 100644 --- a/t/tests/generic-empty/tags +++ b/t/tests/generic-empty/tags @@ -5,9 +5,9 @@ E: generic-empty source: no-standards-version-field E: generic-empty: maintainer-address-missing a E: generic-empty: no-copyright-file E: generic-empty: package-has-no-description -E: generic-empty_1.0_arch.changes: bad-urgency-in-changes-file unknown -E: generic-empty_1.0_arch.changes: changed-by-address-malformed a <> -E: generic-empty_1.0_arch.changes: changed-by-address-missing a <> +E: generic-empty_1.0_amd64 changes: bad-urgency-in-changes-file unknown +E: generic-empty_1.0_amd64 changes: changed-by-address-malformed a <> +E: generic-empty_1.0_amd64 changes: changed-by-address-missing a <> W: generic-empty source: changelog-should-mention-nmu W: generic-empty source: maintainer-not-full-name a W: generic-empty source: no-section-field-for-source diff --git a/t/tests/lintian-output-xml/tags b/t/tests/lintian-output-xml/tags index 4c73126..1910121 100644 --- a/t/tests/lintian-output-xml/tags +++ b/t/tests/lintian-output-xml/tags @@ -1,3 +1,5 @@ + + line 11 field "section" in package lintian-output-xml diff --git a/testset/tags.foo++ b/testset/tags.foo++ index 2bb281c..d21136e 100644 --- a/testset/tags.foo++ +++ b/testset/tags.foo++ @@ -13,7 +13,7 @@ E: foo++: debian-changelog-file-contains-debmake-default-email-address he@unknow E: foo++: debian-changelog-file-uses-obsolete-national-encoding at line 11 E: foo++: no-copyright-file E: foo++: wrong-debian-qa-address-set-as-maintainer Lintian Maintainer -E: foo++_arch.changes: changed-by-address-malformed Marc 'HE' Brockschmidt +E: foo++_5_amd64 changes: changed-by-address-malformed Marc 'HE' Brockschmidt I: foo++ source: duplicate-short-description foo++ foo++-helper I: foo++: no-md5sums-control-file W: foo++ source: ancient-standards-version 3.1.1 (current is 3.8.4) diff --git a/testset/tags.scripts b/testset/tags.scripts index 1655991..b5b7f15 100644 --- a/testset/tags.scripts +++ b/testset/tags.scripts @@ -20,7 +20,7 @@ E: scripts: shell-script-fails-syntax-check ./usr/bin/sh-broken E: scripts: suid-perl-script-but-no-perl-suid-dep ./usr/bin/suidperlfoo2 E: scripts: wrong-path-for-interpreter ./usr/bin/lefty-foo (#!/usr/local/bin/lefty != /usr/bin/lefty) E: scripts: wrong-path-for-interpreter ./usr/bin/rubyfoo (#!/bin/ruby1.8 != /usr/bin/ruby1.8) -E: scripts_6ds-1ubuntu0.5.10.1_arch.changes: bad-ubuntu-distribution-in-changes-file unstable +E: scripts_6ds-1ubuntu0.5.10.1_amd64 changes: bad-ubuntu-distribution-in-changes-file unstable I: scripts source: debian-watch-file-should-dversionmangle-not-uversionmangle line 5 I: scripts source: dpatch-missing-description 02_i_dont_have_a_description.patch I: scripts source: dpatch-missing-description 04_i_dont_have_a_description_either.patch diff --git a/unpack/unpack-changes-l1 b/unpack/unpack-changes-l1 new file mode 100755 index 0000000..7d777bc --- /dev/null +++ b/unpack/unpack-changes-l1 @@ -0,0 +1,69 @@ +#!/usr/bin/perl +# unpack-changes-l1 -- lintian unpack script (changes file level 1) +# +# syntax: unpack-changes-l1 +# +# Note, that must be specified with absolute path. + +# Copyright (C) 1998 Christian Schwarz +# Copyright (C) 2010 Adam D. Barratt +# +# 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; +use vars qw($verbose); + +($#ARGV == 1) or die "syntax: unpack-changes-l1 "; +my $base_dir = shift; +my $file = shift; + +# import perl libraries +use lib "$ENV{'LINTIAN_ROOT'}/lib"; +use Util; + +# stat $file +(my @stat = stat $file) or fail("$file: cannot stat: $!"); + +# get package control information +my $data = get_dsc_info($file); + +# create directory in lab +print "N: Creating directory $base_dir ...\n" if $verbose; +mkdir("$base_dir", 0777) or fail("mkdir $base_dir: $!"); +mkdir("$base_dir/fields", 0777) or fail("mkdir $base_dir/fields: $!"); + +# create control field files +for my $field (keys %$data) { + my $value = $data->{$field}; + # avoid path traversal if $field contains slashes + $field =~ s,/,:,g; + my $field_file = "$base_dir/fields/$field"; + open(F, '>', $field_file) + or fail("cannot open file $field_file for writing: $!"); + print F $value,"\n"; + close(F); +} + +symlink($file,"$base_dir/changes") or fail("cannot symlink changes file: $!"); + +exit 0; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround