X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FMail.pm;h=1366be3a33c09905272ebdd831a4396262563814;hb=8c1e979b111657c8c2a033e07eb3389f219010e9;hp=54e52f5dc6d852a7dc161932f449fcdc6adb9431;hpb=dcb283c0a89bb0c05b78584657f6c8d12f6bf873;p=debbugs.git diff --git a/Debbugs/Mail.pm b/Debbugs/Mail.pm index 54e52f5..1366be3 100644 --- a/Debbugs/Mail.pm +++ b/Debbugs/Mail.pm @@ -42,21 +42,28 @@ 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 POSIX qw(:sys_wait_h strftime); +use Time::HiRes qw(usleep gettimeofday); use Mail::Address (); use Debbugs::MIME qw(encode_rfc1522); use Debbugs::Config qw(:config); use Params::Validate qw(:types validate_with); +use Encode qw(encode is_utf8); + +use Debbugs::Packages; 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 = (addresses => [qw(get_addresses)], + misc => [qw(rfc822_date)], + mail => [qw(send_mail_message encode_headers default_headers)], + ); + @EXPORT_OK = (); + Exporter::export_ok_tags(keys %EXPORT_TAGS); $EXPORT_TAGS{all} = [@EXPORT_OK]; - } # We set this here so it can be overridden for testing purposes @@ -77,6 +84,209 @@ sub get_addresses { } +=head2 default_headers + + my @head = default_headers(queue_file => 'foo', + data => $data, + msgid => $header{'message-id'}, + msgtype => 'error', + headers => [...], + ); + create_mime_message(\@headers, + ... + ); + +This function is generally called to generate the headers for +create_mime_message (and anything else that needs a set of default +headers.) + +In list context, returns an array of headers. In scalar context, +returns headers for shoving in a mail message after encoding using +encode_headers. + +=head3 options + +=over + +=item queue_file -- the queue file which will generate this set of +headers (refered to as $nn in lots of the code) + +=item data -- the data of the bug which this message involves; can be +undefined if there is no bug involved. + +=item msgid -- the Message-ID: of the message which will generate this +set of headers + +=item msgtype -- the type of message that this is. + +=item pr_msg -- the pr message field + +=item headers -- a set of headers which will override the default +headers; these headers will be passed through (and may be reordered.) +If a particular header is undef, it overrides the default, but isn't +passed through. + +=back + +=head3 default headers + +=over + +=item X-Loop -- set to the maintainer e-mail + +=item From -- set to the maintainer e-mail + +=item To -- set to Unknown recipients + +=item Subject -- set to Unknown subject + +=item Message-ID -- set appropriately (see code) + +=item Precedence -- set to bulk + +=item References -- set to the full set of message ids that are known +(from data and the msgid option) + +=item In-Reply-To -- set to msg id or the msgid from data + +=item X-Project-PR-Message -- set to pr_msg with the bug number appended + +=item X-Project-PR-Package -- set to the package of the bug + +=item X-Project-PR-Keywords -- set to the keywords of the bug + +=item X-Project-PR-Source -- set to the source of the bug + +=back + +=cut + +sub default_headers { + my %param = validate_with(params => \@_, + spec => {queue_file => {type => SCALAR|UNDEF, + optional => 1, + }, + data => {type => HASHREF, + optional => 1, + }, + msgid => {type => SCALAR|UNDEF, + optional => 1, + }, + msgtype => {type => SCALAR|UNDEF, + default => 'misc', + }, + pr_msg => {type => SCALAR|UNDEF, + default => 'misc', + }, + headers => {type => ARRAYREF, + default => [], + }, + }, + ); + my @header_order = (qw(X-Loop From To subject), + qw(Message-ID In-Reply-To References)); + # handle various things being undefined + if (not exists $param{queue_file} or + not defined $param{queue_file}) { + $param{queue_file} = join('',gettimeofday()) + } + for (qw(msgtype pr_msg)) { + if (not exists $param{$_} or + not defined $param{$_}) { + $param{$_} = 'misc'; + } + } + my %header_order; + @header_order{map {lc $_} @header_order} = 0..$#header_order; + my %set_headers; + my @ordered_headers; + my @temp = @{$param{headers}}; + my @other_headers; + while (my ($header,$value) = splice @temp,0,2) { + if (exists $header_order{lc($header)}) { + push @{$ordered_headers[$header_order{lc($header)}]}, + ($header,$value); + } + else { + push @other_headers,($header,$value); + } + $set_headers{lc($header)} = 1; + } + + # calculate our headers + my $bug_num = exists $param{data} ? $param{data}{bug_num} : 'x'; + my $nn = $param{queue_file}; + # handle the user giving the actual queue filename instead of nn + $nn =~ s/^[a-zA-Z]([a-zA-Z])/$1/; + $nn = lc($nn); + my @msgids; + if (exists $param{msgid} and defined $param{msgid}) { + push @msgids, $param{msgid} + } + elsif (exists $param{data} and defined $param{data}{msgid}) { + push @msgids, $param{data}{msgid} + } + my %default_header; + $default_header{'X-Loop'} = $config{maintainer_email}; + $default_header{From} = "$config{maintainer_email} ($config{project} $config{ubug} Tracking System)"; + $default_header{To} = "Unknown recipients"; + $default_header{Subject} = "Unknown subject"; + $default_header{'Message-ID'} = ""; + if (@msgids) { + $default_header{'In-Reply-To'} = $msgids[0]; + $default_header{'References'} = join(' ',@msgids); + } + $default_header{Precedence} = 'bulk'; + $default_header{"X-$config{project}-PR-Message"} = $param{pr_msg} . (exists $param{data} ? ' '.$param{data}{bug_num}:''); + $default_header{Date} = rfc822_date(); + if (exists $param{data}) { + if (defined $param{data}{keywords}) { + $default_header{"X-$config{project}-PR-Keywords"} = $param{data}{keywords}; + } + if (defined $param{data}{package}) { + $default_header{"X-$config{project}-PR-Package"} = $param{data}{package}; + if ($param{data}{package} =~ /^src:(.+)$/) { + $default_header{"X-$config{project}-PR-Source"} = $1; + } + else { + my $pkg_src = Debbugs::Packages::getpkgsrc(); + $default_header{"X-$config{project}-PR-Source"} = $pkg_src->{$param{data}{package}}; + } + } + } + for my $header (sort keys %default_header) { + next if $set_headers{lc($header)}; + if (exists $header_order{lc($header)}) { + push @{$ordered_headers[$header_order{lc($header)}]}, + ($header,$default_header{$header}); + } + else { + push @other_headers,($header,$default_header{$header}); + } + } + my @headers; + for my $hdr1 (@ordered_headers) { + next if not defined $hdr1; + my @temp = @{$hdr1}; + while (my ($header,$value) = splice @temp,0,2) { + next if not defined $value; + push @headers,($header,$value); + } + } + push @headers,@other_headers; + if (wantarray) { + return @headers; + } + else { + my $headers = ''; + while (my ($header,$value) = splice @headers,0,2) { + $headers .= "${header}: $value\n"; + } + return $headers; + } +} + + =head2 send_mail_message @@ -111,7 +321,7 @@ using warn. sub send_mail_message{ my %param = validate_with(params => \@_, spec => {sendmail_arguments => {type => ARRAYREF, - default => [qw(-odq -oem -oi)], + default => $config{sendmail_arguments}, }, parse_for_recipients => {type => BOOLEAN, default => 0, @@ -129,12 +339,15 @@ sub send_mail_message{ }, }, ); - my @sendmail_arguments = qw(-odq -oem -oi); + my @sendmail_arguments = @{$param{sendmail_arguments}}; 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'; + my %recipients; + @recipients{@recipients} = (1) x @recipients; + @recipients = keys %recipients; # 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}; @@ -144,6 +357,11 @@ sub send_mail_message{ if ($param{encode_headers}) { $param{message} = encode_headers($param{message}); } + eval { + if (is_utf8($param{message})) { + $param{message} = encode('utf8',$param{message}); + } + }; # First, try to send the message as is. eval { @@ -188,6 +406,17 @@ sub encode_headers{ return $header . qq(\n\n). $body; } +=head2 rfc822_date + + rfc822_date + +Return the current date in RFC822 format in the UTC timezone + +=cut + +sub rfc822_date{ + return scalar strftime "%a, %d %h %Y %T +0000", gmtime; +} =head1 PRIVATE FUNCTIONS