From 07b448c42af48ba7771ea6a7edb3379271e2c52e Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Mon, 7 Aug 2023 20:02:00 -0500 Subject: [PATCH] Change handling of utility functions in object classes Several utilities are implemented in the main package and used throughout. This commit replaces direct references to most of them with imports from the "main" package into the various object class packages. --- gatekeeper.pl | 122 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 84 insertions(+), 38 deletions(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index 94d91ef..a2072a0 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -208,6 +208,41 @@ use Text::Wrap; use POSIX qw(strftime WIFSIGNALED WTERMSIG); use Email::MessageID; +use Exporter qw(import); # export some subs from main for classes to use +BEGIN { + $INC{'main.pm'} = 1; # ensure that "use main" will work + our @EXPORT = (); + our @EXPORT_OK = qw(abort throw ftp_syslog mkdir_p + check_signature_timestamp slurp_clearsigned_message + verify_clearsigned_message verify_detached_signature + + CONF_Log_Tag CONF_Zone_Tag + + CONF_Email_Blacklist CONF_Email_Maintainers + CONF_Email_SourceAddress CONF_Email_ReturnAddress + CONF_Email_PublicArchive CONF_Email_InternalArchive + + CONF_DIR_ConfigBase CONF_DIR_State CONF_DIR_FTPRoot + CONF_DIR_Inbox CONF_DIR_Scratch + CONF_DIR_Staging CONF_DIR_Public CONF_DIR_Archive + ); + our %EXPORT_TAGS = + (err => [qw(abort throw)], log => [qw(ftp_syslog)], + gpg => [qw(check_signature_timestamp slurp_clearsigned_message + verify_clearsigned_message verify_detached_signature)], + config => + [qw(CONF_Log_Tag CONF_Zone_Tag + + CONF_Email_Blacklist CONF_Email_Maintainers + CONF_Email_SourceAddress CONF_Email_ReturnAddress + CONF_Email_PublicArchive CONF_Email_InternalArchive + + CONF_DIR_ConfigBase CONF_DIR_State CONF_DIR_FTPRoot + CONF_DIR_Inbox CONF_DIR_Scratch + CONF_DIR_Staging CONF_DIR_Public CONF_DIR_Archive)], + ); +} + =head1 INTERNALS This section catches the internal documentation for internal functions @@ -950,6 +985,8 @@ of the name. { package Local::Exception; + use main qw(:log); + =head3 Throwing Exceptions =over @@ -973,8 +1010,7 @@ called as a function. my $type; ($type = shift) =~ s/^Local::Exception:://; my $ob = bless {type => $type, @_}, 'Local::Exception::'.$type; - # ftp_syslog is a function defined at top-level in main - ::ftp_syslog err => $ob->summary if $ob->summary; + ftp_syslog err => $ob->summary if $ob->summary; die $ob; } @@ -1603,6 +1639,8 @@ needed to process an upload, independent of the type of the upload. { package Local::OpList; + use main qw(:err); + =item $oplist = Local::OpList->new(@ops) Construct an operation list object containing OPS. The elements of OPS are @@ -1622,7 +1660,7 @@ arrayrefs as described below. if (exists &{$steppack.'::execute'}) { bless $step, $steppack } else - { ::abort "unknown internal operation: $step->[0]" } + { abort "unknown internal operation: $step->[0]" } } bless \@ops, $class @@ -1683,6 +1721,8 @@ entire hash is passed to all other operation list handlers. { package Local::OpList::Op_install; + use main qw(:err :log :config mkdir_p); + =item [ install =E $destination_filename ] Install a file into the managed tree as DESTINATION_FILENAME. @@ -1702,13 +1742,13 @@ Install a file into the managed tree as DESTINATION_FILENAME. 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); + (CONF_DIR_Public, @{$packet->target_directory}, $install_as); my $final_signature = File::Spec->catfile - (::CONF_DIR_Public, @{$packet->target_directory}, $install_as.'.sig'); + (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, + throw processing_error => command => $step, summary => $pubfinal." exists and 'replace' was not selected"; } $packet->add_notice @@ -1728,22 +1768,22 @@ Install a file into the managed tree as DESTINATION_FILENAME. 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 $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); + (CONF_DIR_Public, @$directory, $install_as); my $final_signature = File::Spec->catfile - (::CONF_DIR_Public, @$directory, $install_as.'.sig'); + (CONF_DIR_Public, @$directory, $install_as.'.sig'); - ::mkdir_p ::CONF_DIR_Public, @$directory; + 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"; + ftp_syslog info => "overwriting $pubfinal with uploaded version"; } # Do atomic rename (if the system crashes between or during the mv's, @@ -1760,6 +1800,8 @@ Install a file into the managed tree as DESTINATION_FILENAME. { package Local::OpList::Op_symlink; + use main qw(:err :log :config); + =item [ symlink =E $target, $linkname ] Establish a symlink at LINKNAME pointing to TARGET. @@ -1777,22 +1819,22 @@ Establish a symlink at LINKNAME pointing to TARGET. my $target = $step->[1]; my $linkname = $step->[2]; my $abslinkname = - File::Spec->catfile(::CONF_DIR_Public, @$directory, $linkname); + 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, + or throw processing_error => command => $step, summary => "removal of symlink $linkname failed: $!"; } # symlink away! symlink $target, $abslinkname - or ::throw processing_error => command => $step, + or throw processing_error => command => $step, summary => "creation of symlink $linkname to $target in $pubdir failed: $!"; - ::ftp_syslog info => + ftp_syslog info => "added symlink $linkname pointing to $target in $pubdir"; } } @@ -1800,6 +1842,8 @@ Establish a symlink at LINKNAME pointing to TARGET. { package Local::OpList::Op_rmsymlink; + use main qw(:err :log :config); + =item [ rmsymlink =E $linkname ] Remove the symlink at LINKNAME. @@ -1815,19 +1859,19 @@ Remove the symlink at LINKNAME. my $directory = $packet->target_directory; my $abslinkname = - File::Spec->catfile(::CONF_DIR_Public, @$directory, $step->[1]); + File::Spec->catfile(CONF_DIR_Public, @$directory, $step->[1]); - ::throw processing_error => command => $step, + throw processing_error => command => $step, summary => "symlink $step->[1] was not found" unless -e $abslinkname; - ::throw processing_error => command => $step, + throw processing_error => command => $step, summary => "refusing to remove a non-symlink file" unless -l $abslinkname; unlink $abslinkname - or ::throw processing_error => command => $step, + or throw processing_error => command => $step, summary => "removal of symlink $step->[1] failed: $!"; - ::ftp_syslog info => + ftp_syslog info => "removed symlink $step->[1] in ".File::Spec::Unix->catdir(@$directory); } } @@ -1835,6 +1879,8 @@ Remove the symlink at LINKNAME. { package Local::OpList::Op_archive; + use main qw(:err); + =item [ archive =E $filename ] Move FILENAME (and its detached signature) from the managed public file @@ -1878,7 +1924,7 @@ BEGIN { { package Local::Packet; - BEGIN { *throw = \&::throw } + use main qw(:err); # can be given an arrayref or a file list sub collect { @@ -1947,7 +1993,7 @@ BEGIN { my $self = shift; # Invoking this without first parsing the packet is a very serious bug. - ::abort 'internal error: performing installation check on unparsed packet' + abort 'internal error: performing installation check on unparsed packet' unless $self->{oplist}; $self->{oplist}->check; @@ -1957,7 +2003,7 @@ BEGIN { my $self = shift; # Invoking this without first parsing the packet is a very serious bug. - ::abort 'internal error: installing unparsed packet' + abort 'internal error: installing unparsed packet' unless $self->{oplist}; $self->{oplist}->execute; @@ -1970,17 +2016,17 @@ BEGIN { package Local::Packet::Directive; {our @ISA = qw(Local::Packet)} - BEGIN { *throw = \&::throw } + use main qw(:err :log :config :gpg); sub directive_file_name { ((shift)->files)[0] } sub parse { my $self = shift; - ::ftp_syslog info => 'found directive: '.$self->directive_file_name; + ftp_syslog info => 'found directive: '.$self->directive_file_name; - $self->{directive_text} = ::slurp_clearsigned_message - (File::Spec->catfile(::CONF_DIR_Scratch, $self->directive_file_name)); + $self->{directive_text} = slurp_clearsigned_message + (File::Spec->catfile(CONF_DIR_Scratch, $self->directive_file_name)); # This would imply that the directive file did not contain a signed # message. There is nothing further to do. @@ -2025,7 +2071,7 @@ BEGIN { my $self = shift; my $dsig_info = $self->{auth_directive_signature_info} = - ::verify_clearsigned_message($self->{directive_text}, $self->auth_keyrings); + verify_clearsigned_message($self->{directive_text}, $self->auth_keyrings); throw signature_error => sig_info => $dsig_info, summary => "gpg verify of directive file failed" @@ -2033,7 +2079,7 @@ BEGIN { throw signature_error => sig_info => $dsig_info, summary => "gpg verification problem: could not extract timestamp" unless defined $dsig_info->{sig_creation}; - ::check_signature_timestamp(directive => $dsig_info->{sig_creation}); + check_signature_timestamp(directive => $dsig_info->{sig_creation}); ::check_replay($self->{oplist}, $dsig_info->{sig_creation}); } @@ -2053,7 +2099,7 @@ BEGIN { my $self = shift; # Invoking this without first authenticating the packet is a serious bug. - ::abort 'internal error: installing unauthenticated packet' + abort 'internal error: installing unauthenticated packet' unless $self->{auth_directive_signature_info} && ($self->{auth_directive_signature_info}{exitcode} == 0 && !defined $self->{auth_directive_signature_info}{TILT}); @@ -2073,7 +2119,7 @@ BEGIN { package Local::Packet::Directive::Upload; {our @ISA = qw(Local::Packet::Directive)} - BEGIN { *throw = \&::throw } + use main qw(:err :log :config :gpg); sub has_uploaded_file { return 1 } @@ -2092,8 +2138,8 @@ BEGIN { # now check the detached signature on the uploaded file my $fsig_info = $self->{auth_file_signature_info} = - ::verify_detached_signature - (map(File::Spec->catfile(::CONF_DIR_Scratch, $_), + verify_detached_signature + (map(File::Spec->catfile(CONF_DIR_Scratch, $_), $self->target_filepair), $self->auth_keyrings); @@ -2104,7 +2150,7 @@ BEGIN { throw signature_error => sig_info => $fsig_info, summary => "gpg verification problem: could not extract timestamp" unless defined $fsig_info->{sig_creation}; - ::check_signature_timestamp(file => $fsig_info->{sig_creation}); + check_signature_timestamp(file => $fsig_info->{sig_creation}); } sub auth_signature_fingerprints { @@ -2124,14 +2170,14 @@ BEGIN { # Check uploaded file for known Automake CVE issues. check_automake_vulnerabilities - (File::Spec->catfile(::CONF_DIR_Scratch, $self->upload_filename)); + (File::Spec->catfile(CONF_DIR_Scratch, $self->upload_filename)); } sub install { my $self = shift; # Invoking this without first authenticating the file is a serious bug. - ::abort 'internal error: installing unauthenticated file' + abort 'internal error: installing unauthenticated file' unless $self->{auth_file_signature_info} && ($self->{auth_file_signature_info}{exitcode} == 0 && !defined $self->{auth_file_signature_info}{TILT}); @@ -2139,7 +2185,7 @@ BEGIN { # Do we need a subdirectory on CONF_DIR_Staging as well? Can't quite # picture when we'd have a collision, so skip that for now. move_filepair - (::CONF_DIR_Scratch, $self->upload_filename, ::CONF_DIR_Staging); + (CONF_DIR_Scratch, $self->upload_filename, CONF_DIR_Staging); $self->SUPER::install; } -- 2.25.1