New plugin: smtptls-forward

[Jason Mills]

I wrote this plugin to help me with my local debugging.
Basically a heavily modified version of smtp-foward.

Thanks,
 - Jason


=head1 NAME

smtptls-forward

=head1 DESCRIPTION

This plugin forwards the mail via SMTP TLS to a specified server, rather than
delivering the email locally.

This is very similar to the smtp-forward queue plugin. In fact it is just a
heavily modified version smtp-forward.

=head1 DEPENDANCIES

Currently L<Net::SMTP::TLS> is the only non-qpstmpd dependancy.

=head1 CONFIG

Configuration is mostly strait forward. Simply add it into your qpsmtpd config
root's plugins file in the form of:

  queue/smtptls-forward <remote smtp server address> <username> <password>

Or alternately:

  queue/smtptls-forward <address> <port> <username> <password>
  
The end result should look something like this:

  queue/smtptls-forward 10.2.2.2 emailguy s3cr3t

Or maybe this:

  queue/smtptls-forward smtp.othermailhost.com 587 emailguy s3cr3t

=head1 REASONING

This plugin is mostly useful for debugging and or testing local qpsmtpd 
although there is nothing to stop you from using this to deliver mail to
external addresses from your local machine. YMMV.

=head1 CAVEATS

Sadly the dependant TLS transport class L<Net::SMTP::TLS> has a few bugs which
prevent this plugin from having as much error reporting/correction as would
normally be desired. As of this writing it appears that L<Net::SMTP::TLS> is
without a loving maintainer (please see 
https://rt.cpan.org/Dist/Display.html?Name=Net-SMTP-TLS) which may in the
future motivate this programmer to either rewrite this plugin to use a
different TLS transport class or consult with the PAUSE authorities that be to
take up the mantle of maintainer for L<Net::SMTP::TLS>

=cut

use Net::SMTP::TLS;

sub init {
  my ($self, $qp, @args) = @_;

  if (@args > 0) {
    
    if ($args[0] =~ /^([\.\w_-]+)$/) {
      $self->{_smtp_server} = $1;
      shift(@args);
    } else {
      die "Bad data in smtp server: $args[0]";
    }
    
    $self->{_smtp_port} = 25;
    
    if (@args != 0 and $args[0] =~ /^(\d+)$/) {
      $self->{_smtp_port} = $1;
      shift(@args);
    }
                
    die("smtptls-forward requires username and password config")
      unless @args == 2;
                
    ($self->{_smtp_user}, $self->{_smtp_pass}) = @args;

    $self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 
2);
  
  } else {
    
    die("No SMTP server specified in smtp-forward config");
    
  }

}

sub hook_queue {
  my ($self, $transaction) = @_;

  $self->log(
    LOGINFO,
    "forwarding to $self->{_smtp_server}:$self->{_smtp_port}"
  );
  
  my $smtp = Net::SMTP::TLS->new(
    $self->{_smtp_server},
    Port => $self->{_smtp_port},
    Timeout => 60,
    User => $self->{_smtp_user},
    Password => $self->{_smtp_pass},
    Hello => $self->qp->config("me"),
  );
  
  return (
    DECLINED,
    "Unable to queue message, failed to connect to smtp-tls server ($!)"
  ) unless $smtp;
  
  # NOTE: Net-SMTP-TLS isn't a drop in replacement for Net::SMTP
  # it seems to not return correctly
  # so in this case we are going to simply fire it off and
  # check $! for errors
  # At some point maybe someone will take up maintainership of this package
  # See: https://rt.cpan.org/Dist/Display.html?Name=Net-SMTP-TLS
  
  $smtp->mail( $transaction->sender->address );
  return(DECLINED, "Unable to queue message: smtp-tls ($!)") if $!;
  
  $smtp->to($_->address)
    foreach ($transaction->recipients);
  
  return(DECLINED, "Unable to queue message: smtp-tls ($!)") if $!;
  
  my $payload = $transaction->header->as_string;
  $payload .= $transaction->body_as_string;
  
  $smtp->data();
  $smtp->datasend($payload);
  $smtp->dataend();
  
  return(DECLINED, "Unable to queue message: smtp-tls ($!)") if $!;
  
  $smtp->quit();
    
  return(DECLINED, "Unable to queue message: smtp-tls ($!)") if $!;
  
  $self->log(LOGINFO, "finished queueing");
  
  return (OK, "Queued!");
}