1#!/depot/path/tclsh 2 3# This is a CGI script that displays another CGI script 4# and massages "source" commands into hyperlinks 5 6package require cgi 7 8cgi_eval { 9 source example.tcl 10 11 cgi_input 12 13 cgi_head { 14 set scriptname [info script]; # display self by default! 15 catch {cgi_import scriptname} 16 17 # strip tildes to gracefully handle experimenters 18 set scriptname [string trimleft $scriptname ~] 19 20 set scriptname [file tail $scriptname] 21 cgi_title "Source for $scriptname" 22 } 23 cgi_body { 24 # gracefully handle hackers trying to opening directories 25 switch -- $scriptname . - .. - "" { 26 h3 "No such file: $scriptname" 27 return 28 } 29 if {[catch {set fid [open $scriptname]}]} { 30 h3 "No such file: $scriptname" 31 return 32 } 33 cgi_preformatted { 34 while {-1 != [gets $fid buf]} { 35 if {[regexp "^(\[ \t]*)source (.*)" $buf ignore space filename]} { 36 puts "[set space]source [cgi_url $filename [cgi_cgi display scriptname=$filename]]" 37 } else { 38 puts [cgi_quote_html $buf] 39 } 40 } 41 } 42 } 43} 44 45