From: Jacob Bachmeyer <jcb@gnu.org>
Date: Wed, 19 Oct 2022 02:03:45 +0000 (-0500)
Subject: Use new slurp_directive_file helper in read_directive_file
X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=041bbbd83713ac4573abef049d798fccee60b3cc;p=gatekeeper.git

Use new slurp_directive_file helper in read_directive_file

This also ensures that unsigned lines in directives are consistently
ignored.  The testsuite is adjusted accordingly; this resolves an issue
with consistently detecting and rejecting unsigned directives.
---

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 8549e82..5ee31bb 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -884,6 +884,50 @@ sub read_directive_from_string {
   return $records;
 }
 
+=item $text = slurp_directive_file ( $filename )
+
+Read the first PGP-clearsigned message from the file FILENAME and return
+it, complete with all headers and the full signature block.
+
+The returned string is tainted.
+
+=cut
+
+sub slurp_directive_file {
+  my $filename = shift;
+
+  local *_;
+  my @lines;
+
+  # Note that the loops below preserve line endings.
+
+  open my $handle, '<', $filename
+    or die "open($filename) failed: $!";
+  # First, we find the PGP signature headers.
+  while (<$handle>) {
+    last if m/^-----BEGIN PGP SIGNED MESSAGE-----\s*\r*\n$/;
+    # RFC4880 allows trailing whitespace on marker lines.
+  }
+  return '' unless defined $_;	# no signed message at all?
+  @lines = ($_);		# store the header
+  # We are now in the armor headers.
+  while (<$handle>) {
+    push @lines, $_;
+    # According to RFC4880, there must be exactly one empty line to
+    # separate the signed message from the armor headers.
+    last if m/^$/;
+  }
+  # We are now looking at the signed message text and signature.
+  while (<$handle>) {
+    push @lines, $_;
+    last if m/^-----END PGP SIGNATURE-----\s*\r*\n$/;
+  }
+  close $handle
+    or die "close($filename) failed: $!";
+
+  return join('', @lines);
+}
+
 =item @values = find_directive_elements ( $directive, $key )
 
 Search the DIRECTIVE arrayref for KEY elements and return their associated
@@ -1420,16 +1464,15 @@ sub read_directive_file {
   my $uploaded_file = shift;
   my $directive_only = shift;
 
-  # For debugging purposes, see below
-  my $directive_file_contents = '';
-
-  open DIRECTIVE_FILE, '<', $directive_file
-    or ftp_abort("FATAL: open($directive_file) failed: $!");
-  $directive_file_contents = join('', <DIRECTIVE_FILE>);
-  close DIRECTIVE_FILE
-    or ftp_warn("close($directive_file) failed: $!");
+  my $directive_file_contents = slurp_directive_file($directive_file);
   my $directive = read_directive_from_string($directive_file_contents);
 
+  if ($directive_file_contents eq '') {
+    # This implies that the directive file did not contain a signed
+    # message.  There is nothing further to do.
+    fatal("directive file $directive_file has no signature",0)
+  }
+
   # 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
   # uploader know something went wrong.  So let's see if we can match the
diff --git a/testsuite/gatekeeper.all/01_loose.exp b/testsuite/gatekeeper.all/01_loose.exp
index 17e4a2b..b844f8b 100644
--- a/testsuite/gatekeeper.all/01_loose.exp
+++ b/testsuite/gatekeeper.all/01_loose.exp
@@ -95,10 +95,6 @@ proc check_loose_directive { desc case args } {
 
 # ----------------------------------------
 
-# TODO: All of the unsigned directive tests should probably produce a
-#	message about the lack of a signature or a failed signature check
-#	at the least; currently, they do not consistently do so.
-
 check_loose_directive "bogus: unsigned with no directory specified" {
     directive {
 	version 1.2
@@ -108,6 +104,8 @@ check_loose_directive "bogus: unsigned with no directory specified" {
 } file-tree {
     { incoming stage pub archive } empty {}
     { in-stage } files { foo.directive.asc }
+} log {
+    unsigned-directive,foo.directive.asc "unsigned directive"
 } email-to {
     ftp-upload-script@gnu.org
 }
@@ -123,7 +121,7 @@ check_loose_directive "bogus: unsigned for bogus package" {
     { incoming stage pub archive } empty {}
     { in-stage } files { foo.directive.asc }
 } log {
-    unknown-package "unknown package from directive"
+    unsigned-directive,foo.directive.asc "unsigned directive"
 } email-to {
     ftp-upload-script@gnu.org
 }
@@ -138,6 +136,8 @@ check_loose_directive "bogus: unsigned for package with no email address" {
 } file-tree {
     { incoming stage pub archive } empty {}
     { in-stage } files { foo.directive.asc }
+} log {
+    unsigned-directive,foo.directive.asc "unsigned directive"
 } email-to {
     ftp-upload-script@gnu.org
 }
@@ -152,8 +152,10 @@ check_loose_directive "bogus: unsigned for valid package" {
 } file-tree {
     { incoming stage pub archive } empty {}
     { in-stage } files { foo.directive.asc }
+} log {
+    unsigned-directive,foo.directive.asc "unsigned directive"
 } email-to {
-    ftp-upload-script@gnu.org foo@example.org foo@example.net
+    ftp-upload-script@gnu.org
 }
 
 check_loose_directive "bogus: signed with no directory specified" {
diff --git a/testsuite/lib/gatekeeper.exp b/testsuite/lib/gatekeeper.exp
index b6f8e05..da41226 100644
--- a/testsuite/lib/gatekeeper.exp
+++ b/testsuite/lib/gatekeeper.exp
@@ -640,6 +640,13 @@ proc analyze_log { base_dir name assess } {
 		     exp_continue
 		 }
 
+	-re {^gatekeeper\[[0-9]+\]: \(Test\)\
+		 directive file ([^ ]+) has no signature} {
+		     # from read_directive_file, when signed message is null
+		     set A(unsigned-directive) 1
+		     set A(unsigned-directive,$expect_out(1,string)) 1
+		     exp_continue
+		 }
 	-re {^gatekeeper\[[0-9]+\]: \(Test\)\
 		 invalid directive 'replace', not supported[^\r\n]+} {
 		     # from read_directive_file, if replace used in v1.1