1
# These routines are used when WiKit is called from CGI
3
package provide Web 1.0
6
package require Wikit::Db
7
package require Wikit::Search
9
# dump CGI env to file for debugging purposes
11
set logfd [open $env(WIKIT_DUMP) a]
12
fconfigure $logfd -buffering line
13
proc tclLog {msg} { puts $::logfd $msg }
14
tclLog "#############################"
15
foreach x [lsort [array names env]] {
16
tclLog "\$$x = $env($x)"
22
tclLog ==============================
24
# 1-5-2001: new logic to work with a cache for *much* higher performance
26
# To make this work, create a "main" dir, reachable from the web, and store
27
# a special ".htaccess" file in it, (adjust as needed):
28
# DirectoryIndex /home/jcw/wikit.cgi/0
29
# ErrorDocument 404 /home/jcw/wikit.cgi
31
# Then config this wikit to maintain pages in that cache:
32
# WIKI_CACHE=/home/jcw/www/tcl ./wikit.tkd
34
# Operation without this new env var, or with the CGI url remains unaffected.
36
if {[info exists env(WIKIT_CACHE)] && $env(WIKIT_CACHE) != ""} {
37
set htmlcache $env(WIKIT_CACHE)
38
tclLog "htmlcache = $htmlcache"
41
set EditInstructions {}
44
# 3-5-2001: force graceful cleanup
45
proc cgi_mail_start {args} {
47
global _cgi env appname
48
file delete $appname.lock
49
set fd [open errors.txt a]
50
puts $fd {=================================================================}
51
puts $fd [clock format [clock seconds]]
52
puts $fd $_cgi(errorInfo)
53
puts $fd $env(PATH_INFO)
61
# 3-5-2001: make sure broken pipes won't abort
62
catch {eval jcw_puts $args}
63
if {[info exists ::htmlcopy]} {
65
if {[llength $args] == 1} {
66
append ::htmlcopy $a0 \n
67
} elseif {[llength $args] == 2 && $a0 == "-nonewline"} {
74
proc Wikit::stylesheet {} {
76
if {[info exists env(WIKIT_CSS)]} {
77
cgi_relationship stylesheet $env(WIKIT_CSS) type=text/css
81
proc Wikit::ProcessCGI {} {
83
global htmlcopy htmlcache env roflag
85
if {[info exists env(WIKIT_EMAIL)]} {
86
admin_mail_addr $env(WIKIT_EMAIL)
88
admin_mail_addr nowhere@to.go
92
# 2002-06-17: moved to app-wikit/start.tcl
96
# support AOLserver, fix by Pascal Scheffers from http://mini.net/tcl/4416
97
if { [string first "AOLserver/3" $env(SERVER_SOFTWARE)] > -1 } {
98
#Aolserver does not provide a correct SCRIPT_NAME
99
#fix this by parsing the WIKIT_BASE (which is mandatory anyway)
101
regexp -nocase {^http://[^/]+(/.+)/$} $env(WIKIT_BASE) - env(SCRIPT_NAME)
105
set ::script_name $::env(SCRIPT_NAME)
107
# fix embedded wikithttpd server script name
108
if { [string first "WikitHttpd" $env(SERVER_SOFTWARE)] > -1 } {
109
if { $::script_name == "/" } {
114
# this code added 1-5-2001 to handle ErrorDocument redirection/caching
115
if {[info exists ::env(REDIRECT_URL)]} {
117
set r $env(REDIRECT_URL)
118
if {[info exists env(PATH_INFO)]} { # DirectoryIndex case
119
append r [string range $env(PATH_INFO) 1 end]
120
} else { # ErrorDocument case
121
set env(PATH_INFO) /[file tail $r]
123
set env(SCRIPT_NAME) [file dirname $r]
125
catch {set env(QUERY_STRING) $env(REDIRECT_QUERY_STRING)}
127
if {[info exists htmlcache] && [regexp {\d+(\.html)?$} $r - x]} {
128
tclLog "setting up cache copy - $r"
132
global htmlcopy htmlcache env
133
if {[info exists env(WIKIT_SAVE)] && $env(WIKIT_SAVE) eq "0"} return
134
regsub ".*?\n\n" $htmlcopy "" htmlcopy
135
if {$N == 2 || $htmlcopy == ""} return
137
set fd [open [file join $htmlcache $N.html] w]
138
puts -nonewline $fd $htmlcopy
147
set host $::env(REMOTE_ADDR)
148
#catch {set host $::env(REMOTE_HOST)}
150
# this adds user name, if it is known (thx Shane McDonald, wiki page 19)
151
catch {set host "$::env(REMOTE_USER)@$host"}
154
catch {set path $::env(PATH_INFO)}
157
catch {set query $::env(QUERY_STRING)}
158
regsub {^Q=} $query {} query
159
regsub {&.*} $query {} query
163
# Updated 3Mar03, edit and references are now subdirs to allow
165
if {![regexp {^/(edit/|references/)?([0-9]+)(.*)$} $path x section N cmd] || $N >= [mk::view size wdb.pages]} {
168
# try to locate a page by name, using various search heuristics
169
if {[regexp {^/(.*)} $path x arg] && $arg != "" && $query == ""} {
170
set N [mk::select wdb.pages name $arg -min date 1]
171
switch [llength $N] {
172
0 { # no match, try alternative approach
173
# do a glob search, where AbCdEf -> *[Aa]b*[Cc]d*[Ee]f*
174
# skip this if the search has brackets
175
if {[string first \[ $arg] < 0} {
176
regsub -all {[A-Z]} $arg \
177
{*\\[&[string tolower &]\]} temp
178
set temp "[subst -novariable $temp]*"
179
set N [mk::select wdb.pages -glob name $temp -min date 1]
181
if {[llength $N] != 1} {
183
set query $arg ;# turn it into a keyword search
186
1 { # uniquely identified, done
188
default { # ambiguous, turn it into a keyword search
194
#tclLog "path $path query $query N $N"
196
# prevent DoS via way too large integers
197
if {$query eq "" && [string length $N] > 9} { set query $N }
203
set searchKey [unquote_input $query]
204
set searchLong [regexp {^(.*)\*$} $searchKey x searchKey]
208
pagevars $N name date who
209
set origtag [list $date $who]
210
set refs [mk::select wdb.refs to $N]
212
# added 2004-05-17 wru cookie identification
213
catch {source $::env(WIKIT_WRU)}
215
# if there is new page content, save it now
216
if {$N != "" && [lsearch -exact $::ProtectedPages $N] < 0} {
217
if {$roflag < 0 && ![catch {import C}] && [import C] != ""} {
218
# added 2002-06-13 - edit conflict detection
219
if {![catch {import O}] && $O != $origtag} {
220
tclLog "conflict, want $O, stored $origtag"
226
cgi_http_equiv Content-type "text/html; charset=utf-8"
228
cgi_http_equiv Pragma no-cache
229
cgi_http_equiv Expire "Mon, 04 Dec 1999 21:29:02 GMT"
233
h2 "Edit conflict on page $N - [Wiki $name $N]"
234
p "[bold {Your changes have NOT been saved}], because
235
someone (at IP address [lindex $origtag 1]) saved
236
a change to this page while you were editing."
237
p [italic {Please restart a new edit and merge your
238
version, which is shown in full below.}]
240
p "<pre>[quote_html $C]</pre>"
246
# thx Alistair Grant, see http://mini.net/tcl/9747
247
#SavePage $N $C $host $name
248
cgi_import_as Action editAction
249
# Only actually save the page if the user selected "Save"
250
if {[string trim $editAction] == "Save" && \
251
(![info exists ::env(WIKIT_WRU_REQ)] || [info exists wru_nick])} {
252
# this cache flushing is not perfect - for one, it fails to be run
253
# when running the same wiki in local mode as well, the solution is
254
# to move this code to the modify layer, not just the cgi script use
255
if {[info exists htmlcache]} {
256
file delete $htmlcache/4.html
257
file delete $htmlcache/$N.html
258
# remove all referencing pages, if this page did not exist before
259
# this makes sure that cache entries point to a filled-in page
260
# from now on, instead of a "[...]" link to a first-time edit page
263
set r1 [mk::get wdb.refs!$r from]
264
file delete $htmlcache/$r1.html
268
SavePage $N $C $host $name
269
# end of change, 03-09-2003
273
set saved "not saved"
275
# a general improvement: redirect through a fetch again
276
if {![catch {import Z}]} {
286
http_equiv Refresh 1\;URL=$Z
290
puts "Page $saved... [link - [Wikit::Format::quote $name] $Z]"
298
# set up a few standard URLs an strings
300
switch [llength $refs] {
304
set Title [Wikit::Format::quote $name]
307
# 03-06-2003 generate page with back ref request, so cached
308
# copy stays valid when more page references are added later
309
#set backRef [mk::get wdb.refs!$refs from]
310
set backRef references/$N!
311
set Refs "[Wiki Reference $backRef] - "
312
set Title [Wiki $name $backRef]
315
set backRef references/$N!
316
set Refs "[llength $refs] [Wiki References $backRef] - "
317
set Title [Wiki $name $backRef]
321
set Edit "Edit [Wiki - edit/$N@]"
323
if { $section eq "" } {
324
set Home "Go to [Wiki - 0]"
325
set About "About [Wiki - 1] - "
326
set Search "[Wiki - 2] - "
327
set Changes "[Wiki - 4] - "
328
set Help " - [Wiki - 3]"
330
# either edit/ or references/ is in the URL. That means all
331
# links must point to ../, to avoid confusion (it would still
333
set Home "Go to [Wiki - ../0]"
334
set About "About [Wiki - ../1] - "
335
set Search "[Wiki - ../2] - "
336
set Changes "[Wiki - ../4] - "
337
set Help " - [Wiki - ../3]"
340
if {$N == 1} { set About "" }
341
if {$N == 2} { set Search "" }
342
if {$N == 3} { set Help "" }
343
if {$N == 4} { set Changes "" }
346
set date [clock format $date -gmt 1 -format {%e %b %Y, %R GMT}]
349
set updated "Updated [cgi_font size=-1 $date]"
352
if {[regexp {^(.+)[,@]} $who - who_nick] && $who_nick ne ""} {
353
append updated " by $who_nick"
356
if {[lsearch -exact $::ProtectedPages $N] >= 0} {
358
} elseif {$roflag >= 0 || $readonly} {
359
set menu "$updated[nl]"
361
set menu "$updated [nbspace]-[nbspace] $Edit"
362
# 2004-05-29 add optional link to history
363
if {[info exists ::env(WIKIT_REVS)] && $::env(WIKIT_REVS) ne ""} {
364
append menu " [nbspace]-[nbspace]\
365
[link - Revisions $::env(WIKIT_REVS)/$N]"
370
append menu "$Search$Changes$Refs$About$Home$Help"
377
# now dispatch on the type of request
383
@ { # called to generate an edit page
385
cgi_http_equiv Content-type "text/html; charset=utf-8"
386
cgi_title "Edit $name"
387
cgi_meta name=robots content=noindex,nofollow
388
cgi_http_equiv Pragma no-cache
389
cgi_http_equiv Expire "Mon, 04 Dec 1999 21:29:02 GMT"
391
if {$N != "2" && [info exists ::env(WIKIT_BASE)]} {
392
cgi_base href=$::env(WIKIT_BASE)edit/
396
cgi_body bgcolor=#ffffff {
397
cgi_h2 [Wiki - ../$N]
399
cgi_form $::script_name/$N {
400
cgi_export O=$origtag
402
set z "http://$::env(HTTP_HOST)$::env(REDIRECT_URL)"
407
textarea C=[GetPage $N] rows=30 cols=72 wrap=virtual \
410
# thx Alistair Grant, see http://mini.net/tcl/9747
411
#submit_button "= Save "
412
# Create Save and Cancel buttons
413
submit_button "Action=Save" \
414
[expr {[info exists ::env(WIKIT_WRU_REQ)] && \
415
![info exists wru_nick] ? "disabled" : ""}]
416
cgi_puts " [nbspace] "
417
submit_button "Action=Cancel"
418
# end of change, 03-09-2003
419
# 2004-05-17 added some sugar to show wru identities
421
cgi_puts " [nbspace] [nbspace] [nbspace] "
422
cgi_puts [italic "Last saved on [bold $date]"]
423
if {[info exists who_nick] && $who_nick ne ""} {
424
cgi_puts [italic " by [bold $who_nick]"]
427
if {[info exists wru_nick]} {
428
cgi_puts " [nbspace] (you are: [bold $wru_nick])"
429
} elseif {[info exists ::env(WIKIT_WRU_REQ)]} {
430
cgi_puts " [nbspace] ([bold [url Register $::env(WIKIT_WRU_REQ)]] to enable saving)"
433
cgi_puts $::EditInstructions
438
! { # called to generate a page with references
440
cgi_http_equiv Content-type "text/html; charset=utf-8"
441
cgi_title "References to $name"
442
cgi_meta name=robots content=noindex,nofollow
443
cgi_http_equiv Pragma no-cache
444
cgi_http_equiv Expire "Mon, 04 Dec 1999 21:29:02 GMT"
446
if {$N != "2" && [info exists ::env(WIKIT_BASE)]} {
447
cgi_base href=$::env(WIKIT_BASE)references/
451
cgi_body bgcolor=#ffffff {
452
cgi_h2 "References to [Wiki - ../$N]"
456
set r [mk::get wdb.refs!$r from]
458
lappend refList [list $name $r]
462
# the items are a list, if we would just sort on them, then all
463
# single-item entries come first (the rest has {}'s around it)
464
# the following sorts again on 1st word, knowing sorts are stable
465
foreach x [lsort -dict -index 0 [lsort -dict $refList]] {
468
li "[GetTimeStamp $date] . . . [Wiki - ../$r] . . . $who"
473
cgi_puts [cgi_font size=-1 "$Search - $Changes - $About - $Home"]
477
default { # display one page, also handles expanded pages
479
cgi_http_equiv Content-type "text/html; charset=utf-8"
480
#if {$N == 4} { cgi_http_equiv refresh 300 }
482
cgi_http_equiv Pragma no-cache
483
cgi_http_equiv Expire "Mon, 04 Dec 1999 21:29:02 GMT"
485
if {$N != "2" && [info exists ::env(WIKIT_BASE)]} {
486
cgi_base href=$::env(WIKIT_BASE)
489
cgi_body bgcolor=#ffffff {
492
foreach {C U} [Expand_HTML $C] break
493
set noTitle [regsub {^<p>(<img src=".*?")>} $C \
494
[link - {\1 border=0>} $backRef] C]
495
if {!$noTitle} { h2 $Title }
498
# thx Alistair Grant, see http://mini.net/tcl/9748
499
isindex "prompt=Enter the search phrase. \
500
Append an asterisk (*) to search page contents as well: "
507
cgi_puts "<p id='footer'>$menu</p>"
513
if {[info exists ::htmlcopy]} { saveCopy $N }
added
removed
lib/wikit/web.tcl
