Navigation
Daily
Comix
quarantine.cgi is a perl script that permits authenticated users to selectivly delete, or force messages to be delivered out of sendmail's QUARANTINE queue. This script needs to be run setuid root to delete and to deliver mail from the quarantine queue.

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 -wT

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

use strict;
use warnings;
use CGI;
$|++;

my $q = new CGI;

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;
}
print $q->header( -type => 'text/html' );

$< = $>;
if ( $q->param("op") ) {
  if ( $q->param("op") eq "delete" ) {
    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" ) {
    my ($qid) = ( $q->param("qid") =~ m/(\w{14})/ );

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

opendir( QUEUE, "/var/spool/mqueue" ) or die "Couldn't opendir /var/spool/mqueue ($!)";

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

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;

  open( SENDMAIL, "-|", "sendmail -bv $info->{recipient}" );
  while (<SENDMAIL>) {
    next QID unless ($_ =~ m/\Qlocal, user $ENV{REMOTE_USER}\E/);
  }

  print "<tr><td><a href='$ENV{REQUEST_URI}/$qid'>$qid</a><br>\n";
  print "<form method=post><input type=hidden name=qid value=$qid>\n";
  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><td colspan=4>$info->{quarantine}</td></tr>\n";
  print "<tr><td colspan=4 align=right>$info->{recipient}</td></tr>\n";
}
print "</table>\n";