Add initial scaffolding for testing mode in upload-ftp script

diff --git a/upload-ftp-v1.2.pl b/upload-ftp-v1.2.pl
index 4a814135911b461c869ab4ec1fa5c956cc605f85..78c2eeeedc0ac66666738037ff908ef7b71164ba 100755 (executable)
--- a/upload-ftp-v1.2.pl
+++ b/upload-ftp-v1.2.pl
@@ -94,8 +94,14 @@
 # Additional changes (syslog) by Justin Baugh (baughj@gnu.org), August 2005
 # Additional testing, bugfixes and functionality by Ward Vandewege (ward@gnu.org), Apr 2006 - Jan 2013
 # Additional changes (update ftpindex) by Ruben Rodriguez (ruben@gnu.org), September 2017
+# Imported into Git by Jacob Bachmeyer (jcb@gnu.org), July 2020
+# Further changes are tracked in Git.
 
 use strict;
+use warnings;
+
+use constant ();       # load this now for use in later BEGIN blocks
+
 use Net::SMTP;
 use Date::Manip;
 use Sys::Syslog qw(:DEFAULT setlogsock);
@@ -110,34 +116,63 @@ use lib '.';
 use CheckVulnerabilities qw(&check_vulnerabilities);
 no lib '.';
 
-$ENV{"LC_ALL"} = "C";  # do not think about multibyte characters
+BEGIN {
+  $ENV{'LC_ALL'} = 'C';                # do not think about multibyte characters
 
-# Clean env so we can run subprograms, notably gpgv and lsof.
-$ENV{"PATH"} = "/usr/bin:/bin:/usr/sbin";
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+  # Clean env so we can run subprograms, notably gpgv and lsof.
+  $ENV{'PATH'} = '/usr/bin:/bin:/usr/sbin';
+  delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+}
 
 my $V1_COMPAT_ALLOWED = 0;
 
 my $NAME = 'upload-ftp-v1.2.pl';
 my $VERSION = '1.2'; # This is the protocol version
 my $DATE = '2017/09/14 12:42:38';
-my $AUTHORS = "Free Software Foundation <sysadmin\@gnu.org>";
-my $COPYRIGHT = "2003-2017";
+my $COPYRIGHT_NOTICE = <<'END';
+Copyright (C) 2003-2017 Free Software Foundation <sysadmin@gnu.org>
+Copyright (C) 2020 Jacob Bachmeyer <jcb@gnu.org>
+END
 my $LICENSE = "GPLv3 or later - http://www.fsf.org/licenses/gpl.txt";
 my $URL = "http://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html";
 
-my $style = '';
-my $help = '';
-my $version = '';
-# Set this to 1 or higher to get debug output in the log file.
-my $DEBUG = 1;
-
-my $NOMAIL = 0;
-
-# Set this to 0 to disable the timestamp check on uploaded files in sub scan_incoming
-my $TSTAMPCHECK = 1;
+BEGIN {
+  # These must be declared "our" so that the actual variable with the data
+  # (in the symbol table) will remain available after the BEGIN block.
+  #
+  # These should be changed to constants eventually, since they should not
+  # change after the script is started.
+  our $style = '';
+  our $help = '';
+  our $version = '';
+  # Set this to 1 or higher to get debug output in the log file.
+  our $DEBUG = 1;
+
+  our $NOMAIL = 0;
+
+  # Set this to 0 to disable the timestamp check on uploaded files in sub scan_incoming
+  our $TSTAMPCHECK = 1;
+
+  my $TestingMode = 0;
+
+  GetOptions('help' => \$help,
+            'version' => \$version,
+            'style=s' => \$style,
+            'tstampcheck=i' => \$TSTAMPCHECK,
+            'nomail=i' => \$NOMAIL,
+            'debug=i' => \$DEBUG,
+            'testing-this-script' => \$TestingMode,
+           );
+
+  constant->import(IN_TEST_MODE => $TestingMode);
+}
 
-GetOptions ("style=s" => \$style, "tstampcheck=i" => \$TSTAMPCHECK, "nomail=i" => \$NOMAIL, "debug=i" => \$DEBUG, "help" => \$help, "version" => \$version);
+our $style;
+our $help;
+our $version;
+our $DEBUG;
+our $NOMAIL;
+our $TSTAMPCHECK;
 
 &version_information () if ($version);
 &usage_information() if ($help);
@@ -185,6 +220,20 @@ my $email_always = 'ftp-upload-script@gnu.org';  # e.g., ftp-upload@gnu.org
 # syslog destination
 my $facility = "LOCAL5";
 
+if (IN_TEST_MODE) { # override the above for testing
+  # override PATH
+  # override file paths to our testcase environment
+  # verify mock gpgv
+  # verify configuration for mock smtpd
+  die "ftp-upload: test mode: TEST_SMTP_PORT not valid"
+    unless $ENV{TEST_SMTP_PORT} && $ENV{TEST_SMTP_PORT} =~ m/^\d+$/;
+  # verify configuration for mock syslog
+  die "ftp-upload: test mode: TEST_SYSLOG_SOCKET not valid"
+    unless $ENV{TEST_SYSLOG_SOCKET} && -S $ENV{TEST_SYSLOG_SOCKET} && -w _;
+} else {
+  # TODO: make sure the mock gpgv is NOT in our PATH
+}
+
 my %info;   # package being processed; a global so fatal and mail can use it
 
 exit (&main ());
@@ -193,7 +242,7 @@ sub main
 {
 
   # Initialize our syslogging
-  setlogsock('unix');
+  setlogsock(unix => $ENV{TEST_SYSLOG_SOCKET}) if IN_TEST_MODE;
   openlog("ftp-upload", 'pid', $facility);
   ftp_syslog('info', "($log_style) Beginning upload processing run.");
 
@@ -275,9 +324,11 @@ sub usage_information {
 
 sub version_information {
   print "\nThis is $NAME protocol version $VERSION ($DATE)\n";
-  print "Copyright (c) $COPYRIGHT by $AUTHORS\n";
+  print $COPYRIGHT_NOTICE;
   print "License: $LICENSE\n";
   print "More information at $URL\n\n";
+  print 'Running in ', (IN_TEST_MODE ? 'testing' : 'production'),
+    " mode with PATH:\n  ", $ENV{PATH}, "\n\n";
   print 'Running with @INC:', "\n";
   print "  $_\n" for @INC;
   print "\n";
@@ -1249,7 +1300,13 @@ sub mail {
       }
       ftp_syslog('info', "($log_style) Body: $msg");
   } else {
-      my $smtp = Net::SMTP->new ("127.0.0.1");
+      my $smtp;
+      if (IN_TEST_MODE) {
+       $smtp = Net::SMTP->new
+         (Host => 'localhost', Port => $ENV{TEST_SMTP_PORT});
+      } else {
+       $smtp = Net::SMTP->new ("127.0.0.1");
+      }
       ftp_die("FATAL: SMTP connection failed") unless $smtp;
 
       $smtp->mail ($sender);
@@ -1293,7 +1350,13 @@ sub debug {
   if ($NOMAIL) {
       ftp_syslog('info', "($log_style) Subject: [$m_style gnu-ftp-debug] new upload processed: $package_name\nBody: $msg");
   } else {
-      my $smtp = Net::SMTP->new ("127.0.0.1");
+      my $smtp;
+      if (IN_TEST_MODE) {
+       $smtp = Net::SMTP->new
+         (Host => 'localhost', Port => $ENV{TEST_SMTP_PORT});
+      } else {
+       $smtp = Net::SMTP->new ("127.0.0.1");
+      }
       ftp_die("FATAL: SMTP connection failed") unless $smtp;
       $smtp->mail ("ftp-upload-script\@gnu.org");
       $smtp->recipient ($maintainer_email, { SkipBad => 1});