#!/usr/bin/perl -w # # Copyright (c) 2002 Robert Waldner # # 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 # 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. # # A copy of the GNU General Public License should have been available # whereever you got this program from, and you should have been # encouraged to get and read it. If not, you can get it from # or # , or write to the # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # Please note that other licenses (especially the Artistic License # for the PERL-language/-interpreter) may also apply. It is solely your # responsibility to abide by the terms of whatever licenses apply. # # An up-to-date version of this script should be available via # . # # Note that per default this script will mail the original author (me ;-) ) # a copy of each attempted exploit, if you do not want that, go edit the # code (look for "$cc"). It also relies heavily on Debian'isms and Apache. # make output unbuffered select STDERR; $| = 1; select STDIN; $| = 1; select STDOUT; $| = 1; use CGI; use FileHandle; my $query = new CGI; print < traceroute from ka.graffl.net EOF print ("\n"); print ("

\n"); print < support my beer-consumption
with ad-clicking if you please EOF my $params = $query->param(); if (defined $query->param("trace_to")) { $destination = $query->param("trace_to"); # cut off leading and trailing spaces while ($destination =~ /^\ /) { $destination =~ s/^\ //g; } while ($destination =~ /\ $/) { $destination =~ s/\ $//g; } while ($destination =~ /\/$/) { $destination =~ s/\///g; } while ($destination =~ /http/) { $destination =~ s/http//g; } while ($destination =~ /:/) { $destination =~ s/://g; } while ($destination =~ /.*\//) { $destination =~ s/"^.*\/"//g; } if ($destination !~ /^[0-9a-z\.\-]+$/i) { print ("

Illegal character detected in input

\n"); print ("I could pare it down to $destination, but that's about it.
\n"); print ("What characters are allowed?
\n"); print ("a-z A-Z 0-9 . -
\n"); print ("No URLs (eg http://...)!
\n"); $file = new FileHandle; if ($file->open(">/tmp/x.x")) { print $file "Here is what I could gather:\n\n"; foreach(sort keys(%ENV)) { print $file "$_: $ENV{$_}\n"; } print $file "\n\n"; print $file "The offending string was: \"", $destination, "\"\n"; } $file->close; my $rcpt = $ENV{"SERVER_ADMIN"}; my $cc = "waldner+trace.pl-exploit\@waldner.priv.at"; system ("cat /tmp/x.x \| /usr/bin/mail -s \"nph-trace.pl exploit attempt\" -c $cc $rcpt"); system ("rm /tmp/x.x"); my $host = $ENV{"REMOTE_ADDR"}; print $query->end_html; die "$host tried to hack us...\n"; } print ("

Tracing route to ",$destination,".

\n"); print ("Be patient, this will take a while "); print ("(there is intentional slow-down to prevent abuse)...
\n"); print ("

\n"); my $host = $destination; open TR, "/usr/sbin/traceroute -p 33434 $host 2>&1 |" or die "Error executing traceroute"; while() { chomp $_; $_ =~ s/\ /\ \;/g; print ("$_
\n"); sleep 1; } close TR; print ("

\n"); # print ("

Now for something completely different

\n"); # $host = $ENV{"REMOTE_ADDR"}; # print ("

What RIPE knows about your host ($host)

\n"); # my $line = "/usr/bin/whois -a -h whois.ripe.net $host"; # open TR, "$line 2>&1 |" or die "Cannot open pipe"; # print ("

\n");
#    while()  
#      { chomp $_;
#        print ("$_\n");
#      }
#    close TR;
#    print ("

\n"); print ("

Some credentials your browser sent

\n"); sleep 1; print ("Your address: ", $ENV{"REMOTE_ADDR"}, "
\n"); sleep 1; print ("Your host: ", $ENV{"REMOTE_HOST"}, "
\n"); sleep 1; print ("Your user-agent: ", $ENV{"HTTP_USER_AGENT"}, "
\n"); sleep 1; print ("Port your query originated from: ", $ENV{"REMOTE_PORT"}, "
\n"); sleep 1; print ("Encodings your browser accepts: ", $ENV{"HTTP_ACCEPT_ENCODING"}, "
\n"); sleep 1; print ("Content-types your browser pretends to understand: ", $ENV{"HTTP_ACCEPT"}, "
\n"); sleep 1; } else { # print ($query->start_form); print ("