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 0a8055fcbf3dfa87132f5721a8a01884cc4b9402..42ea8e68ce743fe85351b560d1b969b9c3c54bbb 100755 (executable)
--- 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 (<LSOF>) {
-    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";
 }
 
 {