NOTE: I havn't spent quite enough time making absolutely sure it's foolproof (users can delete or deliver other user's mail if they know the queue id), but it's close enough for me.
Questions? Comments? Shoot me an email at richard ((__NOSPAM__)) richardharman.com.
Here's the syntax highlighted version of quarantine.cgi. Click here to download the sourcecode.
#!/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
