Adding upstream version 1.22.4.upstream/1.22.4

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

3 files changed, 610 insertions, 0 deletions

diff --git a/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm b/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
new file mode 100644
index 0000000..9c53ef1
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
@@ -0,0 +1,334 @@
+# Copyright © 2007, 2022 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::OpenPGP::Backend::GnuPG - OpenPGP backend for GnuPG
+
+=head1 DESCRIPTION
+
+This module provides a class that implements the OpenPGP backend
+for GnuPG.
+
+B<Note>: This is a private module, its API can change at any time.
+
+=cut
+
+package Dpkg::OpenPGP::Backend::GnuPG 0.01;
+
+use strict;
+use warnings;
+
+use POSIX qw(:sys_wait_h);
+use File::Temp;
+use MIME::Base64;
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::File;
+use Dpkg::Path qw(find_command);
+use Dpkg::OpenPGP::ErrorCodes;
+
+use parent qw(Dpkg::OpenPGP::Backend);
+
+sub DEFAULT_CMDV {
+    return [ qw(gpgv) ];
+}
+
+sub DEFAULT_CMDSTORE {
+    return [ qw(gpg-agent) ];
+}
+
+sub DEFAULT_CMD {
+    return [ qw(gpg) ];
+}
+
+sub has_backend_cmd {
+    my $self = shift;
+
+    return defined $self->{cmd} && defined $self->{cmdstore};
+}
+
+sub has_keystore {
+    my $self = shift;
+
+    return 0 if not defined $self->{cmdstore};
+    return 1 if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) ||
+                ($ENV{HOME} && -e "$ENV{HOME}/.gnupg");
+    return 0;
+}
+
+sub can_use_key {
+    my ($self, $key) = @_;
+
+    # With gpg, a secret key always requires gpg-agent (the key store).
+    return $self->has_keystore();
+}
+
+sub has_verify_cmd {
+    my $self = shift;
+
+    return defined $self->{cmdv} || defined $self->{cmd};
+}
+
+sub get_trusted_keyrings {
+    my $self = shift;
+
+    my $keystore;
+    if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) {
+        $keystore = $ENV{GNUPGHOME};
+    } elsif ($ENV{HOME} && -e "$ENV{HOME}/.gnupg") {
+        $keystore = "$ENV{HOME}/.gnupg";
+    } else {
+        return;
+    }
+
+    my @keyrings;
+    foreach my $keyring (qw(trustedkeys.kbx trustedkeys.gpg)) {
+        push @keyrings, "$keystore/$keyring" if -r "$keystore/$keyring";
+    }
+    return @keyrings;
+}
+
+# _pgp_* functions are strictly for applying or removing ASCII armor.
+# See <https://datatracker.ietf.org/doc/html/rfc4880#section-6> for more
+# details.
+#
+# Note that these _pgp_* functions are only necessary while relying on
+# gpgv, and gpgv itself does not verify multiple signatures correctly
+# (see https://bugs.debian.org/1010955).
+
+sub _pgp_dearmor_data {
+    my ($type, $data) = @_;
+
+    # Note that we ignore an incorrect or absent checksum, following the
+    # guidance of
+    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
+    my $armor_regex = qr{
+        -----BEGIN\ PGP\ \Q$type\E-----[\r\t ]*\n
+        (?:[^:]+:\ [^\n]*[\r\t ]*\n)*
+        [\r\t ]*\n
+        ([a-zA-Z0-9/+\n]+={0,2})[\r\t ]*\n
+        (?:=[a-zA-Z0-9/+]{4}[\r\t ]*\n)?
+        -----END\ PGP\ \Q$type\E-----
+    }xm;
+
+    if ($data =~ m/$armor_regex/) {
+        return decode_base64($1);
+    }
+    return;
+}
+
+sub _pgp_armor_checksum {
+    my ($data) = @_;
+
+    # From the upcoming revision to RFC 4880
+    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
+    #
+    # The resulting three-octet-wide value then gets base64-encoded into
+    # four base64 ASCII characters.
+
+    my $CRC24_INIT = 0xB704CE;
+    my $CRC24_GENERATOR = 0x864CFB;
+
+    my @bytes = unpack 'C*', $data;
+    my $crc = $CRC24_INIT;
+    for my $b (@bytes) {
+        $crc ^= ($b << 16);
+        for (1 .. 8) {
+            $crc <<= 1;
+            if ($crc & 0x1000000) {
+                # Clear bit 25 to avoid overflow.
+                $crc &= 0xffffff;
+                $crc ^= $CRC24_GENERATOR;
+            }
+        }
+    }
+    my $sum = pack 'CCC', ($crc >> 16) & 0xff, ($crc >> 8) & 0xff, $crc & 0xff;
+    return encode_base64($sum, q{});
+}
+
+sub _pgp_armor_data {
+    my ($type, $data) = @_;
+
+    my $out = encode_base64($data, q{}) =~ s/(.{1,64})/$1\n/gr;
+    chomp $out;
+    my $crc = _pgp_armor_checksum($data);
+    my $armor = <<~"ARMOR";
+        -----BEGIN PGP $type-----
+
+        $out
+        =$crc
+        -----END PGP $type-----
+        ARMOR
+    return $armor;
+}
+
+sub armor {
+    my ($self, $type, $in, $out) = @_;
+
+    my $raw_data = file_slurp($in);
+    my $data = _pgp_dearmor_data($type, $raw_data) // $raw_data;
+    my $armor = _pgp_armor_data($type, $data);
+    return OPENPGP_BAD_DATA unless defined $armor;
+    file_dump($out, $armor);
+
+    return OPENPGP_OK;
+}
+
+sub dearmor {
+    my ($self, $type, $in, $out) = @_;
+
+    my $armor = file_slurp($in);
+    my $data = _pgp_dearmor_data($type, $armor);
+    return OPENPGP_BAD_DATA unless defined $data;
+    file_dump($out, $data);
+
+    return OPENPGP_OK;
+}
+
+sub _gpg_exec
+{
+    my ($self, @exec) = @_;
+
+    my ($stdout, $stderr);
+    spawn(exec => \@exec, wait_child => 1, nocheck => 1, timeout => 10,
+          to_string => \$stdout, error_to_string => \$stderr);
+    if (WIFEXITED($?)) {
+        my $status = WEXITSTATUS($?);
+        print { *STDERR } "$stdout$stderr" if $status;
+        return $status;
+    } else {
+        subprocerr("@exec");
+    }
+}
+
+sub _gpg_options_weak_digests {
+    my @gpg_weak_digests = map {
+        (qw(--weak-digest), $_)
+    } qw(SHA1 RIPEMD160);
+
+    return @gpg_weak_digests;
+}
+
+sub _gpg_verify {
+    my ($self, $signeddata, $sig, $data, @certs) = @_;
+
+    return OPENPGP_MISSING_CMD if ! $self->has_verify_cmd();
+
+    my $gpg_home = File::Temp->newdir('dpkg-gpg-verify.XXXXXXXX', TMPDIR => 1);
+    my @cmd_opts = qw(--no-options --no-default-keyring --batch --quiet);
+    my @gpg_opts;
+    push @gpg_opts, _gpg_options_weak_digests();
+    push @gpg_opts, '--homedir', $gpg_home;
+    push @cmd_opts, @gpg_opts;
+
+    my @exec;
+    if ($self->{cmdv}) {
+        push @exec, $self->{cmdv};
+        push @exec, @gpg_opts;
+        # We need to touch the trustedkeys.gpg keyring, otherwise gpgv will
+        # emit an error about the trustedkeys.kbx file being of unknown type.
+        file_touch("$gpg_home/trustedkeys.gpg");
+    } else {
+        push @exec, $self->{cmd};
+        push @exec, @cmd_opts;
+    }
+    foreach my $cert (@certs) {
+        my $certring = File::Temp->new(UNLINK => 1, SUFFIX => '.pgp');
+        my $rc;
+        # XXX: The internal dearmor() does not handle concatenated ASCII Armor,
+        # but the old implementation handled such certificate keyrings, so to
+        # avoid regressing for now, we fallback to use the GnuPG dearmor.
+        if ($cert =~ m{\.kbx$}) {
+            # Accept GnuPG apparent keybox-format keyrings as-is.
+            $rc = 1;
+        } elsif (defined $self->{cmd}) {
+            $rc = $self->_gpg_exec($self->{cmd}, @cmd_opts, '--yes',
+                                          '--output', $certring,
+                                          '--dearmor', $cert);
+        } else {
+            $rc = $self->dearmor('PUBLIC KEY BLOCK', $cert, $certring);
+        }
+        $certring = $cert if $rc;
+        push @exec, '--keyring', $certring;
+    }
+    push @exec, '--output', $data if defined $data;
+    if (! $self->{cmdv}) {
+        push @exec, '--verify';
+    }
+    push @exec, $sig if defined $sig;
+    push @exec, $signeddata;
+
+    my $rc = $self->_gpg_exec(@exec);
+    return OPENPGP_NO_SIG if $rc;
+    return OPENPGP_OK;
+}
+
+sub inline_verify {
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return $self->_gpg_verify($inlinesigned, undef, $data, @certs);
+}
+
+sub verify {
+    my ($self, $data, $sig, @certs) = @_;
+
+    return $self->_gpg_verify($data, $sig, undef, @certs);
+}
+
+sub inline_sign {
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_MISSING_CMD if ! $self->has_backend_cmd();
+
+    my @exec = ($self->{cmd});
+    push @exec, _gpg_options_weak_digests();
+    push @exec, qw(--utf8-strings --textmode --armor);
+    # Set conformance level.
+    push @exec, '--openpgp';
+    # Set secure algorithm preferences.
+    push @exec, '--personal-digest-preferences', 'SHA512 SHA384 SHA256 SHA224';
+    if ($key->type eq 'keyfile') {
+        # Promote the keyfile keyhandle to a keystore, this way we share the
+        # same gpg-agent and can get any password cached.
+        my $gpg_home = File::Temp->newdir('dpkg-sign.XXXXXXXX', TMPDIR => 1);
+
+        push @exec, '--homedir', $gpg_home;
+        $self->_gpg_exec(@exec, qw(--quiet --no-tty --batch --import), $key->handle);
+        $key->set('keystore', $gpg_home);
+    } elsif ($key->type eq 'keystore') {
+        push @exec, '--homedir', $key->handle;
+    } else {
+        push @exec, '--local-user', $key->handle;
+    }
+    push @exec, '--output', $inlinesigned;
+
+    my $rc = $self->_gpg_exec(@exec, '--clearsign', $data);
+    return OPENPGP_CMD_CANNOT_SIGN if $rc;
+    return OPENPGP_OK;
+}
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/Backend/SOP.pm b/scripts/Dpkg/OpenPGP/Backend/SOP.pm
new file mode 100644
index 0000000..f48cec9
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend/SOP.pm
@@ -0,0 +1,132 @@
+# Copyright © 2021-2022 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::OpenPGP::Backend::SOP - OpenPGP backend for SOP
+
+=head1 DESCRIPTION
+
+This module provides a class that implements the OpenPGP backend
+for the Stateless OpenPGP Command-Line Interface, as described in
+L<https://datatracker.ietf.org/doc/draft-dkg-openpgp-stateless-cli>.
+
+B<Note>: This is a private module, its API can change at any time.
+
+=cut
+
+package Dpkg::OpenPGP::Backend::SOP 0.01;
+
+use strict;
+use warnings;
+
+use POSIX qw(:sys_wait_h);
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::OpenPGP::ErrorCodes;
+
+use parent qw(Dpkg::OpenPGP::Backend);
+
+# - Once "gosop" implements inline-verify and inline-sign, add as alternative.
+#   Ref: https://github.com/ProtonMail/gosop/issues/6
+# - Once "gosop" can handle big keyrings.
+#   Ref: https://github.com/ProtonMail/gosop/issues/25
+# - Once "hop" implements the new SOP draft, add as alternative.
+#   Ref: https://salsa.debian.org/clint/hopenpgp-tools/-/issues/4
+# - Once the SOP MR !23 is finalized and merged, implement a way to select
+#   whether the SOP instance supports the expected draft.
+#   Ref: https://gitlab.com/dkg/openpgp-stateless-cli/-/merge_requests/23
+# - Once the SOP issue #42 is resolved we can perhaps remove the alternative
+#   dependencies and commands to check?
+#   Ref: https://gitlab.com/dkg/openpgp-stateless-cli/-/issues/42
+
+sub DEFAULT_CMD {
+    return [ qw(sqop pgpainless-cli) ];
+}
+
+sub _sop_exec
+{
+    my ($self, $io, @exec) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    $io->{out} //= '/dev/null';
+    my $stderr;
+    spawn(exec => [ $self->{cmd}, @exec ],
+          wait_child => 1, nocheck => 1, timeout => 10,
+          from_file => $io->{in}, to_file => $io->{out},
+          error_to_string => \$stderr);
+    if (WIFEXITED($?)) {
+        my $status = WEXITSTATUS($?);
+        print { *STDERR } "$stderr" if $status;
+        return $status;
+    } else {
+        subprocerr("$self->{cmd} @exec");
+    }
+}
+
+sub armor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    # We ignore the $type, and let "sop" handle this automatically.
+    return $self->_sop_exec({ in => $in, out => $out }, 'armor');
+}
+
+sub dearmor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    # We ignore the $type, and let "sop" handle this automatically.
+    return $self->_sop_exec({ in => $in, out => $out }, 'dearmor');
+}
+
+sub inline_verify
+{
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return $self->_sop_exec({ in => $inlinesigned, out => $data },
+                            'inline-verify', @certs);
+}
+
+sub verify
+{
+    my ($self, $data, $sig, @certs) = @_;
+
+    return $self->_sop_exec({ in => $data }, 'verify', $sig, @certs);
+}
+
+sub inline_sign
+{
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_NEEDS_KEYSTORE if $key->needs_keystore();
+
+    return $self->_sop_exec({ in => $data, out => $inlinesigned },
+                            qw(inline-sign --as clearsigned --), $key->handle);
+}
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/Backend/Sequoia.pm b/scripts/Dpkg/OpenPGP/Backend/Sequoia.pm
new file mode 100644
index 0000000..ae4acc1
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend/Sequoia.pm
@@ -0,0 +1,144 @@
+# Copyright © 2021-2022 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::OpenPGP::Backend::Sequoia - OpenPGP backend for Sequoia
+
+=head1 DESCRIPTION
+
+This module provides a class that implements the OpenPGP backend
+for Sequoia-PGP.
+
+B<Note>: This is a private module, its API can change at any time.
+
+=cut
+
+package Dpkg::OpenPGP::Backend::Sequoia 0.01;
+
+use strict;
+use warnings;
+
+use POSIX qw(:sys_wait_h);
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::OpenPGP::ErrorCodes;
+
+use parent qw(Dpkg::OpenPGP::Backend);
+
+sub DEFAULT_CMD {
+    return [ qw(sq) ];
+}
+
+sub _sq_exec
+{
+    my ($self, @exec) = @_;
+
+    my ($stdout, $stderr);
+    spawn(exec => [ $self->{cmd}, @exec ],
+          wait_child => 1, nocheck => 1, timeout => 10,
+          to_string => \$stdout, error_to_string => \$stderr);
+    if (WIFEXITED($?)) {
+        my $status = WEXITSTATUS($?);
+        print { *STDERR } "$stdout$stderr" if $status;
+        return $status;
+    } else {
+        subprocerr("$self->{cmd} @exec");
+    }
+}
+
+sub armor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    # We ignore the $type, and let "sq" handle this automatically.
+    my $rc = $self->_sq_exec(qw(armor --output), $out, $in);
+    return OPENPGP_BAD_DATA if $rc;
+    return OPENPGP_OK;
+}
+
+sub dearmor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    # We ignore the $type, and let "sq" handle this automatically.
+    my $rc = $self->_sq_exec(qw(dearmor --output), $out, $in);
+    return OPENPGP_BAD_DATA if $rc;
+    return OPENPGP_OK;
+}
+
+sub inline_verify
+{
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    my @opts;
+    push @opts, map { ('--signer-file', $_) } @certs;
+    push @opts, '--output', $data if defined $data;
+
+    my $rc = $self->_sq_exec(qw(verify), @opts, $inlinesigned);
+    return OPENPGP_NO_SIG if $rc;
+    return OPENPGP_OK;
+}
+
+sub verify
+{
+    my ($self, $data, $sig, @certs) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    my @opts;
+    push @opts, map { ('--signer-file', $_) } @certs;
+    push @opts, '--detached', $sig;
+
+    my $rc = $self->_sq_exec(qw(verify), @opts, $data);
+    return OPENPGP_NO_SIG if $rc;
+    return OPENPGP_OK;
+}
+
+sub inline_sign
+{
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+    return OPENPGP_NEEDS_KEYSTORE if $key->needs_keystore();
+
+    my @opts;
+    push @opts, '--cleartext-signature';
+    push @opts, '--signer-file', $key->handle;
+    push @opts, '--output', $inlinesigned;
+
+    my $rc = $self->_sq_exec('sign', @opts, $data);
+    return OPENPGP_KEY_CANNOT_SIGN if $rc;
+    return OPENPGP_OK;
+}
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;