├── .gitignore ├── static-example.tcl ├── routes-example.tcl ├── wapp-thread.tcl ├── wapp-routes.tcl ├── README.md ├── wapp-static.tcl └── wapp.tcl /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | .*.swp 3 | -------------------------------------------------------------------------------- /static-example.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env tclkit8.6 2 | # 3 | set root [file dirname [file normalize [info script]]] 4 | 5 | source ../wapp.tcl 6 | source wapp-static.tcl 7 | 8 | wapp-static ../../tickpic/images images browse 9 | 10 | proc wapp-default {} { 11 | set mname [wapp-param PATH_HEAD] 12 | if { $mname eq "" } { 13 | wapp-redirect /images 14 | } 15 | } 16 | 17 | wapp-start $argv 18 | -------------------------------------------------------------------------------- /routes-example.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env tclkit8.6 2 | # 3 | source wapp.tcl 4 | source wapp-routes.tcl 5 | 6 | wapp-route GET /image/date/file { 7 | puts "GET $date $file" 8 | } 9 | 10 | wapp-route PUT /image/date/file { 11 | puts "PUT $date $file" 12 | } 13 | 14 | wapp-route DELETE /image/date/file { 15 | puts "DEL $date $file" 16 | } 17 | 18 | 19 | proc wapp-default {} { 20 | wapp-subst { HI } 21 | } 22 | 23 | wapp-start $argv 24 | 25 | -------------------------------------------------------------------------------- /wapp-thread.tcl: -------------------------------------------------------------------------------- 1 | 2 | package require Thread 3 | 4 | proc wapp-deliver-file-content { wapp chan } { 5 | set mimetype [dict get $wapp .mimetype] 6 | set filepath [dict get $wapp .filepath] 7 | 8 | thread::detach $chan 9 | 10 | thread::create [subst -nocommands { 11 | thread::attach $chan 12 | 13 | set contentLength [file size $filepath] 14 | set inchan [open $filepath rb] 15 | puts $chan "Content-Type: $mimetype\r" 16 | puts $chan "Content-Length: \$contentLength\r" 17 | puts $chan "\r" 18 | fcopy \$inchan $chan 19 | close \$inchan 20 | flush $chan 21 | close $chan 22 | }] 23 | } 24 | 25 | -------------------------------------------------------------------------------- /wapp-routes.tcl: -------------------------------------------------------------------------------- 1 | # Simple notation for wapp-page-$page handler generation. 2 | # 3 | # wapp-route [GET|PUT|DELETE|...] /page[/value1[/value2]] [param1 .. paramN] handlerBody 4 | # 5 | # Route values are unpacked into local variables. Any remainder of the path is 6 | # left as a list in the local variable PATH_TAIL. The original path tail is 7 | # still available using [wapp-param PATH_TAIL]. Additional parameters are 8 | # unpacked with [wapp-param] into local variables. 9 | # 10 | proc wapp-route-dispatch { page } { 11 | set REQUEST_METHOD [wapp-param REQUEST_METHOD] 12 | if { [info command wapp-page-$page-$REQUEST_METHOD] ne "" } { 13 | wapp-page-$page-$REQUEST_METHOD 14 | } else { 15 | wapp-reply-code "404 Page Not Found" 16 | } 17 | } 18 | 19 | proc wapp-route { method pathspec args } { 20 | set names [lassign [split $pathspec /] -> page] 21 | set args [lreverse [lassign [lreverse $args] body]] 22 | 23 | set prefix "" 24 | if { [llength $names] } { 25 | append prefix " set PATH_TAIL \[lassign \[split \[wapp-param PATH_TAIL] /] $names]\n" 26 | } 27 | foreach arg $args { 28 | append prefix " set $arg \[wapp-param $arg]\n" 29 | } 30 | 31 | proc wapp-page-$page-$method {} "\n$prefix $body" 32 | proc wapp-page-$page {} "wapp-route-dispatch $page" 33 | } 34 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | #### static 3 | This adds the ability to serve static content using fcopy without reading 4 | the entire file into memory first. This might undermine some of the 5 | deliberate security of wapp, but some care was taken. Feedback regarding 6 | security welcome. 7 | 8 | #### thread 9 | Refactor file delivery to allow the file content to be deivered by a new 10 | thread. One for each file. This makes the service about 30% faster when 11 | displaying a page full of large jpegs. 12 | 13 | #### routes 14 | Boiler plate generator for unpacking route path values and wapp-params into 15 | local variables in a page handler. 16 | 17 | #### From [lego12239/wapp](https://github.com/lego12239/wapp) 18 | 19 | This is a fork of original wapp from D. Richard Hipp with some changes: 20 | 21 | - support of PUT, PATCH, DELETE http methods; 22 | - fix cookies parsing(make parsing more rfc6265 compliant, 23 | but be more liberal to cookie value, 24 | allowing any chars except dquote in a quoted value and 25 | any char except semicolon in a nonquoted value); 26 | - throw error on bad cookie value set; 27 | - -server option accepts a listen address in plan9 format: 28 | tcp!ADDR!PORT or tcp!ADDR!0 or tcp!ADDR or ADDR. 29 | If PORT isn't specified or 0, then the first not used port is selected. 30 | If ADDR is 0.0.0.0, then listen on wildcard address; 31 | - fix request target parsing(make parsing more rfc3986 compliant); 32 | - fix request header name-value parsing(make parsing more rfc7230 compliant); 33 | 34 | For documentation look https://wapp.tcl.tk/home/doc/trunk/README.md . 35 | -------------------------------------------------------------------------------- /wapp-static.tcl: -------------------------------------------------------------------------------- 1 | # A wapp extension to allow a directory if static files to be served. 2 | # 3 | 4 | set wapp-static-mimetypes { 5 | .css text/css 6 | .html text/html 7 | .jpeg image/jpeg 8 | .jpg image/jpeg 9 | .js application/javascript 10 | .png image/jpeg 11 | .svg image/svg+xml 12 | .txt text/plain 13 | } 14 | 15 | proc wapp-static { root { page {} } { browse nobrowse } } { 16 | if { $page eq {} } { 17 | set page [file tail $root] 18 | } 19 | 20 | # Create a proc to serve static content from root at page. Browse allows 21 | # directory navigation. 22 | # 23 | proc wapp-page-$page-directory { fileroot filetail } { 24 | wapp-subst "" 29 | } 30 | 31 | proc wapp-page-$page {} [subst -nocommands { 32 | set rootpath [file normalize $root] 33 | set filepath [file normalize $root/[wapp-param PATH_TAIL]] 34 | 35 | if { [string first \$rootpath \$filepath] != 0 } { 36 | return 37 | } 38 | set filetail [string range \$filepath [string length \$rootpath] end] 39 | 40 | if { [file isfile \$filepath] } { 41 | global wapp 42 | wapp-mimetype [dict get \${::wapp-static-mimetypes} [string tolower [file extension \$filepath]]] 43 | dict set wapp .filepath \$filepath 44 | } else { 45 | if { "$browse" eq "browse" } { 46 | wapp-page-$page-directory \$filepath \$filetail 47 | } 48 | } 49 | }] 50 | } 51 | -------------------------------------------------------------------------------- /wapp.tcl: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2017 D. Richard Hipp 2 | # 3 | # This program is free software; you can redistribute it and/or 4 | # modify it under the terms of the Simplified BSD License (also 5 | # known as the "2-Clause License" or "FreeBSD License".) 6 | # 7 | # This program is distributed in the hope that it will be useful, 8 | # but without any warranty; without even the implied warranty of 9 | # merchantability or fitness for a particular purpose. 10 | # 11 | #--------------------------------------------------------------------------- 12 | # 13 | # Design rules: 14 | # 15 | # (1) All identifiers in the global namespace begin with "wapp" 16 | # 17 | # (2) Indentifiers intended for internal use only begin with "wappInt" 18 | # 19 | package require Tcl 8.6 20 | 21 | proc wappInt-cookies-parse {cstr} { 22 | set c [dict create] 23 | 24 | while {$cstr ne ""} { 25 | set idxs [regexp -indices -inline {^\s*([^\s=]+)\s*=\s*(?:"([^"]*)"|([^";][^;]*)|)(?:\s*;\s*)?} $cstr] 26 | if {[llength $idxs] == 0} { 27 | puts stderr "cookie parse error for: '$cstr'" 28 | return $c 29 | } 30 | set name [string range $cstr [lindex $idxs 1 0] [lindex $idxs 1 1]] 31 | if {[lindex $idxs 2 0] >= 0} { 32 | set val [string range $cstr [lindex $idxs 2 0] [lindex $idxs 2 1]] 33 | } elseif {[lindex $idxs 3 0] >= 0} { 34 | set val [string range $cstr [lindex $idxs 3 0] [lindex $idxs 3 1]] 35 | set val [string trimright $val] 36 | } else { 37 | set val "" 38 | } 39 | dict set c $name $val 40 | set cstr [string range $cstr [lindex $idxs 0 1]+1 end] 41 | } 42 | return $c 43 | } 44 | 45 | # Add text to the end of the HTTP reply. No interpretation or transformation 46 | # of the text is performs. The argument should be enclosed within {...} 47 | # 48 | proc wapp {txt} { 49 | global wapp 50 | dict append wapp .reply $txt 51 | } 52 | 53 | # Add text to the page under construction. Do no escaping on the text. 54 | # 55 | # Though "unsafe" in general, there are uses for this kind of thing. 56 | # For example, if you want to return the complete, unmodified content of 57 | # a file: 58 | # 59 | # set fd [open content.html rb] 60 | # wapp-unsafe [read $fd] 61 | # close $fd 62 | # 63 | # You could do the same thing using ordinary "wapp" instead of "wapp-unsafe". 64 | # The difference is that wapp-safety-check will complain about the misuse 65 | # of "wapp", but it assumes that the person who write "wapp-unsafe" understands 66 | # the risks. 67 | # 68 | # Though occasionally necessary, the use of this interface should be minimized. 69 | # 70 | proc wapp-unsafe {txt} { 71 | global wapp 72 | dict append wapp .reply $txt 73 | } 74 | 75 | # Add text to the end of the reply under construction. The following 76 | # substitutions are made: 77 | # 78 | # %html(...) Escape text for inclusion in HTML 79 | # %url(...) Escape text for use as a URL 80 | # %qp(...) Escape text for use as a URI query parameter 81 | # %string(...) Escape text for use within a JSON string 82 | # %unsafe(...) No transformations of the text 83 | # 84 | # The substitutions above terminate at the first ")" character. If the 85 | # text of the TCL string in ... contains ")" characters itself, use instead: 86 | # 87 | # %html%(...)% 88 | # %url%(...)% 89 | # %qp%(...)% 90 | # %string%(...)% 91 | # %unsafe%(...)% 92 | # 93 | # In other words, use "%(...)%" instead of "(...)" to include the TCL string 94 | # to substitute. 95 | # 96 | # The %unsafe substitution should be avoided whenever possible, obviously. 97 | # In addition to the substitutions above, the text also does backslash 98 | # escapes. 99 | # 100 | # The wapp-trim proc works the same as wapp-subst except that it also removes 101 | # whitespace from the left margin, so that the generated HTML/CSS/Javascript 102 | # does not appear to be indented when delivered to the client web browser. 103 | # 104 | if {$tcl_version>=8.7} { 105 | proc wapp-subst {txt} { 106 | global wapp 107 | regsub -all -command \ 108 | {%(html|url|qp|string|unsafe){1,1}?(|%)\((.+)\)\2} $txt wappInt-enc txt 109 | dict append wapp .reply [subst -novariables -nocommand $txt] 110 | } 111 | proc wapp-trim {txt} { 112 | global wapp 113 | regsub -all {\n\s+} [string trim $txt] \n txt 114 | regsub -all -command \ 115 | {%(html|url|qp|string|unsafe){1,1}?(|%)\((.+)\)\2} $txt wappInt-enc txt 116 | dict append wapp .reply [subst -novariables -nocommand $txt] 117 | } 118 | proc wappInt-enc {all mode nu1 txt} { 119 | return [uplevel 2 "wappInt-enc-$mode \"$txt\""] 120 | } 121 | } else { 122 | proc wapp-subst {txt} { 123 | global wapp 124 | regsub -all {%(html|url|qp|string|unsafe){1,1}?(|%)\((.+)\)\2} $txt \ 125 | {[wappInt-enc-\1 "\3"]} txt 126 | dict append wapp .reply [uplevel 1 [list subst -novariables $txt]] 127 | } 128 | proc wapp-trim {txt} { 129 | global wapp 130 | regsub -all {\n\s+} [string trim $txt] \n txt 131 | regsub -all {%(html|url|qp|string|unsafe){1,1}?(|%)\((.+)\)\2} $txt \ 132 | {[wappInt-enc-\1 "\3"]} txt 133 | dict append wapp .reply [uplevel 1 [list subst -novariables $txt]] 134 | } 135 | } 136 | 137 | # There must be a wappInt-enc-NAME routine for each possible substitution 138 | # in wapp-subst. Thus there are routines for "html", "url", "qp", and "unsafe". 139 | # 140 | # wappInt-enc-html Escape text so that it is safe to use in the 141 | # body of an HTML document. 142 | # 143 | # wappInt-enc-url Escape text so that it is safe to pass as an 144 | # argument to href= and src= attributes in HTML. 145 | # 146 | # wappInt-enc-qp Escape text so that it is safe to use as the 147 | # value of a query parameter in a URL or in 148 | # post data or in a cookie. 149 | # 150 | # wappInt-enc-string Escape ", ', \, and < for using inside of a 151 | # javascript string literal. The < character 152 | # is escaped to prevent "" from causing 153 | # problems in embedded javascript. 154 | # 155 | # wappInt-enc-unsafe Perform no encoding at all. Unsafe. 156 | # 157 | proc wappInt-enc-html {txt} { 158 | return [string map {& & < < > > \" " \\ \} $txt] 159 | } 160 | proc wappInt-enc-unsafe {txt} { 161 | return $txt 162 | } 163 | proc wappInt-enc-url {s} { 164 | if {[regsub -all {[^-{}@~?=#_.:/a-zA-Z0-9]} $s {[wappInt-%HHchar {&}]} s]} { 165 | set s [subst -novar -noback $s] 166 | } 167 | if {[regsub -all {[{}]} $s {[wappInt-%HHchar \\&]} s]} { 168 | set s [subst -novar -noback $s] 169 | } 170 | return $s 171 | } 172 | proc wappInt-enc-qp {s} { 173 | if {[regsub -all {[^-{}_.a-zA-Z0-9]} $s {[wappInt-%HHchar {&}]} s]} { 174 | set s [subst -novar -noback $s] 175 | } 176 | if {[regsub -all {[{}]} $s {[wappInt-%HHchar \\&]} s]} { 177 | set s [subst -novar -noback $s] 178 | } 179 | return $s 180 | } 181 | proc wappInt-enc-string {s} { 182 | return [string map {\\ \\\\ \" \\\" ' \\' < \\u003c \n \\n \r \\r 183 | \f \\f \t \\t \x01 \\u0001 \x02 \\u0002 \x03 \\u0003 184 | \x04 \\u0004 \x05 \\u0005 \x06 \\u0006 \x07 \\u0007 185 | \x0b \\u000b \x0e \\u000e \x0f \\u000f \x10 \\u0010 186 | \x11 \\u0011 \x12 \\u0012 \x13 \\u0013 \x14 \\u0014 187 | \x15 \\u0015 \x16 \\u0016 \x17 \\u0017 \x18 \\u0018 188 | \x19 \\u0019 \x1a \\u001a \x1b \\u001b \x1c \\u001c 189 | \x1d \\u001d \x1e \\u001e \x1f \\u001f} $s] 190 | } 191 | 192 | # This is a helper routine for wappInt-enc-url and wappInt-enc-qp. It returns 193 | # an appropriate %HH encoding for the single character c. If c is a unicode 194 | # character, then this routine might return multiple bytes: %HH%HH%HH 195 | # 196 | proc wappInt-%HHchar {c} { 197 | if {$c==" "} {return +} 198 | return [regsub -all .. [binary encode hex [encoding convertto utf-8 $c]] {%&}] 199 | } 200 | 201 | 202 | # Undo the www-url-encoded format. 203 | # 204 | # HT: This code stolen from ncgi.tcl 205 | # 206 | proc wappInt-decode-url {str} { 207 | set str [string map [list + { } "\\" "\\\\" \[ \\\[ \] \\\]] $str] 208 | regsub -all -- \ 209 | {%([Ee][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])} \ 210 | $str {[encoding convertfrom utf-8 [binary decode hex \1\2\3]]} str 211 | regsub -all -- \ 212 | {%([CDcd][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])} \ 213 | $str {[encoding convertfrom utf-8 [binary decode hex \1\2]]} str 214 | regsub -all -- {%([0-7][A-Fa-f0-9])} $str {\\u00\1} str 215 | return [subst -novar $str] 216 | } 217 | 218 | # Reset the document back to an empty string. 219 | # 220 | proc wapp-reset {} { 221 | global wapp 222 | dict set wapp .reply {} 223 | } 224 | 225 | # Change the mime-type of the result document. 226 | # 227 | proc wapp-mimetype {x} { 228 | global wapp 229 | dict set wapp .mimetype $x 230 | } 231 | 232 | # Change the reply code. 233 | # 234 | proc wapp-reply-code {x} { 235 | global wapp 236 | dict set wapp .reply-code $x 237 | } 238 | 239 | # Set a cookie 240 | # 241 | proc wapp-set-cookie {name value} { 242 | global wapp 243 | if {![regexp {^[]!#$%&'()*+./:0-9<=>?@A-Z[^_`a-z{|}~-]+$} $value]} { 244 | error "Bad cookie value: '$value'" 245 | } 246 | dict lappend wapp .new-cookies $name $value 247 | } 248 | 249 | # Unset a cookie 250 | # 251 | proc wapp-clear-cookie {name} { 252 | wapp-set-cookie $name {} 253 | } 254 | 255 | # Add extra entries to the reply header 256 | # 257 | proc wapp-reply-extra {name value} { 258 | global wapp 259 | dict lappend wapp .reply-extra $name $value 260 | } 261 | 262 | # Specifies how the web-page under construction should be cached. 263 | # The argument should be one of: 264 | # 265 | # no-cache 266 | # max-age=N (for some integer number of seconds, N) 267 | # private,max-age=N 268 | # 269 | proc wapp-cache-control {x} { 270 | wapp-reply-extra Cache-Control $x 271 | } 272 | 273 | # Redirect to a different web page 274 | # 275 | proc wapp-redirect {uri} { 276 | wapp-reply-code {307 Redirect} 277 | wapp-reply-extra Location $uri 278 | } 279 | 280 | # Return the value of a wapp parameter 281 | # 282 | proc wapp-param {name {dflt {}}} { 283 | global wapp 284 | if {![dict exists $wapp $name]} {return $dflt} 285 | return [dict get $wapp $name] 286 | } 287 | 288 | # Return true if a and only if the wapp parameter $name exists 289 | # 290 | proc wapp-param-exists {name} { 291 | global wapp 292 | return [dict exists $wapp $name] 293 | } 294 | 295 | # Set the value of a wapp parameter 296 | # 297 | proc wapp-set-param {name value} { 298 | global wapp 299 | dict set wapp $name $value 300 | } 301 | 302 | # Return all parameter names that match the GLOB pattern, or all 303 | # names if the GLOB pattern is omitted. 304 | # 305 | proc wapp-param-list {{glob {*}}} { 306 | global wapp 307 | return [dict keys $wapp $glob] 308 | } 309 | 310 | # By default, Wapp does not decode query parameters and POST parameters 311 | # for cross-origin requests. This is a security restriction, designed to 312 | # help prevent cross-site request forgery (CSRF) attacks. 313 | # 314 | # As a consequence of this restriction, URLs for sites generated by Wapp 315 | # that contain query parameters will not work as URLs found in other 316 | # websites. You cannot create a link from a second website into a Wapp 317 | # website if the link contains query planner, by default. 318 | # 319 | # Of course, it is sometimes desirable to allow query parameters on external 320 | # links. For URLs for which this is safe, the application should invoke 321 | # wapp-allow-xorigin-params. This procedure tells Wapp that it is safe to 322 | # go ahead and decode the query parameters even for cross-site requests. 323 | # 324 | # In other words, for Wapp security is the default setting. Individual pages 325 | # need to actively disable the cross-site request security if those pages 326 | # are safe for cross-site access. 327 | # 328 | proc wapp-allow-xorigin-params {} { 329 | global wapp 330 | if {![dict exists $wapp .qp] && ![dict get $wapp SAME_ORIGIN]} { 331 | wappInt-decode-query-params 332 | } 333 | } 334 | 335 | # Set the content-security-policy. 336 | # 337 | # The default content-security-policy is very strict: "default-src 'self'" 338 | # The default policy prohibits the use of in-line javascript or CSS. 339 | # 340 | # Provide an alternative CSP as the argument. Or use "off" to disable 341 | # the CSP completely. 342 | # 343 | proc wapp-content-security-policy {val} { 344 | global wapp 345 | if {$val=="off"} { 346 | dict unset wapp .csp 347 | } else { 348 | dict set wapp .csp $val 349 | } 350 | } 351 | 352 | # Examine the bodys of all procedures in this program looking for 353 | # unsafe calls to various Wapp interfaces. Return a text string 354 | # containing warnings. Return an empty string if all is ok. 355 | # 356 | # This routine is advisory only. It misses some constructs that are 357 | # dangerous and flags others that are safe. 358 | # 359 | proc wapp-safety-check {} { 360 | set res {} 361 | foreach p [info command] { 362 | set ln 0 363 | foreach x [split [info body $p] \n] { 364 | incr ln 365 | if {[regexp {^[ \t]*wapp[ \t]+([^\n]+)} $x all tail] 366 | && [string index $tail 0]!="\173" 367 | && [regexp {[[$]} $tail] 368 | } { 369 | append res "$p:$ln: unsafe \"wapp\" call: \"[string trim $x]\"\n" 370 | } 371 | if {[regexp {^[ \t]*wapp-(subst|trim)[ \t]+[^\173]} $x all cx]} { 372 | append res "$p:$ln: unsafe \"wapp-$cx\" call: \"[string trim $x]\"\n" 373 | } 374 | } 375 | } 376 | return $res 377 | } 378 | 379 | # Return a string that descripts the current environment. Applications 380 | # might find this useful for debugging. 381 | # 382 | proc wapp-debug-env {} { 383 | global wapp 384 | set out {} 385 | foreach var [lsort [dict keys $wapp]] { 386 | if {[string index $var 0]=="."} continue 387 | append out "$var = [list [dict get $wapp $var]]\n" 388 | } 389 | append out "\[pwd\] = [list [pwd]]\n" 390 | return $out 391 | } 392 | 393 | # Tracing function for each HTTP request. This is overridden by wapp-start 394 | # if tracing is enabled. 395 | # 396 | proc wappInt-trace {} {} 397 | 398 | # Start up a listening socket. Arrange to invoke wappInt-new-connection 399 | # for each inbound HTTP connection. 400 | # 401 | # laddr Listen on this addr (tcp!ADDR!PORT). Port 0 means to select 402 | # a port that is not currently in use 403 | # 404 | # wappmode One of "scgi", "remote-scgi", "server", or "local". 405 | # 406 | # fromip If not {}, then reject all requests from IP addresses 407 | # other than $fromip 408 | # 409 | proc wappInt-start-listener {laddr wappmode fromip} { 410 | if {[string match *scgi $wappmode]} { 411 | set type SCGI 412 | set server [list wappInt-new-connection \ 413 | wappInt-scgi-readable $wappmode $fromip] 414 | } else { 415 | set type HTTP 416 | set server [list wappInt-new-connection \ 417 | wappInt-http-readable $wappmode $fromip] 418 | } 419 | set laddr [split $laddr "!"] 420 | switch [llength $laddr] { 421 | 3 { 422 | if {[lindex $laddr 0] ne "tcp"} { 423 | error "Listen error: only 'tcp' network is supported now" 424 | } 425 | set host [lindex $laddr 1] 426 | set port [lindex $laddr 2] 427 | } 428 | 2 { 429 | if {[lindex $laddr 0] ne "tcp"} { 430 | error "Listen error: only 'tcp' network is supported now" 431 | } 432 | set host [lindex $laddr 1] 433 | set port 0 434 | } 435 | default { 436 | set host [lindex $laddr 0] 437 | set port 0 438 | } 439 | } 440 | if {$wappmode=="local" || $wappmode=="scgi"} { 441 | set x [socket -server $server -myaddr $host $port] 442 | } else { 443 | set x [socket -server $server -myaddr $host $port] 444 | } 445 | set coninfo [chan configure $x -sockname] 446 | set port [lindex $coninfo 2] 447 | if {$wappmode=="local"} { 448 | wappInt-start-browser http://$host:$port/ 449 | } elseif {$fromip!=""} { 450 | puts "Listening for $type requests on $host:$port from IP $fromip" 451 | } else { 452 | puts "Listening for $type requests on $host:$port" 453 | } 454 | } 455 | 456 | # Start a web-browser and point it at $URL 457 | # 458 | proc wappInt-start-browser {url} { 459 | global tcl_platform 460 | if {$tcl_platform(platform)=="windows"} { 461 | exec cmd /c start $url & 462 | } elseif {$tcl_platform(os)=="Darwin"} { 463 | exec open $url & 464 | } elseif {[catch {exec xdg-open $url}]} { 465 | exec firefox $url & 466 | } 467 | } 468 | 469 | # This routine is a "socket -server" callback. The $chan, $ip, and $port 470 | # arguments are added by the socket command. 471 | # 472 | # Arrange to invoke $callback when content is available on the new socket. 473 | # The $callback will process inbound HTTP or SCGI content. Reject the 474 | # request if $fromip is not an empty string and does not match $ip. 475 | # 476 | proc wappInt-new-connection {callback wappmode fromip chan ip port} { 477 | upvar #0 wappInt-$chan W 478 | if {$fromip!="" && ![string match $fromip $ip]} { 479 | close $chan 480 | return 481 | } 482 | set W [dict create REMOTE_ADDR $ip REMOTE_PORT $port WAPP_MODE $wappmode \ 483 | .header {}] 484 | fconfigure $chan -blocking 0 -translation binary 485 | fileevent $chan readable [list $callback $chan] 486 | } 487 | 488 | # Close an input channel 489 | # 490 | proc wappInt-close-channel {chan} { 491 | if {$chan=="stdout"} { 492 | # This happens after completing a CGI request 493 | exit 0 494 | } else { 495 | unset ::wappInt-$chan 496 | close $chan 497 | } 498 | } 499 | 500 | # Process new text received on an inbound HTTP request 501 | # 502 | proc wappInt-http-readable {chan} { 503 | if {[catch [list wappInt-http-readable-unsafe $chan] msg]} { 504 | puts stderr "$msg\n$::errorInfo" 505 | wappInt-close-channel $chan 506 | } 507 | } 508 | proc wappInt-http-readable-unsafe {chan} { 509 | upvar #0 wappInt-$chan W wapp wapp 510 | if {![dict exists $W .toread]} { 511 | # If the .toread key is not set, that means we are still reading 512 | # the header 513 | set line [string trimright [gets $chan]] 514 | set n [string length $line] 515 | if {$n>0} { 516 | if {[dict get $W .header]=="" || [regexp {^\s+} $line]} { 517 | dict append W .header $line 518 | } else { 519 | dict append W .header \n$line 520 | } 521 | if {[string length [dict get $W .header]]>100000} { 522 | error "HTTP request header too big - possible DOS attack" 523 | } 524 | } elseif {$n==0} { 525 | # We have reached the blank line that terminates the header. 526 | global argv0 527 | if {[info exists ::argv0]} { 528 | set a0 [file normalize $argv0] 529 | } else { 530 | set a0 / 531 | } 532 | dict set W SCRIPT_FILENAME $a0 533 | dict set W DOCUMENT_ROOT [file dir $a0] 534 | if {[wappInt-parse-header $chan]} { 535 | catch {close $chan} 536 | return 537 | } 538 | set len 0 539 | if {[dict exists $W CONTENT_LENGTH]} { 540 | set len [dict get $W CONTENT_LENGTH] 541 | } 542 | if {$len>0} { 543 | # Still need to read the query content 544 | dict set W .toread $len 545 | } else { 546 | # There is no query content, so handle the request immediately 547 | set wapp $W 548 | wappInt-handle-request $chan 549 | } 550 | } 551 | } else { 552 | # If .toread is set, that means we are reading the query content. 553 | # Continue reading until .toread reaches zero. 554 | set got [read $chan [dict get $W .toread]] 555 | dict append W CONTENT $got 556 | dict set W .toread [expr {[dict get $W .toread]-[string length $got]}] 557 | if {[dict get $W .toread]<=0} { 558 | # Handle the request as soon as all the query content is received 559 | set wapp $W 560 | wappInt-handle-request $chan 561 | } 562 | } 563 | } 564 | 565 | # Decode the HTTP request header. 566 | # 567 | # This routine is always running inside of a [catch], so if 568 | # any problems arise, simply raise an error. 569 | # 570 | proc wappInt-parse-header {chan} { 571 | upvar #0 wappInt-$chan W 572 | set hdr [split [dict get $W .header] \n] 573 | if {$hdr==""} {return 1} 574 | set req [lindex $hdr 0] 575 | dict set W REQUEST_METHOD [set method [lindex $req 0]] 576 | if {[lsearch -exact {GET HEAD POST PUT PATCH DELETE} $method]<0} { 577 | error "unsupported request method: \"[dict get $W REQUEST_METHOD]\"" 578 | } 579 | set uri [lindex $req 1] 580 | if {![regexp {^([^?#]+)(?:\?([^#]*))?$} $uri all uri_path uri_query]} { 581 | error "invalid request uri: \"$uri\"" 582 | } 583 | if {![regexp {^/[-.A-Za-z0-9_~/%!$&'()*+,;=:@]*$} $uri_path]} { 584 | error "invalid request uri path: \"$uri_path\"" 585 | } 586 | dict set W REQUEST_URI $uri_path 587 | dict set W PATH_INFO $uri_path 588 | dict set W QUERY_STRING $uri_query 589 | set n [llength $hdr] 590 | for {set i 1} {$i<$n} {incr i} { 591 | set x [lindex $hdr $i] 592 | if {![regexp {^([^:]+):[[:blank:]]*(.*?)[[:blank:]]*$} $x all name value]} { 593 | error "invalid header line: \"$x\"" 594 | } 595 | set name [string toupper $name] 596 | switch -- $name { 597 | REFERER {set name HTTP_REFERER} 598 | USER-AGENT {set name HTTP_USER_AGENT} 599 | CONTENT-LENGTH {set name CONTENT_LENGTH} 600 | CONTENT-TYPE {set name CONTENT_TYPE} 601 | HOST {set name HTTP_HOST} 602 | COOKIE {set name HTTP_COOKIE} 603 | ACCEPT-ENCODING {set name HTTP_ACCEPT_ENCODING} 604 | default {set name .hdr:$name} 605 | } 606 | dict set W $name $value 607 | } 608 | return 0 609 | } 610 | 611 | # Decode the QUERY_STRING parameters from a GET request or the 612 | # application/x-www-form-urlencoded CONTENT from a POST request. 613 | # 614 | # This routine sets the ".qp" element of the ::wapp dict as a signal 615 | # that query parameters have already been decoded. 616 | # 617 | proc wappInt-decode-query-params {} { 618 | global wapp 619 | dict set wapp .qp 1 620 | if {[dict exists $wapp QUERY_STRING]} { 621 | foreach qterm [split [dict get $wapp QUERY_STRING] &] { 622 | set qsplit [split $qterm =] 623 | set nm [lindex $qsplit 0] 624 | if {[regexp {^[a-z][a-z0-9]*$} $nm]} { 625 | dict set wapp $nm [wappInt-decode-url [lindex $qsplit 1]] 626 | } 627 | } 628 | } 629 | if {[dict exists $wapp CONTENT_TYPE] && [dict exists $wapp CONTENT]} { 630 | set ctype [dict get $wapp CONTENT_TYPE] 631 | if {$ctype=="application/x-www-form-urlencoded"} { 632 | foreach qterm [split [string trim [dict get $wapp CONTENT]] &] { 633 | set qsplit [split $qterm =] 634 | set nm [lindex $qsplit 0] 635 | if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} { 636 | dict set wapp $nm [wappInt-decode-url [lindex $qsplit 1]] 637 | } 638 | } 639 | } elseif {[string match multipart/form-data* $ctype]} { 640 | regexp {^(.*?)\r\n(.*)$} [dict get $wapp CONTENT] all divider body 641 | set ndiv [string length $divider] 642 | while {[string length $body]} { 643 | set idx [string first $divider $body] 644 | set unit [string range $body 0 [expr {$idx-3}]] 645 | set body [string range $body [expr {$idx+$ndiv+2}] end] 646 | if {[regexp {^Content-Disposition: form-data; (.*?)\r\n\r\n(.*)$} \ 647 | $unit unit hdr content]} { 648 | if {[regexp {name="(.*)"; filename="(.*)"\r\nContent-Type: (.*?)$}\ 649 | $hdr hr name filename mimetype]} { 650 | dict set wapp $name.filename \ 651 | [string map [list \\\" \" \\\\ \\] $filename] 652 | dict set wapp $name.mimetype $mimetype 653 | dict set wapp $name.content $content 654 | } elseif {[regexp {name="(.*)"} $hdr hr name]} { 655 | dict set wapp $name $content 656 | } 657 | } 658 | } 659 | } 660 | } 661 | } 662 | 663 | # Invoke application-supplied methods to generate a reply to 664 | # a single HTTP request. 665 | # 666 | # This routine uses the global variable ::wapp and so must not be nested. 667 | # It must run to completion before the next instance runs. If a recursive 668 | # instances of this routine starts while another is running, the the 669 | # recursive instance is added to a queue to be invoked after the current 670 | # instance finishes. Yes, this means that WAPP IS SINGLE THREADED. Only 671 | # a single page rendering instance my be running at a time. There can 672 | # be multiple HTTP requests inbound at once, but only one my be processed 673 | # at a time once the request is full read and parsed. 674 | # 675 | set wappIntPending {} 676 | set wappIntLock 0 677 | proc wappInt-handle-request {chan} { 678 | global wappIntPending wappIntLock 679 | fileevent $chan readable {} 680 | if {$wappIntLock} { 681 | # Another instance of request is already running, so defer this one 682 | lappend wappIntPending [list wappInt-handle-request $chan] 683 | return 684 | } 685 | set wappIntLock 1 686 | catch [list wappInt-handle-request-unsafe $chan] 687 | set wappIntLock 0 688 | if {[llength $wappIntPending]>0} { 689 | # If there are deferred requests, then launch the oldest one 690 | after idle [lindex $wappIntPending 0] 691 | set wappIntPending [lrange $wappIntPending 1 end] 692 | } 693 | } 694 | proc wappInt-handle-request-unsafe {chan} { 695 | global wapp 696 | dict set wapp .reply {} 697 | dict set wapp .mimetype {text/html; charset=utf-8} 698 | dict set wapp .reply-code {200 Ok} 699 | dict set wapp .csp {default-src 'self'} 700 | 701 | # Set up additional CGI environment values 702 | # 703 | if {![dict exists $wapp HTTP_HOST]} { 704 | dict set wapp BASE_URL {} 705 | } elseif {[dict exists $wapp HTTPS]} { 706 | dict set wapp BASE_URL https://[dict get $wapp HTTP_HOST] 707 | } else { 708 | dict set wapp BASE_URL http://[dict get $wapp HTTP_HOST] 709 | } 710 | if {![dict exists $wapp REQUEST_URI]} { 711 | dict set wapp REQUEST_URI / 712 | } elseif {[regsub {\?.*} [dict get $wapp REQUEST_URI] {} newR]} { 713 | # Some servers (ex: nginx) append the query parameters to REQUEST_URI. 714 | # These need to be stripped off 715 | dict set wapp REQUEST_URI $newR 716 | } 717 | if {[dict exists $wapp SCRIPT_NAME]} { 718 | dict append wapp BASE_URL [dict get $wapp SCRIPT_NAME] 719 | } else { 720 | dict set wapp SCRIPT_NAME {} 721 | } 722 | if {![dict exists $wapp PATH_INFO]} { 723 | # If PATH_INFO is missing (ex: nginx) then construct it 724 | set URI [dict get $wapp REQUEST_URI] 725 | set skip [string length [dict get $wapp SCRIPT_NAME]] 726 | dict set wapp PATH_INFO [string range $URI $skip end] 727 | } 728 | if {[regexp {^/([^/]+)(.*)$} [dict get $wapp PATH_INFO] all head tail]} { 729 | dict set wapp PATH_HEAD $head 730 | dict set wapp PATH_TAIL [string trimleft $tail /] 731 | } else { 732 | dict set wapp PATH_INFO {} 733 | dict set wapp PATH_HEAD {} 734 | dict set wapp PATH_TAIL {} 735 | } 736 | dict set wapp SELF_URL [dict get $wapp BASE_URL]/[dict get $wapp PATH_HEAD] 737 | 738 | # Parse query parameters from the query string, the cookies, and 739 | # POST data 740 | # 741 | if {[dict exists $wapp HTTP_COOKIE]} { 742 | set cparsed [wappInt-cookies-parse [dict get $wapp HTTP_COOKIE]] 743 | dict for {cname cval} $cparsed { 744 | if {[regexp {^[a-z][-a-z0-9_]*$} $cname]} { 745 | dict set wapp $cname $cval 746 | } 747 | } 748 | } 749 | set same_origin 0 750 | if {[dict exists $wapp HTTP_REFERER]} { 751 | set referer [dict get $wapp HTTP_REFERER] 752 | set base [dict get $wapp BASE_URL] 753 | if {$referer==$base || [string match $base/* $referer]} { 754 | set same_origin 1 755 | } 756 | } 757 | dict set wapp SAME_ORIGIN $same_origin 758 | if {$same_origin} { 759 | wappInt-decode-query-params 760 | } 761 | 762 | # Invoke the application-defined handler procedure for this page 763 | # request. If an error occurs while running that procedure, generate 764 | # an HTTP reply that contains the error message. 765 | # 766 | wapp-before-dispatch-hook 767 | wappInt-trace 768 | set mname [dict get $wapp PATH_HEAD] 769 | if {[catch { 770 | if {$mname!="" && [llength [info command wapp-page-$mname]]>0} { 771 | wapp-page-$mname 772 | } else { 773 | wapp-default 774 | } 775 | } msg]} { 776 | if {[wapp-param WAPP_MODE]=="local" || [wapp-param WAPP_MODE]=="server"} { 777 | puts "ERROR: $::errorInfo" 778 | } 779 | wapp-reset 780 | wapp-reply-code "500 Internal Server Error" 781 | wapp-mimetype text/html 782 | wapp-trim { 783 |

Wapp Application Error

784 | 
%html($::errorInfo)
785 | } 786 | dict unset wapp .new-cookies 787 | } 788 | 789 | # Transmit the HTTP reply 790 | # 791 | if {$chan=="stdout"} { 792 | puts $chan "Status: [dict get $wapp .reply-code]\r" 793 | } else { 794 | puts $chan "HTTP/1.1 [dict get $wapp .reply-code]\r" 795 | puts $chan "Server: wapp\r" 796 | puts $chan "Connection: close\r" 797 | } 798 | if {[dict exists $wapp .reply-extra]} { 799 | foreach {name value} [dict get $wapp .reply-extra] { 800 | puts $chan "$name: $value\r" 801 | } 802 | } 803 | if {[dict exists $wapp .csp]} { 804 | puts $chan "Content-Security-Policy: [dict get $wapp .csp]\r" 805 | } 806 | if {[dict exists $wapp .new-cookies]} { 807 | foreach {nm val} [dict get $wapp .new-cookies] { 808 | if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} { 809 | if {$val==""} { 810 | puts $chan "Set-Cookie: $nm=; HttpOnly; Path=/; Max-Age=1\r" 811 | } else { 812 | set val $val 813 | puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/\r" 814 | } 815 | } 816 | } 817 | } 818 | 819 | wapp-write-content $wapp $chan 820 | } 821 | 822 | proc wapp-write-content { wapp chan } { 823 | if {[dict exists $wapp .filepath]} { 824 | wapp-deliver-file-content $wapp $chan 825 | return 826 | } else { 827 | set mimetype [dict get $wapp .mimetype] 828 | if {[string match text/* $mimetype]} { 829 | set reply [encoding convertto utf-8 [dict get $wapp .reply]] 830 | if {[regexp {\ygzip\y} [wapp-param HTTP_ACCEPT_ENCODING]]} { 831 | catch { 832 | set x [zlib gzip $reply] 833 | set reply $x 834 | puts $chan "Content-Encoding: gzip\r" 835 | } 836 | } 837 | } else { 838 | set reply [dict get $wapp .reply] 839 | } 840 | set contentLength [string length $reply] 841 | puts $chan "Content-Type: $mimetype\r" 842 | puts $chan "Content-Length: $contentLength\r" 843 | puts $chan \r 844 | 845 | puts -nonewline $chan $reply 846 | flush $chan 847 | wappInt-close-channel $chan 848 | } 849 | } 850 | 851 | proc wapp-deliver-file-content { wapp chan } { 852 | set mimetype [dict get $wapp .mimetype] 853 | set filepath [dict get $wapp .filepath] 854 | set contentLength [file size $filepath] 855 | set inchan [open $filepath rb] 856 | puts $chan "Content-Type: $mimetype\r" 857 | puts $chan "Content-Length: $contentLength\r" 858 | puts $chan \r 859 | fcopy $inchan $chan 860 | flush $chan 861 | close $inchan 862 | wappInt-close-channel $chan 863 | } 864 | 865 | # This routine runs just prior to request-handler dispatch. The 866 | # default implementation is a no-op, but applications can override 867 | # to do additional transformations or checks. 868 | # 869 | proc wapp-before-dispatch-hook {} {return} 870 | 871 | # Process a single CGI request 872 | # 873 | proc wappInt-handle-cgi-request {} { 874 | global wapp env 875 | foreach key [array names env {[A-Z]*}] {dict set wapp $key $env($key)} 876 | set len 0 877 | if {[dict exists $wapp CONTENT_LENGTH]} { 878 | set len [dict get $wapp CONTENT_LENGTH] 879 | } 880 | if {$len>0} { 881 | fconfigure stdin -translation binary 882 | dict set wapp CONTENT [read stdin $len] 883 | } 884 | dict set wapp WAPP_MODE cgi 885 | fconfigure stdout -translation binary 886 | wappInt-handle-request-unsafe stdout 887 | } 888 | 889 | # Process new text received on an inbound SCGI request 890 | # 891 | proc wappInt-scgi-readable {chan} { 892 | if {[catch [list wappInt-scgi-readable-unsafe $chan] msg]} { 893 | puts stderr "$msg\n$::errorInfo" 894 | wappInt-close-channel $chan 895 | } 896 | } 897 | proc wappInt-scgi-readable-unsafe {chan} { 898 | upvar #0 wappInt-$chan W wapp wapp 899 | if {![dict exists $W .toread]} { 900 | # If the .toread key is not set, that means we are still reading 901 | # the header. 902 | # 903 | # An SGI header is short. This implementation assumes the entire 904 | # header is available all at once. 905 | # 906 | dict set W .remove_addr [dict get $W REMOTE_ADDR] 907 | set req [read $chan 15] 908 | set n [string length $req] 909 | scan $req %d:%s len hdr 910 | incr len [string length "$len:,"] 911 | append hdr [read $chan [expr {$len-15}]] 912 | foreach {nm val} [split $hdr \000] { 913 | if {$nm==","} break 914 | dict set W $nm $val 915 | } 916 | set len 0 917 | if {[dict exists $W CONTENT_LENGTH]} { 918 | set len [dict get $W CONTENT_LENGTH] 919 | } 920 | if {$len>0} { 921 | # Still need to read the query content 922 | dict set W .toread $len 923 | } else { 924 | # There is no query content, so handle the request immediately 925 | dict set W SERVER_ADDR [dict get $W .remove_addr] 926 | set wapp $W 927 | wappInt-handle-request $chan 928 | } 929 | } else { 930 | # If .toread is set, that means we are reading the query content. 931 | # Continue reading until .toread reaches zero. 932 | set got [read $chan [dict get $W .toread]] 933 | dict append W CONTENT $got 934 | dict set W .toread [expr {[dict get $W .toread]-[string length $got]}] 935 | if {[dict get $W .toread]<=0} { 936 | # Handle the request as soon as all the query content is received 937 | dict set W SERVER_ADDR [dict get $W .remove_addr] 938 | set wapp $W 939 | wappInt-handle-request $chan 940 | } 941 | } 942 | } 943 | 944 | # Start up the wapp framework. Parameters are a list passed as the 945 | # single argument. 946 | # 947 | # -server $LADDR Listen for HTTP requests on this address 948 | # in plan9 format - tcp!ADDR!PORT. Can be: 949 | # tcp!ADDR!0 or tcp!ADDR or ADDR. 950 | # 951 | # -local $PORT Listen for HTTP requests on 127.0.0.1:$PORT 952 | # 953 | # -scgi $PORT Listen for SCGI requests on 127.0.0.1:$PORT 954 | # 955 | # -remote-scgi $PORT Listen for SCGI requests on TCP port $PORT 956 | # 957 | # -cgi Handle a single CGI request 958 | # 959 | # With no arguments, the behavior is called "auto". In "auto" mode, 960 | # if the GATEWAY_INTERFACE environment variable indicates CGI, then run 961 | # as CGI. Otherwise, start an HTTP server bound to the loopback address 962 | # only, on an arbitrary TCP port, and automatically launch a web browser 963 | # on that TCP port. 964 | # 965 | # Additional options: 966 | # 967 | # -fromip GLOB Reject any incoming request where the remote 968 | # IP address does not match the GLOB pattern. This 969 | # value defaults to '127.0.0.1' for -local and -scgi. 970 | # 971 | # -nowait Do not wait in the event loop. Return immediately 972 | # after all event handlers are established. 973 | # 974 | # -trace "puts" each request URL as it is handled, for 975 | # debugging 976 | # 977 | # -lint Run wapp-safety-check on the application instead 978 | # of running the application itself 979 | # 980 | # -Dvar=value Set TCL global variable "var" to "value" 981 | # 982 | # 983 | proc wapp-start {arglist} { 984 | global env 985 | set mode auto 986 | set laddr "tcp!127.0.0.1!0" 987 | set nowait 0 988 | set fromip {} 989 | set n [llength $arglist] 990 | for {set i 0} {$i<$n} {incr i} { 991 | set term [lindex $arglist $i] 992 | if {[string match --* $term]} {set term [string range $term 1 end]} 993 | switch -glob -- $term { 994 | -server { 995 | incr i; 996 | set mode "server" 997 | set laddr [lindex $arglist $i] 998 | } 999 | -local { 1000 | incr i; 1001 | set mode "local" 1002 | set fromip 127.0.0.1 1003 | set laddr "tcp!127.0.0.1![lindex $arglist $i]" 1004 | } 1005 | -scgi { 1006 | incr i; 1007 | set mode "scgi" 1008 | set fromip 127.0.0.1 1009 | set laddr "tcp!127.0.0.1![lindex $arglist $i]" 1010 | } 1011 | -remote-scgi { 1012 | incr i; 1013 | set mode "remote-scgi" 1014 | set laddr "tcp!127.0.0.1![lindex $arglist $i]" 1015 | } 1016 | -cgi { 1017 | set mode "cgi" 1018 | } 1019 | -fromip { 1020 | incr i 1021 | set fromip [lindex $arglist $i] 1022 | } 1023 | -nowait { 1024 | set nowait 1 1025 | } 1026 | -trace { 1027 | proc wappInt-trace {} { 1028 | set q [wapp-param QUERY_STRING] 1029 | set uri [wapp-param BASE_URL][wapp-param PATH_INFO] 1030 | if {$q!=""} {append uri ?$q} 1031 | puts $uri 1032 | } 1033 | } 1034 | -lint { 1035 | set res [wapp-safety-check] 1036 | if {$res!=""} { 1037 | puts "Potential problems in this code:" 1038 | puts $res 1039 | exit 1 1040 | } else { 1041 | exit 1042 | } 1043 | } 1044 | -D*=* { 1045 | if {[regexp {^.D([^=]+)=(.*)$} $term all var val]} { 1046 | set ::$var $val 1047 | } 1048 | } 1049 | default { 1050 | error "unknown option: $term" 1051 | } 1052 | } 1053 | } 1054 | if {$mode=="auto"} { 1055 | if {[info exists env(GATEWAY_INTERFACE)] 1056 | && [string match CGI/1.* $env(GATEWAY_INTERFACE)]} { 1057 | set mode cgi 1058 | } else { 1059 | set mode local 1060 | } 1061 | } 1062 | if {$mode=="cgi"} { 1063 | wappInt-handle-cgi-request 1064 | } else { 1065 | wappInt-start-listener $laddr $mode $fromip 1066 | if {!$nowait} { 1067 | vwait ::forever 1068 | } 1069 | } 1070 | } 1071 | 1072 | # Call this version 1.0 1073 | package provide wapp 1.0 1074 | --------------------------------------------------------------------------------