Revise install_files to use new model
authorJacob Bachmeyer <jcb@gnu.org>
Sat, 22 Oct 2022 04:23:23 +0000 (23:23 -0500)
committerJacob Bachmeyer <jcb@gnu.org>
Sat, 22 Oct 2022 04:23:23 +0000 (23:23 -0500)
gatekeeper.pl

index 4d21ccb1c6d10a7a704d88d9584ff4d792bf9cef..67f98e89e3350d421200e4e1915f4ee67ba214c5 100755 (executable)
@@ -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];