From: Jacob Bachmeyer Date: Thu, 17 Nov 2022 04:04:40 +0000 (-0600) Subject: Revise calls to ftp_syslog X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=90c112122faf93d24849350636bbc433ad3b073b;p=gatekeeper.git Revise calls to ftp_syslog The ftp_syslog procedure now requires exactly two arguments and all calls have been changed to use Perl's fat comma and its implicit quoting for the syslog severity keywords. --- diff --git a/gatekeeper.pl b/gatekeeper.pl index 0a8055f..42ea8e6 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -415,7 +415,7 @@ single line and prepending processing context information. =cut -sub ftp_syslog { +sub ftp_syslog($$) { my $severity = shift; my $message = shift; @@ -464,7 +464,7 @@ sub abort($) { if (defined $AbortPipe && defined fileno $AbortPipe) { print $AbortPipe $msg, "\n" } else - { ftp_syslog('err', $msg) } + { ftp_syslog err => $msg } exit $AbortExitCode; } @@ -477,10 +477,10 @@ if (IN_TEST_MODE) { setlogsock(unix => $1); } openlog(SYSLOG_APP_IDENT, 'pid', SYSLOG_FACILITY); -ftp_syslog('info', "Beginning upload processing run."); +ftp_syslog info => "Beginning upload processing run."; # send copies of warnings to syslog -$SIG{__WARN__} = sub { ftp_syslog('warning', $_[0]); warn $_[0] }; +$SIG{__WARN__} = sub { ftp_syslog warning => $_[0]; warn $_[0] }; # # -- Filename validation patterns and limits @@ -769,7 +769,7 @@ sub throw { my $type = shift; my $ob = bless {type => $type, @_}, 'Local::Exception::'.$type; - ftp_syslog('err', $ob->summary) if $ob->summary; + ftp_syslog err => $ob->summary if $ob->summary; die $ob; } @@ -924,7 +924,7 @@ sub _spawn_gpgv { push @gpgv_args, '--keyring', $_ for @$keyrings; push @gpgv_args, @file_args; - ftp_syslog('debug', 'DEBUG: gpgv command line: '.join(' ', @gpgv_args)) + ftp_syslog debug => 'DEBUG: gpgv command line: '.join(' ', @gpgv_args) if DEBUG; my $pid = fork; @@ -1096,7 +1096,7 @@ sub verify_clearsigned_message { my $text = shift; my @keyrings = @_; - ftp_syslog('debug', 'DEBUG: message size is '.length($text)) if DEBUG; + ftp_syslog debug => 'DEBUG: message size is '.length($text) if DEBUG; # "my (LIST) = ..." causes problems with CPerl mode here -- jcb my $pid; my $gpgv_stdin_source; @@ -1161,9 +1161,9 @@ sub verify_detached_signature { my $file_size = -s $filename; my $sig_file_size = -s $sigfilename; - ftp_syslog('debug', "DEBUG: $sigfilename size is $sig_file_size") + ftp_syslog debug => "DEBUG: $sigfilename size is $sig_file_size" if DEBUG; - ftp_syslog('debug', "DEBUG: $filename size is $file_size") + ftp_syslog debug => "DEBUG: $filename size is $file_size" if DEBUG; } @@ -1256,7 +1256,7 @@ sub directory_keyrings { my @keyrings = directory_configuration_files('pubring.gpg', $directory); if (DEBUG) { - ftp_syslog('debug', "DEBUG: found keyring $_") for @keyrings; + ftp_syslog debug => "DEBUG: found keyring $_" for @keyrings; } return @keyrings; @@ -1375,10 +1375,10 @@ sub sendmail { my $body = shift; if (NOMAIL) { - ftp_syslog('info', - 'NOMAIL is set - not sending email to '.join(' ',@$recipients)); + ftp_syslog info => + 'NOMAIL is set - not sending email to '.join(' ',@$recipients); } else { - ftp_syslog('info', 'Sending email to '.join(' ',@$recipients)); + ftp_syslog info => 'Sending email to '.join(' ',@$recipients); } { @@ -1386,9 +1386,9 @@ sub sendmail { if (my @subject = grep $_->[0] eq 'Subject', @$headers) { $subject = $subject[0][1] } if ($subject =~ m/generic failure$/) - { ftp_syslog('warning', "Error uploading package: $body") } - ftp_syslog('info', "Subject: '$subject'"); - ftp_syslog('info', "Body: $body"); + { ftp_syslog warning => "Error uploading package: $body" } + ftp_syslog info => "Subject: '$subject'"; + ftp_syslog info => "Body: $body"; } unless (NOMAIL) { @@ -1443,8 +1443,8 @@ sub mail { # Something went wrong, but we can't figure out which package this # upload belongs to. Mention that in the logs, and then mail this to # the script maintainer anyway. - ftp_syslog('info', - "No uploader e-mail address(es) to report this error to!"); + ftp_syslog info => + "No uploader e-mail address(es) to report this error to!"; @email_list = ($Internal_Report_Inbox); } @@ -1720,7 +1720,7 @@ sub scan_incoming { # Examine the file; this populates an internal cache in perl. unless (stat(File::Spec->catfile($directory, $ent))) { - ftp_syslog('warning', "could not stat($ent), skipping"); + ftp_syslog warning => "could not stat($ent), skipping"; next ENT } @@ -1729,8 +1729,8 @@ sub scan_incoming { # are still being uploaded. (use stat cache) if (TSTAMPCHECK) { if ((stat(_))[9] >= $time_bar) { - ftp_syslog('debug', "DEBUG: " - ."$ent has been modified in the last 2 minutes, skipping") + ftp_syslog debug => "DEBUG: " + ."$ent has been modified in the last 2 minutes, skipping" if DEBUG; next ENT } @@ -1738,25 +1738,25 @@ sub scan_incoming { # check for overlength directives and signatures (use stat cache) if (/[.]directive[.]asc$/ && -f _ && ((-s _) >= MAX_DIRECTIVE_SIZE)) { - ftp_syslog('info', "Overlength directive file ($ent) trashcanned"); + ftp_syslog info => "Overlength directive file ($ent) trashcanned"; push @trash, File::Spec->catfile($directory, $ent); next ENT } elsif (/[.]sig$/ && -f _ && ((-s _) >= MAX_SIGNATURE_SIZE)) { - ftp_syslog('info', "Overlength signature file ($ent) trashcanned"); + ftp_syslog info => "Overlength signature file ($ent) trashcanned"; push @trash, File::Spec->catfile($directory, $ent); next ENT } - ftp_syslog('debug', "DEBUG: uploaded file to check: $ent") if DEBUG; + ftp_syslog debug => "DEBUG: uploaded file to check: $ent" if DEBUG; $possible{$ent} = 1; } closedir INCOMING or abort "FATAL: closedir($directory) failed: $!"; # dispose of any garbage files - ftp_syslog('info', "$badname_count files with bogus names were trashcanned") + ftp_syslog info => "$badname_count files with bogus names were trashcanned" if $badname_count; - ftp_syslog('info', "Trashcanned files removed") + ftp_syslog info => "Trashcanned files removed" if unlink @trash; @trash = (); # and empty the array to be safe, since it contained # potentially arbitrary _untainted_ filenames @@ -1782,17 +1782,17 @@ sub scan_incoming { # be seen because they are owned by another user. my @lsof_args = (LSOF_BIN, "-Fn", map { File::Spec->catfile($directory, $_) } keys %possible); - ftp_syslog('debug', "DEBUG: lsof command line: " . join(' ',@lsof_args)) + ftp_syslog debug => "DEBUG: lsof command line: " . join(' ',@lsof_args) if DEBUG; open LSOF, '-|', @lsof_args or abort "FATAL: cannot spawn lsof: $!";; while () { - ftp_syslog('debug', "DEBUG: lsof output: $_") if DEBUG; + ftp_syslog debug => "DEBUG: lsof output: $_" if DEBUG; # only look at the name lines next unless /^n${directory}\/(.+)$/; - ftp_syslog('debug', "DEBUG: " - ."upload in progress for $1, ignoring during this run") + ftp_syslog debug => "DEBUG: " + ."upload in progress for $1, ignoring during this run" if DEBUG; delete ($possible{$1}) or warn "WARNING: lsof found unrequested but open $1?!"; @@ -1836,8 +1836,8 @@ sub gather_packets { # issue by requiring known extensions on each common STEM, but requires # this function to be updated if new packet types are added. - ftp_syslog('debug', "DEBUG: " - ."considering stem [$stem] for processing") if DEBUG; + ftp_syslog debug => "DEBUG: " + ."considering stem [$stem] for processing" if DEBUG; # Note that all values in %havefile are 1 and the undefined value is # falsish in Perl, so simple checks are adequate here. No tests for @@ -1858,14 +1858,14 @@ sub gather_packets { && ! -e File::Spec->catfile($directory, $file)) || rename (File::Spec->catfile($directory, $file), File::Spec->catfile($scratchpad, $file))) { - ftp_syslog('error', - "rename $directory/$file to $scratchpad/$file: $!"); + ftp_syslog error => + "rename $directory/$file to $scratchpad/$file: $!"; next STEM # abandon processing this triplet } } push @ret, $triplet; - ftp_syslog('info', 'processing ['.join(':',@$triplet).']'); + ftp_syslog info => 'processing ['.join(':',@$triplet).']'; } else { # A lone directive file: STEM.directive.asc @@ -1886,10 +1886,10 @@ sub gather_packets { if ($racecondition) { # Most likely a race condition. We have a directive file but not # the accompanying file(s). Just ignore this directive for now. - ftp_syslog('info', + ftp_syslog info => "Found directive file with filename directive " ."(${stem}.directive.asc), but no accompanying files. " - ."Ignoring directive file in this run."); + ."Ignoring directive file in this run."; } else { # Directive file only, no actual file to deal with # This can happen when dealing with symlink/rmsymlink/archive options @@ -1898,12 +1898,12 @@ sub gather_packets { && ! -e File::Spec->catfile($directory, $file))# file uploads || rename (File::Spec->catfile($directory, $file), File::Spec->catfile($scratchpad, $file))) { - ftp_syslog('error', - "rename $directory/$file to $scratchpad/$file: $!"); + ftp_syslog error => + "rename $directory/$file to $scratchpad/$file: $!"; next STEM # abandon processing this item } push @ret, [$file]; - ftp_syslog('info', 'processing ['.$file.']'); + ftp_syslog info => 'processing ['.$file.']'; } } } @@ -2282,9 +2282,9 @@ sub check_signature_timestamp { my $what = ucfirst shift; my $timestamp = shift; - ftp_syslog('debug', "DEBUG: $what signature made " + ftp_syslog debug => "DEBUG: $what signature made " .strftime('%a %b %d %H:%M:%S %Y %Z', - localtime $timestamp)) if DEBUG; + localtime $timestamp) if DEBUG; # Verify that this timestamp is not too far in the future. We allow a # discrepancy of 1 day so we don't have to worry about timezones @@ -2346,8 +2346,8 @@ sub check_automake_vulnerabilities { local *_; # First check if the file contains any Makefile.in files - ftp_syslog('debug',"DEBUG: " - ."testing $upload_file for presence of Makefile.in") + ftp_syslog debug => "DEBUG: " + ."testing $upload_file for presence of Makefile.in" if DEBUG; my @tar_cmd = (qw(/bin/tar -tf), $upload_file); open TAR, '-|', @tar_cmd @@ -2361,8 +2361,8 @@ sub check_automake_vulnerabilities { # If it does, check inside them my %issues = (); - ftp_syslog('debug',"DEBUG: found Makefile.in, " - ."testing for CVE-2009-4029 and CVE-2012-3386") + ftp_syslog debug => "DEBUG: found Makefile.in, " + ."testing for CVE-2009-4029 and CVE-2012-3386" if DEBUG; @tar_cmd = (qw(/bin/tar --to-stdout -x -f), $upload_file, qw(Makefile.in --wildcards */Makefile.in)); @@ -2382,8 +2382,8 @@ sub check_automake_vulnerabilities { if %issues; } - ftp_syslog('debug', "DEBUG: " - ."tested negative for CVE-2009-4029 and CVE-2012-3386") + ftp_syslog debug => "DEBUG: " + ."tested negative for CVE-2009-4029 and CVE-2012-3386" if DEBUG; } @@ -2458,7 +2458,7 @@ sub archive_filepair { rename $abspubfilename, $absarcfilename or die "rename($abspubfilename, $absarcfilename): $!"; - ftp_syslog('info', "archived $pubfilename to $absarcfilename"); + ftp_syslog info => "archived $pubfilename to $absarcfilename"; close ARCSTAMP; } @@ -2497,7 +2497,7 @@ sub install_files { if ($header->{options}{replace}) { archive_filepair([File::Spec::Unix->splitdir($header->{directory})], $upload_file); - ftp_syslog('info', "overwriting $pubfinal with uploaded version"); + ftp_syslog info => "overwriting $pubfinal with uploaded version"; push @{$header->{notices}}, "Archived and overwrote $pubfinal with uploaded version"; } else { @@ -2563,8 +2563,8 @@ sub execute_commands { or throw processing_error => command => $step, summary => "creation of symlink $linkname " ."to $target in $header->{directory} failed: $!"; - ftp_syslog('info', "added symlink $linkname pointing to " - ."$target in $header->{directory}"); + ftp_syslog info => "added symlink $linkname pointing to " + ."$target in $header->{directory}"; } elsif ($step->[0] eq 'rmsymlink') { my $abslinkname = File::Spec->catfile($Public_dir, @directory, $step->[1]); @@ -2577,7 +2577,7 @@ sub execute_commands { unlink $abslinkname or throw processing_error => command => $step, summary => "removal of symlink $step->[1] failed: $!"; - ftp_syslog('info', "removed symlink $step->[1] in $header->{directory}"); + ftp_syslog info => "removed symlink $step->[1] in $header->{directory}"; } elsif ($step->[0] eq 'archive') { # We now also allow archiving entire directories archive_filepair(\@directory, $step->[1]); @@ -2621,8 +2621,8 @@ sub cleanup_dir { my @stat = stat($absfile); my $mtime = $stat[9]; if ($mtime < $time_bar) { # file older than one day - ftp_syslog('debug',"DEBUG: " - ."Removing $file, older than 24 hours (mtime: $mtime)") + ftp_syslog debug => "DEBUG: " + ."Removing $file, older than 24 hours (mtime: $mtime)" if DEBUG; unlink $absbackup; # don't worry if it doesn't exist rename $absfile, $absbackup; @@ -2646,7 +2646,7 @@ sub cleanup { for my $file (@_) { my $absfile = File::Spec->catfile($dir, $file); my $absbackup = File::Spec->catfile($dir, '.'.$file); - ftp_syslog('debug',"DEBUG: cleaning up $dir/$file\n") + ftp_syslog debug => "DEBUG: cleaning up $dir/$file\n" if (DEBUG > 1); # if we quit early enough, they might not be there. next unless defined $file && -e $absfile; @@ -2676,7 +2676,7 @@ my @packets; foreach my $packet (@packets) { # each list element is an array reference my $stem = substr $packet->[0],0,-(length '.directive.asc'); - ftp_syslog('info',"found directive: $packet->[0]"); + ftp_syslog info => "found directive: $packet->[0]"; # variables preserved for the report if an exception is thrown my $directive_text; my $directive; my $oplist; my $op_header; @@ -2848,13 +2848,13 @@ foreach my $packet (@packets) { # each list element is an array reference } if ((scalar @packets) == 0) { - ftp_syslog('info', "No files found for processing."); + ftp_syslog info => "No files found for processing."; } else { - ftp_syslog('info', "Processing complete: " - .(scalar @packets)." uploads processed."); + ftp_syslog info => "Processing complete: " + .(scalar @packets)." uploads processed."; system("/usr/local/bin/generate-ftpindex") unless IN_TEST_MODE; - ftp_syslog('info', "Updated ftpindex"); + ftp_syslog info => "Updated ftpindex"; } {