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