Refactor directive validity checks

The check for the "replace" element appearing in a v1.1 directive is moved
to interpret_directive and directive processing no longer stops at the
first error, since the documentation states that the order of directive
elements is insignificant.

This also fixes a long-standing bug that resulted in the sending of email
to the registered maintainers for a package depending on the relative
location of the "directory" element; the testsuite is adjusted accordingly.

diff --git a/gatekeeper.pl b/gatekeeper.pl
index be1f4a753b8158e7c6d6ad91d4357b06f9d86f24..db180657c3115f919af63c17f02a3396540ff728 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -1645,6 +1645,8 @@ sub interpret_directive {
   my $directive = shift;               # presumed tainted
   my $directive_file_contents = shift; # temporary scaffold
 
+  my @errors;
+
   my %options = ( replace => undef );
   my %header = ( version => undef, options => \%options,
                 package => undef, directory => undef, filename => undef );
@@ -1660,17 +1662,17 @@ sub interpret_directive {
 
     if (scalar @versions == 1) {
       $versions[0][1] =~ /^(\d+\.\d+)$/
-       or fatal("invalid version $versions[0][1]",1,$directive_file_contents);
+       or push @errors, "invalid version $versions[0][1]";
       my $val = $1;  # so far so good
 
       # We only support version 1.1/1.2 right now!
-      fatal("invalid version $val, not supported",1,$directive_file_contents)
+      push @errors, "invalid version $val, not supported"
        if (($val ne '1.1') and ($val ne '1.2'));
 
       $header{version} = $val;  # TODO:  parse?
       $info{"version"} = $val; #ok.
     } elsif (scalar @versions > 1) {
-      fatal("invalid multiple version elements",1,$directive_file_contents);
+      push @errors, "invalid multiple version elements";
     } else {   # no version at all; no longer allowed
       # This will be caught later, when the operation list is validated.
     }
@@ -1687,12 +1689,13 @@ sub interpret_directive {
     } elsif ($tainted_cmd eq 'filename') {
       # We use the same filename restrictions as scan_incoming
       $tainted_val =~ /^($RE_filename_here)$/
-       or fatal("invalid filename $tainted_val",1,$directive_file_contents);
+       or push @errors, "invalid filename $tainted_val";
       my $val = $1;  # so far so good
 
       # Only let them specify one filename directive.
-      fatal("Only one filename directive is allowed per directive file. "
-           ."Error at filename directive: $val.",1,$directive_file_contents)
+      push @errors,
+       "Only one filename directive is allowed per directive file.  "
+         ."Error at filename directive: $val."
        if defined $header{filename};
 
       $header{filename} = $val;
@@ -1701,28 +1704,33 @@ sub interpret_directive {
       # already handled above
     } elsif ($tainted_cmd eq 'symlink') {
       $tainted_val =~ /^($RE_filename_relative)\s+($RE_filename_relative)$/
-       or fatal("invalid parameters for symlink command: $tainted_val",
-                1,$directive_file_contents);
+       or push @errors,
+         "invalid parameters for symlink command: $tainted_val";
       # $1 -- link target      $2 -- link name
       push @ops, [symlink => $1, $2];
       $info{"symlink-$1"} = {"link" => $2, "order" => $cnt++}; #ok.
     } elsif ($tainted_cmd eq 'rmsymlink') {
       $tainted_val =~ /^($RE_filename_relative)$/
-       or fatal("invalid parameters for rmsymlink command: $tainted_val",
-                1,$directive_file_contents);
+       or push @errors,
+         "invalid parameters for rmsymlink command: $tainted_val";
       push @ops, [rmsymlink => $1];
       $info{"rmsymlink-$1"} = {"order" => $cnt++}; #ok.
     } elsif ($tainted_cmd eq 'archive') {
       $tainted_val =~ /^($RE_filename_relative)$/
-       or fatal("invalid parameters for archive command: $tainted_val",
-                1,$directive_file_contents);
+       or push @errors,
+         "invalid parameters for archive command: $tainted_val";
       push @ops, [archive => $1];
       $info{"archive-$1"} = {"order" => $cnt++}; #ok.
     } elsif ($tainted_cmd eq 'replace') {
       # This command is only supported from v1.2
       $tainted_val =~ /^(true|false)$/
-       or fatal("invalid parameters for replace command: $tainted_val",
-                1,$directive_file_contents);
+       or push @errors,
+         "invalid parameters for replace command: $tainted_val";
+
+      push @errors,
+       "invalid directive 'replace', not supported prior to version 1.2"
+         if $header{version} eq '1.1';
+
       $options{replace} = ($1 eq 'true');
       $info{"replace"} = $1; #ok.
     } elsif ($tainted_cmd eq 'comment') {
@@ -1732,8 +1740,7 @@ sub interpret_directive {
       push @ops, ['no-op'];
       $info{'no-op'} = {order => $cnt++};
     } else {
-      fatal("Invalid directive line:\n\n  $tainted_cmd $tainted_val",
-           1,$directive_file_contents);
+      push @errors, "Invalid directive line:\n\n  $tainted_cmd $tainted_val";
     }
 
     if (!defined($install)
@@ -1741,6 +1748,12 @@ sub interpret_directive {
       { push @ops, ($install = [install => $header{filename}]) }
   }
 
+  if (@errors) {
+    # TODO:  eventually report all errors found
+    # for now, just report the first error, to emulate an immediate fatal()
+    fatal($errors[0],1,$directive_file_contents);
+  }
+
   return \@ops;
 }
 
@@ -1859,11 +1872,6 @@ sub read_directive_file {
   my $ops = interpret_directive($directive, $directive_file_contents);
   my $op_header = $ops->[0][1];
 
-  if (exists($info{"replace"}) && ($info{"version"} eq '1.1')) {
-    fatal("invalid directive 'replace', not supported prior to version 1.2",
-         1,$directive_file_contents);
-  }
-
   # 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.

diff --git a/testsuite/gatekeeper.all/03_triplet.exp b/testsuite/gatekeeper.all/03_triplet.exp
index 3f5715bf15aad149ebe699350769aa5563256e27..7084ceff8bd53bc0738dcdb8a94483b241aef1a0 100644 (file)
--- a/testsuite/gatekeeper.all/03_triplet.exp
+++ b/testsuite/gatekeeper.all/03_triplet.exp
@@ -623,6 +623,7 @@ check_triplet "bogus: version field not a number" setup {
        validate,bad-version "invalid version rejected"
     } email-to {
        ftp-upload-script@gnu.org foo@example.gnu.org
+       foo@example.org foo@example.net
     }
 }
 
@@ -656,6 +657,7 @@ check_triplet "bogus: invalid v1.0 format directive" setup {
        validate,bad-version "invalid version rejected"
     } email-to {
        ftp-upload-script@gnu.org foo@example.gnu.org
+       foo@example.org foo@example.net
     }
 }
 
@@ -722,6 +724,7 @@ check_triplet "bogus: duplicated version key" setup {
        validate,bad-version-repeat "version key repeated"
     } email-to {
        ftp-upload-script@gnu.org foo@example.gnu.org
+       foo@example.org foo@example.net
     }
 }
 
@@ -756,6 +759,7 @@ check_triplet "bogus: ambiguous version declaration" setup {
        validate,bad-version-repeat "version key repeated"
     } email-to {
        ftp-upload-script@gnu.org foo@example.gnu.org
+       foo@example.org foo@example.net
     }
 }
 
@@ -827,6 +831,7 @@ foreach FVER $DIRECTIVE_FORMAT_VERSIONS {
                "directive file with bogus filename rejected"
        } email-to {
            ftp-upload-script@gnu.org foo@example.gnu.org
+           foo@example.org foo@example.net
        }
     }
 
@@ -862,6 +867,7 @@ foreach FVER $DIRECTIVE_FORMAT_VERSIONS {
                "directive file with repeated filename rejected"
        } email-to {
            ftp-upload-script@gnu.org foo@example.gnu.org
+           foo@example.org foo@example.net
        }
     }
 
@@ -897,6 +903,7 @@ foreach FVER $DIRECTIVE_FORMAT_VERSIONS {
                "directive file with ambiguous filename rejected"
        } email-to {
            ftp-upload-script@gnu.org foo@example.gnu.org
+           foo@example.org foo@example.net
        }
     }
 
@@ -1517,6 +1524,7 @@ check_triplet "bogus: v1.2 format directive with bogus replace value" setup {
            "invalid replace flag value rejected"
     } email-to {
        ftp-upload-script@gnu.org foo@example.gnu.org
+       foo@example.org foo@example.net
     }
 }