#!/usr/bin/perl -w
#
# $Id: //websites/unixwiz/unixwiz.net/webroot/paychoice/find-malurls.txt#1 $
#
# written by : Stephen J. Friedl
#              Software Consultant
#              Orange County, California USA
#              steve@unixwiz.net
#
#	This program attempts to locate domain names used in the Online Employer
#	impersonation incident. The bad guy used a series of domain names that
#	had a common pattern - in a sense, "one word from column A, one fromk
#	column B", so this runs through all the ones we know about.
#
#	For each domain name created, it queries a root nameserver to see where
#	the NS records point. Live domains are reported, and the dead ones (which
#	are the vast majority) are ignored.
#
#	We can exclude names that we've already dealt with.

use strict;
use Net::DNS;

# "COLUMN A AND COLUMN B"
#
# The lists of words we build the name from: AB A-B BA B-A. Each
# iterates through the list of top-level domains.
#
# SOme of thes
#
my @COLA = qw[
	updated updater sec new upd
	dnl update download secure
	plugin plug plug-in
	browser service software
];
my @COLB = qw[
	online-employer onlineemployer
	omline-employer omlineemployer
	online-emp onlineemp
	onlimemp
];

my @TLDS = qw[ com net org biz us info ];

# These ones have been resolved: don't report them
my %IGNORE = (
	'update-onlineemployer.com' => 1,
	'online-employer-dnl.com' => 1,
	'onlineemployer-update.net' => 1,
	'onlineemployer-download.net' => 1,
	'secure-onlineemployer.com' => 1,
	'plugin-online-employer.org' => 1,

	# Fri Sep 25 08:13:38 PDT 2009
	'onlineemployer-download.biz' => 1,
	'plugin-online-employer.com' => 1,
	'plugin-online-emp.info' => 1,
	'onlimemp-plugin.com' => 1,
	'onlimemp-software.org' => 1,

	'onlimemp-plug-in.org' => 1,

	'onlineemployersoftware.com' => 1,		# uninvolved 
	'onlineemployersoftware.net' => 1,		# uninvolved
);

my $verbose = 0;


foreach ( @ARGV )
{
	if ( m/^--help/i )
	{
		print STDERR <<EOF;
Usage: find-malurls [options]

  --help        Show this brief help listing
  --verbose     Show a bit more runtime debugging (multiple OK)
EOF
		exit 0;
	}
	elsif ( m/^--verbose/ )
	{
		$verbose++;
	}
	else
	{
		die "ERROR: {$_} is invalid cmdline param (try --help)\n";
	}
}

my @ROOTNS = (
	qw[	a.root-servers.net
		b.root-servers.net
		c.root-servers.net
		d.root-servers.net
		e.root-servers.net
		f.root-servers.net
		g.root-servers.net
		h.root-servers.net
		i.root-servers.net
		j.root-servers.net
	]
);

my $rootres = Net::DNS::Resolver->new(
  	nameservers => [ @ROOTNS ],
  	recurse     => 0,
  	debug       => 0,
);

foreach my $cola ( @COLA )
{
	print "Column A: $cola\n"		if $verbose;

	foreach my $colb ( @COLB )
	{
		foreach my $tld ( @TLDS )
		{
			
			check( "$cola$colb.$tld" );
			check( "$cola-$colb.$tld" );
			check( "$colb$cola.$tld" );
			check( "$colb-$cola.$tld" );
		}
	}
}

# ------------------------------------------------------------------------
# This is the list of root nameservers that we're going to try and talk
# to; they won't often have the complete answer, but they will delegate
# to one of the top-level domain handlers.
#


my @DOMAINS = ();

# ------------------------------------------------------------------------
# Create the root nameserver resolvers out of our list. We specifically
# don't ever ask for recursion (mainly because it wouldn't be allowed
# anyway).
#

sub check {
	my $domain = shift;

	return if $IGNORE{$domain};

	print STDERR "# Trying to lookup $domain\n"		if $verbose > 1;

	my @nslist = lookup_nameservers($rootres, $domain);

#	print "$domain: ";		# no newline!

	if ( @nslist == 0 )
	{
		return;
	}
	else
	{
		foreach ( @nslist ) { s/\.$//; }

		print "$domain: ", join(" ", sort map { lc $_ } @nslist), "\n";
	}
}

#
# lookup_nameservers()
#
#	This takes the top-level resolver and a domain name and starts the process
#	of querying down the line; 
#
sub lookup_nameservers {

	my $res    = shift;
	my $domain = shift;

	my $maxloops = 5;

	for (my $i = 0; $i < $maxloops; $i++)
	{
		my $nsname = ( $res->nameservers() )[0];

		print STDERR "#  Loop $i; querying $nsname\n"	if $verbose > 1;

		my @nslist = get_ns($res, $domain);

		return ()		if @nslist == 0;

		my $ans = shift @nslist;

		return @nslist		if $ans;

		$res = Net::DNS::Resolver->new(
			nameservers => [ @nslist ],
			recurse     => 0,
			debug       => 0
		);
	}

	return ();
}

#
# get_ns
#
#	Given a resolver and a domain name, return the list of nameservers
#	that are being pointed to by it. We expect to be called in sequence
#	as we work our way down from the root servers.
#
#	There are three flavors of returns:
#
#	( )            -- no data; we're probably stuck
#
#	( 0, nslist )  -- authority but not answer; gotta keep digging
#
#	( 1, nslist )  -- we got an answer; we're done querying
#
#

sub get_ns {
	my $res    = shift;
	my $domain = shift;

	my $response;

	if ( not defined ( $response = $res->send($domain, 'NS') ) )
	{
		# not found; oops

		return ();
	}

	my @roots = ();

	#
	# we get an "authority" response from the root servers that delegate
	# to lower level roots, and "answer" when we hit the first real
	# delegation.
	# 

	my $ans = $response->answer ? 1 : 0;	# we got "the answer" ?

	my @nsanswer = ();
	push @nsanswer, $response->authority		if $response->authority;
	push @nsanswer, $response->answer		if $response->answer;

	foreach my $rr ( @nsanswer )
	{
		push @roots, $rr->rdatastr	if $rr->type eq 'NS';
	}

	return ()		if not @roots;

	return ($ans, @roots);
}