adismaug has asked for the wisdom of the Perl Monks concerning the following question:

Dear monks
I have a linux machine configured as a bridge in front of some mail servers.
Using iptables I redirect each SMTP SYN to user space queue:
iptables -A FORWARD -s 0/0 -i eth0 -p tcp --syn --dport 25 -j QUEUE
Using “IPTables::IPv4::IPQueue” the script reads the queued packets and check if they are listed in an RBL blacklist using DNS query.
The thing is I want to create a file of blacklisted IP address so I won’t have to perform a DNS lookup on previously matched IPs.
So writing the blacklisted IP to a file is easy but I want another script that will age out IP address from the file and delete them.
How can I do that?
Is there a more efficient way to write the script?
This is the main script:

#!/usr/bin/perl
use Parallel::ForkManager;
use IPTables::IPv4::IPQueue qw(:constants);
use NetPacket::IP qw(:ALL);
use Time::HiRes qw(time);

my $i = 0;
my $t0 = time;

my $ipq = new IPTables::IPv4::IPQueue
    (copy_mode => IPQ_COPY_PACKET, copy_range => 1500);


my $pm = new Parallel::ForkManager(3); 
    $pm->run_on_finish(
        sub { 
            my ($pid, $exit_code) = @_;
            $i++;
        }
    );

while (1) {
    if ($i == 100) {
        $elapsed = time - $t0;
        print "\n *************\n$elapsed\n********************\n";
        $i = 0;
        my $t0 = time;
        $pm->wait_all_children;
    }

    $pm->start and next; # do the fork

    my $msg = $ipq->get_message;
    if (defined $msg) {
        my $ip = NetPacket::IP->decode($msg->payload);
        $ipAddr = $ip->{src_ip};
        $DSTipAddr = $ip->{dest_ip};
        @res = qx { /root/scripts/iptables/rbl.pl $ipAddr };
        if (grep(/err/, @res)) {
            #qx { echo $ipAddr >> /root/scripts/iptables/stat/blackRbl
+.log };
            $ipq->set_verdict($msg->packet_id, NF_DROP);
            print "$ipAddr -> $DSTipAddr @res\n";
        } else {
            $ipq->set_verdict($msg->packet_id, NF_ACCEPT);
            #print "$ipAddr -> $DSTipAddr @res\n";
        }
        exit(0);
    } else {
        print "Not defined\n";
        exit(0);
    }
    $pm->finish; # do the exit in the child process
}

[download]
Regards,
Adi.

Replies are listed 'Best First'.
Re: IPQueue blacklist file
by Corion (Patriarch) on May 25, 2009 at 08:16 UTC

    IMO the easiest approach to "aging out" is to store everything with an expiry time in the future. The check whether an item is valid is then whether it matches and its expiry time is still in the future at the time of the check. You can easily implement different timeouts that way or even add accumulating timeouts for repeated transgressions (on other ports, for example). Also, by choosing a suitable point of time in the future, you can also ban IPs "forever".

    As you seem to be doing stuff in parallel, I suggest you don't use a text file but a database (for example, DBD::SQLite for storing the information. Having a single file is important so you can just delete that file to reset the blacklist. Using a database is convenient as the database will handle all the necessary locking and retrying for you. Also, consider taking a look at the (not in Perl) fail2ban, which also does dynamic IP blocking.

[reply]
      Thanks for the replay.
      I solved the issue by using a database for the blacklist and inserting IP address, counter and tag value.
      The tag and counter are used for aging out the entry.
      This is done by this script: 
      #!/usr/bin/perl
use DBI();

my $dbh = DBI->connect("DBI:mysql:database=xxxx;host=localhost",
                     "xxx", "xxxxx",
                     {'RaiseError' => 1});
my $i = 144;

while ($i > -1) {
    print "$i\n";
    $newCounter = $i - 12;
    $rows = $dbh->do("update blacklist set counter='$newCounter', tag=
+'1' where counter = '$i' and tag = '0'");
    $i = $i - 12;
}

$rows = $dbh->do("update blacklist set tag='0' where tag like '%%'");
$rows = $dbh->do("delete  from blacklist where counter <= '0'");

$dbh->disconnect();
exit(0);

      [download]

      The script runs every 5 minutes which gives each entry one hour to live (unless updated with a new counter)
      Still if any one have a better way I will be glad to know…..
[reply]
[d/l]

Back to Seekers of Perl Wisdom