{ 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<summary> option.
+All types include a brief summary given with the C<summary> 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;
}
\f
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) {
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) {
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
"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
}
}
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 {
}
-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]*} {
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
projects / gatekeeper.git / commitdiff