#!/usr/bin/perl

#
# dtmdd - dsvrTrustedMail delivery daemon
# 
# Copyright (c) Designer Servers Ltd
# All Rights Reserved
#

use strict;
use warnings;
use diagnostics;
use Carp;
use DBI;
use POSIX;
use Mail::Box::Manager;
use Sys::Syslog;
use Dsvr::Util;
use Dsvr::TaskManager;

#
# prototypes
#
sub prefix;
sub info;
sub deliver;
sub usage;

#
# options
#
my %opt = (
  "help|?"      => 0, 
  "verbose+"    => 0,
  "preserve!"   => 0,
  "daemon|d!"   => 0,
  "log=s"       => "",
  "user=s"      => "mail",
  "delay=i"     => 30,
  "batch=i"     => 50,
  "tasks=i"     => 10,
  "dbhost|H=s"  => "quarantine",
  "dbuser|U=s"  => "dtm",
  "dbpass|P=s"  => "",
  "dbtrace|T=i" => 0,
);

#
# constants
#
my $APPNAM = ($0 =~ m/\/([0-9A-Za-z_.-]+)$/g)[-1];
my $APPDSC = get_appdsc ($APPNAM . " - dsvrTrustedMail delivery daemon");

#
# globals
#
my $G_sigterm = 0;

#
# handlers
#
$SIG{__WARN__} = sub {
  syslog ('warning', @_) if ($opt{daemon});
  if ($opt{verbose}) {
    carp (prefix, @_); 
  } else {
    warn (prefix, @_) unless ($opt{quiet});
  }
};

$SIG{__DIE__} = sub {
  syslog ('err', @_) if ($opt{daemon});
  if ($opt{verbose}) {
    confess (prefix, @_);
  } else {
    die (prefix, @_);
  }
};

$SIG{INT} = $SIG{TERM} = sub {
  $G_sigterm = 1;
  warn ("received SIGTERM/SIGINT");
  $SIG{INT} = $SIG{TERM} = 'IGNORE';
};
                
#
# main
#
usage 2 unless get_opt (\%opt, GetoptConf => "no_ignore_case");
usage 0 if $opt{help};
$opt{quiet} = 0 if $opt{verbose};

print $APPDSC unless ($opt{daemon} || $opt{quiet});
show_opt (%opt) if $opt{verbose} > 1;

my $tm = Dsvr::TaskManager->new ($opt{tasks});
if ($opt{daemon}) {
  if ($opt{log}) {
    $tm->daemonise (User => $opt{user},
        STDOUT => ">" . $opt{log}, STDERR => ">&STDOUT")
      or die ("daemonise failed: $!");
  } else {
    $tm->daemonise (User => $opt{user}) 
      or die ("daemonise failed: $!");
  }
  openlog ("$APPNAM", 'cons,pid', 'mail');
  syslog ('notice', "dsvrTrustedMail delivery daemon ready");
}
      
my %pids;
$tm->{finish_code} = sub { my ($pid, $rc, $task) = @_;
  delete ($pids{$task});
};

my @DBCONNECT = ("dbi:Pg:dbname=$opt{dbhost}", $opt{dbuser}, $opt{dbpass}); 
DBI->trace ($opt{dbtrace});
my ($dbh, $sth);

if (@ARGV) {
  $dbh = DBI->connect (@DBCONNECT) or die ($DBI::errstr);
  $sth = $dbh->prepare (qq(
    SELECT ref, name, postmaster, prelude_q FROM index_list
       WHERE sf_delivered = '1' AND sf_disabled = '0' AND name like ?))
    or die ($dbh->errstr);

  foreach my $arg (@ARGV) {
    if (defined (my $recs = $dbh->selectall_arrayref ($sth, undef, $arg))) {
      foreach my $rec (@$recs) {
        my ($ref, $name, $postmaster, $prelude_q) = @$rec;
        deliver ($ref, $name, $postmaster, $prelude_q);
      }
    } else {
      warn ($dbh->errstr);
    }
  }
  exit (0);
}

while (!$G_sigterm) {
  my $d = 0;
  while (!$G_sigterm && !defined ($dbh)) {
    if (defined ($dbh = DBI->connect (@DBCONNECT, {InactiveDestroy => 1}))) {
      $sth = $dbh->prepare (qq(
        SELECT ref, name, postmaster, prelude_q FROM index_list
          WHERE sf_delivered = '1' AND sf_disabled = '0'))
        or warn ($dbh->errstr);
      last;
    } else {
      warn ($DBI::errstr);
      $d++ unless ($d > 14);
      info ("sleeping for ", $d, "m...") if $opt{verbose};
      sleep ($d * 60);
    }
  }

  if (defined (my $recs = $dbh->selectall_arrayref ($sth))) {
    foreach my $rec (@$recs) {
      last if ($G_sigterm);
      my ($ref, $name, $postmaster, $prelude_q) = @$rec;
      next if (exists ($pids{$ref}));
      $pids{$ref} = $tm->start ($ref) and next;
      deliver ($ref, $name, $postmaster, $prelude_q);
      $tm->finish;
    }
  } else {
    warn ($dbh->errstr); $dbh->disconnect; $dbh = undef; 
  }
  info ("sleeping for ", $opt{delay}, "s...") if $opt{verbose};
  $tm->wait ($opt{delay}) unless ($G_sigterm);
  $tm->wait_children;
}
$dbh->disconnect;
info ("waiting for children...") if ($opt{verbose});
$tm->wait_all_children;
warn ("exiting normally");
exit (0);

#
# subroutines
#
sub info { print prefix, @_, "\n" unless $opt{quiet}; }

sub prefix { 
  if ($opt{verbose} > 2) {
    my (@now) = localtime;
    my $ts = sprintf "[%02d:%02d:%02d]", @now[2,1,0];
    return ("$APPNAM\[$$]$ts: ");
  } else {
    return ("$APPNAM\[$$]: ");
  }
}

sub deliver { my ($index_ref, $name, $postmaster, $prelude_q) = @_;
  use Mail::Transport::Exim;
  
  my $info = "[domain:$name]";
  openlog ($APPNAM, 'cons,pid', 'mail');
  info ("$info [ref:$index_ref]") unless ($opt{daemon});

  if ($opt{verbose} > 1) {
    info ("postmaster: ", 
      $opt{verbose} > 3 ? $postmaster : brief ($postmaster));
    info (" prelude_q: ", 
      $opt{verbose} > 3 ? $prelude_q : brief ($prelude_q));
  }

  my $dbh = DBI->connect (@DBCONNECT) or die ("$info $DBI::errstr");
  my $sth = $dbh->prepare (qq(
       SELECT ref, h_message_id, h_envelope_to, h_subject, head, body 
        FROM mail_$index_ref
         WHERE sf_delivered = '1' AND sf_deleted = '0'))
    or die ("$info $dbh->errstr");
    
  my $sql = qq(UPDATE mail_$index_ref SET sf_deleted = '1' WHERE ref = ?);
  if (defined (my $msgs = $dbh->selectall_arrayref (
                            $sth, {MaxRows => $opt{batch}}))) {
    if (scalar(@$msgs) == 0) {
      $sql = qq(UPDATE index SET sf_delivered = '0' WHERE ref = ?);
      warn ("$info $dbh->errstr") 
        unless (defined ($dbh->do ($sql, undef, $index_ref)));
    }

    my $sent = 0;
    foreach my $msg (@$msgs) {
      last if ($G_sigterm);
      my ($ref, $h_message_id, $h_envelope_to, $h_subject, $head, $body) 
        = @$msg;
     
      if ($opt{verbose} > 1) {
        info ("          ref: ", $opt{verbose} > 3 ? $ref : brief ($ref));
        info (" h_message_id: ", 
          $opt{verbose} > 3 ? $h_message_id : brief ($h_message_id));
        info ("h_envelope_to: ", 
          $opt{verbose} > 3 ? $h_envelope_to : brief ($h_envelope_to));
	info ("    h_subject: ", 
          $opt{verbose} > 3 ? $h_subject : brief ($h_subject));
        info ("         head: ", $opt{verbose} > 3 ? $head : brief ($head));
        info ("         body: ", $opt{verbose} > 3 ? $body : brief ($body));
        info ("-" x 40); 
      }
      
      my $nested = Mail::Message::Body::Nested->new (
        nested => Mail::Message->read ($head.$body));
      my $msg = Mail::Message->build (
        From => $postmaster, To => $h_envelope_to, Subject => $h_subject,
	data => $prelude_q, attach => $nested);
      $msg->head->add ('X-tmDeliver:');

      if ($msg->send (via => 'exim')) {
        if (defined ($dbh->do ($sql, undef, $ref))) {
          info ("$info\[ref:$ref] message-id: $h_message_id delivered") 
            if $opt{verbose};
	  syslog ('info', 
              "$info\[ref:$ref] message-id: $h_message_id  delivered") 
            if $opt{daemon};
          $sent++;
        } else {
          warn ($dbh->errstr); 
          last;
        }
      } else {
        warn ($msg->errors); 
        last;
      }
    }
    info ("$info\[messages:$sent/", scalar (@$msgs), "]") 
      unless ($opt{daemon});
  } else {
    warn ($dbh->errstr);
  }
  $dbh->disconnect; die ("interrupted") if ($G_sigterm);
  closelog; exit (0);
}

sub usage { my ($rc) = @_;
  print <<USAGE;
$APPDSC
Usage: $APPNAM [options] [names...]
dsvrTrustedMail delivery daemon.
options:
        --tasks     =i  max parallel tasks            
        --batch     =i  max records per transaction 
        --delay     =i  delay between tasks  
    -l, --log       =s  log STDOUT, STDERR to file
    -u, --user      =s  user when running as daemon     
    -d, --daemon     !  fork and run as a daemon
    -p, --preserve   !  preserve messages/files after delivery

    -H, --dbhost    =s  database connection string 
    -U, --dbuser    =s  database username
    -P, --dbpass    =s  database password
    -T, --dbtrace   =i  print DBI trace information 

    -q, --quiet      !  suppress normal output 
    -v, --verbose    +  print verbose output
    -?, --help          show brief help
USAGE
  exit ($rc);
}

__END__

=head1 NAME

dtmdd - dsvrTrustedMail delivery daemon

=head1 SYNOPSIS

dtmdd [--tasks][--batch][--delay]
      [--log][--user][--daemon][--preserve]
      [--dbhost][--dbuser][--dbpass][--dbtrace]
      [--quiet][--verbose][--help] [names...]
                  
=head1 DESCRIPTION

Deliver messages from a dsvrTrustedMail quarantine database.

Options:

=over 4

=item --tasks=INTEGER

maximum parallel tasks to be used for delivery.

=item --batch=INTEGER

maximum records to be handled within a database transaction.

=item --delay=FLOAT  

delay in seconds between checks for messages to deliver.

=item --log=STRING

(or C<-l>) file to which STDOUT, STDERR should be logged.

=item --user=STRING

(or C<-u>) user when running as a daemon.

=item --daemon =E<gt> BOOLEAN (--no-daemon)

(or C<-d>) fork and run as a daemon.

=item --preserve =E<gt> BOOLEAN (--no-preserve)

(or C<-p>) prevent messages being marked for deletion even after successful delivery from quarantine database.

=item --dbhost=STRING

(or C<-H>) database host connection string.

=item --dbuser=STRING

(or C<-U>) database user.

=item --dbpass=STRING

(or C<-P> database password.

=item --dbtrace=INTEGER 

(or C<-T>) print DBI trace information.

=item --quiet =E<gt> BOOLEAN (--no-quiet)

(or C<-q>) suppress normal output.

=item --verbose =E<gt> INCREMENTAL

(or C<-v>) print verbose output. 

=item --help =E<gt> BOOLEAN

(or C<-?>) show brief help.

=back

=head1 AUTHOR

Tim Sellar (F<tim.sellar@dsvr.co.uk>)

=head1 COPYRIGHT

Copyright (c) Designer Servers Ltd.
All Rights Reserved.

=head1 VERSION

This code is always going to be beta ta... 

=cut

1;
# vim:set ai et sts=2 sw=2 tw=0:
