#!/usr/bin/perl -w
use strict;

=head1 NAME

	qqtool.pl - A tool for viewing and purging messages from a qmail queue

=head1 SYNOPSIS

	Qmail Queue Tool (qqtool.pl) 

	Written for the toaster users on mail-toaster@simerson.net
	Run the program without any parameters to view the options and syntax.

	ChangeLog - http://matt.simerson.net/computing/mail/qqtool/Changes

=cut

##
# User Preferences
##
# -----------------------------------------------------------------------------  

my $qdir     = "/var/qmail/queue";
my $qcontrol = "/service/send";

#######################################################################
#      System Settings! Don't muck with anything below this line      #
#######################################################################

my $author = "Matt Simerson";
my $email  = "matt\@cadillac.net";
my $version = "1.0.2";

use Getopt::Std;
use vars qw/ $opt_a $opt_h $opt_i $opt_q $opt_s $opt_v $remotes $locals/;
getopts('a:h:iqs:v');
use MATT::Qmail;
use MATT::Utility;

print "           Qmail Queue Tool   v $version\n\n";

# Make sure the qmail queue directory is set correctly
CheckQmailQueue($qdir);

if (! $opt_a ) 
{
	PrintUsage();
	die "\n";
}
else 
{
	if ( $opt_q ) 
	{
		# if a queue is specified, only check it.
		if    ($opt_q eq "remote") { $remotes = GetMessages("remote"); } 
		elsif ($opt_q eq "local" ) { $locals  = GetMessages("local");  };
	}
	else
	{
		# otherwise, check both queues
		$remotes = GetMessages("remote");
		$locals  = GetMessages("local");
		print "\n";
	};
};

if    ($opt_a eq "list"  ) { ListMessages  ($remotes, $locals); }
elsif ($opt_a eq "delete") { DeleteMessages($remotes, $locals); }
elsif ($opt_a eq "expire") { ExpireMessages($remotes, $locals); };

exit 1;

# -----------------------------------------------------------------------------
#       Subroutines. No user servicable parts below this line!                #
# -----------------------------------------------------------------------------

sub PrintUsage
{
	print "	
	-a  action (delete, expire, list)
	-h  header to match (From, To, Subject, Date)
	-q  queue to search (local/remote) 
	-s  search  (pattern to search for)
	-v  verbose
	
	If no -h is specified, then the pattern is searched for in any header.
	If no -q is specified, then both queues are searched.

	To list messages in queue from matt: 
	$0 -a list -s matt -h From

	To list messages in queue with string \"foo\" in the headers:
	$0 -a list -s foo	
";
# 	-i  interactive
};

sub DeleteMessage
{
	my ($tree, $id) = @_;

	print "Deleting message $id...";

	# for each message id, check each of the queues and remove it.
	if ( -f "$qdir/local/$tree/$id" ) {
		print "\t deleting file $qdir/local/$tree/$id\n" if ($opt_v);
		unlink "$qdir/local/$tree/$id" or die "couldn't delete: $!";
	};

	if ( -f "$qdir/remote/$tree/$id" ) {
		print "\t deleting file $qdir/remote/$tree/$id\n" if ($opt_v);
		unlink "$qdir/remote/$tree/$id" or die "couldn't delete: $!";
	};

	if ( -f "$qdir/info/$tree/$id" ) {
		print "\t deleting file $qdir/info/$tree/$id\n" if ($opt_v);
		unlink "$qdir/info/$tree/$id" or die "couldn't delete: $!";
	};

	if ( -f "$qdir/mess/$tree/$id" ) {
		print "\t deleting file $qdir/mess/$tree/$id\n" if ($opt_v);
		unlink "$qdir/mess/$tree/$id" or die "couldn't delete: $!";
	};
	
	if ( -f "$qdir/bounce/$id" ) {
		print "\t deleting file $qdir/bounce/$id\n" if ($opt_v);
		unlink "$qdir/bounce/$id" or die "couldn't delete: $!";
	};

	print "done.\n";
};

sub DeleteMessages
{
	CheckQmailControl($qcontrol);
	
	my $r = StopQmail();
	if ($r) {
		die "qmail-send wouldn't die!\n";
	};
	
	# we'll get passed an array of the local, remote, or both queues
	foreach my $q (@_)
	{
		foreach my $hash (@$q)
		{
			my $header = GetHeaders($hash->{'tree'}, $hash->{'num'});
			
			if ( ! $opt_s ) {
				DeleteMessage($hash->{'tree'}, $hash->{'num'});
				next;
			};
			
			if ( $opt_h ) {
				if ($header->{$opt_h} =~ /$opt_s/) 
				{
					DeleteMessage($hash->{'tree'}, $hash->{'num'});
				};
			} else {
				foreach my $key (keys %$header)
				{
					if ( $header->{$key} =~ /$opt_s/ ) 
					{
						DeleteMessage($hash->{'tree'}, $hash->{'num'});
					};
				};
			};
		};
	};
	
	StartQmail();
};

sub ExpireMessage
{
	my ($file) = @_;

	# set $ago to 8 days old.
	my $ago = time - 8 * 24  * 60 * 60;

	# alter the timestamp of the file to 8 days ago.
	utime $ago, $ago, $file;
	print "Expired $file\n";
};

sub ExpireMessages
{
	foreach my $q (@_)
	{
		foreach my $hash (@$q)
		{
			my $header = GetHeaders($hash->{'tree'}, $hash->{'num'});
			my $id = "$hash->{'tree'}/$hash->{'num'}";
			
			if ( ! $opt_s ) 
			{
				ExpireMessage("$qdir/info/$id");
				next;
			};
			
			if ( $opt_h ) 
			{
				if ($header->{$opt_h} =~ /$opt_s/) 
				{
					ExpireMessage("$qdir/info/$id");
				};
			}
			else
			{
				foreach my $key (keys %$header)
				{
					if ( $header->{$key} =~ /$opt_s/ ) 
					{
						ExpireMessage("$qdir/info/$id");
					};
				};
			};
		};
	};
	
	ProcessQmailQueue();	

	print "NOTICE: Expiring the messages does not remote them from the queue. 
	It merely alters their expiration time. The messages will be removed from
	the queue after qmail attempts to deliver them one more time. 
	
	I've already told qmail to start that process so be patient while qmail 
	is processing the queue. This might be a good time to check the value of 
	/var/qmail/control/concurrencyremote and verify it's value is reasonable
	for your site.\n\n";	
}

sub ListMessages
{
	foreach my $q (@_)
	{
		foreach my $hash (@$q)
		{			
			my $header = GetHeaders($hash->{'tree'}, $hash->{'num'});
			my $id = "$hash->{'tree'}/$hash->{'num'}";
			
			if ( !$opt_s) {
				PrintMessage($id, $header);
				next;
			};
			
			if ( $opt_h ) {
				if ($header->{$opt_h} =~ /$opt_s/) 
				{
					PrintMessage($id, $header);
				};
			} else {
				foreach my $key (keys %$header)
				{
					if ( $header->{$key} =~ /$opt_s/ ) 
					{
						PrintMessage($id, $header);
						exit;
					};
				};
			};
		};
	};
};

sub PrintMessage
{
	my ($id, $header) = @_;

	print "message # $id ";
	print "to $header->{'To'}\n";
	print "From:     $header->{'From'}\n";
	print "Subject:  $header->{'Subject'}\n";

	if ($opt_v) 
	{
		if ($header->{'CC'}) {
			print "CC:        $header->{'CC'}\n";
		};
		print "Date:      $header->{'Date'}\n";
		my @lines = ReadFile("$qdir/info/$id");
		chop $lines[0];
		print "Return Path: $lines[0]\n";
	};
	
	print "\n";
};

sub GetHeaders
{
	my ($tree, $id) = @_;
	my %hash;
	
	my $mess = "$qdir/mess/$tree/$id";
	my @lines = ReadFile($mess);
	foreach my $line (@lines)
	{
		if ( $line =~ /^([a-zA-Z\-]*):\s(.*)$/ ) {
#			print "header: $line\n" if $opt_v;
			$hash{$1} = $2;
		} else {
#			print "body: $line\n" if $opt_v;
		};
	};
	return \%hash;
};

sub GetMessages
{
	my ($qsubdir) = @_;
	my $queue = "$qdir/$qsubdir";
	my @messages;
	my ($up1dir, $id, $tree, $queu);
	
	my @dirlist = GetDirList($queue);
	
	foreach my $dir (@dirlist) 
	{
		my @files = GetDirList($dir);
		foreach my $file (@files)
		{
			($up1dir, $id)   = StripLastDirFromPath($file);
			($up1dir, $tree) = StripLastDirFromPath($up1dir);
			($up1dir, $queu) = StripLastDirFromPath($up1dir);

#			print "GetMessages: id: $id\n" if ($opt_v);

			my %hash = (
				num   => $id,
				file  => $file,
				tree  => $tree,
			   queu  => $queu
			);
			push @messages, \%hash;

#			print "GetMessages: file   : $file\n" if ($opt_v);
		};
	};
	my $count = @messages;
	print "$qsubdir has $count messages\n";
	
	return \@messages;
};


##
# Misc Utility Subs
##
# -----------------------------------------------------------------------------

sub GetDirList($)
{
	my ($dir) = @_;
	my @files;

	opendir(D, $dir) or die "GetDirFiles: couldn't open $dir: $!"; 
	while( defined ( my $f = readdir(D) ) ) 
	{
		next if $f =~ /^\.\.?$/;
		push @files, "$dir/$f";
	};
	closedir(D);
	return @files;
};


=head1 DESCRIPTION

	Idea based on mailRemove.py by Dru Nelson <dru@redwoodsoft.com>
	ideas borrowed from qmHandle by Michele Beltrame <mick@io.com>

	Funding for the writing was financed by contributions from:

	erik erik@microcontroller.nl (spearheaded community participation)
	Rick Romero  rick@valeoinc.com
	Chris Eaton  Chris.Eaton@med.ge.com
	Marius Kirschner marius@agoron.com
	J. Vicente Carrasco carvay@teleline.es
	Chris Odell  chris@redstarnetworks.net (paid $5 extra)
	Pat Hayes pat@pathayes.net
	Dixon Cole dixon@levee.net
	Randy Meyer rjmeyer@humbleguys.net 0
	kristian kristian@waveit.com
	Michael Andreasen michael@subwire.dk (beer in Denmark)
	Nathan Nieblas nnieblas@microtosh.net (paid $5 extra)
	Randy Jordan ctech@pcwarp.com

=head1 AUTHOR

	Matt Simerson <matt@cadillac.net>

=head1 BUGS

	None known. Report any to author.

=head1 TODO

	In list mode, when showing messages in the queue, show which addresses
	   delivery has failed for, so you know exactly why a message is still in
	   the queue (useful for mailing lists with many recipients)

	More documentation

	Write the messages into a "inactive" queue before deleting them.

	Ability to restore messages from "inactive" to the real queue.

=head1 SEE ALSO

	http://matt.simerson.net/computing/mail/qqtool/

=head1 COPYRIGHT

	Copyright 2003, Matt Simerson. All Right Reserved.

=cut
