From: Jacob Bachmeyer <jcb@gnu.org>
Date: Sat, 5 Nov 2022 22:44:55 +0000 (-0500)
Subject: Revise and document cleanup_dir and cleanup
X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=3030219ec00a07315e5b2f1ab5708122e7e509de;p=gatekeeper.git

Revise and document cleanup_dir and cleanup
---

diff --git a/gatekeeper.pl b/gatekeeper.pl
index adca4bb..c11ab59 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -2514,38 +2514,65 @@ sub success_directive {
     or warn "unlink($directive_file) failed: $!";
 }
 
+=item cleanup_dir ( $directory )
+
+Remove all files older than one day from DIRECTORY.
+
+As a precaution against data loss, "removed" files are actually simply
+renamed to have a leading dot.  Note that, for the inbox directory,
+scan_incoming will remove those files on the next run.
+
+=cut
+
 sub cleanup_dir {
   my $dir = shift;
   opendir(DIR, $dir)
     or ftp_abort("Can’t opendir $dir in cleanup_dir: $!");
-  my @files = grep { ! /^\./ && -f "$dir/$_" } readdir(DIR);
+  my @files = grep { !/^\./ && -f File::Spec->catfile($dir, $_) } readdir(DIR);
   closedir DIR;
 
+  my $time_bar = time - 24*3600;	# one day ago
   foreach my $file (@files) {
-    my @tmp = stat("$dir/$file");
-    $file =~ /^(.*)$/; $file = $1;
-    my $mtime = $tmp[9];
-    $mtime =~ /^(.*)$/; $mtime = $1;
-    ftp_syslog('debug',"DEBUG: "
-	       ."Removing $file, older than 24 hours (mtime: $tmp[9])\n")
-      if ((time() > ($tmp[9]+24*3600)) && (DEBUG > 0));
-    unlink ("$dir/.$file");  # don't worry if it doesn't exist
-    rename ("$dir/$file", "$dir/.$file")
-      if (time() > ($mtime+24*3600));
+    $file =~ /^(.*)$/; $file = $1;	# untaint
+    # This is safe, because $file was read from a directory.
+    my $absfile = File::Spec->catfile($dir, $file);
+    my $absbackup = File::Spec->catfile($dir, '.'.$file);
+
+    my @stat = stat($absfile);
+    my $mtime = $stat[9];
+    if ($mtime < $time_bar) {	# file older than one day
+      ftp_syslog('debug',"DEBUG: "
+		 ."Removing $file, older than 24 hours (mtime: $mtime)")
+	if DEBUG;
+      unlink $absbackup;  # don't worry if it doesn't exist
+      rename $absfile, $absbackup;
+    }
   }
 }
 
+=item cleanup ( @files )
+
+Remove FILES from the inbox, scratch, and staging directories.
+
+As a precaution against data loss, "removed" files are actually simply
+renamed to have a leading dot.  Note that, for the inbox directory,
+scan_incoming will remove those files on the next run.
+
+=cut
+
 sub cleanup {
   our $Inbox_dir; our $Scratch_dir; our $Stage_dir;
   for my $dir ($Inbox_dir, $Scratch_dir, $Stage_dir) {
-    for my $f (@_) {
-      ftp_syslog('debug',"DEBUG: cleaning up $dir/$f\n")
+    for my $file (@_) {
+      my $absfile = File::Spec->catfile($dir, $file);
+      my $absbackup = File::Spec->catfile($dir, '.'.$file);
+      ftp_syslog('debug',"DEBUG: cleaning up $dir/$file\n")
 	if (DEBUG > 1);
       # if we quit early enough, they might not be there.
-      next unless defined $f && -e "$dir/$f";
+      next unless defined $file && -e $absfile;
 
-      unlink ("$dir/.$f");  # don't worry if it doesn't exist
-      rename ("$dir/$f", "$dir/.$f"); # save one backup
+      unlink $absbackup;  # don't worry if it doesn't exist
+      rename $absfile, $absbackup; # save one backup
     }
   }
 }