Factor move_filepair out of install_files
authorJacob Bachmeyer <jcb@gnu.org>
Fri, 18 Nov 2022 04:14:24 +0000 (22:14 -0600)
committerJacob Bachmeyer <jcb@gnu.org>
Fri, 18 Nov 2022 04:14:24 +0000 (22:14 -0600)
gatekeeper.pl

index 6c13798ae2529b4a46a67b24061e1afdf461c892..2cc645b29f22b0887bfce9ca38352afb2deb7349 100755 (executable)
@@ -2481,6 +2481,31 @@ sub archive_filepair {
   close ARCSTAMP;
 }
 
+=item move_filepair ( $source, $filename, $target )
+
+Move FILENAME (and its detached signature) from the SOURCE directory to the
+TARGET directory.  Both SOURCE and TARGET are strings in the form produced
+by File::Spec->catdir on the local system.
+
+=cut
+
+sub move_filepair {
+  my $source = shift;
+  my $filename = shift;
+  my $target = shift;
+
+  # TARGET is always a directory, so POSIX says we only need to invoke mv once
+  my @mv_args = ('/bin/mv',
+                File::Spec->catfile($source, $filename),
+                File::Spec->catfile($source, $filename.'.sig'),
+                $target);
+  die 'command failed: '.join(' ', @mv_args)
+    if system (@mv_args) != 0;
+  chmod 0644,
+    (File::Spec->catfile($target, $filename),
+     File::Spec->catfile($target, $filename.'.sig'));
+}
+
 # Install both SIG_FILE and UPLOAD_FILE in $Public_dir/$info{directory}.
 # 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.
@@ -2491,7 +2516,7 @@ sub install_files {
   my $header = shift;
   my $step = shift;    # [ install => $filename ]
 
-  our $Stage_dir; our $Public_dir;
+  our $Scratch_dir; our $Stage_dir; our $Public_dir;
 
   my @directory = File::Spec::Unix->splitdir($header->{directory});
   my $install_as = $step->[1];
@@ -2527,14 +2552,7 @@ sub install_files {
   # Do we need a subdirectory on $Stage_dir as well?  Can't quite picture
   # when we'd have a collision, so skip that for now.
   #
-  our $Scratch_dir;
-  for my $f (($sig_file, $upload_file)) {
-    my $stage = File::Spec->catfile($Stage_dir, $f);
-    my @mv_args = ("/bin/mv", File::Spec->catfile($Scratch_dir, $f), $stage);
-    die 'command failed: '.join(' ', @mv_args)
-      if system (@mv_args) != 0;
-    chmod 0644, $stage;
-  }
+  move_filepair($Scratch_dir, $header->{filename}, $Stage_dir);
 
   # 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