summaryrefslogtreecommitdiffstats
path: root/scripts/Dpkg
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--scripts/Dpkg/Archive/Ar.pm440
-rw-r--r--scripts/Dpkg/BuildDriver.pm196
-rw-r--r--scripts/Dpkg/BuildDriver/DebianRules.pm298
-rw-r--r--scripts/Dpkg/Control/FieldsCore.pm5
-rw-r--r--scripts/Dpkg/OpenPGP/Backend/GnuPG.pm14
-rw-r--r--scripts/Dpkg/OpenPGP/ErrorCodes.pm19
-rw-r--r--scripts/Dpkg/Shlibs/Cppfilt.pm10
-rw-r--r--scripts/Dpkg/Source/Package.pm33
-rw-r--r--scripts/Dpkg/Source/Package/V1.pm3
-rw-r--r--scripts/Dpkg/Source/Package/V2.pm3
-rw-r--r--scripts/Dpkg/Source/Package/V3/Bzr.pm4
-rw-r--r--scripts/Dpkg/Substvars.pm34
-rw-r--r--scripts/Dpkg/Vendor/Debian.pm37
-rw-r--r--scripts/Dpkg/Vendor/Ubuntu.pm2
14 files changed, 1068 insertions, 30 deletions
diff --git a/scripts/Dpkg/Archive/Ar.pm b/scripts/Dpkg/Archive/Ar.pm
new file mode 100644
index 0000000..97d5711
--- /dev/null
+++ b/scripts/Dpkg/Archive/Ar.pm
@@ -0,0 +1,440 @@
+# Copyright © 2023-2024 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::Archive::Ar - Unix ar archive support
+
+=head1 DESCRIPTION
+
+This module provides a class to handle Unix ar archives.
+It support the common format, with no GNU or BSD extensions.
+
+B<Note>: This is a private module, its API can change at any time.
+
+=cut
+
+package Dpkg::Archive::Ar 0.01;
+
+use strict;
+use warnings;
+
+use Carp;
+use Fcntl qw(:seek);
+use IO::File;
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+my $AR_MAGIC = "!<arch>\n";
+my $AR_MAGIC_LEN = 8;
+my $AR_FMAG = "\`\n";
+my $AR_HDR_LEN = 60;
+
+=head1 METHODS
+
+=over 8
+
+=item $ar = Dpkg::Archive::Ar->new(%opts)
+
+Create a new object to handle Unix ar archives.
+
+Supported options are:
+
+=over 8
+
+=item filename
+
+The filename for the archive to open or create.
+
+=item create
+
+A boolean denoting whether the archive should be created,
+otherwise if it does not exist the constructor will not open, create or
+scan it.
+
+=back
+
+=cut
+
+sub new {
+ my ($this, %opts) = @_;
+ my $class = ref($this) || $this;
+ my $self = {
+ filename => undef,
+ fh => undef,
+ # XXX: If we promote this out from internal use, we should make this
+ # default to the archive mtime, or be overridable like in libdpkg,
+ # so that it can be initialized from SOURCE_DATE_EPOCH for example.
+ time => 0,
+ size => 0,
+ members => [],
+ };
+ bless $self, $class;
+
+ if ($opts{filename}) {
+ if ($opts{create}) {
+ $self->create_archive($opts{filename});
+ } elsif (-e $opts{filename}) {
+ $self->open_archive($opts{filename});
+ }
+ if (-e $opts{filename}) {
+ $self->scan_archive();
+ }
+ }
+
+ return $self;
+}
+
+sub init_archive {
+ my $self = shift;
+
+ $self->{fh}->binmode();
+ $self->{fh}->stat
+ or syserr(g_('cannot get archive %s size'), $self->{filename});
+ $self->{size} = -s _;
+
+ return;
+}
+
+=item $ar->create_archive($filename)
+
+Create the archive.
+
+=cut
+
+sub create_archive {
+ my ($self, $filename) = @_;
+
+ if (defined $self->{fh}) {
+ croak 'the object has already been initialized with another file';
+ }
+
+ $self->{filename} = $filename;
+ $self->{fh} = IO::File->new($filename, '+>')
+ or syserr(g_('cannot open or create archive %s'), $filename);
+ $self->init_archive();
+ $self->{fh}->write($AR_MAGIC, $AR_MAGIC_LEN)
+ or syserr(g_('cannot write magic into archive %s'), $filename);
+
+ return;
+}
+
+=item $ar->open_archive($filename)
+
+Open the archive.
+
+=cut
+
+sub open_archive {
+ my ($self, $filename) = @_;
+
+ if (defined $self->{fh}) {
+ croak 'the object has already been initialized with another file';
+ }
+
+ $self->{filename} = $filename;
+ $self->{fh} = IO::File->new($filename, '+<')
+ or syserr(g_('cannot open or create archive %s'), $filename);
+ $self->init_archive();
+
+ return;
+}
+
+sub _read_buf {
+ my ($self, $subject, $size) = @_;
+
+ my $buf;
+ my $offs = $self->{fh}->tell();
+ my $n = $self->{fh}->read($buf, $size);
+ if (not defined $n) {
+ # TRANSLATORS: The first %s string is either "archive magic" or
+ # "file header".
+ syserr(g_('cannot read %s at offset %d from archive %s'),
+ $subject, $offs, $self->{filename});
+ } elsif ($n == 0) {
+ return;
+ } elsif ($n != $size) {
+ # TRANSLATORS: The first %s string is either "archive magic" or
+ # "file header".
+ error(g_('%s at offset %d in archive %s is truncated'),
+ $subject, $offs, $self->{filename});
+ }
+
+ return $buf;
+}
+
+=item $ar->parse_magic()
+
+Reads and parses the archive magic string, and validates it.
+
+=cut
+
+sub parse_magic {
+ my $self = shift;
+
+ my $magic = $self->_read_buf(g_('archive magic'), $AR_MAGIC_LEN)
+ or error(g_('archive %s contains no magic'), $self->{filename});
+
+ if ($magic ne $AR_MAGIC) {
+ error(g_('archive %s contains bad magic'), $self->{filename});
+ }
+
+ return;
+}
+
+=item $ar->parse_member()
+
+Reads and parses the archive member and tracks it for later handling.
+
+=cut
+
+sub parse_member {
+ my $self = shift;
+
+ my $offs = $self->{fh}->tell();
+
+ my $hdr = $self->_read_buf(g_('file header'), $AR_HDR_LEN)
+ or return;
+
+ my $hdr_fmt = 'A16A12A6A6A8A10a2';
+ my ($name, $time, $uid, $gid, $mode, $size, $fmag) = unpack $hdr_fmt, $hdr;
+
+ if ($fmag ne $AR_FMAG) {
+ error(g_('file header at offset %d in archive %s contains bad magic'),
+ $offs, $self->{filename});
+ }
+
+ # Remove trailing spaces from the member name.
+ $name =~ s{ *$}{};
+
+ # Remove optional slash terminator (on GNU-style archives).
+ $name =~ s{/$}{};
+
+ my $member = {
+ name => $name,
+ time => int $time,
+ uid => int $uid,
+ gid => int $gid,
+ mode => oct $mode,
+ size => int $size,
+ offs => $offs,
+ };
+ push @{$self->{members}}, $member;
+
+ return $member;
+}
+
+=item $ar->skip_member($member)
+
+Skip this member to the next one.
+Get the value of a given substitution.
+
+=cut
+
+sub skip_member {
+ my ($self, $member) = @_;
+
+ my $size = $member->{size};
+ my $offs = $member->{offs} + $AR_HDR_LEN + $size + ($size & 1);
+
+ $self->{fh}->seek($offs, SEEK_SET)
+ or syserr(g_('cannot seek into next file header at offset %d from archive %s'),
+ $offs, $self->{filename});
+
+ return;
+}
+
+=item $ar->scan_archive()
+
+Scan the archive for all its member files and metadata.
+
+=cut
+
+sub scan_archive {
+ my $self = shift;
+
+ $self->{fh}->seek(0, SEEK_SET)
+ or syserr(g_('cannot seek into beginning of archive %s'),
+ $self->{filename});
+
+ $self->parse_magic();
+
+ while (my $member = $self->parse_member()) {
+ $self->skip_member($member);
+ }
+
+ return;
+}
+
+=item $ar->get_members()
+
+Get the list of members in the archive.
+
+=cut
+
+sub get_members {
+ my $self = shift;
+
+ return $self->{members};
+}
+
+sub _copy_fh_fh {
+ my ($self, $if, $of, $size) = @_;
+
+ while ($size > 0) {
+ my $buf;
+ my $buflen = $size > 4096 ? 4096 : $size;
+
+ my $n = $if->{fh}->read($buf, $buflen)
+ or syserr(g_('cannot read file %s'), $if->{name});
+
+ $of->{fh}->write($buf, $buflen)
+ or syserr(g_('cannot write file %s'), $of->{name});
+
+ $size -= $buflen;
+ }
+
+ return;
+}
+
+=item $ar->extract_member($member)
+
+Extract the specified member to the current directory.
+
+=cut
+
+sub extract_member {
+ my ($self, $member) = @_;
+
+ $self->{fh}->seek($member->{offs} + $AR_HDR_LEN, SEEK_SET);
+
+ my $ofh = IO::File->new($member->{name}, '+>')
+ or syserr(g_('cannot create file %s to extract from archive %s'),
+ $member->{name}, $self->{filename});
+
+ $self->_copy_fh_fh({ fh => $self->{fh}, name => $self->{filename} },
+ { fh => $ofh, name => $member->{name} },
+ $member->{size});
+
+ $ofh->close()
+ or syserr(g_('cannot write file %s to the filesystem'),
+ $member->{name});
+
+ return;
+}
+
+=item $ar->write_member($member)
+
+Write the provided $member into the archive.
+
+=cut
+
+sub write_member {
+ my ($self, $member) = @_;
+
+ my $size = $member->{size};
+ my $mode = sprintf '%o', $member->{mode};
+
+ my $hdr_fmt = 'A16A12A6A6A8A10A2';
+ my $data = pack $hdr_fmt, @{$member}{qw(name time uid gid)}, $mode, $size, $AR_FMAG;
+
+ $self->{fh}->write($data, $AR_HDR_LEN, $member->{offs})
+ or syserr(g_('cannot write file header into archive %s'),
+ $self->{filename});
+
+ return;
+}
+
+=item $ar->add_file($filename)
+
+Append the specified $filename into the archive.
+
+=cut
+
+sub add_file {
+ my ($self, $filename) = @_;
+
+ if (length $filename > 15) {
+ error(g_('filename %s is too long'), $filename);
+ }
+
+ my $fh = IO::File->new($filename, '<')
+ or syserr(g_('cannot open file %s to append to archive %s'),
+ $filename, $self->{filename});
+ $fh->stat()
+ or syserr(g_('cannot get file %s size'), $filename);
+ my $size = -s _;
+
+ my %member = (
+ name => $filename,
+ size => $size,
+ time => $self->{time},
+ mode => 0100644,
+ uid => 0,
+ gid => 0,
+ );
+
+ $self->write_member(\%member);
+ $self->_copy_fh_fh({ fh => $fh, name => $filename },
+ { fh => $self->{fh}, name => $self->{filename} },
+ $size);
+ if ($size & 1) {
+ $self->{fh}->write("\n", 1)
+ or syserr(g_('cannot write file %s padding to archive %s'),
+ $filename, $self->{filename});
+ }
+
+ return;
+}
+
+=item $ar->close_archive()
+
+Close the archive and release any allocated resource.
+
+=cut
+
+sub close_archive {
+ my $self = shift;
+
+ $self->{fh}->close() if defined $self->{fh};
+ $self->{fh} = undef;
+ $self->{size} = 0;
+ $self->{members} = [];
+
+ return;
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ $self->close_archive();
+
+ return;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildDriver.pm b/scripts/Dpkg/BuildDriver.pm
new file mode 100644
index 0000000..5a892ae
--- /dev/null
+++ b/scripts/Dpkg/BuildDriver.pm
@@ -0,0 +1,196 @@
+# Copyright © 2020-2024 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::BuildDriver - drive the build of a Debian package
+
+=head1 DESCRIPTION
+
+This class is used by dpkg-buildpackage to drive the build of a Debian
+package.
+
+B<Note>: This is a private module, its API can change at any time.
+
+=cut
+
+package Dpkg::BuildDriver 0.01;
+
+use strict;
+use warnings;
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+=head1 METHODS
+
+=over 4
+
+=item $bd = Dpkg::BuildDriver->new(%opts)
+
+Create a new Dpkg::BuildDriver object.
+It will load a build driver module as requested in the B<Build-Drivers> field
+in the $opts{ctrl} L<Dpkg::Control::Info> object or if not present,
+it will fall back to load the default B<debian-rules> driver.
+
+Supported or required options are:
+
+=over
+
+=item B<ctrl> (required)
+
+A L<Dpkg::Control::Info> object.
+
+=item B<root_cmd>
+
+A string with the gain-root-command to use when needing to execute a command
+with root-like rights.
+If needed and unset, it will default to L<fakeroot> if it is available or
+the module will error out.
+
+=item B<as_root>
+
+A boolean to force F<debian/rules> target calls as root-like, even if they
+would normally not require to be executed as root-like.
+This option is applied to all targets globally.
+
+B<Note>: This option is only relevant for drivers that use F<debian/rules>.
+
+=item B<debian_rules>
+
+An array containing the command to execute the F<debian/rules> file and any
+additional arguments.
+It defaults to B<debian/rules>.
+
+B<Note>: This option is only relevant for drivers that use F<debian/rules>.
+
+=item B<rrr_override>
+
+A string that overrides the B<Rules-Requires-Root> field value.
+
+B<Note>: This option is only relevant for drivers that use F<debian/rules>.
+
+=back
+
+=cut
+
+sub _load_driver {
+ my ($name, %opts) = @_;
+
+ # Normalize the driver name.
+ $name = join q{}, map { ucfirst lc } split /-/, $name;
+
+ my $driver;
+ eval qq{
+ require Dpkg::BuildDriver::$name;
+ \$driver = Dpkg::BuildDriver::$name->new(%opts);
+ };
+ error(g_('build driver %s is unknown: %s'), $name, $@) if $@;
+
+ return $driver;
+}
+
+sub new {
+ my ($this, %opts) = @_;
+ my $class = ref($this) || $this;
+
+ my $ctrl_src = $opts{ctrl}->get_source();
+ my $name = $ctrl_src->{'Build-Driver'} // 'debian-rules';
+ my $self = {
+ driver => _load_driver($name, %opts),
+ };
+ bless $self, $class;
+ return $self;
+}
+
+=item $bd->pre_check()
+
+Perform build driver specific checks, before anything else.
+
+This will run after the B<init> hook, and before C<dpkg-source --before-build>.
+
+B<Note>: This is an optional method that can be omitted from the driver
+implementation.
+
+=cut
+
+sub pre_check {
+ my $self = shift;
+
+ return unless $self->{driver}->can('pre_check');
+ return $self->{driver}->pre_check();
+}
+
+=item $bool = $bd->need_build_task($build_task, binary_task)
+
+Returns whether we need to use the build task.
+
+B<Note>: This method is needed as long as we support building as root-like.
+Once that is not needed this method will be deprecated.
+
+=cut
+
+sub need_build_task {
+ my ($self, $build_task, $binary_task) = @_;
+
+ return $self->{driver}->need_build_task($build_task, $binary_task);
+}
+
+=item $bd->run_build_task($build_task, $binary_task)
+
+Executes the build task for the build.
+
+B<Note>: This is an optional method needed as long as we support building as
+root-like.
+Once that is not needed this method will be deprecated.
+
+=cut
+
+sub run_build_task {
+ my ($self, $build_task, $binary_task) = @_;
+
+ $self->{driver}->run_build_task($build_task, $binary_task);
+
+ return;
+}
+
+=item $bd->run_task($task)
+
+Executes the given task for the build.
+
+=cut
+
+sub run_task {
+ my ($self, $task) = @_;
+
+ $self->{driver}->run_task($task);
+
+ return;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildDriver/DebianRules.pm b/scripts/Dpkg/BuildDriver/DebianRules.pm
new file mode 100644
index 0000000..ffc1987
--- /dev/null
+++ b/scripts/Dpkg/BuildDriver/DebianRules.pm
@@ -0,0 +1,298 @@
+# Copyright © 2020-2024 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::BuildDriver::DebianRules - build a Debian package using debian/rules
+
+=head1 DESCRIPTION
+
+This class is used by dpkg-buildpackage to drive the build of a Debian
+package, using F<debian/rules>.
+
+B<Note>: This is a private module, its API can change at any time.
+
+=cut
+
+package Dpkg::BuildDriver::DebianRules 0.01;
+
+use strict;
+use warnings;
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Path qw(find_command);
+use Dpkg::BuildTypes;
+use Dpkg::BuildAPI qw(get_build_api);
+
+=head1 METHODS
+
+=over 4
+
+=item $bd = Dpkg::BuildDriver::DebianRules->new(%opts)
+
+Create a new Dpkg::BuildDriver::DebianRules object.
+
+Supports or requires the same Dpkg::BuildDriver->new() options.
+
+=cut
+
+sub new {
+ my ($this, %opts) = @_;
+ my $class = ref($this) || $this;
+
+ my $self = {
+ ctrl => $opts{ctrl},
+ root_cmd => $opts{root_cmd},
+ as_root => $opts{as_root},
+ debian_rules => $opts{debian_rules},
+ rrr_override => $opts{rrr_override},
+ };
+ bless $self, $class;
+
+ my $rrr = $self->_parse_rules_requires_root();
+
+ $self->{rules_requires_root} = $rrr;
+
+ return $self;
+}
+
+sub _setup_rootcommand {
+ my $self = shift;
+
+ if ($< == 0) {
+ warning(g_('using a gain-root-command while being root'))
+ if @{$self->{root_cmd}};
+ } else {
+ push @{$self->{root_cmd}}, 'fakeroot'
+ unless @{$self->{root_cmd}};
+ }
+
+ if (@{$self->{root_cmd}} && ! find_command($self->{root_cmd}[0])) {
+ if ($self->{root_cmd}[0] eq 'fakeroot' && $< != 0) {
+ error(g_("fakeroot not found, either install the fakeroot\n" .
+ 'package, specify a command with the -r option, ' .
+ 'or run this as root'));
+ } else {
+ error(g_("gain-root-command '%s' not found"), $self->{root_cmd}[0]);
+ }
+ }
+}
+
+my %target_build = map { $_ => 1 } qw(
+ build
+ build-arch
+ build-indep
+);
+my %target_legacy_root = map { $_ => 1 } qw(
+ clean
+ binary
+ binary-arch
+ binary-indep
+);
+my %target_official = map { $_ => 1 } qw(
+ clean
+ build
+ build-arch
+ build-indep
+ binary
+ binary-arch
+ binary-indep
+);
+
+# Check whether we are doing some kind of rootless build, and sanity check
+# the fields values.
+sub _parse_rules_requires_root {
+ my $self = shift;
+
+ my %rrr;
+ my $rrr;
+ my $rrr_default;
+ my $keywords_base;
+ my $keywords_impl;
+
+ if (get_build_api($self->{ctrl}) >= 1) {
+ $rrr_default = 'no';
+ } else {
+ $rrr_default = 'binary-targets';
+ }
+
+ my $ctrl_src = $self->{ctrl}->get_source();
+ $rrr = $self->{rrr_override} // $ctrl_src->{'Rules-Requires-Root'} // $rrr_default;
+
+ foreach my $keyword (split ' ', $rrr) {
+ if ($keyword =~ m{/}) {
+ if ($keyword =~ m{^dpkg/target/(.*)$}p and $target_official{$1}) {
+ error(g_('disallowed target in %s field keyword %s'),
+ 'Rules-Requires-Root', $keyword);
+ } elsif ($keyword ne 'dpkg/target-subcommand') {
+ error(g_('%s field keyword "%s" is unknown in dpkg namespace'),
+ 'Rules-Requires-Root', $keyword);
+ }
+ $keywords_impl++;
+ } else {
+ if ($keyword ne lc $keyword and
+ (lc $keyword eq 'no' or lc $keyword eq 'binary-targets')) {
+ error(g_('%s field keyword "%s" is uppercase; use "%s" instead'),
+ 'Rules-Requires-Root', $keyword, lc $keyword);
+ } elsif (lc $keyword eq 'yes') {
+ error(g_('%s field keyword "%s" is invalid; use "%s" instead'),
+ 'Rules-Requires-Root', $keyword, 'binary-targets');
+ } elsif ($keyword ne 'no' and $keyword ne 'binary-targets') {
+ warning(g_('%s field keyword "%s" is unknown'),
+ 'Rules-Requires-Root', $keyword);
+ }
+ $keywords_base++;
+ }
+
+ if ($rrr{$keyword}++) {
+ error(g_('field %s contains duplicate keyword %s'),
+ 'Rules-Requires-Root', $keyword);
+ }
+ }
+
+ if ($self->{as_root} || ! exists $rrr{no}) {
+ $self->_setup_rootcommand();
+ }
+
+ # Notify the children we do support R³.
+ $ENV{DEB_RULES_REQUIRES_ROOT} = join ' ', sort keys %rrr;
+
+ if ($keywords_base > 1 or $keywords_base and $keywords_impl) {
+ error(g_('%s field contains both global and implementation specific keywords'),
+ 'Rules-Requires-Root');
+ } elsif ($keywords_impl) {
+ # Set only on <implementations-keywords>.
+ $ENV{DEB_GAIN_ROOT_CMD} = join ' ', @{$self->{root_cmd}};
+ } else {
+ # We should not provide the variable otherwise.
+ delete $ENV{DEB_GAIN_ROOT_CMD};
+ }
+
+ return \%rrr;
+}
+
+sub _rules_requires_root {
+ my ($self, $target) = @_;
+
+ return 1 if $self->{as_root};
+ return 1 if $self->{rules_requires_root}{"dpkg/target/$target"};
+ return 1 if $self->{rules_requires_root}{'binary-targets'} and $target_legacy_root{$target};
+ return 0;
+}
+
+sub _run_cmd {
+ my @cmd = @_;
+ printcmd(@cmd);
+ system @cmd and subprocerr("@cmd");
+}
+
+sub _run_rules_cond_root {
+ my ($self, $target) = @_;
+
+ my @cmd;
+ push @cmd, @{$self->{root_cmd}} if $self->_rules_requires_root($target);
+ push @cmd, @{$self->{debian_rules}}, $target;
+
+ _run_cmd(@cmd);
+}
+
+=item $bd->pre_check()
+
+Perform build driver specific checks, before anything else.
+
+This checks whether the F<debian/rules> file is executable,
+and if not then make it so.
+
+=cut
+
+sub pre_check {
+ my $self = shift;
+
+ if (@{$self->{debian_rules}} == 1 && ! -x $self->{debian_rules}[0]) {
+ warning(g_('%s is not executable; fixing that'),
+ $self->{debian_rules}[0]);
+ # No checks of failures, non fatal.
+ chmod 0755, $self->{debian_rules}[0];
+ }
+}
+
+=item $bool = $bd->need_build_task($build_task, $binary_task)
+
+Returns whether we need to use the build task.
+
+B<Note>: This method is needed as long as we support building as root-like.
+Once that is not needed this method will be deprecated.
+
+=cut
+
+sub need_build_task {
+ my ($self, $build_task, $binary_task) = @_;
+
+ # If we are building rootless, there is no need to call the build target
+ # independently as non-root.
+ return 0 if not $self->_rules_requires_root($binary_task);
+ return 1;
+}
+
+=item $bd->run_build_task($build_task, $binary_task)
+
+Executes the build task for the build.
+
+B<Note>: This method is needed as long as we support building as root-like.
+Once that is not needed this method will be deprecated.
+
+=cut
+
+sub run_build_task {
+ my ($self, $build_task, $binary_task) = @_;
+
+ # If we are building rootless, there is no need to call the build
+ # target independently as non-root.
+ if ($self->_rules_requires_root($binary_task)) {
+ _run_cmd(@{$self->{debian_rules}}, $build_task)
+ }
+
+ return;
+}
+
+=item $bd->run_task($task)
+
+Executes the given task for the build.
+
+=cut
+
+sub run_task {
+ my ($self, $task) = @_;
+
+ $self->_run_rules_cond_root($task);
+
+ return;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/FieldsCore.pm b/scripts/Dpkg/Control/FieldsCore.pm
index 0c024ab..38fa774 100644
--- a/scripts/Dpkg/Control/FieldsCore.pm
+++ b/scripts/Dpkg/Control/FieldsCore.pm
@@ -1,4 +1,5 @@
# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2024 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
@@ -174,6 +175,10 @@ our %FIELDS = (
dependency => 'normal',
dep_order => 3,
},
+ 'build-driver' => {
+ name => 'Build-Driver',
+ allowed => CTRL_TMPL_SRC,
+ },
'build-essential' => {
name => 'Build-Essential',
allowed => ALL_PKG,
diff --git a/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm b/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
index 6c834be..43ac1e2 100644
--- a/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
+++ b/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
@@ -34,7 +34,9 @@ use strict;
use warnings;
use POSIX qw(:sys_wait_h);
+use File::Basename;
use File::Temp;
+use File::Copy;
use MIME::Base64;
use Dpkg::ErrorHandling;
@@ -296,6 +298,18 @@ sub inline_sign {
return OPENPGP_MISSING_CMD if ! $self->has_backend_cmd();
+ my $file = basename($data);
+ my $signdir = File::Temp->newdir('dpkg-sign.XXXXXXXX', TMPDIR => 1);
+ my $signfile = "$signdir/$file";
+
+ # Make sure the file to sign ends with a newline, as GnuPG does not adhere
+ # to the OpenPGP specification (see <https://dev.gnupg.org/T7106>).
+ copy($data, $signfile);
+ open my $signfh, '>>', $signfile
+ or syserr(g_('cannot open %s'), $signfile);
+ print { $signfh } "\n";
+ close $signfh or syserr(g_('cannot close %s'), $signfile);
+
my @exec = ($self->{cmd});
push @exec, _gpg_options_weak_digests();
push @exec, qw(--utf8-strings --textmode --armor);
diff --git a/scripts/Dpkg/OpenPGP/ErrorCodes.pm b/scripts/Dpkg/OpenPGP/ErrorCodes.pm
index 0db59aa..3a67dd8 100644
--- a/scripts/Dpkg/OpenPGP/ErrorCodes.pm
+++ b/scripts/Dpkg/OpenPGP/ErrorCodes.pm
@@ -1,4 +1,4 @@
-# Copyright © 2022 Guillem Jover <guillem@debian.org>
+# Copyright © 2022-2024 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
@@ -44,7 +44,12 @@ our @EXPORT = qw(
OPENPGP_MISSING_INPUT
OPENPGP_KEY_IS_PROTECTED
OPENPGP_UNSUPPORTED_SUBCMD
+ OPENPGP_UNSUPPORTED_SPECIAL_PREFIX
+ OPENPGP_AMBIGUOUS_INPUT
OPENPGP_KEY_CANNOT_SIGN
+ OPENPGP_INCOMPATIBLE_OPTIONS
+ OPENPGP_NO_HW_KEY_FOUND
+ OPENPGP_HW_KEY_FAILURE
OPENPGP_MISSING_CMD
OPENPGP_NEEDS_KEYSTORE
@@ -58,7 +63,7 @@ use Exporter qw(import);
use Dpkg::Gettext;
# Error codes based on
-# https://ietf.org/archive/id/draft-dkg-openpgp-stateless-cli-04.html#section-6
+# https://ietf.org/archive/id/draft-dkg-openpgp-stateless-cli-10.html#section-7
#
# Local error codes use a negative number, as that should not conflict with
# the SOP exit codes.
@@ -74,7 +79,12 @@ use constant {
OPENPGP_MISSING_INPUT => 61,
OPENPGP_KEY_IS_PROTECTED => 67,
OPENPGP_UNSUPPORTED_SUBCMD => 69,
+ OPENPGP_UNSUPPORTED_SPECIAL_PREFIX => 71,
+ OPENPGP_AMBIGUOUS_INPUT => 73,
OPENPGP_KEY_CANNOT_SIGN => 79,
+ OPENPGP_INCOMPATIBLE_OPTIONS => 83,
+ OPENPGP_NO_HW_KEY_FOUND => 97,
+ OPENPGP_HW_KEY_FAILURE => 101,
OPENPGP_MISSING_CMD => -1,
OPENPGP_NEEDS_KEYSTORE => -2,
@@ -92,7 +102,12 @@ my %code2error = (
OPENPGP_MISSING_INPUT() => N_('input file does not exist'),
OPENPGP_KEY_IS_PROTECTED() => N_('cannot unlock password-protected key'),
OPENPGP_UNSUPPORTED_SUBCMD() => N_('unsupported subcommand'),
+ OPENPGP_UNSUPPORTED_SPECIAL_PREFIX() => N_('unknown special designator in indirect parameter'),
+ OPENPGP_AMBIGUOUS_INPUT() => N_('special designator in indirect parameter is an existing file'),
OPENPGP_KEY_CANNOT_SIGN() => N_('key is not signature-capable'),
+ OPENPGP_INCOMPATIBLE_OPTIONS() => N_('mutually exclusive options'),
+ OPENPGP_NO_HW_KEY_FOUND() => N_('cannot identify hardware device for hardware-backed secret keys'),
+ OPENPGP_HW_KEY_FAILURE() => N_('cannot perform operation on hardware-backed secret key'),
OPENPGP_MISSING_CMD() => N_('missing OpenPGP implementation'),
OPENPGP_NEEDS_KEYSTORE() => N_('specified key needs a keystore'),
diff --git a/scripts/Dpkg/Shlibs/Cppfilt.pm b/scripts/Dpkg/Shlibs/Cppfilt.pm
index 1f054a1..010fe66 100644
--- a/scripts/Dpkg/Shlibs/Cppfilt.pm
+++ b/scripts/Dpkg/Shlibs/Cppfilt.pm
@@ -96,8 +96,14 @@ sub cppfilt_demangle {
my $demangled = readline($filt->{to});
chop $demangled;
- # If the symbol was not demangled, return undef
- $demangled = undef if $symbol eq $demangled;
+ # If the symbol was not demangled, return undef. Otherwise normalize
+ # it as llvm packs ending angle brackets with no intermediate spaces
+ # as allowed by C++11, contrary to GNU binutils.
+ if ($symbol eq $demangled) {
+ $demangled = undef;
+ } else {
+ $demangled =~ s{(?<=>)(?=>)}{ }g;
+ }
# Remember the last result
$filt->{last_symbol} = $symbol;
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
index 3427383..3d336a1 100644
--- a/scripts/Dpkg/Source/Package.pm
+++ b/scripts/Dpkg/Source/Package.pm
@@ -29,7 +29,7 @@ is the one that supports the extraction of the source package.
=cut
-package Dpkg::Source::Package 2.02;
+package Dpkg::Source::Package 2.03;
use strict;
use warnings;
@@ -389,6 +389,21 @@ sub get_basename {
return $f->{'Source'} . '_' . $vs;
}
+=item $p->get_basedirname()
+
+Returns the default base directory name for the package.
+
+=cut
+
+sub get_basedirname {
+ my $self = shift;
+
+ my $dirname = $self->get_basename();
+ $dirname =~ s/_/-/;
+
+ return $dirname;
+}
+
sub find_original_tarballs {
my ($self, %opts) = @_;
$opts{extension} //= compression_get_file_extension_regex();
@@ -699,17 +714,21 @@ sub write_dsc {
=head1 CHANGES
+=head2 Version 2.03 (dpkg 1.22.7)
+
+New method: $p->get_basedirname().
+
=head2 Version 2.02 (dpkg 1.21.10)
-New method: armor_original_tarball_signature().
+New method: $p->armor_original_tarball_signature().
=head2 Version 2.01 (dpkg 1.20.1)
-New method: get_upstream_signing_key().
+New method: $p->get_upstream_signing_key().
=head2 Version 2.00 (dpkg 1.20.0)
-New method: check_original_tarball_signature().
+New method: $p->check_original_tarball_signature().
Remove variable: $diff_ignore_default_regexp.
@@ -721,12 +740,12 @@ New option: format in new().
=head2 Version 1.02 (dpkg 1.18.7)
-New option: require_strong_checksums in check_checksums().
+New option: require_strong_checksums in $p->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()
+New functions: $p->get_default_diff_ignore_regex(),
+$p->set_default_diff_ignore_regex(), $p->get_default_tar_ignore_pattern().
Deprecated variables: $diff_ignore_default_regexp, @tar_ignore_default_pattern
diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm
index bdf2c87..566fd24 100644
--- a/scripts/Dpkg/Source/Package/V1.pm
+++ b/scripts/Dpkg/Source/Package/V1.pm
@@ -291,8 +291,7 @@ sub do_build {
my $sourcepackage = $self->{fields}{'Source'};
my $basenamerev = $self->get_basename(1);
my $basename = $self->get_basename();
- my $basedirname = $basename;
- $basedirname =~ s/_/-/;
+ my $basedirname = $self->get_basedirname();
# Try to find a .orig tarball for the package
my $origdir = "$dir.orig";
diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm
index 1f09461..a3d6c49 100644
--- a/scripts/Dpkg/Source/Package/V2.pm
+++ b/scripts/Dpkg/Source/Package/V2.pm
@@ -406,8 +406,7 @@ sub check_patches_applied {
sub _generate_patch {
my ($self, $dir, %opts) = @_;
my ($dirname, $updir) = fileparse($dir);
- my $basedirname = $self->get_basename();
- $basedirname =~ s/_/-/;
+ my $basedirname = $self->get_basedirname();
# Identify original tarballs
my ($tarfile, %addonfile);
diff --git a/scripts/Dpkg/Source/Package/V3/Bzr.pm b/scripts/Dpkg/Source/Package/V3/Bzr.pm
index adc5fda..953f7d9 100644
--- a/scripts/Dpkg/Source/Package/V3/Bzr.pm
+++ b/scripts/Dpkg/Source/Package/V3/Bzr.pm
@@ -109,9 +109,6 @@ sub do_build {
my $sourcepackage = $self->{fields}{'Source'};
my $basenamerev = $self->get_basename(1);
- my $basename = $self->get_basename();
- my $basedirname = $basename;
- $basedirname =~ s/_/-/;
_check_workdir($dir);
@@ -179,7 +176,6 @@ sub do_extract {
my ($self, $newdirectory) = @_;
my $fields = $self->{fields};
- my $basename = $self->get_basename();
my $basenamerev = $self->get_basename(1);
my @files = $self->get_files();
diff --git a/scripts/Dpkg/Substvars.pm b/scripts/Dpkg/Substvars.pm
index cf55194..7150c30 100644
--- a/scripts/Dpkg/Substvars.pm
+++ b/scripts/Dpkg/Substvars.pm
@@ -1,4 +1,4 @@
-# Copyright © 2006-2009, 2012-2020, 2022 Guillem Jover <guillem@debian.org>
+# Copyright © 2006-2024 Guillem Jover <guillem@debian.org>
# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
#
# This program is free software; you can redistribute it and/or modify
@@ -26,7 +26,7 @@ It provides a class which is able to substitute variables in strings.
=cut
-package Dpkg::Substvars 2.01;
+package Dpkg::Substvars 2.02;
use strict;
use warnings;
@@ -48,6 +48,7 @@ use constant {
SUBSTVAR_ATTR_AGED => 4,
SUBSTVAR_ATTR_OPT => 8,
SUBSTVAR_ATTR_DEEP => 16,
+ SUBSTVAR_ATTR_REQ => 32,
};
=head1 METHODS
@@ -190,13 +191,14 @@ sub parse {
next if m/^\s*\#/ || !m/\S/;
s/\s*\n$//;
- if (! m/^(\w[-:0-9A-Za-z]*)(\?)?\=(.*)$/) {
+ if (! m/^(\w[-:0-9A-Za-z]*)([?!])?\=(.*)$/) {
error(g_('bad line in substvars file %s at line %d'),
$varlistfile, $.);
}
## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
if (defined $2) {
$attr = (SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_OPT) if $2 eq '?';
+ $attr = (SUBSTVAR_ATTR_REQ) if $2 eq '!';
}
$self->set($1, $3, $attr);
$count++;
@@ -378,9 +380,16 @@ sub warn_about_unused {
# that they are not required in the current situation
# (example: debhelper's misc:Depends in many cases)
next if $self->{vars}{$vn} eq '';
- warning($opts{msg_prefix} .
- g_('substitution variable ${%s} unused, but is defined'),
- $vn);
+
+ if ($self->{attr}{$vn} & SUBSTVAR_ATTR_REQ) {
+ error($opts{msg_prefix} .
+ g_('required substitution variable ${%s} not used'),
+ $vn);
+ } else {
+ warning($opts{msg_prefix} .
+ g_('substitution variable ${%s} unused, but is defined'),
+ $vn);
+ }
}
}
@@ -434,7 +443,14 @@ sub output {
# Store all non-automatic substitutions only
foreach my $vn (sort keys %{$self->{vars}}) {
next if $self->{attr}{$vn} & SUBSTVAR_ATTR_AUTO;
- my $op = $self->{attr}{$vn} & SUBSTVAR_ATTR_OPT ? '?=' : '=';
+ my $op;
+ if ($self->{attr}{$vn} & SUBSTVAR_ATTR_OPT) {
+ $op = '?=';
+ } elsif ($self->{attr}{$vn} & SUBSTVAR_ATTR_REQ) {
+ $op = '!=';
+ } else {
+ $op = '=';
+ }
my $line = "$vn$op" . $self->{vars}{$vn} . "\n";
print { $fh } $line if defined $fh;
$str .= $line;
@@ -451,6 +467,10 @@ indicated file.
=head1 CHANGES
+=head2 Version 2.02 (dpkg 1.22.7)
+
+New feature: Add support for required substitution variables.
+
=head2 Version 2.01 (dpkg 1.21.8)
New feature: Add support for optional substitution variables.
diff --git a/scripts/Dpkg/Vendor/Debian.pm b/scripts/Dpkg/Vendor/Debian.pm
index b3be69e..edf94bc 100644
--- a/scripts/Dpkg/Vendor/Debian.pm
+++ b/scripts/Dpkg/Vendor/Debian.pm
@@ -1,5 +1,5 @@
# Copyright © 2009-2011 Raphaël Hertzog <hertzog@debian.org>
-# Copyright © 2009, 2011-2017 Guillem Jover <guillem@debian.org>
+# Copyright © 2009-2024 Guillem Jover <guillem@debian.org>
#
# Hardening build flags handling derived from work of:
# Copyright © 2009-2011 Kees Cook <kees@debian.org>
@@ -88,7 +88,21 @@ sub run_hook {
# Reset umask to a sane default.
umask 0022;
# Reset locale to a sane default.
+ #
+ # We ignore the LANGUAGE GNU extension, as that only affects
+ # LC_MESSAGES which will use LC_CTYPE for its codeset. We need to
+ # move the high priority LC_ALL catch-all into the low-priority
+ # LANG catch-all so that we can override LC_* variables, and remove
+ # any existing LC_* variables which would have been ignored anyway,
+ # and would now take precedence over LANG.
+ if (length $ENV{LC_ALL}) {
+ $ENV{LANG} = delete $ENV{LC_ALL};
+ foreach my $lc (grep { m/^LC_/ } keys %ENV) {
+ delete $ENV{$lc};
+ }
+ }
$ENV{LC_COLLATE} = 'C.UTF-8';
+ $ENV{LC_CTYPE} = 'C.UTF-8';
} elsif ($hook eq 'backport-version-regex') {
return qr/~(bpo|deb)/;
} else {
@@ -449,9 +463,7 @@ sub add_build_flags {
}
$flags->append($_, $default_flags) foreach @compile_flags;
- $flags->append($_ . '_FOR_BUILD', $default_flags) foreach @compile_flags;
$flags->append('DFLAGS', $default_d_flags);
- $flags->append('DFLAGS_FOR_BUILD', $default_d_flags);
## Area: abi
@@ -479,6 +491,8 @@ sub add_build_flags {
# Warnings that detect actual bugs.
if ($flags->use_feature('qa', 'bug-implicit-func')) {
$flags->append('CFLAGS', '-Werror=implicit-function-declaration');
+ } else {
+ $flags->append('CFLAGS', '-Wno-error=implicit-function-declaration');
}
if ($flags->use_feature('qa', 'bug')) {
# C/C++ flags
@@ -632,6 +646,23 @@ sub add_build_flags {
$flags->append($_, $flag) foreach @compile_flags;
}
}
+
+ # XXX: Handle *_FOR_BUILD flags here until we can properly initialize them.
+ require Dpkg::Arch;
+
+ my $host_arch = Dpkg::Arch::get_host_arch();
+ my $build_arch = Dpkg::Arch::get_build_arch();
+
+ if ($host_arch eq $build_arch) {
+ foreach my $flag ($flags->list()) {
+ next if $flag =~ m/_FOR_BUILD$/;
+ my $value = $flags->get($flag);
+ $flags->append($flag . '_FOR_BUILD', $value);
+ }
+ } else {
+ $flags->append($_ . '_FOR_BUILD', $default_flags) foreach @compile_flags;
+ $flags->append('DFLAGS_FOR_BUILD', $default_d_flags);
+ }
}
sub _build_tainted_by {
diff --git a/scripts/Dpkg/Vendor/Ubuntu.pm b/scripts/Dpkg/Vendor/Ubuntu.pm
index f907fa9..1633220 100644
--- a/scripts/Dpkg/Vendor/Ubuntu.pm
+++ b/scripts/Dpkg/Vendor/Ubuntu.pm
@@ -177,7 +177,7 @@ sub add_build_flags {
if ($cpu eq 'arm64') {
$flag = '-mbranch-protection=none';
} elsif ($cpu eq 'amd64') {
- $flag = '-fno-cf-protection';
+ $flag = '-fcf-protection=none';
}
if (defined $flag) {
$flags->append($_, $flag) foreach @compile_flags;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-07 20:53:43 +0000