Bivio::Mail::Common
# Copyright (c) 1999-2012 bivio Software, Inc. All rights reserved. # $Id$ package Bivio::Mail::Common; use strict; use Bivio::Agent::Request; use Bivio::Base 'Bivio::Collection::Attributes'; use Bivio::Die; use Bivio::IO::Config; use Bivio::IO::Trace; use IO::File (); use User::pwent (); our($_TRACE); my($_FORWARDING_HDR_RE); b_use('IO.Config')->register(my $_CFG = { errors_to => 'postmaster', # Deliver in background so errors are sent via e-mail sendmail => '/usr/sbin/sendmail -oem -odb -i', allow_resend_from => [], force_rewrite_from => [], dedup_ignores_recipients => 1, in_btest => 0, }); #TODO: get rid of global state - put it on the request instead my($_IDI) = __PACKAGE__->instance_data_index; sub FORWARDING_HDR_RE { return $_FORWARDING_HDR_RE ||= qr{^\Q@{[shift->FORWARDING_HDR]}\E:\s*(\d*)}im; } sub FORWARDING_HDR { return 'X-Bivio-Forwarded'; } sub TEST_RECIPIENT_HDR { # Returns header where recipient is inserted into msg. Only if # $req.is_test. return 'X-Bivio-Test-Recipient'; } sub enqueue_send { my($self, $req) = shift->internal_req(@_); # Queues I<self> for sending on commit. $req->push_txn_resource($self); return $self; } sub format_as_bounce { my($proto, $err, $recipients, $msg, $errors_to, $req) = @_; # Creates an error message to be sent to 'errors_to'. I<recipients> will # be retrieved with I<unsafe_get_recipients> if not supplied. # I<msg> will be retrieved with I<as_string> if not supplied. # I<errors_to> will be retrieved from I<errors_to> config if not supplied. $msg ||= \($proto->as_string); $recipients ||= $proto->unsafe_get_recipients || '<>'; my($u) = User::pwent::getpwuid($>); $u = defined($u) ? $u->name : 'uid' . $>; $errors_to ||= $_CFG->{errors_to}; my($email, $name) = $proto->user_email($req); my($test_recipient) = $req->is_test ? "\n" . $proto->TEST_RECIPIENT_HDR . ": $errors_to" : ''; return \(<<"EOF"); From: "$name" <$email> To: $errors_to Subject: ERROR: unable to send mail Sender: "$0" <$u>$test_recipient Auto-Submitted: auto-replied Error while trying to send message to $recipients: (reason: $err) -------------------- Original Message Follows ---------------- $$msg EOF } sub get_last_queued_message { my($self, $req) = @_; # Return the last message queued. return pop(@{[ grep(UNIVERSAL::isa($_, $self), @{$req->get('txn_resources')})]}); } sub handle_commit { # Send self. shift->send(shift); return; } sub handle_config { my(undef, $cfg) = @_; # errors_to : string [postmaster] # # To whom should errors be sent. # # sendmail : string [/usr/sbin/sendmail -O DeliveryMode=b -i] # # How to send mail. Must accept a list of recipients on the # command line. Arguments must be easily separated, i.e. no quoting. if ($cfg->{errors_to} =~ /['\\]/) { b_die($cfg->{errors_to}, ': invalid errors_to'); } $_CFG = $cfg; foreach my $c (qw(allow_resend_from force_rewrite_from)) { my($v) = $cfg->{$c} ||= []; $cfg->{$c . '_re'} = @$v ? qr{[\@\.](?:@{[join('|', @$v)]})$}is : undef; } return; } sub handle_rollback { # Do nothing. return; } sub internal_get_config { return $_CFG; } sub internal_req { my($self, $req) = @_; # Returns request. Warns deprecated if I<req> not supplied return ( $self, $req ? $req : ( Bivio::Agent::Request->get_current_or_new, Bivio::IO::Alert->warn_deprecated('request is a required parameter') )); } sub send { my($self, $recipients, $msg, $offset, $from, $req) = @_; # Sends a message via configured C<sendmail> program. Errors are # mailed back to configured C<errors_to>--except if no I<recipients> # or no I<msg> iwc an exception is raised. # # Bounces are sent back to $from. $from is the envelope FROM, ie. # the -f argument given to sendmail. $recipients ||= $self->unsafe_get_recipients || Bivio::Die->die('no recipients'); $recipients = join(',', @$recipients) if ref($recipients); $msg ||= $self->as_string; my($msg_ref) = ref($msg) ? $msg : \$msg; $offset ||= 0; $from = defined($from) ? '-f' . $from : ''; $recipients =~ s/'/'\\''/g; Bivio::Die->die('negative offset: ', $offset) if $offset < 0; $from =~ s/'/'\\''/g; $req ||= Bivio::Agent::Request->get_current_or_new; my($err) = _send($self, $recipients, $msg_ref, $offset, $from, $req); _send_error($self, $err, $recipients, $msg_ref, $req) if $err; return $self; } sub set_recipients { my($self, $email_list) = @_; # Sets the recipient of this mail message. It does not modify the # headers, i.e. To:, etc. I<email_list> may be a single scalar # containing multiple addresses (separated by commas) # or an array whose elements may contain scalar lists. return $self->put(recipients => join( ',', map(@{Bivio::Mail::Address->parse_list($_)}, ref($email_list) ? @$email_list : $email_list, ), )); } sub test_language_setup { my($self) = @_; b_use('IO.Config')->introduce_values({ 'Bivio::Mail::Common' => { in_btest => 1, }, }); return; } sub unsafe_get_recipients { # Returns recipients. return shift->unsafe_get('recipients'); } sub user_email { my(undef, $req) = @_; # Returns ($email, $name) my($name) = getpwuid($>) || 'intruder'; return ($req->format_email($name), $name); } sub _send { my($proto, $recipients, $msg, $offset, $from, $req) = @_; # Attempts to send the message. Returns an error string on failure. _trace('sending to ', $recipients) if $_TRACE; if ($req->is_test) { return grep( _send($proto, $_, $msg, $offset, $from, $req), split(/,/, $recipients), ) if $recipients =~ /,/; my($m) = $$msg; $msg = \$m; substr($$msg, $offset, 0) = $proto->TEST_RECIPIENT_HDR . ": $recipients\n"; } my($command) = '| ' . $_CFG->{sendmail} . ($from ? " '$from'" : '') . " '$recipients'"; _trace($command) if $_TRACE; return unless my $die = Bivio::Die->catch(sub { #TODO: causes too much forking for vagrant Bivio::IO::File->write( IO::File->new($command) || die("$command: open failed"), $msg, $offset, ); }) or $?; Bivio::IO::Alert->warn($die ? $die->as_string : "$command: status = $?"); return 'I/O error'; } sub _send_error { my($self, $err, $recipients, $msg_ref, $req) = @_; my($errors) = [$err]; foreach my $mr ($msg_ref, \('(original message send failed with reported reason)')) { $err = _send( $self, $_CFG->{errors_to}, $self->format_as_bounce($err, $recipients, $mr, undef, $req), 0, '', $req, ); last unless $err; push(@$errors, $err); } return unless $err; Bivio::Die->die('errors_to mail failed: ', join(', ', @$errors), "\n", $msg_ref); # DOES NOT RETURN } 1;