From d37c34a7791bf6416677b5fb635e0557f581d34b Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Fri, 4 Aug 2023 22:28:28 -0500 Subject: [PATCH] Move operation list dispatch into new operation list objects --- gatekeeper.pl | 198 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 154 insertions(+), 44 deletions(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index cd2851a..8153e80 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -199,6 +199,7 @@ use FindBin; use SDBM_File; use File::Spec; use Pod::Usage; +use Scalar::Util; # load now but import nothing into main use Net::SMTP; use Sys::Syslog qw(:DEFAULT setlogsock); @@ -1590,6 +1591,153 @@ sub read_directive_from_string { =back +=head2 Operation list helper classes + +=over + +=item TODO + +=cut + +{ + package Local::OpList; + + sub new { + my $class = shift; + my @ops = @_; + + foreach my $step (@ops) { + my $steppack = 'Local::OpList::Op_'.$step->[0]; + no strict 'refs'; + # Note that $step cannot be a symbolic reference because we have + # already dereferenced it with strict 'refs' in force above. + if (exists &{$steppack.'::execute'}) + { bless $step, $steppack } + else + { ::abort "unknown internal operation: $step->[0]" } + } + + bless \@ops, $class + } + + sub check { + my $self = shift; + my $info = $self->[0][1]; # obtain hash from header + + foreach my $step (@$self) { $step->check($info) } + } + + sub execute { + my $self = shift; + my $info = $self->[0][1]; # obtain hash from header + + foreach my $step (@$self) { $step->execute($info) } + } +} + +{ + package Local::OpList::Op_header; + + sub check {} + sub execute {} +} + +{ + package Local::OpList::Op_install; + + sub check { + my $step = shift; + my $info = shift; + my $packet = $info->{packet}; + + # If the upload installs a file, check if the final file exists; if so, + # require the 'replace' option to be set. + + my $install_as = $step->[1]; + + my $pubfinal = File::Spec::Unix->catfile + (pub => @{$packet->target_directory}, $install_as); + my $final_upload = File::Spec->catfile + (::CONF_DIR_Public, @{$packet->target_directory}, $install_as); + my $final_signature = File::Spec->catfile + (::CONF_DIR_Public, @{$packet->target_directory}, $install_as.'.sig'); + + if (-e $final_signature || -e $final_upload) { + unless ($packet->allow_overwrite) { + ::throw processing_error => command => $step, + summary => $pubfinal." exists and 'replace' was not selected"; + } + $packet->add_notice + ("Archived and overwrote $pubfinal with uploaded version"); + } + } + + sub execute { + my $step = shift; + my $info = shift; + my $packet = $info->{packet}; + + ::execute_install($packet->target_directory, $step, + $packet->upload_filename); + } +} + +{ + package Local::OpList::Op_symlink; + + sub check {} + + sub execute { + my $step = shift; + my $info = shift; + my $packet = $info->{packet}; + + ::execute_symlink($packet->target_directory, $step); + } +} + +{ + package Local::OpList::Op_rmsymlink; + + sub check {} + + sub execute { + my $step = shift; + my $info = shift; + my $packet = $info->{packet}; + + ::execute_rmsymlink($packet->target_directory, $step); + } +} + +{ + package Local::OpList::Op_archive; + + sub check {} + + sub execute { + my $step = shift; + my $info = shift; + my $packet = $info->{packet}; + + # We now also allow archiving entire directories + ::archive_filepair($packet->target_directory, $step->[1]); + } +} + +BEGIN { + eval q{{ + package Local::OpList::Op_no_op; + + sub check {} + sub execute {} + }} if (IN_TEST_MODE) +} + + + +=back + =head2 Packet model classes =over @@ -1673,29 +1821,7 @@ sub read_directive_from_string { ::abort 'internal error: performing installation check on unparsed packet' unless $self->{oplist}; - # If the upload installs a file, check if the final file exists; if so, - # require the 'replace' option to be set. - foreach my $step (@{$self->{oplist}}) { - if ($step->[0] eq 'install') { - my $install_as = $step->[1]; - - my $pubfinal = File::Spec::Unix->catfile - (pub => @{$self->target_directory}, $install_as); - my $final_upload = File::Spec->catfile - (::CONF_DIR_Public, @{$self->target_directory}, $install_as); - my $final_signature = File::Spec->catfile - (::CONF_DIR_Public, @{$self->target_directory}, $install_as.'.sig'); - - if (-e $final_signature || -e $final_upload) { - unless ($self->allow_overwrite) { - throw processing_error => command => $step, - summary => $pubfinal." exists and 'replace' was not selected"; - } - $self->add_notice - ("Archived and overwrote $pubfinal with uploaded version"); - } - } - } + $self->{oplist}->check; } sub install { @@ -1705,24 +1831,7 @@ sub read_directive_from_string { ::abort 'internal error: installing unparsed packet' unless $self->{oplist}; - # skip the header - foreach my $step (@{$self->{oplist}}[1..$#{$self->{oplist}}]) { - if ($step->[0] eq 'install') { - ::execute_install($self->target_directory, $step, - $self->upload_filename); - } elsif ($step->[0] eq 'symlink') { - ::execute_symlink($self->target_directory, $step); - } elsif ($step->[0] eq 'rmsymlink') { - ::execute_rmsymlink($self->target_directory, $step); - } elsif ($step->[0] eq 'archive') { - # We now also allow archiving entire directories - ::archive_filepair($self->target_directory, $step->[1]); - } elsif (::IN_TEST_MODE && $step->[0] eq 'no-op') { - # do nothing - } else { - ::abort "unknown internal operation: $step->[0]"; - } - } + $self->{oplist}->execute; $self->{installation_successful} = 1; } @@ -2180,8 +2289,9 @@ sub Local::Packet::Directive::_interpret_directive { my $version_error; my %options = ( replace => undef ); - my %header = ( version => undef, options => \%options, + my %header = ( version => undef, options => \%options, packet => $self, package => undef, directory => undef, filename => undef ); + Scalar::Util::weaken($header{packet}); # circular reference my @ops = ([header => \%header]); my $install = undef; # can only install one file per directive # The 'install' op carries the name of the file to install, while the @@ -2331,7 +2441,7 @@ sub Local::Packet::Directive::_interpret_directive { # Comments are ok, we ignore them } elsif (IN_TEST_MODE && $tainted_cmd eq 'no-op') { # The testsuite uses a no-op command to validate directive processing. - push @ops, ['no-op']; + push @ops, ['no_op']; } else { push @errors, "Invalid directive line:\n\n $tainted_cmd $tainted_val"; push @trace, [' ^--', 'this element is not recognized']; @@ -2356,7 +2466,7 @@ sub Local::Packet::Directive::_interpret_directive { target_directory => $header{directory}; } - $self->{oplist} = \@ops; + $self->{oplist} = Local::OpList->new(@ops); } =item $packet->_validate_directive -- 2.25.1