From: don <> Date: Thu, 18 Aug 2005 04:46:17 +0000 (-0800) Subject: [project @ 2005-08-17 21:46:13 by don] X-Git-Tag: release/2.6.0~656 X-Git-Url: https://git.donarmstrong.com/?p=debbugs.git;a=commitdiff_plain;h=4692d502113156a65b4691a5963cebe0d37114d3 [project @ 2005-08-17 21:46:13 by don] * Add Debbugs::Mail module that has two important functions: send_mail_message and encode_headers. All mail handling in service.in and process.in now uses send_mail_message to send mail messages which tries as hard as possible to send a message; if it fails, only warnings are returned. This fixes bad addresses causing sendmail to exit and destroying the bug log. (closes: #191306) * Add rudimentary Test::More modules for testing Debbugs::Mime and Debbugs::Mail. These are currently not called as part of the build process. --- diff --git a/Debbugs/Mail.pm b/Debbugs/Mail.pm new file mode 100644 index 0000000..6d311f8 --- /dev/null +++ b/Debbugs/Mail.pm @@ -0,0 +1,223 @@ +# $Id: Mail.pm,v 1.1 2005/08/17 21:46:16 don Exp $ + +package Debbugs::Mail; + +=head1 NAME + +Debbugs::Mail -- Outgoing Mail Handling + +=head1 SYNOPSIS + +use Debbugs::Mail qw(send_mail_message get_addresses); + +my @addresses = get_addresses('blah blah blah foo@bar.com') +send_mail_message(message => <[@addresses]); +To: $addresses[0] +Subject: Testing + +Testing 1 2 3 +END + +=head1 EXPORT TAGS + +=over + +=item :all -- all functions that can be exported + +=back + +=head1 FUNCTIONS + + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +use IPC::Open3; +use POSIX ":sys_wait_h"; +use Time::HiRes qw(usleep); +use Mail::Address (); +use Debbugs::MIME qw(encode_rfc1522); + +BEGIN{ + ($VERSION) = q$Revision: 1.1 $ =~ /^Revision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + @EXPORT_OK = qw(send_mail_message get_addresses encode_headers); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +=head2 get_addresses + + my @addresses = get_addresses('don@debian.org blars@debian.org + kamion@debian.org ajt@debian.org'); + +Given a string containing some e-mail addresses, parses the string +using Mail::Address->parse and returns a list of the addresses. + +=cut + +sub get_addresses { + return map { $_->address() } map { Mail::Address->parse($_) } @_; +} + + + +=head2 send_mail_message + + send_mail_message(message => $message, + recipients => [@recipients], + envelope_from => 'don@debian.org', + ); + + +=over + +=item message -- message to send out + +=item recipients -- recipients to send the message to. If undefed or +an empty arrayref, will use '-t' to parse the message for recipients. + +=item envelope_from -- envelope_from for outgoing messages + +=item encode_headers -- encode headers using RFC1522 (default) + +=item parse_for_recipients -- use -t to parse the message for +recipients in addition to those specified. [Can be used to set Bcc +recipients, for example.] + +=back + +Returns true on success, false on failures. All errors are indicated +using warn. + +=cut + +sub send_mail_message{ + die "send_mail_message requires an even number of arguments" if @_ % 2; + # It would be better to use Param::Validate instead... + my %param = @_; + + die "send_mail_message requires a message" if not defined $param{message}; + + my @sendmail_arguments = qw(-odq -oem -oi); + push @sendmail_arguments, '-f', $param{envelope_from} if exists $param{envelope_from}; + + my @recipients; + @recipients = @{$param{recipients}} if defined $param{recipients} and + ref($param{recipients}) eq 'ARRAY'; + # If there are no recipients, use -t to parse the message + if (@recipients == 0) { + $param{parse_for_recipients} = 1 unless exists $param{parse_for_recipients}; + } + # Encode headers if necessary + $param{encode_headers} = 1 if not exists $param{encode_headers}; + if ($param{encode_headers}) { + $param{message} = encode_headers($param{message}); + } + + # First, try to send the message as is. + eval { + _send_message($param{message}, + @sendmail_arguments, + $param{parse_for_recipients}?q(-t):(), + @recipients); + }; + return 1 unless $@; + # If there's only one recipient, there's nothing more we can do, + # so bail out. + warn $@ and return 0 if $@ and @recipients == 0; + # If that fails, try to send the message to each of the + # recipients separately. We also send the -t option separately in + # case one of the @recipients is ok, but the addresses in the + # mail message itself are malformed. + my @errors; + for my $recipient ($param{parse_for_recipients}?q(-t):(),@recipients) { + eval { + _send_message($param{message},@sendmail_arguments,$recipient); + }; + push @errors, "Sending to $recipient failed with $@" if $@; + } + # If it still fails, complain bitterly but don't die. + warn join(qq(\n),@errors) and return 0 if @errors; + return 1; +} + +=head2 encode_headers + + $message = encode_heeaders($message); + +RFC 1522 encodes the headers of a message + +=cut + +sub encode_headers{ + my ($message) = @_; + + my ($header,$body) = split /\n\n/, $message, 2; + $header = encode_rfc1522($header); + return $header . qq(\n\n). $body; +} + + +=head1 PRIVATE FUNCTIONS + +=head2 _send_message + + _send_message($message,@sendmail_args); + +Private function that actually calls sendmail with @sendmail_args and +sends message $message. + +dies with errors, so calls to this function in send_mail_message +should be wrapped in eval. + +=cut + +sub _send_message{ + my ($message,@sendmail_args) = @_; + + my ($wfh,$rfh); + my $pid = open3($wfh,$rfh,$rfh,'/usr/lib/sendmail',@sendmail_args) + or die "Unable to fork off /usr/lib/sendmail: $!"; + local $SIG{PIPE} = 'IGNORE'; + eval { + print {$wfh} $message or die "Unable to write to /usr/lib/sendmail: $!"; + close $wfh or die "/usr/lib/sendmail exited with $?"; + }; + if ($@) { + local $\; + # Reap the zombie + waitpid($pid,WNOHANG); + # This shouldn't block because the pipe closing is the only + # way this should be triggered. + my $message = <$rfh>; + die "$@$message"; + } + # Wait for sendmail to exit for at most 30 seconds. + my $loop = 0; + while (waitpid($pid, WNOHANG) == 0 or $loop++ >= 600){ + # sleep for a 20th of a second + usleep(50_000); + } + if ($loop >= 600) { + warn "Sendmail didn't exit within 30 seconds"; + } +} + + +1; + + +__END__ + + + + + + diff --git a/Makefile b/Makefile index a515322..fda9d78 100644 --- a/Makefile +++ b/Makefile @@ -14,7 +14,7 @@ examples_dir := $(doc_dir)/examples scripts_in := $(filter-out scripts/config.in scripts/errorlib.in scripts/text.in, $(wildcard scripts/*.in)) htmls_in := $(wildcard html/*.html.in) cgis := $(wildcard cgi/*.cgi cgi/*.pl) -perls := $(foreach name,Log MIME Packages Versions,Debbugs/$(name).pm) +perls := $(foreach name,Log MIME Mail Packages Versions,Debbugs/$(name).pm) install_exec := install -m755 -p install_data := install -m644 -p diff --git a/debian/changelog b/debian/changelog index 5aede6f..54065af 100644 --- a/debian/changelog +++ b/debian/changelog @@ -82,6 +82,15 @@ debbugs (2.4.2) UNRELEASED; urgency=low that look like urls in the html records output by bugreport.cgi. - Things that look like urls in message bodies are now linked (closes: #168962) + - Add Debbugs::Mail module that has two important functions: + send_mail_message and encode_headers. All mail handling in service.in + and process.in now uses send_mail_message to send mail messages which + tries as hard as possible to send a message; if it fails, only + warnings are returned. This fixes bad addresses causing sendmail to + exit and destroying the bug log. (closes: #191306) + - Add rudimentary Test::More modules for testing Debbugs::Mime and + Debbugs::Mail. These are currently not called as part of the build + process. -- Colin Watson Fri, 20 Jun 2003 18:57:25 +0100 diff --git a/scripts/process.in b/scripts/process.in index 832a676..09756f9 100755 --- a/scripts/process.in +++ b/scripts/process.in @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: process.in,v 1.101 2005/07/30 03:55:01 don Exp $ +# $Id: process.in,v 1.102 2005/08/17 21:46:16 don Exp $ # # Usage: process nn # Temps: incoming/Pnn @@ -10,7 +10,8 @@ tzset(); use IO::File; use MIME::Parser; -use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); +use Debbugs::MIME qw(decode_rfc1522); +use Debbugs::Mail qw(send_mail_message encode_headers); $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; @@ -1023,9 +1024,7 @@ sub sendmessage { # The original message received is written out in appendlog, so # before writing out the other messages we've sent out, we need to # RFC1522 encode the header. - my ($header,$body) = split /\n\n/, $msg, 2; - $header = encode_rfc1522($header); - $msg = $header . qq(\n\n). $body; + $msg = encode_headers($msg); my $hash = get_hashname($ref); #save email to the log @@ -1040,7 +1039,10 @@ sub sendmessage { push @$recips, @$bcc; } - send_mail_message($msg,$recips); + send_mail_message(message => $msg, + # Because we encode the headers above, we do not want to encode them here + encode_headers => 0, + recipients => $recips); } sub checkmaintainers { @@ -1108,80 +1110,6 @@ sub checkmaintainers { } } -=head2 send_mail_message - - send_mail_message($message,[@recipients],$envelope_from) - -Sends a mail message out to a set of recepients with envelope sender -$envelope_from; if $envelope_from is not set, defaults to -$gMaintainerEmail. - -=cut - -sub send_mail_message{ - my ($message,$recipients,$envelope_from) = @_; - - # Default to $gMaintainerEmail - $envelope_from ||= $gMaintainerEmail; - - print DEBUG "sending mail to ".join(', ',@$recipients)." with -f $envelope_from"; - local $_ = ''; - $SIG{'CHLD'}='chldhandle'; - #print DEBUG "mailing sigchild set up<\n"; - our $chldexit = 'no'; - our $c= open(U,"-|"); - #print DEBUG "mailing opened pipe fork<\n"; - defined($c) || die $!; - #print DEBUG "mailing opened pipe fork ok $c<\n"; - if (!$c) { # ie, we are in the child process - #print DEBUG "mailing child<\n"; - unless (open(STDERR,">&STDOUT")) { - #print DEBUG "mailing child opened stderr<\n"; - print STDOUT "redirect stderr: $!\n"; - #print DEBUG "mailing child opened stderr fail<\n"; - exit 1; - #print DEBUG "mailing child opened stderr fail exit !?<\n"; - } - #print DEBUG "mailing child opened stderr ok<\n"; - $c= open(D,"|-"); - #print DEBUG "mailing child forked again<\n"; - defined($c) || die $!; - #print DEBUG "mailing child forked again ok $c<\n"; - if (!$c) { # ie, we are the child process - #print DEBUG "mailing grandchild<\n"; - exec '/usr/lib/sendmail', (defined $envelope_from?'-f'.$envelope_from:''),'-odq','-oem','-oi', - @{$recipients}; - #print DEBUG "mailing grandchild exec failed<\n"; - die $!; - #print DEBUG "mailing grandchild died !?<\n"; - } - #print DEBUG "mailing child not grandchild<\n"; - print(D $message) || die $!; - #print DEBUG "mailing child printed msg<\n"; - close(D); - #print DEBUG "mailing child closed pipe<\n"; - die "\n*** command returned exit status $?\n" if $?; - #print DEBUG "mailing child exit status ok<\n"; - exit 0; - #print DEBUG "mailing child exited ?!<\n"; - } - #print DEBUG "mailing parent<\n"; - $results=''; - #print DEBUG "mailing parent results emptied<\n"; - while( $chldexit eq 'no' ) { $results.= $_; } - #print DEBUG "mailing parent results read >$results<\n"; - close(U); - #print DEBUG "mailing parent results closed<\n"; - $results.= "\n*** child returned exit status $?\n" if $?; - #print DEBUG "mailing parent exit status ok<\n"; - $SIG{'CHLD'}='DEFAULT'; - #print DEBUG "mailing parent sigchild default<\n"; - if (length($results)) { &quit("running sendmail: $results"); } - #print DEBUG "mailing parent results ok<\n"; - - -} - =head2 bug_list_forward bug_list_forward($spool_filename) if $codeletter eq 'L'; @@ -1229,9 +1157,10 @@ sub bug_list_forward{ $bug_address =~ s/\@.+//; print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n"; print DEBUG $header.qq(\n\n).$body; - send_mail_message($header.qq(\n\n).$body, - ["bugs=$bug_address\@$gListDomain"], - $envelope_from, + send_mail_message(message => $header.qq(\n\n).$body, + recipients => ["bugs=$bug_address\@$gListDomain"], + envelope_from => $envelope_from, + encode_headers => 0, ); unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!"); exit 0; diff --git a/scripts/service.in b/scripts/service.in index 693caec..d00ab8d 100755 --- a/scripts/service.in +++ b/scripts/service.in @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: service.in,v 1.111 2005/07/30 03:22:36 don Exp $ +# $Id: service.in,v 1.112 2005/08/17 21:46:17 don Exp $ # # Usage: service .nn # Temps: incoming/P.nn @@ -7,6 +7,7 @@ use File::Copy; use MIME::Parser; use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); +use Debbugs::Mail qw(send_mail_message); $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; @@ -865,22 +866,9 @@ unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!"); sub sendmailmessage { local ($message,@recips) = @_; $message = "X-Loop: $gMaintainerEmail\n" . $message; - # The original message received is written out above, so before - # writing out the other messages we've sent out, we need to - # RFC1522 encode the header. - my ($header,$body) = split /\n\n/, $message, 2; - $header = encode_rfc1522($header); - $message = $header . qq(\n\n). $body; - - print "mailing to >@recips<\n" if $debug; - $c= open(D,"|-"); - defined($c) || &quit("mailing forking for sendmail: $!"); - if (!$c) { # ie, we are the child process - exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odb','-oem','-oi',get_addresses(@recips); - die $!; - } - print(D $message) || &quit("writing to sendmail process: $!"); - $!=0; close(D); $? && &quit("sendmail gave exit status $? ($!)"); + send_mail_message(message => $message, + recipients => \@recips, + ); $midix++; } diff --git a/t/01_mime.t b/t/01_mime.t new file mode 100644 index 0000000..ed16d70 --- /dev/null +++ b/t/01_mime.t @@ -0,0 +1,28 @@ +# -*- mode: cperl;-*- +# $Id: 01_mime.t,v 1.1 2005/08/17 21:46:17 don Exp $ + +use Test::More tests => 3; + +use warnings; +use strict; + +use utf8; + +use_ok('Debbugs::MIME'); + +# encode_headers testing + +my $test_str = <<'END'; +Döñ Ärḿßtrøñĝ +END + +# 1: test decode +ok(Debbugs::MIME::decode_rfc1522(q(=?iso-8859-1?Q?D=F6n_Armstr=F3ng?= )) eq + q(Dön Armstróng ),"decode_rfc1522 decodes and converts to UTF8 properly"); + + +# 2: test encode +ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str)) eq $test_str, + "encode_rfc1522 encodes strings that decode_rfc1522 can decode"); + +# XXX figure out how to test parse diff --git a/t/05_mail.t b/t/05_mail.t new file mode 100644 index 0000000..e92bde1 --- /dev/null +++ b/t/05_mail.t @@ -0,0 +1,30 @@ +# -*- mode: cperl;-*- +# $Id: 05_mail.t,v 1.1 2005/08/17 21:46:17 don Exp $ + +use Test::More tests => 2; + +use warnings; +use strict; + +use utf8; + +use UNIVERSAL; + +use Debbugs::MIME qw(decode_rfc1522); + +use_ok('Debbugs::Mail'); + +# encode_headers testing + +my $test_str = <<'END'; +To: Döñ Ärḿßtrøñĝ +Subject: testing + +blah blah blah +END + +# 1: test decode +ok(decode_rfc1522(Debbugs::Mail::encode_headers($test_str)) eq $test_str); + +# XXX Figure out a good way to test the send message bit of +# Debbugs::Mail