#!/usr/local/bin/perl -wT --*-Perl-*-- # # This is a cgi program that will traceroute from the server it's running on back to # the machine the client's web browser is running on or another host that the client # specifies. # # It can be used by your customers/clients to help diagnose connectivity problems # to your web server # # Security: This program has been written with Perl 'taint' mode on and all # external data is laundered before use. There are also some restrictions # designed to prevent users from tracerouting into private IP space in your # network. Read the code for details. # # Author: Paul Farrall pfarrall@brains2bytes.com # Copyright 2001, 2002 Paul Farrall # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or (at # your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA # #$Id: traceroute,v 1.4 2002/03/07 22:45:32 pfarrall Exp $ use strict; use CGI qw(param -debug); use Socket; use PaulCommon; $|++; ################################################################################ # Global Vars. Modify as needed ################################################################################ $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin'; $ENV{BASH_ENV} = ""; my $PROGNAME = "traceroute"; # The name of the program, used for links, notices. my $TRACEROUTE = "/usr/sbin/traceroute"; # Location of your traceroute binary my $OPTIONS = "-m 30 -q 1 -w 3"; # Options for traceroute cmd my $PSCMD = "ps -ef"; # ps cmd that will list all procs, long listing my $TIMEOUT = 60; # Seconds to wait for traceroute to complete. my $MAX_PROCS = 10; # max simultaneous traceroutes my $SERVER = $ENV{SERVER_NAME}; # hostname of this server # # @deny_target array contains regexes. # No traceroutes will be allowed to IP addresses that match the regex. # my @deny_targets = ( '^10.10', # Private IP space '^172.17', '.255$', # Broadcast address 'localhost' ); # # @deny_client array contains regexes. Use of this tool will be denied to # IP addresses that match any of these regexes. # my @deny_clients = qw (); # # Customize this HTML for your site. # my $HTML = <

RS/GIS Unix Traceroute

This CGI is attempting to do a traceroute from this server ($SERVER) to your machine. The results are printed below. To perform a traceroute to a different machine, enter the desired target host.domain (e.g. www.yahoo.com) or Internet address (e.g. 137.138.28.228) in the box below:

Target hostname or IP address:

Reset traceroute 
END
    ;
################################################################################
# END Customize.  You shouldn't have to change anything below this line.
################################################################################

print_header('RS/GIS UNIX Traceroute util');
my ($target_addr, $target_host, $client_host, $client_addr);
print $HTML;

# Get IP/hostname from ENV
$client_addr = addr_from_env();   #addr is laundered
$client_host = addr2host($client_addr);  

if (defined(param())) {
    ($target_addr, $target_host) = get_cgi_args();  #addr, host laundered
} else {
    $target_addr = $client_addr;
    $target_host = $client_host;
}

# if security OK
if ( security_ok($target_addr, $target_host, $client_addr, $client_host) ) {
    if ( system_load_ok() ) {
	print "Commencing Traceroute from $SERVER to $target_addr ($target_host)....\n";
	trace($target_addr);
    }
} else {
    print "

Oops. There was a problem with the target. ", "Start over and notify the webmaster if you continue to have problems.", "
\n"; } print "

\n"; print_footer(); exit; ################################################################################ # # Returns IP address from %ENV or undef if not found. # sub addr_from_env { my $addr = undef; # Find target IP address if ( defined($ENV{'HTTP_X_FORWARDED_FOR'}) ) { # proxy that passes the client's address: $addr = $ENV{'HTTP_X_FORWARDED_FOR'}; } elsif (defined($ENV{'REMOTE_ADDR'})) { $addr = $ENV{'REMOTE_ADDR'}; } return validate_addr_format($addr); } sub validate_addr_format { my $addr = shift; if ( defined($addr) && $addr =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/ ) { return $1; } else { return undef; } } sub host2addr { my $host = shift; my $addr = undef; if (! defined($host) || $host eq "") { return undef; } # needs to be modified to account for multiple addr per hostname $addr = inet_ntoa(inet_aton($host)); if (defined($addr)) { return $addr; } else { print "ERROR: Unable to resolve Address for '$host'\n"; return undef; } } sub addr2host { my $addr = shift; my $host = undef; return unless defined($addr); # if REMOTE_HOST environment variable is defined # let it override any lookup value. if (defined (my $val = $ENV{'REMOTE_HOST'}) ) { if ( $val =~ /^([\w\-\.\_]+)/ ) { $host = $1; } } else { $host = gethostbyaddr(inet_aton($addr), AF_INET); } return (defined($host) && $host ne "") ? $host : ""; } # # Returns addr and hostname or empty list on error. # sub get_cgi_args { my ($addr, $host); my $target = defined(param('target')) ? param('target') : ""; return if ($target eq ""); # Target is an IP address if ( $target =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/ ) { $addr = $1; $host = addr2host($addr); # Target is FQDN } elsif ( $target =~ /((\w+[\.\-\_])+\w{2,3})/ ) { $host = $1; $addr = host2addr($host); # Target looks like unqualified hostname. } elsif ( $target =~ /([\w\-\_]+)/ ) { $host = $1; $addr = host2addr($host); } return ($addr, $host); } # # Returns true if no problems with target addr/host # Returns undef if there are problems # sub security_ok { my $target_addr = shift; my $target_host = shift; my $client_addr = shift; my $client_host = shift; # If addr is undefined, no point in continuing if ( (!defined($target_addr)) || $target_addr eq "") { print "ERROR: No IP Address for Target\n"; return undef; } # Just make sure target_hostname is not too long # print "checking for len
\n"; if (length($target_addr) > 256) { print "ERROR: host name is too long.
\n"; return undef; } # print "checking target against access lists\n"; if ( map { $target_addr =~ /$_/i } @deny_targets ) { print "ERROR: Sorry, traceroute to $target_addr is denied\n"; return undef; } elsif ( map { $target_host =~ /$_/i } @deny_targets ) { print "ERROR: Sorry, traceroute to $target_host is denied\n"; return undef; } # print "checking client against access lists\n"; if ( map { $client_addr =~ /$_/i } @deny_clients ) { print "ERROR: Sorry, client '$client_addr' is not allowed to use this tool\n"; return undef; } elsif ( map { $client_host =~ /$_/i } @deny_clients ) { print "ERROR: Sorry, client $client_host is not allowed to use this tool\n"; return undef; } #print "Security O.K.\n"; return 1; } sub trace { my $target = shift; local $SIG{ALRM} = sub { die "TIMED OUT" }; eval { alarm($TIMEOUT); open( TO, "$TRACEROUTE $OPTIONS $target 2>&1|"); while () { print; } alarm(0); }; if ( $@ =~ /TIMED OUT/ ) { print "Stopped waiting for traceroute to finish\n"; } close(TO); alarm(0); return; } # # Make sure system load is acceptable. # Return True if it is, undef otherwise. # sub system_load_ok { # Make sure there aren't too many traceroutes running. my @procs = `$PSCMD|grep $TRACEROUTE`; if (@procs > $MAX_PROCS) { print("Sorry, system load is too high to run your traceroute.\n", "Try again later\n\n"); return undef; } return 1; }