#!/usr/bin/perl -wT
use strict;
use CGI;
$CGI::DISABLE_UPLOADS = 1;			# Disable uploads
$CGI::POST_MAX = 512 * 1024 * 1;	# limit posts to 512K max
#comment next line when live
#use CGI::Carp qw/ fatalsToBrowser /;
use lib '/home/4220/lib';
use CGI::Safe qw/ taint /;
$| = 1;

use vars qw/ $q %param $traceroute $whois $ping $ping_count $debug
			%whois $whois_server1 $whois_server2 /;

#comment next line when live
#$debug = 0;

$traceroute = '/usr/bin/traceroute';
$whois		= '/usr/bin/whois';
$ping		= '/bin/ping';
$ping_count	= 5;

$whois_server1 = 'whois.internic.net';
$whois_server2 = 'whois.nic.';

###

$q = CGI::Safe->new;
%param = $q->Vars;

print	$q->header,
		$q->start_html(-title=>'internet tools'),
		$q->center(
		$q->start_table(-border=>'0'),
			$q->Tr(
					$q->td($q->b('TRACEROUTE')),
					$q->td(' '),
					),
			$q->start_form(-method=>'get'),
			$q->Tr(
					$q->td('enter IP address'),
					$q->td($q->textfield(-name=>'tracerouteip1',
										-size=>'3',
										-maxlength=>'3'),
							$q->b('.'),
							$q->textfield(-name=>'tracerouteip2',
										-size=>'3',
										-maxlength=>'3'),
							$q->b('.'),
							$q->textfield(-name=>'tracerouteip3',
										-size=>'3',
										-maxlength=>'3'),
							$q->b('.'),
							$q->textfield(-name=>'tracerouteip4',
										-size=>'3',
										-maxlength=>'3'),
							),
					$q->td($q->submit),
					),
			$q->endform,
			$q->start_form(-method=>'get'),
			$q->Tr(
					$q->td('enter domainname'),
					$q->td($q->textfield(-name=>'traceroutedomain',
										-size=>'15'),
							),
					$q->td($q->submit),
					),
			$q->endform,
			$q->Tr(
					$q->td(' '),
					$q->td(' '),
					),
			$q->Tr(
					$q->td($q->b('WHOIS')),
					$q->td(' '),
					),
			$q->start_form(-method=>'get'),
			$q->Tr(
					$q->td('enter domain name'),
					$q->td($q->textfield(-name=>'whois',
										-size=>'25'),
							),
					$q->td($q->submit),
					),
			$q->endform,
			$q->Tr(
					$q->td(' '),
					$q->td(' '),
					),
			$q->Tr(
					$q->td($q->b('PING')),
					$q->td(' '),
					),
			$q->start_form(-method=>'get'),
			$q->Tr(
					$q->td('enter IP address'),
					$q->td($q->textfield(-name=>'pingip1',
										-size=>'3',
										-maxlength=>'3'),
							$q->b('.'),
							$q->textfield(-name=>'pingip2',
										-size=>'3',
										-maxlength=>'3'),
							$q->b('.'),
							$q->textfield(-name=>'pingip3',
										-size=>'3',
										-maxlength=>'3'),
							$q->b('.'),
							$q->textfield(-name=>'pingip4',
										-size=>'3',
										-maxlength=>'3'),
							),
					$q->td($q->submit),
					),
			$q->endform,
			$q->start_form(-method=>'get'),
			$q->Tr(
					$q->td('enter domainname'),
					$q->td($q->textfield(-name=>'pingdomain',
										-size=>'15'),
							),
					$q->td($q->submit),
					),
			$q->endform,
		$q->end_table(),
			);


# what has to be done?
if (defined $param{tracerouteip1}) {
	tracerouteip();
}
elsif (defined $param{traceroutedomain}) {
	traceroutedomain();
}
elsif (defined $param{whois}) {
	whois();
}
elsif (defined $param{pingip1}) {
	pingip();
}
elsif (defined $param{pingdomain}) {
	pingdomain();
}

print $q->end_html;

exit;


sub tracerouteip {
	if ($debug) {debug("started \&tracerouteip")};
	
	my $ip = untaint_ip( \$param{tracerouteip1}, \$param{tracerouteip2},
						\$param{tracerouteip3}, \$param{tracerouteip4} )
		or return;

	traceroute( \$ip );
}

sub traceroutedomain {
	if ($debug) {debug("started \&traceroutedomain")};
	
	my $domain = untaint_domain( \$param{traceroutedomain} )
		or return;
	
	traceroute( \$domain );
}

sub traceroute {
	### This sub requires a reference to 1 string to be passed to it
	#	The ip address or domain name to be used
	
	if ($debug) {debug("started \&traceroute")};
	my ($search, $result);
	
	$search = ${$_[0]};
	if ($debug) {debug("going to pass $search to traceroute")};
	
	print '<pre>';
	$result = open(TRACEROUTE, " $traceroute $search 2>&1 | ")
		or print $?;
	while (<TRACEROUTE>) {
		print;
	}
	print '</pre>';
}

sub whois {
	if ($debug) {debug("started \&whois")};
	my ($domain, $option, $result);
	
	$domain = untaint_domain( \$param{whois} );
	$option = $domain . '@';
	
	if ( $domain =~ /(com|net|org|edu)$/ ) {
		$option .= $whois_server1;
	}
	elsif ( $domain =~ /([a-zA-Z]+)$/ ) {
		$option .= $whois_server2;
		$option .= $1;
	}
	else { return }
	
	print '<pre>';
	$result = open(WHOIS, " $whois $option 2>&1 | ")
		or print $?;
	while (<WHOIS>) {
		print;
	}
	print '</pre>';	
}

sub pingip {
	if ($debug) {debug("started \&pingip")};
	
	my $ip = untaint_ip( \$param{pingip1}, \$param{pingip2},
						\$param{pingip3}, \$param{pingip4} )
		or return;

	ping( \$ip );
}

sub pingdomain {
	if ($debug) {debug("started \&pingdomain")};
	
	my $domain = untaint_domain( \$param{pingdomain} )
		or return;
	
	ping( \$domain );
}

sub ping {
	### This sub requires a reference to 1 string to be passed to it
	#	The ip address or domain name to be used
	
	if ($debug) {debug("started \&ping")};
	my ($search, $result);
	
	$search = ${$_[0]};
	if ($debug) {debug("going to pass $search to ping")};
	
	print '<pre>';
	$result = open(PING, " $ping -c $ping_count $search 2>&1 | ")
		or print $?;
	while (<PING>) {
		print;
	}
	print '</pre>';
}

sub untaint_ip {
	### This sub requires a reference to 4 strings passed to it
	# The IP address to be untainted
	my ($tainted, $untainted);
	$tainted = ${$_[0]} . '.' . ${$_[1]} . '.' . ${$_[2]} . '.' . ${$_[3]};
	unless ( $tainted =~ /^
							(
								\d{1,3}		#1-3 numeral
								\.			#period
								\d{1,3}		#and so on...
								\.
								\d{1,3}
								\.
								\d{1,3}
							)				#catch all in $1
							$/x ) {
		print 'illegal input';
		return 0;
	}
	$untainted = $1;
	if ($debug) {debug("\&untaint_ip is returning $untainted")};
	return $untainted;
}

sub untaint_domain {
	### This sub requires a reference to 1 string passed to it
	#	The domain name to be untainted
	my ($tainted, $untainted);
	$tainted = ${$_[0]};
	$tainted =~ ( s/^www\.(.*)$/$1/i );
	
	unless ( $tainted =~ /^
							(
								[a-zA-Z0-9]		#must start with
								[a-zA-Z0-9.-]*	#then any of
								\.				#must have 1 period
								[a-zA-Z]+		#at least one of
								(\.[a-zA-Z]+)?	#then any of
							)					#catch all in $1
							$/x ) {
		print 'illegal input';
		return 0;
	}
	$untainted = $1;
	if ($debug) {debug("\&untaint_domain is returning $untainted")};
	return $untainted;
}

sub debug {
	for (@_) {
		print $_, "<br>", $/;
	}
}