Script de Correção no Q-MAIL

Este Script corrige alguns bugs nas pastas de controle do q-mail, onde as mensagens e informações dos e-mails são armazenadas. Útil também para limpar aquelas longas filas de SPAM que ficam armazenadas no queue do q-mail.

Se você executá-lo sem parâmetros, ele apenas verifica, não corrige nada;
Usando com o parâmetro LIVE (minúsculo), será corrigido toda e qualquer anormalidade encontrada;
Usando com o parâmetro EMPTY (minúsculo), será limpado (esvaziado) todo e qualquer e-mail que esteja na fila (queue) do q-mail.

Sintase: ./qfixq live empty

Salve o script abaixo com o nome de qfixq
mude o atributo para executável (chmod +x qfixq)
execute para verificação ou para correção.


#------------------- Início do Script ---------------------------------
#!/usr/bin/perl -w
#
# qfixq
# John Simpson 2003-10-17
#
# repairs a messed-up qmail queue structure.
#
# *********************************************************************
# *** ***
# *** DANGER! DANGER! DANGER! ***
# *** ***
# *** DO NOT RUN THIS WHILE ANY QMAIL-RELATED PROGRAMS ARE RUNNING! ***
# *** ***
# *** DANGER! DANGER! DANGER! ***
# *** ***
# *********************************************************************
#
# 2004-01-20 jms1 - fixed an issue with directory/file permissions being set
# incorrectly in some cases
#
# 2004-01-21 jms1 - fixed issue where /v/q/queue/lock/trigger was being set
# to the wrong owner, causing queue slowdowns as detailed here:
# http://lifewithqmail.org/lwq.html#trigger
#
# 2004-01-22 jms1 - fixed a REALLY minor issue- mess/*/* files were being
# forced to perm 0640, where their native state in a correct queue is 0644.
# the old way did no damage (the ownership was correct so it didn't really
# matter) but it was dumping a lot of un-necessary warnings when it ran,
# which may make people think there was a problem when there wasn't one.
#
# 2004-10-13 jms1 - at least one version of perl considers mkdir() with
# only one argument to be an error, so i've added specific permissions to
# all mkdir() calls. i've also added a specific umask() call, just because
# it's a good idea for any program which creates files or directories which
# shouldn't be world-readable when they're first created. thanks go to
# Tom Clegg for the suggestion.
#
# 2005-04-11 jms1 - (no code changed.) changed the copyright notice to
# specify that the license is the GPL VERSION 2 ONLY. i'm not comfortable
# with the "or future versions" clause until i know what these "future
# versions" will look like.
#
# 2005-04-14 jms1 - (no code changed.) added comments to show which lines
# are to be changed for configuring the script to work on non-standard
# machines.
#
# 2005-04-20 jms1 - once upon a time, there was a guy who had a queue with
# over 200 buckets. we don't know why, maybe his server handles millions
# of message per day, but whatever... he downloaded this script, and even
# though he had been specifically told to fix the bucket count first, he
# ran it without fixing the bucket count first. in doing so he destroyed
# his queue so badly that qmail-send wouldn't work- it started spewing
# "unable to open info/24, sleeping..." over and over again.
#
# so now the script will run qmail-showctl and figure out how many buckets
# to use automatically.
#
# 2005-04-21 jms1 - again in the interest of safety, i'm adding an extra
# safety feature to the script which will allow it to FIND problems, but
# not fix them unless you run the script as "qfixq live".
#
# 2005-04-22 jms1 - to protect people from thinking they've fixed a problem
# which still exists, now if the script is not running in live mode, it
# will print a reminder at the end of the output as well as the beginning.
#
# 2005-08-30 jms1 - fixed two minor permissions issues. thanks to Michael
# Martinell for spotting the problem. i keep saying i shouldn't write
# code when i'm tired...
#
# 2005-11-15 jms1 - adding a "empty" option which will delete any files
# relating to individual messages. this should leave you with an
# empty queue.
#
# i also removed "default number of buckets" as an option- basically,
# if "qmail-showctl" can't give you the right answer, it would be too
# dangerous to even think of trying to run this script- because that
# would mean that there's a lot more wrong than just your queue being
# corrupted.
#
###############################################################################
#
# Copyright (C) 2003-2005 John Simpson.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, version 2, as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# or visit http://www.gnu.org/licenses/gpl.txt
#
###############################################################################

require 5.003 ;
use strict ;

###############################################################################
#
# configuration here

my $vq = "/var/qmail" ;
my $qmailq = getpwnam ( "qmailq" ) ;
my $qmailr = getpwnam ( "qmailr" ) ;
my $qmails = getpwnam ( "qmails" ) ;
my $qmail = getgrnam ( "qmail" ) ;

###############################################################################
#
# it should not be necessary to change anything below this point, however
# if you do find a bug or have an idea to make it work better, please let
# me know.
#
###############################################################################

umask ( 077 ) ;

my %dirown =
(
"bounce" => $qmails ,
"info" => $qmails ,
"intd" => $qmailq ,
"local" => $qmails ,
"mess" => $qmailq ,
"remote" => $qmails ,
"todo" => $qmailq ,
) ;

my %dirperm =
(
"bounce" => 0700 ,
"info" => 0700 ,
"intd" => 0700 ,
"local" => 0700 ,
"mess" => 0750 ,
"remote" => 0700 ,
"todo" => 0750 ,
) ;

my %fileperm =
(
"bounce" => 0600 ,
"info" => 0600 ,
"intd" => 0644 ,
"local" => 0600 ,
"mess" => 0644 ,
"remote" => 0600 ,
"todo" => 0644 ,
) ;

my %dirbuckets =
(
"bounce" => 0 ,
"info" => 1 ,
"intd" => 0 ,
"local" => 1 ,
"mess" => 1 ,
"remote" => 1 ,
"todo" => 0 ,
) ;

my $vqq = "$vq/queue" ;
my $live = 0 ;
my $empty = 0 ;

my ( %file , %msg , %ren , %del , $buckets ) ;

$| = 1 ;

###############################################################################
#
# fix/set ownership and permissions on a file

sub chownmod($$$@)
{
my $uid = shift ;
my $gid = shift ;
my $prm = shift ;

while ( my $f = shift )
{
my @s = stat $f ;

if ( ( $s[4] != $uid ) || ( $s[5] != $gid ) )
{
if ( $s[4] != $uid )
{
printf "Fixing uid of $f (%d s/b %d)\n" ,
$s[4] , $uid ;
}

if ( $s[5] != $uid )
{
printf "Fixing gid of $f (%d s/b %d)\n" ,
$s[5] , $gid ;
}

$live && chown ( $uid , $gid , $f ) ;
}

if ( ( $s[2] & 0777 ) != ( $prm & 0777 ) )
{
printf "Fixing permissions on $f (%04o s/b %04o)\n" ,
( $s[2] & 0777 ) , ( $prm & 0777 ) ;
$live && chmod ( ( $prm & 0777 ) , $f ) ;
}
}
}

###############################################################################
###############################################################################
###############################################################################
#
# sanity checks

$< && die "This program requires root privileges.\n" ;

while ( my $z = shift @ARGV )
{
if ( $z eq "live" )
{
$live = 1 ;
}
elsif ( $z eq "empty" )
{
$empty = 1 ;
}
}

if ( $live && $empty )
{
print <
Running in LIVE and EMPTY mode. All messages WILL BE DELETED from the
queue.

EOF
}
elsif ( $live )
{
print <
Running in LIVE mode. All fixes will be written to the disk.

EOF
}
elsif ( $empty )
{
print <
Running in EMPTY mode, but not LIVE mode. Messages will NOT actually be
deleted.

If you wish to entirely empty the queue, use "$0 live empty".

EOF
}
else
{
print <
Running in FIND mode. Any fixes described will NOT be written to the disk.

If you wish to run in LIVE mode and fix problems, use "$0 live".

If you wish to entirely empty the queue, use "$0 live empty".

EOF
}

###############################################################################
#
# figure out how many buckets we have to play with

open ( B , "$vq/bin/qmail-showctl |" )
or die "Can\'t run $vq/bin/qmail-showctl: $!\n" ;
while ( my $line = )
{
next unless ( $line =~ /split\: (\d+)/ ) ;
$buckets = $1 ;
last ;
}
close B ;

if ( $buckets )
{
print "Using $buckets buckets as ordered by qmail-showctl.\n" ;
}
else
{
die <

Cannot determine how many buckets to use, cannot continue.

EOF
}

###############################################################################
#
# fix directory ownerships and permissions

chownmod ( $qmailq , $qmail , 0750 , $vqq ) ;
chownmod ( $qmailq , $qmail , 0750 , "$vqq/lock" ) ;
chownmod ( $qmails , $qmail , 0600 , "$vqq/lock/sendmutex" ) ;
chownmod ( $qmailr , $qmail , 0644 , "$vqq/lock/tcpto" ) ;
chownmod ( $qmails , $qmail , 0622 , "$vqq/lock/trigger" ) ;
chownmod ( $qmailq , $qmail , 0700 , "$vqq/pid" ) ;

for my $dir ( sort keys %dirown )
{
unless ( -d "$vqq/$dir" )
{
print "Creating missing directory $vqq/dir\n" ;
$live && mkdir ( "$vqq/$dir" , 0700 ) ;
}

chownmod ( $dirown{$dir} , $qmail , $dirperm{$dir} , "$vqq/$dir" ) ;

if ( $dirbuckets{$dir} )
{
for my $n ( 0 .. ( $buckets - 1 ) )
{
unless ( -d "$vqq/$dir/$n" )
{
print "Creating missing bucket $vqq/$dir/$n\n" ;
$live && mkdir ( "$vqq/$dir/$n" , 0700 ) ;
}

chownmod ( $dirown{$dir} , $qmail , $dirperm{$dir} ,
"$vqq/$dir/$n" ) ;
}
}
}

# dunno what to do with files in "pid"... delete? ignore? anyone?
# thought about deleting, ignoring them for now...
# rm -r $vqq/pid/*

########################################
# make a list of what files exist for each message

for my $dir ( sort keys %dirown )
{
print "Reading $vqq/$dir\n" ;

open ( L , "find $vqq/$dir -type f |" )
or die "Can\'t run [find $vqq/$dir -type f]: $!\n" ;

while ( my $line = )
{
chomp $line ;
$line =~ m|.*/(.*)| ;
my $n = $1 ;

if ( $empty )
{
$file{"$n:$dir"} = $line ;
$msg{$n} = "" ;
$del{$n} = "" ;
next ;
}

chownmod ( $dirown{$dir} , $qmail , $fileperm{$dir} , $line ) ;

my @s = stat $line ;

unless ( $s[7] )
{
print "Remving zero-byte file $line\n" ;
$live && unlink $line ;
next ;
}

if ( exists $file{"$n:$dir"} )
{
# duplicate names (i.e. info/3/101 and info/5/101) ???
print "Duplicate [$n:$dir] message will be killed\n" ;
print "\tRemoving $line\n" ;
$live && unlink $line ;
$del{$n} = 1 ;
next ;
}

$file{"$n:$dir"} = $line ;
$msg{$n} = "" ;

if ( $dirbuckets{$dir} )
{
$line =~ m|.*/(.*?)/$n| ;
my $b = $1 ;
if ( $b != ( $n % $buckets ) )
{
print "$n is in the wrong bucket\n" ;
$ren{$n} ||= $n ;
}
}

if ( $dir eq "mess" )
{
if ( $n != $s[1] )
{
print "$n should be $s[1]\n" ;
$ren{$n} = $s[1] ;
}
}
}

close L ;
}

###############################################################################
#
# kill off any messages which need to be deleted

for my $m ( sort keys %del )
{
print "Killing message $m\n" ;

for my $dir ( sort keys %dirown )
{
if ( exists $file{"$m:$dir"} )
{
my $f = $file{"$m:$dir"} ;
print "\tRemoving $f\n" ;

$live && unlink $f ;

delete $file{"$m:$dir"} ;
}
}

if ( exists $ren{$m} )
{
delete $ren{$m} ;
}

delete $del{$m} ;
delete $msg{$m} ;
}

###############################################################################
#
# analyze the lists, find and delete mesages with missing pieces

print "Analyzing the results...\n" ;

for my $m ( sort keys %msg )
{
if ( exists $file{"$m:bounce"} ) { $msg{$m} .= "B" ; }
if ( exists $file{"$m:intd"} ) { $msg{$m} .= "D" ; }
if ( exists $file{"$m:info"} ) { $msg{$m} .= "F" ; }
if ( exists $file{"$m:local"} ) { $msg{$m} .= "L" ; }
if ( exists $file{"$m:mess"} ) { $msg{$m} .= "M" ; }
if ( exists $file{"$m:remote"} ) { $msg{$m} .= "R" ; }
if ( exists $file{"$m:todo"} ) { $msg{$m} .= "T" ; }

next if ( ( $msg{$m} eq "DMT" ) # waiting to be processed
|| ( $msg{$m} eq "FLM" ) # waiting on local delivery
|| ( $msg{$m} eq "FMR" ) # waiting on remote delivery
|| ( $msg{$m} eq "BFLM" ) # bounce from local delivery
|| ( $msg{$m} eq "BFMR" ) # bounce from remote delivery
) ;

print "$m: [$msg{$m}] illegal file combination, removing\n" ;

for my $dir ( sort keys %dirown )
{
if ( exists $file{"$m:$dir"} )
{
my $f = $file{"$m:$dir"} ;
print "\tRemoving $f\n" ;

$live && unlink $f ;

delete $file{"$m:$dir"} ;
}
}

if ( exists $ren{$m} )
{
delete $ren{$m} ;
}

delete $msg{$m} ;
}

###############################################################################
#
# handle any renaming that needs to be done, either because "mess" filenames
# are not the same as the inode numbers, or because the files are in the
# wrong buckets.
#
# we do this as two passes, just in case a message's
# new filename already exists.

########################################
# first pass: all files get ".temp" added first

for my $m ( sort keys %ren )
{
for my $dir ( sort keys %dirown )
{
if ( exists $file{"$m:$dir"} )
{
my $f = $file{"$m:$dir"} ;
my $n = "$f.temp" ;

print "Renaming(1) $f to $n\n" ;
$live && rename ( $f , $n ) ;

$file{"$m:$dir"} = $n ;
}
}
}

########################################
# second pass: the ".temp" files get their final names

for my $m ( sort keys %ren )
{
########################################
# these directories use a bucket number
# which must be part of the final filename

for my $dir ( sort keys %dirown )
{
if ( exists $file{"$m:$dir"} )
{
my $f = $file{"$m:$dir"} ;
my $n = "$vqq/$dir/$ren{$m}" ;

if ( $dirbuckets{$dir} )
{
my $b = $ren{$m} % $buckets ;
$n = "$vqq/$dir/$b/$ren{$m}" ;
}

print "Renaming(2) $f to $n\n" ;
$live && rename ( $f , $n ) ;

delete $file{"$m:$dir"} ;
$file{"$ren{$m}:$dir"} = $n ;
}
}

$msg{$ren{$m}} = $msg{$m} ;
delete $msg{$m} ;
}

###############################################################################
#
# in case they missed it the first time...

unless ( $live )
{
print <

******************************************************************************

This was not LIVE mode.
Anything described above was NOT written to the disk.

If you wish to run in live mode, use "$0 live".

If you wish to entirely empty the queue, use "$0 live empty".

******************************************************************************

EOF
}
#
#------------------------------ Final do Script ---------------------------------------
#
#

O Documento original, encontra-se em http://qmail.jms1.net/scripts/qfixq.shtml