From cba0f9e41be7c0246007277bbd0f6d66349c12f1 Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Fri, 21 Oct 2022 23:23:23 -0500
Subject: [PATCH] Revise install_files to use new model

---
 gatekeeper.pl | 64 +++++++++++++++++++++++++++++----------------------
 1 file changed, 37 insertions(+), 27 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 4d21ccb..67f98e8 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -1864,12 +1864,25 @@ sub archive {
 # Make the directory if it doesn't exist (for, e.g., a new gcc/x.y.z
 # subdir). When the destination file exists, archive it automatically first.
 #
+# TODO: - currently assumes files are located in $incoming_tmp
+#	- factor out final staging
 sub install_files {
   my $header = shift;
-  my $files = shift;
+  my $step = shift;	# [ install => $filename ]
+
+  my $destdir = File::Spec->catdir
+    ($destfinal, File::Spec::Unix->splitdir($header->{directory}));
+  my $install_as = $step->[1];
+
+  my $upload_file = $header->{filename};
+  my $sig_file = $header->{filename}.'.sig';
+
+  my $stage_upload = File::Spec->catfile($desttmp, $upload_file);
+  my $stage_signature = File::Spec->catfile($desttmp, $sig_file);
+
+  my $final_upload = File::Spec->catfile($destdir, $install_as);
+  my $final_signature = File::Spec->catfile($destdir, $install_as.'.sig');
 
-  my ($sig_file,$upload_file) = ($files->{"sig"}, $files->{"upload"});
-  my $destdir = "$destfinal/$header->{directory}";
   # File::Path is 200 lines of Perl and requires reading an external
   # text file.  In my mind, it is a toss-up as to whether that or
   # forking the system mkdir is safer.  We could debate endlessly,
@@ -1878,57 +1891,54 @@ sub install_files {
   system (@mkdir_args);
   -d $destdir or fatal("no directory $destdir",1);
 
-  my ($t1, $t2) = (0,0);
+  my $notification_str = '';
 
   # We now allow overwriting of files - without warning!!
-  if (-e "$destdir/$sig_file") {
+  if (-e $final_signature) {
     if ($header->{options}{replace}) {
       archive($destdir, $header->{directory}, $sig_file);
       ftp_syslog('info', "archived and overwrote "
-		 ."$destdir/$sig_file with uploaded version");
-      $t1 = 1;
+		 ."$final_signature with uploaded version");
+      $notification_str .=
+	"Archived and overwrote $final_signature with uploaded version\n";
     } else {
-      fatal("This signature file exists: $destdir/$sig_file, if you want to "
+      fatal("This signature file exists: $final_signature, if you want to "
 	    ."replace the pair please use the 'replace' directive",1);
     }
   }
-  if (-e "$destdir/$upload_file") {
+  if (-e $final_upload) {
     if ($header->{options}{replace}) {
       archive($destdir, $header->{directory}, $upload_file);
       ftp_syslog('info', "overwrote "
-		 ."$destdir/$upload_file with uploaded version");
-      $t2 = 1;
+		 ."$final_upload with uploaded version");
+      $notification_str .=
+	"Archived and overwrote $final_upload with uploaded version\n";
     } else {
-      fatal("This file exists: $destdir/$upload_file, if you want to "
+      fatal("This file exists: $final_upload, if you want to "
 	    ."replace the pair please use the 'replace' directive",1);
     }
   }
-  my $notification_str = '';
-  $notification_str .=
-    "Archived and overwrote $destdir/$sig_file with uploaded version\n"
-      if ($t1);
-  $notification_str .=
-    "Archived and overwrote $destdir/$upload_file with uploaded version\n"
-      if ($t2);
-   mail ($notification_str) if ($notification_str ne '');
+
+  mail ($notification_str) if ($notification_str ne '');
 
   # Do we need a subdirectory on $desttmp as well?  Can't quite picture
   # when we'd have a collision, so skip that for now.
   #
   for my $f (($sig_file, $upload_file)) {
-    my @mv_args = ("/bin/mv", $f, "$desttmp/$f");
+    my $stage = File::Spec->catfile($desttmp, $f);
+    my @mv_args = ("/bin/mv", File::Spec->catfile($incoming_tmp, $f), $stage);
     fatal("@mv_args failed",0) if system (@mv_args) != 0;
+    chmod 0644, $stage;
   }
 
   # Do atomic rename (if the system crashes between or during the mv's,
   # too bad :).  This is so we don't ever have a partial file that could
   # be found by mirrors, etc.
   #
-  for my $f (($sig_file, $upload_file)) {
-    chmod 0644, "$desttmp/$f";
-    rename ("$desttmp/$f", "$destdir/$f")
-      or fatal("rename($desttmp/$f, $destdir/$f) failed: $!",0);
-  }
+  rename $stage_signature, $final_signature
+    or fatal("rename($stage_signature, $final_signature) failed: $!",0);
+  rename $stage_upload, $final_upload
+    or fatal("rename($stage_upload, $final_upload) failed: $!",0);
 }
 
 sub execute_commands {
@@ -1943,7 +1953,7 @@ sub execute_commands {
   foreach my $step (@{$oplist}[1..$#$oplist]) {	# skip the header
     if ($step->[0] eq 'install') {
       check_files($incoming_tmp, $header);
-      install_files($header, $files);
+      install_files($header, $step);
     } elsif ($step->[0] eq 'symlink') {
       my $target = $step->[1];
       my $linkname = $step->[2];
-- 
2.25.1