MailRemoveAddress

From My Admin Page
Jump to: navigation, search

The following Perl script will remove all mail in the mail queue addressed to email_address. Messages with multiple envelope recipients will not be deleted.

#!/usr/bin/perl

use strict;

# Exit immediately if email_address was not specified as command-line argument
if (!(defined($ARGV[0]))) {
   (my $basename = $0) =~ s!^.*/!!;
   print "Usage: $basename email_address\n";
   exit 1;
}

# Convert email address supplied as command-line argument to lowercase
my $address_to_remove = lc($ARGV[0]);

my $qtool = "/usr/local/bin/qtool.pl";
my $mqueue_directory = "/var/spool/mqueue";
my $messages_removed = 0;

use File::Find;
# Recursively find all files and directories in $mqueue_directory
find(\&wanted, $mqueue_directory);

sub wanted {
   # Is this a qf* file?
   if ( /^qf\w{14}/ ) {
      my $QF_FILE = $_;
      my $envelope_recipients = 0;
      my $match = 1;
      open (QF_FILE, $_);
      while(<QF_FILE>) {
         # If any of the envelope recipients contain an email address other than
         # $address_to_remove, do not match the message
         if ( /^R.*:<(.*)>$/ ) {
            my $recipient_address = lc($1);
            $envelope_recipients++;
            if ($recipient_address ne $address_to_remove) {
               $match = 0;
               last;
            } 
         }
      }
      close (QF_FILE);
      # $QF_FILE may not contain an envelope recipient at the time it is opened
      # and read. Do not match $QF_FILE in that case.
      if ($match == 1 && $envelope_recipients != 0) {
         print "Removing $QF_FILE...\n";
         system "$qtool", "-d", $QF_FILE;
         $messages_removed++;
      } 
   }
}

print "$messages_removed total message(s) removed from mail queue.\n";