diff options
| -rw-r--r-- | doc/exec.n | 6 | ||||
| -rw-r--r-- | doc/http.n | 18 | ||||
| -rw-r--r-- | library/http/http.tcl | 142 | ||||
| -rw-r--r-- | tests/httpPipeline.test | 2 | ||||
| -rw-r--r-- | tests/httpTestScript.tcl | 2 | ||||
| -rw-r--r-- | tests/winPipe.test | 6 | ||||
| -rw-r--r-- | win/tclWinPipe.c | 8 |
7 files changed, 67 insertions, 117 deletions
@@ -224,10 +224,10 @@ Although it is the common escape algorithm, but, in fact, the way how the executable parses the command-line (resp. splits it into single arguments) is decisive. .PP -Unfortunately, there is currently no way to supply newline character within -an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command +Unfortunately, there is currently no way to supply newline character within +an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command processor (\fBcmd.exe /c\fR), because this causes truncation of command-line -(also the argument chain) on the first newline character. +(also the argument chain) on the first newline character. But it works properly with an executable (using CommandLineToArgv, etc). .PP The Tk console text widget does not provide real standard IO capabilities. @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH "http" n 2.8 http "Tcl Bundled Packages" +.TH "http" n 2.9 http "Tcl Bundled Packages" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! @@ -22,6 +22,8 @@ http \- Client-side implementation of the HTTP/1.1 protocol .sp \fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? .sp +\fB::http::quoteString\fR \fIvalue\fR +.sp \fB::http::reset\fR \fItoken\fR ?\fIwhy\fR? .sp \fB::http::wait \fItoken\fR @@ -146,12 +148,13 @@ default is 0. \fB\-urlencoding\fR \fIencoding\fR . The \fIencoding\fR used for creating the x-url-encoded URLs with -\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC +\fB::http::formatQuery\fR and \fB::http::quoteString\fR. +The default is \fButf-8\fR, as specified by RFC 2718. Prior to http 2.5 this was unspecified, and that behavior can be returned by specifying the empty string (\fB{}\fR), although \fIiso8859-1\fR is recommended to restore similar behavior but without the -\fB::http::formatQuery\fR throwing an error processing non-latin-1 -characters. +\fB::http::formatQuery\fR or \fB::http::quoteString\fR +throwing an error processing non-latin-1 characters. .TP \fB\-useragent\fR \fIstring\fR . @@ -375,6 +378,11 @@ encodes the keys and values, and generates one string that has the proper & and = separators. The result is suitable for the \fB\-query\fR value passed to \fB::http::geturl\fR. .TP +\fB::http::quoteString\fR \fIvalue\fR +. +This procedure does x-url-encoding of string. It takes a single argument and +encodes it. +.TP \fB::http::reset\fR \fItoken\fR ?\fIwhy\fR? . This command resets the HTTP transaction identified by \fItoken\fR, if any. @@ -755,7 +763,7 @@ Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::getur .PP Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request that fails because it uses a persistent connection that the server has -half-closed (an +half-closed (an .QW "asynchronous close event" ). Subsequent GET and HEAD requests in a failed pipeline will also be retried. \fIThe -repost option should be used only if the application understands diff --git a/library/http/http.tcl b/library/http/http.tcl index 643a119..f82bced 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -100,7 +100,6 @@ namespace eval http { array set socketWrQueue {} array set socketClosing {} array set socketPlayCmd {} - return } init @@ -128,7 +127,7 @@ namespace eval http { set defaultKeepalive 0 } - namespace export geturl config reset wait formatQuery + namespace export geturl config reset wait formatQuery quoteString namespace export register unregister registerError # - Useful, but not exported: data, size, status, code, cleanup, error, # meta, ncode, mapReply, init. Comments suggest that "init" can be used @@ -161,7 +160,6 @@ if {[info command http::Log] eq {}} {proc http::Log {args} {}} proc http::register {proto port command} { variable urlTypes set urlTypes([string tolower $proto]) [list $port $command] - # N.B. Implicit Return. } # http::unregister -- @@ -219,7 +217,6 @@ proc http::config {args} { } set http($flag) $value } - return } } @@ -293,8 +290,6 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} { } { http::CloseQueuedQueries $connId $token } - - return } # http::KeepSocket - @@ -335,9 +330,6 @@ proc http::KeepSocket {token} { # ONLY for testing reaction to server eof. # No server timeouts will be caught. catch {fileevent $state(sock) readable {}} - } else { - # Normal operation. - # Test constraint normalEof. } if { [info exists state(socketinfo)] @@ -386,7 +378,7 @@ proc http::KeepSocket {token} { # socketWrState has been marked "pending" (in # http::NextPipelinedWrite or http::geturl) so a new pipelined # request cannot jump the queue. - # + # # Tests: # - In this case the read queue (tested above) is empty and this # "pending" write token is in front of the rest of the write @@ -476,8 +468,6 @@ proc http::KeepSocket {token} { } elseif {(!$state(-pipeline))} { set socketWrState($connId) Wready # Rready and Wready and idle: nothing to do. - } else { - # Rready and idle: nothing to do. } } else { @@ -485,7 +475,6 @@ proc http::KeepSocket {token} { # There is no socketMapping($state(socketinfo)), so it does not matter # that CloseQueuedQueries is not called. } - return } # http::CheckEof - @@ -511,7 +500,6 @@ proc http::CheckEof {sock} { # will then be error-handled. CloseSocket $sock } - return } # http::CloseSocket - @@ -539,7 +527,6 @@ proc http::CloseSocket {s {token {}}} { upvar 0 $token state if {[info exists state(socketinfo)]} { set connId $state(socketinfo) - } else { } } else { set map [array get socketMapping] @@ -547,7 +534,6 @@ proc http::CloseSocket {s {token {}}} { if {$ndx != -1} { incr ndx -1 set connId [lindex $map $ndx] - } else { } } if { ($connId ne {}) @@ -557,22 +543,18 @@ proc http::CloseSocket {s {token {}}} { Log "Closing connection $connId (sock $socketMapping($connId))" if {[catch {close $socketMapping($connId)} err]} { Log "Error closing connection: $err" - } else { } if {$token eq {}} { # Cases with a non-empty token are handled by Finish, so the tokens # are finished in connection order. http::CloseQueuedQueries $connId - } else { } } else { Log "Closing socket $s (no connection info)" if {[catch {close $s} err]} { Log "Error closing socket: $err" - } else { } } - return } # http::CloseQueuedQueries @@ -629,7 +611,6 @@ proc http::CloseQueuedQueries {connId {token {}}} { - token $token {*}$unfinished } - return } # http::Unset @@ -655,8 +636,6 @@ proc http::Unset {connId} { unset -nocomplain socketWrQueue($connId) unset -nocomplain socketClosing($connId) unset -nocomplain socketPlayCmd($connId) - - return } # http::reset -- @@ -682,7 +661,6 @@ proc http::reset {token {why reset}} { unset state eval ::error $errorlist } - return } # http::geturl -- @@ -1248,9 +1226,6 @@ proc http::geturl {url args} { #Log re-use nonpipeline, GRANT r/w access to $token in geturl set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token - - } else { - # (!$reusing) } # All (!$reusing) cases come here, and also some $reusing cases if the @@ -1528,17 +1503,12 @@ proc http::Connected {token proto phost srvurl} { registerError $sock {} if {$msg eq {}} { set msg {failed to use socket} - } else { } Finish $token $msg } elseif {$state(status) ne "error"} { Finish $token $err - } else { - # if state(status) is error, it means someone's already called - # Finish to do the above-described clean up. } } - return } # http::registerError @@ -1567,7 +1537,6 @@ proc http::registerError {sock args} { return } set registeredErrors($sock) {*}$args - # N.B. Implicit Return } # http::DoneRequest -- @@ -1645,7 +1614,6 @@ proc http::DoneRequest {token} { # In the nonpipeline case, connection for reading always occurs. ReceiveResponse $token } - return } # http::ReceiveResponse @@ -1666,7 +1634,6 @@ proc http::ReceiveResponse {token} { coroutine ${token}EventCoroutine http::Event $sock $token fileevent $sock readable ${token}EventCoroutine - return } # http::NextPipelinedWrite @@ -1778,12 +1745,7 @@ proc http::NextPipelinedWrite {token} { #Log re-use nonpipeline, GRANT delayed write access to $token in NextP.. set socketWrState($connId) peNding - - } else { - # No requests in socketWrQueue. Nothing to do. } - - return } # http::CancelReadPipeline @@ -1816,7 +1778,6 @@ proc http::CancelReadPipeline {name1 connId op} { } set socketRdQueue($connId) {} } - return } # http::CancelWritePipeline @@ -1850,7 +1811,6 @@ proc http::CancelWritePipeline {name1 connId op} { } set socketWrQueue($connId) {} } - return } # http::ReplayIfDead -- @@ -1907,7 +1867,6 @@ proc http::ReplayIfDead {tokenArg doing} { lappend InFlightR $socketRdState($stateArg(socketinfo)) } elseif {($doing eq "read")} { lappend InFlightR $tokenArg - } else { } if { [info exists socketWrState($stateArg(socketinfo))] @@ -1916,7 +1875,6 @@ proc http::ReplayIfDead {tokenArg doing} { lappend InFlightW $socketWrState($stateArg(socketinfo)) } elseif {($doing eq "write")} { lappend InFlightW $tokenArg - } else { } # Report any inconsistency of $tokenArg with socket*state. @@ -1936,7 +1894,6 @@ proc http::ReplayIfDead {tokenArg doing} { Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \ ne socketWrState($stateArg(socketinfo)) \ $socketWrState($stateArg(socketinfo)) - } else { } } else { # One transaction should be in flight. @@ -1948,7 +1905,6 @@ proc http::ReplayIfDead {tokenArg doing} { Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \ ne socketRdState($stateArg(socketinfo)) \ $socketRdState($stateArg(socketinfo)) - } else { } # Report the inconsistency that socketRdQueue is non-empty. @@ -1958,7 +1914,6 @@ proc http::ReplayIfDead {tokenArg doing} { Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \ has read queue socketRdQueue($stateArg(socketinfo)) \ $socketRdQueue($stateArg(socketinfo)) ne {} - } else { } lappend InFlightW $socketRdState($stateArg(socketinfo)) @@ -1989,7 +1944,6 @@ proc http::ReplayIfDead {tokenArg doing} { # to new values in ReplayCore. ReplayCore $newQueue - return } # http::ReplayIfClose -- @@ -2029,7 +1983,6 @@ proc http::ReplayIfClose {Wstate Rqueue Wqueue} { # 2. Cleanup - none needed, done by the caller. ReplayCore $newQueue - return } # http::ReInit -- @@ -2236,7 +2189,6 @@ proc http::ReplayCore {newQueue} { # Connect does its own fconfigure. fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs] #Log ---- $sock << conn to $token for HTTP request (e) - return } # Data access functions: @@ -2314,7 +2266,6 @@ proc http::cleanup {token} { if {[info exists state]} { unset state } - return } # http::Connect @@ -2358,7 +2309,6 @@ proc http::Connect {token proto phost srvurl} { fileevent $state(sock) writable {} ::http::Connected $token $proto $phost $srvurl } - return } # http::Write @@ -2463,7 +2413,6 @@ proc http::Write {token} { eval $state(-queryprogress) \ [list $token $state(querylength) $state(queryoffset)] } - return } # http::Event @@ -2560,10 +2509,6 @@ proc http::Event {sock token} { # last use. # If any other requests are in flight or pipelined/queued, they # will be discarded. - } else { - ##Log - connecting 2 - token $token - # nsl is -1 so either fblocked (OK) or (eof and not reusing). - # Continue. Any eof is processed at the end of this proc. } } elseif {$state(state) eq "header"} { if {[catch {gets $sock line} nhl]} { @@ -2795,7 +2740,6 @@ proc http::Event {sock token} { set n 0 set state(state) complete } - } else { } } elseif {[info exists state(transfer_final)]} { # This code forgives EOF in place of the final CRLF. @@ -2955,11 +2899,8 @@ proc http::Event {sock token} { } } elseif {$cc} { return - } else { - # Not eof, continue and yield. } } - return } # http::TestForReplay @@ -3148,7 +3089,6 @@ proc http::CopyStart {sock token {initial 1}} { Finish $token $err } } - return } proc http::CopyChunk {token chunk} { @@ -3178,7 +3118,6 @@ proc http::CopyChunk {token chunk} { } Eot $token ;# FIX ME: pipelining. } - return } # http::CopyDone @@ -3209,7 +3148,6 @@ proc http::CopyDone {token count {error {}}} { } else { CopyStart $sock $token 0 } - return } # http::Eot @@ -3279,7 +3217,6 @@ proc http::Eot {token {reason {}}} { } } Finish $token $reason - return } # http::wait -- @@ -3317,6 +3254,12 @@ proc http::wait {token} { # TODO proc http::formatQuery {args} { + if {[llength $args] % 2} { + return \ + -code error \ + -errorcode [list HTTP BADARGCNT $args] \ + {Incorrect number of arguments, must be an even number.} + } set result "" set sep "" foreach i $args { @@ -3361,6 +3304,7 @@ proc http::mapReply {string} { } return $converted } +interp alias {} http::quoteString {} http::mapReply # http::ProxyRequired -- # Default proxy filter. @@ -3382,7 +3326,6 @@ proc http::ProxyRequired {host} { } return [list $http(-proxyhost) $http(-proxyport)] } - return } # http::CharsetToEncoding -- @@ -3436,8 +3379,7 @@ proc http::ContentEncoding {token} { compress - x-compress { lappend r decompress } identity {} default { - set msg "unsupported content-encoding \"$coding\"" - return -code error $msg + return -code error "unsupported content-encoding \"$coding\"" } } } @@ -3445,39 +3387,39 @@ proc http::ContentEncoding {token} { return $r } -proc http::make-transformation-chunked {chan command} { - set lambda {{chan command} { - set data "" - set size -1 - yield - while {1} { - chan configure $chan -translation {crlf binary} - while {[gets $chan line] < 1} { yield } - chan configure $chan -translation {binary binary} - if {[scan $line %x size] != 1} { - return -code error "invalid size: \"$line\"" - } - set chunk "" - while {$size && ![chan eof $chan]} { - set part [chan read $chan $size] - incr size -[string length $part] - append chunk $part - } - if {[catch { - uplevel #0 [linsert $command end $chunk] - }]} { - http::Log "Error in callback: $::errorInfo" - } - if {[string length $chunk] == 0} { - # channel might have been closed in the callback - catch {chan event $chan readable {}} - return - } +proc http::ReceiveChunked {chan command} { + set data "" + set size -1 + yield + while {1} { + chan configure $chan -translation {crlf binary} + while {[gets $chan line] < 1} { yield } + chan configure $chan -translation {binary binary} + if {[scan $line %x size] != 1} { + return -code error "invalid size: \"$line\"" + } + set chunk "" + while {$size && ![chan eof $chan]} { + set part [chan read $chan $size] + incr size -[string length $part] + append chunk $part + } + if {[catch { + uplevel #0 [linsert $command end $chunk] + }]} { + http::Log "Error in callback: $::errorInfo" + } + if {[string length $chunk] == 0} { + # channel might have been closed in the callback + catch {chan event $chan readable {}} + return } - }} - coroutine dechunk$chan ::apply $lambda $chan $command - chan event $chan readable [namespace origin dechunk$chan] - return + } +} + +proc http::make-transformation-chunked {chan command} { + coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command + chan event $chan readable [namespace current]::dechunk$chan } # Local variables: diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test index 5eb02d3..8de79b9 100644 --- a/tests/httpPipeline.test +++ b/tests/httpPipeline.test @@ -532,7 +532,7 @@ proc ReturnTestScriptAndResult {ca cb delay te} { # Proc MakeMessage # ------------------------------------------------------------------------------ # WHD's one-line command to generate multi-line strings from readable code. -# +# # Example: # set blurb [MakeMessage { # |This command allows multi-line strings to be created with readable diff --git a/tests/httpTestScript.tcl b/tests/httpTestScript.tcl index a8ef9c8..a40449a 100644 --- a/tests/httpTestScript.tcl +++ b/tests/httpTestScript.tcl @@ -496,7 +496,7 @@ proc httpTestScript::runHttpTestScript {scr} { proc httpTestScript::cleanupHttpTestScript {} { variable TimeOutDone variable RequestsWhenStopped - + if {![info exists RequestsWhenStopped]} { return -code error {Cleanup Failed: RequestsWhenStopped is undefined} } diff --git a/tests/winPipe.test b/tests/winPipe.test index 9402db1..62cc707 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -41,7 +41,7 @@ append big $big append big $big set path(little) [makeFile {} little] -set f [open $path(little) w] +set f [open $path(little) w] puts -nonewline $f "little" close $f @@ -332,7 +332,7 @@ proc _testExecArgs {single args} { set broken {} foreach args $args { if {$single & 1} { - # enclose single test-arg between 1st/3rd to be sure nothing is truncated + # enclose single test-arg between 1st/3rd to be sure nothing is truncated # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined): set args [list "1st" $args "3rd"] } @@ -569,7 +569,7 @@ set injectList { test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \ -constraints {win exec} -body { - # test exe only, because currently there is no proper way to escape a new-line char resp. + # test exe only, because currently there is no proper way to escape a new-line char resp. # to supply a new-line to the batch-files within arguments (command line is truncated). _testExecArgs 8 \ [list START {*}$injectList END] \ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index dd54a27..826265a 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1495,10 +1495,10 @@ QuoteCmdLinePart( QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); start = *bspos; } - /* - * escape all special chars enclosed in quotes like `"..."`, note that here we + /* + * escape all special chars enclosed in quotes like `"..."`, note that here we * don't must escape `\` (with `\`), because it's outside of the main quotes, - * so `\` remains `\`, but important - not at end of part, because results as + * so `\` remains `\`, but important - not at end of part, because results as * before the quote, so `%\%\` should be escaped as `"%\%"\\`). */ TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */ @@ -1653,7 +1653,7 @@ BuildCommandLine( special++; } /* rest of argument (and escape backslashes before closing main quote) */ - QuoteCmdLineBackslash(&ds, start, special, + QuoteCmdLineBackslash(&ds, start, special, (quote & CL_QUOTE) ? bspos : NULL); } if (quote & CL_QUOTE) { |