return $old_epoch;
}
-sub read_directive_file {
- my $directive_file = shift;
- my $uploaded_file = shift;
- my $directive_only = shift;
-
- # scaffolding: will later derive file names from stem
- die "directive file name does not match expected pattern"
- unless $directive_file =~ m/^(.*)[.]directive[.]asc/;
- my $stem = $1;
- # The following error is not possible because packets are recognized by
- # their stems. This check will be removed later.
- die "uploaded file name does not match stem"
- unless $directive_only || $uploaded_file eq $stem;
-
- my $directive_file_contents = slurp_clearsigned_message($directive_file);
- my $directive = read_directive_from_string($directive_file_contents);
-
- if ($directive_file_contents eq '') {
- # This implies that the directive file did not contain a signed
- # message. There is nothing further to do.
- fatal("directive file $directive_file has no signature",0)
- }
+# temporary scaffolding; last piece of read_directive_file that does not
+# really fit elsewhere and will be removed when the new key index is
+# implemented to directly map long key IDs to email addresses
+sub guess_email_address_from_signature {
+ my $directive_file_contents = shift;
# If we don't know whose project this file belongs to, because the
# 'directory:' line is messed up or not there, we'd still like to let the
{ push(@{$info{email}},$1) }
}
}
+}
+
+=item validate_commands ( $packet, $oplist )
+
+Validate the commands in OPLIST as applicable to PACKET. PACKET is an
+arrayref listing the files considered to be in this packet. OPLIST is an
+operation list arrayref.
+
+An exception is thrown if validation fails.
+
+=cut
- my $ops = interpret_directive($directive, $directive_file_contents);
+sub validate_commands {
+ my $packet = shift;
+ my $ops = shift;
+
+ my $stem = substr $packet->[0],0,-(length '.directive.asc');
my $op_header = $ops->[0][1];
- # Phone home. E-mail the contents of the directive file to the maintainer,
- # for debugging purposes. After this point, we don't need to pass the
- # $directive_file_contents to any subsequent fatal calls.
- if (defined $op_header->{package}) {
- debug($directive_file_contents, $op_header->{package}) if DEBUG;
- } else {
- debug($directive_file_contents, '') if DEBUG;
- }
+ # scaffolding to be removed later
+ my $directive_only = (1 == scalar @$packet);
# They have to specify a version
- fatal("no version directive specified in $directive_file",1)
+ fatal("no version directive specified in $stem.directive.asc",1)
unless defined $op_header->{version};
# They have to specify a directory directive.
# Send the warning to the upload-ftp script maintainer, and the person who
# signed the file, if we were able to extract that from the signature on
# the directive file.
- fatal("no directory directive specified in $directive_file",1);
+ fatal("no directory directive specified in $stem.directive.asc",1);
}
# Configuration must exist for the package
-d $package_config_base . '/' . $op_header->{package}
or fatal("no configuration directory for package $op_header->{package}",0);
- # Check that we have a keyring for this package:
- my @keyrings = directory_keyrings($op_header->{directory});
- fatal("no keyring for package $op_header->{package}",0) if ($#keyrings < 0);
-
# Check that we actually have at least one command in the directive
unless ($#$ops > 0) {
if ($directive_only) {
fatal("nothing to do - no commands in directive file",1);
} else {
# Provide a different message if this looks like an upload packet.
- fatal("no filename directive specified in $directive_file. "
+ fatal("no filename directive specified in $stem.directive.asc. "
."Upgrade to the latest version! "
."See http://www.gnu.org/prep/maintain/maintain.html",1)
}
."\n Uploaded file: $stem\n",1)
unless $stem eq $op_header->{filename};
}
+}
- my $result = verify_clearsigned_message($directive_file_contents, @keyrings);
+=item check_replay ( $oplist, $timestamp )
- if ($result->{exitcode} != 0 || defined $result->{TILT}) {
- fatal("gpg verify of directive file failed",1,'',2);
- }
+Check that OPLIST has not been seen before. This is accomplished by
+storing directive signature timestamps, indexed by the name of the
+published file they installed. The TIMESTAMP is the signature creation
+timestamp obtained from C<verify_clearsigned_message> for this directive.
+
+An exception is thrown if this directive is not the newest we have seen for
+the file it seeks to install.
+
+=cut
+
+sub check_replay {
+ my $ops = shift;
+ my $timestamp = shift;
+
+ my $op_header = $ops->[0][1];
# If a file is to be installed, ensure that this directive is newer than
- # the any previous directive installing a file under the same full name.
+ # any previous directive installing a file under the same full name.
if (grep $_->[0] eq 'install', @$ops) {
- fatal("gpg verification problem: could not extract timestamp",1)
- unless defined $result->{sig_creation};
ftp_syslog('debug', "DEBUG: Signature made "
.strftime('%a %b %d %H:%M:%S %Y %Z',
- localtime $result->{sig_creation})) if DEBUG;
+ localtime $timestamp)) if DEBUG;
# Verify that this timestamp is not too far in the future. We allow a
# discrepancy of 1 day so we don't have to worry about timezones
- if ($result->{sig_creation} > (time() + 24*3600)) {
+ if ($timestamp > (time() + 24*3600)) {
fatal("GPG signed upload from the future - not allowed. "
."Please make sure your clock is set correctly, "
."resign the directive file, and upload again. "
foreach my $installed (map $_->[1], grep $_->[0] eq 'install', @$ops) {
my $full_filename = File::Spec::Unix->catfile($op_header->{directory},
$installed);
- advance_timestamp_ratchet($full_filename, $result->{sig_creation});
+ advance_timestamp_ratchet($full_filename, $timestamp);
}
}
-
- return $ops;
}
sub automake_tests {
or ftp_abort("FATAL: chdir($incoming_tmp) failed: $!");
foreach my $packet (@packets) { # each list element is an array reference
- ftp_syslog('info',"found directive: $packet->[0]\n");
+ my $stem = substr $packet->[0],0,-(length '.directive.asc');
+ ftp_syslog('info',"found directive: $packet->[0]");
# scaffolding to be cleaned up as the internal API is improved
my $directive_only = (1 == scalar @$packet);
my $upload_file = ''; my $sig_file = '';
eval { # trap exceptions encountered while processing a packet
+ my $directive_text = slurp_clearsigned_message($packet->[0]);
+ my $directive = read_directive_from_string($directive_text);
+
+ # This would imply that the directive file did not contain a signed
+ # message. There is nothing further to do.
+ fatal("directive file $directive_file has no signature",0)
+ if $directive_text eq '';
+
unless ($directive_only) {
foreach (@{$packet}[1..$#$packet]) {
if (m/[.]sig$/) { $sig_file =$_ } else { $upload_file = $_ }
}
}
- # set up the %info variable
- my $oplist = read_directive_file ($directive_file,
- $upload_file,
- $directive_only);
+
+ # this function just updates $info{email}
+ guess_email_address_from_signature($directive_text);
+
+ my $oplist = interpret_directive($directive, $directive_text);
+ my $op_header = $oplist->[0][1];
+
+ # Phone home. E-mail the contents of the directive file to the maintainer,
+ # for debugging purposes. After this point, we don't need to pass the
+ # directive text to any subsequent fatal calls.
+ if (defined $op_header->{package}) {
+ debug($directive_text, $op_header->{package}) if DEBUG;
+ } else {
+ debug($directive_text, '') if DEBUG;
+ }
+
+ validate_commands($packet, $oplist);
+
+ # Check that we have a keyring for this package:
+ my @keyrings = directory_keyrings($op_header->{directory});
+ fatal("no keyring for package $op_header->{package}",0) if ($#keyrings < 0);
+
+ my $result = verify_clearsigned_message($directive_text, @keyrings);
+
+ fatal("gpg verify of directive file failed",1,'',2)
+ if $result->{exitcode} != 0 || defined $result->{TILT};
+ fatal("gpg verification problem: could not extract timestamp",1)
+ unless defined $result->{sig_creation};
+
+ check_replay($oplist, $result->{sig_creation});
if ($oplist) {
# do the work
projects / gatekeeper.git / commitdiff