Add checks that the rename builtin works as expected

The tool assumes that the Perl rename builtin can atomically move files
from the inbox to the scratchpad directory and among the staging, public,
and archive directories.  This commit extends the configuration checks
to confirm that the system can actually move files as expected.

diff --git a/gatekeeper.pl b/gatekeeper.pl
index def61144f9656da97a1018f7496a0869ab599c14..d97143db575148de2602e450fd07a3e9e97234af 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -514,15 +514,77 @@ BEGIN {
     unless $pass;
 }
 
-# make sure our directories all exist, or it's hopeless.
-# Use ftp_abort here - this error should "never" happen.
+# Ensure that all configured directories actually exist and that
+# directories required to be on the same filesystem actually are on the
+# same filesystem.  More precisely, ensure that rename works in the
+# circumstances where we assume it to be available.
+#
+# Use ftp_abort here - these errors should "never" happen.
 {
-  our $Inbox_dir; our $Scratch_dir; our $Public_dir; our $Stage_dir;
+  our $Inbox_dir; our $Scratch_dir;
+  our $Stage_dir; our $Public_dir; our $Archive_dir;
+
+  # The actual archive directory will be created if necessary, but we
+  # require its immediate parent to exist and will test moving a file there
+  # instead if the archive directory does not already exist.
+  my $archive_test_dir;
+  if (-d $Archive_dir) { $archive_test_dir = $Archive_dir }
+  else {       # effectively `dirname $Archive_dir`
+    my @archive_dir = File::Spec->splitdir($Archive_dir); pop @archive_dir;
+    $archive_test_dir = File::Spec->catdir(@archive_dir);
+  }
+
   for my $dir ($package_config_base, $Inbox_dir, $Scratch_dir,
-              $Public_dir, $Stage_dir) {
+              $Public_dir, $Stage_dir, $archive_test_dir) {
     ftp_abort("FATAL: configuration problem, $dir is not a directory")
       unless -d $dir;
   }
+
+  # Note that the file name used for testing is _not_ a permissible name,
+  # nor can it be produced by cleaning up a file with a permissible name.
+  my $testfilename =
+    '.+gatekeeper.test.'.$$.strftime '.{%Y-%m-%d.%H-%M-%S}', localtime;
+
+  my $infile = File::Spec->catfile($Inbox_dir, $testfilename);
+  my $scratchfile = File::Spec->catfile($Scratch_dir, $testfilename);
+  my $stagefile = File::Spec->catfile($Stage_dir, $testfilename);
+  my $pubfile = File::Spec->catfile($Public_dir, $testfilename);
+  my $arcfile = File::Spec->catfile($archive_test_dir, $testfilename);
+
+  # none of them should exist at the start of the test
+  unlink $infile, $scratchfile, $stagefile, $pubfile, $arcfile;
+
+  # test moving a file from inbox to scratch
+  {
+    sysopen my $test, $infile, O_WRONLY|O_CREAT|O_EXCL
+      or ftp_abort("create test file in inbox: $!");
+    close $test;
+    unless (rename $infile, $scratchfile and -f $scratchfile) {
+      unlink $infile;
+      ftp_abort("FATAL:  could not rename file from inbox to scratchpad: $!");
+    }
+    unlink $scratchfile;       # test complete
+  }
+
+  # The system mv(1) command is used to move files from scratch to staging.
+
+  # test moving a file from stage to public to archive
+  {
+    sysopen my $test, $stagefile, O_WRONLY|O_CREAT|O_EXCL
+      or ftp_abort("create test file in staging directory: $!");
+    close $test;
+    unless (rename $stagefile, $pubfile and -f $pubfile) {
+      unlink $stagefile;
+      ftp_abort("FATAL:  could not rename file from staging to public: $!");
+    }
+    unless (rename $pubfile, $arcfile and -f $arcfile) {
+      unlink $pubfile;
+      ftp_abort("FATAL:  could not rename file from public to archive: $!");
+    }
+    unlink $arcfile;           # test complete
+  }
+  # There is a very small window where someone listing the public directory
+  # might see a test file, but it will not stay for long.
 }
 
 \f