#!/usr/bin/perl 

# by Simon Josefsson 2001-11-19
# (collected scripts, written since 2000-06 or so)
# $Id: dnssurvey.pl,v 1.30 2002/12/28 14:03:07 jas Exp $

use strict;
use DBI;
require HTTP::Request;
require LWP::UserAgent;
require Net::DNS;

my ($cmd) = shift;
my ($tmpfile) = "/tmp/tmp.$$";
my $dsn = "DBI:Pg:dbname=dns";
my $user = "jas";
my $passwd = "";

my ($DBNAME) = "dns";
my ($DB) = qq{
CREATE TABLE entries (
	zone    TEXT NOT NULL,
	soa     INT NOT NULL,
	year    INT NOT NULL,
	month   INT NOT NULL,
	day     INT NOT NULL,
        PRIMARY KEY (zone, soa)
);

CREATE TABLE mx (
	zone	TEXT NOT NULL,
	soa	INT NOT NULL,
	domain	TEXT NOT NULL,
	prio	INT NOT NULL,
	server	TEXT NOT NULL
);

CREATE TABLE ns (
	zone	TEXT NOT NULL,
	soa	INT NOT NULL,
	domain	TEXT NOT NULL,
	server	TEXT NOT NULL
);

CREATE TABLE a (
	zone	TEXT NOT NULL,
	soa	INT NOT NULL,
	domain	TEXT NOT NULL,
	ip	INET NOT NULL
);

CREATE TABLE smtpprg (
       name  TEXT NOT NULL
);

CREATE TABLE http (
       domain  TEXT,
       PRIMARY KEY (domain)
);

CREATE TABLE httpaddress (
       domain  TEXT,
       ip      INET,
       error   TEXT,
       probed  TIMESTAMP DEFAULT now()
);

CREATE TABLE httphost (
       ip      INET,
       port    INT,
       probed  TIMESTAMP DEFAULT now(),
       error   TEXT,
       server  TEXT
);

CREATE TABLE dnsprg (
       name  TEXT NOT NULL
);

CREATE TABLE smtphost (
	probed	TIMESTAMP NOT NULL,
	ip	INET NOT NULL,
	dnsprg	TEXT NOT NULL
);

CREATE TABLE dnshost (
	probed	TIMESTAMP NOT NULL,
	ip	INET NOT NULL,
	dnsprg	TEXT NOT NULL
);
};

if (! $cmd) {
    print qq{Usage:
  $0 initdb                  Initialize Database
  $0 addindex                Add indices
  $0 dropindex               Drop indices
  $0 zap <zone> <soa>        Zap all data related to ZONE,SOA
  $0 readzone [file ...]     Read zone file into database
  $0 zonedump [file ...]     Print parsed zone to stdout
  $0 seoverview              Generate .se Overview
  $0 topdns <zone> [soa]     Generate top-20 list for zone
  $0 alldns <zone> [soa]     Generate top-INF list for zone
  $0 pie <zone> [soa]        Generate top-20 table/piechart of DNS servers
  $0 pierest <zone> [soa]    Generate top-INF table/piechart of DNS servers
  $0 latestsoa [zone] [soa]  Get latest soa for zone, or info about soa
  $0 addhttp <domain>        Schedule a new domain for HTTP querying
  $0 addhttp <zone> [soa]    Schedule alot of domains for HTTP querying
  $0 delhttp <domain>        Remove a HTTP server from query schedule (XXX)
  $0 httpaddress [domain]    Find addresses for HTTP all servers (one server)
  $0 queryhttp [domain]      Query for server info from all server (one server)
};
    exit;
}

sub initdb {
    system("createdb $DBNAME");
    open FD, ">$tmpfile" or die;
    print FD $DB;
    close FD;
    system("psql $DBNAME < $tmpfile");
    unlink $tmpfile;
    exit;
}

sub zap {
    my ($zone) = shift @ARGV;
    my ($soa) = shift @ARGV;
    my ($i);

    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;

    print "DELETE FROM mx WHERE zone = '$zone' AND soa = '$soa'\n";
    $i = $dbh->do("DELETE FROM mx WHERE zone = '$zone' AND soa = '$soa'");
    print "$i rows affected.\n";
    print "DELETE FROM ns WHERE zone = '$zone' AND soa = '$soa'\n";
    $i = $dbh->do("DELETE FROM ns WHERE zone = '$zone' AND soa = '$soa'");
    print "$i rows affected.\n";
    print "DELETE FROM a WHERE zone = '$zone' AND soa = '$soa'\n";
    $i = $dbh->do("DELETE FROM a WHERE zone = '$zone' AND soa = '$soa'");
    print "$i rows affected.\n";
    print "DELETE FROM entries WHERE zone = '$zone' AND soa = '$soa'\n";
    $i = $dbh->do("DELETE FROM entries WHERE zone = '$zone' AND soa = '$soa'");
    print "$i rows affected.\n";

    $dbh->disconnect;
}

sub readzone {
    my ($file, $soa, $when, $origin, $nsoa, $nlines, $totallines);
    my ($tmp, $tmp2);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
    my ($dbh) = DBI->connect($dsn, $user, $passwd, { AutoCommit => 0 })
	or die DBI->errstr;
    my ($domain, $lastdomain, $ttl, $class, $type, $extra, $ip, $prio, $host);
    my ($in_soa) = 0;
    my ($soatype) = 0;

    while ($file = shift @ARGV) {
	print "Reading $file...\n";
	$soa = "";
	# find SOA and WHEN
	open FD, $file or die;
	$nsoa = 0; # we want 2
	$nlines = 0;
	while (<FD>) {
	    $nlines++;
	    if (($tmp) = m,^\$ORIGIN (.*)$,) {
		$origin = $tmp;
		print "set origin to $origin\n";
		next;
	    }
	    if (($tmp) = m,^\s+(\d+)\s+; serial$,) {
		die "duplicate soa $tmp and $soa" if ($soa && $soa != $tmp);
		$soa = $tmp;
		$nsoa++;
		print "found old soa $soa number $nsoa\n";	
		die "already set soatype? $soatype" if $soatype != 0 && $soatype != 1;
		$soatype = 1;
		next;
	    }
            # se.                     86400   IN      SOA     catcher-in-the-rye.nic-se.se. registry.nic-se.se. 2001081801 7200 3600 2419200 86400
	    if (($tmp, $tmp2) = m,^(\S+)\s+\d+\s+IN\s+SOA\s+\S+\s+\S+\s+(\d+)\s+\d+\s+\d+\s+\d+\s+\d+$,) {
		die "duplicate soa $tmp and $soa" if ($soa && $soa != $tmp2);
		$soa = $tmp2;
		$nsoa++;
		die "origin $origin with new dig format??" if ($origin && $origin != $tmp);
		$origin = $tmp;
		print "set origin to $origin\n";
		print "found new soa $soa number $nsoa\n";
		die "already set soatype? $soatype" if $soatype != 0 && $soatype != 2;
		$soatype = 2;
		next;
	    }

	    if (($tmp) = m,^;; WHEN: (.*)$,) {
		$when = $tmp;
		$tmp = `date --date="$tmp" +%s`;
		($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
		    localtime($tmp);
		$year += 1900;
		$mon++;
		print "found date $when\n";
		next;
	    }

	    next if m,^;,;
	    die "excess data after second SOA?\n$_" if ($nsoa >= 2 && (($domain, $ttl, $class, $type, $extra) = m,^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*),));
	}
	close FD;
	$totallines = $nlines;

	# sanity checks
	die "no when? $when" unless $when;
	die "Trashed zone file (cannot find two SOA records)..." unless $nsoa == 2;
	die "no soatype?? $soatype" unless $soatype == 1 || $soatype == 2;
	die "File already read, use \"zap $origin $soa\" to delete it" 
	    if ($dbh->do("SELECT * FROM entries WHERE zone = '$origin' AND soa = '$soa'") > 0);
#	die "File already read (MX!), use \"zap $origin $soa\"" 
#	    if ($dbh->do("SELECT * FROM mx WHERE zone = '$origin' AND soa = '$soa'") > 0);
#	die "File already read (A!), use \"zap $origin $soa\"" 
#	    if ($dbh->do("SELECT * FROM a WHERE zone = '$origin' AND soa = '$soa'") > 0);
#	die "File already read (NS!), use \"zap $origin $soa\"" 
#	    if ($dbh->do("SELECT * FROM ns WHERE zone = '$origin' AND soa = '$soa'") > 0);

	print "Inserting entry for zone $origin with SOA $soa from $year-$mon-$mday...\n";
	$tmp = sprintf "INSERT INTO entries (zone, soa, year, month, day) VALUES ('%s', '%s', '%s', '%s', '%s')", $origin, $soa, $year, $mon, $mday;
	print "$tmp\n";
	die "error inserting entry" unless $dbh->do($tmp);
# why doesn't the following work???!   It used to
#	$dbh->do("INSERT INTO entries (zone, soa, year, month, day) VALUES (?, ?, ?, ?, ?)", undef, $origin, $soa, $year, $mon, $mday);
	print "done\n";

	open A, ">$tmpfile.a" or die;
	print A "COPY \"a\" FROM stdin;\n";
	open MX, ">$tmpfile.mx" or die;
	print MX "COPY \"mx\" FROM stdin;\n";
	open NS, ">$tmpfile.ns" or die;
	print NS "COPY \"ns\" FROM stdin;\n";

	open FD, $file or die;
	$nlines = 0;
	while (<FD>) {
	    chop;
	    next if m/^$/;
	    next if m/^;/;
	    
	    $nlines++;
	    if (($nlines % 1000) == 0) {
		printf "Read %2.2f %%...\r", 100 * ($nlines / $totallines);
	    }

	    if ($in_soa && m,\),) {
		print "leave soa\n";
		$in_soa = 0;
		next;
	    } elsif ($in_soa) {
		next;
	    }

	    if (m,^\$ORIGIN,) {
		($tmp) = m,^\$ORIGIN (.*)$,;
		print "origin set to $tmp\n";
		die "origin missmatch? tmp $tmp origin $origin" unless $tmp == $origin;
		next;
	    }

	    if (m, IN SOA\t,) {
		print "in soa\n";
		$in_soa = 1;
		$lastdomain = $origin;
		next;
	    }

	    if (m,IN\tSOA,) {
		next;
	    }

#	    print $_, "\n";
	    
	    unless (($domain, $ttl, $class, $type, $extra) = m,^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*),) {
		($ttl, $class, $type, $extra) = m,^\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*), or
		    die "bad regexp";
		$domain = $lastdomain;
	    }
	    if ($domain eq "@") {
		$domain = $origin;
	    } elsif (substr($domain, -1) ne ".") {
		$domain = $domain . "." . $origin;
	    }
	    die "urk" unless $domain;
    
	    if ($type eq "MX") {
		$_ = $extra;
		($prio, $host) = m,(\S+)\s+(\S+),;
		if (substr($host, -1) ne ".") {
		    $host = $host . "." . $origin;
		}
#		print "Inserting mail exchange, zone=$origin, soa=$soa, domain=$domain prio=$prio, server=$host\n";
#		$dbh->do("INSERT INTO mx (zone, soa, domain, prio, server) VALUES ('$origin', '$soa', '$domain', '$prio', '$host')");
		print MX "$origin\t$soa\t$domain\t$prio\t$host\n";
	    } elsif ($type eq "NS") {
		$host = $extra;
		if (substr($host, -1) ne ".") {
		    $host = $host . "." . $origin;
		}
#		print "Inserting nameserver, zone=$origin, soa=$soa, domain=$domain server=$host\n";
#		$dbh->do("INSERT INTO ns (zone, soa, domain, server) VALUES ('$origin', '$soa', '$domain', '$host')");
		print NS "$origin\t$soa\t$domain\t$host\n";
	    } elsif ($type eq "A") {
		$ip = $extra;
#		print "Inserting IP address, zone=$origin, soa=$soa, domain=$domain ip=$ip\n";
#		$dbh->do("INSERT INTO a (zone, soa, domain, ip) VALUES ('$origin', '$soa', '$domain', '$ip')");
		print A "$origin\t$soa\t$domain\t$ip\n";
	    } elsif ($type eq "TXT" && $extra == "\"Non-NS data is removed\"") {
	    } elsif ($type eq "TXT" && $extra == "\"See <http://www.nic-se.se/meddelanden/datapekare/>\"") {
	    } elsif ($type eq "CNAME" && $extra == "spider.nic-se") {
	    } else {
		print "\nWhat's this?\ndomain $domain\tttl $ttl\tclass $class\ttype $type\textra $extra\n";
	    }

	    $lastdomain = $domain;
	}
	print A "\\.\n";
	print MX "\\.\n";
	print NS "\\.\n";
	close A;
	close MX;
	close NS;

	print "Storing into database... A records\n";
	system("psql dns < $tmpfile.a");
	print "Storing into database... NS records\n";
	system("psql dns < $tmpfile.ns");
	print "Storing into database... MX records\n";
	system("psql dns < $tmpfile.mx");

	unlink($tmpfile . ".a");
	unlink($tmpfile . ".ns");
	unlink($tmpfile . ".mx");

	print "Read file $file OK...\n";
    }

    $dbh->commit || die $dbh->errstr;
    $dbh->disconnect;
}

sub seoverview {
    my ($sth);
    my ($dbh) = DBI->connect($dsn, $user, $passwd, { AutoCommit => 0 })
	or die DBI->errstr;
    my (@data);
    my ($total);
    my ($year, $month, $day);
    my ($lastmonth);
    my ($setotal) = "/tmp/se-total.rrd";
    my ($setotal2) = "/tmp/se-total2.rrd";
    my ($startdate) = `date --date="Jul 23 00:00:00 2000" +%s`;
    chop $startdate;
    $startdate--;
    my ($enddate) = `date +%s`; chop $enddate;
    my ($step) = 24*60*60;
    my ($zone) = 'se.';
    my ($maxsoa) = pop @ARGV;

    $sth = $dbh->prepare("SELECT soa, year, month, day FROM entries WHERE zone = '$zone' " . ($maxsoa ? "AND soa = '$maxsoa' " : "") . "ORDER BY soa DESC");
    $sth->execute();
    ($maxsoa,$year,$month,$day) = $sth->fetchrow_array();
    $enddate = `date --date=$year-$month-$day +%s`; chop $enddate;
    die "No such SOA" unless $maxsoa;

    my ($ndelta) = int (($enddate - $startdate) / $step)+1;

    print "<table border=1 cellspacing=0>\n\n";
    print "<tr>\n";
    print "<td>Datum</td>\n";
    print "<td align=center>Totalt<br>antal<br>delegerade<br>domäner</td>\n";
    print "<td align=center>Antal<br>delegerade<br><a href=\"http://www.nic-se.se/faq1.shtml#48\">pp-domäner</a></td>\n";
    print "<td align=center>Antal<br>delegerade<br><a href=\"http://www.nic-se.se/faq1.shtml#35\">varumärken</a></td>\n";
    print "<td align=center>Antal<br>delegerade<br><a href=\"http://www.iis.se/regler_app3.shtml\">länsdomäner</a></td>\n";
    print "</tr>\n";
    print "<tr><td></td>\n";
    print "<td></td>\n";
    print "<td></td>\n";
    print "<td></td>\n";
    print "<td></td>\n";
    $sth = $dbh->prepare("SELECT DISTINCT year,month FROM entries WHERE zone = '$zone' and soa <= '$maxsoa'");
    $total = $sth->execute();
    print "<td rowspan=", $total + 2, ">\n";
    print "<img src=\"se-total.png\"><br><img src=\"se-total2.png\"></td>\n";
    print "</tr>\n";

    system("rm -f $setotal");
    system("rrdtool create $setotal --start $startdate --step $step DS:domains:GAUGE:$step:U:U RRA:AVERAGE:0.5:1:$ndelta");
    system("rm -f $setotal2");
    system("rrdtool create $setotal2 --start $startdate --step $step DS:pp:GAUGE:$step:U:U DS:tm:GAUGE:$step:U:U DS:county:GAUGE:$step:U:U RRA:AVERAGE:0.5:1:$ndelta");

    $sth = $dbh->prepare("SELECT * FROM entries WHERE zone = '$zone' AND soa <= $maxsoa ORDER BY year, month, day");
    $sth->execute();
    while (@data = $sth->fetchrow_array()) {
	my ($zone, $soa, $year, $month, $day) = @data;
	my ($rv, $sth2);
	my ($pptotal, $tmtotal, $countytotal);

	$sth2 = $dbh->prepare("SELECT COUNT(DISTINCT domain) FROM ns WHERE zone = '$zone' AND soa = '$soa'");
	$rv = $sth2->execute();
	$total = $sth2->fetchrow_array;
	$sth2->finish();

	my ($date) = `date --date=\"$year-$month-$day\" +%s`; chop $date;
	system("rrdtool update $setotal $date:$total");

	if ($month != $lastmonth) {
	    printf "\n<tr><td>%04d-%02d-%02d</td>\n", $year, $month, $day;
	    print "<td align=right>$total</td>\n";
	}

	$sth2 = $dbh->prepare("SELECT COUNT(DISTINCT domain) FROM ns WHERE zone = '$zone' AND soa = '$soa' AND domain LIKE '%.pp.se.'");
	$rv = $sth2->execute();
	$pptotal = $sth2->fetchrow_array;
	$sth2->finish();

	if ($month != $lastmonth) {
	    print "<td align=right>$pptotal</td>\n";
	}

	$sth2 = $dbh->prepare("SELECT COUNT(DISTINCT domain) FROM ns WHERE zone = '$zone' AND soa = '$soa' AND domain LIKE '%.tm.se.'");
	$rv = $sth2->execute();
	$tmtotal = $sth2->fetchrow_array;
	$sth2->finish();

	if ($month != $lastmonth) {
	    print "<td align=right>$tmtotal</td>\n";
	}

	$sth2 = $dbh->prepare("SELECT COUNT(DISTINCT domain) FROM ns WHERE zone = '$zone' AND soa = '$soa' AND (domain LIKE '%.k.se.' OR domain LIKE '%.i.se.' OR domain LIKE '%.x.se.' OR domain LIKE '%.n.se.' OR domain LIKE '%.z.se.' OR domain LIKE '%.f.se.' OR domain LIKE '%.h.se.' OR domain LIKE '%.w.se.' OR domain LIKE '%.g.se.' OR domain LIKE '%.bd.se.' OR domain LIKE '%.m.se.' OR domain LIKE '%.a.se.' OR domain LIKE '%.d.se.' OR domain LIKE '%.c.se.' OR domain LIKE '%.s.se.' OR domain LIKE '%.ac.se.' OR domain LIKE '%.y.se.' OR domain LIKE '%.u.se.' OR domain LIKE '%.o.se.' OR domain LIKE '%.t.se.' OR domain LIKE '%.e.se.' OR domain LIKE '%.l.se.' OR domain LIKE '%.r.se.' OR domain LIKE '%.p.se.')");
	$rv = $sth2->execute();
	$countytotal = $sth2->fetchrow_array;
	$sth2->finish();

	if ($month != $lastmonth) {
	    print "<td align=right>$countytotal</td>\n";
	    print "</tr>\n";
	}

	system("rrdtool update $setotal2 --template pp:tm:county $date:$pptotal:$tmtotal:$countytotal");

	$lastmonth = $month;
    }
    $sth->finish();

    print "</table>\n";
    printf "<i>Aktuell per %04d-%02d-%02d.</i>\n", $year, $month, $day;

    system("rrdtool graph se-total.png --start $startdate --end $enddate DEF:domains=${setotal}:domains:AVERAGE LINE2:domains#FF0000:\"Totalt antal\" --title=\"Svensk domänstatistik - http://josefsson.org/dns/\" > /dev/null");
    system("rrdtool graph se-total2.png --start $startdate --end $enddate DEF:pp=${setotal2}:pp:AVERAGE LINE2:pp#FF0000:\"Antal pp.se-domäner\" DEF:tm=${setotal2}:tm:AVERAGE LINE2:tm#00FF00:\"Antal tm.se-domäner\" DEF:county=${setotal2}:county:AVERAGE LINE2:county#0000FF:\"Antal länsdomäner\" --title=\"Svensk domänstatistik - http://josefsson.org/dns/\" > /dev/null");
    $dbh->disconnect;
}

sub zonedump {
    my ($origin);
    my ($domain, $lastdomain, $ttl, $class, $type, $extra, $ip, $prio, $host);
    my ($in_soa) = 0;

    while (<>) {
	chop;
	next if m/^$/;
	next if m/^;/;
	
	if ($in_soa && m,\),) {
	    $in_soa = 0;
	    next;
	} elsif ($in_soa) {
	    next;
	}
	
	if (m,^\$ORIGIN,) {
	    ($origin) = m,^\$ORIGIN (.*)$,;
	    print "origin set to $origin\n";
	    next;
	}
	
	if (m, IN SOA\t,) {
	    $in_soa = 1;
	    $lastdomain = $origin;
	    next;
	}
	
	#print $_, "\n";
	
	unless (($domain, $ttl, $class, $type, $extra) = m,^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*),) {
	    ($ttl, $class, $type, $extra) = m,^\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*), or
		die "bad regexp";
	    $domain = $lastdomain;
	}
	if ($domain eq "@") {
	    $domain = $origin;
	} elsif (substr($domain, -1) ne ".") {
	    $domain = $domain . "." . $origin;
	}
	die "urk" unless $domain;
	
	#print "domain $domain\tttl $ttl\tclass $class\ttype $type\textra $extra\n";
	
	if ($type eq "MX") {
	    $_ = $extra;
	    ($prio, $host) = m,(\S+)\s+(\S+),;
	    if (substr($host, -1) ne ".") {
		$host = $host . "." . $origin;
	    }
	    print "mx for domain $domain is host $host with prio $prio\n";
	} elsif ($type eq "NS") {
	    $host = $extra;
	    if (substr($host, -1) ne ".") {
		$host = $host . "." . $origin;
	    }
	    print "ns for domain $domain is host $host\n";
	} elsif ($type eq "A") {
	    $ip = $extra;
	    print "ip for domain $domain is $ip\n";
	}
	
	$lastdomain = $domain;
    }
}

sub printzone {
    my ($origin);
    my ($domain, $lastdomain, $ttl, $class, $type, $extra, $ip, $prio, $host);
    my ($in_soa) = 0;
    my (@nsdomains, @mxdomains);

    while (<>) {
	chop;
	next if m/^$/;
	next if m/^;/;
	
	if ($in_soa && m,\),) {
	    $in_soa = 0;
	    next;
	} elsif ($in_soa) {
	    next;
	}
	
	if (m,^\$ORIGIN,) {
	    ($origin) = m,^\$ORIGIN (.*)$,;
	    #print "origin set to $origin\n";
	    next;
	}
	
	if (m, IN SOA\t,) {
	    $in_soa = 1;
	    $lastdomain = $origin;
	    next;
	}
	
	#print $_, "\n";
	
	unless (($domain, $ttl, $class, $type, $extra) = m,^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*),) {
	    ($ttl, $class, $type, $extra) = m,^\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*), or
		die "bad regexp";
	    $domain = $lastdomain;
	}
	if ($domain eq "@") {
	    $domain = $origin;
	} elsif (substr($domain, -1) ne ".") {
	    $domain = $domain . "." . $origin;
	}
	die "urk" unless $domain;
	
	#print "domain $domain\tttl $ttl\tclass $class\ttype $type\textra $extra\n";
	
	if ($type eq "MX") {
	    $_ = $extra;
	    ($prio, $host) = m,(\S+)\s+(\S+),;
	    if (substr($host, -1) ne ".") {
		$host = $host . "." . $origin;
	    }
	    #print "mx for domain $domain is host $host with prio $prio\n";
	    push @mxdomains, $domain;
	} elsif ($type eq "NS") {
	    $host = $extra;
	    if (substr($host, -1) ne ".") {
		$host = $host . "." . $origin;
	    }
	    #print "ns for domain $domain is host $host\n";
	    push @nsdomains, $domain;
	} elsif ($type eq "A") {
	    $ip = $extra;
	    #print "ip for domain $domain is $ip\n";
	}
	
	$lastdomain = $domain;
    }
    
    my ($i);
    
    $lastdomain = "FNORD";
    $i = 0;
    foreach $domain (sort @nsdomains) {
	if ($lastdomain ne $domain) {
	    print "ns $domain\n";
	    $i++;
	}
	$lastdomain = $domain;
    }
    
    print "total ns $i\n";
    
    $lastdomain = "FNORD";
    $i = 0;
    foreach $domain (sort @mxdomains) {
	if ($lastdomain ne $domain) {
	    print "mx $domain\n";
	    $i++;
	}
	$lastdomain = $domain;
    }
    
    print "total mx $i\n";
}

sub addindex {
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    $dbh->do("CREATE INDEX mx_index_zone_soa ON mx (zone, soa)");
    $dbh->do("CREATE INDEX ns_index_zone_soa ON ns (zone, soa)");
    $dbh->do("CREATE INDEX a_index_zone_soa ON a (zone, soa)");
    $dbh->do("CREATE INDEX httpprg_index_domain ON httpprg (domain)");
    $dbh->disconnect;
}

sub dropindex {
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    $dbh->do("DROP INDEX mx_index_zone_soa");
    $dbh->do("DROP INDEX ns_index_zone_soa");
    $dbh->do("DROP INDEX a_index_zone_soa");
    $dbh->do("DROP INDEX a_index_domain");
    $dbh->disconnect;
}

my ($how_many_dns) = 60;

sub alldns {
    $how_many_dns = -1;
    topdns();
}

sub topdns {
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    my ($sth);
    my ($zone) = shift @ARGV;
    my ($soa) = shift @ARGV;
    my (@data);
    my ($year, $month, $day);
    my ($i);
    my ($rows) = 20;

    die "No zone specified" unless $zone;

    $sth = $dbh->prepare("SELECT soa,year,month,day FROM entries WHERE zone = '$zone' " . ($soa ? "AND soa = '$soa' " : "") . "ORDER BY soa DESC");
    $sth->execute();
    ($soa,$year,$month,$day) = $sth->fetchrow_array();

    $sth = $dbh->prepare("SELECT LOWER(server),COUNT(server) FROM ns WHERE zone = '$zone' AND soa = '$soa' GROUP BY LOWER(server) ORDER BY COUNT(server) DESC, LOWER(server)");
    $sth->execute();

    print "<table border=1 cellspacing=0>\n\n";
    print "<tr>\n";
    do {	
	print "<td><b>Placering</b></td>\n";
	print "<td><b>Server</b></td>\n";
	print "<td><b>Antal domäner</b></td>\n";
    } while (++$i < $how_many_dns / $rows);

    print "</tr>\n";

    if ($how_many_dns == -1) {
	$i = 1;
	while (@data = $sth->fetchrow_array()) {
	    my ($server, $count) = @data;
	    
	    print "<tr>\n";
	    print "<td align=right>$i</td>\n";
	    print "<td align=right>$server</td>\n";
	    print "<td align=right>$count</td>\n";
	    print "</tr>\n";

	    $i++;
	}
    } else {
	my (%server, %count);

	$i = 1;
	while (@data = $sth->fetchrow_array()) {
	    my ($server, $count) = @data;
	    
	    $server{$i} = $server;
	    $count{$i} = $count;

	    last if ($i >= $how_many_dns);
	    $i++;
	}
	
	$i = 1;
	while (@data = $sth->fetchrow_array()) {
	    my ($server, $count) = @data;

	    print "<tr>\n";

	    my ($j) = 0;
	    while ($server{$j*$rows+$i}) {
		print "<td align=right>", $j*$rows+$i, "</td>\n";
		print "<td align=right>", $server{$j*$rows+$i}, "</td>\n";
		print "<td align=right>", $count{$j*$rows+$i}, "</td>\n";
		$j++;
	    }
	    print "</tr>\n";

	    last if ($i >= $rows);
	    $i++;
	}
	
    }
    print "</table>\n";
    printf "<i>Aktuell per %04d-%02d-%02d.</i>\n", $year, $month, $day;

    $sth->finish;
    $dbh->disconnect;
}

my ($operator_dns_base_file) = "dnssurvey.dns-";

my ($how_many_operators) = 20;

sub pierest {
    $how_many_operators = -1;
    pie();
}

sub pie {
    my ($zone) = shift @ARGV;
    my ($soa) = shift @ARGV;

    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    my ($sth);
    my (%servers);
    my (%ndomains);
    my ($key);
    my ($year, $month, $day);
    my ($rv, $total);
    my (@data);
    my ($chartbasefile) = (substr $zone, 0, -1) . "-operators";

    open FD, $operator_dns_base_file . $zone
	or die "Can't open $operator_dns_base_file$zone";

    while (<FD>) {
	chop;
	my (@data) = split / /;
	my ($name) = shift @data;

	$servers{$name} = \@data;
    }
    close FD;
    
    if ($how_many_operators != -1) {
	open FD, ">$chartbasefile.pl"
	    or die "Can't open $chartbasefile.pl";

	print FD "#proc page\n";
	print FD "scale: 2.0\n";
	print FD "tightcrop: yes\n";
	print FD "\n";
	print FD "#proc getdata\n";
	print FD "data:\n";
    }

    $sth = $dbh->prepare("SELECT soa,year,month,day FROM entries WHERE zone = '$zone' " . ($soa ? "AND soa = '$soa' " : "") .  "ORDER BY soa DESC");
    $sth->execute();
    ($soa,$year,$month,$day) = $sth->fetchrow_array();
    $sth->finish;

    die "SOA not found in DB" unless $soa;

    print "<table border=1 cellspacing=0>\n";
    print "<tr>\n";
    print "<td><b>Namn</b></td>\n";
    print "<td><b>Antal domäner</b></td>\n";
    if ($how_many_operators != -1) {
	print "<td></td>\n";
	print "<tr>\n";
	print "<td></td>\n";
	print "<td></td>\n";
	print "<td rowspan=", $how_many_operators + 4, ">\n";
	print "<img src=\"$chartbasefile.png\"></td>\n";
    }
    print "</tr>\n";

    my ($notsqlstr) = "TRUE";
    foreach $key (sort keys %servers) {
	my (@data) = @{$servers{$key}};

	my ($entry);
	my ($sqlstr) = "FALSE";
	while ($entry = pop @data) {
	    $sqlstr .= " OR server LIKE '$entry'";
	    $notsqlstr .= " AND server NOT LIKE '$entry'";
	}

	$sth = $dbh->prepare("SELECT COUNT(DISTINCT domain) FROM ns WHERE zone = '$zone' AND soa = '$soa' and ($sqlstr)");
	$rv = $sth->execute();
	$total = $sth->fetchrow_array;
	$sth->finish;

	$ndomains{$key} = $total;

    }

    $sth = $dbh->prepare("SELECT COUNT(DISTINCT domain),server FROM ns WHERE zone = '$zone' AND soa = '$soa' and ($notsqlstr) GROUP BY server ORDER BY count(DISTINCT domain) DESC");
    $rv = $sth->execute();
    while (@data = $sth->fetchrow_array) {
	my ($count, $server) = @data;

	$ndomains{$server} = $count;
    }
    
    my ($i) = 0;
    my ($sofar) = 0;
    foreach $key (sort { $ndomains{$b} <=> $ndomains{$a} } keys %ndomains) {
	my ($total) = $ndomains{$key};
	$i++;

	last if ($how_many_operators != -1 && $i > $how_many_operators);

	$sofar += $total;

	print "<tr>\n";
	print "<td>$key</td>\n";
	print "<td>$total</td>\n";
	print "</tr>\n";

	if ($how_many_operators != -1) {
	    print FD "$key $total\n";
	}
    }

    $sth = $dbh->prepare("SELECT COUNT(DISTINCT domain) FROM ns WHERE zone = '$zone' AND soa = '$soa'");
    $rv = $sth->execute();
    $total = $sth->fetchrow_array;
    $sth->finish;

    print "<tr>\n";
    print "<td>Övriga</td>\n";
    print "<td>", $total-$sofar, "</td>\n";
    print "</tr>\n";

    print "<tr>\n";
    print "<td>Totalt</td>\n";
    print "<td>$total</td>\n";
    print "</tr>\n";
    print "</table>\n";
    printf "<i>Aktuell per %04d-%02d-%02d.</i>\n", $year, $month, $day;

    if ($how_many_operators != -1) {
	print FD "Övriga ", $total-$sofar, "\n";
	print FD "\n";

	print FD "#proc pie\n";
	print FD "datafield: 2\n";
	print FD "labelfield: 1\n";
	print FD "labelfarout: 1.2\n";
	print FD "firstslice: 65\n";
	print FD "labelmode: line+label\n";
	print FD "outlinedetails: width=0.1\n";
	print FD "center: 2 2\n";
	print FD "textdetails: size=4 style=R\n";
	print FD "radius: 1.0\n";
	print FD "colors: dullyellow drabgreen pink powderblue lavender\n";
	print FD "\n";
	print FD "#proc annotate\n";
	print FD "location: 2.0 3.1\n";
	print FD "textdetails: size=8 style=B\n";
	print FD "text: Svensk domänstatistik - http://josefsson.org/dns/\n";
	print FD "\n";

	close FD;

	system("ploticus -png $chartbasefile.pl");
    }

    $dbh->disconnect;
}

sub addhttp {
    my ($param) = shift @ARGV;
    my ($soa) = shift @ARGV;
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    my ($sth);
    my (@data);

    if ($soa) {
      $sth = $dbh->prepare("SELECT DISTINCT domain FROM ns WHERE zone = '$param' AND soa = '$soa'");
      $sth->execute();
      while (@data = $sth->fetchrow_array()) {
	my ($domain) = @data;

	$dbh->do("INSERT INTO http (domain) VALUES (?)", undef, $domain);
      }
      $sth->finish();
    } else {
      my ($domain) = $param;

      $dbh->do("INSERT INTO http (domain) VALUES (?)", undef, $domain);
    }
    $dbh->disconnect;
}

sub delhttp {
    my ($domain) = shift @ARGV;
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    my ($sth);

    # XXX No integrity check in httpaddress or httphost

    $dbh->do("DELETE FROM http WHERE domain = ?", undef, $domain);
    $dbh->disconnect;
}

sub httpaddress {
    my ($domain) = shift @ARGV;
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    my ($sth);
    my (@data);
    my ($res) = new Net::DNS::Resolver;

    $sth = $dbh->prepare("SELECT domain FROM http" . ($domain ? " WHERE domain = '$domain'" : ""));
    $sth->execute();
    while (@data = $sth->fetchrow_array()) {
      my ($domain) = @data;

      foreach $domain ($domain, "www." . $domain) {
	my ($query) = $res->search($domain);
	if (!$query) {
	  print "No such domain $domain\n";
	  $dbh->do("INSERT INTO httpaddress (domain, error) VALUES (?, ?)", undef, $domain, $res->errorstring);
	  next;
	}

	my ($rr);
	foreach $rr ($query->answer) {
	  next unless $rr->type eq "A";
	  my ($ip) = $rr->address;
	  print "Added address $ip for $domain\n";
	  $dbh->do("INSERT INTO httpaddress (domain, ip) VALUES (?, ?)", undef, $domain, $ip);
	  next;
	}
      }
    }
    $sth->finish();
    $dbh->disconnect;
}

sub queryhttp {
  my ($domain) = shift @ARGV;
  my ($dbh) = DBI->connect($dsn, $user, $passwd)
    or die DBI->errstr;
  my ($sth);
  my (@data);
  my ($ua) = LWP::UserAgent->new;
  $ua->agent("");

  $sth = $dbh->prepare("SELECT ip FROM httpaddress WHERE ip IN (SELECT DISTINCT ip FROM httpaddress WHERE NOT ip = NULL" . ($domain ? " AND domain = '$domain'" : "") . ") ORDER BY probed");
  $sth->execute();
  while (@data = $sth->fetchrow_array()) {
    my ($ip) = @data;
    my ($port) = 80;
    my ($request);
    my ($response);
    my ($server);

    $request = HTTP::Request->new(HEAD => "http://$ip:$port/");
    $response = $ua->simple_request($request);

    if (!$response->headers->header('Server')) {
      print "$ip:$port failed: ", $response->code, " ", $response->message, "\n";
      $dbh->do("INSERT INTO httphost (ip, port, error) VALUES (?, ?, ?)", undef, $ip, $port, $response->code . " " . $response->message);
      next;
    }

    $server = $response->headers->header('Server');

    print "$ip:$port ok: ", $server, "\n";
    $dbh->do("INSERT INTO httphost (ip, port, server) VALUES (?, ?, ?)", undef, $ip, $port, $server);
  }
  $sth->finish;
  $dbh->disconnect;
}

sub latestsoa {
    my ($zone) = shift @ARGV;
    my ($soa) = shift @ARGV;
    my ($dbh) = DBI->connect($dsn, $user, $passwd)
	or die DBI->errstr;
    my ($sth);

    $zone = "se." unless $zone;

    $sth = $dbh->prepare("SELECT soa,year,month,day FROM entries WHERE zone = '$zone' " . ($soa ? "AND soa = '$soa' " : "") . "ORDER BY soa DESC");
    $sth->execute();
    my ($soa,$year,$month,$day) = $sth->fetchrow_array();
    printf "SOA for %04d-%02d-%02d is %s\n", $year, $month, $day, $soa;
    $sth->finish;
    $dbh->disconnect;
}

# main

eval $cmd;
die if ($@);