# -*- cperl -*-

use strict;
use warnings;

use Net::SMTP;

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

  if (@args > 0) {
    if ($args[0] =~ /^([\.\w_-]+)$/) {
      $self->{_smtp_server} = $1;
    }
    else {
      die "Bad data in smtp server: $args[0]";
    }
    $self->{_smtp_port} = 25;
    if (@args > 1 and $args[1] =~ /^(\d+)$/) {
      $self->{_smtp_port} = $1;
    }
    $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->new( $self->{_smtp_server},
			     Port    => $self->{_smtp_port},
			     Timeout => 60,
			     Hello   => $self->qp->config("me"),
                           ) || die $!;

  my $helo_resp = $smtp->message();

  if ( $self->qp->connection->notes('xforward_enabled') ) {
    eval {
      $self->attempt_xforward( $self->qp->connection, $smtp, $helo_resp );
    };

    $self->log(LOGINFO, "XFORWARD failed: $@") if $@;
  }

  $smtp->mail( $transaction->sender->address || "" ) or return(DECLINED, "Unable to queue message ($!)");

  foreach ($transaction->recipients) {
    $smtp->to($_->address) or return(DECLINED, "Unable to queue message ($!)");
  }

  $smtp->data() or return(DECLINED, "Unable to queue message ($!)");
  $smtp->datasend($transaction->header->as_string) or return(DECLINED, "Unable to queue message ($!)");
  $transaction->body_resetpos;

  while (my $line = $transaction->body_getline) {
    $smtp->datasend($line) or return(DECLINED, "Unable to queue message ($!)");
  }

  $smtp->dataend() or return(DECLINED, "Unable to queue message ($!)");
  $smtp->quit()    or return(DECLINED, "Unable to queue message ($!)");

  $self->log(LOGINFO, "finished queueing");

  return (OK, "Queued!");
}


sub attempt_xforward {

  my ($self, $connection, $smtp, $helo_resp) = @_;

  # This feels like a slightly dodgy way of processing the response,
  # and assumes a well-formed ESMTP response.

  my @s = split /\r?\n/, $helo_resp;
  my @supported = splice( @s, 1 ); # Drop the hostname.
  my @xforward  = grep { /XFORWARD/i } @supported;

  my @params;

  if ( @xforward ) {
    my @x = split / /, $xforward[0];
    @params = map { uc } splice( @x, 1 ); # Drop the XFORWARD verb.
    $self->log(LOGDEBUG, "supported parameters: @params" );
  } else {
    $self->log(LOGINFO, "XFORWARD does not appear to be supported by SMTP server $self->{'_smtp_server}'}" );
    die "XFORWARD does not appear to be supported by downstream SMTP server";
  }

  my %xf = %{ $connection->notes('xforward') || {} };

  # No point in sending XFORWARD commands if we don't have anything useful to say.
  die "No XFORWARD data to send to downstream server" unless keys %xf;

  foreach my $param ( @params ) {
    my $value = $xf{ $param } || '[UNAVAILABLE]';

    $self->log(LOGDEBUG, "sending ${param}=${value}");

    # command() is a Net::Cmd class method, returns undef on error.
    my $rc = $smtp->command( "XFORWARD", "${param}=${value}" );
    die "Problem sending XFORWARD command" unless defined $rc;

    unless ( $smtp->response == 2 ) {
      # response returns most signifcant digit of server response code.
      die "Positive return code not received from XFORWARD command";
    }
  }
  return 1;
}



=head1 NAME

xforward-smtp-forward

=head1 DESCRIPTION

This plugin is heavily based on the queue/smtp-forward plugin.

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

In addition, if the specified server supports the XFORWARD SMTP
extension, this plugin will send any XFORWARD information it has to
that server. See the xforward plugin for the code to accept incoming
XFORWARD data.

=head1 CONFIGURATION

It takes one required parameter, the IP address or hostname to forward to.

  queue/xforward-smtp-forward 10.2.2.2

Optionally you can also add a port:

  queue/xforward-smtp-forward 10.2.2.2 9025

=head1 ISSUES

At the moment the code processing XFORWARD commands is split into two
parts - the xforward plugin accepts the commands from the upstream
server and this plugin sends XFORWARD commands on to a downstream
server. This may well change in future versions.

=head1 AUTHOR

XFORWARD code added by Barrie Bremner L<http://www.barriebremner.com>.

Other functionality taken from the Qpsmtpd queue/smtp-forward plugin
L<http://smtpd.develooper.com/>

=head1 LICENSE

Copyright (c) 2006 Barrie Bremner

This plugin is licensed under the same terms as the qpsmtpd package itself.
Please see the LICENSE file included with qpsmtpd for details.

=cut