sendmail mailqueue management

lsadd.pl

#!/usr/local/bin/perl

use strict;

my $mqueue_directory = "/var/spool/mqueue";
my %occurrences;

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}/ ) {
      open (QF_FILE, $_);
      while(<QF_FILE>) {
         # Lines beginning with R contain an envelope recipient
         if ( /^R.*:<(.*)>$/ ) {
            my $domain = lc($1);
            # Add 1 to the %occurrences hash
            $occurrences{$domain}++;
         }
      }
   }
}

# Subroutine to sort hash by ascending value
sub hashValueAscendingNum {
   $occurrences{$a} <=> $occurrences{$b};
}

# Print sorted results
foreach my $key (sort hashValueAscendingNum (keys(%occurrences))) {
   print "$occurrences{$key} $key\n";
}

lsdom.pl

#!/usr/local/bin/perl

use strict;

my $mqueue_directory = "/var/spool/mqueue";
my %occurrences;

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}/ ) {
      open (QF_FILE, $_);
      while(<QF_FILE>) {
         # Lines beginning with R contain an envelope recipient
         if ( /^R.*:<.*\@(.*)>$/ ) {
            my $domain = lc($1);
            # Add 1 to the %occurrences hash
            $occurrences{$domain}++;
         }
      }
   }
}

# Subroutine to sort hash by ascending value
sub hashValueAscendingNum {
   $occurrences{$a} <=> $occurrences{$b};
}

# Print sorted results
foreach my $key (sort hashValueAscendingNum (keys(%occurrences))) {
   print "$occurrences{$key} $key\n";
}

rmadd.pl

#!/usr/local/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";

rmdom.pl

#!/usr/local/bin/perl

use strict;

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

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

# my $qtool = "/usr/local/bin/qtool.pl";
my $qtool = "/usr/src/contrib/sendmail/contrib/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 a domain other than
         # $domain_to_remove, do not match the message
         if ( /^R.*:<.*\@(.*)>$/ ) {
            my $recipient_domain = lc($1);
            $envelope_recipients++;
            if ($recipient_domain ne $domain_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";