summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8')
-rw-r--r--systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.19.tm (renamed from systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.18.tm)13
-rw-r--r--systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.5/tcltest-2.5.5.tm (renamed from systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.5/tcltest-2.5.3.tm)28
-rw-r--r--systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/http-2.9.8.tm (renamed from systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/http-2.9.5.tm)188
-rw-r--r--systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.5.tm (renamed from systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm)2
4 files changed, 179 insertions, 52 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.18.tm b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.19.tm
index 752f069326..acaebf2684 100644
--- a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.18.tm
+++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.19.tm
@@ -364,6 +364,17 @@ proc ::platform::patterns {id} {
foreach {major minor} [split $v .] break
set res {}
+ if {$major eq 13} {
+ # Add 13.0 to 13.minor to patterns.
+ for {set j $minor} {$j >= 0} {incr j -1} {
+ lappend res macosx${major}.${j}-${cpu}
+ foreach a $alt {
+ lappend res macosx${major}.${j}-$a
+ }
+ }
+ set major 12
+ set minor 5
+ }
if {$major eq 12} {
# Add 12.0 to 12.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
@@ -420,7 +431,7 @@ proc ::platform::patterns {id} {
# ### ### ### ######### ######### #########
## Ready
-package provide platform 1.0.18
+package provide platform 1.0.19
# ### ### ### ######### ######### #########
## Demo application
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.5/tcltest-2.5.3.tm b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.5/tcltest-2.5.5.tm
index dedcd7ac16..7344f9f168 100644
--- a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.5/tcltest-2.5.3.tm
+++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.5/tcltest-2.5.5.tm
@@ -10,9 +10,9 @@
# initially implemented by Mary Ann May-Pumphrey of Sun
# Microsystems.
#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 Scriptics Corporation.
-# Copyright (c) 2000 Ajuba Solutions
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 Scriptics Corporation.
+# Copyright © 2000 Ajuba Solutions
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
@@ -22,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
- variable Version 2.5.3
+ variable Version 2.5.5
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -399,6 +399,9 @@ namespace eval tcltest {
}
default {
set outputChannel [open $filename a]
+ if {[package vsatisfies [package provide Tcl] 8.7-]} {
+ fconfigure $outputChannel -encoding utf-8
+ }
set ChannelsWeOpened($outputChannel) 1
# If we created the file in [temporaryDirectory], then
@@ -443,6 +446,9 @@ namespace eval tcltest {
}
default {
set errorChannel [open $filename a]
+ if {[package vsatisfies [package provide Tcl] 8.7-]} {
+ fconfigure $errorChannel -encoding utf-8
+ }
set ChannelsWeOpened($errorChannel) 1
# If we created the file in [temporaryDirectory], then
@@ -785,6 +791,9 @@ namespace eval tcltest {
variable Option
if {$Option(-loadfile) eq {}} {return}
set tmp [open $Option(-loadfile) r]
+ if {[package vsatisfies [package provide Tcl] 8.7-]} {
+ fconfigure $tmp -encoding utf-8
+ }
loadScript [read $tmp]
close $tmp
}
@@ -1330,6 +1339,9 @@ proc tcltest::DefineConstraintInitializers {} {
ConstraintInitializer stdio {
set code 0
if {![catch {set f [open "|[list [interpreter]]" w]}]} {
+ if {[package vsatisfies [package provide Tcl] 8.7-]} {
+ fconfigure $f -encoding utf-8
+ }
if {![catch {puts $f exit}]} {
if {![catch {close $f}]} {
set code 1
@@ -2129,7 +2141,7 @@ proc tcltest::test {name description args} {
if {[IsVerbose msec] || [IsVerbose usec]} {
set t [expr {[clock microseconds] - $timeStart}]
if {[IsVerbose usec]} {
- puts [outputChannel] "++++ $name took $t μs"
+ puts [outputChannel] "++++ $name took $t \xB5s"
}
if {[IsVerbose msec]} {
puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms"
@@ -2177,6 +2189,9 @@ proc tcltest::test {name description args} {
set testFile [file normalize [uplevel 1 {info script}]]
if {[file readable $testFile]} {
set testFd [open $testFile r]
+ if {[package vsatisfies [package provide Tcl] 8.7-]} {
+ fconfigure $testFd -encoding utf-8
+ }
set testLine [expr {[lsearch -regexp \
[split [read $testFd] "\n"] \
"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
@@ -2885,6 +2900,9 @@ proc tcltest::runAllTests { {shell ""} } {
if {[catch {
incr numTestFiles
set pipeFd [open $cmd "r"]
+ if {[package vsatisfies [package provide Tcl] 8.7-]} {
+ fconfigure $pipeFd -encoding utf-8
+ }
while {[gets $pipeFd line] >= 0} {
if {[regexp [join {
{^([^:]+):\t}
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/http-2.9.5.tm b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/http-2.9.8.tm
index b0f87de4ef..5a09bb8b35 100644
--- a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/http-2.9.5.tm
+++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/http-2.9.8.tm
@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.9.5
+package provide http 2.9.8
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -255,11 +255,35 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
if {[info commands ${token}EventCoroutine] ne {}} {
rename ${token}EventCoroutine {}
}
+
+ # Is this an upgrade request/response?
+ set upgradeResponse \
+ [expr { [info exists state(upgradeRequest)] && $state(upgradeRequest)
+ && [info exists state(http)] && [ncode $token] eq {101}
+ && [info exists state(connection)] && "upgrade" in $state(connection)
+ && [info exists state(upgrade)] && "" ne $state(upgrade)}]
+
if { ($state(status) eq "timeout")
|| ($state(status) eq "error")
|| ($state(status) eq "eof")
- || ([info exists state(-keepalive)] && !$state(-keepalive))
- || ([info exists state(connection)] && ($state(connection) eq "close"))
+ } {
+ set closeQueue 1
+ set connId $state(socketinfo)
+ set sock $state(sock)
+ CloseSocket $state(sock) $token
+ } elseif {$upgradeResponse} {
+ # Special handling for an upgrade request/response.
+ # - geturl ensures that this is not a "persistent" socket used for
+ # multiple HTTP requests, so a call to KeepSocket is not needed.
+ # - Leave socket open, so a call to CloseSocket is not needed either.
+ # - Remove fileevent bindings. The caller will set its own bindings.
+ # - THE CALLER MUST PROCESS THE UPGRADED SOCKET IN THE CALLBACK COMMAND
+ # PASSED TO http::geturl AS -command callback.
+ catch {fileevent $state(sock) readable {}}
+ catch {fileevent $state(sock) writable {}}
+ } elseif {
+ ([info exists state(-keepalive)] && !$state(-keepalive))
+ || ([info exists state(connection)] && ("close" in $state(connection)))
} {
set closeQueue 1
set connId $state(socketinfo)
@@ -267,7 +291,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
CloseSocket $state(sock) $token
} elseif {
([info exists state(-keepalive)] && $state(-keepalive))
- && ([info exists state(connection)] && ($state(connection) ne "close"))
+ && ([info exists state(connection)] && ("close" ni $state(connection)))
} {
KeepSocket $token
}
@@ -298,7 +322,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
# queued task if possible. Otherwise leave it idle and ready for its next
# use.
#
-# If $socketClosing(*), then ($state(connection) eq "close") and therefore
+# If $socketClosing(*), then ("close" in $state(connection)) and therefore
# this command will not be called by Finish.
#
# Arguments:
@@ -447,7 +471,7 @@ proc http::KeepSocket {token} {
(!$state(-pipeline))
&& [info exists socketWrQueue($connId)]
&& [llength $socketWrQueue($connId)]
- && ($state(connection) ne "close")
+ && ("close" ni $state(connection))
} {
# If not pipelined, (socketRdState eq Rready) tells us that we are
# ready for the next write - there is no need to check
@@ -733,7 +757,7 @@ proc http::geturl {url args} {
-strict boolean
-timeout integer
-validate boolean
- -headers dict
+ -headers list
}
set state(charset) $defaultCharset
set options {
@@ -747,13 +771,18 @@ proc http::geturl {url args} {
foreach {flag value} $args {
if {[regexp -- $pat $flag]} {
# Validate numbers
- if {($flag eq "-headers") ? [catch {dict size $value}] :
- ([info exists type($flag)] && ![string is $type($flag) -strict $value])
+ if { [info exists type($flag)]
+ && (![string is $type($flag) -strict $value])
} {
unset $token
return -code error \
"Bad value for $flag ($value), must be $type($flag)"
}
+ if {($flag eq "-headers") && ([llength $value] % 2 != 0)} {
+ unset $token
+ return -code error \
+ "Bad value for $flag ($value), number of list elements must be even"
+ }
set state($flag) $value
} else {
unset $token
@@ -892,8 +921,12 @@ proc http::geturl {url args} {
}
return -code error "Illegal characters in URL path"
}
+ if {![regexp {^[^?#]+} $srvurl state(path)]} {
+ set state(path) /
+ }
} else {
set srvurl /
+ set state(path) /
}
if {$proto eq ""} {
set proto http
@@ -946,6 +979,15 @@ proc http::geturl {url args} {
# c11a51c482]
set state(accept-types) $http(-accept)
+ # Check whether this is an Upgrade request.
+ set connectionValues [SplitCommaSeparatedFieldValue \
+ [GetFieldValue $state(-headers) Connection]]
+ set connectionValues [string tolower $connectionValues]
+ set upgradeValues [SplitCommaSeparatedFieldValue \
+ [GetFieldValue $state(-headers) Upgrade]]
+ set state(upgradeRequest) [expr { "upgrade" in $connectionValues
+ && [llength $upgradeValues] >= 1}]
+
if {$isQuery || $isQueryChannel} {
# It's a POST.
# A client wishing to send a non-idempotent request SHOULD wait to send
@@ -961,8 +1003,13 @@ proc http::geturl {url args} {
# There is a small risk of a race against server timeout.
set state(-pipeline) 0
}
+ } elseif {$state(upgradeRequest)} {
+ # It's an upgrade request. Method must be GET (untested).
+ # Force -keepalive to 0 so the connection is not made over a persistent
+ # socket, i.e. one used for multiple HTTP requests.
+ set state(-keepalive) 0
} else {
- # It's a GET or HEAD.
+ # It's a non-upgrade GET or HEAD.
set state(-pipeline) $http(-pipeline)
}
@@ -1310,8 +1357,7 @@ proc http::Connected {token proto phost srvurl} {
set sock $state(sock)
set isQueryChannel [info exists state(-querychannel)]
set isQuery [info exists state(-query)]
- set host [lindex [split $state(socketinfo) :] 0]
- set port [lindex [split $state(socketinfo) :] 1]
+ regexp {^(.+):([^:]+)$} $state(socketinfo) {} host port
set lower [string tolower $proto]
set defport [lindex $urlTypes($lower) 0]
@@ -1357,14 +1403,18 @@ proc http::Connected {token proto phost srvurl} {
if {[catch {
set state(method) $how
puts $sock "$how $srvurl HTTP/$state(-protocol)"
- if {[dict exists $state(-headers) Host]} {
+ set hostValue [GetFieldValue $state(-headers) Host]
+ if {$hostValue ne {}} {
# Allow Host spoofing. [Bug 928154]
- puts $sock "Host: [dict get $state(-headers) Host]"
+ regexp {^[^:]+} $hostValue state(host)
+ puts $sock "Host: $hostValue"
} elseif {$port == $defport} {
# Don't add port in this case, to handle broken servers. [Bug
# #504508]
+ set state(host) $host
puts $sock "Host: $host"
} else {
+ set state(host) $host
puts $sock "Host: $host:$port"
}
puts $sock "User-Agent: $http(-useragent)"
@@ -1389,7 +1439,7 @@ proc http::Connected {token proto phost srvurl} {
# Proxy-Connection header field in any requests"
set accept_encoding_seen 0
set content_type_seen 0
- dict for {key value} $state(-headers) {
+ foreach {key value} $state(-headers) {
set value [string map [list \n "" \r ""] $value]
set key [string map {" " -} [string trim $key]]
if {[string equal -nocase $key "host"]} {
@@ -2586,7 +2636,7 @@ proc http::Event {sock token} {
if { ([info exists state(connection)])
&& ([info exists socketMapping($state(socketinfo))])
- && ($state(connection) eq "keep-alive")
+ && ("keep-alive" in $state(connection))
&& ($state(-keepalive))
&& (!$state(reusing))
&& ($state(-pipeline))
@@ -2608,7 +2658,7 @@ proc http::Event {sock token} {
if { ([info exists state(connection)])
&& ([info exists socketMapping($state(socketinfo))])
- && ($state(connection) eq "close")
+ && ("close" in $state(connection))
&& ($state(-keepalive))
} {
# The server warns that it will close the socket after this
@@ -2656,6 +2706,19 @@ proc http::Event {sock token} {
set state(state) body
+ # According to
+ # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
+ # any comma-separated "Connection:" list implies keep-alive, but I
+ # don't see this in the RFC so we'll play safe and
+ # scan any list for "close".
+ # Done here to support combining duplicate header field's values.
+ if { [info exists state(connection)]
+ && ("close" ni $state(connection))
+ && ("keep-alive" ni $state(connection))
+ } {
+ lappend state(connection) "keep-alive"
+ }
+
# If doing a HEAD, then we won't get any body
if {$state(-validate)} {
Log ^F$tk end of response for HEAD request - token $token
@@ -2679,7 +2742,7 @@ proc http::Event {sock token} {
# (totalsize == 0).
if { (!( [info exists state(connection)]
- && ($state(connection) eq "close")
+ && ("close" in $state(connection))
)
)
&& (![info exists state(transfer)])
@@ -2745,32 +2808,14 @@ proc http::Event {sock token} {
}
proxy-connection -
connection {
- set tmpHeader [string trim [string tolower $value]]
# RFC 7230 Section 6.1 states that a comma-separated
- # list is an acceptable value. According to
- # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
- # any comma-separated list implies keep-alive, but I
- # don't see this in the RFC so we'll play safe and
- # scan any list for "close".
- if {$tmpHeader in {close keep-alive}} {
- # The common cases, continue.
- } elseif {[string first , $tmpHeader] < 0} {
- # Not a comma-separated list, not "close",
- # therefore "keep-alive".
- set tmpHeader keep-alive
- } else {
- set tmpResult keep-alive
- set tmpCsl [split $tmpHeader ,]
- # Optional whitespace either side of separator.
- foreach el $tmpCsl {
- if {[string trim $el] eq {close}} {
- set tmpResult close
- break
- }
- }
- set tmpHeader $tmpResult
+ # list is an acceptable value.
+ foreach el [SplitCommaSeparatedFieldValue $value] {
+ lappend state(connection) [string tolower $el]
}
- set state(connection) $tmpHeader
+ }
+ upgrade {
+ set state(upgrade) [string trim $value]
}
}
lappend state(meta) $key [string trim $value]
@@ -3125,7 +3170,7 @@ proc http::BlockingGets {sock} {
while 1 {
set count [gets $sock line]
set eof [eof $sock]
- if {$count > -1 || $eof} {
+ if {$count >= 0 || $eof} {
return $line
} else {
yield
@@ -3421,7 +3466,7 @@ proc http::CharsetToEncoding {charset} {
set encoding "iso8859-$num"
} elseif {[regexp {iso-?2022-(jp|kr)} $charset -> ext]} {
set encoding "iso2022-$ext"
- } elseif {[regexp {shift[-_]?js} $charset]} {
+ } elseif {[regexp {shift[-_]?jis} $charset]} {
set encoding "shiftjis"
} elseif {[regexp {(?:windows|cp)-?([0-9]+)} $charset -> num]} {
set encoding "cp$num"
@@ -3433,6 +3478,9 @@ proc http::CharsetToEncoding {charset} {
1 - 2 - 3 {
set encoding "iso8859-$num"
}
+ default {
+ set encoding "binary"
+ }
}
} else {
# other charset, like euc-xx, utf-8,... may directly map to encoding
@@ -3457,8 +3505,12 @@ proc http::ContentEncoding {token} {
gzip - x-gzip { lappend r gunzip }
compress - x-compress { lappend r decompress }
identity {}
+ br {
+ return -code error\
+ "content-encoding \"br\" not implemented"
+ }
default {
- return -code error "unsupported content-encoding \"$coding\""
+ Log "unknown content-encoding \"$coding\" ignored"
}
}
}
@@ -3496,6 +3548,52 @@ proc http::ReceiveChunked {chan command} {
}
}
+# http::SplitCommaSeparatedFieldValue --
+# Return the individual values of a comma-separated field value.
+#
+# Arguments:
+# fieldValue Comma-separated header field value.
+#
+# Results:
+# List of values.
+proc http::SplitCommaSeparatedFieldValue {fieldValue} {
+ set r {}
+ foreach el [split $fieldValue ,] {
+ lappend r [string trim $el]
+ }
+ return $r
+}
+
+
+# http::GetFieldValue --
+# Return the value of a header field.
+#
+# Arguments:
+# headers Headers key-value list
+# fieldName Name of header field whose value to return.
+#
+# Results:
+# The value of the fieldName header field
+#
+# Field names are matched case-insensitively (RFC 7230 Section 3.2).
+#
+# If the field is present multiple times, it is assumed that the field is
+# defined as a comma-separated list and the values are combined (by separating
+# them with commas, see RFC 7230 Section 3.2.2) and returned at once.
+proc http::GetFieldValue {headers fieldName} {
+ set r {}
+ foreach {field value} $headers {
+ if {[string equal -nocase $fieldName $field]} {
+ if {$r eq {}} {
+ set r $value
+ } else {
+ append r ", $value"
+ }
+ }
+ }
+ return $r
+}
+
proc http::make-transformation-chunked {chan command} {
coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
chan event $chan readable [namespace current]::dechunk$chan
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.5.tm
index 1794f07409..334dbcd74e 100644
--- a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm
+++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.5.tm
@@ -13,7 +13,7 @@
package require tdbc
package require sqlite3
-package provide tdbc::sqlite3 1.1.3
+package provide tdbc::sqlite3 1.1.5
namespace eval tdbc::sqlite3 {
namespace export connection