Improve error mail when rejecting message

diff --git a/scripts/control.pl b/scripts/control.pl
index cb34a7c8592099650af14577b6657ff834a8892e..bf9353a1f5feed4ae7e2b368980972cbcfe073a2 100755 (executable)
--- a/scripts/control.pl
+++ b/scripts/control.pl
@@ -132,18 +132,20 @@ sub genreply ($$@) {
     return $mcontent;
 }
 
-sub validate_one_header ($) {
-    my $it = shift;
-    $head->get($it) or die "Control message missing `$it' header";
+sub validate_one_header ($$) {
+    my ( $err, $it ) = @_;
+    $head->get($it) or push $err, "Control message missing `$it' header";
 }
 
 sub validate_headers () {
+    my @errors;
 
     # Strictly speaking these aren't Required to be present but we
     # aren't too interested in supporting bug manipulation from people
     # with such broken mail clients.
-    validate_one_header('From');
-    validate_one_header('Message-ID');
+    validate_one_header( \@errors, 'From' );
+    validate_one_header( \@errors, 'Message-ID' );
+    return @errors;
 }
 
 sub validate_from ($) {
@@ -352,10 +354,12 @@ our %cmds = (
     stop     => { Priv => 0, Cmd => \&cmd_quit, },
 );
 
-eval { validate_headers(); };
-if ($@) {
-    chomp($@);
-    push @reply, $@;
+my @errors = validate_headers();
+if (@errors) {
+    chomp(@errors);
+    push @reply, "Invalid control message:";
+    push @reply, map { " * $_" } @errors;
+    push @reply, "";
     push @reply, "Refusing to process control message";
     my $reply = genreply( $head, 0, @reply );
     spool_reply($reply);
@@ -405,9 +409,7 @@ push @reply, ( "", "---" );
 push @reply,
   ( $c{TrackerName}, "Contact " . $c{OwnerAddress} . " with any issues", );
 
-my $reply = genreply( $head, 1, @reply );
-
-spool_reply($reply);
+spool_reply( genreply( $head, 1, @reply ) );
 
 exit(0);