Perl脚本黑名单检查高CPU使用率

Question

我在perl中编写了一个脚本，它从数据库中获取一组IP，并在20个主要黑名单服务器上查询它们。它非常简单，脚本似乎在Ubuntu 12.04安装上正常运行但是当我尝试将其迁移到具有相同版本的perl和安装库的CentOS 6.5时，我注意到该脚本将使用大量CPU。

它很奇怪，因为在其他ubuntu安装工作正常（0.0％使用）和dns服务器是相同的。我没有在这个版本上实现线程，因为它运行得很好（在ubuntu上）。 我尝试在本地dns上使用缓存，尝试升级perl，更新perl的模块，在检查期间添加睡眠暂停，但情况是相同的。

在代码

下面

#!/usr/bin/perl
use POSIX qw/ strftime /;

#use Encode qw/encode decode/;
#use Syslog;  # for later use to check everything's ding fine

use strict;
use warnings;

use Digest::MD5 qw(md5);
use Net::DNS;
use DBD::mysql;
use LWP::Simple;
use strict;
use warnings;
use Proc::Daemon;

#Proc::Daemon::Init;

print "Setting globals\n";
my $continue = 1;
my $debug   = 1;
my $timeout = 3;
my $id_start = 0;
#my $id_start = $ARGV[0];
#my $id_end = $ARGV[1];
my $id_end       = 320000;
my $enable_cache = 1;
my $count      = 0;
my $cache_path = "/cachedir/cache/";

#konfigu i db jarebi
my $host = "localhost";
my $db   = "db here";
my $user = "user and stuff";
my $pw   = "passwordz ";

$SIG{TERM} = sub { $continue = 0 };

while ($continue) {
    my $dbh = DBI->connect( "DBI:mysql:$db", $user, $pw ) || die "Snuk: $DBI::errstr";
    if ($debug) {
        print "Connecting to the databasse\n";
    }

    my @total_query;

    my $top_10 = "SELECT `ip` FROM main_data WHERE `id` >= ? and `id` <= ? ORDER BY `last_check` ASC limit 10";
    if ($debug) {
        print "Constructing query with $id_start and $id_end as parameters\n";
    }

    # zgjedhim 10 te parat qe nuk jane lock(te parat i thencin)
    my $sth = $dbh->prepare($top_10);

    if ( !$sth ) {
        die "Probleme me tabelen\n";
    } else {
        $sth->execute( $id_start, $id_end );
    }

    if ($debug) {
        print "Query Executed\n";
    }

    my @ips = ();

    while ( my @results = $sth->fetchrow() ) {
        if ($debug) {
            print "Inserting IP $results[0] on arrays\n";
        }
        push @ips, "$results[0]";
    }
    $dbh->disconnect;

    my @a     = ();
    my $count = 0;
    if ($debug) {
        print "Got " . scalar(@ips) . " from query\n";
    }

    foreach my $gje (@ips) {
        if ($debug) {
            print "Checking IP:$gje for spamming trace\n";
        }
        $a[0]  = $gje;
        $a[1]  = check( $gje, "b.barracudacentral.org" );
        $a[2]  = check( $gje, "zen.spamhaus.org" );
        $a[3]  = check( $gje, "sbl-xbl.spamhaus.org" );
        $a[4]  = check( $gje, "cidr.bl.mcafee.com" );
        $a[5]  = check( $gje, "bl.score.senderscore.com" );
        $a[6]  = check( $gje, "z.mailspike.net" );
        $a[7]  = check( $gje, "dnsbl.proxybl.org" );
        $a[8]  = check( $gje, "cbl.abuseat.org" );
        $a[9]  = check( $gje, "dnsbl.inps.de" );
        $a[10] = check( $gje, "dyna.spamrats.com" );
        $a[11] = check( $gje, "dnsbl-1.uceprotect.net" );
        $a[12] = check( $gje, "all.spamrats.com" );
        $a[13] = check( $gje, "spam.dnsbl.sorbs.net" );
        $a[14] = check( $gje, "dnsbl.sorbs.net" );
        $a[15] = check( $gje, "noptr.spamrats.com" );
        #   $a[16] = "-1";
        $a[16] = check( $gje, "db.wpbl.info" );
        $a[17] = check( $gje, "dnsbl.ahbl.org" );
        #   $a[17] = "-1";
        $a[18] = check( $gje, "ips.backscatterer.org" );
        $a[19] = check( $gje, "bl.spamcop.net" );
        $a[20] = check( $gje, "ip.v4bl.org" );
        print "@a" . "\n";

        if ( $enable_cache eq "1" ) {
            update_cache(@a);
        }

        push( @total_query, [@a] );
    }

    update_db(@total_query);

    print "Exiting \n";

}

sub update_db {
    my @total_query = @_;
    my $dbh = DBI->connect( "DBI:mysql:$db", $user, $pw ) || die "Snuk: $DBI::errstr";
    my $top_10 = "UPDATE main_data SET `1`=?,`2`=?,`3`=?,`4`=?,`5`=?,`6`=?,`7`=?,`8`=?,`9`=?,`10`=?,`11`=?,`12`=?,`13`=?,`14`=?,`15`=?,`16`=?,`17`=?,`18`=?,`19`=?,`20`=?,`last_check`= NOW(),status=? where ip = ? LIMIT 1";
    my $sth = $dbh->prepare($top_10);
    foreach my $data (@total_query) {
        my $status = 0;

        foreach ( my $i = 1 ; $i <= 20 ; $i++ ) {
            if ( $$data[$i] > 0 ) {
                $status++;
            }
        }
        print "$$data[1],$$data[2],$$data[3],$$data[4],$$data[5],$$data[6],$$data[7],$$data[8],$$data[9],$$data[10],$$data[11],$$data[12],$$data[13],$$data[14],$$data[15],$$data[16],$$data[17],$$data[18],$$data[19],$$data[20],$status,$$data[0]\n";

        $sth->execute(
            $$data[1],  $$data[2],  $$data[3],  $$data[4],  $$data[5],  $$data[6],  $$data[7],  $$data[8],
            $$data[9],  $$data[10], $$data[11], $$data[12], $$data[13], $$data[14], $$data[15], $$data[16],
            $$data[17], $$data[18], $$data[19], $$data[20], $status,    $$data[0]
        );
    }
    $dbh->disconnect;
}

sub check {
    my $res = Net::DNS::Resolver->new;
    $res->tcp_timeout($timeout);
    $res->udp_timeout($timeout);
    my $nr    = 0;
    my $ip    = shift;
    my @copat = split( /\./, $ip );
    $ip = "$copat[3].$copat[2].$copat[1].$copat[0]";

    my $rbl_server = shift;
    if ($debug) {
        print "Checking IP:$ip for spamm records on server $rbl_server\n";
    }
    my $query = $res->search("$ip.$rbl_server");

    if ($query) {
        foreach my $rr ( $query->answer ) {
            if ( $rr->type eq "A" ) {
                $nr++;

                #print ".$rr->address." \n";
                my $returnC = $rr->address;
                my $rtc = substr( $returnC, 8 );
                return $rtc;
            } else {
                return "1";
            }
        }
    } else {
        if ( $res->errorstring eq "NXDOMAIN" ) {
            return "0";
        } else {
            return "-1";
        }
    }
}

sub get_date {
    my ($self) = @_;
    my @timeD = localtime();    # 3 4 5
    $timeD[4]++;
    $timeD[5] += 1900;
    $timeD[4] = ( ( $timeD[4] < 10 ) ? "0" . $timeD[4] : $timeD[4] );    # nena ternarit jam :D
    $timeD[3] = ( ( $timeD[3] < 10 ) ? "0" . $timeD[3] : $timeD[3] );
    $timeD[2] = ( ( $timeD[2] < 10 ) ? "0" . $timeD[2] : $timeD[2] );
    $timeD[1] = ( ( $timeD[1] < 10 ) ? "0" . $timeD[1] : $timeD[1] );
    return "$timeD[5]-$timeD[4]-$timeD[3] $timeD[2]:$timeD[1]:$timeD[0]";
}

sub update_cache {
    my (@data) = @_;

    #my $last_ch = get_date();
    $count++;
    my $status = 0;
    foreach ( my $i = 1 ; $i <= 14 ; $i++ ) {
        if ( $data[$i] > 0 ) {
            $status++;
        }
    }

    if ( -d "$cache_path" ) {
        # ok folder exits
    } elsif ( -e "$cache_path" ) {
        # bohh
    } else {
        # lets create teh folder
        system("touch $cache_path");
    }

    open( REALTIME_FILE, "< $cache_path" ) or die "Could not open file";
    my @rrjeshtat = <REALTIME_FILE>;
    close(REALTIME_FILE);

    if ( $count > 5 ) {
        pop(@rrjeshtat);
    }
    my $line;

    open( REALTIME_FILE, "> $cache_path" ) or die "Could not open file";
    if ( $status > 0 ) {
        # blacklisted
        $status = ( $status > 1 ) ? "$status SERVERA" : "$status SERVER";
        $line =
            '<li class="list-group-item"><span class="text-muted">'
          . get_date()
          . '</span> <strong>'
          . $data[0]
          . '</strong> <span class="label label-danger pull-right">LISTUAR NE '
          . $status
          . ' </span></li>' . " \n";
         #print '<li class="list-group-item"><span class="text-muted">'.get_date().'</span> <strong>'.$data[0].'</strong> <span class="label label-danger pull-right">LISTUAR NE '.$status.'</span></li>'." \n";
    } else {
        # clean
        $line =
            '<li class="list-group-item"><span class="text-muted">'
          . get_date()
          . '</span> <strong>'
          . $data[0]
          . '</strong> <span class="label label-success pull-right">E PASTER</span></li>' . " \n";
          #print '<li class="list-group-item"><span class="text-muted">'.get_date().'</span> <strong>'.$data[0].'</strong> <span class="label label-success pull-right">'." \n";
    }
    unshift( @rrjeshtat, $line );

    #print $line;
    print REALTIME_FILE join( "", @rrjeshtat );
    close(REALTIME_FILE);
    $count++;
}