#!/usr/local/bin/perl -T
#
# NoteNote: only -w recognized here under mod_perl
# Therefore need 'PerlTaintCheck On' in httpd.conf when running
# under mod_perl, -T isn't enough.
#
# Copyright (c) 2001     RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and 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.
#
#------------------------------------------------------------------------------
# Module Header
# 
# Filename          : whois
# Purpose           : Web CGI for RIPE whois database.
#                     
# Author            : Andrew McDowell <andy@ripe.net>  <softies@ripe.net>
# Date              : 20010918
# Description       : CGI application to allow users to more easily construct whois
#					: queries. The CGI also performs formatting and logging functions
#					: as well as input validation.
#
# Language Version  : perl v5.6.0 built for i686-linux
# OSs Tested        : Slackware linux 7.1.0/8.0 
# Browsers Tested	: Linux - Opera, Netscape 4.75/6.01. 
#					: Windows 2000 Professional - Netscape 4.75/6.01, IE5.00/6.00
# Command Line      : NA 
#
# Input Files       : None
#
# Output Files      : Writes to a logfile for analysis of querying trends.
#					: /var/www/cgi-data/whois/whois.log
#
# External Programs : whois. pushes queries down port 43 via a socket we explicitly
#					: create.
#                     
# Problems          : There's a bug in Pod:
#                     "my" variable $line masks earlier declaration in same scope at
#                     /usr/local/lib/perl5.6.0/Pod/Text.pm line 215."
# To Do             : Paging is a possiblity but this would need to be a 
#					: collaborative effort with the technical webmaster,
#					: the database group and the programmer.
#
# Comments          : This is a mod_perl script and is run mod_perl'ed by
#					: an apache webserver.
#
# Modification hist	:
#
# AMcD 07052002 - 	Escaped the value string using metaquote function to prevent regex
#					errors on strings that begin with a metacharacter. This is not
#					common, but they do occur and they do cause problems.
#					These changes added as per requested by A.Robachevsky.
#					- remove hrefing from "nic-hdl:", "notify:", "sub-dom:", "nserver:", 
#					"rev-svr:", "author:", "upd-to", "mnt-nfy:", "irt-nfy:"  attributes as
#					it doesn't make real sense to make forward queries for them.
#					- add "origin:" to searchable attributes.
#					- include irt object (see db ref manual).
#					- change the "Hyperlinks: Searchable Inverse Attributes" to 
#					"Hyperlinks: Searchable Attributes".  
#
#------------------------------------------------------------------------------
################# MODULE INCLUDES #################

require 5.6.0;

$| = 1; # don't buffer the output, print it directly as it comes.

delete $ENV{'PATH'} if ( exists $ENV{'PATH'} );

use strict;
use warnings;
use Time::HiRes qw(gettimeofday tv_interval); 	#used for timing of whois server 
use Fcntl ':flock'; 							# import LOCK_* constants
use IO::Socket::INET;
use Sys::Hostname;
use CGI;

$CGI::POST_MAX = 0;			# Disable limits on POSTings. 
							# IE. CGI can used with no usage limit
$CGI::DISABLE_UPLOADS = 1;	# Disable file uploads

################# MAIN #################

# array to store alternative dbase sources. This is global so the result will be
# cached in memory.
use vars qw( $VERSION @database_list $HARD_LIMIT);	

$VERSION = "1.04"; # version number of the application.

$HARD_LIMIT = 300; 	# This is the maximum number of objects allowed for display
					# for a single query.

{
	# New cgi object
	my $cgi = new CGI;
	
	# The RIPENCC header for public websites. This is the prod webserver location only
	my $RIPENCCHEADER = '../pub/ssi/ncchead1.inc';
	
	# The RIPENCC footer for public websites. This is the prod webserver location only
	my $RIPENCCFOOTER = '../pub/ssi/nccfoot1.inc';
	
	# These are the links for information about the migration to RPSL (whois db v.3)
	# and the whois reference manual. These are the used in the bottom table for 
	# further information.
	my $rpsl_page = "/ripencc/pub-services/db/rpsl/index.html";
	my $db_reference = "/ripe/docs/databaseref-manual.html";
	
	# If the cgi is being run on kiwi (test webserver), make a timestamp entry
	# in the httpd.error logfile to prevent misinterpretation of entries.
	test_header();
	
	# Print the input form which includes the header.
	print_startofpage($cgi, $RIPENCCHEADER);
	
	# If there are results, print these.
	print_results($cgi);
	
	# Print the further information table and the footer.
	print_endofpage($cgi, $RIPENCCFOOTER, $rpsl_page, $db_reference);
}
	
################# SUBROUTINES: 3 MAIN BLOCKS #################

###############################################################################
# Function		: test_header                                            
# Description	: Gets the hostname of the machine the cgi is being run on and
#				: if its the test server, writes a timestamp to the server
#				: error log.                    
# Input			: None.                                                  
# Output		: None.                               
###############################################################################
sub test_header
{
	my $hostname = hostname();
	if ( ($hostname) && ($hostname =~ /kiwi.*/) )
	{
		my $start_time = time();
		print STDERR "kiwi test: ",scalar localtime($start_time),"\n";
	}

	return 1;
}

###############################################################################
# Function		: print_startofpage                                            
# Description	: Prints the header and the input form of the webpage.
# Input			: New cgi object scalar.
#				: RIPENCC header constant.                                                  
# Output		: None.                               
###############################################################################
sub print_startofpage
{
	my ($cgi, $header) = @_;

	my $html_title = "Query the RIPE Whois Database";

	#Gete the header for the html tables.
	my $header_html;
	($header_html = "</HEAD>") unless ($header_html = ssi_include($header));

	#Build web page in cgi code -> assign to variable $web_page.
	#The conf doesn't send the MIME type Note: the /r/n/r/n won't 
	#work on a mac
	my $web_page = "Content-Type: text/html\r\n\r\n".  
	"<HTML>" . "<HEAD>" . "<TITLE>$html_title</TITLE>";

	$web_page .= $header_html;
	
	$web_page .= print_form($cgi);

	print $web_page;

	return 1;
}

###############################################################################
# Function		: print_form                                            
# Description	: Determines which input form is being used by the user
#				: - simple or advanced - and assigns the form to a scalar.
# Input			: New cgi object scalar.
# Output		: Scalar containing the webpage input form.                               
###############################################################################
sub print_form
{
	my ($cgi) = shift;

	my ($web_page, $input_form);
		
	my $form_type = $cgi->param('form_type') || 'simple';
	
	#--- button actions
	# advanced search button sets form type to advanced for display to user
	if ($cgi->param('Advanced search'))
	{
		$form_type = 'advanced';
	}
	# simple search button sets form type to simple for display to user
	elsif ($cgi->param('Simple search'))
	{
		$form_type = 'simple';
	}	
	# reset form sets form to default, basically returns an empty form.
	if ($cgi->param('Reset Form')) 
	{
		$cgi->delete_all();
	}

	#--- form determination
	# select the form you want based on the $form_type variable.
	if ($form_type eq "advanced")
	{
		# get the advanced query table from this advanced_query subroutine
		$input_form = advanced_query($cgi);
	}
	else
	{
		# get the simple query table from this simple_query subroutine
		$input_form = simple_query($cgi);
	} 

	# build the form including the header, display title and the input form. 
	$web_page = 
	
	$cgi->start_table({
	-border=>0,
   	-width=>645}) .

		$cgi->start_form().

		$cgi->Tr({
		-align=>"center",
		-bgcolor=>"#FFCC00"},
			$cgi->td({
			-width=>"100%",
			-height=>65,
			-valign=>"middle"},
				$cgi->h2("Query the Ripe Whois Database"))).
		$cgi->Tr(
			$cgi->td({
			-width=>"100%",
			-height=>65,
			-valign=>"left"},
				$input_form)).
				
		$cgi->endform() . 
	
	$cgi->end_table();

	# return this table via the scalar to the calling function.
	return $web_page;
}

###############################################################################
# Function		: print_results                                            
# Description	: This is where the work is done after the query has been performed.
#				: This function checks to see if the searchtext variable has been
#				: filled and if it has initiates the query. The focus of this 
#				: function is not the query, but rather taking the filehandle
#				: which is the open socket with the query results, waiting to be
#				: read. The core of the function performs the formatting of the
#				: objects line by line so as to minimise cpu and memory usage.
#				: When the maximum number of objects has been reached (300 at
#				: time of writing), a message is printed to the browsers and the
#				: the rest of the results are discarded. The results are printed to 
#				: to the browser one object at a time just as they are formatted.
#				: 
# Input			: New cgi object scalar.
# Output		: Formatted objects to the browser.                               
###############################################################################
sub print_results
{
	my ($cgi) = shift;					# the cgi object.
	my $cgi_script = $cgi->url();		# the name of the cgi script
	
	#variable declartions 
	my ($search_text,			# users search name with no options.
		$search_string,			# the complete search string sent to whois.
		$counter,				# number of objects returned by whois server.
		$error_count,			# number of errors returned.
		$web_page,				# table to be displayed in browser
		$formatted_object,		# single formatted object ready for display.
		$result_message,		# message to be put at end of results list.
		$search_result,			# filehandle which is the socket waiting to be read. 
		$logentry				# this is the entry going into the whois log file.
		);
		
	#leave results processing until a query is constructed
	return unless ($cgi->param('searchtext'));

	#Escape the searchtext to prevent html interpretation of user input if they
	#were bastard enough to try something underhanded.
	$search_text = $cgi->escapeHTML( $cgi->param('searchtext') );
		
	#construct the query string.
	$search_result = build_search_string($cgi);
	
	# Print the query string if we are on the test server
	my $hostname = hostname();
	if ( ($hostname) && ($hostname =~ /kiwi.*/) )
	{
		# get the full query constructed and sent to whois for debug display
		$search_string = $cgi->param('full_query_string');
		
		# put it into a table record and print it to the browser.
		$web_page = 
			$cgi->Tr({
			-align=>"left",
			-nowrap=>1},			       
				$cgi->td({
				-colspan=>2},
					$cgi->p("Processed string: $search_string")));
		print $web_page;			
	}

	local $/ = "\n\n";				# new object seperator.
	$counter = $error_count = 0;	# set counters to 0
	while (my $raw_object = <$search_result>)
	{
		if ($raw_object =~ /^\s*$/s) {next}; # blank line don't process

		# format the raw object
    	$formatted_object = format_whois_object (	$cgi,
													$raw_object);

		print $cgi->pre($formatted_object); # print the object to the browser

		# add 1 to the total number of objects if its a real object
		$counter++ if ( ($formatted_object !~ /^\W*?%/) and
						($formatted_object !~ /^\W*?$/)	);
							
		# add 1 to the total number of errors if an error string occurs
		$error_count++ if ( ($formatted_object) =~ /^%ERROR.*?/ );
		
		# When you hit the limit print an message to the screen and dump rest of results.
		if ($counter == $HARD_LIMIT)
		{
			print $cgi->pre("Limit of 300 objects reached");
			last; 
		}
	}
	
	# construct an nice message to the user informing them of the total number of
	# objects their search found, or an error message if they only got errors.
	$result_message = format_result_message($error_count,$counter,$search_text);
	
	close ($search_result); # close the filehandle.

	# make table containing the explaination of format types and the result message
	$web_page =	
	$cgi->start_table({-width=>645}).
	$cgi->Tr({
	-align=>"left"}, 
		$cgi->td({
		-height=>65},
			$cgi->font({
			-size=>2,
			-face=>"courier"},
				$cgi->li($cgi->b("Bold: Object type. ")) .
				$cgi->li($cgi->u("Underlined: Primary key(s). ")) .
				$cgi->li("Hyperlinks: Searchable Attributes.")
			)));
			
	$web_page .=
		$cgi->Tr({
			-valign=>"top",
			-width=>645,
			-bgcolor=>"#FFFF99"},
				$cgi->th({
				-align=>"center"},
					"$result_message")) . $cgi->end_table(); 

	print $web_page; # print the page to the browser
	
	# make a log entry in the logfile
	$logentry = "PID: $$\n" . "objects returned: $counter\n";
	log_entry($logentry);
	
	return 1;
}

###############################################################################
# Function		: print_results                                            
# Description	: Prints the additional information and footer to browser.
#				: Basically the bottom part of the form.
# Input			: New cgi object scalar, the footer path, and hyperlinks
#				: to whois rpsl information and the whois reference manual.
# Output		: Prints bottom part of page to browser                             
###############################################################################
sub print_endofpage
{
	my ($cgi, $footer, $rpsl_page, $db_reference) = @_;
	
	my $footer_html;

	# If a footer fails to be retrieved by the ssi_include module, define
	# the footer as an end (/) html tag.
	($footer_html = "</html>") unless ($footer_html = ssi_include($footer));
	
	# Assign a variable with the html table containing the RPSL link and the 
	# and the database reference manual link
	my $web_page = 
		$cgi->start_table({
		-border=>0,
		-width=>645,
		-bgcolor=>"#FFCC00",
		-valign=>"top",
		}).
		
		$cgi->Tr(
			$cgi->td({
			-align=>"center"},
				$cgi->start_table().
		
					$cgi->Tr(
						$cgi->th({
						-align=>"center"},
						"Further Information")).
					$cgi->Tr({
					-align=>"center"},
						$cgi->td(
							$cgi->font({
							-size=>2},
								$cgi->a({
								-href=>"$db_reference"},
									"The Ripe Whois Database Reference Manual")))).
					$cgi->Tr({
					-align=>"center"},
						$cgi->td(
							$cgi->font({
							-size=>2},
								$cgi->a({
								-href=>"$rpsl_page"},
									"Ripe-181 to RPSL Migration Information")))).
				$cgi->end_table())) .
	
		$cgi->end_table();      
	
	print $web_page; # Print the table to the browser

	print $footer_html; # And then print the footer.
	
	return 1;
}

################# SUBROUTINES: HTML Table defn #################

###############################################################################
# Function		: advanced_query                                            
# Description	: Defines the HTML table for the advanced search form. This is
#				: is made up of nested html tables so calls are made to 
#				: additional subroutines where the additional tables are defined.                    
# Input			: new cgi object                                                  
# Output		: scalar containing table                                
###############################################################################
sub advanced_query
{
    my ($cgi) = shift; # New cgi object variable
	
	# This scalar gets the table defn for in the actual input searchtext field.
	# The hidden field is used to keep state information between the simple
	# and advanced form usage.
	my $User_Query_Table = 
		"\n\n<input type=hidden name=form_type value=advanced>\n\n".
		search_field_table($cgi);
		
	# If the advanced tables fail to be retreived, leave this subroutine 
	# since there isn't much point continuing. The tables are needed to
	# construct the advanced form.
	return unless ( my ($RSD_Table,$DOA_Table) = set_html_tables($cgi) );

	# Assign a scalar with the advanced table 
	my $advanced_table = 
 		$cgi->start_table({
		-border=>0,
		-cellpadding=>10,
		-cellspacing=>0,
 		-align=>"center",
		-width=>"100%",
		-bgcolor=>"#FFFFCC"}).
			$cgi->Tr({
			-align=>"center"},
				$cgi->td({
				-colspan=>2},
					$User_Query_Table)).  
			
			$cgi->Tr({
			-valign=>"top"},
				$cgi->td(
					{-width=>"50%"},($RSD_Table)),  
				$cgi->td(
					{-width=>"50%"},($DOA_Table))).
			
			$cgi->Tr({
			-align=>"center",
			-bgcolor=>"#FFCC00"},
				$cgi->td({
				-colspan=>2,
				-height=>25,
				-valign=>"middle"},
					$cgi->submit(
					-name=>'Simple search'))).
	$cgi->end_table();
	#END advanced_table
	
	return ($advanced_table); # Return the advanced table
}

###############################################################################
# Function		: simple_query                                            
# Description	: Defines the HTML table for the simple search form. There are no
#			    : nested tables in this form, so only the searchtext input field
#				: needs to be retrieved via a subroutine.               
# Input			: new cgi object                                                  
# Output		: scalar containing table                                
###############################################################################
sub simple_query
{
    my ($cgi) = shift; # new cgi object.
	
	# This scalar gets the table defn for in the actual input searchtext field.
	# The hidden field is used to keep state information between the simple
	# and advanced form usage.
	my $User_Query_Table = 
		"\n\n<input type=hidden name=form_type value=simple>\n\n".
		search_field_table($cgi);
	
	# scalar containing the simple form
	my $simple_table = 
		$cgi->start_table({
		-border=>0,
		-cellpadding=>10,
		-cellspacing=>0,
		-align=>"left",
		-width=>"100%",
		-bgcolor=>"#FFFFCC"}).
			$cgi->Tr(
				$cgi->td(
					$User_Query_Table)).  
			
			$cgi->Tr({
			-align=>"center",
			-bgcolor=>"#FFCC00"},
				$cgi->td({
				-height=>25,
				-valign=>"middle"},
					$cgi->submit(
					-name=>'Advanced search'))).
		$cgi->end_table();
		#END simple_table
		
		return ($simple_table); # return the simple form 
}

###############################################################################
# Function		: search_field_table                                            
# Description	: This defines the actual input part of the form displayed to
#				: the user. There are 3 discreet parts to this. 1. is the 
#				: textfield itself for the users query. 2. is the submit 
#				: button and 3. is the reset button.    
# Input      	: new cgi object                                                  
# Output     	: scalar containing table                                
###############################################################################
sub search_field_table
{
    my $cgi = shift; 	# new cgi object
	my $query_env;		# assigned the user query from one of the cgi parameters
	
	# Old-style whois parameter handling.
	# The cgi can be called from other applications that pass parameters
	# differently. Some pass by whois?query=<query>, others pass by
	# whois?search=<query>. This if block takes care of the query in its
	# many forms
	if ( ($cgi->query_string()) and not ($cgi->param('searchtext')) )
	{		
		if ( $cgi->param("query") )
		{
			$query_env = join ' ',$cgi->param("query");
		}
		elsif ( $cgi->param("search") )
		{
			$query_env = join ' ',$cgi->param("search");
		}
		else
		{
			$query_env = join ' ',$cgi->param("keywords");
		}

		# assign the scalar query_env value to the cgi paramater searchtext so
		# so a query can be performed.
		$cgi->param(
			-name  => 'searchtext',
			-value => $query_env);
	}

	# assign the user input table to a scalar.
	my $search_field_table	=
		"\n\n<input type=hidden name=full_query_string>\n\n".
   		$cgi->start_table({
		-border=>0}).
   			$cgi->Tr(
				$cgi->td({
				-width=>"20%",
				-align=>"right",
				-valign=>"bottom"},
					$cgi->font({
					-size=>2,
					-face=>"ariel"},
						"Search for")).
				$cgi->td({
				-width=>"50%",
				-align=>"left",
				-valign=>"bottom"},
					$cgi->textfield(
					-name=>"searchtext",
					-size=>"50"
				)).
				$cgi->td({
				-width=>"15%",
				-valign=>"bottom",
				-align=>"left"},
					$cgi->submit(
					-name=>"do_search",
					-value=>"Search")).
				$cgi->td({
				-width=>"15%",
				-valign=>"bottom",
				-align=>"left"},
					$cgi->submit(
					-name=>"Reset Form"))).

	$cgi->end_table();
		
	return ($search_field_table); # return the user input table.

} #END search_field_table

###############################################################################
# Function		: set_html_tables                                            
# Description	: The advanced form is made up of two seperate tables on the 
#				: left hand side, and right hand side of the form. The two tables
#				: divide up the options into the proper query types as outlined
#				: in the whois reference manual. This was done so no matter what
#				: options the user selects, they will always construct a correct
#				: query. This does not mean they will construct meaningful queries,
#				: as cluelessness cannot be checked here. The intention though was
#				: to help the user construct queries with multiple options that
#				: would be syntactically correct. The two main tables themselves are
#				: comprised of nested tables to structure the options in a orderly
#				: and uniform way.                     
# Input      	: new cgi object                                                  
# Output     	: two scalars containing the left hand side table and
#				: right hand side table.                                
###############################################################################
sub set_html_tables 
{
    my ($cgi) = shift; # new cgi object.

	# Values for the database select box. If this fails, exit the cgi as there
	# has been a problem accessing the whois server.
	if (! (get_alternative_dbases()) )
	{
		print STDERR "Could not get alt database values\n";
		print_error_and_exit();
		
	}

	#Values for the object type select box 
	#sort the array so its in alphabetical order for the users
	my @type_list = sort qw(	
		mntner route route-set as-set rtr-set peering-set
		filter-set aut-num inet-rtr inetnum inet6num domain limerick
		as-block key-cert All person role irt);

	#Values for the inverse attribute select box			
	my @inverse_attributes_list = ("admin-c", "tech-c", 
		"zone-c", "author", "notify", "cross-nfy",
		"mnt-by", "mbrs-by-ref", "cross-mnt", "origin", "local-as",
		"sub-dom", "rev-srv", "nserver", "member-of", "person", "upd-to",
		"None", "mnt-routes", "mnt-nfy", "mnt-lower", "referral-by",
		"admin-c,tech-c,zone-c" );
		
	# sort the inverse attributes list alphabetically.
	@inverse_attributes_list = sort @inverse_attributes_list;	
	
	#Values for the search level select box								
	my @search_level = (	"Default",
							"-l First Level Less objects", 
							"-L All Less objects", 
							"-m First Level More objects", 
							"-M All More objects", 
							"-x Exact match only");
	
	# assign the left hand table to a variable.
	my $RSD_Table =
		$cgi->start_table({
		-border=>0,
		-width=>"100%",
		-align=>"center",
		-cellspacing=>0,
		-valign=>"top"}).

			# first nested table.
			$cgi->Tr(
				$cgi->td(
					$cgi->start_table({
					-border=>0,
					-align=>"left",
					-cellspacing=>"10",
					-valign=>"top"}).

						$cgi->Tr(
							$cgi->th({
							-align=>"left",
							-colspan=>3},
								"Query Options: IP address Lookups")). # option type

						# defn of the checkbox to switch on reverse delegation domain lookups.
						# The hyperlink goes to the help form description.
						$cgi->Tr(
							$cgi->td({
							-align=>"left",
							-width=>"15",
							-height=>40},
								"-d "),
							$cgi->td({
							-align=>"left",
							-width=>"150",
							-height=>40},
								$cgi->a({
								-href=>"/ripencc/pub-services/db/whois/whoishelp.html#revdel"},
									"Reverse Delegations")),
							$cgi->td({
							-align=>"left",
							-width=>"80",
							-height=>40},
								$cgi->checkbox(
								-name=>"reverse_delegation_domains",
								-value=>"ON",
								-label=>""
								))).
								
						$cgi->end_table()
				)
			).
			
			# second nested table			
			$cgi->Tr(
				$cgi->td(
					$cgi->start_table({
					-border=>0,
					-width=>"100%",
					-cellspacing=>"10",
					-valign=>"top",
					-align=>"left"}).
					
						$cgi->Tr(
							$cgi->th({
							-align=>"left",
							-colspan=>3},
								"Query Options: Inverse Lookups")). # option type
		
						# defn of the select list for inverse attribute searching.
						# hyperlink goes to the help form description.
						$cgi->Tr({
						-align=>"left"},
							$cgi->td({
							-align=>"left"},
								"-i "),
							$cgi->td({
							-align=>"left"},
								$cgi->a({
								-href=>"/ripencc/pub-services/db/whois/whoishelp.html#invatt"},
									"Inverse attributes")),
							$cgi->td({
							-align=>"left"},
								$cgi->popup_menu(
								-name=>"inverse_attributes",
								-values=>\@inverse_attributes_list,
								-default=>"None"))).

					$cgi->end_table()
				)
			).

			# third nested table
			$cgi->Tr(
				$cgi->td(
					$cgi->start_table({
					-border=>0,
					-align=>"left",
					-cellspacing=>"10",,
					-valign=>"top"}).
						$cgi->Tr(
							$cgi->th({
							-align=>"left",
							-colspan=>2},
							"Query Options: IP address Lookups")). # option type
							
						# defn of the select list for the type of ip search level.
						# hyperlink goes to the help page description.
						$cgi->Tr(
							$cgi->td(
								$cgi->a({
								-href=>"/ripencc/pub-services/db/whois/whoishelp.html#ipsearch"},
									"Search level")),
							$cgi->td({
							-align=>"left"},
								$cgi->popup_menu(
								-name=>"ip_search_lvl",
								-values=>\@search_level,
								-default=>"Default"))).
					$cgi->end_table()
				)
			).

	$cgi->end_table();      
	#END RSD_Table
	
	# assign the right hand side table to a scalar.
	my $DOA_Table = 
		$cgi->start_table({
		-border=>0,
		-width=>"100%",
		-align=>"center",
		-cellspacing=>"10",
		-valign=>"top"}).
		
			$cgi->Tr(
				$cgi->th({
				-align=>"left",
				-colspan=>3},
				"Query Support Tools")). # name of the query type.

			# Defn of the checkbox to disable recursive lookups.
			# hyperlink goes to help form description
			$cgi->Tr(
				$cgi->td({
				-align=>"left",
				-width=>20,
				-height=>40},
					"-r "),
				$cgi->td({
				-align=>"left",
				-height=>40},
					$cgi->a({
					-href=>"/ripencc/pub-services/db/whois/whoishelp.html#recur_look"},
						"Turn off recursive lookups")),
				$cgi->td({
				-align=>"left",
				-height=>40},	
					$cgi->checkbox(
					-name=>"recursive",
					-value=>"ON",
					-label=>""))).
			
			# Defn of the checkbox to enable primary key only searching.
			# Hyperlink goes to help page description.
			$cgi->Tr(
				$cgi->td({
				-align=>"left",
				-height=>40},
					"-K "),
				$cgi->td({
				-align=>"left",
				-height=>40},
					$cgi->a({
					-href=>"/ripencc/pub-services/db/whois/whoishelp.html#primarykey"},
						"Primary keys only")),
				$cgi->td({
				-align=>"left",
				-height=>40},
					$cgi->checkbox(
					-name=>"primary_key",
					-value=>"ON",
					-label=>""))).

			# Defn of checkbox to switch off use of the referral mechanism for domain 
			# lookups. Hyperlink goes to help form description.
			$cgi->Tr(
				$cgi->td({
				-align=>"left",
				-height=>40},
					"-R "),
				$cgi->td({
				-align=>"left",
				-height=>40},
					$cgi->a({
					-href=>"/ripencc/pub-services/db/whois/whoishelp.html#disdomref"},
						"Disable domain name referral")),
				$cgi->td({
				-align=>"left",
				-height=>40},
					$cgi->checkbox(
					-name=>"domain_name_referral",
					-value=>"ON",
					-label=>""))).
		
			# Defn of the select list for alternative databases to search.
			# The values are retrieved from the database via a query.
			# Hyperlink goes to help text description.
			$cgi->Tr({
			-align=>"left"},
				$cgi->td({
				-align=>"left"},
					"-s "),
				$cgi->td({
				-align=>"left"},
					$cgi->a({
					-href=>"/ripencc/pub-services/db/whois/whoishelp.html#altdb"},
						"Alternative database")),
				$cgi->td({
				-align=>"left"},
					$cgi->popup_menu(
					-name=>"alt_database",
					-values=>\@database_list,
					-default=>"RIPE"))).
						
			# Defn of scrolling list (allowing multiple selections) for object types.
			# Hyperlink goes to help page description. 
			$cgi->Tr({
			-align=>"left"},
				$cgi->td({
				-align=>"left"},
					"-T "),
				$cgi->td({
				-align=>"left"},
					$cgi->a({
					-href=>"/ripencc/pub-services/db/whois/whoishelp.html#objtype"},
						"Objects types")),
				$cgi->td({-align=>"left"},
					$cgi->scrolling_list(
					-name=>"object_type",
					-values=>\@type_list,
					-default=>"All",
					-size=>3,
					-multiple=>"true"))).
					
	$cgi->end_table();      
	#END $DOA_Table
	
	return ($RSD_Table,$DOA_Table); #return the two tables.
}

###############################################################################
# Function		: ssi_include                                            
# Description	: Retrieves the header and footer code from the file they are stored in
#				: and return them to the calling subroutine for inclusion in the
#				: web form
# Input      	: header / footer file path                                                  
# Output     	: header / footer code returned                               
###############################################################################
sub ssi_include 
{
    my ($file) = @_; # the header or footer file to be read
    
    #Return undef if no parameters
    return undef unless (-r $file);

    # Open the file and read it, storing lines into an array.
	# When the file is finished being read, joing the lines and return the output.
    if(open(SSI, $file)) {
        my @lines = <SSI>;
        close(SSI);
        return ( join '', @lines );
    }
	else # print error message to stderr.
	{
		print STDERR "Couldn't open header/footer $file: $!\n";
	}

	return -1;
	
} #end ssi_include


################# SUBROUTINES: Input processing #################

###############################################################################
# Function		: build_search_string                                            
# Description	: From the options selected by the user, a search string is 
#				: constructed, ready for submission to the whois database. 
#				: This subroutine builds the complete string for the database 
#				: by prepending flags to the search text based on the user selected 
#				: radioboxes, checkboxes, and popupmenus.
#				:
# Input      	: new cgi object                                                  
# Output     	: scalar containing whois query string                                
###############################################################################
sub build_search_string
{	
	my ($cgi) = @_; # new cgi object
	 
	my (	$first_params,			# var for ip address lookup option.
			$second_params,			# var for alternative dbase option.
			$third_params,			# var for object type option.
			$fourth_params,			# var for inverse attribute option.
			$primary_key_option,	# var for primary key option.
			$delegation_domain, 	# var for domain name referral option.
			$domain_ref, 			# var for reverse delegation option.
			@obj_type, 				# array for object types selected.
			$query_handle, 			# scalar assigned with socket filehandling for result reading.
			$inverse_atts			# scalar is assigned a cgi->param var for a comparison test.
		);

	# build hash table for attribute type.
	my %inverse_desc_names = 
   			(	"admin-c" 				=>	"ac",
   				"tech-c"				=>	"tc",
				"zone-c"				=>	"zc",
				"author"				=>	"ah", 
				"notify"				=>	"ny", 
				"cross-nfy"				=>	"cn", 
				"mnt-by"				=>	"mb", 
				"cross-mnt"				=>	"ct", 
				"origin"				=>	"or", 
				"local-as" 				=>	"la", 
				"sub-dom" 				=>	"sd", 
				"rev-srv" 				=>	"rz", 
				"nserver" 				=>	"ns", 
				"member-of"				=>	"mo", 
				"person"				=>	"pn", 
				"upd-to"				=>	"dt",
				"mnt-routes"			=>	"mu", 
				"mnt-nfy"				=>	"mn", 
				"mnt-lower"				=>	"ml", 
				"referral-by"			=>	"rb", 
				"mbrs-by-ref"			=>	"mr", 
				"admin-c,tech-c,zone-c"	=>	"ac,tc,zc"	);

		
	# Build first parameter flags. Check to see if the following variables are defined. If they are
	# prepend the necessary flag letter to the $first_params variable
	if ( ($cgi->param('ip_search_lvl')) && 
		($cgi->param('ip_search_lvl') eq "-l First Level Less objects") ) 
	{
		$first_params = $first_params . "l";
	}
	if ( ($cgi->param('ip_search_lvl')) &&
		($cgi->param('ip_search_lvl') eq "-L All Less objects") )
	{    
		$first_params = $first_params . "L";
	}
	if ( ($cgi->param('ip_search_lvl')) &&
		($cgi->param('ip_search_lvl') eq "-m First Level More objects") )
	{
		$first_params = $first_params . "m";
	}
	if ( ($cgi->param('ip_search_lvl')) &&
		($cgi->param('ip_search_lvl') eq "-M All More objects") )
	{
		$first_params = $first_params . "M";
	}
	if ( ($cgi->param('ip_search_lvl')) &&
		($cgi->param('ip_search_lvl') eq "-x Exact match only") )
	{
		$first_params = $first_params . "x";
	}
	if ( ($cgi->param('recursive')) &&
		($cgi->param('recursive') eq "ON") )
	{
		$first_params = $first_params . "r";
	}
	if ( ($cgi->param('FRO')) &&
		($cgi->param('FRO') eq "ON") )
	{
		$first_params = $first_params . "F";
	}
	if ( ($cgi->param('alt_database')) &&
		($cgi->param('alt_database') eq "ALL") )
	{
		$first_params = $first_params . "a";
	}
	# if none of the above variables were defined, then set the variable to an 
	# empty string.
	if (($first_params) && ($first_params =~ /\w+?/)) 
	{
		$first_params = "-" . $first_params . " ";
	}
	else 
	{
		$first_params = "";
	}

	## Build second parameter block
	# If the user has defined a database other than default
	if ( !($cgi->param('alt_database')) || 
		($cgi->param('alt_database') eq "ALL")) 
	{
		$second_params ="";
	}
	elsif ( ($cgi->param('alt_database')) && 
			($cgi->param('alt_database') eq "RIPE") ) 
	{
		$second_params ="-sRIPE ";
	}
	elsif ($cgi->param('alt_database'))
	{
		#assign the flag and the database name to the $second_params variable
		$second_params = "-s" . $cgi->param('alt_database') . " ";
	} 

	## Build third parameter block.
	# If the user has defined an object type other than default
	(@obj_type = $cgi->param('object_type')) unless ( !$cgi->param('object_type') );
	if ( (@obj_type) && ($obj_type[0] ne "All"))
	{
		my $temp_store = join ',' , @obj_type;
        $third_params = "-T" . $temp_store . " "; 
	}
	else 
	{
		$third_params = "";
	}

	## Build fourth parameter block
	#If the user has defined an attribute other than default
	($inverse_atts = $cgi->param('inverse_attributes')) unless ( !$cgi->param('inverse_attributes'));
	if ($inverse_atts && $inverse_atts ne "None") 
	{
		#assign the flag and the attribute name to the variable $fourth_params
		$fourth_params = "-i" . $inverse_desc_names{$inverse_atts} . " ";
	} 
	else 
	{
		$fourth_params = "";
	}
   
	## Build primary key option
	#If the user has defined an attribute other than default
	if ( ($cgi->param('primary_key')) && 
		($cgi->param('primary_key') eq "ON") ) 
	{
		#assign the flag and the attribute name to the variable $fourth_params
		$primary_key_option = "-K ";
	} 
	else 
	{
		$primary_key_option = "";
	}

	## Build reverse delegation domain option
	# If the user has defined an attribute other than default
	if ( ($cgi->param('reverse_delegation_domains')) &&
		($cgi->param('reverse_delegation_domains')  eq "ON") ) 
	{
		#assign the flag and the attribute name to the variable $fourth_params
		$domain_ref = "-d ";
	} 
	else 
	{
		$domain_ref = "";
	}
	
	## Build domain name referral option
	# If the user has defined an attribute other than default
	if ( ($cgi->param('domain_name_referral')) &&
		($cgi->param('domain_name_referral') eq "ON") ) 
	{
		#assign the flag and the attribute name to the variable $fourth_params
		$delegation_domain = "-R ";
	} 
	else 
	{
		$delegation_domain = "";
	}

	# attach -V flag to whois server with current version number of the cgi
	# and the ip address of the host making the query. 
	my $version_string = "-Vwhois_cgi_v$VERSION," . $cgi->remote_host() . " ";

	# Put together the entire query
	my $search_string =	 $version_string
						. $first_params 
						. $second_params
   						. $third_params
						. $fourth_params
						. $primary_key_option
						. $delegation_domain
						. $domain_ref
						. $cgi->param('searchtext');
						
	# Make the cgi full_query_string paramter value the same as the full query.
	# This is used for display on the test server. Serves no purpose on production
	# or another machine.
	$cgi->param(-name=>'full_query_string', 
				-value=>$search_string);
		  
	# send the query to the whois server and get the socket back for reading
	# as a filehandle.				
	$query_handle = make_whois_filehandle($cgi, $search_string);
	
	return $query_handle; # return the filehandle.										

} #end build_search_string

###############################################################################
# Function		: format_whois_object                                            
# Description	: Takes one object at a time and formats the object with 
#				: underlining, bolding and hypertext links. Then returns
#				: the object for printing to the browswer.
#				: 
# Input      	: new cgi object. 
#				: 1 raw object still hot from the socket 
#				:                                                   
# Output     	: The formatted object                  
###############################################################################
sub format_whois_object
{
	my (	$cgi,			# new cgi object.
			$raw_object		# single unformatted object.
		) = @_;
		
	my $cgi_script = $cgi->url();	# name of script.
	
	# form type being used by user.
	my $screen_to_display = $cgi->param('form_type') || 'simple';

	# escape object so as to prevent unintentional or michevious interpretation
	# as html code
	$raw_object = $cgi->escapeHTML($raw_object); 
	

	# declare local vars
	my (
		$new_object,	# flag to indicate new object for bold highlighting.
		$field, 		# left hand side of : indicating the field name
		$value,			# right hand side Of : indicating the value of the field
		$tmp_hold,		# used to store bolded field code for substitution in a new object
		$key,			# 1 element of a hash. for use when looping through the hashes
		$object_type,	# right hand value of hash.
		$line,			# 1 line of the object.
		$format_object	# The formatted object
		);
		
	# Hash tables for output formatting.
	my %object_inverse_keys = 	
		(	
			"as-block" 		=>	[	"tech-c", "admin-c", "mnt-lower",
									"mnt-by"	],
							
			"as-set"		=>	[	"mbrs-by-ref", "tech-c", "admin-c",
									"mnt-by" ],
													
			"aut-num"		=>	[	"member-of", "admin-c", "tech-c",
									"cross-mnt", "cross-nfy",
									"mnt-lower", "mount-routes", "mnt-by"	],
													
			"domain"		=>	[	"admin-c", "tech-c", "zone-c",
									"mnt-by", "mount-lower"	],
													
			"filter-set"	=>	[	"tech-c", "admin-c", "mnt-by"	],
			
			"inet6num"		=>	[	"admin-c", "tech-c",
									"mnt-by", "mnt-lower"	],
										
			"inetnum"		=>	[	"admin-c", "tech-c",
									"mnt-by", "mnt-lower", "mnt-routes"	],
										
			"inet-rtr"		=>	[	"local-as", "member-of", "admin-c", "tech-c",
									"mnt-by"	],
										
			"key-cert"		=>	[	"mnt-by"	],
				
			"limerick"		=>	[	"admin-c", "mnt-by"	],
			
			"mntner"		=>	[	"admin-c", "tech-c",
									"mnt-by", "referral-by"	],
									
			"peering-set"	=>	[	"tech-c", "admin-c", "mnt-by"	],
									
			"person"		=>	[	"mnt-by"	],
										
			"role"			=>	[	"admin-c", "tech-c", "mnt-by"	],
										
			"route"			=>	[	"member-of", "cross-mnt",
									"cross-nfy", "mnt-lower", "mnt-routes",
									"mnt-by", "origin"	],
										
			"route-set"		=>	[	"mbrs-by-ref", "tech-c", "admin-c",
									"mnt-by"	],
										
			"rtr-set"		=>	[	"mbrs-by-ref", "tech-c", "admin-c",
									"mnt-by"	],

			"irt"			=>	[	"admin-c", "tech-c", "mnt-by"	] 
		);
	
	# Hash table for primary keys
	my %object_primary_key = 	
		(	
			"as-block" 		=>	["as-block"],
			"as-set"		=>	["as-set"],
			"aut-num"		=>	["aut-num"],
			"domain"		=>	["domain"],
			"filter-set"	=>	["filter-set"],
			"inet6num"		=>	["inet6num"],
			"inetnum"		=>	["inetnum"],
			"inet-rtr"		=>	["inet-rtr"],
			"key-cert"		=>	["key-cert"],
			"limerick"		=>	["limerick"],
			"mntner"		=>	["mntner"],
			"peering-set"	=>	["peering-set"],
			"person"		=>	["nic-hdl"],
			"role"			=>	["nic-hdl"],
			"route"			=>	["route", "origin"],
			"route-set"		=>	["route-set"],
			"rtr-set"		=>	["rtr-set"],
			"irt"			=>	["irt"]
		);
		
	$new_object = 1; # set new object to true for intial entry into foreach loop
	
	# For the object type, look at each line of the object one by one
	# as you want to examine its lines individually.
	foreach my $line (split "\n", $raw_object) 
	{
		# Header message
		if ($line =~ /^%.+?/)
		{
			# Convert header message hyperlinks into actual hypertext links
			if ($line =~  /(http\:\/\/\S+)/)
			{
				$line =~  s/(http\:\/\/\S+)/$cgi->a({-href=>"$1"},$1)/e;
			}
				
			$format_object .= $line . "\n"; # add to the object var to be returned.
		}	
		# actual data line
		elsif ($line =~ /^(\w+?|\w+?-\w+?):\s*(.+)$/)
		{
			# Capture field and value data and assign to descriptive variables
			 ($field, $value) = ($1, $2);
			
			($field, $value) = split (/:\s{1,8}/,$line);

			# if its a new object make the field bold to show the object type explicitly.
			# then unset the new object flag.
			if ($new_object)
			{
				$tmp_hold = $cgi->b($field);	# bold the field.
				$line =~ s/$field/$tmp_hold/e;	# substitute for the bold code
				$object_type = $field;			# set object type to be the field value
				undef ($new_object);
			}
			
			# Here is where we check the hash for primary keys for the object type.
			# If there is a match. Underline the field value.
			foreach $key ( @{$object_primary_key{$object_type}} )
			{
				# If there is a match
				if ($field eq $key)
				{
					$tmp_hold = $cgi->u($field);	# assign temp var with the bolded code
					$line =~ s/$field/$tmp_hold/e;	# substitute in the temp var
				}
			}
				
			# Now check the line to see if there is a match for the inverse attributes
			# which we want to make into hypertext links. The links will allow further
			# searching by the user for more records.
			foreach $key ( @{$object_inverse_keys{$object_type}} )
			{
				# If the key and field match, convert the value bit into a hyperlink 
				if ($field eq $key)
				{
					# important to note: put in the form type being used so the user stays on same 
					# screen as they were using before.
					$tmp_hold = $cgi->a({-href=>"$cgi_script?searchtext=$value&form_type=$screen_to_display"},$value);
					my $escape_val = quotemeta($value); # to format correctly if strings contain metachars
					$line =~ s/$escape_val/$tmp_hold/e; 
				}
			}
			
			# add the line to the formatted object var.
			$format_object .= $line . "\n";
		}
		else
		{
			# if its another line apart from a data line of header line add it unaltered
			# as we don't want to lose output.
			$format_object .= $line . "\n";
		}

	} # end foreach

	return ($format_object); # return the formatted object
	
} # end do_whois_query

###############################################################################
# Function		: format_result_message                                            
# Description	: Formats the result message on the bottom of the result list. 
#				: Used to format the result string into something a little 
#				: more pretty for displaying to the user on the HTML page.
#				: 
# Input      	: scalars containing error count, number of objects and user query                                                  
# Output     	: scalar containing message for user                                
###############################################################################
sub format_result_message
{

	my (
		$error_count,	# the number of errors returned in the output
		$numobjects,	# total number of objects query generated
		$user_query		# only the string put into the searchtext text field
		) = @_;
		
	my $user_information_string; # the message string to be returned.
   
	#present a meaningful message the user based on the number of searches returned.
	if ($error_count > 0) 
	{
    	$user_information_string = "No records found for '$user_query'";
	} 
	elsif (($error_count == 0) and ($numobjects == 1)) 
	{
    	$user_information_string = "1 record found for '$user_query'";
	}
	elsif (($error_count == 0) and ($numobjects >= 1)) 
	{
   		$user_information_string = $numobjects .  " records found for '$user_query'";
	}
	else 
	{
    	$user_information_string = "Result for '$user_query'";
	}

	return ($user_information_string); # return the message string.

} #end print_formatted_result

###############################################################################
# Function		: get_alternative_dbases                                            
# Description	: Perform a query to get the list of alternative
#				: database sources. Capture process time and make a log entry.
#				: The array which holds the alternative databases list is a 
#				: global var that is cached in memory by the apache webserver.
#				: This effectively means we only have to do the query when the
#				: var goes out of the memory stack. In reality it means we only
#				: have do this query once every 10 minutes or so. Its a nice way of
#				: of putting apache global variable caching to work for us and
#				: getting some benefit out of us.                   
# Input      	: None
# Output     	: Populates a global array containing the list of database sources                                 
###############################################################################
sub get_alternative_dbases
{
	my ($postquery_time, 	# time after query
		$prequery_time, 	# time before query
		$whois_connection,	# socket through which we push the query for alt databases
		$answer,			# 1 line of the results
		$source,			# used to see if there was a regex match in the while loop
		$logentry 			# description line to go into whois.log file
		);
	
	# if there is no defn of this variable then continue and make a query.
	if ( !(@database_list) )
	{
		#Make connection to host. If connection fails go to error handler and quit
		if (! ($whois_connection = new IO::Socket::INET (
        						PeerAddr=>'whois.ripe.net',
        						PeerPort => 43,
        						Proto => 'tcp',
        						Type => SOCK_STREAM
								)) ) 
		{
			print STDERR "Can't make whois server connection: $!\n";
			print_error_and_exit();
		}

		$prequery_time = [gettimeofday];	#time before query.

		# make the query to whois server over the socket
		print $whois_connection "-q sources\n"; 

		# read the lines of output from the socket as a filehandle
		while ( $answer = <$whois_connection> )
		{
			# bypass the crap not needed
			next if ( $answer !~ /^\w/ );

			# check if line is an actual database source.
			# if it is put it into our list (array).
			$source = $answer =~/(\w+):.*/;
			push (@database_list, "$1") if ($source);
		}
		
		push (@database_list, "ALL"); # add 'all' to array.

		$postquery_time = [gettimeofday]; # time after the query and processing
	
		close ($whois_connection); # close the filehandle

		# Get log entry details together
		$logentry = 	"PID: $$\n" . "query: <dbsources>\n" .
						"screen: NULL\n";

		# make a log entry
		log_entry ($logentry,"sources",$prequery_time,$postquery_time);
		
	} # end if
		
	return 1; # return with success value

}#end get_alternative_dbases

###############################################################################
# Function		: log_entry                                            
# Description	: Creates an entry in the logfile 
# Input      	: Query type, query start time, query end time, and log details
#				: receives the scalar containing the help text to be displayed.
#				: Not all of the parameters are supplied in certain cases. The ones
#				: that may be missing are the time params. In which case no time
#				: logging is done.                                               
# Output     	: None                                
###############################################################################
sub log_entry
{
	my ($logentry,			# details to go into the log
		$qtype,				# was it a dbase sources or user query
		$prequery_time,		# time before query
		$postquery_time		# time after query
		) = @_;

	# Add query type to the log entry details
	if ( $qtype && ($qtype eq "user") )
	{
		$logentry .= "USER QUERY\n";
	}
	elsif ( $qtype )
	{
		$logentry .= "DBASE-SRC QUERY\n";
	}

	# make a time entry for the query if this variable is defined
	if ( $prequery_time )
	{
		# calculate elapsed time and add it to the log entry details
		my $elapsed_time = tv_interval($prequery_time, $postquery_time);
		$logentry .= "server proc time: $elapsed_time\n";
	
		#timestamp the data entry by putting the time in seconds
		#into the global scalar 
		my ($sec,$min,$hour,$dayofweek,$month) = localtime(time);
		my $timestamp = "$dayofweek-" . ++$month . " $hour:$min:$sec";
		$logentry .= "time: $timestamp\n";
	}
	
	$logentry .= "-------------\n"; # record seperator line

	# logfile path
	my $logfilename = "/var/www/cgi-data/whois/whois.log";

	#write to the file. Locking is used to avoid concurrent write problems.
	if (! open (LOGFILE, ">>$logfilename", ) )
	{
		print STDERR "Cannot open logfile: $!\n";
		print_error_and_exit();
	}

	eval 
	{
		#localise the sigalrm declaration scope
		local $SIG{ALRM} = sub { die "TIMEOUT\n" };
		alarm (30);
		
		eval 
		{
			#attempt lock on file
			flock(LOGFILE, LOCK_EX()) or die "Cannot flock: $!\n";
		};
		alarm (0); #reset alarm

		die ($@) if ($@); 	#if there was an error propogate the magic var
							#to the outer eval block.
	};
	alarm (0);

	# if we timed out there was a problem with the locking. Make a not of it in 
	# the httpd error log, and go to the error handler.
	if ($@ eq "TIMEOUT\n")
	{
		print STDERR "Cannot flock $logfilename: Operation timed out.\n";
		print_error_and_exit();
	}	
	elsif ($@)
	{
		print STDERR "Cannot flock $logfilename: $@\n";
		print_error_and_exit();
	}

	# print the details to the logfile
	print (LOGFILE $logentry);
	
	# close the logfile filehandle
	close (LOGFILE);
	
	# leave with a success value
	return 1;

} #end log_entry

###############################################################################
# Function		: make_whois_filehandle                                            
# Description	: Open up a socket to the whois server. Send the query through
#				: and return the socket for reading.   
# Input      	: Search string query, and new cgi object
# Output     	: Scalar which is the socket.                              
###############################################################################
sub make_whois_filehandle
{
	my ($cgi, 			# new cgi object
		$search_string 	# the complete query string 
		) = @_;
	
	my ($whois_connection, 	# Filehandle which is the socket connection to the whois server
		$prequery_time, 	# time before query
		$postquery_time, 	# time after query
		$logentry			# log entry descriptions
		);

	# get the form type for the log
	my $form = $cgi->param('form_type') || "simple";

	# test to see if the user actually filled in the form before hitting 'submit'
	if ($search_string)
	{
		# Make log entry details
		$logentry = 	"PID: $$\n" . "query: $search_string\n" .
						"screen: $form\n";
	}
	# if they didn't make any entry to that effect. Good for analysis later of donkey queries
	else
	{
		# Make log entry details
		$logentry = 	"PID: $$\n" . "query: No Query String\n" .
						"screen: $form\n";
	}

	# Make connection to host. If connection fails print an error to the HTML page
	# via subroutine &print_error_and_exit. 
	if (! ($whois_connection = new IO::Socket::INET (
        PeerAddr=>'whois.ripe.net',
        PeerPort => 43,
        Proto => 'tcp',
        Type => SOCK_STREAM
		)) )
	{
		print STDERR "Can't make whois server connection: $!\n";
		print_error_and_exit();
	}

	$prequery_time = [gettimeofday];	#time before query for logging.

	print $whois_connection "$search_string\n"; # send the query to the whois server
	
	$postquery_time = [gettimeofday];	# time after query for logging.
	
	# make a log entry 
	log_entry($logentry,"user",$prequery_time,$postquery_time);

	return $whois_connection;	# return the filehandle to be read from.

} #make_whois_filehandle

###############################################################################
# Function		: Print an error message and exit the cgi                                            
# Description	: Builds an html table with an error message prints it and then
#				: exits the program                    
# Input      	: None
# Output     	: The printed html page                               
###############################################################################
sub print_error_and_exit
{
	#print message to html page
	print 	#"Content-Type: text/html\r\n\r\n".
   			"<table width=645 align=left><tr>" .
			"<td><font size=4>Whois is experiencing problems, " .
			"please try your query again in a few minutes." .
			"</font></td></tr>" .
			"<tr><td><font size=4>" .
			"You can use your browser back button to return to the Whois query form. " .
			"Or go back to the <A HREF=\"http://www.ripe.net/\">Ripe Homepage</A>" .
			"</font></td></tr></tr></table>";


	#print exit message to error log and get out gracefully
	print STDERR "Forced exit by error handler subroutine\n";
	exit;
	
}# end print_error_and_exit

##########################################################################################
