From: Jacob Bachmeyer <jcb@gnu.org>
Date: Sun, 30 Oct 2022 03:26:24 +0000 (-0500)
Subject: Factor SMTP client out of mail and debug
X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=abaa1b4f6363fd7dde6b71f8b24d11d05d4257c9;p=gatekeeper.git

Factor SMTP client out of mail and debug
---

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 6d91cb3..c4ce02f 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -1026,6 +1026,63 @@ sub exclude_mail_blacklist {
   return @filtered;
 }
 
+=item sendmail ( $sender, $recipients, $headers, $body )
+
+Send mail from SENDER to RECIPIENTS, with HEADERS and BODY.  SENDER is an
+email address.  RECIPIENTS is an arrayref of email addresses.  HEADERS is
+an arrayref of name/value arrayrefs.  BODY is a string, which will be sent
+as given.
+
+Information about the message is also sent to syslog.
+
+=cut
+
+sub sendmail {
+  my $sender = shift;
+  my $recipients = shift;
+  my $headers = shift;
+  my $body = shift;
+
+  if (NOMAIL) {
+    ftp_syslog('info',
+	       'NOMAIL is set - not sending email to '.join(' ',@$recipients));
+  } else {
+    ftp_syslog('info', 'Sending email to '.join(' ',@$recipients));
+  }
+
+  {
+    my $subject = 'generic failure';
+    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");
+  }
+
+  unless (NOMAIL) {
+    my $smtp;
+    if (IN_TEST_MODE) {
+      $smtp = Net::SMTP->new
+	(Host => 'localhost', Port => $ENV{TEST_SMTP_PORT});
+    } else {
+      $smtp = Net::SMTP->new(Host => 'localhost');
+    }
+    ftp_abort("FATAL: SMTP connection failed") unless $smtp;
+
+    $smtp->mail($sender);
+    $smtp->recipient(unique(@$recipients), { SkipBad => 1});
+
+    $smtp->data();
+    $smtp->datasend($_->[0].': '.$_->[1]."\n") for @$headers;
+    $smtp->datasend("\n");
+    $smtp->datasend($body);
+    $smtp->dataend();
+
+    $smtp->quit();
+  }
+}
+
 # Used for both success and failure.
 #
 sub mail {
@@ -1054,109 +1111,52 @@ sub mail {
 	       "No uploader e-mail address(es) to report this error to!");
     @email_list = ($email_always);
   }
-  if (NOMAIL) {
-    ftp_syslog('info',
-	       "NOMAIL is set - not sending email to @email_list");
-  } else {
-    ftp_syslog('info', "Sending email to @email_list");
-  }
 
   my $sender = 'ftp-upload-script@gnu.org';
   $sender = 'ftp-upload@gnu.org'
     if ($send_to_user); # We really want replies to go to the ftp-upload queue
 
-  @email_list = unique(exclude_mail_blacklist($email_blacklist, @email_list));
+  @email_list = exclude_mail_blacklist($email_blacklist, @email_list);
 
   #print STDERR "final emails: @email_list\n";
   # return @_;
 
-  if (NOMAIL) {
-      if ($subject ne '') {
-	  ftp_syslog('info', "Subject: '$subject'");
-      } elsif (defined $info{package}) {
-	  ftp_syslog('info', "Subject: $info{package}");
-      } else {
-	  ftp_syslog('warning', "Error uploading package: $msg");
-	  ftp_syslog('info', "Subject: generic failure");
-      }
-      ftp_syslog('info', "Body: $msg");
+  if ($subject ne '') {
+    $subject = "[$m_style gnu-ftp-upload] $subject";
+  } elsif (defined $info{package}) {
+    $subject = "[$m_style gnu-ftp-upload] $info{package}";
   } else {
-      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_abort("FATAL: SMTP connection failed") unless $smtp;
-
-      $smtp->mail($sender);
-      $smtp->bcc($email_always)
-	if ($send_to_user && !grep $_ eq $email_always, @email_list);
-      $smtp->recipient(@email_list, { SkipBad => 1});
-
-      $smtp->data();
-      $smtp->datasend("To: " . join (", ", @email_list) . "\r\n");
-      $smtp->datasend("From: $sender\r\n");
-      $smtp->datasend("Reply-To: ftp-upload\@gnu.org\r\n");
-      my $mid = Email::MessageID->new;
-      $smtp->datasend("Message-ID: <$mid>\r\n");
-      $smtp->datasend("Date: "
-		      . strftime("%a, %e %b %Y %H:%M:%S %z", localtime)
-		      . "\r\n");
-      if ($subject ne '') {
-	  $smtp->datasend ("Subject: [$m_style gnu-ftp-upload] $subject");
-	  ftp_syslog('info', "Subject: '$subject'");
-      } elsif (defined $info{package}) {
-	  $smtp->datasend("Subject: [$m_style gnu-ftp-upload] $info{package}");
-	  ftp_syslog('info', "Subject: $info{package}");
-      } else {
-	  $smtp->datasend("Subject: [$m_style gnu-ftp-upload] generic failure");
-	  ftp_syslog('warning', "Error uploading package: $msg");
-	  ftp_syslog('info', "Subject: generic failure");
-      }
-      $smtp->datasend ("\n\n");
-      ftp_syslog('info', "Body: $msg");
-
-      # Wrap message at 78 characters, this is e-mail...
-      $Text::Wrap::columns=78;
-      $smtp->datasend (wrap('','',$msg) . "\n");
-      $smtp->dataend();
+    $subject = "[$m_style gnu-ftp-upload] generic failure";
+  }
 
-      $smtp->quit();
-    }
+  # Wrap message at 78 characters, this is e-mail...
+  local $Text::Wrap::columns = 78;
+
+  sendmail($sender,
+	   [$email_always, @email_list],
+	   [[To		=> join ', ', @email_list],
+	    [From	=> $sender],
+	    [Date	=> strftime("%a, %e %b %Y %H:%M:%S %z", localtime)],
+	    [Subject	=> $subject],
+	    ['Reply-To'	=> 'ftp-upload@gnu.org'],
+	    ['Message-ID'=> Email::MessageID->new->in_brackets],
+	   ],
+	   wrap('','',$msg) . "\n");
 }
 
 sub debug {
   my $msg = shift;
   my $package_name = shift;
 
-  if (NOMAIL) {
-    ftp_syslog('info', "Subject: [$m_style gnu-ftp-debug] "
-	       ."new upload processed: $package_name\nBody: $msg");
-  } else {
-      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_abort("FATAL: SMTP connection failed") unless $smtp;
-      $smtp->mail ("ftp-upload-script\@gnu.org");
-      $smtp->recipient ($maintainer_email, { SkipBad => 1});
-
-      $smtp->data();
-      $smtp->datasend("To: $maintainer_email\n");
-      $smtp->datasend("From: ftp-upload-script\@gnu.org\n");
-      $smtp->datasend("Reply-To: ftp-upload\@gnu.org\n");
-      $smtp->datasend("Subject: [$m_style gnu-ftp-debug] "
-		      ."new upload processed: $package_name");
-      $smtp->datasend("\n\n");
-      $smtp->datasend("$msg\n");
-      $smtp->dataend();
-      $smtp->quit();
-  }
+  sendmail('ftp-upload-script@gnu.org',
+	   [$maintainer_email],
+	   [[To		=> $maintainer_email],
+	    [From	=> 'ftp-upload-script@gnu.org'],
+	    [Subject	=> ("[$m_style gnu-ftp-debug] "
+			    ."new upload processed: $package_name")],
+	    ['Reply-To'	=> 'ftp-upload@gnu.org'],
+	   ],
+	   $msg);
 }
 
 # Send email with TAINTED_MSG to the ftp maintainers, as well as any