Un script en Perl para borrar basura de la cola de Postfix

Una cosa típica que nos pasa a todos los que gestionamos servidores de correo, es que de vez en cuando la cola se llena de basura, en mi caso tengo un servidor que maneja cientos de miles de mensajes diarios y una cola atascada, por ejemplo por una avalancha de spam, se hace difícil de manejar.

La forma típica de borrar mensajes de la cola es usar directamente postsuper y mailq, por ejemplo, para borrar un mensaje por su ID:

postsuper -d "IDMENSAJE"

O usando un patrón, por ejemplo, para borrar todo mensaje en la cola con la cadena spamcity:

mailq |grep spamcity |awk '{print $1}' |postsuper -d -

Pero hace tiempo, buscando en algunos foros, encontré un pequeño script en Perl que facilita la gestión de borrar la basura de la cola pasando parámetros a postsuper.

No se quién lo ha escrito, pero he visto que está publicado en muchos sitios, así que aquí lo dejo, simplemente crea un archivo nuevo en una carpeta dentro del path con el siguiente contenido, por ejemplo en «/usb/bin/borrar-cola», y podrás borrar emails atascados en la cola mediante patrones, por ejemplo, «borrar-cola @gmail», borraría todos los emails para o de un email de gmail.

Este es el script:

#!/usr/bin/perl

$REGEXP = shift || die "no email-adress given (regexp-style, e.g. bl.*\@yahoo.com)!";
@data = qx;
for (@data) {
  if (/^(\w+)(\*|\!)?\s/) {
     $queue_id = $1;
  }
  if($queue_id) {
    if (/$REGEXP/i) {
      $Q{$queue_id} = 1;
      $queue_id = "";
    }
  }
}
open(POSTSUPER,"|postsuper -d -") || die "couldn't open postsuper" ;
foreach (keys %Q) {
  print POSTSUPER "$_\n";
};
close(POSTSUPER);