qmail_nuke_bouncing_addrs.pl

snowtty

#!/usr/local/bin/perl
# remove user/.qmail (vpopmail) and .qmail-user when the target address
# is not accepting mail
# Copyright 2008 Jeremy Kister.  http://jeremy.kister.net./
use strict;
use Sys::Hostname;
my $hostname = hostname();
my ($y,$m,$d) = (localtime())[5,4,3];
$y += 1900;
my $mon = sprintf('%.2d', $m);
my $day = sprintf('%.2d', $d);
my $date = $y . $mon . $day;
my(%dir,%nuked);
my $DEBUG;
opendir(D, '/var/qmail/queue/mess/') || die "cannot opendir queue/mess: $!\n";
my @subdirs = (grep {!/^\./} readdir D); # conf-split
closedir D;
# trim log,
my @log;
if(open(LOG, "/var/log/nukedforwards")){
        while(){
                push @log, $_;
        }
        close LOG;
        my $i=1;
        open(LOG, ">/var/log/nukedforwards.tmp") || die "cannot write to nukedforwards.tmp: $!\n";
        foreach my $line (reverse @log){
                print LOG $line;
                last if($i == 10000);
                $i++;
        }
        close LOG;
        rename("/var/log/nukedforwards.tmp","/var/log/nukedforwards")
          || die "cannot rename tmp: $!\n";
}
## end trim log
open(LOG, ">>/var/log/nukedforwards") || die "cannot open $hostname for append: $!\n";
foreach my $subdir (@subdirs){
        opendir(S, "/var/qmail/queue/mess/${subdir}/") || die "cannot opendir mess/$subdir: $!\n";
        foreach my $file (grep {/^\d+$/} readdir S){
                if(open(F, "/var/qmail/queue/mess/${subdir}/${file}")){
                        chop(my $firstline = );
                        if($firstline =~ /^Received: \(qmail\s\d+\sinvoked for bounce\)\;/){
                                my $line = 2; # already processed line 1
                                print "$subdir/$file matches (line $line) -- ";
                                my $found_dt;
                                while(){
                                        chomp;
                                        if(/^Delivered-To:\s(\S+)\@(\S+\.\S+)$/){
                                                print "(dt found) ";
                                                my $user = lc($1);
                                                my $domain = lc($2);
                                                $user =~ s/^${domain}-//;
                                                $found_dt = 1;
                                                if(exists($nuked{$user}{$domain})){
                                                        print "skipping - already processesed\n";
                                                        $line=50;
                                                        last;
                                                }
                               
                                                $nuked{$user}{$domain} = 1;
                                                unless(exists($dir{$domain})){
                                                        open(A, '/var/qmail/users/assign') || die "cannot open assign: $!\n";
                                                        while(){
                                                                if(/^\+${domain}\-:[^:]+:\d+:\d+:([^:]+):/){
                                                                        $dir{$domain} = $1; # memory cheaper than cpu
                                                                        last;
                                                                }
                                                        }
                                                        close A;
                                                        unless(exists($dir{$domain})){
                                                                warn "cant find dir for $domain\n";         # impossible ?
                                                                $dir{$domain} = '/dev/null';
                                                        }
                                                }
                                                # yeah, there *could* be both a .qmail-username and a username/.qmail,
                                                # but since .qmail-username takes precedence, we remove it first, and
                                                # maybe the bouncing stops
                                                if(-f "$dir{$domain}/.qmail-${user}"){
                                                        print "$dir{$domain}/.qmail-${user} exists - ";
                                                        if($DEBUG == 1){
                                                                print "skipped unlink\n";
                                                        }else{
                                                                if(unlink("$dir{$domain}/.qmail-${user}")){
                                                                        print LOG "[${date}]: removed $dir{$domain}/.qmail-${user} (forward)\n";
                                                                }else{
                                                                         print "could not unlink $dir{$domain}/.qmail-${user}: $!\n";
                                                                }
                                                        }
                                                }else{
                                                        # get their home dir, check for .qmail
                                                        if(open(V, "$dir{$domain}/vpasswd")){
                                                                my $maildir;
                                                                while(){
                                                                        if(/^${user}:[^:]+:\d+:\d+:[^:]*:([^:]+):/){
                                                                                $maildir = $1;       
                                                                                if(-f "${maildir}/.qmail"){
                                                                                        print "${maildir}/.qmail exists - ";
                                                                                        if($DEBUG == 1){
                                                                                                print "skipped unlink\n";
                                                                                        }else{
                                                                                                if(unlink("${maildir}/.qmail")){
                                                                                                        print LOG "[$date]: removed ${maildir}/.qmail (forward)\n";
                                                                                                }else{
                                                                                                        print "could not unlink ${maildir}/.qmail: $!\n";
                                                                                                }
                                                                                        }
                                                                                }else{
                                                                                        warn "could not find forwarding info as per ${subdir}/${file}\n";
                                                                                }
                                                                                last;
                                                                        }
                                                                }
                                                                close V;
                                                                warn "did not find mailbox or forward for ${user}\@${domain}\n" unless($maildir);
                                                        }else{
                                                                warn "could not open $dir{$domain}/vpasswd: $!\n";
                                                        }
                                                }
                                        }
                                        $line++;
                                        last if($line == 50);
                                }
                                unless($found_dt == 1){
                                        print "no Delivered-To line found in ${subdir}/${file}\n";
                                }
                        }
                        close F;
                }else{
                        warn "could not open mess/${subdir}/${file}: $!\n";
                }
        }
        closedir S;
}


本文来自ChinaUnix博客，如果查看原文请点：http://blog.chinaunix.net/u/5591/showart_2115177.html