$! Traceroute.COM
$!
$! Do a Traceroute
$!
$! This search takes a single string and a set of additional
$! qualifiers.  Then it does a traceroute.
$!
$! Inputs from the form will be:
$!
$!  (X_)QUERY - the text of the query (spaces are + characters)
$!  (X_)AS    - if set to "YES," then will do AS lookups
$!  (X_)LRR   - if set to a station, will trace from there
$!  (X_)MAX   - if set to an integer, will be maximum TTL. Default 30.
$!  (X_)MIN   - if set to an integer, will be minimum TTL. Default 4.
$!  (X_)NUM   - if set to an integer, will be number probes. Default 3.
$!  (X_)NOSYM - if set to "YES," then will NOT do DNS lookups
$!
$! An example of this might be:
$!
$! <td>
$! <center>
$! <form method="post" action="http://www.ibs-net.com/htbin/search-or">
$! <input name="index" type="hidden" value="disk$ebony:[ibs.www]ibsfulltext">
$! <input type="hidden" name="addsearch0" value="keyart">
$! <input type="text" size=20 maxlength=100 name="Query" value="">
$! <input type="image" align=absmiddle alt="Search" border=0
$! src="img/search.gif"><p>
$! </form>
$! </center>
$! </td>
$! 
$! Inputs are available AFTER CGI_SYMBOLS is executed
$!
$! Definitions
$!
$ nl = f$fao("!/")		! a newline
$ say = "write net_link "	! write to the server
$ wso = "write sys$output "	! write to the logfile
$!
$! We assume that "TRACEROUTE" has been defined as a foreign
$! command.  If it hasn't, then do that here. 
$!
$! TRACEROUTE = F$Parse("TRACEROUTE.EXE;", F$Environment("PROCEDURE"))
$! TRACEROUTE = "$''TRACEROUTE'"
$!
$! - define the symbols we EXPECT to see so that we don't go into
$!   loops looking for them.  Hopefully, SET_DCL_ENV will redefine
$!   these, but we are protected against buggy forms. 
$!
$ x_QUERY = "warez.opus1.com"
$ x_AS = "NO"
$ x_DEBUG = "NO"
$ x_LSRR = ""
$ x_MAX = 30
$ x_MIN = 4
$ abs_MIN = 1
$ x_NUM = 3
$ x_NOSYM = "NO"
$ x_OWNER = "NO"
$ x_SPRAY = "YES"
$ DELAY = "NO"
$ WWW_HTTP_REFERER = "/dev/null"
$!
$! Find out our host name
$!
$! say "<DNETHOST>"
$! read net_link host
$!
$! say "<DNETRECMODE>"		! Set implied carriage control
$!
$ mcr 'f$parse("SET_DCL_ENV.EXE;",f$environment("PROCEDURE")) "WWW_" "X_"
$!
$ say "content-type: text/html",nl 	! CGI header
$ say "status: 200 Traceroute Rules",nl
$ say "",nl,nl
$!
$! Check to see if this is coming from combat.uxn.com; if so, then
$! change the absolute minimum to a new minimum which will avoid including
$! the first few hops.
$! 20020309/jms - added some other domains which are also going through us
$!
$ h_refer = f$edit(WWW_HTTP_REFERER,"upcase,collapse,trim")
$ if (f$locate("COMBAT.UXN.COM",h_refer) .ne. f$length(h_refer)) then -
	$ abs_MIN = 5
$ if (f$locate("NETDEMON.NET",h_refer) .ne. f$length(h_refer)) then -
	$ abs_MIN = 5
$ if (f$locate("GOGETTEM.COM",h_refer) .ne. f$length(h_refer)) then -
	$ abs_MIN = 5
$abs_MIN = 10  ! fuckem - ehud
$!+++ ehud code
$! me=f$environment("procedure")
$! datfile = f$element(0,";",me) - ".COM" + ".DAT"
$! if .not. f$exists(datfile) create 'datfile'
$!---
$!
$! Make sure that we got legal inputs 
$!
$ query = f$edit(X_query,"COLLAPSE,UNCOMMENT,LOWERCASE")
$!
$!+++ Ehud Code
$! open/append dat 'datfile'
$! write dat f$time()+": referer: "+h_refer+" target: "+query
$! close dat
$!--- Ehud Code
$!
$ call validate_string "''query'"
$ max = f$edit(X_max,"COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''max'"
$ if (max   .gt. 30) then $ max = 30
$ if (max   .lt. 1 ) then $ max = 1
$ min = f$edit(X_min,"COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''min'"
$ if (min   .gt. 30) then $ min = 30
$ if (min   .lt. abs_MIN)  then $ min = abs_MIN
$ if (max .le. min) then $ max = min + 1
$ num = f$edit(X_num,"COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''num'"
$ if (num   .gt. 100) then $ num = 100
$ if (num   .lt. 1)  then $ num = 1
$ if (num .ne. 3) then $ delay = "YES"
$ as  = f$edit(X_as, "COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''as'"
$ owner  = f$edit(X_owner, "COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''owner'"
$ spray  = f$edit(X_spray, "COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''spray'"
$ lsrr = f$edit(X_lsrr, "COLLAPSE,UNCOMMENT,LOWERCASE")
$ call validate_string "''lsrr'"
$ if (lsrr .eqs. "default") then $ lsrr = ""
$ nosym = f$edit(X_nosym, "COLLAPSE,UNCOMMENT,UPCASE")
$ call validate_string "''nosym'"
$!
$ if (x_debug .nes. "UBETCHA") then $ goto A1
$ say "Args ''p1' ''p2' ''p3' ''p4' ''p5' ''p6'<BR><HR>"
$ say "x_query ''x_query'<br>"
$ say "x_as ''x_as'<br>"
$ say "x_delay ''x_delay'<br>"
$ say "x_lsrr  ''x_lsrr'<br>"
$ say "x_max ''x_max'<br>"
$ say "x_min ''x_min'<br>"
$ say "x_num ''x_num'<br>"
$ say "x_nosym ''x_nosym'<br>"
$ say "x_owner ''x_owner'<br>"
$ say "x_spray ''x_spray'<br>"
$ say "abs_min ''abs_min'<br>"
$A1:
$!+++
$! Trap out some special addresses which are not our problem
$!---
$ call validate_ipaddr "''query'"
$!+++
$! Build the command
$!---
$! Special HTML switch, courtesy of Ehud Gavron for Enhanced Traceroute!
$ switches = "/TERM=<br>"
$! /AS_LOOKUP
$ if (as .eqs. "YES")
$ then
$	switches = switches + "/AS_LOOKUP"
$ endif
$! /AUTOMAGIC
$ switches = switches + "/AUTOMAGIC"
$! /DEBUG 
$!	accept default
$! /DELAY_STATS
$ if (delay .eqs. "YES")
$ then
$	switches = switches + "/DELAY"
$ endif
$! /LSRR
$! if (lsrr .nes. "") 
$! then
$!	switches = switches + "/LSRR=''lsrr'"
$! endif
$! /MAXIMUM_TTL
$ switches = switches + "/MAXIMUM_TTL=''max'"
$! /MICROTIMERS
$ switches = switches + "/MICROTIMERS"
$! /MINIMUM_TTL
$ switches = switches + "/MINIMUM_TTL=''min'"
$! /MTU_DISCOVERY
$!	accept default
$! /NUMBER_OF_PROBES
$ switches = switches + "/NUMBER_OF_PROBES=''num'"
$! /OUTPUT
$!	accept default
$! /OWNER
$ if (owner .eqs. "YES")
$ then
$	switches = switches + "/OWNER"
$ endif
$! /PORT
$!	accept default
$! /SOURCE
$!	accept default
$! /SPRAY
$ if (spray .eqs. "YES")
$ then
$	switches = switches + "/SPRAY"
$ endif
$! /SYMBOLIC_ADDRESSES
$ if (nosym .eqs. "YES")
$ then
$	switches = switches + "/NOSYMBOLIC_ADDRESSES"
$ endif
$! /TYPE_OF_SERVICE
$!	accept default
$! /VERBOSE
$!	accept default
$! /WAIT_TIME
$!	accept default
$!
$!
$! Run the command...
$!
$ if (x_debug .nes. "UBETCHA") then $ goto A2
$ say "query ''query'<br>"
$ say "switches ''switches'<br>"
$A2:
$!
$ say "<HTML><HEAD><TITLE>Traceroute to ''query'</TITLE></HEAD>",nl
$ say "<BODY><H2>Tracing from Opus One to ''query'</H2>",nl
$! 
$ say "<HR><PRE>",nl
$!
$! If this is from Combat.UXN.COM, tell them
$!
$!+++ no more mr nice guy - ehud
$! if (f$locate("COMBAT.UXN.COM",h_refer) .ne. f$length(h_refer)) then -
$! $ say "Traceroute for combat.uxn.com users starts at hop 8 for best speed",nl
$!---
$ define/nolog/user sys$output net_link 
$ traceroute 'query' 'switches'
$ say "</PRE><HR>",nl
$! 
$ say "<a href=""http://www.opus1.com/o/nospamtrace.html""><b>",nl
$ say "Spam Fighters:</b> Click here now!</a><hr>",nl
$!
$ say "<P>For more information on enhanced traceroute, ",nl
$ say "read the <A",nl
$ say "HREF=""ftp://ftp.aces.com/pub/software/traceroute/traceroute.faq"">",nl
$ say "FAQ</A><P>",nl
$ say "Press the back button on your browser to do it again,",nl
$ say "or if you're an exceptionally lazy person and want to waste",nl
$ say "resources, click <a ",nl
$ say "href=""http://www.opus1.com/www/traceroute.html"">here</a>",nl
$ say "to go back to the Opus One traceroute page.  If you have a",nl
$ say "sudden urge to care about what Opus One is,",nl
$ say "<a href=""http://www.opus1.com/"">this</a> will get you",nl
$ say "to our home page.  As if.",nl
$ say "</BODY></HTML>"
$!
$done:
$ exit

$no_query:
$ say "Stop screwing around."
$ exit

$validate_string: subroutine
$!
$! p1 is string to validate.  If it doesn't, we never return
$!
$ p1_len = f$length(p1)
$ if (f$locate("%",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("+",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("\",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("/",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("!",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("&",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("@",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("$",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("^",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("*",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("(",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("=",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("?",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("<",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("[",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("{",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("'",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate(":",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate(",",p1) .ne. p1_len) then $ goto no_p1
$ if (f$locate("""",p1) .ne. p1_len) then $ goto no_p1
$ exit

$no_p1:
$ say "Stop screwing around.  Do you think that this is, Unix?"
$! close net_link
$ exit
$ENDSUBROUTINE

$validate_ipaddr: subroutine
$!
$! p1 is an IP address to validate.  If it doesn't, we never return
$!
$ p1_len = f$length(p1)
$ p1_char1 = f$extract(0,1,p1)
$ p1_char3 = f$extract(0,3,p1)
$ p1_char7 = f$extract(0,7,p1)
$!
$! If not starting with numeric 1, then don't bother
$!
$ if (p1_char1 .nes. "1") then $ exit
$!
$! Trap out 10/8
$!
$ if (p1_char3 .eqs. "10.") then $ goto no_ip
$!
$! Trap out 192.168/16
$!
$ if (p1_char7 .eqs. "192.168") then $ goto no_ip
$!
$! Trap out 172.16/12
$!
$ if (p1_char7 .eqs. "172.16.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.17.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.18.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.19.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.20.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.21.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.22.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.23.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.24.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.25.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.26.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.27.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.28.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.29.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.30.") then $ goto no_ip
$ if (p1_char7 .eqs. "172.31.") then $ goto no_ip
$!                
$! We must be OK
$!
$ exit

$no_ip:
$! Explain that the user is broken
$ say "<HTML><HEAD><TITLE>Traceroute to ''query'</TITLE></HEAD>",nl
$ say "<BODY><H2>Tracing from Opus One to ''query'</H2>",nl
$! 
$ say "<HR><PRE>",nl
$ say "You are trying to traceroute to a private address, as defined ",nl
$ say "in RFC 1918 (among others).  Those addresses are not available from ",nl
$ say "Opus One.  If you are trying to track down a spammer, please click ",nl
$ say "on the link below for Spam Fighters.",nl
$ say "",nl
$ say "If you are actually trying to traceroute from Opus One to ",nl
$ say "one of those addresses, then ... well ... you can't get there ",nl
$ say "from here.",nl
$ say "</PRE><HR>",nl
$! 
$ say "<a href=""http://www.opus1.com/o/nospamtrace.html""><b>",nl
$ say "Spam Fighters:</b> Click here now!</a><hr>",nl
$!
$ say "<P>For more information on enhanced traceroute, ",nl
$ say "read the <A",nl
$ say "HREF=""ftp://ftp.aces.com/software/traceroute/traceroute.faq"">",nl
$ say "FAQ</A><P>",nl
$ say "Press the back button on your browser to do it again,",nl
$ say "or if you're an exceptionally lazy person and want to waste",nl
$ say "resources, click <a ",nl
$ say "href=""http://www.opus1.com/www/traceroute.html"">here</a>",nl
$ say "to go back to the Opus One traceroute page.  If you have a",nl
$ say "sudden urge to care about what Opus One is,",nl
$ say "<a href=""http://www.opus1.com/"">this</a> will get you",nl
$ say "to our home page.  As if.",nl
$ say "</BODY></HTML>",nl
$ exit
$!
$done:
$ exit
$ ENDSUBROUTINE