#!/usr/bin/perl
#
# qmHandle 0.5.1
#
# Copyright(c) 1998, 2001 Michele Beltrame <mick@io.com>
#
# You can freely use, modify and redistribute for free this program, as long
# as this notice remains intact. If you plan to resell this program, you have
# to contact me before doing that.

# Set this to your qmail queue directory (be sure to include the final slash!)
$queue = "/var/qmail/queue/";

$qmcmd = '/etc/rc.d/init.d/qmail start';
# Replace the above with this if you have qmail < 1.03:
## $qmcmd = '/var/qmail/bin/qmail-start ./Mailbox splogger qmail &';
# If you installed qmail from a .deb or similiar package you should use
# something like this instead:
## $qmcmd = '/etc/init.d/qmail start';

# Print help
sub Usage {
    print "qmHandle v0.5.1\n";
    print "by Michele Beltrame\n\n";
    print "Wrong parameters entered, [$arg] available ones are:\n";
    print "  -l   : list message queues\n";
    print "  -L   : list local message queue\n";
    print "  -R   : list remote message queue\n";
    print "  -s   : show some statistics\n";
    print "  -vN  : display message number N\n";
    print "  -dN  : delete message number N\n";
    print "  -D   : delete all messages in the queue (local & remote)\n";
    print "Additional (optional) parameters are:\n";
    print "  -c   : display colored output\n";
    print "  -N   : list message numbers only\n";
    print "         (to be used either with -l, -L or -R)\n\n";
    print "You can view/delete multiple message eg -d123 -v456 -d567\n\n";
    exit (1);
}

if ($#ARGV == -1) { Usage(); }; # No arguments

# Make list of messages in remote queue (thanks Franky Van Liedekerke)
opendir(DIR,"${queue}remote");
@dirlist = grep !/\./, readdir DIR;
closedir DIR;
foreach $dir (@dirlist) {
    opendir (SUBDIR,"${queue}remote/$dir");
    @files = grep !/\./, map "$dir/$_", readdir SUBDIR;
    foreach $file (@files) {
	push @msglist, "$file";
	$type{"$file"} = 'R';
    }
    closedir SUBDIR;
}

# Make list of messages in local queue (thanks Franky Van Liedekerke)
opendir(DIR,"${queue}local");
@dirlist = grep !/\./, readdir DIR;
closedir DIR;
foreach $dir (@dirlist) {
    opendir (SUBDIR,"${queue}local/$dir");
    @files = grep !/\./, map "$dir/$_", readdir SUBDIR;
    foreach $file (@files) {
	push @msglist, "$file";
	$type{"$file"} = 'L';
    }
    closedir SUBDIR;
}

# Get options & perform action
$color = 0;
$summary = 0;
foreach $arg(@ARGV) {
  SWITCH: {
      $arg eq '-l' && do { push @actions, "&ListMsg('A')"; last SWITCH; };
      $arg eq '-R' && do { push @actions, "&ListMsg('L')"; last SWITCH; };
      $arg eq '-L' && do { push @actions, "&ListMsg('R')"; last SWITCH; };
      $arg eq '-N' && do { $summary = 1; last SWITCH; };
      $arg eq '-c' && do { $color = 1; last SWITCH; };
      $arg eq '-s' && do { push @actions, "&Stats()"; last SWITCH; };
      $arg =~ /^-v(.+)/ && do { push @actions, "&ViewMsg($1)"; last SWITCH; };
      $arg =~ /^-d(.+)/ && do { push @actions, "&DelMsg($1)"; last SWITCH; };
      $arg eq '-D' && do { push @actions, "&DelAll()"; last SWITCH; };
      &Usage();
  }
}

foreach $action(@actions) {
    eval "$action";
}

exit(0);

# Display message list
# pass parameter of queue NOT to list! i.e. if you want remote only, pass L
# if you want local, pass R  if you want all pass anything else eg A
sub ListMsg {
    $q = shift;
    
    if ($summary == 0) {
	foreach $msg(@msglist) {
	    # Read return path
	    open (MSG, "${queue}info/$msg");
	    $ret{$msg} = <MSG>;
	    substr($ret{$msg}, 0, 1) = '';
	    chop ($ret{$msg});
	    close (MSG);
	    
	    # Get message (file) size
	    $fsize{$msg} = (stat("${queue}mess/$msg"))[7];
	    
	    # Read something from message header (sender, receiver, subject, date)
	    open (MSG, "${queue}mess/$msg");
	    while (<MSG>) {
		if ($_ =~ /^Date: /) {
		    $date{$msg} = $';
		    chop ($date{$msg});
		} elsif ( $_ =~ /^From: /) {
		    $from{$msg} = $';
		    chop ($from{$msg});
		} elsif ( $_ =~ /^Subject: /) {
		    $subj{$msg} = $';
		    chop ($subj{$msg});
		} elsif ( $_ =~ /^To: /) {
		    $to{$msg} = $';
		    chop ($to{$msg});
		} elsif ( $_ =~ /^Cc: /) {
		    $cc{$msg} = $';
		    chop ($cc{$msg});
		} elsif ( $_ eq "\n") {
		    last;
		}
	    }
	}
    }
    
    if ($color == 1) {
	foreach $msg(@msglist) {
	    unless ($q eq $type{$msg})  {
		($dir, $rmsg) = split (/\//, $msg);
		print chr(27)."[01;34m$rmsg ($dir, $type{$msg})\n";
		if ($summary == 0) {
		    $ret{$msg} ne ''   and print "  \e[01;31mReturn-path\e[00m: $ret{$msg}\n";
		    $from{$msg} ne ''  and print "  \e[01;31mFrom\e[00m: $from{$msg}\n";
		    $to{$msg} ne ''    and print "  \e[01;31mTo\e[00m: $to{$msg}\n";
		    $cc{$msg} ne ''    and print "  \e[01;31mCc\e[00m: $cc{$msg}\n";
		    $subj{$msg} ne ''  and print "  \e[01;31mSubject\e[00m: $subj{$msg}\n";
		    $date{$msg} ne ''  and print "  \e[01;31mDate\e[00m: $date{$msg}\n";
		    $fsize{$msg} ne '' and print "  \e[01;31mSize\e[00m: $fsize{$msg} bytes\n\n";
		}
	    }
	}
    } else {
	foreach $msg(@msglist) {
	    unless ($q eq $type{$msg})  {
		($dir, $rmsg) = split (/\//, $msg);
		print "$rmsg ($dir, $type{$msg})\n";
		if ($summary == 0) {
		    $ret{$msg} ne ''   and print "  Return-path: $ret{$msg}\n";
		    $from{$msg} ne ''  and print "  From: $from{$msg}\n";
		    $to{$msg} ne ''    and print "  To: $to{$msg}\n";
		    $cc{$msg} ne ''    and print "  Cc: $cc{$msg}\n";
		    $subj{$msg} ne ''  and print "  Subject: $subj{$msg}\n";
		    $date{$msg} ne ''  and print "  Date: $date{$msg}\n";
		    $fsize{$msg} ne '' and print "  Size: $fsize{$msg} bytes\n\n";
		}
	    }
	}
    }
    &Stats();
}

# View a message in the queue
sub ViewMsg {
    $rmsg = shift;
    
    unless ($rmsg =~ /^\d+$/) {
	
	print "$rmsg is not a valid message number!\n";
	
    } else {

	# Search message
	$ok = 0;
	foreach $msg(@msglist) {
	    if ($msg =~ /$rmsg$/) {
		$ok = 1;
		print "\n --------------\nMESSAGE NUMBER $rmsg \n --------------\n"; 
		open (MSG, "${queue}mess/$msg");
		while (<MSG>) {
		    print $_;
		}
		close (MSG);
		last;
	    }
	}
	
	# If the message isn't found, print a notice
	if ($ok == 0) {
	    print "Message $rmsg not found in the queue!\n";
	    
	}
    }
    
}

# Delete a message in the queue
sub DelMsg {
    $rmsg = shift;
    
    unless ($rmsg =~ /^\d+$/) {
	
	print "$rmsg is not a valid message number!\n";
	
    } else {
	
	system('/etc/rc.d/init.d/qmail stop');
	
	# Search message
	$ok = 0;
	foreach $msg(@msglist) {
	    if ($msg =~ /$rmsg$/) {
		$ok = 1;
		unlink "${queue}mess/$msg";
		unlink "${queue}info/$msg";
		if ($type{$msg} eq 'R') {
		    unlink "${queue}remote/$msg";
		} else {
		    unlink "${queue}local/$msg";
		}
		last;
	    }
	}
	
	# If the message isn't found, print a notice
	if ($ok == 0) {
	    print "Message $rmsg not found in the queue!\n";
	}
	system($qmcmd);
    }
}

# Delete all messages in the queue (thanks Kasper Holtze)
sub DelAll {
    $rmsg = shift;

    $qmpid = `$pidcmd`;
    chop ($qmpid);
    if ($qmpid != 0) {
	print "Terminating qmail (pid $qmpid)... this might take a while if qmail is working.\n";
	kill 'TERM', $qmpid;
	while (`$pidcmd` eq "$qmpid\n") { sleep 1; }
    } else {
	print "Qmail isn't running... good.\n";
    }

    # Search messages
    $ok = 0;
    foreach $msg (@msglist) {
	$ok = 1;
	print "Deleting message $msg...\n";
	unlink "${queue}mess/$msg";
	unlink "${queue}info/$msg";
	if ($type{$msg} eq 'R') {
	    unlink "${queue}remote/$msg";
	} else {
	    unlink "${queue}local/$msg";
	}
	$i++;
    }

    # If no messages are found, print a notice
    if ($ok == 0) {
	print "No messages found in the queue!\n";
    }
    if ($qmpid != 0) {
	print "Restarting qmail... ";
	system($qmcmd);
	print "done (hopefully).\n";
    }
}

# Make statistics
sub Stats {
    $l=0; $r=0;
    foreach $msg(@msglist) {
	if ($type{$msg} eq 'R') { $r++; }
	else { $l++; }
    }
    if ($color == 1) {
	print chr(27)."[01;31mMessages in local queue".chr(27)."[00m: $l\n";
	print chr(27)."[01;31mMessages in remote queue".chr(27)."[00m: $r\n";
    } else {
	print "Messages in local queue: $l\n";
	print "Messages in remote queue: $r\n";
  }
    
}

