Add send_args to Log::Dispatch::Email and subclasses

lib/Log/Dispatch/Email.pm

@@ -10,7 +10,7 @@ use Log::Dispatch::Output;
 use base qw( Log::Dispatch::Output );
 
 use Devel::GlobalDestruction qw( in_global_destruction );
-use Params::Validate qw(validate SCALAR ARRAYREF BOOLEAN);
+use Params::Validate qw(validate SCALAR ARRAYREF HASHREF BOOLEAN);
 Params::Validate::validation_options( allow_extra => 1 );
 
 # need to untaint this value
@@ -31,6 +31,10 @@ sub new {
                 type     => SCALAR,
                 optional => 1
             },
+            send_args => {
+                type     => SCALAR | ARRAYREF | HASHREF,
+                optional => 1
+            },
             buffered => {
                 type    => BOOLEAN,
                 default => 1
@@ -43,8 +47,9 @@ sub new {
     $self->_basic_init(%p);
 
     $self->{subject} = $p{subject} || "$0: log email";
-    $self->{to} = ref $p{to} ? $p{to} : [ $p{to} ];
-    $self->{from} = $p{from};
+    $self->{to}        = ref $p{to} ? $p{to} : [ $p{to} ];
+    $self->{from}      = $p{from};
+    $self->{send_args} = $p{send_args};
 
     # Default to buffered for obvious reasons!
     $self->{buffered} = $p{buffered};
@@ -154,6 +159,11 @@ addresses. Required.
 A string containing an email address. This is optional and may not
 work with all mail sending methods.
 
+=item * send_args ($, \@ or \%)
+
+This stores any options used to send email, such as smtp host, port, etc.
+These are different for each subclass.
+
 =item * buffered (0 or 1)
 
 This determines whether the object sends one email per message it is

lib/Log/Dispatch/Email/MIMELite.pm

@@ -16,7 +16,7 @@ sub send_email {
     my %p    = @_;
 
     my %mail = (
-        To => ( join ',', @{ $self->{to} } ),
+        To      => ( join ',', @{ $self->{to} } ),
         Subject => $self->{subject},
         Type    => 'TEXT',
         Data    => $p{message},
@@ -25,9 +25,11 @@ sub send_email {
     $mail{From} = $self->{from} if defined $self->{from};
 
     local $?;
-    unless ( MIME::Lite->new(%mail)->send ) {
-        warn "Error sending mail with MIME::Lite";
-    }
+    warn "Error sending mail with MIME::Lite"
+      unless do {
+        MIME::Lite->new(%mail)->send( @{ $self->{send_args} || [] } );
+      };
+
 }
 
 1;
@@ -46,7 +48,8 @@ __END__
               'Email::MIMELite',
               min_level => 'emerg',
               to        => [qw( [email protected] [email protected] )],
-              subject   => 'Big error!'
+              subject   => 'Big error!',
+              send_args => [ 'smtp', 'smtp.example.org', Port => 465, AuthUser => 'john', AuthPass => 'secret' ]
           ]
       ],
   );
@@ -58,4 +61,9 @@ __END__
 This is a subclass of L<Log::Dispatch::Email> that implements the
 send_email method using the L<MIME::Lite> module.
 
+=head1 CHANGING HOW MAIL IS SENT
+
+To change how mail is sent, set send_args to according to what
+L<< MIME::Lite->send >> expects.
+
 =cut

lib/Log/Dispatch/Email/MailSend.pm

@@ -25,7 +25,7 @@ sub send_email {
 
     local $?;
     eval {
-        my $fh = $msg->open
+        my $fh = $msg->open( @{ $self->{send_args} } )
             or die "Cannot open handle to mail program";
 
         $fh->print( $p{message} )
@@ -54,7 +54,8 @@ __END__
               'Email::MailSend',
               min_level => 'emerg',
               to        => [qw( [email protected] [email protected] )],
-              subject   => 'Big error!'
+              subject   => 'Big error!',
+              send_args => [ 'smtp', Server => 'mail.example.org', Hello => 'foobar.com' ],
           ]
       ],
   );
@@ -68,13 +69,26 @@ method using the L<Mail::Send> module.
 
 =head1 CHANGING HOW MAIL IS SENT
 
+There are two ways to change how mail is sent:
+
+=over 4
+
+=item 1
+
 Since L<Mail::Send> is a subclass of L<Mail::Mailer>, you can change
 how mail is sent from this module by simply C<use>ing L<Mail::Mailer>
 in your code before mail is sent. For example, to send mail via smtp,
 you could do:
 
   use Mail::Mailer 'smtp', Server => 'foo.example.com';
 
+=item 2
+
+Set send_args to the same arguments as
+the constructor of L<Mail::Mailer> expects.
+
+=back
+
 For more details, see the L<Mail::Mailer> docs.
 
 =cut

lib/Log/Dispatch/Email/MailSendmail.pm

@@ -24,6 +24,9 @@ sub send_email {
         From => $self->{from} || '[email protected]',
     );
 
+    # merge options from %{send_args}
+    %mail = ( %mail, %{ $self->{send_args} } ) if defined $self->{send_args};
+
     local $?;
     unless ( Mail::Sendmail::sendmail(%mail) ) {
         warn "Error sending mail: $Mail::Sendmail::error";
@@ -46,7 +49,8 @@ __END__
               'Email::MailSendmail',
               min_level => 'emerg',
               to        => [qw( [email protected] [email protected] )],
-              subject   => 'Big error!'
+              subject   => 'Big error!',
+              send_args => { smtp => '127.0.0.1', retries => 10, delay => 5, debug => 0, X-Custom-Header => 'epale' }
           ]
       ],
   );
@@ -58,4 +62,9 @@ __END__
 This is a subclass of L<Log::Dispatch::Email> that implements the
 send_email method using the L<Mail::Sendmail> module.
 
+=head1 CHANGING HOW MAIL IS SENT
+
+To change how mail is sent, set send_args to a hash reference just
+like L<< %Mail::Sendmail::mailcfg >>.
+
 =cut

t/send_args-exim.conf

@@ -0,0 +1,96 @@
+# This is a sample exim config file that I used together with send_args-test.pl
+# to test send_args in Log::Dispatch::Mail modules.
+#
+# It listens on ports 25, 9025 and 9026, but requires authentication only for port 9026
+#
+# It adds these headers:
+# X-Exim-Source: source of the email (eg: sendmail invocation, tcp, etc)
+# X-Exim-User: user that authenticated to send the email, or none
+# X-Exim-Flag1: added by the router (at transport time)
+# X-Exim-Flag2: added by the transport
+
+# this should be changed to some smtp server that will receive your emails:
+SMTP_SMARTHOST     = 172.16.8.51
+
+# from which tcp ports we require authentication (25 and 9025 are missing)
+# this is treated as a list
+AUTH_PORTS         = 9026
+
+# user accounts, I used pipe to separate each user and password
+AUTH_ACCOUNTS      = user1|pass1 : alan|secreto : user3|pass3
+
+acl_smtp_rcpt      = acl_rcpt_to
+acl_not_smtp       = acl_sendmail
+
+daemon_smtp_ports  = 25 : 9025 : 9026
+
+ignore_bounce_errors_after = 2d
+timeout_frozen_after       = 30d
+
+# allow to change the From:
+local_from_check   = false
+
+# log to syslog
+log_file_path      = syslog
+syslog_duplication = false
+syslog_timestamp   = false
+
+begin acl
+
+# locally generated
+acl_sendmail:
+    accept
+        add_header = X-Exim-Source: command line
+        add_header = X-Exim-User: none (not required)
+        logwrite   = Accepted from source: command line invocation
+
+# RCPT TO:
+acl_rcpt_to:
+    accept
+        condition  = ${if !forany{AUTH_PORTS}{match{$item}{$received_port}}{yes}{no}}
+        add_header = X-Exim-Source: SMTP $received_ip_address:$received_port
+        add_header = X-Exim-User: none (not required)
+        logwrite   = Accepted from source: SMTP $received_ip_address:$received_port username: none (not required)
+    accept
+        authenticated = plain : login
+        add_header = X-Exim-Source: SMTP $received_ip_address:$received_port
+        add_header = X-Exim-User: $authenticated_id
+        logwrite   = Accepted from source: SMTP $received_ip_address:$received_port username: $authenticated_id
+    deny
+        message    = Authentication is required. Interface: $interface_address username: $authenticated_id
+
+begin routers
+snd_smarthost:
+    driver      = manualroute
+    route_list  = !\N^$\N SMTP_SMARTHOST
+    transport   = remote_smtp
+    errors_to   =
+    headers_add = X-Exim-Flag1: hola
+
+begin transports
+remote_smtp:
+    driver      = smtp
+    headers_add = X-Exim-Flag2: hola
+
+begin retry
+    *    *    F,2h,15m; G,16h,1h,1.5; F,4d,6h
+
+begin rewrite
+
+begin authenticators
+
+plain:
+    driver           = plaintext
+    public_name      = PLAIN
+    server_advertise_condition = true
+    server_prompts   = :
+    server_condition = ${if inlist{$auth2|$auth3}{AUTH_ACCOUNTS}}
+    server_set_id    = $auth2
+
+login:
+    driver           = plaintext
+    public_name      = LOGIN
+    server_advertise_condition = true
+    server_prompts   = Username:: : Password::
+    server_condition = ${if inlist{$auth1|$auth2}{AUTH_ACCOUNTS}}
+    server_set_id    = $auth1