From 9b677cc77efc5f997de73ac21ee0bfbd47796811 Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Thu, 16 Mar 2023 22:48:12 -0500 Subject: [PATCH] Add key index support to gatekeeper The testsuite is adjusted accordingly to handle signature verfications during the report phase. --- gatekeeper.pl | 206 ++++++++++++++++++++++++++++++++++- testsuite/lib/gatekeeper.exp | 8 +- 2 files changed, 205 insertions(+), 9 deletions(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index 3921bab..036d879 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -172,11 +172,13 @@ use constant (); # load this now for use in later BEGIN blocks use Carp qw(cluck); # for stack trace on error in ftp_syslog -use Fcntl qw(F_GETFD F_SETFD FD_CLOEXEC +use Fcntl qw(LOCK_SH LOCK_EX LOCK_UN + F_GETFD F_SETFD FD_CLOEXEC F_GETFL F_SETFL O_NONBLOCK - O_WRONLY O_CREAT O_EXCL); + O_RDONLY O_WRONLY O_CREAT O_EXCL); use FindBin; +use SDBM_File; use File::Spec; use Pod::Usage; @@ -885,6 +887,154 @@ sub throw { die $ob; } + + +=back + +=head2 Keyring Index access + +=over + +=cut + +use constant KEYIDX_NAME => 'keyindex'; +use constant KEYIDX_REV => 1; + +=item keyidx_attach + +Establish the connection to the key index database and acquire the lock. + +=cut + +sub keyidx_attach { + our %KeyIndex; + + return if tied %KeyIndex; # already attached? + + my $dbstem = File::Spec->catfile($package_config_base, KEYIDX_NAME); + + open KEYIDXLOCK, '+>', $dbstem.'.flag' + or die "open key index lock file: $!"; + flock KEYIDXLOCK, LOCK_SH + or die "lock key index: $!"; + + tie %KeyIndex, 'SDBM_File', $dbstem, O_RDONLY, 0666 + or die "tie key index: $!"; + + die "key index uses unsupported newer revision ". + $KeyIndex{__index_format_revision} + if $KeyIndex{__index_format_revision} > KEYIDX_REV; +} + +END { + our %KeyIndex; + # This dance ensures that the reference to the tied object behind + # %KeyIndex is dropped before %KeyIndex is untied to avoid a warning. + my $is_tied = defined tied %KeyIndex; + untie %KeyIndex if $is_tied; + # The lock on the flag file is released when the file is implicitly + # closed as this program exits. +} + +=item $boolean = _keyidx_chk $key + +Return true if a value for KEY exists in the key index. + +=cut + +sub _keyidx_chk { + my $key = shift; + + our %KeyIndex; + + if ($key =~ m/^[[:upper:]]/) + { return exists $KeyIndex{$key.'-'.0} } + elsif ($key =~ m/^[[:lower:]]/) + { return exists $KeyIndex{$key} } + else { return undef } +} + +=item @values = _keyidx_get $key + +Retrieve a set of values from the key index. + +=cut + +sub _keyidx_get { + my $key = shift; + + our %KeyIndex; + + my @ret; + + if ($key =~ m/^[[:upper:]]/) { + for (my $i = 0; exists $KeyIndex{$key.'-'.$i}; $i++) + { push @ret, $KeyIndex{$key.'-'.$i} } + } elsif ($key =~ m/^[[:lower:]]/) { + push @ret, $KeyIndex{$key}; + } + + return @ret; +} + +=item @fingerprints = keyidx_resolve $id_or_fingerprint... + +Resolve a set of key IDs or fingerprints (possibly subkey fingerprints) to +a set of candidate primary key fingerprints known to the system. + +This returns a set, even if given only one item, because RFC4880 requires +implementations be able to handle key ID collisions. In the event of a key +ID collision, at most one of the candidate keys is expected to be able to +verify the signature. + +Note that the returned values really are candidates and actually verifying +the signature is required because producing a fake signature claiming to be +from any key ID is trivial. + +=cut + +sub keyidx_resolve { + my @queries = map uc, @_; + + my @fingerprints; + + foreach my $id (@queries) { + if (_keyidx_chk 'Li'.$id) { push @fingerprints, _keyidx_get 'Li'.$id } + else { push @fingerprints, $id } + } + + return map _keyidx_get('kf'.$_), @fingerprints; +} + +=item @keyrings = keyidx_locate $fingerprint... + +Return a set of keyrings where the index indicates a key with the given +primary key fingerprint can be found. + +This is used for verifying signatures for keys known to the system but not +allowed access to the directory requested in a directive, or in other +words, authenticating uploads where authorization checks have failed. + +=cut + +sub keyidx_locate { + my @directories = map _keyidx_get('Df'.uc), grep defined, @_; + + return map File::Spec->catfile + ($package_config_base, File::Spec::Unix->splitdir($_), 'pubring.gpg'), + @directories; +} + +=item @addresses = keyidx_email $fingerprint... + +Return a set of email addresses for the key with the given primary key +fingerprint. + +=cut + +sub keyidx_email { return map _keyidx_get('Ef'.uc), grep defined, @_ } + + =back @@ -2869,6 +3019,9 @@ foreach my $packet (@packets) { # each list element is an array reference $complete = 1; }; + # sending a report uses the key index + keyidx_attach; + if ($complete) { local $Phase = 'RP'; our $Scratch_dir; @@ -2879,6 +3032,11 @@ foreach my $packet (@packets) { # each list element is an array reference defined $op_header->{package} ? $op_header->{package} : ''); + # Successfully verifying a signature also yields a key fingerprint. + push @email_addresses, keyidx_email($dsig_info->{key_fingerprint}); + push @email_addresses, keyidx_email($fsig_info->{key_fingerprint}) + if $fsig_info; + # report success if ($directive_only) { mail "processing of $directive_file complete", @@ -2900,9 +3058,47 @@ foreach my $packet (@packets) { # each list element is an array reference my $E = $@; # preserve the exception, since many functions use eval - # TODO: rework this check to use the key ID index (also TODO) to locate - # which keyring _does_ have the key, then verify the signature to - # determine whether to send the directive to the public archive + { my @fprs; # scratchpad for key fingerprints of valid signatures + + last unless $directive_text; # skip if no signature at all + + my $key_id; + + if (defined $dsig_info) { + if ($dsig_info->{key_fingerprint}) { + # This signature was successfully matched to a known key. + push @fprs, $dsig_info->{key_fingerprint} + if $dsig_info->{exitcode} == 0 && !defined $dsig_info->{TILT}; + } else { + # Only a key ID is available. + $key_id = $dsig_info->{key_longid}; + } + } else { + my $sig_info = verify_clearsigned_message($directive_text, + File::Spec->devnull); + # Verification with no keyrings at all will of course fail, but + # will extract a key ID from the signature, which we need here. + $key_id = $sig_info->{key_longid}; + } + + if (defined $key_id) { + # We have a key ID; find candidate keys and try them. + my @keyrings = keyidx_locate keyidx_resolve $key_id; + my $sig = verify_clearsigned_message($directive_text, @keyrings); + + if ($sig->{exitcode} == 0 && !defined $sig->{TILT}) { + # The signature is indeed valid, but the key that produced it + # lacks permission for the requested directory. + push @fprs, $sig->{key_fingerprint}; + } + } + + if (@fprs) { + $have_any_directive_signature = 1; + push @email_addresses, keyidx_email @fprs; + } + } + if (($oplist && $have_any_directive_signature) || (defined $dsig_info && $dsig_info->{exitcode} == 0 diff --git a/testsuite/lib/gatekeeper.exp b/testsuite/lib/gatekeeper.exp index 5d599bd..6eed9c6 100644 --- a/testsuite/lib/gatekeeper.exp +++ b/testsuite/lib/gatekeeper.exp @@ -730,24 +730,24 @@ proc analyze_log { base_dir name assess } { exp_continue } - -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|PV)\]\ + -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|RP|PV)\]\ DEBUG: [^ ]+ size is [[:digit:]]+} { # from verify_keyring, upon entry # also from check_files, twice, upon entry exp_continue } - -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|PV)\]\ + -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|RP|PV)\]\ DEBUG: gpgv command line: [^\r\n]+} { # from verify_keyring, tracing gpgv call exp_continue } - -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|PV)\]\ + -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|RP|PV)\]\ gpgv exited ([[:digit:]]+)} { # from verify_keyring, when closing pipe from gpgv set A(gpgv,exitcode,$expect_out(1,string)) 1 exp_continue } - -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|PV)\]\ + -re {^gatekeeper\[[0-9]+\]: \(Test\) \[(?:AA|RP|PV)\]\ gpg verify of directive file failed} { # from verify_keyring, when no keys match set A(gpgv,directive-verify-failed) 1 -- 2.25.1