#!/usr/bin/perl
# vim:set ts=4 sw=4 ai et:
# 
# noclicky.pl, version 1.00
#
# A command line ("non-clicky") client to query the toorrr.com service to
# determine if a given nameserver is vulnerable to CERT Vulnerability Note
# VU#800113 DNS Cache Poisoning attacks.  Based entirely on Dan Kaminsky's
# JavaScript client, at <http://www.doxpara.com/>.  Updates are available
# from <http://michael.toren.net/code/noclicky/>.
#
#   -- Michael C. Toren <mct@toren.net>
#      Tue Jul  8 21:59:10 PDT 2008
#

use Net::DNS;
use LWP::UserAgent;

use strict;
use warnings;

my $nameserver = shift or die "Usage: $0 <nameserver>\n";

my @char = ("a" .. "z", 0 .. 9);
my $session = join "", map { $char[rand @char] } (1 .. 12);
my $domain = "$session.toorrr.com";

sub lookup
{
    my $nameserver = shift;
    my $res = new Net::DNS::Resolver (nameservers => [$nameserver], recurse => 1)
        or die "Net::DNS::Resolver constructor failed?";

    my $query = $res->search($domain)
        or die "DNS lookup failed: ", $res->errorstring, "\n";

    for my $rr ($query->answer)
    {
        return $rr->address if $rr->type eq "A";
    }

    die "DNS lookup failed: $domain has no 'A' record?\n";
}

print "Looking up $domain against $nameserver\n";
my $ip = lookup $nameserver;

print "Fetching http://$ip/fprint/$session\n";
my $agent = new LWP::UserAgent;
my $response = $agent->get("http://$ip/fprint/$session",
    Host => $domain, "Content-Type" => "application/x-javascript");
die "Failed: ", $response->status_line, "\n" unless $response->is_success;

my @data = split ",", $response->content;
die "Oops, I was expecting more comma separated data than I found\n"
    unless @data >= 5;

my $first = shift @data;
die "Oops, fetched data was for session '$first', not $domain?\n"
    unless $first eq $domain;

my $date = shift @data;
print "Requests seen for $domain:\n";

my %ports;
for my $data (@data)
{
    if ($data =~ /^[1-9]/) {
        chomp($data);
        my ($ip, $port, $txid) = split "-", $data;
        print "  $ip:$port TXID=$txid\n";
        $ports{$port} = 1;
    }
}

if (keys %ports == 1) {
    print "Your nameserver appears vulnerable; all requests came from the same port.\n";
} else {
    print "Your nameserver appears to be safe\n";
}