#!/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 . Updates are available
# from .
#
# -- Michael C. Toren
# 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 \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)
{
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";
}