From b42725e17d340a397e3769e5246a66e5af7e4560 Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Mon, 31 Oct 2022 22:29:29 -0500
Subject: [PATCH] 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.
---
 gatekeeper.pl | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 5647cab..19bf737 100755
--- 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)
-- 
2.25.1