#!/usr/local/bin/perl -w
# .dk-bot 1.2
# (c) 2001 Mads Peter Bach
# released under the GPL.
# could probably be done much smarter.

use Socket;
use LWP::UserAgent;
use Parallel::ForkManager;
# Found it on Freshmeat, I think.
$MAX_PROCESSES = 20;
open(ZONES, "<domains.txt") or die;
my(@zones) = <ZONES>;
close ZONES;

my($chunksize) = (scalar @zones / $MAX_PROCESSES);


$pm = new Parallel::ForkManager($MAX_PROCESSES);
$forks = 0;
for($forks = 0 ; $forks < $MAX_PROCESSES; $forks++) {
    my(@domains) = @zones[($forks * $chunksize) .. ((($forks+1) * $chunksize)-1)];
    $pm->start and next;
    $ua = LWP::UserAgent->new;
    $ua->timeout(120);
    $ua->agent(".dk-bot/1.2 (http://logout.sh/domain/; webserver survey; " . $ua->agent .')');
    my($pid) = $$;
    $| = 1;
    my(%register);
    my($base);
    my($www);
    my($ip);
    my($prefix);
    my($server);
    while ($domain = shift @domains) {
	chomp $domain;
	$base = gethostbyname($domain);
	$www = gethostbyname('www.'.$domain);
	$ip = '';
	$server = '';
	if($www) {
	    $ip = inet_ntoa($www);
	    $prefix = 'www.';
	} else {
	    if($base) {
		$ip = inet_ntoa($base);
		$prefix = '';
	    }
	}
	if(length($ip) > 7) {

	    if((!(%register->{$ip})) or ((%register->{$ip} =~ m/IIS/) and (!(%register->{$ip} =~ m/PHP/)))) {
		$request = HTTP::Request->new('HEAD', "http://$prefix$domain/");
		$result = $ua->request($request);
		if($result->is_success) {

		    if($result->headers->{'server'}) {
			$server = $result->headers->{'server'};
			if(($result->headers->{'x-powered-by'}) and (!($server =~ m/PHP/))) {
			    $server .= ' ' . $result->headers->{'x-powered-by'};
			}
			
		    } else {
			$server = 'No server header';
		    }
		    if(($result->headers->{'servlet-engine'}) and (!($server =~ m/JSP/))) {
			$server .= ' ' . $result->headers->{'servlet-engine'};
		    }
		    %register->{$ip} = $server;
		} else {
		    %register->{$ip} = 'No response';
		    $server = 'No response';
		}
	    } else {
		$server = %register->{$ip};
	    }
	    print "$prefix$domain\t$server\t$ip\n";
	}
    }
    $pm->finish;
}
$pm->wait_all_children;