=head1 NAME
 
queue/zmailer_queue
 
=head1 DESCRIPTION
 
This plugin delivers mails to a zmailer spool dir. 
 
=head1 CONFIG
 
It takes one required parameter, the location of the spool dir (POSTOFFICE).
If it gets a parameter routerdirhash, it will use hashed dirs
 
=over 4
 
=item <dir_postoffice>  (REQUIRED)
 
The location of the spool dir (POSTOFFICE).
 
=item routerdirhash   (OPTIONAL)
 
If this string is present, it will use hashed dirs
 
=back
 
=head1 AUTHOR
 
Written by Leonardo Helman <lhelman@pert(punto)com(punto)ar>.
Pert Consultores SRL
Argentina
 
=head1 COPYRIGHT AND LICENSE
 
Copyright (c) 2005 Leonardo Helman. Pert Consultores SRL Argentina
 
This plugin is licensed under the same terms as the qpsmtpd package itself.
Please see the LICENSE file included with qpsmtpd for details.
 
=head1 VERSION
 
$Id: zmailer-queue,v 1.11 2006/05/16 14:12:34 leoh Exp $
 
=cut
 
use File::Path qw(mkpath);
use Sys::Hostname qw(hostname);
use Time::HiRes qw(gettimeofday);
 
sub register {
  my ($self, $qp, @args) = @_;
 
  if (@args > 0) {
    ($self->{_routerdir}) = ((shift(@args)) =~ m!([/\w\.\-]+)!);
  }
 
  $self->{_routerdirhashenabled} = grep( /routerdirhash/, @args );
 
  unless ($self->{_routerdir}) {
    $self->log(LOGWARN, "WARNING: postoffice directory not specified");
    return 0;
  }
 
  unless (-d $self->{_routerdir}) {
    $self->log(LOGWARN, "WARNING: postoffice not exists or not a directory");
    return 0;
  }
 
  # my $hostname = (hostname =~ m/([\w\._\-]+)/)[0];
  # $self->{_hostname} = $hostname;
 
}
 
my $maildir_counter = 0;
 
sub hook_queue {
  my ($self, $transaction) = @_;
 
  my ($time, $microseconds) = gettimeofday;
 
  $time = ($time =~ m/(\d+)/)[0];
  $microseconds =~ s/\D//g;
 
 
  my $unique  = "qptf-$$-" . $maildir_counter++;
  my $dir = $self->{_routerdir};
  if( $self->{_routerdirhashenabled} ) {
    my @subdir= ('A' .. 'Z');
    $dir .= "/" . $subdir[rand( @subdir )];
  }
  my $file = $dir . "/$unique";
 
  open (MF, ">$file") or 
    $self->log(LOGWARN, "could not open $file: $!"),
    return(DECLINED, "queue error (open)");
 
  print MF "external\n";
 
  my $hellostring=  '[' . $self->qp->connection->remote_ip . ']:' . $self->qp->connection->remote_port . ' "' . uc( $self->qp->connection->hello ) . ' ' . $self->qp->connection->hello_host . '"';
  # Only when there is some auth...
  if( grep( /^auth/, keys %{$self->qp->{hooks}} ) ) {
    $hellostring .= ' smtp-auth: ' . ($self->auth_user ? '"' . $self->auth_user . '"' : "<none>" );
  }
  my $sendersinsignos= $transaction->sender;
  $sendersinsignos =~ s/[<>]//g;
  print MF "rcvdfrom " . $self->qp->connection->remote_host . " ($hellostring)\n";
  print MF "comment " . $self->qp->connection->remote_host . " $hellostring\n";
  if( $sendersinsignos ) {
    print MF "from <$sendersinsignos>\n";
  }
  else {
    print MF "channel error\n";
  }
  foreach my $recip ($transaction->recipients) {
    print MF "todsn NOTIFY=FAILURE,DELAY ORCPT=rfc822;" . $recip->address . " INRCPT=rfc822;" . $recip->address . " INFROM=rfc822;$sendersinsignos\n";
    print MF "to <" . $recip->address . ">\n";
  }
  print MF "with " . ($self->qp->connection->hello eq "ehlo" ? "ESMTP" : "SMTP" ) . "\n";
  print MF "env-end\n";
 
  $transaction->header->print(\*MF);
  $transaction->body_resetpos;
  while (my $line = $transaction->body_getline) {
    print MF $line;
  }
 
#use Data::Dumper;
#print MF "-"x78 . "\n";
#print MF Dumper($self) . "\n";
#print MF "-"x78 . "\n";
#print MF Dumper($transaction) . "\n";
#print MF "="x78 . "\n";
#print MF Dumper( keys %{$self->{hooks}} ) . "\n";
 
  close MF or
    $self->log(LOGWARN, "could not close $file: $!")
    and return(DECLINED, "queue error (close)");
 
  my @stats= stat($file);
 
  rename $file, "$dir/$stats[1]" or
    $self->log(LOGWARN, "could not rename $file to $dir/$stats[1]: $!")
    and return(DECLINED, "queue error (rename)");
 
  my $msg_id = $transaction->header->get('Message-Id') || '';
  $msg_id =~ s/[\r\n].*//s;
 
  return (OK, "Queued! $msg_id"); 
}
 
# vim:ft=perl: