shell bypass 403
UnknownSec Shell
:
/
usr
/
share
/
perl5
/
Dpkg
/
Source
/ [
drwxr-xr-x
]
upload
mass deface
mass delete
console
info server
name :
Package.pm
# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org> # Copyright © 2008-2019 Guillem Jover <guillem@debian.org> # # 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 <https://www.gnu.org/licenses/>. =encoding utf8 =head1 NAME Dpkg::Source::Package - manipulate Debian source packages =head1 DESCRIPTION This module provides a class that can manipulate Debian source packages. While it supports both the extraction and the creation of source packages, the only API that is officially supported is the one that supports the extraction of the source package. =cut package Dpkg::Source::Package 2.02; use strict; use warnings; our @EXPORT_OK = qw( get_default_diff_ignore_regex set_default_diff_ignore_regex get_default_tar_ignore_pattern ); use Exporter qw(import); use POSIX qw(:errno_h :sys_wait_h); use Carp; use File::Temp; use File::Copy qw(cp); use File::Basename; use File::Spec; use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Control; use Dpkg::Checksums; use Dpkg::Version; use Dpkg::Compression; use Dpkg::Path qw(check_files_are_the_same check_directory_traversal); use Dpkg::Vendor qw(run_vendor_hook); use Dpkg::Source::Format; use Dpkg::OpenPGP; use Dpkg::OpenPGP::ErrorCodes; my $diff_ignore_default_regex = ' # Ignore general backup files (?:^|/).*~$| # Ignore emacs recovery files (?:^|/)\.#.*$| # Ignore vi swap files (?:^|/)\..*\.sw.$| # Ignore baz-style junk files or directories (?:^|/),,.*(?:$|/.*$)| # File-names that should be ignored (never directories) (?:^|/)(?:DEADJOE|\.arch-inventory|\.(?:bzr|cvs|hg|git|mtn-)ignore)$| # File or directory names that should be ignored (?:^|/)(?:CVS|RCS|\.deps|\{arch\}|\.arch-ids|\.svn| \.hg(?:tags|sigs)?|_darcs|\.git(?:attributes|modules|review)?| \.mailmap|\.shelf|_MTN|\.be|\.bzr(?:\.backup|tags)?)(?:$|/.*$) '; # Take out comments and newlines $diff_ignore_default_regex =~ s/^#.*$//mg; $diff_ignore_default_regex =~ s/\n//sg; no warnings 'qw'; ## no critic (TestingAndDebugging::ProhibitNoWarnings) my @tar_ignore_default_pattern = qw( *.a *.la *.o *.so .*.sw? */*~ ,,* .[#~]* .arch-ids .arch-inventory .be .bzr .bzr.backup .bzr.tags .bzrignore .cvsignore .deps .git .gitattributes .gitignore .gitmodules .gitreview .hg .hgignore .hgsigs .hgtags .mailmap .mtn-ignore .shelf .svn CVS DEADJOE RCS _MTN _darcs {arch} ); ## use critic =head1 FUNCTIONS =over 4 =item $string = get_default_diff_ignore_regex() Returns the default diff ignore regex. =cut sub get_default_diff_ignore_regex { return $diff_ignore_default_regex; } =item set_default_diff_ignore_regex($string) Set a regex as the new default diff ignore regex. =cut sub set_default_diff_ignore_regex { my $regex = shift; $diff_ignore_default_regex = $regex; } =item @array = get_default_tar_ignore_pattern() Returns the default tar ignore pattern, as an array. =cut sub get_default_tar_ignore_pattern { return @tar_ignore_default_pattern; } =back =head1 METHODS =over 4 =item $p = Dpkg::Source::Package->new(%opts, options => {}) Creates a new object corresponding to a source package. When the key B<filename> is set to a F<.dsc> file, it will be used to initialize the source package with its description. Otherwise if the B<format> key is set to a valid value, the object will be initialized for that format (since dpkg 1.19.3). The B<options> key is a hash ref which supports the following options: =over 8 =item skip_debianization If set to 1, do not apply Debian changes on the extracted source package. =item skip_patches If set to 1, do not apply Debian-specific patches. This options is specific for source packages using format "2.0" and "3.0 (quilt)". =item require_valid_signature If set to 1, the check_signature() method will be stricter and will error out if the signature can't be verified. =item require_strong_checksums If set to 1, the check_checksums() method will be stricter and will error out if there is no strong checksum. =item copy_orig_tarballs If set to 1, the extraction will copy the upstream tarballs next the target directory. This is useful if you want to be able to rebuild the source package after its extraction. =back =cut # Class methods sub new { my ($this, %args) = @_; my $class = ref($this) || $this; my $self = { fields => Dpkg::Control->new(type => CTRL_DSC), format => Dpkg::Source::Format->new(), options => {}, checksums => Dpkg::Checksums->new(), openpgp => Dpkg::OpenPGP->new(needs => { api => 'verify' }), }; bless $self, $class; if (exists $args{options}) { $self->{options} = $args{options}; } if (exists $args{filename}) { $self->initialize($args{filename}); $self->init_options(); } elsif ($args{format}) { $self->{fields}{Format} = $args{format}; $self->upgrade_object_type(0); $self->init_options(); } if ($self->{options}{require_valid_signature}) { $self->{report_verify} = \&error; } else { $self->{report_verify} = \&warning; } return $self; } sub init_options { my $self = shift; # Use full ignore list by default # note: this function is not called by V1 packages $self->{options}{diff_ignore_regex} ||= $diff_ignore_default_regex; $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/source/local-.*$'; $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/files(?:\.new)?$'; if (defined $self->{options}{tar_ignore}) { $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ] unless @{$self->{options}{tar_ignore}}; } else { $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ]; } push @{$self->{options}{tar_ignore}}, 'debian/source/local-options', 'debian/source/local-patch-header', 'debian/files', 'debian/files.new'; $self->{options}{copy_orig_tarballs} //= 0; # Skip debianization while specific to some formats has an impact # on code common to all formats $self->{options}{skip_debianization} //= 0; $self->{options}{skip_patches} //= 0; # Set default validation checks. $self->{options}{require_valid_signature} //= 0; $self->{options}{require_strong_checksums} //= 0; # Set default compressor for new formats. $self->{options}{compression} //= 'xz'; $self->{options}{comp_level} //= compression_get_level($self->{options}{compression}); $self->{options}{comp_ext} //= compression_get_file_extension($self->{options}{compression}); } sub initialize { my ($self, $filename) = @_; my ($fn, $dir) = fileparse($filename); error(g_('%s is not the name of a file'), $filename) unless $fn; $self->{basedir} = $dir || './'; $self->{filename} = $fn; # Read the fields my $fields = $self->{fields}; $fields->load($filename); $self->{is_signed} = $fields->get_option('is_pgp_signed'); foreach my $f (qw(Source Version Files)) { unless (defined($fields->{$f})) { error(g_('missing critical source control field %s'), $f); } } $self->{checksums}->add_from_control($fields, use_files_for_md5 => 1); $self->upgrade_object_type(0); } sub upgrade_object_type { my ($self, $update_format) = @_; $update_format //= 1; my $format = $self->{fields}{'Format'} // '1.0'; my ($major, $minor, $variant) = $self->{format}->set($format); my $module = "Dpkg::Source::Package::V$major"; $module .= '::' . ucfirst $variant if defined $variant; eval qq{ require $module; \$minor = \$${module}::CURRENT_MINOR_VERSION; }; if ($@) { error(g_("source package format '%s' is not supported: %s"), $format, $@); } if ($update_format) { $self->{format}->set_from_parts($major, $minor, $variant); $self->{fields}{'Format'} = $self->{format}->get(); } $module->prerequisites() if $module->can('prerequisites'); bless $self, $module; } =item $p->get_filename() Returns the filename of the DSC file. =cut sub get_filename { my $self = shift; return File::Spec->catfile($self->{basedir}, $self->{filename}); } =item $p->get_files() Returns the list of files referenced by the source package. The filenames usually do not have any path information. =cut sub get_files { my $self = shift; return $self->{checksums}->get_files(); } =item $p->check_checksums() Verify the checksums embedded in the DSC file. It requires the presence of the other files constituting the source package. If any inconsistency is discovered, it immediately errors out. It will make sure at least one strong checksum is present. If the object has been created with the "require_strong_checksums" option, then any problem will result in a fatal error. =cut sub check_checksums { my $self = shift; my $checksums = $self->{checksums}; my $warn_on_weak = 0; # add_from_file verify the checksums if they are already existing foreach my $file ($checksums->get_files()) { if (not $checksums->has_strong_checksums($file)) { if ($self->{options}{require_strong_checksums}) { error(g_('source package uses only weak checksums')); } else { $warn_on_weak = 1; } } my $pathname = File::Spec->catfile($self->{basedir}, $file); $checksums->add_from_file($pathname, key => $file); } warning(g_('source package uses only weak checksums')) if $warn_on_weak; } sub get_basename { my ($self, $with_revision) = @_; my $f = $self->{fields}; unless (exists $f->{'Source'} and exists $f->{'Version'}) { error(g_('%s and %s fields are required to compute the source basename'), 'Source', 'Version'); } my $v = Dpkg::Version->new($f->{'Version'}); my $vs = $v->as_string(omit_epoch => 1, omit_revision => !$with_revision); return $f->{'Source'} . '_' . $vs; } sub find_original_tarballs { my ($self, %opts) = @_; $opts{extension} //= compression_get_file_extension_regex(); $opts{include_main} //= 1; $opts{include_supplementary} //= 1; my $basename = $self->get_basename(); my @tar; foreach my $dir ('.', $self->{basedir}, $self->{options}{origtardir}) { next unless defined($dir) and -d $dir; opendir(my $dir_dh, $dir) or syserr(g_('cannot opendir %s'), $dir); push @tar, map { File::Spec->catfile($dir, $_) } grep { ($opts{include_main} and /^\Q$basename\E\.orig\.tar\.$opts{extension}$/) or ($opts{include_supplementary} and /^\Q$basename\E\.orig-[[:alnum:]-]+\.tar\.$opts{extension}$/) } readdir($dir_dh); closedir($dir_dh); } return @tar; } =item $p->get_upstream_signing_key($dir) Get the filename for the upstream key. =cut sub get_upstream_signing_key { my ($self, $dir) = @_; return "$dir/debian/upstream/signing-key.asc"; } =item $p->armor_original_tarball_signature($bin, $asc) Convert a signature from binary to ASCII armored form. If the signature file does not exist, it is a no-op. If the signature file is already ASCII armored then simply copy it, otherwise convert it from binary to ASCII armored form. =cut sub armor_original_tarball_signature { my ($self, $bin, $asc) = @_; if (-e $bin) { return $self->{openpgp}->armor('SIGNATURE', $bin, $asc); } return; } =item $p->check_original_tarball_signature($dir, @asc) Verify the original upstream tarball signatures @asc using the upstream public keys. It requires the origin upstream tarballs, their signatures and the upstream signing key, as found in an unpacked source tree $dir. If any inconsistency is discovered, it immediately errors out. =cut sub check_original_tarball_signature { my ($self, $dir, @asc) = @_; my $upstream_key = $self->get_upstream_signing_key($dir); if (not -e $upstream_key) { warning(g_('upstream tarball signatures but no upstream signing key')); return; } foreach my $asc (@asc) { my $datafile = $asc =~ s/\.asc$//r; info(g_('verifying %s'), $asc); my $rc = $self->{openpgp}->verify($datafile, $asc, $upstream_key); if ($rc) { $self->{report_verify}->(g_('cannot verify upstream tarball signature for %s: %s'), $datafile, openpgp_errorcode_to_string($rc)); } } } =item $bool = $p->is_signed() Returns 1 if the DSC files contains an embedded OpenPGP signature. Otherwise returns 0. =cut sub is_signed { my $self = shift; return $self->{is_signed}; } =item $p->check_signature() Implement the same OpenPGP signature check that dpkg-source does. In case of problems, it prints a warning or errors out. If the object has been created with the "require_valid_signature" option, then any problem will result in a fatal error. =cut sub check_signature { my $self = shift; my $dsc = $self->get_filename(); my @certs; push @certs, $self->{openpgp}->get_trusted_keyrings(); foreach my $vendor_keyring (run_vendor_hook('package-keyrings')) { if (-r $vendor_keyring) { push @certs, $vendor_keyring; } } my $rc = $self->{openpgp}->inline_verify($dsc, undef, @certs); if ($rc) { $self->{report_verify}->(g_('cannot verify inline signature for %s: %s'), $dsc, openpgp_errorcode_to_string($rc)); } } sub describe_cmdline_options { return; } sub parse_cmdline_options { my ($self, @opts) = @_; foreach my $option (@opts) { if (not $self->parse_cmdline_option($option)) { warning(g_('%s is not a valid option for %s'), $option, ref $self); } } } sub parse_cmdline_option { return 0; } =item $p->extract($targetdir) Extracts the source package in the target directory $targetdir. Beware that if $targetdir already exists, it will be erased (as long as the no_overwrite_dir option is set). =cut sub extract { my ($self, $newdirectory) = @_; my ($ok, $error) = version_check($self->{fields}{'Version'}); if (not $ok) { if ($self->{options}{ignore_bad_version}) { warning($error); } else { error($error); } } # Copy orig tarballs if ($self->{options}{copy_orig_tarballs}) { my $basename = $self->get_basename(); my ($dirname, $destdir) = fileparse($newdirectory); $destdir ||= './'; my $ext = compression_get_file_extension_regex(); foreach my $orig (grep { /^\Q$basename\E\.orig(-[[:alnum:]-]+)?\.tar\.$ext$/ } $self->get_files()) { my $src = File::Spec->catfile($self->{basedir}, $orig); my $dst = File::Spec->catfile($destdir, $orig); if (not check_files_are_the_same($src, $dst, 1)) { cp($src, $dst) or syserr(g_('cannot copy %s to %s'), $src, $dst); } } } # Try extract $self->do_extract($newdirectory); # Check for directory traversals. if (not $self->{options}{skip_debianization} and not $self->{no_check}) { # We need to add a trailing slash to handle the debian directory # possibly being a symlink. check_directory_traversal($newdirectory, "$newdirectory/debian/"); } # Store format if non-standard so that next build keeps the same format if ($self->{fields}{'Format'} and $self->{fields}{'Format'} ne '1.0' and not $self->{options}{skip_debianization}) { my $srcdir = File::Spec->catdir($newdirectory, 'debian', 'source'); my $format_file = File::Spec->catfile($srcdir, 'format'); unless (-e $format_file) { mkdir($srcdir) unless -e $srcdir; $self->{format}->save($format_file); } } # Make sure debian/rules is executable my $rules = File::Spec->catfile($newdirectory, 'debian', 'rules'); my @s = lstat($rules); if (not scalar(@s)) { unless ($! == ENOENT) { syserr(g_('cannot stat %s'), $rules); } warning(g_('%s does not exist'), $rules) unless $self->{options}{skip_debianization}; } elsif (-f _) { chmod($s[2] | 0111, $rules) or syserr(g_('cannot make %s executable'), $rules); } else { warning(g_('%s is not a plain file'), $rules); } } sub do_extract { croak 'Dpkg::Source::Package does not know how to unpack a ' . 'source package; use one of the subclasses'; } # Function used specifically during creation of a source package sub before_build { my ($self, $dir) = @_; } sub build { my ($self, @args) = @_; $self->do_build(@args); } sub after_build { my ($self, $dir) = @_; } sub do_build { croak 'Dpkg::Source::Package does not know how to build a ' . 'source package; use one of the subclasses'; } sub can_build { my ($self, $dir) = @_; return (0, 'can_build() has not been overridden'); } sub add_file { my ($self, $filename) = @_; my ($fn, $dir) = fileparse($filename); if ($self->{checksums}->has_file($fn)) { croak "tried to add file '$fn' twice"; } $self->{checksums}->add_from_file($filename, key => $fn); $self->{checksums}->export_to_control($self->{fields}, use_files_for_md5 => 1); } sub commit { my ($self, @args) = @_; $self->do_commit(@args); } sub do_commit { my ($self, $dir) = @_; info(g_("'%s' is not supported by the source format '%s'"), 'dpkg-source --commit', $self->{fields}{'Format'}); } sub write_dsc { my ($self, %opts) = @_; my $fields = $self->{fields}; foreach my $f (keys %{$opts{override}}) { $fields->{$f} = $opts{override}{$f}; } unless ($opts{nocheck}) { foreach my $f (qw(Source Version Architecture)) { unless (defined($fields->{$f})) { error(g_('missing information for critical output field %s'), $f); } } foreach my $f (qw(Maintainer Standards-Version)) { unless (defined($fields->{$f})) { warning(g_('missing information for output field %s'), $f); } } } foreach my $f (keys %{$opts{remove}}) { delete $fields->{$f}; } my $filename = $opts{filename}; $filename //= $self->get_basename(1) . '.dsc'; open(my $dsc_fh, '>', $filename) or syserr(g_('cannot write %s'), $filename); $fields->apply_substvars($opts{substvars}); $fields->output($dsc_fh); close($dsc_fh); } =back =head1 CHANGES =head2 Version 2.02 (dpkg 1.21.10) New method: armor_original_tarball_signature(). =head2 Version 2.01 (dpkg 1.20.1) New method: get_upstream_signing_key(). =head2 Version 2.00 (dpkg 1.20.0) New method: check_original_tarball_signature(). Remove variable: $diff_ignore_default_regexp. Hide variable: @tar_ignore_default_pattern. =head2 Version 1.03 (dpkg 1.19.3) New option: format in new(). =head2 Version 1.02 (dpkg 1.18.7) New option: require_strong_checksums in check_checksums(). =head2 Version 1.01 (dpkg 1.17.2) New functions: get_default_diff_ignore_regex(), set_default_diff_ignore_regex(), get_default_tar_ignore_pattern() Deprecated variables: $diff_ignore_default_regexp, @tar_ignore_default_pattern =head2 Version 1.00 (dpkg 1.16.1) Mark the module as public. =cut 1;
© 2026 UnknownSec