From 79aef13ac63febbc2be0aecf6134b29a2c1f047a Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Fri, 14 Oct 2022 22:24:04 -0500
Subject: [PATCH] Revise check for open files in scan_incoming

The old code would incorrectly assume that no files are open if the
lsof program fails to run; this new code uses a list-form pipe open
introduced in Perl 5.8.0 instead of an implied fork.

Also use File::Spec to form the arguments to lsof.
---
 gatekeeper.pl | 34 ++++++++++++++--------------------
 1 file changed, 14 insertions(+), 20 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 4706e3c..d26db21 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -937,29 +937,23 @@ sub scan_incoming {
   # the open files because they are owned by another user.
   # On modern (Debian) systems, condition a) is not met.
   my @lsof_args = (LSOF_BIN, "-Fn",
-       map { "$directory/$_" } keys %possible);
-  ftp_syslog('debug', "DEBUG: "
-	     ."lsof command line: " . join(' ',@lsof_args))
+       map { File::Spec->catfile($directory, $_) } keys %possible);
+  ftp_syslog('debug', "DEBUG: lsof command line: " . join(' ',@lsof_args))
     if DEBUG;
-  my $pid = open (LSOF, "-|");
 
-  if ($pid) {      # parent
-    while (defined (my $line = <LSOF>)) {
-      ftp_syslog('debug', "DEBUG: " . "lsof output: $line")
-	if DEBUG;
-      # only look at the name lines.
-      next unless $line =~ /^n${directory}\/(.+)$/;
-      ftp_syslog('debug', "DEBUG: "
-		 ."upload in progress for $1, ignoring during this run")
-	if DEBUG;
-      delete ($possible{$1})
-	or ftp_warn("WARNING: lsof found unrequested but open $1?!");
-    }
-    close (LSOF);
-  } else {       # child
-    exec (@lsof_args)
-      or ftp_die("FATAL: cannot exec lsof: $!");
+  open LSOF, '-|', @lsof_args
+    or ftp_die("FATAL: cannot spawn lsof: $!");;
+  while (<LSOF>) {
+    ftp_syslog('debug', "DEBUG: lsof output: $_") if DEBUG;
+    # only look at the name lines
+    next unless /^n${directory}\/(.+)$/;
+    ftp_syslog('debug', "DEBUG: "
+	       ."upload in progress for $1, ignoring during this run")
+      if DEBUG;
+    delete ($possible{$1})
+      or ftp_warn("WARNING: lsof found unrequested but open $1?!");
   }
+  close (LSOF);
 
   my @ret;
 
-- 
2.25.1