From 583953daaa4aa2c7a6d547f820da7ab8eeffe919 Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Thu, 3 Nov 2022 15:09:45 -0500 Subject: [PATCH] Add structured exception for unknown package error and move email check The check for a missing per-package email list had to be moved to validate_commands to allow the unknown package exception to be thrown. This now makes the server misconfiguration scenario of a missing email list distinguishable from the user error scenario of an unknown package. The testsuite is adjusted accordingly. --- gatekeeper.pl | 62 ++++++++++++++++--------- testsuite/gatekeeper.all/01_loose.exp | 1 + testsuite/gatekeeper.all/03_triplet.exp | 11 +++-- testsuite/lib/gatekeeper.exp | 19 ++++---- 4 files changed, 54 insertions(+), 39 deletions(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index dbc3144..f864731 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -565,21 +565,43 @@ BEGIN { { return join("\n", map join(': ', @$_), @{(shift)->{trace}})."\n" } } +{ + package Local::Exception::unknown_package; + {our @ISA = qw(Local::Exception)} + + sub package_name { (shift)->{package_name} } + + sub summary { return 'unknown package '.((shift)->{package_name}) } + + sub message { my $package_name = (shift)->{package_name}; return <<"END" } +The directory line should start with the name of the package for which you +are trying to upload a file, e.g. gcc, gawk, or gimp. We have no package +named '$package_name'. If this is a new GNU package, please ensure that you +have registered your GPG key for its uploads, per +http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html. + +The GPG key must be registered separately for each package, so this needs +to be done even if you are already registered for uploading with another +package. +END +} + =item throw $type => ($key => $value)... Throw a TYPE exception, with further options specified as key/value pairs. -All types include a brief summary given with the C option. +All types include a brief summary given with the C option or +implied by the type. This summary is sent to the log. =cut sub throw { my $type = shift; - my $ob = {type => $type, @_}; + my $ob = bless {type => $type, @_}, 'Local::Exception::'.$type; - ftp_syslog('err', $ob->{summary}) if $ob->{summary}; + ftp_syslog('err', $ob->summary) if $ob->summary; - die bless $ob, 'Local::Exception::'.$type; + die $ob; } @@ -1011,21 +1033,6 @@ sub directory_email_addresses { my @email_files = directory_configuration_files('email', $directory); - # While per-directory email lists are now supported, the per-package list - # is still required to be present. - fatal(<<"END",1) -The directory line should start with the name of the package for which you -are trying to upload a file, e.g. gcc, gawk, or gimp. We have no package -named '$package_name'. If this is a new GNU package, please ensure that you -have registered your GPG key for its uploads, per -http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html. - -The GPG key must be registered separately for each package, so this needs -to be done even if you are already registered for uploading with another -package. -END - unless -f File::Spec->catfile($package_config_base, $package_name, 'email'); - my @addresses; foreach my $file (@email_files) { @@ -2003,8 +2010,15 @@ sub validate_commands { my $op_header = $ops->[0][1]; # Configuration must exist for the package - -d File::Spec->catdir($package_config_base, $op_header->{package}) - or fatal("no configuration directory for package $op_header->{package}",0); + throw unknown_package => package_name => $op_header->{package} + unless -d File::Spec->catdir($package_config_base, $op_header->{package}); + + # While per-directory email lists are now supported, the per-package list + # is still required to be present. + throw package_configuration => package_name => $op_header->{package}, + summary => 'no email list for package '.$op_header->{package} + unless -f File::Spec->catfile + ($package_config_base, $op_header->{package}, 'email'); # Check that we actually have at least one command in the directive unless ($#$ops > 0) { @@ -2592,9 +2606,11 @@ foreach my $packet (@packets) { # each list element is an array reference if (defined $E->{send_to_user}) { # scaffolding for now mail($E->{message},$E->{send_to_user}); } elsif ($E->type_p('directive_syntax')) { - mail(join("\n",$E->{summary},'',$E->trace_msg),1); + mail(join("\n",$E->summary,'',$E->trace_msg),1); } elsif ($E->type_p('package_configuration')) { - mail($E->{summary},0); + mail($E->summary,0); + } elsif ($E->type_p('unknown_package')) { + mail($E->message,1); } } else { # Exceptions thrown by perl itself come out as strings diff --git a/testsuite/gatekeeper.all/01_loose.exp b/testsuite/gatekeeper.all/01_loose.exp index 00206f1..3d4d57f 100644 --- a/testsuite/gatekeeper.all/01_loose.exp +++ b/testsuite/gatekeeper.all/01_loose.exp @@ -257,6 +257,7 @@ check_loose_directive "bogus: signed for bogus package" { unknown-package "unknown package from directive" } email-to { ftp-upload-script@gnu.org foo@example.gnu.org + ftp-upload-report@gnu.org } check_loose_directive "bogus: signed for package with no email address" { diff --git a/testsuite/gatekeeper.all/03_triplet.exp b/testsuite/gatekeeper.all/03_triplet.exp index d31bcf4..fa07ea5 100644 --- a/testsuite/gatekeeper.all/03_triplet.exp +++ b/testsuite/gatekeeper.all/03_triplet.exp @@ -329,8 +329,8 @@ check_triplet "bogus: signed for unknown package" setup { "found triplet" unknown-package "unknown package from directive" } email-to { - ftp-upload-script@gnu.org - foo@example.gnu.org + ftp-upload-script@gnu.org foo@example.gnu.org + ftp-upload-report@gnu.org } } @@ -413,13 +413,14 @@ check_triplet "bogus: signed but package has no email addresses" setup { found,bar.tar.gz.directive.asc "found directive in triplet" found-packet,bar.tar.gz.directive.asc:bar.tar.gz.sig:bar.tar.gz \ "found triplet" - unknown-package "reject upload for misconfigured package" + validate,package-no-email "reject upload for misconfigured package" } email-to { ftp-upload-script@gnu.org - bar@example.gnu.org + ftp-upload-report@gnu.org } } -# TODO: should be validate,package-no-email instead of unknown-package here +# This case is a server misconfiguration, so we do not need to send mail to +# bar@example.gnu.org, even though that key signed the upload. check_triplet "bogus: directive signature from the future" setup { packages { diff --git a/testsuite/lib/gatekeeper.exp b/testsuite/lib/gatekeeper.exp index c5e521c..7700028 100644 --- a/testsuite/lib/gatekeeper.exp +++ b/testsuite/lib/gatekeeper.exp @@ -613,13 +613,17 @@ proc analyze_log { base_dir name assess } { } -re {^gatekeeper\[[0-9]+\]: \(Test\) \[PV\]\ - The directory line should start with the name of the package\ - for which you / are trying to upload a file[^\r\n]+} { - # from email_addresses, when the list cannot be opened + unknown package[^\r\n]+} { + # from validate_commands, when package has no config tree set A(unknown-package) 1 exp_continue } - # TODO: This should be validate,package-no-email instead. + -re {^gatekeeper\[[0-9]+\]: \(Test\) \[PV\]\ + no email list for package[^\r\n]+} { + # from validate_commands, when package has no email file + set A(validate,package-no-email) 1 + exp_continue + } -re {^gatekeeper\[[0-9]+\]: \(Test\) \[PV\]\ invalid directory[^\r\n]*} { @@ -725,13 +729,6 @@ proc analyze_log { base_dir name assess } { set A(validate,no-filename,$expect_out(1,string)) 1 exp_continue } - -re {^gatekeeper\[[0-9]+\]: \(Test\) \[PV\]\ - no configuration directory for package ([^\r\n]+)} { - # from read_directive_file, if package config not found - set A(validate,package-no-config) 1 - exp_continue - } - # TODO: validate,package-no-config should be unknown-package -re {^gatekeeper\[[0-9]+\]: \(Test\) \[AA\]\ no keyring for package ([^\r\n]+)} { # from read_directive_file, if package keyring not found -- 2.25.1