Use new read_directive helper in read_directive_file
authorJacob Bachmeyer <jcb@gnu.org>
Sun, 16 Oct 2022 04:32:40 +0000 (23:32 -0500)
committerJacob Bachmeyer <jcb@gnu.org>
Sun, 16 Oct 2022 04:32:40 +0000 (23:32 -0500)
gatekeeper.pl

index 0988f1d26f0c7c9016611f8b4a2f776de23e4c80..58002b2c67afa99278afdca116b5c80cc93a609b 100755 (executable)
@@ -1276,10 +1276,14 @@ sub read_directive_file {
   my $directive_file_contents = '';
   my @lines = ();
 
-  open (DIRECTIVE_FILE, "<", $directive_file)
+  open DIRECTIVE_FILE, '<', $directive_file
     or ftp_abort("FATAL: open($directive_file) failed: $!");
   $directive_file_contents = join('', (@lines = <DIRECTIVE_FILE>));
-  close (DIRECTIVE_FILE) or ftp_warn("close($directive_file) failed: $!");
+  seek DIRECTIVE_FILE, 0, 0
+    or ftp_abort("FATAL: seek($directive_file) failed: $!");
+  my $directive = read_directive(*DIRECTIVE_FILE{IO});
+  close DIRECTIVE_FILE
+    or ftp_warn("close($directive_file) failed: $!");
 
   # 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
@@ -1306,27 +1310,13 @@ sub read_directive_file {
   # archive/create symlinks/remove symlinks
   my $filename_required = 1;
 
-  foreach my $line (@lines) {
-    $line =~ s/\r\n/\n/g; # deal with dos-based line endings...
-    $line =~ s/\s+$/\n/; # Some people like to put spaces after their commands
-    $line =~ s/^\s+//; # Or even *before* their commands
-    last if ($line =~ /^-----BEGIN PGP SIGNATURE/);
-    if ($line =~ /^-----BEGIN PGP SIGNED MESSAGE-----$/) {
-      $signed = 1;
-      next;
-    }
-    next if ($line =~ /^Hash:/);
-    next if ($line =~ /^\s*$/);
-    # Just make sure we don't parse any lines that are NOT part of the
-    # signed message!  GPG will make sure that a line that looks like
-    # "-----BEGIN PGP SIGNED MESSAGE-----" will be escaped.
-    next if (!$signed);
-
+  foreach my $item (@$directive) {
+    my $tainted_cmd = lc $item->[0];
+    my $tainted_val = $item->[1];
 
-    my ($tainted_cmd,$tainted_val) = split(' ',$line,2);
-    if ($tainted_cmd =~ /^Directory:?$/i) {
+    if ($tainted_cmd eq 'directory') {
       parse_directory_line($tainted_val, $directive_file_contents,0);
-    } elsif ($tainted_cmd =~ /^Filename:?$/i) {
+    } 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);
@@ -1338,7 +1328,7 @@ sub read_directive_file {
        if exists $info{"filename"};
 
       $info{"filename"} = {"value" => $val, "order" => $cnt++};  # ok.
-    } elsif ($tainted_cmd =~ /^Version:?$/i) {
+    } elsif ($tainted_cmd eq 'version') {
       $tainted_val =~ /^(\d+\.\d+)$/
        or fatal("invalid version $tainted_val",1,$directive_file_contents);
       my $val = $1;  # so far so good
@@ -1353,31 +1343,31 @@ sub read_directive_file {
        if exists $info{"version"};
 
       $info{"version"} = $val; #ok.
-    } elsif ($tainted_cmd =~ /^symlink:?$/i) {
+    } 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);
       # $1 -- link target      $2 -- link name
       $info{"symlink-$1"} = {"link" => $2, "order" => $cnt++}; #ok.
-    } elsif ($tainted_cmd =~ /^rmsymlink:?$/i) {
+    } elsif ($tainted_cmd eq 'rmsymlink') {
       $tainted_val =~ /^($RE_filename_relative)$/
        or fatal("invalid parameters for rmsymlink command: $tainted_val",
                 1,$directive_file_contents);
       $info{"rmsymlink-$1"} = {"order" => $cnt++}; #ok.
-    } elsif ($tainted_cmd =~ /^archive:?$/i) {
+    } elsif ($tainted_cmd eq 'archive') {
       $tainted_val =~ /^($RE_filename_relative)$/
        or fatal("invalid parameters for archive command: $tainted_val",
                 1,$directive_file_contents);
       $info{"archive-$1"} = {"order" => $cnt++}; #ok.
-    } elsif ($tainted_cmd =~ /^replace:?$/i) {
+    } 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);
       $info{"replace"} = $1; #ok.
-    } elsif ($tainted_cmd =~ /^comment:?$/i) {
+    } elsif ($tainted_cmd eq 'comment') {
       # Comments are ok, we ignore them
-    } elsif (IN_TEST_MODE && $tainted_cmd =~ /^no-op:?$/i) {
+    } elsif (IN_TEST_MODE && $tainted_cmd eq 'no-op') {
       # The testsuite uses a no-op command to validate directive processing.
       $info{'no-op'} = {order => $cnt++};
     } else {