#!/usr/bin/perl -T

BEGIN { use CGI::Carp qw(fatalsToBrowser carpout); }
$ENV{PATH} = "/usr/sbin";

use strict;
#use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser carpout);
use AnyDBM_File;
use Fcntl;
use List::Util qw(first);


my %queue_to_user;
my $tie_status = tie(%queue_to_user, 'AnyDBM_File', "/var/www/data/queue.db", O_CREAT | O_RDWR,0666) or die "Couldn't tie! ($!)";

$|++;

my $q = new CGI;

# print out to browser mode (somewhat useful)
if ( $ENV{PATH_INFO} ) {
  my ($qid) = ( $ENV{PATH_INFO} =~ m,/(\w{14}), );
  open( QF, "<", "/var/spool/mqueue/hf$qid" ) or die "Couldn't open /var/spool/mqueue/hf$qid for reading ($!)\n";
  open( DF, "<", "/var/spool/mqueue/df$qid" ) or die "Couldn't open /var/spool/mqueue/df$qid for reading ($!)\n";
  print $q->header( -type => 'text/plain' );
  $/ = undef;
  print <QF>, <DF>;
  exit 0;
}

# all else, we're in html mode
print $q->header( -type => 'text/html' );

# checks to see if we're in admin mode or not
my $admin = 0;
if ($ENV{REMOTE_USER} eq "warewolf" ) { # && defined($q->param("noadmin")) && $q->param("noadmin") eq "1") {
  $admin++;
}

print STDERR "admin mode = $admin\n";
# set real to effective uid
$< = $>;

my $clearing = 0;

if ( $q->param("op") ) {

  if ( $q->param("op") eq "clear") { # {{{
    # clean slate mode, delete all messages owned by $ENV{REMOTE_USER}
    $clearing = 1;
  } # }}}
  elsif ( $q->param("op") eq "delete" ) { # {{{
    # we're deleting messsages now
    my ($qid) = ( $q->param("qid") =~ m/(\w{14})/ );
    unlink("/var/spool/mqueue/hf$qid") or die "Couldn't delete /var/spool/mqueue/hf$qid ($!)";
    unlink("/var/spool/mqueue/df$qid") or die "Couldn't delete /var/spool/mqueue/df$qid ($!)";
    print "Deleted $qid<br>\n";
  }  # }}}
  elsif ( $q->param("op") eq "run" ) { # {{{
    # we're telling sendmail to run a particular message in the quarantine queue so it gets delivered to somebody's mailbox
    my ($qid) = ( $q->param("qid") =~ m/(\w{14})/ );

    open( SENDMAIL, "-|", "sendmail -v -qQ -qf -qI$qid" );
    print "<pre>\n";
    # XXX 
    # XXX NO sanitation of sendmail's output
    # XXX 
    while (<SENDMAIL>) {
      my ($out) = ( $_ =~ m/(.+)/ );
      print $out;
    } 
    print "</pre>";
  } # }}}
}

# carry on as usual

# start finding quarantined messages
opendir( QUEUE, "/var/spool/mqueue" ) or die "Couldn't opendir /var/spool/mqueue ($!)";

# hf = quarantined messages
my @queue_ids = grep { m/hf(\w{14})$/; $_ = $1 } readdir QUEUE;

# this is a quick lookup table
# that maps email addresses to local unix account names
my %email_to_localuser;
print "Click <a href='/ssl-bin/quarantine.cgi'>here</a> to refresh this page.<br>\n";
print "<form method=post>Press <input type=submit name='op' value='clear'> to clear all mail from the queue.</form>\n";
print "<table border=1><th>Q ID</th><th>Size</th><th>Q Time</th><th>Sender/Recipient</th></tr>\n";
QID: foreach my $qid (@queue_ids) {
  open( QF, "<", "/var/spool/mqueue/hf$qid" ) or die "Couldn't open /var/spool/mqueue/hf$qid for reading! ($!)";
  my $info;
  while (<QF>) {
    $_ =~ m/^q"?(.+)"?$/     && do { $info->{quarantine} = $1; next };
    $_ =~ m/^T(\d+)$/        && do { $info->{epoch}      = $1; next };
    $_ =~ m/^S<(.+)\>$/      && do { $info->{sender}     = $1; next };
    $_ =~ m/^rRFC822; (.+)$/ && do { $info->{recipient}  = $1; last };
  }
  $info->{size}  = ( stat QF )[7];
  $info->{epoch} = scalar localtime( $info->{epoch} );
  close QF;

  # don't skip messages 
  # ..... when our email -> local user (unix name) cache gets a hit
  # ..... when we're an admin
  # ..... when our Queue ID -> local user (unix name) cache gets a hit
  if ( defined( $email_to_localuser{ $info->{recipient} } ) or defined( $queue_to_user{$qid} ) ) {
    print STDERR "email to localuser for $info->{recipient} is $email_to_localuser{$info->{recipient}}\n";
    next QID unless (
                      $ENV{REMOTE_USER} eq $email_to_localuser{ $info->{recipient} }
		      or $admin
		      or $queue_to_user{$qid} eq $ENV{REMOTE_USER}
                    );
  }

  # figure out if a message is to be delivered locally or not
  # XXX actually this wasn't implimented XXX
  my $local = 0;
  do { # if either cache $email_to_localuser or $queue_to_user is empty, figure out who it goes to
    #open( SENDMAIL, "-|", "sendmail -bv $info->{recipient}" ); # noisy
    open( SENDMAIL, "-|", "sendmail -OLogLevel=0 -bv $info->{recipient}" ); # quiet

#  REMOTE
#  # warewolf@xabean.com:/var/www/ssl-bin$ sudo sendmail -OLogLevel=0 -bv s2288@mail2000.com.tw
#  s2288@mail2000.com.tw... deliverable: mailer esmtp, host mail2000.com.tw., user s2288@mail2000.com.tw
#
#  LOCAL
#  # warewolf@xabean.com:/var/www/ssl-bin$ sudo sendmail -OLogLevel=0 -bv wa4usb@wa4usb.us
#  wa4usb@wa4usb.us... deliverable: mailer local, user dharman

    while (<SENDMAIL>) {
      # XXX local or not delivery detection XXX
      if ($_ !~ m/\Qmailer esmtp, host\E/) { $local++ };

      my ($found) = ($_ =~ m/\Qlocal, user $ENV{REMOTE_USER}\E/);
      #  skip unless it's for the logged in remote user, or we're god
      next QID unless ( $found or $admin );
      # stick it in our cache (unless we're an admin, otherwise it'd be a false cache)
      $email_to_localuser{ $info->{recipient} } = $ENV{REMOTE_USER} unless ($admin);
      if ($found) {
        # stick it in our cache (unless we're an admin, otherwise it'd be a false cache)
        $queue_to_user{$qid} = $ENV{REMOTE_USER} unless ($admin); 
   
      }
      if (! $local) {
        # non local mail, lets nuke it from the queue
        # map { unlink("/var/spool/mqueue/$_$qid") } qw(qf df hf) ;
      }
    } # end while (<SENDMAIL>) {
  } unless ( defined( $email_to_localuser{ $info->{recipient} } ) or defined( $queue_to_user{$qid} ) );
  my $style;
  if (! defined($queue_to_user{$qid})) {
    $style = $admin  ? ' style="background-color: #ccc;"' : "";
  } else {
    $style = ( $admin && $ENV{REMOTE_USER} ne $queue_to_user{$qid}) ? ' style="background-color: #ccc;"' : "";
  }
  if ($clearing) {
    unlink("/var/spool/mqueue/hf$qid") or die "Couldn't delete /var/spool/mqueue/hf$qid ($!)";
    unlink("/var/spool/mqueue/df$qid") or die "Couldn't delete /var/spool/mqueue/df$qid ($!)";
    print "<tr$style><td><b>DELETED</b><br></td>\n";
    print "<td>$info->{size}</td><td>$info->{epoch}</td><td>$info->{sender}</td></tr>\n";
    print "<tr$style><td colspan=4>$info->{quarantine}</td></tr>\n";
    print "<tr$style><td colspan=4 align=right>$info->{recipient}</td></tr>\n";
  } else {
    print "<tr$style><td><a href='$ENV{REQUEST_URI}/$qid'>$qid</a><br>\n";
    print "<form method=post><input type=hidden name=qid value=$qid>\n";
    if ($q->param("noadmin")) {
      print "<input type=hidden name=noadmin value=".$q->param("noadmin").">\n";
    }
    $info->{sender} = $info->{sender} || "";
    print "<input type=submit name=op value=run> | <input type=submit name=op value=delete></form>\n";
    print "</td><td>$info->{size}</td><td>$info->{epoch}</td><td>$info->{sender}</td></tr>\n";
    print "<tr$style><td colspan=4>$info->{quarantine}</td></tr>\n";
    print "<tr$style><td colspan=4 align=right>$info->{recipient}</td></tr>\n";
  }
}
print "</table>\n";

# size maintenance of cache
foreach my $id ( keys %queue_to_user ) {
  delete $queue_to_user{$id} unless first { defined( $queue_to_user{$_} ) } @queue_ids;
}
undef $tie_status;
untie %queue_to_user;

# vim: ft=perl foldmethod=marker commentstring=#\ %s bg=dark