diff options
Diffstat (limited to 'lib/Lintian/Processable')
29 files changed, 3976 insertions, 0 deletions
diff --git a/lib/Lintian/Processable/Buildinfo.pm b/lib/Lintian/Processable/Buildinfo.pm new file mode 100644 index 0000000..f5983fa --- /dev/null +++ b/lib/Lintian/Processable/Buildinfo.pm @@ -0,0 +1,133 @@ +# Copyright (C) 2019-2020 Felix Lechner +# +# 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 https://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::Processable::Buildinfo; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Deb822; + +use Moo; +use namespace::clean; + +with + 'Lintian::Processable', + 'Lintian::Processable::Fields::Files', + 'Lintian::Processable::Buildinfo::Overrides'; + +=for Pod::Coverage BUILDARGS + +=head1 NAME + +Lintian::Processable::Buildinfo -- A buildinfo file Lintian can process + +=head1 SYNOPSIS + + use Lintian::Processable::Buildinfo; + + my $processable = Lintian::Processable::Buildinfo->new; + $processable->init_from_file('path'); + +=head1 DESCRIPTION + +This class represents a 'buildinfo' file that Lintian can process. Objects +of this kind are often part of a L<Lintian::Group>, which +represents all the files in a changes or buildinfo file. + +=head1 INSTANCE METHODS + +=over 4 + +=item init_from_file (PATH) + +Initializes a new object from PATH. + +=cut + +sub init_from_file { + my ($self, $file) = @_; + + croak encode_utf8("File $file does not exist") + unless -e $file; + + $self->path($file); + $self->type('buildinfo'); + + my $primary = Lintian::Deb822->new; + my @sections = $primary->read_file($self->path) + or croak encode_utf8( + $self->path. ' is not a valid '. $self->type . ' file'); + + $self->fields($sections[0]); + + my $name = $self->fields->value('Source'); + my $version = $self->fields->value('Version'); + my $architecture = $self->fields->value('Architecture'); + + unless (length $name) { + $name = $self->guess_name($self->path); + croak encode_utf8('Cannot determine the name from '. $self->path) + unless length $name; + } + + my $source_name = $name; + my $source_version = $version; + + $self->name($name); + $self->version($version); + $self->architecture($architecture); + $self->source_name($source_name); + $self->source_version($source_version); + + # make sure none of these fields can cause traversal + $self->tainted(1) + if $self->name ne $name + || $self->version ne $version + || $self->architecture ne $architecture + || $self->source_name ne $source_name + || $self->source_version ne $source_version; + + return; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +L<Lintian::Processable> + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Buildinfo/Overrides.pm b/lib/Lintian/Processable/Buildinfo/Overrides.pm new file mode 100644 index 0000000..136c01c --- /dev/null +++ b/lib/Lintian/Processable/Buildinfo/Overrides.pm @@ -0,0 +1,94 @@ +# -*- perl -*- Lintian::Processable::Buildinfo::Overrides +# +# Copyright (C) 2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Buildinfo::Overrides; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +with 'Lintian::Processable::Overrides'; + +=head1 NAME + +Lintian::Processable::Buildinfo::Overrides - access to override data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Buildinfo::Overrides provides an interface for overrides. + +=head1 INSTANCE METHODS + +=over 4 + +=item override_file + +=cut + +has override_file => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return undef; + } +); + +=item overrides + +=cut + +has overrides => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my @overrides; + + return \@overrides; + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Changelog/Version.pm b/lib/Lintian/Processable/Changelog/Version.pm new file mode 100644 index 0000000..7721b17 --- /dev/null +++ b/lib/Lintian/Processable/Changelog/Version.pm @@ -0,0 +1,108 @@ +# -*- perl -*- +# Lintian::Processable::Changelog::Version -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Changelog::Version; + +use v5.20; +use warnings; +use utf8; + +use Syntax::Keyword::Try; + +use Lintian::Changelog::Version; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Changelog::Version - Lintian interface to source package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Changelog::Version->new($name); + if ($collect->native) { + print "Package is native\n"; + } + +=head1 DESCRIPTION + +Lintian::Processable::Changelog::Version provides an interface to package data for source +packages. It implements data collection methods specific to source +packages. + +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 +data via collect scripts. The goal is to eventually access all data about +source packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item changelog_version + +Returns a fully parsed Lintian::Changelog::Version for the +source package's version string. + +=cut + +has changelog_version => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $versionstring = $self->fields->value('Version'); + + my $version = Lintian::Changelog::Version->new; + try { + $version->assign($versionstring, $self->native); + + } catch { + } + + return $version; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Changes.pm b/lib/Lintian/Processable/Changes.pm new file mode 100644 index 0000000..65eb8e4 --- /dev/null +++ b/lib/Lintian/Processable/Changes.pm @@ -0,0 +1,145 @@ +# Copyright (C) 2019-2020 Felix Lechner +# +# 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 https://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::Processable::Changes; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use Path::Tiny; +use Unicode::UTF8 qw(valid_utf8 decode_utf8 encode_utf8); + +use Lintian::Deb822; + +use Moo; +use namespace::clean; + +with + 'Lintian::Processable', + 'Lintian::Processable::Fields::Files', + 'Lintian::Processable::Changes::Overrides'; + +=for Pod::Coverage BUILDARGS + +=head1 NAME + +Lintian::Processable::Changes -- A changes file Lintian can process + +=head1 SYNOPSIS + + use Lintian::Processable::Changes; + + my $processable = Lintian::Processable::Changes->new; + $processable->init_from_file('path'); + +=head1 DESCRIPTION + +This class represents a 'changes' file that Lintian can process. Objects +of this kind are often part of a L<Lintian::Group>, which +represents all the files in a changes or buildinfo file. + +=head1 INSTANCE METHODS + +=over 4 + +=item init_from_file (PATH) + +Initializes a new object from PATH. + +=cut + +sub init_from_file { + my ($self, $file) = @_; + + croak encode_utf8("File $file does not exist") + unless -e $file; + + $self->path($file); + $self->type('changes'); + + # dpkg will include news items in national encoding + my $bytes = path($self->path)->slurp; + + my $contents; + if (valid_utf8($bytes)) { + $contents = decode_utf8($bytes); + } else { + # try to proceed with nat'l encoding; stopping here breaks tests + $contents = $bytes; + } + + my $primary = Lintian::Deb822->new; + my @sections = $primary->parse_string($contents) + or croak encode_utf8( + $self->path. ' is not a valid '. $self->type . ' file'); + + $self->fields($sections[0]); + + my $name = $self->fields->value('Source'); + my $version = $self->fields->value('Version'); + my $architecture = $self->fields->value('Architecture'); + + unless (length $name) { + $name = $self->guess_name($self->path); + croak encode_utf8('Cannot determine the name from ' . $self->path) + unless length $name; + } + + my $source_name = $name; + my $source_version = $version; + + $self->name($name); + $self->version($version); + $self->architecture($architecture); + $self->source_name($source_name); + $self->source_version($source_version); + + # make sure none of these fields can cause traversal + $self->tainted(1) + if $self->name ne $name + || $self->version ne $version + || $self->architecture ne $architecture + || $self->source_name ne $source_name + || $self->source_version ne $source_version; + + return; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +L<Lintian::Processable> + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Changes/Overrides.pm b/lib/Lintian/Processable/Changes/Overrides.pm new file mode 100644 index 0000000..78bd04d --- /dev/null +++ b/lib/Lintian/Processable/Changes/Overrides.pm @@ -0,0 +1,94 @@ +# -*- perl -*- Lintian::Processable::Changes::Overrides +# +# Copyright (C) 2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Changes::Overrides; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +with 'Lintian::Processable::Overrides'; + +=head1 NAME + +Lintian::Processable::Changes::Overrides - access to override data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Changes::Overrides provides an interface for overrides. + +=head1 INSTANCE METHODS + +=over 4 + +=item override_file + +=cut + +has override_file => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return undef; + } +); + +=item overrides + +=cut + +has overrides => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my @overrides; + + return \@overrides; + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Debian/Control.pm b/lib/Lintian/Processable/Debian/Control.pm new file mode 100644 index 0000000..a4c1cf9 --- /dev/null +++ b/lib/Lintian/Processable/Debian/Control.pm @@ -0,0 +1,90 @@ +# -*- perl -*- +# Lintian::Processable::Debian::Control -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Debian::Control; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Debian::Control; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Debian::Control - Lintian interface to d/control fields + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Debian::Control provides an interface to package data +from d/control. + +=head1 INSTANCE METHODS + +=over 4 + +=item debian_control + +=cut + +has debian_control => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $control = Lintian::Debian::Control->new; + + my $item = $self->patched->resolve_path('debian/control'); + return $control + unless defined $item; + + $control->load($item); + + return $control; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Diffstat.pm b/lib/Lintian/Processable/Diffstat.pm new file mode 100644 index 0000000..82a3b28 --- /dev/null +++ b/lib/Lintian/Processable/Diffstat.pm @@ -0,0 +1,162 @@ +# -*- perl -*- Lintian::Processable::Diffstat -- access to collected diffstat data +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2019-2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Diffstat; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use IPC::Run3; +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8 decode_utf8); + +use Moo::Role; +use namespace::clean; + +const my $COLON => q{:}; +const my $UNDERSCORE => q{_}; +const my $NEWLINE => qq{\n}; + +const my $OPEN_PIPE => q{-|}; +const my $WAIT_STATUS_SHIFT => 8; + +=head1 NAME + +Lintian::Processable::Diffstat - access to collected diffstat data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Diffstat provides an interface to diffstat data. + +=head1 INSTANCE METHODS + +=over 4 + +=item diffstat + +Returns the path to diffstat output run on the Debian packaging diff +(a.k.a. the "diff.gz") for 1.0 non-native packages. For source +packages without a "diff.gz" component, this returns the path to an +empty file (this may be a device like /dev/null). + +=cut + +has diffstat => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $noepoch = $self->fields->value('Version'); + + # strip epoch + $noepoch =~ s/^\d://; + + # look for a format 1.0 diff.gz near the input file + my $diffname = $self->name . $UNDERSCORE . $noepoch . '.diff.gz'; + return {} + unless exists $self->files->{$diffname}; + + my $diffpath = path($self->path)->parent->child($diffname)->stringify; + return {} + unless -e $diffpath; + + my @gunzip_command = ('gunzip', '--stdout', $diffpath); + my $gunzip_pid = open(my $from_gunzip, $OPEN_PIPE, @gunzip_command) + or die encode_utf8("Cannot run @gunzip_command: $!"); + + my $stdout; + my $stderr; + my @diffstat_command = qw(diffstat -p1); + run3(\@diffstat_command, $from_gunzip, \$stdout, \$stderr); + my $status = ($? >> $WAIT_STATUS_SHIFT); + + $stdout = decode_utf8($stdout) + if length $stdout; + $stderr = decode_utf8($stderr) + if length $stderr; + + if ($status) { + + my $message= "Non-zero status $status from @diffstat_command"; + $message .= $COLON . $NEWLINE . $stderr + if length $stderr; + + die encode_utf8($message); + } + + close $from_gunzip + or + warn encode_utf8("close failed for handle from @gunzip_command: $!"); + + waitpid($gunzip_pid, 0); + + # remove summary in last line + chomp $stdout; + $stdout =~ s/.*\Z//; + + my %diffstat; + + my @lines = split(/\n/, $stdout); + for my $line (@lines) { + + next + unless $line =~ s/\|\s*([^|]*)\s*$//; + + my $stats = $1; + my $file = $line; + + # trim both ends + $file =~ s/^\s+|\s+$//g; + + die encode_utf8("syntax error in diffstat file: $line") + unless length $file; + + $diffstat{$file} = $stats; + } + + return \%diffstat; + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Fields/Files.pm b/lib/Lintian/Processable/Fields/Files.pm new file mode 100644 index 0000000..df21352 --- /dev/null +++ b/lib/Lintian/Processable/Fields/Files.pm @@ -0,0 +1,181 @@ +# -*- perl -*- +# Lintian::Processable::Fields::Files -- interface to .buildinfo file data collection +# +# Copyright (C) 2010 Adam D. Barratt +# Copyright (C) 2018 Chris Lamb +# Copyright (C) 2019-2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Fields::Files; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Fields::Files - Lintian interface to .buildinfo or changes file data collection + +=head1 SYNOPSIS + + use Moo; + + with 'Lintian::Processable::Fields::Files'; + +=head1 DESCRIPTION + +Lintian::Processable::Fields::Files provides an interface to data for .buildinfo +and changes files. It implements data collection methods specific to .buildinfo +and changes files. + +=head1 INSTANCE METHODS + +=over 4 + +=item files + +Returns a reference to a hash containing information about files listed +in the .buildinfo 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 .buildinfo section relating to the given +checksum. + +=back + +=back + +=cut + +has files => ( + is => 'rw', + lazy => 1, + default => + + sub { + my ($self) = @_; + + my %files; + + my @files_lines = split(/\n/, $self->fields->value('Files')); + + # trim both ends of each line + s/^\s+|\s+$//g for @files_lines; + + for my $line (grep { length } @files_lines) { + + my @fields = split(/\s+/, $line); + my $basename = $fields[-1]; + + # ignore traversals + next + if $basename =~ m{/}; + + my ($md5sum, $size, $section, $priority) = @fields; + + $files{$basename}{checksums}{Md5} = { + 'sum' => $md5sum, + 'filesize' => $size, + }; + + $files{$basename}{name} = $basename; + $files{$basename}{size} = $size; + + unless ($self->type eq 'source') { + + $files{$basename}{section} = $section; + $files{$basename}{priority} = $priority; + } + } + + for my $algorithm (qw(Sha1 Sha256)) { + + my @lines + = split(/\n/, $self->fields->value("Checksums-$algorithm")); + + # trim both ends of each line + s/^\s+|\s+$//g for @lines; + + for my $line (grep { length } @lines) { + + my ($checksum, $size, $basename) = split(/\s+/, $line); + + # ignore traversals + next + if $basename =~ m{/}; + + $files{$basename}{checksums}{$algorithm} = { + 'sum' => $checksum, + 'filesize' => $size + }; + } + } + + return \%files; + } +); + +=back + +=head1 AUTHOR + +Originally written by Adam D. Barratt <adsb@debian.org> for Lintian. + +=head1 SEE ALSO + +lintian(1), L<Lintian::Processable> + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Hardening.pm b/lib/Lintian/Processable/Hardening.pm new file mode 100644 index 0000000..4bf24bd --- /dev/null +++ b/lib/Lintian/Processable/Hardening.pm @@ -0,0 +1,105 @@ +# -*- perl -*- Lintian::Processable::Hardening +# +# Copyright (C) 2019 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Hardening; + +use v5.20; +use warnings; +use utf8; + +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8); + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Hardening - access to collected hardening data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Hardening provides an interface to collected hardening data. + +=head1 INSTANCE METHODS + +=over 4 + +=item hardening_info + +Returns a hashref mapping a FILE to its hardening issues. + +NB: This is generally only useful for checks/binaries to emit the +hardening-no-* tags. + +=cut + +sub hardening_info { + my ($self) = @_; + + return $self->{hardening_info} + if exists $self->{hardening_info}; + + my $hardf = path($self->basedir)->child('hardening-info')->stringify; + + my %hardening_info; + + if (-e $hardf) { + open(my $idx, '<:utf8_strict', $hardf) + or die encode_utf8("Cannot open $hardf"); + + while (my $line = <$idx>) { + chomp($line); + + if ($line =~ m{^([^:]+):(?:\./)?(.*)$}) { + my ($tag, $file) = ($1, $2); + + push(@{$hardening_info{$file}}, $tag); + } + } + close($idx); + } + + $self->{hardening_info} = \%hardening_info; + + return $self->{hardening_info}; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable.pm b/lib/Lintian/Processable/Installable.pm new file mode 100644 index 0000000..54ae406 --- /dev/null +++ b/lib/Lintian/Processable/Installable.pm @@ -0,0 +1,201 @@ +# Copyright (C) 2019-2020 Felix Lechner +# +# 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 https://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::Processable::Installable; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use Const::Fast; +use IPC::Run3; +use Unicode::UTF8 qw(encode_utf8 decode_utf8 valid_utf8); + +use Lintian::Deb822; + +use Moo; +use namespace::clean; + +with + 'Lintian::Processable', + 'Lintian::Processable::Installable::Changelog', + 'Lintian::Processable::Installable::Class', + 'Lintian::Processable::Installable::Conffiles', + 'Lintian::Processable::Installable::Control', + 'Lintian::Processable::Installable::Installed', + 'Lintian::Processable::Installable::Overrides', + 'Lintian::Processable::Installable::Relation', + 'Lintian::Processable::IsNonFree', + 'Lintian::Processable::Hardening', + 'Lintian::Processable::NotJustDocs'; + +# read up to 40kB at a time. this happens to be 4096 "tar records" +# (with a block-size of 512 and a block factor of 20, which appear to +# be the defaults). when we do full reads and writes of READ_SIZE (the +# OS willing), the receiving end will never be with an incomplete +# record. +const my $TAR_RECORD_SIZE => 20 * 512; + +const my $COLON => q{:}; +const my $NEWLINE => qq{\n}; +const my $OPEN_PIPE => q{-|}; + +const my $WAIT_STATUS_SHIFT => 8; + +=for Pod::Coverage BUILDARGS + +=head1 NAME + +Lintian::Processable::Installable -- An installation package Lintian can process + +=head1 SYNOPSIS + + use Lintian::Processable::Installable; + + my $processable = Lintian::Processable::Installable->new; + $processable->init_from_file('path'); + +=head1 DESCRIPTION + +This class represents a 'deb' or 'udeb' file that Lintian can process. Objects +of this kind are often part of a L<Lintian::Group>, which +represents all the files in a changes or buildinfo file. + +=head1 INSTANCE METHODS + +=over 4 + +=item init_from_file (PATH) + +Initializes a new object from PATH. + +=cut + +sub init_from_file { + my ($self, $file) = @_; + + croak encode_utf8("File $file does not exist") + unless -e $file; + + $self->path($file); + + # get control.tar.gz; dpkg-deb -f $file is slow; use tar instead + my @dpkg_command = ('dpkg-deb', '--ctrl-tarfile', $self->path); + + my $dpkg_pid = open(my $from_dpkg, $OPEN_PIPE, @dpkg_command) + or die encode_utf8("Cannot run @dpkg_command: $!"); + + # would like to set buffer size to 4096 & $TAR_RECORD_SIZE + + # get binary control file + my $stdout_bytes; + my $stderr_bytes; + my @tar_command = qw{tar --wildcards -xO -f - *control}; + run3(\@tar_command, $from_dpkg, \$stdout_bytes, \$stderr_bytes); + my $status = ($? >> $WAIT_STATUS_SHIFT); + + if ($status) { + + my $message= "Non-zero status $status from @tar_command"; + $message .= $COLON . $NEWLINE . decode_utf8($stderr_bytes) + if length $stderr_bytes; + + croak encode_utf8($message); + } + + close $from_dpkg + or warn encode_utf8("close failed for handle from @dpkg_command: $!"); + + waitpid($dpkg_pid, 0); + + croak encode_utf8('Nationally encoded control data in ' . $self->path) + unless valid_utf8($stdout_bytes); + + my $stdout = decode_utf8($stdout_bytes); + + my $deb822 = Lintian::Deb822->new; + my @sections = $deb822->parse_string($stdout); + croak encode_utf8( + 'Not exactly one section with installable control data in ' + . $self->path) + unless @sections == 1; + + $self->fields($sections[0]); + + my $name = $self->fields->value('Package'); + my $version = $self->fields->value('Version'); + my $architecture = $self->fields->value('Architecture'); + my $source_name = $self->fields->value('Source'); + + my $source_version = $version; + + unless (length $name) { + $name = $self->guess_name($self->path); + croak encode_utf8('Cannot determine the name from ' . $self->path) + unless length $name; + } + + # source may be left out if same as $name + $source_name = $name + unless length $source_name; + + # source probably contains the version in parentheses + if ($source_name =~ m/(\S++)\s*\(([^\)]+)\)/){ + $source_name = $1; + $source_version = $2; + } + + $self->name($name); + $self->version($version); + $self->architecture($architecture); + $self->source_name($source_name); + $self->source_version($source_version); + + # make sure none of these fields can cause traversal + $self->tainted(1) + if $self->name ne $name + || $self->version ne $version + || $self->architecture ne $architecture + || $self->source_name ne $source_name + || $self->source_version ne $source_version; + + return; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +L<Lintian::Processable> + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Changelog.pm b/lib/Lintian/Processable/Installable/Changelog.pm new file mode 100644 index 0000000..c43a17b --- /dev/null +++ b/lib/Lintian/Processable/Installable/Changelog.pm @@ -0,0 +1,151 @@ +# -*- perl -*- Lintian::Processable::Installable::Changelog -- access to collected changelog data +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2019-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Changelog; + +use v5.20; +use warnings; +use utf8; + +use File::Copy qw(copy); +use List::SomeUtils qw(first_value); +use Path::Tiny; +use Unicode::UTF8 qw(valid_utf8 decode_utf8 encode_utf8); + +use Lintian::IPC::Run3 qw(safe_qx); + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Changelog - access to collected changelog data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Changelog provides an interface to changelog data. + +=head1 INSTANCE METHODS + +=over 4 + +=item changelog_item + +=cut + +has changelog_item => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my @candidate_names = ( + 'changelog.Debian.gz','changelog.Debian', + 'changelog.debian.gz','changelog.debian', + 'changelog.gz','changelog', + ); + + my $package_path = 'usr/share/doc/' . $self->name; + my @candidate_items = grep { defined } + map { $self->installed->lookup("$package_path/$_") }@candidate_names; + + # pick the first existing file + my $item + = first_value { $_->is_file || length $_->link } @candidate_items; + + return $item; + } +); + +=item changelog + +For binary: + +Returns the changelog of the binary package as a Parse::DebianChangelog +object, or an empty object if the changelog doesn't exist. The changelog-file +collection script must have been run to create the changelog file, which +this method expects to find in F<changelog>. + +=cut + +has changelog => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $changelog = Lintian::Changelog->new; + + my $unresolved = $self->changelog_item; + return $changelog + unless defined $unresolved; + + # stop for dangling symbolic link + my $item = $unresolved->resolve_path; + return $changelog + unless defined $item; + + # return empty changelog + return $changelog + unless $item->is_file && $item->is_open_ok; + + if ($item->basename =~ m{ [.]gz $}x) { + + my $bytes = safe_qx('gunzip', '-c', $item->unpacked_path); + + return $changelog + unless valid_utf8($bytes); + + $changelog->parse(decode_utf8($bytes)); + + return $changelog; + } + + return $changelog + unless $item->is_valid_utf8; + + $changelog->parse($item->decoded_utf8); + + return $changelog; + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Class.pm b/lib/Lintian/Processable/Installable/Class.pm new file mode 100644 index 0000000..00520be --- /dev/null +++ b/lib/Lintian/Processable/Installable/Class.pm @@ -0,0 +1,139 @@ +# -*- perl -*- +# Lintian::Processable::Installable::Class -- interface to binary package data collection + +# Copyright (C) 2008, 2009 Russ Allbery +# Copyright (C) 2008 Frank Lichtenheld +# Copyright (C) 2012 Kees Cook +# Copyright (C) 2020-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Class; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Class - Lintian interface to binary package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'binary', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Installable::Class->new($name); + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Class provides an interface to package data for binary +packages. + +=head1 INSTANCE METHODS + +=over 4 + +=item is_debug_package + +The package probably contains only debug symbols. + +=cut + +sub is_debug_package { + my ($self) = @_; + + return 1 + if $self->name =~ /-dbg(?:sym)?/; + + return 0; +} + +=item is_auto_generated + +The package was probably generated automatically. + +=cut + +sub is_auto_generated { + my ($self) = @_; + + return 1 + if $self->fields->declares('Auto-Built-Package'); + + return 0; +} + +=item is_transitional + +The package is probably transitional, i.e. it probably depends + on stuff will eventually disappear. + +=cut + +sub is_transitional { + my ($self) = @_; + + return 1 + if $self->fields->value('Description') =~ /transitional package/i; + + return 0; +} + +=item is_meta_package + +This package is probably some kind of meta or task package. A meta +package is usually empty and just depend on stuff. It also returns +a true value for "tasks" (i.e. tasksel "tasks"). + +=cut + +sub is_meta_package { + my ($self) = @_; + + return 1 + if $self->fields->value('Description') + =~ /meta[ -]?package|(?:dependency|dummy|empty) package/i; + + # section "tasks" or "metapackages" qualifies too + return 1 + if $self->fields->value('Section') =~ m{(?:^|/)(?:tasks|metapackages)$}; + + return 1 + if $self->name =~ /^task-/; + + return 0; +} + +=back + +=head1 AUTHOR + +Originally written by Frank Lichtenheld <djpig@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Conffiles.pm b/lib/Lintian/Processable/Installable/Conffiles.pm new file mode 100644 index 0000000..50db7f7 --- /dev/null +++ b/lib/Lintian/Processable/Installable/Conffiles.pm @@ -0,0 +1,97 @@ +# -*- perl -*- Lintian::Processable::Installable::Conffiles +# +# Copyright (C) 2019-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Conffiles; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Conffiles; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Conffiles - access to collected control data for conffiles + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Conffiles provides an interface to control data for conffiles. + +=head1 INSTANCE METHODS + +=over 4 + +=item conffiles_item + +=cut + +has conffiles_item => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return $self->control->resolve_path('conffiles'); + } +); + +=item declared_conffiles + +=cut + +has declared_conffiles => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $item = $self->conffiles_item; + + my $conffiles = Lintian::Conffiles->new; + $conffiles->parse($item, $self); + + return $conffiles; + } +); + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Control.pm b/lib/Lintian/Processable/Installable/Control.pm new file mode 100644 index 0000000..b6a72d8 --- /dev/null +++ b/lib/Lintian/Processable/Installable/Control.pm @@ -0,0 +1,99 @@ +# -*- perl -*- Lintian::Processable::Installable::Control +# +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Control; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(uniq); + +use Lintian::Index; + +const my $SLASH => q{/}; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Control - access to collected control file data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Control provides an interface to control file data. + +=head1 INSTANCE METHODS + +=over 4 + +=item control + +Returns the index for a binary control file. + +=cut + +has control => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (control)"); + $index->basedir($self->basedir . $SLASH . 'control'); + + # control files are not installed relative to the system root + # disallow absolute paths and symbolic links + + my @command = (qw(dpkg-deb --ctrl-tarfile), $self->path); + my $errors = $index->create_from_piped_tar(\@command); + + my @messages = uniq split(/\n/, $errors); + push(@{$index->unpack_messages}, @messages); + + return $index; + } +); + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Installed.pm b/lib/Lintian/Processable/Installable/Installed.pm new file mode 100644 index 0000000..61444ac --- /dev/null +++ b/lib/Lintian/Processable/Installable/Installed.pm @@ -0,0 +1,103 @@ +# -*- perl -*- Lintian::Processable::Installable::Installed +# +# Copyright (C) 2008, 2009 Russ Allbery +# Copyright (C) 2008 Frank Lichtenheld +# Copyright (C) 2012 Kees Cook +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Installed; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(uniq); + +use Lintian::Index; + +const my $SLASH => q{/}; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Installed - access to collected data about the upstream (orig) sources + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Installed provides an interface to collected data about the upstream (orig) sources. + +=head1 INSTANCE METHODS + +=over 4 + +=item installed + +Returns a index object representing installed files from a binary package. + +=cut + +has installed => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (installed)"); + $index->basedir($self->basedir . $SLASH . 'unpacked'); + + # binary packages are anchored to the system root + # allow absolute paths and symbolic links + $index->anchored(1); + + my @command = (qw(dpkg-deb --fsys-tarfile), $self->path); + my $errors = $index->create_from_piped_tar(\@command); + + my @messages = uniq split(/\n/, $errors); + push(@{$index->unpack_messages}, @messages); + + return $index; + } +); + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Overrides.pm b/lib/Lintian/Processable/Installable/Overrides.pm new file mode 100644 index 0000000..0da551f --- /dev/null +++ b/lib/Lintian/Processable/Installable/Overrides.pm @@ -0,0 +1,131 @@ +# -*- perl -*- Lintian::Processable::Installable::Overrides +# +# Copyright (C) 2019-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Overrides; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use PerlIO::gzip; +use List::SomeUtils qw(first_value); +use Unicode::UTF8 qw(valid_utf8 decode_utf8 encode_utf8); + +use Moo::Role; +use namespace::clean; + +with 'Lintian::Processable::Overrides'; + +const my $EMPTY => q{}; + +=head1 NAME + +Lintian::Processable::Installable::Overrides - access to override data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Overrides provides an interface for overrides. + +=head1 INSTANCE METHODS + +=over 4 + +=item override_file + +=cut + +has override_file => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $unzipped = 'usr/share/lintian/overrides/' . $self->name; + + my @candidates = map { $unzipped . $_ } ($EMPTY, '.gz'); + + # pick the first + my $override_item= first_value { defined } + map { $self->installed->lookup($_) } @candidates; + + return $override_item; + } +); + +=item overrides + +=cut + +has overrides => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return [] + unless defined $self->override_file; + + my $contents = $EMPTY; + + if ($self->override_file->name =~ m{ [.]gz $}x) { + + my $local_path = $self->override_file->unpacked_path; + + open(my $fd, '<:gzip', $local_path) + or die encode_utf8("Cannot open $local_path."); + + local $/ = undef; + my $bytes = <$fd>; + + $contents = decode_utf8($bytes) + if valid_utf8($bytes); + + close $fd; + + } else { + $contents = $self->override_file->decoded_utf8; + } + + return $self->parse_overrides($contents); + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Installable/Relation.pm b/lib/Lintian/Processable/Installable/Relation.pm new file mode 100644 index 0000000..ac94489 --- /dev/null +++ b/lib/Lintian/Processable/Installable/Relation.pm @@ -0,0 +1,154 @@ +# -*- perl -*- +# Lintian::Processable::Installable::Relation -- interface to binary package data collection + +# Copyright (C) 2008, 2009 Russ Allbery +# Copyright (C) 2008 Frank Lichtenheld +# Copyright (C) 2012 Kees Cook +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Installable::Relation; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Relation; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Relation - Lintian interface to binary package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'binary', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Installable::Relation->new($name); + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Relation provides an interface to package data for binary +packages. It implements data collection methods specific to binary +packages. + +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 +data via collect scripts. The goal is to eventually access all data about +binary packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +Native heuristics are only available in source packages. + +=head1 INSTANCE METHODS + +=over 4 + +=item relation (FIELD) + +Returns a L<Lintian::Relation> object for the specified FIELD, which should +be one of the possible relationship fields of a Debian package or one of +the following special values: + +=over 4 + +=item All + +The concatenation of Pre-Depends, Depends, Recommends, and Suggests. + +=item Strong + +The concatenation of Pre-Depends and Depends. + +=item Weak + +The concatenation of Recommends and Suggests. + +=back + +If FIELD isn't present in the package, the returned Lintian::Relation +object will be empty (always present and satisfies nothing). + +=item saved_relations + +=cut + +has saved_relations => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +my %alias = ( + all => [qw(Pre-Depends Depends Recommends Suggests)], + strong => [qw(Pre-Depends Depends)], + weak => [qw(Recommends Suggests)] +); + +my %known = map { $_ => 1 } + qw(pre-depends depends recommends suggests enhances breaks + conflicts provides replaces); + +sub relation { + my ($self, $name) = @_; + + my $lowercase = lc $name; + + my $relation = $self->saved_relations->{$lowercase}; + unless (defined $relation) { + + if (exists $alias{$lowercase}) { + $relation + = Lintian::Relation->new->logical_and(map { $self->relation($_) } + @{ $alias{$lowercase} }); + } else { + croak encode_utf8("unknown relation field $name") + unless $known{$lowercase}; + + my $value = $self->fields->value($name); + $relation = Lintian::Relation->new->load($value); + } + + $self->saved_relations->{$lowercase} = $relation; + } + + return $relation; +} + +=back + +=head1 AUTHOR + +Originally written by Frank Lichtenheld <djpig@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/IsNonFree.pm b/lib/Lintian/Processable/IsNonFree.pm new file mode 100644 index 0000000..bd6f246 --- /dev/null +++ b/lib/Lintian/Processable/IsNonFree.pm @@ -0,0 +1,109 @@ +# -*- perl -*- +# Lintian::Processable::IsNonFree -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::IsNonFree; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::IsNonFree - Lintian interface to source package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry'); + my $collect = Lintian::Processable::IsNonFree->new($name); + if ($collect->native) { + print encode_utf8("Package is native\n"); + } + +=head1 DESCRIPTION + +Lintian::Processable::IsNonFree provides an interface to package data for source +packages. It implements data collection methods specific to source +packages. + +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 +data via collect scripts. The goal is to eventually access all data about +source packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item is_non_free + +Returns a truth value if the package appears to be non-free (based on +the section field; "non-free/*" and "restricted/*") + +=cut + +has is_non_free => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $section; + + if ($self->type eq 'source') { + $section = $self->debian_control->source_fields->value('Section'); + } else { + $section = $self->fields->value('Section'); + } + + $section ||= 'main'; + + return 1 + if $section + =~ m{^(?:non-free|non-free-firmware|restricted|multiverse)/}; + + return 0; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/NotJustDocs.pm b/lib/Lintian/Processable/NotJustDocs.pm new file mode 100644 index 0000000..1e08760 --- /dev/null +++ b/lib/Lintian/Processable/NotJustDocs.pm @@ -0,0 +1,112 @@ +# -*- perl -*- +# Lintian::Processable::NotJustDocs + +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::NotJustDocs; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::NotJustDocs - Lintian interface to installable package data collection + +=head1 SYNOPSIS + + my $processable = Lintian::Processable::Installable->new; + + my $is_empty = $processable->not_just_docs; + +=head1 DESCRIPTION + +Lintian::Processable::NotJustDocs provides an interface to package data for installation +packages. + +=head1 INSTANCE METHODS + +=over 4 + +=item not_just_docs + +Returns a truth value if the package appears to be empty. + +=cut + +has not_just_docs => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $quoted_name = quotemeta($self->name); + + my $empty = 1; + for my $item (@{$self->installed->sorted_list}) { + + # ignore directories + next + if $item->is_dir; + + # skip /usr/share/doc/$name symlinks. + next + if $item->name eq 'usr/share/doc/' . $self->name; + + # only look outside /usr/share/doc/$name directory + next + if $item->name =~ m{^usr/share/doc/$quoted_name}; + + # except if it is a lintian override. + next + if $item->name =~ m{\A + # Except for: + usr/share/ (?: + # lintian overrides + lintian/overrides/$quoted_name(?:\.gz)? + # reportbug scripts/utilities + | bug/$quoted_name(?:/(?:control|presubj|script))? + )\Z}xsm; + + return 0; + } + + return 1; + } +); + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Overrides.pm b/lib/Lintian/Processable/Overrides.pm new file mode 100644 index 0000000..0de05a4 --- /dev/null +++ b/lib/Lintian/Processable/Overrides.pm @@ -0,0 +1,219 @@ +# -*- perl -*- Lintian::Processable::Overrides +# +# Copyright (C) 2019-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Overrides; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +use Lintian::Override; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Overrides - access to override data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Overrides provides an interface to overrides. + +=head1 INSTANCE METHODS + +=over 4 + +=item override_errors + +=cut + +has override_errors => (is => 'rw', default => sub { [] }); + +=item parse_overrides + +=cut + +sub parse_overrides { + my ($self, $contents) = @_; + + $contents //= $EMPTY; + + my @declared_overrides; + + my $justification = $EMPTY; + my $previous = Lintian::Override->new; + + my @lines = split(/\n/, $contents); + + my $position = 1; + for my $line (@lines) { + + my $remaining = $line; + + # trim both ends + $remaining =~ s/^\s+|\s+$//g; + + if ($remaining eq $EMPTY) { + # Throw away comments, as they are not attached to a tag + # also throw away the option of "carrying over" the last + # comment + $justification = $EMPTY; + $previous = Lintian::Override->new; + next; + } + + if ($remaining =~ s{^ [#] \s* }{}x) { + + if (length $remaining) { + + $justification .= $SPACE + if length $justification; + + $justification .= $remaining; + } + + next; + } + + # reduce white space + $remaining =~ s/\s+/ /g; + + # [[pkg-name] [arch-list] [pkg-type]:] <tag> [context] + my $require_colon = 0; + my @architectures; + + # strip package name, if present; require name + # parsing overrides is ambiguous (see #699628) + my $package = $self->name; + if ($remaining =~ s/^\Q$package\E(?=\s|:)//) { + + # both spaces or colon were unmatched lookhead + $remaining =~ s/^\s+//; + $require_colon = 1; + } + + # remove architecture list + if ($remaining =~ s{^ \[ ([^\]]*) \] (?=\s|:)}{}x) { + + my $list = $1; + + @architectures = split($SPACE, $list); + + # both spaces or colon were unmatched lookhead + $remaining =~ s/^\s+//; + $require_colon = 1; + } + + # remove package type + my $type = $self->type; + if ($remaining =~ s/^\Q$type\E(?=\s|:)//) { + + # both spaces or colon were unmatched lookhead + $remaining =~ s/^\s+//; + $require_colon = 1; + } + + my $pointer = $self->override_file->pointer($position); + + # require and remove colon when any package details are present + if ($require_colon && $remaining !~ s/^\s*:\s*//) { + + my %error; + $error{message} = 'Expected a colon'; + $error{pointer} = $pointer; + push(@{$self->override_errors}, \%error); + + next; + } + + my $hint_like = $remaining; + + my ($tag_name, $pattern) = split($SPACE, $hint_like, 2); + + if (!length $tag_name) { + + my %error; + $error{message} = "Cannot parse line: $line"; + $error{pointer} = $pointer; + push(@{$self->override_errors}, \%error); + + next; + } + + $pattern //= $EMPTY; + + # There are no new comments, no "empty line" in between and + # this tag is the same as the last, so we "carry over" the + # comment from the previous override (if any). + $justification = $previous->justification + if !length $justification + && $tag_name eq $previous->tag_name; + + my $current = Lintian::Override->new; + + $current->tag_name($tag_name); + $current->architectures(\@architectures); + $current->pattern($pattern); + $current->position($position); + + # combine successive white space + $justification =~ s{ \s+ }{ }gx; + + $current->justification($justification); + $justification = $EMPTY; + + push(@declared_overrides, $current); + + $previous = $current; + + } continue { + $position++; + } + + return \@declared_overrides; +} + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source.pm b/lib/Lintian/Processable/Source.pm new file mode 100644 index 0000000..e4dc001 --- /dev/null +++ b/lib/Lintian/Processable/Source.pm @@ -0,0 +1,142 @@ +# Copyright (C) 2019-2020 Felix Lechner +# +# 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 https://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::Processable::Source; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use File::Spec; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Deb822; + +use Moo; +use namespace::clean; + +with + 'Lintian::Processable', + 'Lintian::Processable::Diffstat', + 'Lintian::Processable::Changelog::Version', + 'Lintian::Processable::Debian::Control', + 'Lintian::Processable::Fields::Files', + 'Lintian::Processable::IsNonFree', + 'Lintian::Processable::Source::Changelog', + 'Lintian::Processable::Source::Components', + 'Lintian::Processable::Source::Format', + 'Lintian::Processable::Source::Orig', + 'Lintian::Processable::Source::Overrides', + 'Lintian::Processable::Source::Patched', + 'Lintian::Processable::Source::Relation', + 'Lintian::Processable::Source::Repacked'; + +=for Pod::Coverage BUILDARGS + +=head1 NAME + +Lintian::Processable::Source -- A dsc source package Lintian can process + +=head1 SYNOPSIS + + use Lintian::Processable::Source; + + my $processable = Lintian::Processable::Source->new; + $processable->init_from_file('path'); + +=head1 DESCRIPTION + +This class represents a 'dsc' file that Lintian can process. Objects +of this kind are often part of a L<Lintian::Group>, which +represents all the files in a changes or buildinfo file. + +=head1 INSTANCE METHODS + +=over 4 + +=item init_from_file (PATH) + +Initializes a new object from PATH. + +=cut + +sub init_from_file { + my ($self, $file) = @_; + + croak encode_utf8("File $file does not exist") + unless -e $file; + + $self->path($file); + $self->type('source'); + + my $primary = Lintian::Deb822->new; + my @sections = $primary->read_file($self->path) + or croak encode_utf8($self->path . ' is not valid dsc file'); + + $self->fields($sections[0]); + + my $name = $self->fields->value('Source'); + my $version = $self->fields->value('Version'); + my $architecture = 'source'; + + # it is its own source package + my $source_name = $name; + my $source_version = $version; + + croak encode_utf8($self->path . ' is missing Source field') + unless length $name; + + $self->name($name); + $self->version($version); + $self->architecture($architecture); + $self->source_name($source_name); + $self->source_version($source_version); + + # make sure none of these fields can cause traversal + $self->tainted(1) + if $self->name ne $name + || $self->version ne $version + || $self->architecture ne $architecture + || $self->source_name ne $source_name + || $self->source_version ne $source_version; + + return; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +L<Lintian::Processable> + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Changelog.pm b/lib/Lintian/Processable/Source/Changelog.pm new file mode 100644 index 0000000..a781057 --- /dev/null +++ b/lib/Lintian/Processable/Source/Changelog.pm @@ -0,0 +1,109 @@ +# -*- perl -*- Lintian::Processable::Source::Changelog -- access to collected changelog data +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2019-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Changelog; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Changelog - access to collected changelog data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Changelog provides an interface to changelog data. + +=head1 INSTANCE METHODS + +=over 4 + +=item changelog_item + +=cut + +has changelog_item => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $item = $self->patched->resolve_path('debian/changelog'); + + return $item; + } +); + +=item changelog + +Returns the changelog of the source package as a Parse::DebianChangelog +object, or an empty object if the changelog cannot be resolved safely. + +=cut + +has changelog => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $changelog = Lintian::Changelog->new; + + my $item = $self->changelog_item; + + # return empty changelog + return $changelog + unless defined $item && $item->is_open_ok; + + return $changelog + unless $item->is_valid_utf8; + + $changelog->parse($item->decoded_utf8); + + return $changelog; + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Components.pm b/lib/Lintian/Processable/Source/Components.pm new file mode 100644 index 0000000..1541abe --- /dev/null +++ b/lib/Lintian/Processable/Source/Components.pm @@ -0,0 +1,126 @@ +# -*- perl -*- +# Lintian::Processable::Source::Components -- interface to orig tag components +# +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Components; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo::Role; +use namespace::clean; + +const my $EMPTY => q{}; + +=head1 NAME + +Lintian::Processable::Source::Components - interface to orig tar components + +=head1 SYNOPSIS + + use Moo; + + with 'Lintian::Processable::Source::Components'; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Components provides an interface to data for +upstream source components. Most sources only use one tarball. + +=head1 INSTANCE METHODS + +=over 4 + +=item components + +Returns a reference to a hash containing information about source components +listed in the .dsc file. The key is the filename, and the value is the name +of the component. + +=cut + +has components => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + # determine source and version; handle missing fields + my $name = $self->fields->value('Source'); + my $version = $self->fields->value('Version'); + my $architecture = 'source'; + + # it is its own source package + my $source = $name; + my $source_version = $version; + + # version handling based on Dpkg::Version::parseversion. + my $noepoch = $source_version; + if ($noepoch =~ /:/) { + $noepoch =~ s/^(?:\d+):(.+)/$1/ + or die encode_utf8("Bad version number '$noepoch'"); + } + + my $baserev = $source . '_' . $noepoch; + + # strip debian revision + $noepoch =~ s/(.+)-(?:.*)$/$1/; + my $base = $source . '_' . $noepoch; + + my $files = $self->files; + + my %components; + for my $name (keys %{$files}) { + + # Look for $pkg_$version.orig(-$comp)?.tar.$ext (non-native) + # or $pkg_$version.tar.$ext (native) + # - This deliberately does not look for the debian packaging + # even when this would be a tarball. + if ($name + =~ /^(?:\Q$base\E\.orig(?:-(.*))?|\Q$baserev\E)\.tar\.(?:gz|bz2|lzma|xz)$/ + ) { + $components{$name} = $1 // $EMPTY; + } + } + + return \%components; + } +); + +=back + +=head1 AUTHOR + +Originally written by Adam D. Barratt <adsb@debian.org> for Lintian. + +=head1 SEE ALSO + +lintian(1), L<Lintian::Processable> + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Format.pm b/lib/Lintian/Processable/Source/Format.pm new file mode 100644 index 0000000..551f93e --- /dev/null +++ b/lib/Lintian/Processable/Source/Format.pm @@ -0,0 +1,136 @@ +# -*- perl -*- +# Lintian::Processable::Source::Format -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Format; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Path::Tiny; + +use Moo::Role; +use namespace::clean; + +const my $UNDERSCORE => q{_}; + +=head1 NAME + +Lintian::Processable::Source::Format - Lintian interface to source format + +=head1 SYNOPSIS + + my $collect = Lintian::Processable::Source::Format->new; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Format provides an interface to source format +information. + +=head1 INSTANCE METHODS + +=over 4 + +=item source_format + +=cut + +has source_format => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $format = $self->fields->value('Format') || '1.0'; + + return $format; + } +); + +=item native + +Returns true if the source package is native and false otherwise. +This is generally determined from the source format, though in the 1.0 +case the nativeness is determined by looking for the diff.gz (using +the name of the source package and its version). + +If the source format is 1.0 and the version number is absent, this +will return false (as native packages are a lot rarer than non-native +ones). + +Note if the source format is missing, it is assumed to be a 1.0 +package. + +=cut + +has native => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $format = $self->source_format; + + return 0 + if $format =~ /^\s*2\.0\s*$/; + + return 0 + if $format =~ /^\s*3\.0\s+\(quilt|git\)\s*$/; + + return 1 + if $format =~ /^\s*3\.0\s+\(native\)\s*$/; + + my $version = $self->fields->value('Version'); + return 0 + unless length $version; + + # strip epoch + $version =~ s/^\d+://; + + my $diffname = $self->name . $UNDERSCORE . "$version.diff.gz"; + + return 0 + if exists $self->files->{$diffname}; + + return 1; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1), Lintian::Relation(3) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Orig.pm b/lib/Lintian/Processable/Source/Orig.pm new file mode 100644 index 0000000..dd263f5 --- /dev/null +++ b/lib/Lintian/Processable/Source/Orig.pm @@ -0,0 +1,200 @@ +# -*- perl -*- Lintian::Processable::Source::Orig +# +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Orig; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(uniq); +use List::UtilsBy qw(sort_by); +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Index; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $SLASH => q{/}; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Orig - access to collected data about the upstream (orig) sources + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Orig provides an interface to collected data about the upstream (orig) sources. + +=head1 INSTANCE METHODS + +=over 4 + +=item orig + +Returns the index for orig.tar.gz. + +=cut + +my %DECOMPRESS_COMMAND = ( + 'gz' => 'gzip --decompress --stdout', + 'bz2' => 'bzip2 --decompress --stdout', + 'xz' => 'xz --decompress --stdout', +); + +has orig => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (orig)"); + $index->basedir($self->basedir . $SLASH . 'orig'); + + return $index + if $self->native; + + # source packages can be unpacked anywhere; no anchored roots + $index->anchored(0); + + my %components = %{$self->components}; + + # keep sort order; root is missing below otherwise + my @tarballs = sort_by { $components{$_} } keys %components; + + for my $tarball (@tarballs) { + + my $component = $components{$tarball}; + + # so far, all archives with components had an extra level + my $component_dir = $index->basedir; + $component_dir .= $SLASH . $component + if length $component; + + my $subindex = Lintian::Index->new; + $subindex->basedir($component_dir); + + # source packages can be unpacked anywhere; no anchored roots + $index->anchored(0); + + my ($extension) = ($tarball =~ /\.([^.]+)$/); + die encode_utf8("Source component $tarball has no file exension\n") + unless length $extension; + + my $decompress = $DECOMPRESS_COMMAND{lc $extension}; + die encode_utf8("Don't know how to decompress $tarball") + unless $decompress; + + my @command + = (split($SPACE, $decompress), + $self->basedir . $SLASH . $tarball); + + my $errors = $subindex->create_from_piped_tar(\@command); + + push(@{$index->unpack_messages}, "$tarball . $_") + for grep { !/^tar: Ignoring / } uniq split(/\n/, $errors); + + # treat hard links like regular files + my @hardlinks = grep { $_->is_hardlink } @{$subindex->sorted_list}; + for my $item (@hardlinks) { + + my $target = $subindex->lookup($item->link); + + $item->unpacked_path($target->unpacked_path); + $item->size($target->size); + $item->link($EMPTY); + + # turn into a regular file + my $perm = $item->perm; + $perm =~ s/^-/h/; + $item->perm($perm); + + $item->path_info( + ($item->path_info & ~Lintian::Index::Item::TYPE_HARDLINK) + | Lintian::Index::Item::TYPE_FILE); + } + + my @prefixes = @{$subindex->sorted_list}; + + # keep top level prefixes; no trailing slashes + s{^([^/]+).*$}{$1}s for @prefixes; + + # squash identical values; ignore root entry ('') + my @unique = grep { length } uniq @prefixes; + + # check for single common value + if (@unique == 1) { + + # no trailing slash for directories + my $common = $unique[0]; + + # proceed if no file with that name (lacks slash) + my $conflict = $subindex->lookup($common); + unless (defined $conflict) { + + if ($common ne $component || length $component) { + + # shortens paths; keeps same base directory + my $sub_errors = $subindex->drop_common_prefix; + + push(@{$index->unpack_errors}, "$tarball . $_") + for uniq split(/\n/, $sub_errors); + } + } + } + + # lowers base directory to match index being merged into + $subindex->capture_common_prefix + if length $component; + + $index->merge_in($subindex); + } + + return $index; + } +); + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Overrides.pm b/lib/Lintian/Processable/Source/Overrides.pm new file mode 100644 index 0000000..d4c446f --- /dev/null +++ b/lib/Lintian/Processable/Source/Overrides.pm @@ -0,0 +1,109 @@ +# -*- perl -*- Lintian::Processable::Source::Overrides +# +# Copyright (C) 2019-2021 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Overrides; + +use v5.20; +use warnings; +use utf8; + +use List::SomeUtils qw(first_value); + +use Moo::Role; +use namespace::clean; + +with 'Lintian::Processable::Overrides'; + +=head1 NAME + +Lintian::Processable::Source::Overrides - access to override data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Overrides provides an interface to overrides. + +=head1 INSTANCE METHODS + +=over 4 + +=item override_file + +=cut + +has override_file => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + # prefer source/lintian-overrides to source.lintian-overrides + my @candidates = ( + 'debian/source/lintian-overrides', + 'debian/source.lintian-overrides' + ); + + # pick the first + my $override_item= first_value { defined } + map { $self->patched->lookup($_) } @candidates; + + return $override_item; + } +); + +=item overrides + +=cut + +has overrides => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return [] + unless defined $self->override_file; + + my $contents = $self->override_file->decoded_utf8; + + return $self->parse_overrides($contents); + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Patched.pm b/lib/Lintian/Processable/Source/Patched.pm new file mode 100644 index 0000000..229311f --- /dev/null +++ b/lib/Lintian/Processable/Source/Patched.pm @@ -0,0 +1,161 @@ +# -*- perl -*- Lintian::Processable::Source::Patched +# +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Patched; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Cwd; +use List::SomeUtils qw(uniq); +use IPC::Run3; +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8 decode_utf8); + +use Lintian::Index; +use Lintian::Index::Item; + +const my $COLON => q{:}; +const my $SLASH => q{/}; +const my $NEWLINE => qq{\n}; + +const my $NO_UMASK => 0000; +const my $WAIT_STATUS_SHIFT => 8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Patched - access to sources with Debian patches applied + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Patched provides an interface to collected data about patched sources. + +=head1 INSTANCE METHODS + +=over 4 + +=item patched + +Returns a index object representing a patched source tree. + +=cut + +has patched => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (patched)"); + $index->basedir($self->basedir . $SLASH . 'unpacked'); + + # source packages can be unpacked anywhere; no anchored roots + $index->anchored(0); + + path($index->basedir)->remove_tree + if -d $index->basedir; + + print encode_utf8("N: Using dpkg-source to unpack\n") + if $ENV{'LINTIAN_DEBUG'}; + + my $saved_umask = umask; + umask $NO_UMASK; + + my @unpack_command= ( + qw(dpkg-source -q --no-check --extract), + $self->path, $index->basedir + ); + + # ignore STDOUT; older versions are not completely quiet with -q + my $unpack_errors; + + run3(\@unpack_command, \undef, \undef, \$unpack_errors); + my $status = ($? >> $WAIT_STATUS_SHIFT); + + $unpack_errors = decode_utf8($unpack_errors) + if length $unpack_errors; + + if ($status) { + my $message = "Non-zero status $status from @unpack_command"; + $message .= $COLON . $NEWLINE . $unpack_errors + if length $unpack_errors; + + die encode_utf8($message); + } + + umask $saved_umask; + + my $index_errors = $index->create_from_basedir; + + my $savedir = getcwd; + chdir($index->basedir) + or die encode_utf8('Cannot change to directory ' . $index->basedir); + + # fix permissions + my @permissions_command + = ('chmod', '-R', 'u+rwX,o+rX,o-w', $index->basedir); + my $permissions_errors; + + run3(\@permissions_command, \undef, \undef, \$permissions_errors); + + $permissions_errors = decode_utf8($permissions_errors) + if length $permissions_errors; + + chdir($savedir) + or die encode_utf8("Cannot change to directory $savedir"); + + my @messages = grep { !/^tar: Ignoring / } + split(/\n/, $unpack_errors . $index_errors . $permissions_errors); + push(@{$index->unpack_messages}, @messages); + + return $index; + } +); + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Relation.pm b/lib/Lintian/Processable/Source/Relation.pm new file mode 100644 index 0000000..e66297c --- /dev/null +++ b/lib/Lintian/Processable/Source/Relation.pm @@ -0,0 +1,267 @@ +# -*- perl -*- +# Lintian::Processable::Source::Relation -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Relation; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Relation; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Relation - Lintian interface to source package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Source::Relation->new($name); + if ($collect->native) { + print encode_utf8("Package is native\n"); + } + +=head1 DESCRIPTION + +Lintian::Processable::Source::Relation provides an interface to package data for source +packages. It implements data collection methods specific to source +packages. + +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 +data via collect scripts. The goal is to eventually access all data about +source packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item binary_relation (PACKAGE, FIELD) + +Returns a L<Lintian::Relation> object for the specified FIELD in the +binary package PACKAGE in the F<debian/control> file. FIELD should be +one of the possible relationship fields of a Debian package or one of +the following special values: + +=over 4 + +=item All + +The concatenation of Pre-Depends, Depends, Recommends, and Suggests. + +=item Strong + +The concatenation of Pre-Depends and Depends. + +=item Weak + +The concatenation of Recommends and Suggests. + +=back + +If FIELD isn't present in the package, the returned Lintian::Relation +object will be empty (present but satisfies nothing). + +Any substvars in F<debian/control> will be represented in the returned +relation as packages named after the substvar. + +=item saved_binary_relations + +=cut + +has saved_binary_relations => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +my %alias = ( + all => [qw(Pre-Depends Depends Recommends Suggests)], + strong => [qw(Pre-Depends Depends)], + weak => [qw(Recommends Suggests)] +); + +my %known = map { $_ => 1 } + qw(pre-depends depends recommends suggests enhances breaks + conflicts provides replaces); + +sub binary_relation { + my ($self, $package, $name) = @_; + + return undef + unless length $name; + + my $lowercase = lc $name; + + return undef + unless length $package; + + my $relation = $self->saved_binary_relations->{$package}{$lowercase}; + unless (defined $relation) { + + if (length $alias{$lowercase}) { + $relation + = Lintian::Relation->new->logical_and( + map { $self->binary_relation($package, $_) } + @{ $alias{$lowercase} }); + + } else { + croak encode_utf8("unknown relation field $name") + unless $known{$lowercase}; + + my $value + = $self->debian_control->installable_fields($package) + ->value($name); + $relation = Lintian::Relation->new->load($value); + } + + $self->saved_binary_relations->{$package}{$lowercase} = $relation; + } + + return $relation; +} + +=item relation (FIELD) + +Returns a L<Lintian::Relation> object for the given build relationship +field FIELD. In addition to the normal build relationship fields, the +following special field names are supported: + +=over 4 + +=item Build-Depends-All + +The concatenation of Build-Depends, Build-Depends-Arch and +Build-Depends-Indep. + +=item Build-Conflicts-All + +The concatenation of Build-Conflicts, Build-Conflicts-Arch and +Build-Conflicts-Indep. + +=back + +If FIELD isn't present in the package, the returned Lintian::Relation +object will be empty (present but satisfies nothing). + +=item saved_relation + +=cut + +has saved_relations => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +sub relation { + my ($self, $name) = @_; + + return undef + unless length $name; + + my $lowercase = lc $name; + + my $relation = $self->saved_relations->{$lowercase}; + unless (defined $relation) { + + if ($name =~ /^Build-(Depends|Conflicts)-All$/i) { + my $type = $1; + my @fields + = ("Build-$type", "Build-$type-Indep", "Build-$type-Arch"); + $relation + = Lintian::Relation->new->logical_and(map { $self->relation($_) } + @fields); + + } elsif ($name =~ /^Build-(Depends|Conflicts)(?:-(?:Arch|Indep))?$/i){ + my $value = $self->fields->value($name); + $relation = Lintian::Relation->new->load($value); + + } else { + croak encode_utf8("unknown relation field $name"); + } + + $self->saved_relations->{$lowercase} = $relation; + } + + return $relation; +} + +=item relation_norestriction (FIELD) + +The same as L</relation (FIELD)>, but ignores architecture +restrictions and build profile restrictions in the FIELD field. + +=item saved_relations_norestriction + +=cut + +has saved_relations_norestriction => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +sub relation_norestriction { + my ($self, $name) = @_; + + return undef + unless length $name; + + my $lowercase = lc $name; + + my $relation = $self->saved_relations_norestriction->{$lowercase}; + unless (defined $relation) { + + $relation = $self->relation($name)->restriction_less; + $self->saved_relations_norestriction->{$lowercase} = $relation; + } + + return $relation; +} + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Processable/Source/Repacked.pm b/lib/Lintian/Processable/Source/Repacked.pm new file mode 100644 index 0000000..4cf057b --- /dev/null +++ b/lib/Lintian/Processable/Source/Repacked.pm @@ -0,0 +1,99 @@ +# -*- perl -*- +# Lintian::Processable::Source::Repacked -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# Copyright (C) 2020 Felix Lechner +# +# 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 <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Repacked; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Util qw($PKGREPACK_REGEX); + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Repacked - Lintian interface to source package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Source::Repacked->new($name); + if ($collect->native) { + print encode_utf8("Package is native\n"); + } + +=head1 DESCRIPTION + +Lintian::Processable::Source::Repacked provides an interface to package data for source +packages. It implements data collection methods specific to source +packages. + +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 +data via collect scripts. The goal is to eventually access all data about +source packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item repacked + +Returns true if the source package has been "repacked" and false otherwise. +This is determined from the version name containing "dfsg" or similar. + +=cut + +has repacked => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $upstream = $self->changelog_version->upstream; + + return $upstream =~ $PKGREPACK_REGEX; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |