I'm not quite sure why you are opening /dev/stdin when you can just read from the STDIN filehandle.

/J\

Thank you gellyfish. I was reading /dev/stdin instead of STDIN because that part is pure cargo from my inspiration at ApacheLogsWithoutIPs. After fixing that and learning from a horde of zombies to call "exit" instead of "next" from inside the child to continue looping in the parent, it seems to function as intended and very efficiently.

#!/usr/bin/perl -w

$SIG{CHLD} = 'IGNORE';

use strict;
use Fcntl qw(:DEFAULT);
use Net::Netmask;
use Net::Whois::IANA;
use Proc::Fork;
use SDBM_File;

my $iana = Net::Whois::IANA->new;

my $bye  = join '|', (
 'strings known to occur',
 'in custname and orgname',
);
my $badhosts = 'some\.bad|other\.worse\d+';

tie (my %seen, 'SDBM_File', '/some/sdbm', O_RDWR|O_CREAT, 0666)
or die "$!";

while (<STDIN>) {
  chomp;
  next if exists $seen{$_};
  $seen{$_} = 1;

  my $ip = $_;

  child {
    my $problem = 0;
    my $host = `host $ip` or die "$!";
    $problem = 1 if $host =~ /$badhosts/i;

    if ($problem or $host =~ /not found/) {
      $iana->whois_query(-ip=>$ip);

      my $inetnum  = $iana->inetnum || '';
      my $custname = $iana->{QUERY}->{custname} || '';
      my $orgname  = $iana->{QUERY}->{orgname}  || '';

      exit unless $inetnum 
      and ($problem or $custname or $orgname);

      if ($problem or 
      $custname =~ /$bye/i or $orgname =~ /$bye/i){
        my $mask = Net::Netmask->new($inetnum);
        `iptables -A INPUT -s $mask -j DROP`;
      }
    }
  exit
  };
}
untie %seen;
[download]

...or better yet, use the handy, automatic <>


--isotope

This is a totally wild guess, so please feel free to throw rocks at my head if I'm wrong.

Is it OK to open a file and then write to it from forked children and then close it from the parent? It seems to me that you'd get all kinds of horrible problems with multiple children trying to write at the same time... Maybe SDBM has a locking system and the parent process holds the lock? That would cause what you're seeing.

I think you need some kind of IPC to organize everyone so they don't step on eachother while writing to the data base file.

If I were doing this, first I'd seriously reconsider the value of forking off those children. If this were only one process without the forking it would be way easier. If I decided that I really needed that higher performance, I'd use threads with queues (Thread::Queue). I don't know what the equivalent to thread queues in a forking system is, but maybe that'd be easier.

Threads aren't really any harder than forking, in my experience.

See: perlthrtut, perlipc, Thread::Queue

Is it OK to open a file and then write to it from forked children and then close it from the parent?

That's a good question. My instinct is not to touch the hash tied by the parent from inside children in any way. I don't fork until the parent is done accessing %seen, which is ultimately untied from the parent as well. It seems logical to divide the labor by having the parent alone handle a very fast and reliable tied hash while forking off slower DNS queries to children who may add firewall rules based on the results.

I'd seriously reconsider the value of forking off those children.

Something like it has to be done or else a slow function in that while loop prevents Apache from serving requests. So far I'm seeing very few children in "top" on 1 second delay on a busy webserver, one or two at most, with no noticable slowdown.

I'd consider de-coupling this from the apache log handler. Set up a CustomLog to a file and write/borrow:) a log tail-er(perldoc -f seek), which runs from inittab (or a daemon), that processes log entries without intefering with Apache. This has the added benefit, of serialising the process (no fork required), and you won't hit process/resource limits when your webserver gets slammed.

That aside, I don't see why the above script shouldn't work. Are you defining the CustomLog in the server config, or a VirtualHost section? If you set the CustomLog to a file, does anything get written to it?

I'd consider de-coupling this from the apache log handler.

That makes so much sense I rewrote it immediately using File::Tail and Proc::Daemon. By the way this piped version works, but probably won't scale so well as you generously pointed out. Thank you.

#!/usr/bin/perl -w

use strict;
use Fcntl qw(:DEFAULT);
use File::Tail;
use Net::Netmask;
use Net::Whois::IANA;
use Proc::Daemon;
use SDBM_File;

Proc::Daemon::Init;

my $bye  = join '|', (
 'strings known to occur',
 'in custname and orgname',
);
my $bad = 'some\.bad\.host|other\.worse\d+';

my $file = File::Tail->new("/path/to/ip_log");
my $iana = Net::Whois::IANA->new;

tie (my %seen, 'SDBM_File', '/some/sdbm', O_RDWR|O_CREAT, 0666)
or die "$!";

while (defined (my $ip = $file->read)) {
  chomp $ip;
  next if exists $seen{$ip};
  $seen{$ip} = 1;

  my $problem = 0;
  my $host = `host $ip` or next;
  $problem = 1 if $host =~ /$badhosts/i;

  if ($problem or $host =~ /(not found|timed out)/) {
    $iana->whois_query(-ip=>$ip);

    my $inetnum  = $iana->inetnum || '';
    my $custname = $iana->{QUERY}->{custname} || '';
    my $orgname  = $iana->{QUERY}->{orgname}  || '';

    next unless $inetnum 
    and ($problem or $custname or $orgname);

    if ($custname =~ /($bye)/i or $orgname =~ /($bye)/i){
      my $mask = Net::Netmask->new($inetnum);
      `iptables -A INPUT -s $mask -j DROP`;
    }
  }
}
untie %seen;
[download]