Merging upstream version 1.22.7.

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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;