From 10af1fc345d2357962195a294fc119835a91c7ac Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Fri, 4 Aug 2023 22:50:50 -0500 Subject: [PATCH] Move implementation of most operation list steps to operation list objects --- gatekeeper.pl | 199 ++++++++++++++++++++++---------------------------- 1 file changed, 88 insertions(+), 111 deletions(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index 8153e80..c091ed0 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -1645,6 +1645,12 @@ sub read_directive_from_string { { package Local::OpList::Op_install; +=item [ install =E $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 $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 $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); -} - =back -- 2.25.1