summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
authorCraig A. Berry <craigberry@mac.com>2013-11-15 20:55:58 -0600
committerCraig A. Berry <craigberry@mac.com>2014-01-17 17:52:59 -0600
commit90e95a223539362808feea9b97b7ae99ccfaa210 (patch)
tree83e2ca69a48abeaa49c44b5ed6743d0974a9face /utils
parent2bb62a09cce1da4bab5ce16be333e9c54ece21b8 (diff)
downloadperl-90e95a223539362808feea9b97b7ae99ccfaa210.tar.gz
Switch perlbug mail sender on VMS.
The VMS mail utility can't do attachments because it always adds a blank line in front of any headers you add. So use the Send From File utility, which has been documented and supported for any release in the last decade and was latently present before that. It takes the whole message verbatim just like sendmail, but also needs the envelope prepended.
Diffstat (limited to 'utils')
-rw-r--r--utils/perlbug.PL33
1 files changed, 19 insertions, 14 deletions
diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index 10b66ab16d..e100192e68 100644
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -1097,22 +1097,27 @@ sub save_message_to_disk {
}
sub _send_message_vms {
- if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
- or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
- my $prefix;
- foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
- $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
+
+ my $mail_from = $from;
+ my $rcpt_to_to = $address;
+ my $rcpt_to_cc = $cc;
+
+ map { $_ =~ s/^[^<]*<//;
+ $_ =~ s/>[^>]*//; } ($mail_from, $rcpt_to_to, $rcpt_to_cc);
+
+ if ( open my $sff_fh, '|-', 'MCR TCPIP$SYSTEM:TCPIP$SMTP_SFF.EXE SYS$INPUT:' ) {
+ print $sff_fh "MAIL FROM:<$mail_from>\n";
+ print $sff_fh "RCPT TO:<$rcpt_to_to>\n";
+ print $sff_fh "RCPT TO:<$rcpt_to_cc>\n" if $rcpt_to_cc;
+ print $sff_fh "DATA\n";
+ print $sff_fh build_complete_message();
+ my $success = close $sff_fh;
+ if ($success ) {
+ print "\nMessage sent\n";
+ return;
}
- $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
- $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
- }
- $subject =~ s/"/""/g;
- $address =~ s/"/""/g;
- $cc =~ s/"/""/g;
- my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
- if ($sts) {
- die "Can't spawn off mail (leaving bug report in $filename): $sts";
}
+ die "Mail transport failed (leaving bug report in $filename): $^E\n";
}
sub _send_message_mailsend {