Refactor install_files as execute_install

This also moves staging files and validating that the "replace" option is
set if needed to top-level.

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 2cc645b29f22b0887bfce9ca38352afb2deb7349..b9dafbc51af1af695e5bdfa25cdd33f809e3b1f7 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -2506,54 +2506,45 @@ sub move_filepair {
      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.
-#
-# TODO: - currently assumes files are located in $Scratch_dir
-#      - factor out final staging
-sub install_files {
-  my $header = shift;
+=item execute_install ( $directory, $step, $staged_filename )
+
+Install a file (staged under STAGED_FILENAME) into DIRECTORY within the
+managed tree according to STEP.  The DIRECTORY parameter is an array
+reference containing a split directory name.  The destination DIRECTORY
+will be created if necessary.
+
+=cut
+
+sub execute_install {
+  my $directory = shift;
   my $step = shift;    # [ install => $filename ]
+  my $staged_filename = shift;
 
-  our $Scratch_dir; our $Stage_dir; our $Public_dir;
+  our $Stage_dir; our $Public_dir;
 
-  my @directory = File::Spec::Unix->splitdir($header->{directory});
   my $install_as = $step->[1];
 
-  my $upload_file = $header->{filename};
-  my $sig_file = $header->{filename}.'.sig';
+  my $upload_file = $staged_filename;
+  my $sig_file = $staged_filename.'.sig';
 
   my $stage_upload = File::Spec->catfile($Stage_dir, $upload_file);
   my $stage_signature = File::Spec->catfile($Stage_dir, $sig_file);
 
-  my $pubfinal = File::Spec::Unix->catfile(pub => @directory, $install_as);
+  my $pubfinal = File::Spec::Unix->catfile(pub => @$directory, $install_as);
   my $final_upload = File::Spec->catfile
-    ($Public_dir, @directory, $install_as);
+    ($Public_dir, @$directory, $install_as);
   my $final_signature = File::Spec->catfile
-    ($Public_dir, @directory, $install_as.'.sig');
+    ($Public_dir, @$directory, $install_as.'.sig');
 
-  mkdir_p $Public_dir, @directory;
+  mkdir_p $Public_dir, @$directory;
 
   # We now allow overwriting of files - without warning!!
   if (-e $final_signature || -e $final_upload) {
-    if ($header->{options}{replace}) {
-      archive_filepair([File::Spec::Unix->splitdir($header->{directory})],
-                      $upload_file);
-      ftp_syslog info => "overwriting $pubfinal with uploaded version";
-      push @{$header->{notices}},
-       "Archived and overwrote $pubfinal with uploaded version";
-    } else {
-      throw processing_error => command => $step,
-       summary => $pubfinal." exists and 'replace' was not selected";
-    }
+    # previous validation has ensured that the 'replace' option is set
+    archive_filepair($directory, $upload_file);
+    ftp_syslog info => "overwriting $pubfinal with uploaded version";
   }
 
-  # 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.
-  #
-  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
   # be found by mirrors, etc.
@@ -2737,7 +2728,7 @@ foreach my $packet (@packets) {   # each list element is an array reference
   }
 
   eval {       # trap exceptions encountered while processing a packet
-    our $Scratch_dir;
+    our $Scratch_dir; our $Stage_dir; our $Public_dir;
 
     local $Phase = 'PV';
 
@@ -2769,6 +2760,8 @@ foreach my $packet (@packets) {   # each list element is an array reference
 
     validate_directive($packet, $oplist);
 
+    my @directory = File::Spec::Unix->splitdir($op_header->{directory});
+
     $Phase = 'AA';
     # Check that we have a keyring for this package:
     my @keyrings = directory_keyrings($op_header->{directory});
@@ -2814,13 +2807,42 @@ foreach my $packet (@packets) { # each list element is an array reference
       (File::Spec->catfile($Scratch_dir, $op_header->{filename}))
        if find_directive_elements($directive, 'filename');
 
+    # If the upload installs a file, check if the final file exists; if so,
+    # require the 'replace' option to be set.
+    foreach my $step (@$oplist) {
+      if ($step->[0] eq 'install') {
+       my $install_as = $step->[1];
+
+       my $pubfinal = File::Spec::Unix->catfile
+         (pub => @directory, $install_as);
+       my $final_upload = File::Spec->catfile
+         ($Public_dir, @directory, $install_as);
+       my $final_signature = File::Spec->catfile
+         ($Public_dir, @directory, $install_as.'.sig');
+
+       if (-e $final_signature || -e $final_upload) {
+         unless ($op_header->{options}{replace}) {
+           throw processing_error => command => $step,
+             summary => $pubfinal." exists and 'replace' was not selected";
+         }
+         push @{$op_header->{notices}},
+           "Archived and overwrote $pubfinal with uploaded version";
+       }
+      }
+    }
+
     $Phase = 'EX';
 
-    my @directory = File::Spec::Unix->splitdir($op_header->{directory});
+    # If the upload carries a file, transfer (with signature) to staging area.
+    if (find_directive_elements($directive, 'filename')) {
+      # 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.
+      move_filepair($Scratch_dir, $op_header->{filename}, $Stage_dir);
+    }
 
     foreach my $step (@{$oplist}[1..$#$oplist]) { # skip the header
       if ($step->[0] eq 'install') {
-       install_files($op_header, $step);
+       execute_install(\@directory, $step, $op_header->{filename});
       } elsif ($step->[0] eq 'symlink') {
        execute_symlink(\@directory, $step);
       } elsif ($step->[0] eq 'rmsymlink') {

diff --git a/testsuite/lib/gatekeeper.exp b/testsuite/lib/gatekeeper.exp
index fb35dc08db9caeff9fc0e01fe810676e3ca3d153..b80e172985ec98569dd0e7c23697be9414b6af9c 100644 (file)
--- a/testsuite/lib/gatekeeper.exp
+++ b/testsuite/lib/gatekeeper.exp
@@ -837,7 +837,7 @@ proc analyze_log { base_dir name assess } {
                     exp_continue
                 }
 
-       -re {^gatekeeper\[[0-9]+\]: \(Test\) \[EX\]\
+       -re {^gatekeeper\[[0-9]+\]: \(Test\) \[VL\]\
                 [^ ]+ exists and 'replace' was not selected} {
                     # from install_files, if target exists and replace not set
                     set A(install,target-file-exists) 1