#!/usr/bin/perl
#CGI script for querying the RIPE Database via an HTML form.

#DISCLAIMER

# Copyright (c) 1996 the TERENA Association for the RIPE NCC
# 
# All Rights Reserved
# 
# Permission to use, copy, modify, and distribute this software
#and its its documentation for any purpose and without fee is
#hereby granted, provided that the above copyright notice
#appear in all copies and that both that copyright notice and
#this permission notice appear in supporting documentation, 
#and that the name of the author not be used in advertising or
#publicity pertaining to distribution of the software without
#specific, written prior permission.  

#THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
#INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS;
#IN NO EVENT SHALL AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR
#CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
#LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
#NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN 
#CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

#EXAMPLE FORM

#Incorporate these tags into your HTML page.
#Change the URL in 'action' to the location of this script.

#<form method=POST action="http://your.host/cgi-bin/wwwwhois"> 
#<input type=text name="Whois" size=36>
#<input type=submit value="Search">
#<input type=reset value="Clear">
#</form>

#VARIABLES

#Put in here the path to your local whois client
$WHOISHOST = "whois.ripe.net";
$port = 43;
$AF_INET = 2;
$SOCK_STREAM = 1;

&getargs;

&bailout('forced error') if $form{'Whois'} eq 'force error';

&dowhois($form{'Whois'});

sub getargs {
	local($p, $n, $v);

	if ($ENV{'REQUEST_METHOD'} eq 'POST') {

		read(STDIN, $inbuf, $ENV{'CONTENT_LENGTH'});

		@pairs = split(/&/, $inbuf);

		foreach $p (@pairs) {
			($n, $v) = split(/=/, $p);
			$v =~ tr/+/ /;
			$v =~ s/%([a-fA-F0-9]{2})/pack('C', hex($1))/eg;
			$form{$n} = $v;
		}
	}
	elsif ($ENV{'REQUEST_METHOD'} eq 'GET') {
		$v = $ENV{'QUERY_STRING'};
		$v =~ tr/+/ /;
		$v =~ s/%([a-fA-F0-9]{2})/pack('C', hex($1))/eg;
		$form{'Whois'} = $v;
	}
	else {
		&bailout('REQUEST_METHOD unknown');
	}

	if ($form{'Whois'} !~ /^[a-zA-Z0-9 -\/.@]+$/) {
		&sendheader('Searcharg Error');
		print "<HR><PRE>\n";
		print "The whois arguments ($form{'Whois'}) ";
		print "are invalid. Please correct.\n";
		&sendtrailer;
		print "<HR></PRE>\n";
		exit;
	}
	if ($form{'Whois'} =~ /\s-[hp]\s/ || $form{'Whois'} =~ /^-[hp]\s/) {
		&sendheader('Searcharg Error');
		print "<HR><PRE>\n";
		print "Some whois flags ($form{'Whois'}) ";
		print "are invalid. Please correct.\n";
		&sendtrailer;
		print "<HR></PRE>\n";
		exit;
	}
}

sub dowhois {
	local($whois) = @_;
	local($newobj) = 0;
	local($url_char) = "\\w-~";
	local(@hostent);

	$sockaddr = 'S n a4 x8';
	@hostent = gethostbyname($WHOISHOST);
	$that = pack($sockaddr, $AF_INET, $port, $hostent[4]);
	socket(WHOIS, $AF_INET, $SOCK_STREAM, 0) || &bailout("socket: $!");
	connect(WHOIS, $that) || &bailout("connect $WHOISHOST: $!");
	select(WHOIS); $| = 1; select(STDOUT); $|=1;

	print WHOIS "$whois\n";

	&sendheader("Whois $whois");
	print "<PRE>\n";
	while (<WHOIS>) {
		s/&/\&amp;/g;
		s/</\&lt;/g;
		s/>/\&gt;/g;
		
		#Some simple URL replacements
		#mailto URL
		s/mailto:[$url_char]+@[$url_char]+(.[$url_char]+)*/<A HREF="$&" TARGET=_top>$&<\/A>/g;

		#others
		s/(http|telnet|wais|gopher):\/\/([$url_char]+)+(\.[$url_char]+)*(:\d+){0,1}(\/[$url_char\.]+)*(\/){0,1}/<A HREF="$&" TARGET=_top>$&<\/A>/g;
		 s/ftp:\/\/([$url_char]+@){0,1}([$url_char]+)+(\.[$url_char]+)*(:\d+){0,1}(\/[$url_char\.]+)*(\/){0,1}/<A HREF="$&" TARGET=_top>$&<\/A>/g;

		if ($newobj && /^\S+:/) {
			print "<B>";
			print;
			print "</B>";
		}
		else { 
			print;
		}
		if (/^\s*$/) {
			$newobj = 1;
		}
		else {
			$newobj = 0;
		}
	}
	print "</PRE>\n";
	&sendtrailer;
	close(WHOIS);
}

sub bailout {
	local($msg) = @_;

	&sendheader('Unexpected Whois Error');

	if ($! eq "Connection refused") {
		print "The whois server at the RIPE NCC is not currently accepting connections.";
		print "Please try again later. We apologise for any inconvenience.<P>";
	}
	elsif ($! eq "Operation timed out") {
		print "Timed out while trying to connect to the whois server.";
		print "Please try again in a short while. We apologise for any inconvenience.<P>";
	}
	else {
	
		print "An unexpected error has occurred in the whois interface.\n";

		print 'Please contact the <A HREF="mailto:';
		print $ENV{'SERVER_ADMIN'};
		print '">webmaster</A> with a copy of this page.';
		print "\n<HR>\n";
		print "$msg\n";
		print "<PRE><HR>";
		print "Environment:\n";
		foreach $i (sort keys %ENV) {
			print "$i=$ENV{$i} \n";
		}
		print "\n";
		print "Input:\n";
		foreach $i (sort keys %form) {
			print "$i=$form{$i} \n";
		}
		print "<HR></PRE>\n";
	}
	&sendtrailer;
	exit(0);
}


sub sendheader {
	local($title) = @_;
	

	print "Content-type: text/html\n\n";
	print "<HTML>\n<HEAD>\n<TITLE>$title</TITLE></HEAD>\n";
	print '<BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#000099" VLINK="#6600CC" ALINK="#FF0000">';

	if (length($title) < 20) {
		print "<H1>$title</H1>\n<P>\n";
	}
	else {
		print "$title\n<P>\n";
	}
		
}

sub sendtrailer {
	if ($ENV{'HTTP_REFERER'}) {
		print "\n<A HREF=\"$ENV{'HTTP_REFERER'}\">Go back</A>";
		print " to previous page\n";
	}
	print "</BODY>\n</HTML>\n";
}
