diff options
Diffstat (limited to 'lib/Lintian/Processable/Source/Patched.pm')
| -rw-r--r-- | lib/Lintian/Processable/Source/Patched.pm | 161 |
1 files changed, 161 insertions, 0 deletions
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 |