58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
# escaped for safe insertion into HTML. %url(...) substitions encode the
# argument for safe insertion into query parameters of URLs. Backslash
# substitutions are also performed, but variable substitutions are not,
# except within %html() and %url().
#
proc wapp-subst {txt} {
global wapp
regsub -all -- {%(html|url)\(([^)]+)\)} $txt {[wappInt-enc-\1 "\2"]} txt
dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}
proc wappInt-enc-html {txt} {
return [string map {& & < < > >} $txt]
}
# Reset the document back to an empty string.
#
proc wapp-reset {} {
global wapp
dict set wapp .reply {}
}
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
# escaped for safe insertion into HTML. %url(...) substitions encode the
# argument for safe insertion into query parameters of URLs. Backslash
# substitutions are also performed, but variable substitutions are not,
# except within %html() and %url().
#
proc wapp-subst {txt} {
global wapp
regsub -all {%(html|url|qp|unsafe)\(([^)]+)\)} $txt \
{[wappInt-enc-\1 "\2"]} txt
dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}
# There must be a wappInt-enc-NAME routine for each possible substitution
# in wapp-subst. Thus there are routines for "html", "url", "qp", and "unsafe".
#
# wappInt-enc-html Escape text so that it is safe to use in the
# body of an HTML document.
#
# wappInt-enc-url Escape text so that it is safe to pass as an
# argument to href= and src= attributes in HTML.
#
# wappInt-enc-qp Escape text so that it is safe to use as the
# value of a query parameter in a URL or in
# post data or in a cookie.
#
# wappInt-enc-unsafe Perform no encoding at all. Unsafe.
#
proc wappInt-enc-html {txt} {
return [string map {& & < < > >} $txt]
}
proc wappInt-enc-unsafe {txt} {
return $txt
}
proc wappInt-enc-url {s} {
if {[regsub -all {[^-{}@~?=#_.:/a-zA-Z0-9]} $s {[wappInt-%HHchar {&}]} s]} {
set s [subst -novar -noback $s]
}
if {[regsub -all {[{}]} $s {[wappInt-%HHchar \\&]} s]} {
set s [subst -novar -noback $s]
}
return $s
}
proc wappInt-enc-qp {s} {
if {[regsub -all {[^-{}_.a-zA-Z0-9]} $s {[wappInt-%HHchar {&}]} s]} {
set s [subst -novar -noback $s]
}
if {[regsub -all {[{}]} $s {[wappInt-%HHchar \\&]} s]} {
set s [subst -novar -noback $s]
}
return $s
}
# This is a helper routine for wappInt-enc-url and wappInt-enc-qp. It returns
# an appropriate %HH encoding for the single character c. If c is a unicode
# character, then this routine might return multiple bytes: %HH%HH%HH
#
proc wappInt-%HHchar {c} {
if {$c==" "} {return +}
return [regsub -all .. [binary encode hex [encoding convertto utf-8 $c]] {%&}]
}
# Undo the www-url-encoded format.
#
# HT: This code stolen from ncgi.tcl
#
proc wappInt-decode-url {str} {
set str [string map [list + { } "\\" "\\\\" \[ \\\[ \] \\\]] $str]
regsub -all -- \
{%([Ee][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])} \
$str {[encoding convertfrom utf-8 [binary decode hex \1\2\3]]} str
regsub -all -- \
{%([CDcd][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])} \
$str {[encoding convertfrom utf-8 [binary decode hex \1\2]]} str
regsub -all -- {%([0-7][A-Fa-f0-9])} $str {\\u00\1} str
return [subst -novar $str]
}
# Do URL encoding
#
# Reset the document back to an empty string.
#
proc wapp-reset {} {
global wapp
dict set wapp .reply {}
}
|
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
|
if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
set val [wappInt-enc-url $val]
puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/\r"
}
}
}
puts $chan "\r"
puts $chan [dict get $wapp .reply]
flush $chan
wappInt-close-channel $chan
}
# Undo the www-url-encoded format.
#
# HT: This code stolen from ncgi.tcl
#
proc wappInt-decode-url {str} {
set str [string map [list + { } "\\" "\\\\" \[ \\\[ \] \\\]] $str]
regsub -all -- \
{%([Ee][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])} \
$str {[encoding convertfrom utf-8 [DecodeHex \1\2\3]]} str
regsub -all -- \
{%([CDcd][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])} \
$str {[encoding convertfrom utf-8 [DecodeHex \1\2]]} str
regsub -all -- {%([0-7][A-Fa-f0-9])} $str {\\u00\1} str
return [subst -novar $str]
}
# Data for doing url-encoding.
#
array set wappInt-map {
\000 %00 \001 %01 \002 %02 \003 %03 \004 %04 \005 %05 \006 %06 \007 %07
\010 %08 \011 %09 \012 %0A \013 %0B \014 %0C \015 %0D \016 %0E \017 %0F
\020 %10 \021 %11 \022 %12 \023 %13 \024 %14 \025 %15 \026 %16 \027 %17
\030 %18 \031 %19 \032 %1A \033 %1B \034 %1C \035 %1D \036 %1E \037 %1F
{ } + \041 %21 \042 %22 \043 %23 \044 %24 \045 %25 \046 %26 \047 %27
\050 %28 \051 %29 \052 %2A \053 %2B \054 %2C \055 %2D \056 %2E \057 %2F
\072 %3A \073 %3B \074 %3C \075 %3D \076 %3E \077 %3F \100 %40 \133 %5B
\134 %5C \135 %5D \136 %5E \137 %5F \140 %60 \173 %7B \174 %7C \175 %7D
\176 %7E \177 %7F \200 %80 \201 %81 \202 %82 \203 %83 \204 %84 \205 %85
\206 %86 \207 %87 \210 %88 \211 %89 \212 %8A \213 %8B \214 %8C \215 %8D
\216 %8E \217 %8F \220 %90 \221 %91 \222 %92 \223 %93 \224 %94 \225 %95
\226 %96 \227 %97 \230 %98 \231 %99 \232 %9A \233 %9B \234 %9C \235 %9D
\236 %9E \237 %9F \240 %A0 \241 %A1 \242 %A2 \243 %A3 \244 %A4 \245 %A5
\246 %A6 \247 %A7 \250 %A8 \251 %A9 \252 %AA \253 %AB \254 %AC \255 %AD
\256 %AE \257 %AF \260 %B0 \261 %B1 \262 %B2 \263 %B3 \264 %B4 \265 %B5
\266 %B6 \267 %B7 \270 %B8 \271 %B9 \272 %BA \273 %BB \274 %BC \275 %BD
\276 %BE \277 %BF \300 %C0 \301 %C1 \302 %C2 \303 %C3 \304 %C4 \305 %C5
\306 %C6 \307 %C7 \310 %C8 \311 %C9 \312 %CA \313 %CB \314 %CC \315 %CD
\316 %CE \317 %CF \320 %D0 \321 %D1 \322 %D2 \323 %D3 \324 %D4 \325 %D5
\326 %D6 \327 %D7 \330 %D8 \331 %D9 \332 %DA \333 %DB \334 %DC \335 %DD
\336 %DE \337 %DF \340 %E0 \341 %E1 \342 %E2 \343 %E3 \344 %E4 \345 %E5
\346 %E6 \347 %E7 \350 %E8 \351 %E9 \352 %EA \353 %EB \354 %EC \355 %ED
\356 %EE \357 %EF \360 %F0 \361 %F1 \362 %F2 \363 %F3 \364 %F4 \365 %F5
\366 %F6 \367 %F7 \370 %F8 \371 %F9 \372 %FA \373 %FB \374 %FC \375 %FD
\376 %FE \377 %FF
}
# Do URL encoding
#
proc wappInt-enc-url {str} {
upvar #0 wappInt-map map
regsub -all -- \[^a-zA-Z0-9\] $str {$map(&)} str
regsub -all -- {[][{})\\]\)} $str {\\&} str
return [subst -nocommand $str]
}
# Process a single CGI request
#
proc wappInt-handle-cgi-request {} {
global wapp env
foreach key {
CONTENT_LENGTH
CONTENT_TYPE
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
|
if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
set val [wappInt-enc-url $val]
puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/\r"
}
}
}
puts $chan "\r"
puts $chan [encoding convertto utf-8 [dict get $wapp .reply]]
flush $chan
wappInt-close-channel $chan
}
# Process a single CGI request
#
proc wappInt-handle-cgi-request {} {
global wapp env
foreach key {
CONTENT_LENGTH
CONTENT_TYPE
|