From 6a3fadc95b5e2110c207ab04dc21841ccb2751a6 Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Mon, 17 Oct 2022 21:25:20 -0500
Subject: [PATCH] Refactor directive parsing to only read file once

---
 gatekeeper.pl | 47 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 43 insertions(+), 4 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index edd17a8..2e62057 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -472,9 +472,27 @@ use constant MAX_SIGNATURE_SIZE => 50*1024;	# 50 KiB
 use constant MAX_DIRECTORY_DEPTH => 4;
 
 #
-# -- Configuration sanity check
+# -- Configuration sanity checks
 #
 
+# We depend on using in-memory files, which require PerlIO, which has been
+# available by default since Perl 5.8.0.  This allows us to read the
+# directive text once, use it ourselves, and also feed it to gpgv over a
+# pipe, eliminating all possible races involving verifying the signature
+# and parsing the directive.  There were existing safeguards, so this is
+# another layer of redundant protection.
+BEGIN {
+  my $test = "foo\nbar\n"; my $pass = 1;
+  open my $fh, '<', \$test
+    or die "This perl does not appear to have PerlIO";
+  $pass = 0 unless <$fh> eq "foo\n";
+  $pass = 0 unless <$fh> eq "bar\n";
+  $pass = 0 if defined <$fh>;
+  close $fh;
+  die "In-memory files do not appear to work"
+    unless $pass;
+}
+
 # make sure our directories all exist, or it's hopeless.
 # Use die instead of fatal - this error should "never" happen.
 for my $dir ($package_config_base, $incoming_dir, $incoming_tmp,
@@ -842,6 +860,29 @@ sub read_directive_from_file {
   return $records;
 }
 
+=item $directive = read_directive_from_string ( $text )
+
+Read a PGP-clearsigned directive and return an arrayref of key/value pair
+arrayrefs representing the directive elements in the signed portion of the
+provided TEXT.  Any text not within the first clearsigned message is
+ignored.  This function uses Perl's support for in-memory files.
+
+The values returned from this procedure are tainted.
+
+=cut
+
+sub read_directive_from_string {
+  my $text = shift;
+
+  open my $handle, '<', \$text
+    or die "open memory file failed: $!";
+  my $records = read_directive($handle);
+  close $handle
+    or die "close memory file failed: $!";
+
+  return $records;
+}
+
 =item @values = find_directive_elements ( $directive, $key )
 
 Search the DIRECTIVE arrayref for KEY elements and return their associated
@@ -1384,11 +1425,9 @@ sub read_directive_file {
   open DIRECTIVE_FILE, '<', $directive_file
     or ftp_abort("FATAL: open($directive_file) failed: $!");
   $directive_file_contents = join('', <DIRECTIVE_FILE>);
-  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: $!");
+  my $directive = read_directive_from_string($directive_file_contents);
 
   # 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
-- 
2.25.1