#!/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>", $/;
    }
}
[download]