Move implementation of most operation list steps to operation list objects

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 8153e8029a7befc586c2167bfe3cdbdd362b8918..c091ed0c4ca9e0139555e2aa4af77e394fd8fd36 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -1645,6 +1645,12 @@ sub read_directive_from_string {
 {
   package Local::OpList::Op_install;
 
+=item [ install =E<gt> $destination_filename ]
+
+Install a file into the managed tree as DESTINATION_FILENAME.
+
+=cut
+
   sub check {
     my $step = shift;
     my $info = shift;
@@ -1677,14 +1683,51 @@ sub read_directive_from_string {
     my $info = shift;
     my $packet = $info->{packet};
 
-    ::execute_install($packet->target_directory, $step,
-                     $packet->upload_filename);
+    my $directory = $packet->target_directory;
+    my $staged_filename = $packet->upload_filename;
+    my $install_as = $step->[1];
+
+    my $upload_file = $staged_filename;
+    my $sig_file = $staged_filename.'.sig';
+
+    my $stage_upload = File::Spec->catfile(::CONF_DIR_Staging, $upload_file);
+    my $stage_signature = File::Spec->catfile(::CONF_DIR_Staging, $sig_file);
+
+    my $pubfinal = File::Spec::Unix->catfile(pub => @$directory, $install_as);
+    my $final_upload = File::Spec->catfile
+      (::CONF_DIR_Public, @$directory, $install_as);
+    my $final_signature = File::Spec->catfile
+      (::CONF_DIR_Public, @$directory, $install_as.'.sig');
+
+    ::mkdir_p ::CONF_DIR_Public, @$directory;
+
+    # We now allow overwriting of files - without warning!!
+    if (-e $final_signature || -e $final_upload) {
+      # previous validation has ensured that the 'replace' option is set
+      ::archive_filepair($directory, $upload_file);
+      ::ftp_syslog info => "overwriting $pubfinal with uploaded version";
+    }
+
+    # 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.
+    #
+    rename $stage_signature, $final_signature
+      or die "rename($stage_signature, $final_signature): $!";
+    rename $stage_upload, $final_upload
+      or die "rename($stage_upload, $final_upload): $!";
   }
 }
 
 {
   package Local::OpList::Op_symlink;
 
+=item [ symlink =E<gt> $target, $linkname ]
+
+Establish a symlink at LINKNAME pointing to TARGET.
+
+=cut
+
   sub check {}
 
   sub execute {
@@ -1692,13 +1735,39 @@ sub read_directive_from_string {
     my $info = shift;
     my $packet = $info->{packet};
 
-    ::execute_symlink($packet->target_directory, $step);
+    my $directory = $packet->target_directory;
+    my $target = $step->[1];
+    my $linkname = $step->[2];
+    my $abslinkname =
+      File::Spec->catfile(::CONF_DIR_Public, @$directory, $linkname);
+    my $pubdir = File::Spec::Unix->catdir(@$directory);
+
+    # if the symlink already exists, remove it
+    if (-l $abslinkname) {
+      unlink $abslinkname
+       or ::throw processing_error => command => $step,
+         summary => "removal of symlink $linkname failed: $!";
+    }
+
+    # symlink away!
+    symlink $target, $abslinkname
+      or ::throw processing_error => command => $step,
+       summary =>
+         "creation of symlink $linkname to $target in $pubdir failed: $!";
+    ::ftp_syslog info =>
+      "added symlink $linkname pointing to $target in $pubdir";
   }
 }
 
 {
   package Local::OpList::Op_rmsymlink;
 
+=item [ rmsymlink =E<gt> $linkname ]
+
+Remove the symlink at LINKNAME.
+
+=cut
+
   sub check {}
 
   sub execute {
@@ -1706,7 +1775,22 @@ sub read_directive_from_string {
     my $info = shift;
     my $packet = $info->{packet};
 
-    ::execute_rmsymlink($packet->target_directory, $step);
+    my $directory = $packet->target_directory;
+    my $abslinkname =
+      File::Spec->catfile(::CONF_DIR_Public, @$directory, $step->[1]);
+
+    ::throw processing_error => command => $step,
+      summary => "symlink $step->[1] was not found"
+       unless -e $abslinkname;
+    ::throw processing_error => command => $step,
+      summary => "refusing to remove a non-symlink file"
+       unless -l $abslinkname;
+
+    unlink $abslinkname
+      or ::throw processing_error => command => $step,
+       summary => "removal of symlink $step->[1] failed: $!";
+    ::ftp_syslog info =>
+      "removed symlink $step->[1] in ".File::Spec::Unix->catdir(@$directory);
   }
 }
 
@@ -3194,113 +3278,6 @@ sub Local::Packet::Directive::Upload::move_filepair {
      File::Spec->catfile($target, $filename.'.sig'));
 }
 
-=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 a directory
-name object.  The destination DIRECTORY will be created if necessary.
-
-=cut
-
-sub execute_install {
-  my $directory = shift;
-  my $step = shift;    # [ install => $filename ]
-  my $staged_filename = shift;
-
-  my $install_as = $step->[1];
-
-  my $upload_file = $staged_filename;
-  my $sig_file = $staged_filename.'.sig';
-
-  my $stage_upload = File::Spec->catfile(CONF_DIR_Staging, $upload_file);
-  my $stage_signature = File::Spec->catfile(CONF_DIR_Staging, $sig_file);
-
-  my $pubfinal = File::Spec::Unix->catfile(pub => @$directory, $install_as);
-  my $final_upload = File::Spec->catfile
-    (CONF_DIR_Public, @$directory, $install_as);
-  my $final_signature = File::Spec->catfile
-    (CONF_DIR_Public, @$directory, $install_as.'.sig');
-
-  mkdir_p CONF_DIR_Public, @$directory;
-
-  # We now allow overwriting of files - without warning!!
-  if (-e $final_signature || -e $final_upload) {
-    # previous validation has ensured that the 'replace' option is set
-    archive_filepair($directory, $upload_file);
-    ftp_syslog info => "overwriting $pubfinal with uploaded version";
-  }
-
-  # 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.
-  #
-  rename $stage_signature, $final_signature
-    or die "rename($stage_signature, $final_signature): $!";
-  rename $stage_upload, $final_upload
-    or die "rename($stage_upload, $final_upload): $!";
-}
-
-=item execute_symlink ( $directory, $step )
-
-Establish a symlink in DIRECTORY according to STEP.  The DIRECTORY
-parameter is a directory name object.
-
-=cut
-
-sub execute_symlink {
-  my $directory = shift;
-  my $step = shift;    # [ symlink => $target, $linkname ]
-
-  my $target = $step->[1];
-  my $linkname = $step->[2];
-  my $abslinkname =
-    File::Spec->catfile(CONF_DIR_Public, @$directory, $linkname);
-  my $pubdirectory = File::Spec::Unix->catdir(@$directory);
-
-  # if the symlink already exists, remove it
-  if (-l $abslinkname) {
-    unlink $abslinkname
-      or throw processing_error => command => $step,
-       summary => "removal of symlink $linkname failed: $!";
-  }
-
-  # symlink away!
-  symlink $target, $abslinkname
-    or throw processing_error => command => $step,
-      summary =>
-       "creation of symlink $linkname to $target in $pubdirectory failed: $!";
-  ftp_syslog info =>
-    "added symlink $linkname pointing to $target in $pubdirectory";
-}
-
-=item execute_rmsymlink ( $directory, $step )
-
-Remove a symlink in DIRECTORY according to STEP.  The DIRECTORY parameter
-is a directory name object.
-
-=cut
-
-sub execute_rmsymlink {
-  my $directory = shift;
-  my $step = shift;    # [ rmsymlink => $linkname ]
-
-  my $abslinkname =
-    File::Spec->catfile(CONF_DIR_Public, @$directory, $step->[1]);
-
-  throw processing_error => command => $step,
-    summary => "symlink $step->[1] was not found"
-      unless -e $abslinkname;
-  throw processing_error => command => $step,
-    summary => "refusing to remove a non-symlink file"
-      unless -l $abslinkname;
-
-  unlink $abslinkname
-    or throw processing_error => command => $step,
-      summary => "removal of symlink $step->[1] failed: $!";
-  ftp_syslog info =>
-    "removed symlink $step->[1] in ".File::Spec::Unix->catdir(@$directory);
-}
-
 \f
 
 =back