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