summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/SaveResult.32
-rw-r--r--doc/exec.n6
-rw-r--r--doc/http.n18
-rw-r--r--library/http/http.tcl142
-rw-r--r--tests/httpPipeline.test2
-rw-r--r--tests/httpTestScript.tcl2
-rw-r--r--tests/winPipe.test4
7 files changed, 63 insertions, 113 deletions
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 51ccb23..e62d22d 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -1,7 +1,7 @@
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
-'\" Copyright (c) 2018 Nathan Coulter.
+'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/doc/exec.n b/doc/exec.n
index d78c34a..99dfdc5 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -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.
diff --git a/doc/http.n b/doc/http.n
index e788022..7e633b3 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -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 e246ad5..5dab3b7 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -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] \
generated by cgit v0.12 at 2024-11-17 03:14:19 (GMT)