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;
die $ob;
}
+\f
+
+=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, @_ }
+
+
\f
=back
$complete = 1;
};
+ # sending a report uses the key index
+ keyidx_attach;
+
if ($complete) {
local $Phase = 'RP';
our $Scratch_dir;
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",
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
projects / gatekeeper.git / commitdiff