#!/usr/bin/perl

# $Id: clean-mqueue.pl,v 1.8 2005/11/16 02:47:52 jik Exp $
# The current version of this script is available from
# http://www.mit.edu/~jik/clean-mqueue.pl.
# Send comment, corrections, fixes to jik@kamens.brookline.ma.us.
# This script is in the public domain - do whatever you want with it.

# This script scans the queue files in your sendmail queue directory,
# shows you a summary of each one, and asks you what to do about it.
# You can delete it ('d'), quarantine it ('q'), view the body ('b'),
# or move on to the next message (anything else).

# Configure the script by modifying $qdir below to point at your queue
# directory, if it isn't /var/spool/mqueue, and $hide_headers to be a
# regexp matching the headers you don't want to be displayed (mostly
# just to make the output of the script shorter and more manageable).

# Thanks to jon<at>enetworks.co.za for submitting changes to clean
# automatically based on domain, sender or TLD.  I modified Jon's
# changes extensively, so if there are any bugs in them, it's my
# fault, not his.

use strict;
use warnings;
use Term::Cap;
use File::Basename;
use Getopt::Long;

my $qdir = "/var/spool/mqueue";
my $hide_headers = '(?i:Received|Return-Path|Full-Name|X-Moderate-For|Organization|Received-SPF|X-Mailer|X-Bogosity|References|In-Reply-To|Precedence|X-Authentication-Warning|Content-Transfer-Encoding|DomainKey-Signature|MIME-Version|Content-Type|X-IronPort-AV|X-Accept-Language|User-Agent|X-Originating-IP|X-Originating-Email|X-Sender|X-Priority|X-MSMail-Priority|Seal-Send-Time|X-MimeOLE|X-OriginalArrivalTime|Errors-To|X-Maintainer|X-Mailing-List|X-Loop|Old-To|Importance|X-Rcpt-To):';

use vars qw($clean_recipient $clean_sender $clean_batch $terse $go);

my $whoami = basename $0;
my $usage = "Usage: $whoami [--queue-directory dir] [--dryrun] [--batch [--terse]]
\t[--go] [--recipient regexp] [--sender regexp]\n";
my(@qfiles) = glob "$qdir/qf*";
my $term = Tgetent Term::Cap;
my $bold = $term->Tputs('md') || '';
my $endmode = $term->Tputs('me') || '';
my $dryrun;

die $usage if (! GetOptions("queue-directory=s" => \$qdir,
                            "dryrun" => \$dryrun,
			    "terse" => \$terse,
			    "batch" => \$clean_batch,
			    "recipient=s" => \$clean_recipient,
			    "sender=s" => \$clean_sender,
			    "go" => \$go));
die "$whoami: $qdir does not exist\n" if (! -d $qdir);
die "$whoami: Can't read any messages in $qdir\n" if (! @qfiles);
die "$whoami: Must specify --recipient or --sender with --batch\n$usage"
    if ($clean_batch && ! ($clean_recipient || $clean_sender));
die "$whoami: --terse doesn't make sense without --batch\n$usage"
    if ($terse && ! $clean_batch);

print "\n";

if ($clean_batch) {
    print "Running in batch mode\n";
}

if ($clean_recipient) {
    print "Auto-deleting recipients matching \"$clean_recipient\"\n";
}

if ($clean_sender) {
    print "Auto-deleting senders matching \"$clean_sender\"\n";
}

print "Looking at queue in $qdir\n";

print "There are " . scalar(@qfiles) . " messages in your queue\n";

if (! $go && ($clean_recipient || $clean_sender)) {
    print "\n";
    print "You must type \"go\" here to proceed: ";
    my $answer = <STDIN>;
    if ($answer !~ /^go\s*$/i) {
	die "Wrong answer!  Aborting.\n";
    }
}

print "\n";

my %sender_actions;

foreach my $qfile (@qfiles) {
    my(%qfile, $answer);
    my $id = $qfile;
    $id =~ s,.*/..,,;

    (%qfile = &parse_qfile($qfile)) or die "$whoami: Error parsing $qfile\n";

    if (! $terse) {
	print $bold, "Id:      ", $endmode, $id, "\n";
	print $bold, "From:    ", $endmode, $qfile{'sender'}, "\n";
	print $bold, "To:      ", $endmode, $qfile{'recipient'}, "\n";
	print $bold, "Message: ", $endmode, $qfile{'message'}, "\n";

	print $bold, "Header:", $endmode, "\n";
	$_ = $qfile{'header'};
	s/^/  /mg;
	print $_;
    }

    my $auto_delete;

    if (! $auto_delete && $clean_sender) {
	my $sender = $qfile{'sender'};
	$sender =~ s/<(.*)>/$1/;
	if ($sender =~ /$clean_sender/o) {
	    print "Auto-deleting sender $sender\n";
	    $auto_delete = 1;
	}
    }

    if (! $auto_delete && $clean_recipient) {
	my $recipient = $qfile{'recipient'};
	$recipient =~ s/<(.*)>/$1/;
	if ($recipient =~ /$clean_recipient/o) {
	    print "Auto deleting recipient $recipient\n";
	    $auto_delete = 1;
	}
    }

  prompt:

    if ($auto_delete) {
	$answer = "d";
    }
    else {
	if (! $clean_batch) {
	    print($bold,
		  "Enter 'd' to delete, 'q' to quarantine, 'b' to see body.\n",
		  "Add 's' to 'd' or 'q' to act on all messages with this sender: ",
		  $endmode);
	}

	if ($sender_actions{$qfile{'sender'}}) {
	    $answer = $sender_actions{$qfile{'sender'}};
	    print "$answer\n";
	}
	elsif ($clean_batch) {
	    $answer = "\n";
	}
	else {
	    $answer = <STDIN>;
	    exit if (! $answer);
	}
    }
    if ($answer =~ /^(d)(s?)/) {
	$sender_actions{$qfile{'sender'}} = $1 if ($2);
        if (! $dryrun) {
            unlink(glob("$qdir/*$id")) || 
                die "$whoami: Removing $qdir/*$id: $!\n";
        }
    }
    elsif ($answer =~ /^(q)(s?)/) {
        $sender_actions{$qfile{'sender'}} = $1 if ($2);
        my(@cmd) = ("sendmail", "-qI$id", "-Q$whoami");
        if (! $dryrun) {
            system(@cmd) && die "$whoami: @cmd failed\n";
        }
    }
    elsif ($answer =~ /^b/) {
        print "\n";
        system("cat", "$qdir/df$id");
        print "\n";
        goto prompt;
    }

    if (! $terse) {
	print "\n";
    }
}

sub parse_qfile {
    my($qfile) = @_;
    my(%qfile, $qtext);
    local($_);
    open(QFILE, $qfile) or die "$whoami: $qfile: $!\n";
    {
        local($/) = undef;
        $qtext = <QFILE>;
        close(QFILE);
    }
    $qtext =~ s/^\.\n//m;
    my(@qlines) = split(/\n\b/, $qtext);
    $qfile{'header'} = '';
    foreach (@qlines) {
        if (s/^H\?[^\?]*\?//) {
            next if /^$hide_headers/o;
            $qfile{'header'} .= $_ . "\n";
        }
        elsif (s/^R[^:]+://) {
            $qfile{'recipient'} = $_;
        }
        elsif (s/^S//) {
            $qfile{'sender'} = $_;
        }
        elsif (s/^M//) {
            $qfile{'message'} = $_;
        }
    }
    %qfile;
}