#!/usr/bin/perl -w

#
# Make sure the path, above, to your perl interpreter is correct.
#

#
# Copyright (c) 2002 James Raftery. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same terms as
# Perl itself.
#
# James Raftery <james@now.ie>
# 9th April 2002.
#
# CHANGES
# 1 May 2002: Integrate old query climbing SRV behaviour as ``wacky mode''.

use strict;
use Net::DNS;
use Getopt::Std;

use vars qw($opt_b $opt_d $opt_h $opt_p $opt_H $opt_w $opt_s %priority);
getopts('bdh:p:s:Hw') or die "getopts() failed!";
my $query = $ARGV[0] || ($opt_H = 1);
$opt_H = 1 if ($opt_b && $opt_w);



#######################################################################
#
# SET DEFAULTS HERE!
#

# 1. Default server locator name. Change ``whois.ripe.net'' below.
$opt_h = $opt_h ? $opt_h : "whois.ripe.net";

# 2. Default symbolic name. Change ``whois'' below.
$opt_s = $opt_s ? $opt_s : "whois";

# 3. Uncomment this if you want to barf on obviously non-domain queries.
#    If you query for IP numbers you'll definitely want to have this
#    commented.
die "Bad query: $query" unless ($opt_H || $query =~ /^([a-z\d\-]+\.)*[a-z]{2,4}$/i);

#
# NO CHANGES SHOULD BE NEEDED BELOW HERE.
#
#######################################################################



if ($opt_H) {

	print <<END;
Usage:    $0 [-H] [-d] [-b|-w] [-s service] [-h host] [-p port] key

Options:  -h host      Whois server locator. Default: whois.ripe.net [0][2]
          -p port      Port to send query to. Default: SRV RR else -s [1]
          -s service   Whois service symbolic name. Default: whois
          -H           Display this help and exit
          -d           Enable debugging output
          -b           Boring mode. Act like a normal client, ignore SRVs
	  -w           Wacky mode. Guess SRVs from query string

This client respects SRV record priorities. Because it makes one
query per invocation SRV weights are meaningless and are ignored.

[0]  SRV records abstract service locator names in the place of DNS
hostnames. For example it is possible with SRVs to say ``the whois
service of whois.foo.com is provided by a host called bigserver.isp.net
on port 756'', should one wish. Therefore in SRV mode this client
initially uses the value of -h, or its default, to form an SRV query.
The SRV record itself will then tell us what real host to contact.
     Should there be no SRV record, or if called using -b, this client
will treat -h, or its default, as the name of the host to query. That
is, it reverts to the behaviour of a ``normal'' client.

[1]  The port to connect may be determind in one of three ways. In order
of precedence they are:
 1. specified by -p
 2. retrieved in an SRV record, if applicable
 3. the port found for -s, or its default, by getservbyname()

[2]  In wacky mode -h, or its default, is used as the name of the host
to query if no SRV RRs can be found.

END

	exit;
}


die "Invalid -s\n" if ($opt_s && $opt_s !~ /^[a-z\d-]+$/i);
die "Invalid -p\n" if ($opt_p && $opt_p !~ /^\d+$/);
die "Invalid -h\n" if ($opt_h && $opt_h !~ /^([a-z\d\-]+\.)*[a-z]{2,4}$/i);

my @t;

if ($opt_w) {
	# Wacky mode

	# We start looking for SRVs owned by the query. Should we perhaps
	# start one level up? i.e. if the query is ``www.foo.com'' do we
	# start the SRV search at www.foo.com or foo.com?
	@t = &getSRV($query);
	my $q = $query;

	while ($q =~ s/.*?\.//) {
		@t = (@t, &getSRV($q));
	}

} elsif (!$opt_b) {

	@t = &getSRV($opt_h);
}


if (@t) {
	foreach (@t) {
		last if &DoWhois(split(/:/));
	}
} else {
	print "No SRV records found, falling back to boring mode...\n" unless $opt_b;
	&DoWhois($opt_h, "foo");
}


exit;

####
sub ByPriority {
	$priority{$a} <=> $priority{$b};
}

####
sub DoWhois {

	my($host, $port) = @_;
	my($sockaddr) = 'S n a4 x8';

	print "gethostbyname: $host\n" if $opt_d;
	my(@hostent) = gethostbyname($host);
	unless ($hostent[4]) {
		print "gethostbyname failed: $host: $!\n";
		return 0;
	}

	print "getservbyname: $opt_s, tcp\n" if $opt_d;
	my(@servent) = getservbyname($opt_s, "tcp");
	unless ($servent[2] || $port =~ /^\d+$/ || $opt_p) {
		print "getservbyname failed: $host: $!\n";
		return 0;
	}

	print "port = $opt_p $port $servent[2]\n" if $opt_d;
	$port = $opt_p ? $opt_p : ($port =~ /^\d+$/ ? $port : $servent[2]);

	my $t = pack($sockaddr, 2, $port, $hostent[4]);

	print "whois: $host:$port\n" if $opt_d;
	unless (socket(WHOIS, 2, 1, 0)) {
		print "socket failed: $host: $!\n";
		return 0;
	}

	unless (connect(WHOIS, $t)) {
		print "connect failed: $host: $!\n";
		return 0;
	}


	select(WHOIS); $| = 1;
	print WHOIS "$query\n";
	select(STDOUT);
	print "[$host]\n";

	while (<WHOIS>) {
		print;
		last if $. > 10000;	# Guard against a bongo server
	}

	close(WHOIS);

	return 1;
}

sub getSRV {

	my $target = shift;
	my @srvlist;
	my $srv = "_$opt_s._tcp.$target";

	my $res = new Net::DNS::Resolver;
	$res->debug(1) if $opt_d;
	my $ans = $res->query($srv, "SRV", "IN");

	return () unless $ans;

	foreach ($ans->answer) {

		if (($_->type eq "SRV") && ($_->name eq $srv)) {

			if ($opt_d) {
				print "Target: ".  $_->target    ." ";
				print "port: ".    $_->port      ." ";
				print "pri: ".     $_->priority  ." ";
				print "weight: ".  $_->weight    ."\n";
			}

			#
			# Should we null the list if we get a '.'? In theory it
			# means ``no service here''. ATM we'll try any SRVs we
			# get that look good, in case some dork has a '.' mixed
			# in with good SRVs.
			#
			next if ($_->target eq ".");

			$priority{$_->target.":".$_->port} = $_->priority;
			@srvlist = (@srvlist, $_->target.":".$_->port);
		}

		@srvlist = sort ByPriority @srvlist;
	}
	return @srvlist;
}