summaryrefslogtreecommitdiff
path: root/scripts/Dpkg/Source
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/Dpkg/Source')
-rw-r--r--scripts/Dpkg/Source/BinaryFiles.pm161
-rw-r--r--scripts/Dpkg/Source/Format.pm191
-rw-r--r--scripts/Dpkg/Source/Functions.pm44
-rw-r--r--scripts/Dpkg/Source/Package.pm214
-rw-r--r--scripts/Dpkg/Source/Package/V1.pm17
-rw-r--r--scripts/Dpkg/Source/Package/V2.pm196
-rw-r--r--scripts/Dpkg/Source/Package/V3/Bzr.pm2
-rw-r--r--scripts/Dpkg/Source/Package/V3/Native.pm2
-rw-r--r--scripts/Dpkg/Source/Package/V3/Quilt.pm6
-rw-r--r--scripts/Dpkg/Source/Patch.pm9
-rw-r--r--scripts/Dpkg/Source/Quilt.pm4
11 files changed, 544 insertions, 302 deletions
diff --git a/scripts/Dpkg/Source/BinaryFiles.pm b/scripts/Dpkg/Source/BinaryFiles.pm
new file mode 100644
index 000000000..48c84c8fc
--- /dev/null
+++ b/scripts/Dpkg/Source/BinaryFiles.pm
@@ -0,0 +1,161 @@
+# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2015 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/>.
+
+package Dpkg::Source::BinaryFiles;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Cwd;
+use File::Path qw(make_path);
+use File::Spec;
+use File::Find;
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::Source::Functions qw(is_binary);
+
+sub new {
+ my ($this, $dir) = @_;
+ my $class = ref($this) || $this;
+
+ my $self = {
+ dir => $dir,
+ allowed_binaries => {},
+ seen_binaries => {},
+ include_binaries_path =>
+ File::Spec->catfile($dir, 'debian', 'source', 'include-binaries'),
+ };
+ bless $self, $class;
+ $self->load_allowed_binaries();
+ return $self;
+}
+
+sub new_binary_found {
+ my ($self, $path) = @_;
+
+ $self->{seen_binaries}{$path} = 1;
+}
+
+sub load_allowed_binaries {
+ my $self = shift;
+ my $incbin_file = $self->{include_binaries_path};
+
+ if (-f $incbin_file) {
+ open my $incbin_fh, '<', $incbin_file
+ or syserr(g_('cannot read %s'), $incbin_file);
+ while (<$incbin_fh>) {
+ chomp;
+ s/^\s*//;
+ s/\s*$//;
+ next if /^#/ or length == 0;
+ $self->{allowed_binaries}{$_} = 1;
+ }
+ close $incbin_fh;
+ }
+}
+
+sub binary_is_allowed {
+ my ($self, $path) = @_;
+
+ return 1 if exists $self->{allowed_binaries}{$path};
+ return 0;
+}
+
+sub update_debian_source_include_binaries {
+ my $self = shift;
+
+ my @unknown_binaries = $self->get_unknown_binaries();
+ return unless scalar @unknown_binaries;
+
+ my $incbin_file = $self->{include_binaries_path};
+ make_path(File::Spec->catdir($self->{dir}, 'debian', 'source'));
+ open my $incbin_fh, '>>', $incbin_file
+ or syserr(g_('cannot write %s'), $incbin_file);
+ foreach my $binary (@unknown_binaries) {
+ print { $incbin_fh } "$binary\n";
+ info(g_('adding %s to %s'), $binary, 'debian/source/include-binaries');
+ $self->{allowed_binaries}{$binary} = 1;
+ }
+ close $incbin_fh;
+}
+
+sub get_unknown_binaries {
+ my $self = shift;
+
+ return grep { not $self->binary_is_allowed($_) } $self->get_seen_binaries();
+}
+
+sub get_seen_binaries {
+ my $self = shift;
+ my @seen = sort keys %{$self->{seen_binaries}};
+
+ return @seen;
+}
+
+sub detect_binary_files {
+ my ($self, %opts) = @_;
+
+ my $unwanted_binaries = 0;
+ my $check_binary = sub {
+ if (-f and is_binary($_)) {
+ my $fn = File::Spec->abs2rel($_, $self->{dir});
+ $self->new_binary_found($fn);
+ unless ($opts{include_binaries} or $self->binary_is_allowed($fn)) {
+ errormsg(g_('unwanted binary file: %s'), $fn);
+ $unwanted_binaries++;
+ }
+ }
+ };
+ my $exclude_glob = '{' .
+ join(',', map { s/,/\\,/rg } @{$opts{exclude_globs}}) .
+ '}';
+ my $filter_ignore = sub {
+ # Filter out files that are not going to be included in the debian
+ # tarball due to ignores.
+ my %exclude;
+ my $reldir = File::Spec->abs2rel($File::Find::dir, $self->{dir});
+ my $cwd = getcwd();
+ # Apply the pattern both from the top dir and from the inspected dir
+ chdir $self->{dir}
+ or syserr(g_("unable to chdir to '%s'"), $self->{dir});
+ $exclude{$_} = 1 foreach glob $exclude_glob;
+ chdir $cwd or syserr(g_("unable to chdir to '%s'"), $cwd);
+ chdir $File::Find::dir
+ or syserr(g_("unable to chdir to '%s'"), $File::Find::dir);
+ $exclude{$_} = 1 foreach glob $exclude_glob;
+ chdir $cwd or syserr(g_("unable to chdir to '%s'"), $cwd);
+ my @result;
+ foreach my $fn (@_) {
+ unless (exists $exclude{$fn} or exists $exclude{"$reldir/$fn"}) {
+ push @result, $fn;
+ }
+ }
+ return @result;
+ };
+ find({ wanted => $check_binary, preprocess => $filter_ignore,
+ no_chdir => 1 }, File::Spec->catdir($self->{dir}, 'debian'));
+ error(P_('detected %d unwanted binary file (add it in ' .
+ 'debian/source/include-binaries to allow its inclusion).',
+ 'detected %d unwanted binary files (add them in ' .
+ 'debian/source/include-binaries to allow their inclusion).',
+ $unwanted_binaries), $unwanted_binaries)
+ if $unwanted_binaries;
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Format.pm b/scripts/Dpkg/Source/Format.pm
new file mode 100644
index 000000000..41596a233
--- /dev/null
+++ b/scripts/Dpkg/Source/Format.pm
@@ -0,0 +1,191 @@
+# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2018 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/>.
+
+package Dpkg::Source::Format;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Source::Format - manipulate debian/source/format files
+
+=head1 DESCRIPTION
+
+This module provides a class that can manipulate Debian source
+package F<debian/source/format> files.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(Dpkg::Interface::Storable);
+
+=head1 METHODS
+
+=over 4
+
+=item $f = Dpkg::Source::Format->new(%opts)
+
+Creates a new object corresponding to a source package's
+F<debian/source/format> file. When the key B<filename> is set, it will
+be used to parse and set the format. Otherwise if the B<format> key is
+set it will be validated and used to set the format.
+
+=cut
+
+sub new {
+ my ($this, %opts) = @_;
+ my $class = ref($this) || $this;
+ my $self = {
+ filename => undef,
+ major => undef,
+ minor => undef,
+ variant => undef,
+ };
+ bless $self, $class;
+
+ if (exists $opts{filename}) {
+ $self->load($opts{filename}, compression => 0);
+ } elsif ($opts{format}) {
+ $self->set($opts{format});
+ }
+ return $self;
+}
+
+=item $f->set_from_parts($major[, $minor[, $variant]])
+
+Sets the source format from its parts. The $major part is mandatory.
+The $minor and $variant parts are optional.
+
+B<Notice>: This function performs no validation.
+
+=cut
+
+sub set_from_parts {
+ my ($self, $major, $minor, $variant) = @_;
+
+ $self->{major} = $major;
+ $self->{minor} = $minor // 0;
+ $self->{variant} = $variant;
+}
+
+=item ($major, $minor, $variant) = $f->set($format)
+
+Sets (and validates) the source $format specified. Will return the parsed
+format parts as a list, the optional $minor and $variant parts might be
+undef.
+
+=cut
+
+sub set {
+ my ($self, $format) = @_;
+
+ if ($format =~ /^(\d+)(?:\.(\d+))?(?:\s+\(([a-z0-9]+)\))?$/) {
+ my ($major, $minor, $variant) = ($1, $2, $3);
+
+ $self->set_from_parts($major, $minor, $variant);
+
+ return ($major, $minor, $variant);
+ } else {
+ error(g_("source package format '%s' is invalid"), $format);
+ }
+}
+
+=item ($major, $minor, $variant) = $f->get()
+
+=item $format = $f->get()
+
+Gets the source format, either as properly formatted scalar, or as a list
+of its parts, where the optional $minor and $variant parts might be undef.
+
+=cut
+
+sub get {
+ my $self = shift;
+
+ if (wantarray) {
+ return ($self->{major}, $self->{minor}, $self->{variant});
+ } else {
+ my $format = "$self->{major}.$self->{minor}";
+ $format .= " ($self->{variant})" if defined $self->{variant};
+
+ return $format;
+ }
+}
+
+=item $count = $f->parse($fh, $desc)
+
+Parse the source format string from $fh, with filehandle description $desc.
+
+=cut
+
+sub parse {
+ my ($self, $fh, $desc) = @_;
+
+ my $format = <$fh>;
+ chomp $format if defined $format;
+ error(g_('%s is empty'), $desc)
+ unless defined $format and length $format;
+
+ $self->set($format);
+
+ return 1;
+}
+
+=item $count = $f->load($filename)
+
+Parse $filename contents for a source package format string.
+
+=item $str = $f->output([$fh])
+
+=item "$f"
+
+Returns a string representing the source package format version.
+If $fh is set, it prints the string to the filehandle.
+
+=cut
+
+sub output {
+ my ($self, $fh) = @_;
+
+ my $str = $self->get();
+
+ print { $fh } "$str\n" if defined $fh;
+
+ return $str;
+}
+
+=item $f->save($filename)
+
+Save the source package format into the given $filename.
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.19.3)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Source/Functions.pm b/scripts/Dpkg/Source/Functions.pm
index 0a940463e..3435f6c5a 100644
--- a/scripts/Dpkg/Source/Functions.pm
+++ b/scripts/Dpkg/Source/Functions.pm
@@ -22,6 +22,7 @@ our $VERSION = '0.01';
our @EXPORT_OK = qw(
erasedir
fixperms
+ chmod_if_needed
fs_time
is_binary
);
@@ -70,6 +71,18 @@ sub fixperms {
subprocerr("chmod -R -- $modes_set $dir") if $?;
}
+# Only change the pathname permissions if they differ from the desired.
+#
+# To be able to build a source tree, a user needs write permissions on it,
+# but not necessarily ownership of those files.
+sub chmod_if_needed {
+ my ($newperms, $pathname) = @_;
+ my $oldperms = (stat $pathname)[2] & 07777;
+
+ return 1 if $oldperms == $newperms;
+ return chmod $newperms, $pathname;
+}
+
# Touch the file and read the resulting mtime.
#
# If the file doesn't exist, create it, read the mtime and unlink it.
@@ -97,30 +110,15 @@ sub fs_time($) {
sub is_binary($) {
my $file = shift;
- # TODO: might want to reimplement what diff does, aka checking if the
- # file contains \0 in the first 4Kb of data
+ # Perform the same check as diff(1), look for a NUL character in the first
+ # 4 KiB of the file.
+ open my $fh, '<', $file
+ or syserr(g_('cannot open file %s for binary detection'), $file);
+ read $fh, my $buf, 4096, 0;
+ my $res = index $buf, "\0";
+ close $fh;
- # Use diff to check if it's a binary file
- my $diffgen;
- my $diff_pid = spawn(
- exec => [ 'diff', '-u', '--', '/dev/null', $file ],
- env => { LC_ALL => 'C', LANG => 'C', TZ => 'UTC0' },
- to_pipe => \$diffgen,
- );
- my $result = 0;
- local $_;
- while (<$diffgen>) {
- if (m/^(?:binary|[^-+\@ ].*\bdiffer\b)/i) {
- $result = 1;
- last;
- } elsif (m/^[-+\@ ]/) {
- $result = 0;
- last;
- }
- }
- close($diffgen) or syserr('close on diff pipe');
- wait_child($diff_pid, nocheck => 1, cmdline => "diff -u -- /dev/null $file");
- return $result;
+ return $res >= 0;
}
1;
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().
diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm
index 001d9ecd3..d91cea03b 100644
--- a/scripts/Dpkg/Source/Package/V1.pm
+++ b/scripts/Dpkg/Source/Package/V1.pm
@@ -267,7 +267,7 @@ sub do_build {
'argument (with v1.0 source package)'));
}
- $sourcestyle =~ y/X/A/;
+ $sourcestyle =~ y/X/a/;
unless ($sourcestyle =~ m/[akpursnAKPUR]/) {
usageerr(g_('source handling style -s%s not allowed with -b'),
$sourcestyle);
@@ -409,11 +409,18 @@ sub do_build {
$sourcepackage, $tarname);
}
- $self->add_file($tarname) if $tarname;
- if ($tarname and -e "$tarname.sig" and not -e "$tarname.asc") {
- openpgp_sig_to_asc("$tarname.sig", "$tarname.asc");
+ if ($tarname) {
+ $self->add_file($tarname);
+ if (-e "$tarname.sig" and not -e "$tarname.asc") {
+ openpgp_sig_to_asc("$tarname.sig", "$tarname.asc");
+ }
+ }
+ if ($tarsign and -e $tarsign) {
+ info(g_('building %s using existing %s'), $sourcepackage, $tarsign);
+ $self->add_file($tarsign);
+
+ $self->check_original_tarball_signature($tarsign);
}
- $self->add_file($tarsign) if $tarsign and -e $tarsign;
if ($sourcestyle =~ m/[kpKP]/) {
if (stat($origdir)) {
diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm
index 818e32ddc..d84fce2dd 100644
--- a/scripts/Dpkg/Source/Package/V2.pm
+++ b/scripts/Dpkg/Source/Package/V2.pm
@@ -37,8 +37,9 @@ use Dpkg::Path qw(find_command);
use Dpkg::Compression;
use Dpkg::Source::Archive;
use Dpkg::Source::Patch;
+use Dpkg::Source::BinaryFiles;
use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
-use Dpkg::Source::Functions qw(erasedir is_binary fs_time);
+use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
use Dpkg::Vendor qw(run_vendor_hook);
use Dpkg::Control;
use Dpkg::Changelog::Parse;
@@ -399,7 +400,8 @@ sub _generate_patch {
# Identify original tarballs
my ($tarfile, %addonfile);
my $comp_ext_regex = compression_get_file_extension_regex();
- my @origtarballs;
+ my @origtarfiles;
+ my @origtarsigns;
foreach my $file (sort $self->find_original_tarballs()) {
if ($file =~ /\.orig\.tar\.$comp_ext_regex$/) {
if (defined($tarfile)) {
@@ -407,20 +409,23 @@ sub _generate_patch {
'one is allowed'), $tarfile, $file);
}
$tarfile = $file;
- push @origtarballs, $file;
- $self->add_file($file);
- if (-e "$file.sig" and not -e "$file.asc") {
- openpgp_sig_to_asc("$file.sig", "$file.asc");
- }
- $self->add_file("$file.asc") if -e "$file.asc";
} elsif ($file =~ /\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) {
$addonfile{$1} = $file;
- push @origtarballs, $file;
- $self->add_file($file);
- if (-e "$file.sig" and not -e "$file.asc") {
- openpgp_sig_to_asc("$file.sig", "$file.asc");
- }
- $self->add_file("$file.asc") if -e "$file.asc";
+ } else {
+ next;
+ }
+
+ push @origtarfiles, $file;
+ $self->add_file($file);
+
+ # Check for an upstream signature.
+ if (-e "$file.sig" and not -e "$file.asc") {
+ openpgp_sig_to_asc("$file.sig", "$file.asc");
+ }
+ if (-e "$file.asc") {
+ push @origtarfiles, "$file.asc";
+ push @origtarsigns, "$file.asc";
+ $self->add_file("$file.asc")
}
}
@@ -428,8 +433,12 @@ sub _generate_patch {
$self->_upstream_tarball_template()) unless $tarfile;
if ($opts{usage} eq 'build') {
- info(g_('building %s using existing %s'),
- $self->{fields}{'Source'}, "@origtarballs");
+ foreach my $origtarfile (@origtarfiles) {
+ info(g_('building %s using existing %s'),
+ $self->{fields}{'Source'}, $origtarfile);
+ }
+
+ $self->check_original_tarball_signature(@origtarsigns);
}
# Unpack a second copy for comparison
@@ -509,50 +518,12 @@ sub do_build {
my $basenamerev = $self->get_basename(1);
# Check if the debian directory contains unwanted binary files
- my $binaryfiles = Dpkg::Source::Package::V2::BinaryFiles->new($dir);
- my $unwanted_binaries = 0;
- my $check_binary = sub {
- if (-f and is_binary($_)) {
- my $fn = File::Spec->abs2rel($_, $dir);
- $binaryfiles->new_binary_found($fn);
- unless ($include_binaries or $binaryfiles->binary_is_allowed($fn)) {
- errormsg(g_('unwanted binary file: %s'), $fn);
- $unwanted_binaries++;
- }
- }
- };
- my $tar_ignore_glob = '{' . join(',',
- map { s/,/\\,/rg } @{$self->{options}{tar_ignore}}) . '}';
- my $filter_ignore = sub {
- # Filter out files that are not going to be included in the debian
- # tarball due to ignores.
- my %exclude;
- my $reldir = File::Spec->abs2rel($File::Find::dir, $dir);
- my $cwd = getcwd();
- # Apply the pattern both from the top dir and from the inspected dir
- chdir $dir or syserr(g_("unable to chdir to '%s'"), $dir);
- $exclude{$_} = 1 foreach glob($tar_ignore_glob);
- chdir $cwd or syserr(g_("unable to chdir to '%s'"), $cwd);
- chdir($File::Find::dir)
- or syserr(g_("unable to chdir to '%s'"), $File::Find::dir);
- $exclude{$_} = 1 foreach glob($tar_ignore_glob);
- chdir $cwd or syserr(g_("unable to chdir to '%s'"), $cwd);
- my @result;
- foreach my $fn (@_) {
- unless (exists $exclude{$fn} or exists $exclude{"$reldir/$fn"}) {
- push @result, $fn;
- }
- }
- return @result;
- };
- find({ wanted => $check_binary, preprocess => $filter_ignore,
- no_chdir => 1 }, File::Spec->catdir($dir, 'debian'));
- error(P_('detected %d unwanted binary file (add it in ' .
- 'debian/source/include-binaries to allow its inclusion).',
- 'detected %d unwanted binary files (add them in ' .
- 'debian/source/include-binaries to allow their inclusion).',
- $unwanted_binaries), $unwanted_binaries)
- if $unwanted_binaries;
+ my $binaryfiles = Dpkg::Source::BinaryFiles->new($dir);
+
+ $binaryfiles->detect_binary_files(
+ exclude_globs => $self->{options}{tar_ignore},
+ include_binaries => $include_binaries,
+ );
# Handle modified binary files detected by the auto-patch generation
my $handle_binary = sub {
@@ -616,17 +587,25 @@ sub do_build {
sub _get_patch_header {
my ($self, $dir) = @_;
+
my $ph = File::Spec->catfile($dir, 'debian', 'source', 'local-patch-header');
unless (-f $ph) {
$ph = File::Spec->catfile($dir, 'debian', 'source', 'patch-header');
}
- my $text;
if (-f $ph) {
- open(my $ph_fh, '<', $ph) or syserr(g_('cannot read %s'), $ph);
- $text = file_slurp($ph_fh);
- close($ph_fh);
- return $text;
+ return file_slurp($ph);
}
+
+ if ($self->{options}->{single_debian_patch}) {
+ return <<'AUTOGEN_HEADER';
+This is an autogenerated patch header for a single-debian-patch file. The
+delta against upstream is either kept as a single patch, or maintained
+in some VCS, and exported as a single patch instead of more manageable
+atomic patches.
+
+AUTOGEN_HEADER
+ }
+
my $ch_info = changelog_parse(offset => 0, count => 1,
file => File::Spec->catfile($dir, 'debian', 'changelog'));
return '' if not defined $ch_info;
@@ -642,6 +621,7 @@ it.\n";
$header->{'Author'} = $ch_info->{'Maintainer'};
my $yyyy_mm_dd = POSIX::strftime('%Y-%m-%d', gmtime);
+ my $text;
$text = "$header";
run_vendor_hook('extend-patch-header', \$text, $ch_info);
$text .= "\n---
@@ -665,7 +645,7 @@ sub register_patch {
if (-s $patch_file) {
copy($patch_file, $patch)
or syserr(g_('failed to copy %s to %s'), $patch_file, $patch);
- chmod(0666 & ~ umask(), $patch)
+ chmod_if_needed(0666 & ~ umask(), $patch)
or syserr(g_("unable to change permission of '%s'"), $patch);
my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
open(my $applied_fh, '>>', $applied)
@@ -706,7 +686,7 @@ sub do_commit {
error(g_("patch file '%s' doesn't exist"), $tmpdiff) if not -e $tmpdiff;
}
- my $binaryfiles = Dpkg::Source::Package::V2::BinaryFiles->new($dir);
+ my $binaryfiles = Dpkg::Source::BinaryFiles->new($dir);
my $handle_binary = sub {
my ($self, $old, $new, %opts) = @_;
my $fn = File::Spec->abs2rel($new, $dir);
@@ -749,86 +729,4 @@ sub do_commit {
info(g_('local changes have been recorded in a new patch: %s'), $patch);
}
-package Dpkg::Source::Package::V2::BinaryFiles;
-
-use Dpkg::ErrorHandling;
-use Dpkg::Gettext;
-
-use File::Path qw(make_path);
-use File::Spec;
-
-sub new {
- my ($this, $dir) = @_;
- my $class = ref($this) || $this;
-
- my $self = {
- dir => $dir,
- allowed_binaries => {},
- seen_binaries => {},
- include_binaries_path =>
- File::Spec->catfile($dir, 'debian', 'source', 'include-binaries'),
- };
- bless $self, $class;
- $self->load_allowed_binaries();
- return $self;
-}
-
-sub new_binary_found {
- my ($self, $path) = @_;
-
- $self->{seen_binaries}{$path} = 1;
-}
-
-sub load_allowed_binaries {
- my $self = shift;
- my $incbin_file = $self->{include_binaries_path};
- if (-f $incbin_file) {
- open(my $incbin_fh, '<', $incbin_file)
- or syserr(g_('cannot read %s'), $incbin_file);
- while (<$incbin_fh>) {
- chomp;
- s/^\s*//;
- s/\s*$//;
- next if /^#/ or length == 0;
- $self->{allowed_binaries}{$_} = 1;
- }
- close($incbin_fh);
- }
-}
-
-sub binary_is_allowed {
- my ($self, $path) = @_;
- return 1 if exists $self->{allowed_binaries}{$path};
- return 0;
-}
-
-sub update_debian_source_include_binaries {
- my $self = shift;
-
- my @unknown_binaries = $self->get_unknown_binaries();
- return unless scalar(@unknown_binaries);
-
- my $incbin_file = $self->{include_binaries_path};
- make_path(File::Spec->catdir($self->{dir}, 'debian', 'source'));
- open(my $incbin_fh, '>>', $incbin_file)
- or syserr(g_('cannot write %s'), $incbin_file);
- foreach my $binary (@unknown_binaries) {
- print { $incbin_fh } "$binary\n";
- info(g_('adding %s to %s'), $binary, 'debian/source/include-binaries');
- $self->{allowed_binaries}{$binary} = 1;
- }
- close($incbin_fh);
-}
-
-sub get_unknown_binaries {
- my $self = shift;
- return grep { not $self->binary_is_allowed($_) } $self->get_seen_binaries();
-}
-
-sub get_seen_binaries {
- my $self = shift;
- my @seen = sort keys %{$self->{seen_binaries}};
- return @seen;
-}
-
1;
diff --git a/scripts/Dpkg/Source/Package/V3/Bzr.pm b/scripts/Dpkg/Source/Package/V3/Bzr.pm
index f0752c0b1..13d49c742 100644
--- a/scripts/Dpkg/Source/Package/V3/Bzr.pm
+++ b/scripts/Dpkg/Source/Package/V3/Bzr.pm
@@ -176,7 +176,7 @@ sub do_extract {
my @files = $self->get_files();
if (@files > 1) {
- error(g_('format v3.0 uses only one source file'));
+ error(g_('format v3.0 (bzr) uses only one source file'));
}
my $tarfile = $files[0];
my $comp_ext_regex = compression_get_file_extension_regex();
diff --git a/scripts/Dpkg/Source/Package/V3/Native.pm b/scripts/Dpkg/Source/Package/V3/Native.pm
index b53a30f3f..1d0de2b0f 100644
--- a/scripts/Dpkg/Source/Package/V3/Native.pm
+++ b/scripts/Dpkg/Source/Package/V3/Native.pm
@@ -49,7 +49,7 @@ sub do_extract {
my $comp_ext_regex = compression_get_file_extension_regex();
foreach my $file ($self->get_files()) {
if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_ext_regex$/) {
- error(g_('multiple tarfiles in v1.0 source package')) if $tarfile;
+ error(g_('multiple tarfiles in native source package')) if $tarfile;
$tarfile = $file;
} else {
error(g_('unrecognized file for a native source package: %s'), $file);
diff --git a/scripts/Dpkg/Source/Package/V3/Quilt.pm b/scripts/Dpkg/Source/Package/V3/Quilt.pm
index 9718ffa2d..45237d26a 100644
--- a/scripts/Dpkg/Source/Package/V3/Quilt.pm
+++ b/scripts/Dpkg/Source/Package/V3/Quilt.pm
@@ -28,7 +28,7 @@ use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Version;
use Dpkg::Source::Patch;
-use Dpkg::Source::Functions qw(erasedir fs_time);
+use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
use Dpkg::Source::Quilt;
use Dpkg::Exit;
@@ -142,6 +142,8 @@ sub apply_patches {
return unless scalar($quilt->series());
+ info(g_('using patch list from %s'), "debian/patches/$basename");
+
if ($opts{usage} eq 'preparation' and
$self->{options}{unapply_patches} eq 'auto') {
# We're applying the patches in --before-build, remember to unapply
@@ -249,7 +251,7 @@ sub register_patch {
if (-s $tmpdiff) {
copy($tmpdiff, $patch)
or syserr(g_('failed to copy %s to %s'), $tmpdiff, $patch);
- chmod(0666 & ~ umask(), $patch)
+ chmod_if_needed(0666 & ~ umask(), $patch)
or syserr(g_("unable to change permission of '%s'"), $patch);
} elsif (-e $patch) {
unlink($patch) or syserr(g_('cannot remove %s'), $patch);
diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm
index e5ad5424b..25d56335d 100644
--- a/scripts/Dpkg/Source/Patch.pm
+++ b/scripts/Dpkg/Source/Patch.pm
@@ -148,7 +148,6 @@ sub add_diff_directory {
# TODO: make this function more configurable
# - offer to disable some checks
my $basedir = $opts{basedirname} || basename($new);
- my $inc_removal = $opts{include_removal} // 0;
my $diff_ignore;
if ($opts{diff_ignore_func}) {
$diff_ignore = $opts{diff_ignore_func};
@@ -226,11 +225,13 @@ sub add_diff_directory {
return if $files_in_new{$fn};
lstat("$old/$fn") or syserr(g_('cannot stat file %s'), "$old/$fn");
if (-f _) {
- if ($inc_removal) {
+ if (not defined $opts{include_removal}) {
+ warning(g_('ignoring deletion of file %s'), $fn);
+ } elsif (not $opts{include_removal}) {
+ warning(g_('ignoring deletion of file %s, use --include-removal to override'), $fn);
+ } else {
push @diff_files, [$fn, 0, 0, "$old/$fn", '/dev/null',
"$basedir.orig/$fn", '/dev/null'];
- } else {
- warning(g_('ignoring deletion of file %s, use --include-removal to override'), $fn);
}
} elsif (-d _) {
warning(g_('ignoring deletion of directory %s'), $fn);
diff --git a/scripts/Dpkg/Source/Quilt.pm b/scripts/Dpkg/Source/Quilt.pm
index 55b3fbaf8..78a4fdf9a 100644
--- a/scripts/Dpkg/Source/Quilt.pm
+++ b/scripts/Dpkg/Source/Quilt.pm
@@ -30,7 +30,7 @@ use File::Basename;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Source::Patch;
-use Dpkg::Source::Functions qw(erasedir fs_time);
+use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
use Dpkg::Vendor qw(get_current_vendor);
sub new {
@@ -374,7 +374,7 @@ sub restore_quilt_backup_files {
unless (link($_, $target)) {
copy($_, $target)
or syserr(g_('failed to copy %s to %s'), $_, $target);
- chmod((stat(_))[2], $target)
+ chmod_if_needed((stat _)[2], $target)
or syserr(g_("unable to change permission of '%s'"), $target);
}
} else {
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-09 20:13:25 +0000