=head1 NAME
 
http-forward Version 1.0 by Marc Sebastian Pelzer http://search.cpan.org/~mpelzer/
 
=head1 DESCRIPTION
 
This plugin forwards the mail via HTTP to a specified server. The email header will be send
as HTTP POST parameter 'mailheader' and the email body will be send as HTTP POST parameter 'mailbody'
(both are URL-encoded).
 
This plugin needs to be before all other queue plugins in the file config/plugins - otherwise it
will not be processed! So it should look like:
 
queue/http-forward http://test.org/bla.pl
queue/smtp-forward localhost 2525
 
if you want HTTP delivery of your email before sending it via SMTP to a local mailer.
 
=head1 CONFIG
 
It takes one required parameter, the URL to forward to. 
 
  queue/http-forward http://www.test.org/cgi-bin/queuemail.cgi
 
  queue/http-forward http://www.test.org/cgi-bin/queuemail.cgi?myparams=1&b=2&c=3
 
  queue/http-forward https://username:password@www.test.org/cgi-bin/queuemail.cgi?itsme=true
 
Optionally you can also add a port:
 
  queue/http-forward http://www.test.org/cgi-bin/queuemail.cgi 8080
 
If you have installed the appropriate SSL libraries, you can also do calls to a 
HTTPS url. Also, basic HTTP AUTH is supported (see example HTTP URL above). You can
also add your own POST parameters to the url which will be looped through. Make sure
that you URL-encode your values!
 
=cut
 
use LWP::UserAgent;
 
sub register {
  my ($self, $qp, @args) = @_;
 
  if (@args > 0) {
    if ($args[0] =~ m!^(https?://.+)$!) {
      $self->{_http_server} = $1;
    }
    else {
      die "Bad data in http server: $args[0]";
    }
    $self->{_http_port} = 80;
    if (@args > 1 and $args[1] =~ /^(\d+)$/) {
      $self->{_http_port} = $1;
    }
    $self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2);
  } else {
    die("No HTTP server specified in http-forward config");
  }
}
 
sub hook_queue {
  my ($self, $transaction) = @_;
  my $params;
  my $path;
 
  my $server = $self->{_http_server};
  my $port = $self->{_http_port};
 
  ($server, $path, $params) = ($server =~ m!^(http://[^\?\/]+)(/?[^\?]*)\??(.*)!);
 
  $self->log(LOGINFO, "forwarding to $server:${port}${path} with paramaters '$params'");
 
  my $ua = new LWP::UserAgent;
 
  $ua->agent("qpsmtpd");
  $ua->timeout(30);
 
  my $req = HTTP::Request->new('POST', $server . ":" . $port . $path);
 
  $req->content_type('application/x-www-form-urlencoded');
 
  my $body;
  my $header;
  my $content;
 
  $transaction->body_resetpos;
  while (my $line = $transaction->body_getline) { $body .= $line; }  
 
  $header = $transaction->header->as_string;
 
  # URL-encode header and body
  #
  $header =~ s/([^a-zA-Z0-9])/'%'.unpack("H*", $1)/eg;
  $header =~ s/ /\+/g;
  $body =~ s/([^a-zA-Z0-9])/'%'.unpack("H*", $1)/eg;
  $body =~ s/ /\+/g;
 
  $content = "mailheader=" . $header;
  $content .= "&mailbody=" . $body;
 
  if ($params) { $content .= "&" . $params; }
 
  $req->content($content);
 
  my $res = $ua->request($req);
 
  unless ($res->is_success) {
 
    return(DECLINED, "Unable to queue message.");
  }
 
  $self->log(LOGINFO, "finished queueing");
 
  return (DONE, "Queued!");
}
 
1;