From f1380e60bd82442e2af6ea001691798bfc13451c Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Fri, 14 Oct 2022 22:05:01 -0500
Subject: [PATCH] Revise directory scanning loop in scan_incoming

Files with unacceptable names are now removed immediately after scanning
the incoming files directory; the testsuite is adjusted accordingly.
---
 gatekeeper.pl                        | 36 ++++++++++++++++++----------
 testsuite/gatekeeper.all/00_idle.exp |  3 +--
 testsuite/lib/gatekeeper.exp         |  5 ++++
 3 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 9e9dc50..74eea2e 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -857,26 +857,38 @@ sub scan_incoming {
   my $directory = shift;
   my $scratchpad = shift;
 
+  local *_;
+
+  my @trash;
   my %possible;
   # Get list of all possible files from incoming dir.
   #
-  opendir (INCOMING, $directory)
+  opendir INCOMING, $directory
     or ftp_die("FATAL opendir($directory) failed: $!");
-  while (my $tainted_ent = readdir (INCOMING)) {
-    # don't look at files with a leading dot or dash, but allow those chars
-    # subsequently.  Omit files containing any other weird characters.
-    next unless $tainted_ent =~ /^($RE_filename_here)$/;
-    my $ent = $1;
-
-    # Don't look at files with really long names, either.
-    next if length ($ent) > MAX_FILE_NAME_LEN;
-    ftp_syslog('debug', "DEBUG: "
-	       ."uploaded file to check: $ent") if DEBUG;
+ ENT: while (defined($_ = readdir INCOMING)) {
+    next ENT if m/^[.]{1,2}$/;	# skip . and .. entries
+    # require acceptable filenames
+    unless (length($_) <= MAX_FILE_NAME_LEN && /^($RE_filename_here)$/) {
+      m/^(.*)$/;	# untaint the value
+      push @trash, File::Spec->catfile($directory, $1);
+      # This is safe for unlink (which is all we will do with @trash)
+      # because the filename came from a directory entry, so it must be a
+      # valid filename and cannot indicate directory traversal.
+      next ENT
+    }
+    my $ent = $1;	# if we get here, $RE_filename_here matched above
+    # $_ remains tainted, but $ent is an untainted (and safe) copy
+
+    ftp_syslog('debug', "DEBUG: uploaded file to check: $ent") if DEBUG;
     $possible{$ent} = 1;
   }
-  closedir (INCOMING)
+  closedir INCOMING
     or ftp_die("FATAL: closedir($directory) failed: $!");
 
+  # dispose of any garbage files
+  ftp_syslog('info', "Trashcanned files removed")
+    if unlink @trash;
+
   # No possible files found, so return before we call lsof
   return () unless %possible;
 
diff --git a/testsuite/gatekeeper.all/00_idle.exp b/testsuite/gatekeeper.all/00_idle.exp
index 75bd000..3b4df0c 100644
--- a/testsuite/gatekeeper.all/00_idle.exp
+++ b/testsuite/gatekeeper.all/00_idle.exp
@@ -56,7 +56,7 @@ foreach file {
     age_file [file join $tenv incoming ${file}] "3 minutes ago"
 }
 
-# files which are to be rejected and ignored
+# files which are to be rejected, ignored, and removed
 foreach file {
     x=x .abcfoobar -abcfoobar x;x \\~xax x*x x:x x?x ;xax
 } {
@@ -73,7 +73,6 @@ analyze_file_tree $tenv "idle processing: bogus files" {
 } files {
     bogus1 bogus2 bogus3
     _bogus +bogus __bogus _+bogus _-bogus _~bogus _.bogus
-    x=x .abcfoobar -abcfoobar x;x \\~xax x*x x:x x?x ;xax
 }
 analyze_file_tree $tenv "idle processing: bogus files" {
     in-stage stage pub archive
diff --git a/testsuite/lib/gatekeeper.exp b/testsuite/lib/gatekeeper.exp
index d7f6735..9c4daae 100644
--- a/testsuite/lib/gatekeeper.exp
+++ b/testsuite/lib/gatekeeper.exp
@@ -538,6 +538,11 @@ proc analyze_log { base_dir name assess } {
 		     set A(scan,$expect_out(1,string)) 1
 		     exp_continue
 		 }
+	-re {^gatekeeper\[[0-9]+\]: \(Test\)\
+		 Trashcanned files removed} {
+		     # from scan_incoming, when garbage files are purged
+		     exp_continue
+		 }
 	-re {^gatekeeper\[[0-9]+\]: \(Test\)\
 		 DEBUG: lsof command line: [^\r\n]*} {
 		     # from scan_incoming, tracing lsof call
-- 
2.25.1