1
0
Fork 0
devscripts/lib/Devscripts/Uscan/Keyring.pm
Daniel Baumann b543f2e88d
Adding upstream version 2.25.15.
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
2025-06-21 11:04:07 +02:00

317 lines
10 KiB
Perl

package Devscripts::Uscan::Keyring;
use strict;
use Devscripts::Uscan::Output;
use Devscripts::Uscan::Utils;
use Dpkg::IPC;
use Dpkg::Path qw/find_command/;
use File::Copy qw/copy move/;
use File::Path qw/make_path remove_tree/;
use File::Temp qw/tempfile tempdir/;
use List::Util qw/first/;
use MIME::Base64;
# _pgp_* functions are strictly for applying or removing ASCII armor.
# see https://www.rfc-editor.org/rfc/rfc9580.html#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_unarmor_data {
my ($type, $data, $filename) = @_;
# note that we ignore an incorrect or absent checksum, following the
# guidance of
# https://www.rfc-editor.org/rfc/rfc9580.html#section-6.1-3
my $armor_regex = qr{
-----BEGIN\ PGP\ \Q$type\E-----[\r\t ]*\n
(?:[^:\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;
my $blocks = 0;
my $binary;
while ($data =~ m/$armor_regex/g) {
$binary .= decode_base64($1);
$blocks++;
}
if ($blocks > 1) {
uscan_warn "Found multiple concatenated ASCII Armor blocks in\n"
. " $filename, which is not an interoperable construct.\n"
. " See <https://tests.sequoia-pgp.org/results.html#ASCII_Armor>.\n"
. " Please concatenate them into a single ASCII Armor block. For example:\n"
. " sq keyring merge --overwrite --output $filename \\\n"
. " $filename";
}
return $binary;
}
sub _pgp_armor_checksum {
my ($data) = @_;
# from https://www.rfc-editor.org/rfc/rfc9580.html#section-6.1.1
#
# #define CRC24_INIT 0xB704CEL
# #define CRC24_GENERATOR 0x864CFBL
# typedef unsigned long crc24;
# crc24 crc_octets(unsigned char *octets, size_t len)
# {
# crc24 crc = CRC24_INIT;
# int i;
# while (len--) {
# crc ^= (*octets++) << 16;
# for (i = 0; i < 8; i++) {
# crc <<= 1;
# if (crc & 0x1000000) {
# crc &= 0xffffff; /* Clear bit 25 to avoid overflow */
# crc ^= CRC24_GENERATOR;
# }
# }
# }
# return crc & 0xFFFFFFL;
# }
#
# 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) {
$crc &= 0xffffff; # Clear bit 25 to avoid overflow
$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 new {
my ($class) = @_;
my $keyring;
my $havegpgv = first { find_command($_) } qw(gpgv);
my $havesopv = first { find_command($_) } qw(sopv);
my $havesop
= first { find_command($_) } qw(sqop rsop pgpainless-cli gosop);
uscan_die("Please install a sopv variant.")
unless (defined $havegpgv or defined $havesopv);
# upstream/signing-key.pgp and upstream-signing-key.pgp are deprecated
# but supported
if (-r "debian/upstream/signing-key.asc") {
$keyring = "debian/upstream/signing-key.asc";
} else {
my $binkeyring = first { -r $_ } qw(
debian/upstream/signing-key.pgp
debian/upstream-signing-key.pgp
);
if (defined $binkeyring) {
make_path('debian/upstream', { mode => 0700, verbose => 'true' });
# convert to the policy complying armored key
uscan_verbose(
"Found upstream binary signing keyring: $binkeyring");
# Need to convert to an armored key
$keyring = "debian/upstream/signing-key.asc";
uscan_warn "Found deprecated binary keyring ($binkeyring). "
. "Please save it in armored format in $keyring. For example:\n"
. " sop armor < $binkeyring > $keyring";
if ($havesop) {
spawn(
exec => [$havesop, 'armor'],
from_file => $binkeyring,
to_file => $keyring,
wait_child => 1,
);
} else {
open my $inkeyring, '<', $binkeyring
or uscan_warn(
"Can't open $binkeyring to read deprecated binary keyring"
);
read $inkeyring, my $keycontent, -s $inkeyring;
close $inkeyring;
open my $outkeyring, '>', $keyring
or uscan_warn(
"Can't open $keyring for writing ASCII-armored keyring");
my $outkey = _pgp_armor_data('PUBLIC KEY BLOCK', $keycontent);
print $outkeyring $outkey
or
uscan_warn("Can't write ASCII-armored keyring to $keyring");
close $outkeyring or uscan_warn("Failed to close $keyring");
}
uscan_warn("Generated upstream signing keyring: $keyring");
move $binkeyring, "$binkeyring.backup";
uscan_verbose(
"Renamed upstream binary signing keyring: $binkeyring.backup");
}
}
# Need to convert an armored key to binary for use by gpgv
if (defined $keyring) {
uscan_verbose("Found upstream signing keyring: $keyring");
if ($keyring =~ m/\.asc$/ && !defined $havesopv)
{ # binary keyring is only necessary for gpgv:
my $pgpworkdir = tempdir(CLEANUP => 1);
my $newkeyring = "$pgpworkdir/upstream-signing-key.pgp";
open my $inkeyring, '<', $keyring
or uscan_die("Can't open keyring file $keyring");
read $inkeyring, my $keycontent, -s $inkeyring;
close $inkeyring;
my $binkey
= _pgp_unarmor_data('PUBLIC KEY BLOCK', $keycontent, $keyring);
if ($binkey) {
open my $outkeyring, '>:raw', $newkeyring
or uscan_die("Can't write to temporary keyring $newkeyring");
print $outkeyring $binkey
or uscan_die("Can't write $newkeyring");
close $outkeyring or uscan_die("Can't close $newkeyring");
$keyring = $newkeyring;
} else {
uscan_die("Failed to dearmor key(s) from $keyring");
}
}
}
# Return undef if not key found
else {
return undef;
}
my $self = bless {
keyring => $keyring,
gpgv => $havegpgv,
sopv => $havesopv,
}, $class;
return $self;
}
sub verify {
my ($self, $sigfile, $newfile) = @_;
uscan_verbose(
"Verifying OpenPGP self signature of $newfile and extract $sigfile");
if ($self->{sopv}) {
spawn(
exec => [$self->{sopv}, 'inline-verify', $self->{keyring}],
from_file => $newfile,
to_file => $sigfile,
wait_child => 1
) or uscan_die("OpenPGP signature did not verify.");
} else {
unless (
uscan_exec_no_fail(
$self->{gpgv},
'--homedir' => '/dev/null',
'--keyring' => $self->{keyring},
'-o' => "$sigfile",
"$newfile"
) >> 8 == 0
) {
uscan_die("OpenPGP signature did not verify.");
}
}
}
sub verifyv {
my ($self, $sigfile, $base) = @_;
uscan_verbose("Verifying OpenPGP signature $sigfile for $base");
if ($self->{sopv}) {
spawn(
exec => [$self->{sopv}, 'verify', $sigfile, $self->{keyring}],
from_file => $base,
wait_child => 1
) or uscan_die("OpenPGP signature did not verify.");
} else {
unless (
uscan_exec_no_fail(
$self->{gpgv},
'--homedir' => '/dev/null',
'--keyring' => $self->{keyring},
$sigfile, $base
) >> 8 == 0
) {
uscan_die("OpenPGP signature did not verify.");
}
}
}
sub verify_git {
my ($self, $gitdir, $tag, $git_upstream) = @_;
my $commit;
my @dir = $git_upstream ? () : ('--git-dir', $gitdir);
spawn(
exec => ['git', @dir, 'show-ref', $tag],
to_string => \$commit
);
uscan_die "git tag not found" unless ($commit);
$commit =~ s/\s.*$//;
chomp $commit;
my $file;
spawn(
exec => ['git', @dir, 'cat-file', '-p', $commit],
to_string => \$file
);
my $dir;
spawn(exec => ['mktemp', '-d'], to_string => \$dir);
chomp $dir;
unless ($file =~ /^(.*?\n)(\-+\s*BEGIN PGP SIGNATURE\s*\-+.*)$/s) {
uscan_die "Tag $tag is not signed";
}
open F, ">$dir/txt" or die $!;
open S, ">$dir/sig" or die $!;
print F $1;
print S $2;
close F;
close S;
if ($self->{sopv}) {
spawn(
exec => [$self->{sopv}, 'verify', "$dir/sig", $self->{keyring}],
from_file => "$dir/txt",
wait_child => 1
) or uscan_die("OpenPGP signature did not verify");
} else {
unless (
uscan_exec_no_fail(
$self->{gpgv},
'--homedir' => '/dev/null',
'--keyring' => $self->{keyring},
"$dir/sig", "$dir/txt"
) >> 8 == 0
) {
uscan_die("OpenPGP signature did not verify.");
}
}
remove_tree($dir);
}
1;