#!/usr/bin/perl

#
# dtmqd - dsvrTrustedMail quarantine 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 circle;
sub quarantine;
sub parse;
sub usage;

#
# options
#
my %opt = (
  "help|?"      => 0, 
  "verbose+"    => 0,
  "quiet!"      => 0,
  "preserve!"   => 0,
  "split|s!"    => 0,
  "daemon|d!"   => 0,
  "user=s"      => "mail",
  "delay=i"     => 30,
  "batch=i"     => 50,
  "tasks=i"     => 10,
  "dir=s"       => "/var/spool/quarantine",
  "log=s"       => "",
  "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 quarantine 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 quarantine daemon ready"); 
}

my (%pids, $task, $dir, $file);
$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;

if (@ARGV) {
  $dbh = DBI->connect (@DBCONNECT) or die ($DBI::errstr);  
  quarantine (@ARGV) if (@ARGV); 
  exit (0);
}

my @tags = (0..9, 'a'..'z');
my $mark = circle (\@tags);
while (!$G_sigterm) {
  my $d = 0;
  while (!$G_sigterm && !defined ($dbh)) {
    $dbh = DBI->connect (@DBCONNECT, {InactiveDestroy => 1})
      or warn ($DBI::errstr);
    last if (defined ($dbh));
    $d++ unless ($d > 14);
    info ("sleeping for ", $d, "m...") if $opt{verbose};
    sleep ($d * 60);
  }                                    

  if (!defined ($dbh->do("SELECT * FROM config"))) {
    warn ($dbh->errstr); $dbh->disconnect; $dbh = undef;
    next;
  }
  
  my @dirs;
  $task = circle (\@tags);
  $dir = $opt{split} ? "$opt{dir}/$task" : $opt{dir};
  opendir (DH, $dir) or warn ("opendir $dir: $!");
  while (defined ($file = readdir (DH))) {
    open (FH, "< $dir/$file") or warn ("open $dir/$file: $!");
    push (@dirs, "$dir/$file") if (-d FH && $file !~ m/^\..*/);
    close (FH);
  }
  closedir (DH);

  if ($mark eq $task) {
    info ("sleeping for $opt{delay}s...") if $opt{verbose};
    $tm->wait ($opt{delay});
    $tm->wait_children;
    next;
  }
  next if (!@dirs || exists ($pids{$task})); 
  $mark = $task;

  $pids{$task} = $tm->start ($task) and next;
  quarantine (@dirs) unless ($G_sigterm);
  $tm->finish;
}
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 circle { my ($rl) = @_;
  my $head = $rl->[0];
  push (@$rl, shift (@$rl));
  return ($head);
}

sub quarantine { my (@lmb) = @_; 
  my $mbm = Mail::Box::Manager->new;
  
  openlog ($APPNAM, 'cons,pid', 'mail');
  info (join("\n" . prefix . ": ", @lmb)) unless ($opt{daemon});

  my $dbh = DBI->connect (@DBCONNECT, {AutoCommit => 0}) 
    or die ($DBI::errstr);

  foreach my $mb (@lmb) {  
    last if ($G_sigterm);
     
    my ($sth, $domain, $index, $folder); 
    $mb =~ s/\/$//;
    $domain = ($mb =~ m/\/([0-9A-Za-z_.-]+)$/g)[-1];
    $domain =~ s/(.mbox)$//;
    my $info = "[domain:$domain]";
    $sth = $dbh->prepare (qq(
      SELECT * FROM index WHERE name = ?))
        or die ("$info $dbh->errstr");
    if (!defined ($index = $dbh->selectrow_hashref ($sth, undef, $domain))) {
      warn ("$info no entry in quarantine db");
      next;
    }

    $sth = $dbh->prepare (qq (
      INSERT INTO mail_$index->{ref}
         (index, h_message_id, h_return_path, 
            h_envelope_to, h_from, h_to,
              h_subject, sender, recipient, 
                size, head, body, text, mime)
        VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
      )) or die ("$info $dbh->errstr");	                          
    
    unless ($folder =  $mbm->open (folder => $mb, access => 'rw', 
                         extract => 'ALWAYS')) {
      warn ("$info open $mb: $!");
    }
      
    info ("[domain:$index->{name}][table:mail_$index->{ref}]") 
      if ($opt{verbose});

    my @msgs;
    my $sent = 0;
    foreach my $msg ($folder->messages) {
      last if ($G_sigterm);

      my @msg_cols = qw(h_message_id h_return_path h_envelope_to h_from h_to 
                          h_subject sender recipient size body text mime);
      my %cols = parse ($msg, @msg_cols);

      if (!defined ($sth->execute ($index->{ref}, $cols{h_message_id}, 
                      $cols{h_return_path}, $cols{h_envelope_to},
                      $cols{h_from},        $cols{h_to}, 
                      $cols{h_subject},     $cols{sender},
                      $cols{recipient},     $cols{size},
                      $cols{head},          $cols{body},
                      $cols{text},          $cols{mime}))) {
        warn ("$info $sth->errstr");
	$dbh->rollback;
        last;
      }
      push (@msgs, $msg);

      if (($opt{batch} == scalar (@msgs)) 
          || (scalar (@msgs) + $sent == $folder->messages)) {
	$sent += scalar (@msgs);
	if ($dbh->commit == 1) {
          while (my $m = pop (@msgs)) {	
            $m->delete unless ($opt{preserve});
            my $id = $m->messageId;
	    info ("$info message-id: $id quarantined") if ($opt{verbose} > 1); 
  	    syslog 'info', "$info message-id: $id quarantined" if ($opt{daemon});
          }
          info ("$info\[mailbox:", $mb, "][records:", $sent, "/",
                  scalar ($folder->messages), "]") unless ($opt{daemon}); 
        } 
	else {
          warn ("$info $dbh->errstr");
	  $dbh->rollback;
	  last;
        }
      }
    }
  }
  $mbm->closeAllFolders; $dbh->disconnect;
  die ("interrupted") if ($G_sigterm);
  closelog; exit (0);
}

sub parse { my ($msg, %cols) = @_;
  my ($from, $to, $sender, $recipient, $text, $mime);

  foreach my $f ($msg->from) {
    $from = defined ($from) ? $from. ", " . $f->format : $f->format; 
  }
  $from = $msg->get ('return-path') unless (defined ($from));

  foreach my $t ($msg->to) {
    $to = defined ($to) ? $to . ", " . $t->format : $t->format;
    $recipient = $to unless (defined ($recipient));
  }
  $to = $msg->get ('envelope-to') unless (defined ($to));
        
  $sender = $msg->get ('sender');
  $sender = $msg->get ('return-path') unless (defined ($sender));
 
  $recipient = $msg->get ('envelope-to') unless (defined ($recipient));
  
  if ($msg->isMultipart) {
    foreach my $p ($msg->parts) {
      if (!defined ($text)) {
        $text = $p->body->string;
        next;
      }
      my $n = $p->body->disposition->attribute ('filename') 
              || $p->body->type->attribute ('name')
              || "<null>";	          
      my $m = "$n\t" . $p->size . "\t" . $p->decoded->type->body . "\n";
      $mime = defined ($mime) ? $mime . $m : $m;
      next if $p->body->mimeType->isBinary;
      $text = $text . $p->body->string;
    }
  }
  $text = $msg->body->string unless (defined ($text));

  $cols{h_message_id}  = $msg->messageId;
  $cols{h_return_path} = $msg->get ('return-path');
  $cols{h_envelope_to} = $msg->get ('envelope-to');
  $cols{h_from}        = $from;
  $cols{h_to}          = $to;
  $cols{h_subject}     = $msg->subject;
  $cols{size}          = $msg->size;  
  $cols{sender}        = $sender;
  $cols{recipient}     = $recipient;
  ($cols{head}         = $msg->head->string) =~ s/(\x00)//g;
  ($cols{body}         = $msg->body->string) =~ s/(\x00)//g;
  ($cols{text}         = $text) =~ s/(\x00)//g;
  $cols{mime}          = $mime;

  foreach my $c (sort keys %cols) {
    $c = defined ($c) ? $c : "";
    if ($opt{verbose} > 3) {
      info ("$c: ", $cols{$c} ? $cols{$c} : "");
    } 
    elsif ($opt{verbose} > 2) {
      info ("$c: ", $cols{$c} ? brief ($cols{$c}) : "");
    }
  }
  info ("-" x 40) if ($opt{verbose} > 2); 

 return (%cols);
}

sub usage { my ($rc) = @_;
  print <<USAGE;
$APPDSC 
Usage: $APPNAM [options] [mailboxes...]
dsvrTrustedMail quarantine daemon.
options:
        --tasks     =i  max parallel tasks            
        --batch     =i  max records per transaction 
        --delay     =i  delay between tasks  
        --dir       =s  quarantine directory 
    -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 transfer
    -s, --split      !  split quarantine directory
  
    -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

dtmqd - dsvrTrustedMail quarantine daemon

=head1 SYNOPSIS

dtmqd [--tasks][--batch][--delay][--dir][--log]
      [--user][--daemon][--preserve][--split]
      [--dbhost][--dbuser][--dbpass][--dbtrace]
      [--quiet][--verbose][--help] [mailboxes...]

=head1 DESCRIPTION

Quarantine mail messages to a dsvrTrustedMail quarantine database. 

Options:

=over 4

=item --tasks=INTEGER

maximum parallel tasks to be used for quarantining.

=item --batch=INTEGER

maximum records to be handled within a database transaction.

=item --delay=FLOAT  

delay in seconds between checks for messgaes to quarantine.

=item --dir=STRING

directory from which messages are to be quarantined.

=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 deletion of messages even after successful transfer
to quarantine database.

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

(or C<-s>) split the quarantine directory based on the first character of the sub-directories.

=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:
