Replace ftp_warn with general warning handler in gatekeeper

This also sends any warnings generated by perl itself to syslog, which
will cause random test failures with the current testsuite, thus ensuring
that all such warnings will be fixed.

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 5647cab2b6b0d98b4113317712621a2194d510b1..19bf73762161238b0f9ea0451073c6f3b225ca6f 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -415,11 +415,6 @@ sub ftp_syslog {
   cluck($@) if $@;
 }
 
-sub ftp_warn($) {
-    ftp_syslog('warning', $_[0]);
-    warn $_[0];
-}
-
 {
   # If this is set to a defined value, ftp_abort will write the message
   # here instead of using syslog.
@@ -454,6 +449,9 @@ if (IN_TEST_MODE) {
 openlog(SYSLOG_APP_IDENT, 'pid', SYSLOG_FACILITY);
 ftp_syslog('info', "Beginning upload processing run.");
 
+# send copies of warnings to syslog
+$SIG{__WARN__} = sub { ftp_syslog('warning', $_[0]); warn $_[0] };
+
 #
 # -- Filename validation patterns and limits
 #
@@ -958,7 +956,7 @@ END
       push @addresses, $1
        if m/^([[:graph:]]+[@][[:graph:]]+)$/; # simple sanity check and untaint
     }
-    close EMAIL_FILE or ftp_warn("close($file) failed: $!");
+    close EMAIL_FILE or warn "close($file) failed: $!";
   }
 
   # Now also look for all maintainer addresses in the maintainers.bypkg file
@@ -973,7 +971,7 @@ END
     pos = $nlen;
     push @addresses, $1 while m/\G[^<]*<([^@]+[@][^>]+)>/g;
   }
-  close EMAIL_FILE or ftp_warn("close($maintainers_bypkg) failed: $!");
+  close EMAIL_FILE or warn "close($maintainers_bypkg) failed: $!";
 
   return @addresses;
 }
@@ -1202,7 +1200,7 @@ sub fatal {
     while (<PWD>) {
       chomp ($cwd = $_);
     }
-    close (PWD) or ftp_warn("pwd exited $?");
+    close (PWD) or warn "pwd exited $?";
   } else {      # child
     exec ("/bin/pwd") or ftp_abort("can't exec pwd: $!");
   }
@@ -1495,7 +1493,7 @@ sub scan_incoming {
               ."upload in progress for $1, ignoring during this run")
       if DEBUG;
     delete ($possible{$1})
-      or ftp_warn("WARNING: lsof found unrequested but open $1?!");
+      or warn "WARNING: lsof found unrequested but open $1?!";
   }
   close (LSOF);
 
@@ -2325,14 +2323,14 @@ sub success_upload {
   mail ("upload of $upload_file and $sig_file complete",1);
 
   unlink ($directive_file)
-    or ftp_warn("unlink($directive_file) failed: $!");
+    or warn "unlink($directive_file) failed: $!";
 }
 
 sub success_directive {
   my $directive_file = shift;
   mail ("processing of $directive_file complete",1);
   unlink ($directive_file)
-    or ftp_warn("unlink($directive_file) failed: $!");
+    or warn "unlink($directive_file) failed: $!";
 }
 
 sub cleanup_dir {
@@ -2457,7 +2455,7 @@ foreach my $packet (@packets) {   # each list element is an array reference
   };
 
   unless ($complete) {
-    ftp_warn ("eval failed: $@");
+    warn "eval failed: $@";
 
     # clean up files if we abort while processing a triplet
     cleanup ($sig_file, $upload_file, $directive_file)