summaryrefslogtreecommitdiff
path: root/scripts/Dpkg/Source/Package.pm
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/Dpkg/Source/Package.pm')
-rw-r--r--scripts/Dpkg/Source/Package.pm214
1 files changed, 99 insertions, 115 deletions
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
index f7851d203..337000cb8 100644
--- a/scripts/Dpkg/Source/Package.pm
+++ b/scripts/Dpkg/Source/Package.pm
@@ -1,5 +1,5 @@
# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
-# Copyright © 2008-2015 Guillem Jover <guillem@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
@@ -24,7 +24,7 @@ Dpkg::Source::Package - manipulate Debian source packages
=head1 DESCRIPTION
-This module provides an object that can manipulate Debian source
+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.
@@ -34,7 +34,7 @@ is the one that supports the extraction of the source package.
use strict;
use warnings;
-our $VERSION = '1.02';
+our $VERSION = '2.00';
our @EXPORT_OK = qw(
get_default_diff_ignore_regex
set_default_diff_ignore_regex
@@ -44,6 +44,8 @@ our @EXPORT_OK = qw(
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 Dpkg::Gettext;
@@ -52,10 +54,11 @@ use Dpkg::Control;
use Dpkg::Checksums;
use Dpkg::Version;
use Dpkg::Compression;
-use Dpkg::Exit qw(run_exit_handlers);
use Dpkg::Path qw(check_files_are_the_same find_command);
use Dpkg::IPC;
use Dpkg::Vendor qw(run_vendor_hook);
+use Dpkg::Source::Format;
+use Dpkg::OpenPGP;
my $diff_ignore_default_regex = '
# Ignore general backup files
@@ -77,14 +80,8 @@ my $diff_ignore_default_regex = '
$diff_ignore_default_regex =~ s/^#.*$//mg;
$diff_ignore_default_regex =~ s/\n//sg;
-# Public variables
-# XXX: Backwards compatibility, stop exporting on VERSION 2.00.
-## no critic (Variables::ProhibitPackageVars)
-our $diff_ignore_default_regexp;
-*diff_ignore_default_regexp = \$diff_ignore_default_regex;
-
no warnings 'qw'; ## no critic (TestingAndDebugging::ProhibitNoWarnings)
-our @tar_ignore_default_pattern = qw(
+my @tar_ignore_default_pattern = qw(
*.a
*.la
*.o
@@ -166,12 +163,15 @@ sub get_default_tar_ignore_pattern {
=over 4
-=item $p = Dpkg::Source::Package->new(filename => $dscfile, options => {})
+=item $p = Dpkg::Source::Package->new(%opts, options => {})
-Creates a new object corresponding to the source package described
-by the file $dscfile.
+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 options hash supports the following options:
+The B<options> key is a hash ref which supports the following options:
=over 8
@@ -204,12 +204,13 @@ source package after its extraction.
=cut
-# Object methods
+# Class methods
sub new {
my ($this, %args) = @_;
my $class = ref($this) || $this;
my $self = {
fields => Dpkg::Control->new(type => CTRL_PKG_SRC),
+ format => Dpkg::Source::Format->new(),
options => {},
checksums => Dpkg::Checksums->new(),
};
@@ -220,6 +221,10 @@ sub new {
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();
}
return $self;
}
@@ -262,9 +267,8 @@ sub initialize {
$self->{filename} = $fn;
# Read the fields
- my $fields = Dpkg::Control->new(type => CTRL_PKG_SRC);
+ my $fields = $self->{fields};
$fields->load($filename);
- $self->{fields} = $fields;
$self->{is_signed} = $fields->get_option('is_pgp_signed');
foreach my $f (qw(Source Version Files)) {
@@ -281,41 +285,28 @@ sub initialize {
sub upgrade_object_type {
my ($self, $update_format) = @_;
$update_format //= 1;
- $self->{fields}{'Format'} //= '1.0';
- my $format = $self->{fields}{'Format'};
- if ($format =~ /^([\d\.]+)(?:\s+\((.*)\))?$/) {
- my ($version, $variant) = ($1, $2);
+ my $format = $self->{fields}{'Format'} // '1.0';
+ my ($major, $minor, $variant) = $self->{format}->set($format);
- if (defined $variant and $variant ne lc $variant) {
- error(g_("source package format '%s' is not supported: %s"),
- $format, g_('format variant must be in lowercase'));
- }
-
- my $major = $version =~ s/\.[\d\.]+$//r;
- my $minor;
-
- my $module = "Dpkg::Source::Package::V$major";
- $module .= '::' . ucfirst $variant if defined $variant;
- eval qq{
- pop \@INC if \$INC[-1] eq '.';
- require $module;
- \$minor = \$${module}::CURRENT_MINOR_VERSION;
- };
- $minor //= 0;
- if ($update_format) {
- $self->{fields}{'Format'} = "$major.$minor";
- $self->{fields}{'Format'} .= " ($variant)" if defined $variant;
- }
- if ($@) {
- error(g_("source package format '%s' is not supported: %s"),
- $format, $@);
- }
- $module->prerequisites() if $module->can('prerequisites');
- bless $self, $module;
- } else {
- error(g_("invalid Format field '%s'"), $format);
+ my $module = "Dpkg::Source::Package::V$major";
+ $module .= '::' . ucfirst $variant if defined $variant;
+ eval qq{
+ pop \@INC if \$INC[-1] eq '.';
+ 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()
@@ -406,6 +397,33 @@ sub find_original_tarballs {
return @tar;
}
+=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 = "$dir/debian/upstream/signing-key.asc";
+ if (not -e $upstream_key) {
+ warning(g_('upstream tarball signatures but no upstream signing key'));
+ return;
+ }
+
+ my $keyring = File::Temp->new(UNLINK => 1, SUFFIX => '.gpg');
+ Dpkg::OpenPGP::import_key($upstream_key, keyring => $keyring);
+ foreach my $asc (@asc) {
+ Dpkg::OpenPGP::verify_signature($asc,
+ datafile => $asc =~ s/\.asc$//r,
+ keyrings => [ $keyring ]);
+ }
+}
+
=item $bool = $p->is_signed()
Returns 1 if the DSC files contains an embedded OpenPGP signature.
@@ -431,52 +449,18 @@ then any problem will result in a fatal error.
sub check_signature {
my $self = shift;
my $dsc = $self->get_filename();
- my @exec;
-
- if (find_command('gpgv2')) {
- push @exec, 'gpgv2';
- } elsif (find_command('gpgv')) {
- push @exec, 'gpgv';
- } elsif (find_command('gpg2')) {
- push @exec, 'gpg2', '--no-default-keyring', '-q', '--verify';
- } elsif (find_command('gpg')) {
- push @exec, 'gpg', '--no-default-keyring', '-q', '--verify';
+ my @keyrings;
+
+ if (length $ENV{HOME} and -r "$ENV{HOME}/.gnupg/trustedkeys.gpg") {
+ push @keyrings, "$ENV{HOME}/.gnupg/trustedkeys.gpg";
}
- if (scalar(@exec)) {
- if (length $ENV{HOME} and -r "$ENV{HOME}/.gnupg/trustedkeys.gpg") {
- push @exec, '--keyring', "$ENV{HOME}/.gnupg/trustedkeys.gpg";
- }
- foreach my $vendor_keyring (run_vendor_hook('package-keyrings')) {
- if (-r $vendor_keyring) {
- push @exec, '--keyring', $vendor_keyring;
- }
- }
- push @exec, $dsc;
-
- my ($stdout, $stderr);
- spawn(exec => \@exec, wait_child => 1, nocheck => 1,
- to_string => \$stdout, error_to_string => \$stderr,
- timeout => 10);
- if (WIFEXITED($?)) {
- my $gpg_status = WEXITSTATUS($?);
- print { *STDERR } "$stdout$stderr" if $gpg_status;
- if ($gpg_status == 1 or ($gpg_status &&
- $self->{options}{require_valid_signature}))
- {
- error(g_('failed to verify signature on %s'), $dsc);
- } elsif ($gpg_status) {
- warning(g_('failed to verify signature on %s'), $dsc);
- }
- } else {
- subprocerr("@exec");
- }
- } else {
- if ($self->{options}{require_valid_signature}) {
- error(g_('cannot verify signature on %s since GnuPG is not installed'), $dsc);
- } else {
- warning(g_('cannot verify signature on %s since GnuPG is not installed'), $dsc);
+ foreach my $vendor_keyring (run_vendor_hook('package-keyrings')) {
+ if (-r $vendor_keyring) {
+ push @keyrings, $vendor_keyring;
}
}
+
+ Dpkg::OpenPGP::verify_signature($dsc, keyrings => \@keyrings);
}
sub describe_cmdline_options {
@@ -528,31 +512,25 @@ sub extract {
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)) {
- system('cp', '--', $src, $dst);
- subprocerr("cp $src to $dst") if $?;
+ cp($src, $dst)
+ or syserror(g_('cannot copy %s to %s'), $src, $dst);
}
}
}
# Try extract
- eval { $self->do_extract($newdirectory) };
- if ($@) {
- run_exit_handlers();
- die $@;
- }
+ $self->do_extract($newdirectory);
# Store format if non-standard so that next build keeps the same format
- if ($self->{fields}{'Format'} ne '1.0' and
+ 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;
- open(my $format_fh, '>', $format_file)
- or syserr(g_('cannot write %s'), $format_file);
- print { $format_fh } $self->{fields}{'Format'} . "\n";
- close($format_fh);
+ $self->{format}->save($format_file);
}
}
@@ -586,11 +564,8 @@ sub before_build {
sub build {
my $self = shift;
- eval { $self->do_build(@_) };
- if ($@) {
- run_exit_handlers();
- die $@;
- }
+
+ $self->do_build(@_);
}
sub after_build {
@@ -620,11 +595,8 @@ sub add_file {
sub commit {
my $self = shift;
- eval { $self->do_commit(@_) };
- if ($@) {
- run_exit_handlers();
- die $@;
- }
+
+ $self->do_commit(@_);
}
sub do_commit {
@@ -671,6 +643,18 @@ sub write_dsc {
=head1 CHANGES
+=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().
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-16 17:36:45 +0000