[PATCH] perlbug: support -x XFER_METHOD to use Net::SMTP #17073
Labels
Comments
From e@80x24.orgCreated by e@80x24.orgBrought up by the discussion of transitioning away from RT; It would be nice if the perl.org MX supported this to allow cf. http://nntp.perl.org/group/perl.perl5.porters/255344 Perl Info |
From e@80x24.org0001-perlbug-support-x-XFER_METHOD-to-use-Net-SMTP.patchFrom 57143113e8af4962fe34c6a4437460c394620729 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Mon, 1 Jul 2019 17:59:58 +0000
Subject: [PATCH] perlbug: support -x XFER_METHOD to use Net::SMTP
The goal is to support "perlbug -x 587" or "perlbug -x submission"
if/when the perl.org MX opens up the submission port for
unauthenticated users.
For ease-of-testing, "-x $HOST:$PORT" is also supported.
---
utils/perlbug.PL | 78 ++++++++++++++++++++++++++++++++++++++++--------
1 file changed, 66 insertions(+), 12 deletions(-)
diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index 3181adee89..0bc948f641 100644
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -69,6 +69,11 @@ $Getopt::Std::STANDARD_HELP_VERSION = 1;
sub paraprint;
+# default in case Net::DNS isn't available:
+my %DEFAULT_MX = (
+ 'perl.org' => 'perl.mx.develooper.com',
+);
+
BEGIN {
eval { require Mail::Send;};
$::HaveSend = ($@ eq "");
@@ -95,7 +100,8 @@ my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
$fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
$Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
$report_about_module, $category, $severity,
- %opt, $have_attachment, $attachments, $has_patch, $mime_boundary
+ %opt, $have_attachment, $attachments, $has_patch, $mime_boundary,
+ $xfer_method, $smtp_server, $smtp_host, $smtp_port, $xfer_cb
);
my $running_noninteractively = !-t STDIN;
@@ -211,7 +217,7 @@ sub Init {
$address = (basename ($0) =~ /^perlthanks/i) ? $thanksaddress : $bugaddress;
$cc = $::Config{'perladmin'} || $::Config{'cf_email'} || $::Config{'cf_by'} || '';
- HELP_MESSAGE() unless getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt);
+ HELP_MESSAGE() unless getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:x:", \%opt);
# This comment is needed to notify metaconfig that we are
# using the $perladmin, $cf_by, and $cf_time definitions.
@@ -348,6 +354,45 @@ EOF
$from = $::Config{'cf_email'}
if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
($me eq $::Config{'cf_by'});
+
+ # parse: -x "$MX_HOST:$PORT" or "-x sendmail" or "-x mail"
+ # maybe this can default to "submission" in the future
+ $xfer_method = $opt{x} || '';
+ if ($xfer_method =~ /\A(?:(.+):)?(submission|smtp|[0-9]+)\z/) {
+ $smtp_host = $1 if defined $1;
+ $smtp_port = $2;
+ $smtp_port = 587 if $smtp_port eq 'submission';
+ $smtp_port = 25 if $smtp_port eq 'smtp';
+ eval { require Net::SMTP } or
+ die "need Net::SMTP for submission port\n";
+ if (!defined($smtp_host)) {
+ my ($addr_domain) = ($address =~ /\@(.+)/) or
+ die "no domain in address: <$address>\n";
+ if (!eval { require Net::DNS }) {
+ $smtp_host = $DEFAULT_MX{lc($addr_domain)} or
+ die "Net::DNS required to send to $addr_domain\n";
+ warn "Net::DNS missing, using $smtp_host as MX for $address\n";
+ }
+ my (@mx) = Net::DNS::mx($addr_domain);
+ if (@mx) {
+ $smtp_host = $mx[0]->exchange;
+ print "resolved $smtp_host as MX for $addr_domain\n";
+ } else {
+ die "Failed to resolve MX for $addr_domain\n";
+ }
+ }
+ $xfer_cb = \&_send_message_smtp;
+ } elsif ($xfer_method eq '') {
+ if ($::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
+ $xfer_cb = \&_send_message_mailsend;
+ } elsif ($Is_VMS) {
+ $xfer_cb = \&_send_message_vms;
+ } else {
+ $xfer_cb = \&_send_message_sendmail;
+ }
+ } elsif ($xfer_method !~ /\A(?:sendmail|mail|vms)\z/) {
+ die "-x $xfer_method not recognized\n";
+ }
} # sub Init
sub Query {
@@ -916,15 +961,7 @@ sub Send {
# on linux certain "mail" implementations won't accept the subject
# as "~s subject" and thus the Subject header will be corrupted
# so don't use Mail::Send to be safe
- eval {
- if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
- _send_message_mailsend();
- } elsif ($Is_VMS) {
- _send_message_vms();
- } else {
- _send_message_sendmail();
- }
- };
+ eval { $xfer_cb->() };
if ( my $error = $@ ) {
paraprint <<EOF;
@@ -1223,7 +1260,24 @@ EOF
}
}
-
+sub _send_message_smtp {
+ die 'BUG: $smtp_host unset' unless defined $smtp_host;
+ die 'BUG: $smtp_port unset' unless defined $smtp_port;
+ my $smtp = Net::SMTP->new($smtp_host, Port => $smtp_port);
+ if (!$smtp) {
+ warn "Unable to initialize SMTP: \$!=$!, trying with Debug...\n";
+ $smtp = Net::SMTP->new($smtp_host, Port => $smtp_port, Debug => 1);
+ die "Unable to initialize SMTP: \$!=$!\n" unless $smtp;
+ }
+ $smtp->mail($from) or die $smtp->message;
+ my @recipients = ($address);
+ push(@recipients, $cc) if $cc;
+ $smtp->to(@recipients) or die $smtp->message;
+ $smtp->data or die $smtp->message;
+ $smtp->datasend(build_complete_message()) or die $smtp->message;
+ $smtp->dataend or die $smtp->message;
+ $smtp->code =~ /250|200/ or die "Failed to send ".$smtp->message;
+}
# a strange way to check whether any significant editing
# has been done: check whether any new non-empty lines
--
EW
|
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#134253 (status was 'new')
Searchable as RT134253$
The text was updated successfully, but these errors were encountered: