Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Added a 2 minute timeout for coroutine::util::gets_safety Fixed how line breaks are expressed in the httpd module's tests Refactored how Httpd headers are pulled over a socket to better exploit the fact the process is taking place in a coroutine Bumped practcl's version to 0.10 |
---|---|
Timelines: | family | ancestors | descendants | both | hypnotoad |
Files: | files | file ages | folders |
SHA3-256: |
7c6d8768423b678937b5c6a52cda92e5 |
User & Date: | hypnotoad 2017-11-02 10:31:02 |
Context
2017-11-02
| ||
18:21 | Pulling changes from trunk check-in: 9bbf4e73bb user: hypnotoad tags: hypnotoad | |
18:21 | Added a timeout to ::coroutine::util::gets_safety. The delay is setable as a new optional argument. The default is 2 minutes. Refactored the HTTP header parsing system for httpd. Fixed a point where the parser was performing a bare read instead of the coroutine savvy version. Fixed bugs in the httpd test suite. New version of Practcl. Simplified the class structure. Shuffled functions to be closer to be where they are used, and also indicate who calls them. Tcl and Tk now compile in the directory relative to the master project. check-in: e0d0875ab4 user: hypnotoad tags: trunk | |
10:31 | Added a 2 minute timeout for coroutine::util::gets_safety Fixed how line breaks are expressed in the httpd module's tests Refactored how Httpd headers are pulled over a socket to better exploit the fact the process is taking place in a coroutine Bumped practcl's version to 0.10 check-in: 7c6d876842 user: hypnotoad tags: hypnotoad | |
2017-11-01
| ||
22:18 | Pulling changes from trunk check-in: 1db8e05b30 user: hypnotoad tags: hypnotoad | |
Changes
Changes to modules/coroutine/coroutine.tcl.
︙ | ︙ | |||
86 87 88 89 90 91 92 | proc ::coroutine::util::global {args} { # Frame #1 is the coroutine-specific stack frame at its # bottom. Variables there are out of view of the main code, and # can be made visible in the entire coroutine underneath. set cmd [list upvar "#1"] foreach var $args { | | | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | proc ::coroutine::util::global {args} { # Frame #1 is the coroutine-specific stack frame at its # bottom. Variables there are out of view of the main code, and # can be made visible in the entire coroutine underneath. set cmd [list upvar "#1"] foreach var $args { lappend cmd $var $var } tailcall {*}$cmd } # - -- --- ----- -------- ------------- proc ::coroutine::util::after {delay} { |
︙ | ︙ | |||
148 149 150 151 152 153 154 | # Force proper error message for bad call. tailcall ::tcl::update $what } else { ::after 0 [info coroutine] } yield return | | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | # Force proper error message for bad call. tailcall ::tcl::update $what } else { ::after 0 [info coroutine] } yield return } # - -- --- ----- -------- ------------- proc ::coroutine::util::gets {args} { # Process arguments. # Acceptable syntax: # * gets CHAN ?VARNAME? |
︙ | ︙ | |||
172 173 174 175 176 177 178 | # not enough, or too many arguments (0, or > 2): Calling the # builtin gets command with the bogus arguments gives us the # necessary error with the proper message. tailcall ::chan gets {*}$args } # Loop until we have a complete line. Yield to the event loop | | | 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | # not enough, or too many arguments (0, or > 2): Calling the # builtin gets command with the bogus arguments gives us the # necessary error with the proper message. tailcall ::chan gets {*}$args } # Loop until we have a complete line. Yield to the event loop # where necessary. During set blocking [::chan configure $chan -blocking] while {1} { ::chan configure $chan -blocking 0 try { set result [::chan gets $chan line] } on error {result opts} { |
︙ | ︙ | |||
207 208 209 210 211 212 213 | proc ::coroutine::util::gets_safety {chan limit varname} { # Process arguments. # Acceptable syntax: # * gets CHAN ?VARNAME? # Loop until we have a complete line. Yield to the event loop | | | > | | > > > > | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 | proc ::coroutine::util::gets_safety {chan limit varname} { # Process arguments. # Acceptable syntax: # * gets CHAN ?VARNAME? # Loop until we have a complete line. Yield to the event loop # where necessary. During set blocking [::chan configure $chan -blocking] upvar 1 $varname line try { while {1} { ::chan configure $chan -blocking 0 if {[::chan pending input $chan]>= $limit} { error {Too many notes, Mozart. Too many notes} } try { set result [::chan gets $chan line] } on error {result opts} { return -code $result -options $opts } if {[::chan blocked $chan]} { set timeoutevent [::after 120000 [list [info coroutine] timeout]] ::chan event $chan readable [list [info coroutine] readable] set event [yield] if {$event eq "timeout"} { error "Connection Timed Out" } ::after cancel $timeoutevent ::chan event $chan readable {} } else { return $result } } } finally { ::chan configure $chan -blocking $blocking |
︙ | ︙ | |||
359 360 361 362 363 364 365 | upvar 1 $varName var trace add variable var write $callback } set choice [yield] foreach varName $args { | | | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | upvar 1 $varName var trace add variable var write $callback } set choice [yield] foreach varName $args { #checker exclude warnShadowVar upvar 1 $varName var trace remove variable var write $callback } # Step 2. To prevent the next section of the coroutine code from # running entirely within the variable trace (*) we now use an # idle handler to defer it until the trace is definitely |
︙ | ︙ | |||
382 383 384 385 386 387 388 | } proc ::coroutine::util::AWaitSignal {coroutine var index op} { if {$op ne "write"} { return } set fullvar $var if {$index ne ""} { append fullvar ($index) } $coroutine $fullvar | | | 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 | } proc ::coroutine::util::AWaitSignal {coroutine var index op} { if {$op ne "write"} { return } set fullvar $var if {$index ne ""} { append fullvar ($index) } $coroutine $fullvar } # # ## ### ##### ######## ############# ## Internal (package specific) commands proc ::coroutine::util::ID {} { variable counter return [namespace current]::C[incr counter] |
︙ | ︙ |
Changes to modules/httpd/content.tcl.
︙ | ︙ | |||
11 12 13 14 15 16 17 | ### # Class to deliver Static content # When utilized, this class is fed a local filename # by the dispatcher ### ::tool::define ::httpd::content::file { | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | ### # Class to deliver Static content # When utilized, this class is fed a local filename # by the dispatcher ### ::tool::define ::httpd::content::file { method FileName {} { set uri [string trimleft [my query_headers get REQUEST_URI] /] set path [my query_headers get path] set prefix [my query_headers get prefix] set fname [string range $uri [string length $prefix] end] if {$fname in "{} index.html index.md index"} { return $path |
︙ | ︙ | |||
34 35 36 37 38 39 40 | return [file join $path $fname.html] } if {[file exists [file join $path $fname.tml]]} { return [file join $path $fname.tml] } return {} } | | | | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | return [file join $path $fname.html] } if {[file exists [file join $path $fname.tml]]} { return [file join $path $fname.tml] } return {} } method DirectoryListing {local_file} { my puts "<HTML><BODY><TABLE>" foreach file [glob -nocomplain [file join $local_file *]] { my puts "<TR><TD><a href=\"[file tail $file]\">[file tail $file]</a></TD><TD>[file size $file]</TD></TR>" } my puts "</TABLE></BODY></HTML>" } method dispatch {newsock datastate} { # No need to process the rest of the headers my variable chan dipatched_time set dispatched_time [clock seconds] my query_headers replace $datastate set chan $newsock my content |
︙ | ︙ | |||
98 99 100 101 102 103 104 | my puts [::Markdown::convert $mdtxt] } .tml { my reply_headers set Content-Type: {text/html; charset=ISO-8859-1} set tmltxt [::fileutil::cat $local_file] set headers [my query_headers dump] dict with headers {} | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | my puts [::Markdown::convert $mdtxt] } .tml { my reply_headers set Content-Type: {text/html; charset=ISO-8859-1} set tmltxt [::fileutil::cat $local_file] set headers [my query_headers dump] dict with headers {} my puts [subst $tmltxt] } default { ### # Assume we are returning a binary file ### my reply_headers set Content-Type: [::fileutil::magic::filetype $local_file] set reply_file $local_file |
︙ | ︙ | |||
140 141 142 143 144 145 146 | ### # Return dynamic content ### set reply_body [string trim $reply_body] append result "Content-length: [string length $reply_body]" \n \n append result $reply_body chan puts -nonewline $chan $result | | | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | ### # Return dynamic content ### set reply_body [string trim $reply_body] append result "Content-length: [string length $reply_body]" \n \n append result $reply_body chan puts -nonewline $chan $result chan flush $chan my destroy } else { ### # Return a stream of data from a file ### set size [file size $reply_file] append result "Content-length: $size" \n \n |
︙ | ︙ | |||
171 172 173 174 175 176 177 | # This method should check if a process is launched # or launch it if needed, and return a list of # HOST PORT SCRIPT_NAME ### # return {localhost 8016 /some/path} error unimplemented } | | | | | | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 | # This method should check if a process is launched # or launch it if needed, and return a list of # HOST PORT SCRIPT_NAME ### # return {localhost 8016 /some/path} error unimplemented } method content {} { my variable sock chan set sockinfo [my scgi_info] if {$sockinfo eq {}} { my error 404 {Not Found} return } lassign $sockinfo scgihost scgiport scgiscript set sock [::socket $scgihost $scgiport] # Add a few headers that SCGI needs #my query_headers set SERVER_NAME [my <server> cget server_name] my query_headers set SCRIPT_NAME $scgiscript my query_headers set SCGI 1.0 #my query_headers set SERVER_PORT [my <server> port_listening] #set ::env(SCRIPT_NAME) $scgiscript ::puts {HEADERS} foreach {field element} [my query_headers dump] { ::puts [list $field $element] } chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096 chan configure $sock -translation binary -blocking 0 -buffering full -buffersize 4096 ### # Convert our query headers into netstring format. Note that # MimeParse as already rigged it such that CONTENT_LENGTH is first |
︙ | ︙ | |||
214 215 216 217 218 219 220 | chan flush $sock ### # Wake this object up after the SCGI process starts to respond ### #chan configure $sock -translation {auto crlf} -blocking 0 -buffering line chan event $sock readable [namespace code {my output}] } | | < | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 | chan flush $sock ### # Wake this object up after the SCGI process starts to respond ### #chan configure $sock -translation {auto crlf} -blocking 0 -buffering line chan event $sock readable [namespace code {my output}] } method DoOutput {} { my variable chan sock chan event $chan writable {} if {![info exists sock] || [my query_headers getnull HTTP_ERROR] ne {}} { ### # If something croaked internally, handle this page as a normal reply ### next return } set replyhead [my HttpHeaders $sock] set replydat [my MimeParse $replyhead] ### # Convert the Status: header from the SCGI service to # a standard service reply line from a web server, but # otherwise spit out the rest of the headers verbatim ### if {![dict exists $replydat HTTP_STATUS]} { |
︙ | ︙ | |||
273 274 275 276 277 278 279 | # This method should check if a process is launched # or launch it if needed, and return a list of # HOST PORT PROXYURI ### # return {localhost 8016 /some/path} error unimplemented } | | | | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 | # This method should check if a process is launched # or launch it if needed, and return a list of # HOST PORT PROXYURI ### # return {localhost 8016 /some/path} error unimplemented } method content {} { my variable chan sock rawrequest set sockinfo [my proxy_info] if {$sockinfo eq {}} { tailcall my error 404 {Not Found} } lassign $sockinfo proxyhost proxyport proxyscript set sock [::socket $proxyhost $proxyport] chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096 chan configure $sock -translation {auto crlf} -blocking 1 -buffering line # Pass along our modified METHOD URI PROTO chan puts $sock "$proxyscript" # Pass along the headers as we saw them chan puts $sock $rawrequest |
︙ | ︙ | |||
304 305 306 307 308 309 310 | chan flush $sock ### # Wake this object up after the proxied process starts to respond ### chan configure $sock -translation {auto crlf} -blocking 1 -buffering line chan event $sock readable [namespace code {my output}] } | | | | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | chan flush $sock ### # Wake this object up after the proxied process starts to respond ### chan configure $sock -translation {auto crlf} -blocking 1 -buffering line chan event $sock readable [namespace code {my output}] } method DoOutput {} { my variable chan sock chan event $chan writable {} if {![info exists sock] || [my query_headers getnull HTTP_ERROR] ne {}} { ### # If something croaked internally, handle this page as a normal reply ### next return } set length 0 chan configure $sock -translation {crlf crlf} -blocking 1 set replystatus [gets $sock] set replyhead [my HttpHeaders $sock] set replydat [my MimeParse $replyhead] ### # Pass along the status line and MIME headers ### set replybuffer "$replystatus\n" append replybuffer $replyhead chan configure $chan -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096 chan puts $chan $replybuffer |
︙ | ︙ | |||
353 354 355 356 357 358 359 | # Modified httpd server with a template engine # and a shim to insert URL domains ### ::tool::define ::httpd::server::dispatch { array template option doc_root {default {}} variable url_patterns {} | | | | | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | # Modified httpd server with a template engine # and a shim to insert URL domains ### ::tool::define ::httpd::server::dispatch { array template option doc_root {default {}} variable url_patterns {} method add_uri {pattern info} { my variable url_patterns dict set url_patterns $pattern $info } method PrefixNormalize prefix { set prefix [string trimright $prefix /] set prefix [string trimright $prefix *] set prefix [string trimright $prefix /] return $prefix } method dispatch {data} { set reply $data set uri [dict get $data REQUEST_PATH] # Search from longest pattern to shortest my variable url_patterns foreach {pattern info} $url_patterns { if {[string match ${pattern} /$uri]} { |
︙ | ︙ | |||
392 393 394 395 396 397 398 | dict set reply prefix {} dict set reply path $doc_root dict set reply mixin httpd::content::file return $reply } return {} } | | | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | dict set reply prefix {} dict set reply path $doc_root dict set reply mixin httpd::content::file return $reply } return {} } method TemplateSearch page { set doc_root [my cget doc_root] if {$doc_root ne {} && [file exists [file join $doc_root $page.tml]]} { return [::fileutil::cat [file join $doc_root $page.tml]] } if {$doc_root ne {} && [file exists [file join $doc_root $page.html]]} { return [::fileutil::cat [file join $doc_root $page.html]] } return [next $page] } } package provide httpd::content 4.0.1 |
Changes to modules/httpd/httpd.tcl.
︙ | ︙ | |||
86 87 88 89 90 91 92 | # # We do this rather than entering blocking mode to prevent the process # from locking up if it's starved for input. (Or in the case of the test # suite, when we are opening a blocking channel on the other side of the # socket back to ourselves.) ### chan configure $sock -translation {crlf crlf} -blocking 0 -buffering line | < < < < < < < < < < < < < < < < < > | | < < < | > > > > > > | 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 | # # We do this rather than entering blocking mode to prevent the process # from locking up if it's starved for input. (Or in the case of the test # suite, when we are opening a blocking channel on the other side of the # socket back to ourselves.) ### chan configure $sock -translation {crlf crlf} -blocking 0 -buffering line try { while 1 { set readCount [::coroutine::util::gets_safety $sock 4096 line] if {[string trim $line] eq {}} break append result $line \n } } trap {POSIX EBUSY} {err info} { # Happens... } on error {err info} { puts "ERROR $err" puts [dict print $info] tailcall my destroy } ### # Return our buffer ### return $result } method MimeParse mimetext { set data(mimeorder) {} foreach line [split $mimetext \n] { # This regexp picks up # key: value # MIME headers. MIME headers may be continue with a line # that starts with spaces or a tab if {[string length [string trim $line]]==0} break if {[regexp {^([^ :]+):[ ]*(.*)} $line dummy key value]} { |
︙ | ︙ | |||
373 374 375 376 377 378 379 | return $postdata } set postdata {} if {[my query_headers get REQUEST_METHOD] in {"POST" "PUSH"}} { my variable chan chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096 set length [my query_headers get CONTENT_LENGTH] | | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | return $postdata } set postdata {} if {[my query_headers get REQUEST_METHOD] in {"POST" "PUSH"}} { my variable chan chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096 set length [my query_headers get CONTENT_LENGTH] set postdata [::coroutine::util::read $chan $length] } return $postdata } method TransferComplete args { foreach c $args { catch {close $c} |
︙ | ︙ | |||
428 429 430 431 432 433 434 | method timestamp {} { return [clock format [clock seconds] -format {%a, %d %b %Y %T %Z}] } } ### # A simplistic web server, with a few caveats: | < | | | 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | method timestamp {} { return [clock format [clock seconds] -format {%a, %d %b %Y %T %Z}] } } ### # A simplistic web server, with a few caveats: # 1) It is not hardened in any way against malicious attacks # 2) By default it will only listen on localhost ### ::tool::define ::httpd::server { option port {default: auto} option myaddr {default: 127.0.0.1} option server_string [list default: [list TclHttpd $::httpd::version]] option server_name [list default: [list [info hostname]]] |
︙ | ︙ | |||
476 477 478 479 480 481 482 483 484 485 486 487 488 489 | tailcall my Connect $uuid $sock $ip } [namespace current]] $uuid $sock $ip] chan event $sock readable $coro } method Connect {uuid sock ip} { my counter url_hit set line {} try { set readCount [::coroutine::util::gets_safety $sock 4096 line] dict set query REMOTE_ADDR $ip dict set query REQUEST_METHOD [lindex $line 0] set uriinfo [::uri::split [lindex $line 1]] | > | 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 | tailcall my Connect $uuid $sock $ip } [namespace current]] $uuid $sock $ip] chan event $sock readable $coro } method Connect {uuid sock ip} { chan event $sock readable {} my counter url_hit set line {} try { set readCount [::coroutine::util::gets_safety $sock 4096 line] dict set query REMOTE_ADDR $ip dict set query REQUEST_METHOD [lindex $line 0] set uriinfo [::uri::split [lindex $line 1]] |
︙ | ︙ |
Changes to modules/httpd/httpd.test.
︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 | use fileutil/fileutil.tcl fileutil use sha1/sha1.tcl sha1 use uri/uri.tcl uri use ncgi/ncgi.tcl ncgi use dns/ip.tcl ip use nettool/nettool.tcl nettool use dicttool/dicttool.tcl dicttool use cron/cron.tcl cron use oodialect/oodialect.tcl oo::dialect use oometa/oometa.tcl oo::meta use tool/tool.tcl tool } | > | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | use fileutil/fileutil.tcl fileutil use sha1/sha1.tcl sha1 use uri/uri.tcl uri use ncgi/ncgi.tcl ncgi use dns/ip.tcl ip use nettool/nettool.tcl nettool use coroutine/coroutine.tcl coroutine use dicttool/dicttool.tcl dicttool use cron/cron.tcl cron use oodialect/oodialect.tcl oo::dialect use oometa/oometa.tcl oo::meta use tool/tool.tcl tool } |
︙ | ︙ | |||
45 46 47 48 49 50 51 | proc ::httpd::test::send {port text} { set sock [socket localhost $port] variable reply set reply($sock) {} chan configure $sock -translation binary -blocking 0 -buffering full -buffersize 4096 chan event $sock readable [list ::httpd::test::get_reply $sock] | | | | | | > > | > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | proc ::httpd::test::send {port text} { set sock [socket localhost $port] variable reply set reply($sock) {} chan configure $sock -translation binary -blocking 0 -buffering full -buffersize 4096 chan event $sock readable [list ::httpd::test::get_reply $sock] set headers {} set body {} set read_headers 1 foreach line [split $text \n] { if {$read_headers} { if { $line eq {} } { set read_headers 0 } else { append headers $line \x0d\x0a } } else { append body $line \x0d\x0a } } append headers "Content-Type: text/plain" \x0d\x0a append headers "Content-Length: [string length $body]" \x0d\x0a puts $sock $headers puts $sock \x0d\x0a puts $sock $body puts $sock \x0d\x0a flush $sock while {$reply($sock) eq {}} { update } #vwait [namespace current]::reply($sock) return $reply($sock) } |
︙ | ︙ | |||
87 88 89 90 91 92 93 | } ### # Build the reply class ### | | | < | > | < | < > | | < < < < | | 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 | } ### # Build the reply class ### tool::class create ::httpd::test::reply { superclass ::httpd::reply method error {code {msg {}} {errorInfo {}}} { my query_headers set HTTP_ERROR $code my reset my variable error_codes set qheaders [my query_headers dump] if {![info exists error_codes($code)]} { set errorstring "Unknown Error Code" } else { set errorstring $error_codes($code) } dict with qheaders {} my reply_headers replace {} my reply_headers set Status: "$code $errorstring" my reply_headers set Content-Type: text/plain my puts " $code $errorstring" } method reset {} { my variable reply_body my reply_headers replace {Status: {200 OK} Content-Type: text/plain} set reply_body {} } method content {} { my reset switch [my query_headers get REQUEST_URI] { /file { my variable reply_file set reply_file [file join $::here pkgIndex.tcl] } |
︙ | ︙ | |||
178 179 180 181 182 183 184 | ### append result "Content-length: [file size $reply_file]" \n \n puts -nonewline $chan $result set reply_chan [open $reply_file r] chan copy $reply_chan $chan catch {close $reply_chan} } | | | | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | ### append result "Content-length: [file size $reply_file]" \n \n puts -nonewline $chan $result set reply_chan [open $reply_file r] chan copy $reply_chan $chan catch {close $reply_chan} } chan flush $chan my destroy } } ### # Build the server ### tool::class create httpd::test::app { superclass ::httpd::server property reply_class ::httpd::test::reply } httpd::test::app create TESTAPP port 10001 test httpd-client-0001 {Do an echo request} { |
︙ | ︙ | |||
240 241 242 243 244 245 246 | set reply [::httpd::test::send 10001 {POST /error HTTP/1.0 THIS ONE ALONE IS MINE }] } {HTTP/1.0 500 Server Internal Error Content-Type: text/plain Connection: close | | | < < < | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | set reply [::httpd::test::send 10001 {POST /error HTTP/1.0 THIS ONE ALONE IS MINE }] } {HTTP/1.0 500 Server Internal Error Content-Type: text/plain Connection: close Content-length: 25 500 Server Internal Error} set checkreply [subst {HTTP/1.0 200 OK Content-Type: text/plain Connection: close Content-length: 10 [clock seconds]}] |
︙ | ︙ |
Changes to modules/practcl/build.tcl.
1 2 | set here [file dirname [file normalize [file join [pwd] [info script]]]] | | | 1 2 3 4 5 6 7 8 9 10 | set here [file dirname [file normalize [file join [pwd] [info script]]]] set version 0.10 set module [file tail $here] set fout [open [file join $here [file tail $module].tcl] w] dict set map %module% $module dict set map %version% $version puts $fout [string map $map {### |
︙ | ︙ |