Tcl Source Code

Changes On Branch tip-493
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-493 Excluding Merge-Ins

This is equivalent to a diff from a9598976f4 to 313ece0560

2018-02-06
19:55
TIP 493: Cease Distribution of http 1.0 check-in: a1a80c75c0 user: dgp tags: core-8-branch
2018-01-04
12:58
(cherry-pick): Use http 2 instead of http 1 for Safe Base testing. check-in: be96f22ee4 user: jan.nijtmans tags: core-8-5-branch
02:32
Minimal fixes to stop the [package files] machinery writing to freed mem. This contribution needs a ... check-in: e2d0c521d8 user: dgp tags: core-8-branch
2018-01-03
15:11
merge 8.7 check-in: b2b20de662 user: dgp tags: pyk-TclOO
2018-01-02
22:03
Add -stride to lsearch. TIP#351 check-in: 95150a1466 user: pspjuth tags: tip-351
2017-12-29
17:47
Use http 2 instead of http 1 for Safe Base testing. Closed-Leaf check-in: 313ece0560 user: dgp tags: tip-493
17:38
Remove http 1.0 tests. check-in: 235847a1a8 user: dgp tags: tip-493
16:49
Remove handling of http 1.0 package files from Makefiles. check-in: c9233c5f0d user: dgp tags: tip-493
16:16
merge 8.7 check-in: 20d3928f5c user: dgp tags: tip-445
15:13
Pulling changes from core-8-branch check-in: cf43d89150 user: hypnotoad tags: core_zip_vfs
2017-12-28
23:54
Optimise lrange for unshared object. check-in: 30abcdf459 user: pspjuth tags: pspjuth-lrangeopt
21:17
merge core-8-branch check-in: 92e15a4e78 user: jan.nijtmans tags: tip-389
21:15
merge core-8-6-branch check-in: a9598976f4 user: jan.nijtmans tags: core-8-branch
21:14
Fix bug introduced in [0dd0d14489258621] (only for TCL_UTF_MAX > 3): If len parameter = -1, returned... check-in: b4b65e69b8 user: jan.nijtmans tags: core-8-6-branch
18:51
merge core-8-6-branch check-in: e7cb6182f1 user: jan.nijtmans tags: core-8-branch

Deleted library/http1.0/http.tcl.

     1         -# http.tcl
     2         -# Client-side HTTP for GET, POST, and HEAD commands.
     3         -# These routines can be used in untrusted code that uses the Safesock
     4         -# security policy.
     5         -# These procedures use a callback interface to avoid using vwait,
     6         -# which is not defined in the safe base.
     7         -#
     8         -# See the http.n man page for documentation
     9         -
    10         -package provide http 1.0
    11         -
    12         -array set http {
    13         -    -accept */*
    14         -    -proxyhost {}
    15         -    -proxyport {}
    16         -    -useragent {Tcl http client package 1.0}
    17         -    -proxyfilter httpProxyRequired
    18         -}
    19         -proc http_config {args} {
    20         -    global http
    21         -    set options [lsort [array names http -*]]
    22         -    set usage [join $options ", "]
    23         -    if {[llength $args] == 0} {
    24         -	set result {}
    25         -	foreach name $options {
    26         -	    lappend result $name $http($name)
    27         -	}
    28         -	return $result
    29         -    }
    30         -    regsub -all -- - $options {} options
    31         -    set pat ^-([join $options |])$
    32         -    if {[llength $args] == 1} {
    33         -	set flag [lindex $args 0]
    34         -	if {[regexp -- $pat $flag]} {
    35         -	    return $http($flag)
    36         -	} else {
    37         -	    return -code error "Unknown option $flag, must be: $usage"
    38         -	}
    39         -    } else {
    40         -	foreach {flag value} $args {
    41         -	    if {[regexp -- $pat $flag]} {
    42         -		set http($flag) $value
    43         -	    } else {
    44         -		return -code error "Unknown option $flag, must be: $usage"
    45         -	    }
    46         -	}
    47         -    }
    48         -}
    49         -
    50         - proc httpFinish { token {errormsg ""} } {
    51         -    upvar #0 $token state
    52         -    global errorInfo errorCode
    53         -    if {[string length $errormsg] != 0} {
    54         -	set state(error) [list $errormsg $errorInfo $errorCode]
    55         -	set state(status) error
    56         -    }
    57         -    catch {close $state(sock)}
    58         -    catch {after cancel $state(after)}
    59         -    if {[info exists state(-command)]} {
    60         -	if {[catch {eval $state(-command) {$token}} err]} {
    61         -	    if {[string length $errormsg] == 0} {
    62         -		set state(error) [list $err $errorInfo $errorCode]
    63         -		set state(status) error
    64         -	    }
    65         -	}
    66         -	unset state(-command)
    67         -    }
    68         -}
    69         -proc http_reset { token {why reset} } {
    70         -    upvar #0 $token state
    71         -    set state(status) $why
    72         -    catch {fileevent $state(sock) readable {}}
    73         -    httpFinish $token
    74         -    if {[info exists state(error)]} {
    75         -	set errorlist $state(error)
    76         -	unset state(error)
    77         -	eval error $errorlist
    78         -    }
    79         -}
    80         -proc http_get { url args } {
    81         -    global http
    82         -    if {![info exists http(uid)]} {
    83         -	set http(uid) 0
    84         -    }
    85         -    set token http#[incr http(uid)]
    86         -    upvar #0 $token state
    87         -    http_reset $token
    88         -    array set state {
    89         -	-blocksize 	8192
    90         -	-validate 	0
    91         -	-headers 	{}
    92         -	-timeout 	0
    93         -	state		header
    94         -	meta		{}
    95         -	currentsize	0
    96         -	totalsize	0
    97         -        type            text/html
    98         -        body            {}
    99         -	status		""
   100         -    }
   101         -    set options {-blocksize -channel -command -handler -headers \
   102         -		-progress -query -validate -timeout}
   103         -    set usage [join $options ", "]
   104         -    regsub -all -- - $options {} options
   105         -    set pat ^-([join $options |])$
   106         -    foreach {flag value} $args {
   107         -	if {[regexp $pat $flag]} {
   108         -	    # Validate numbers
   109         -	    if {[info exists state($flag)] && \
   110         -		    [regexp {^[0-9]+$} $state($flag)] && \
   111         -		    ![regexp {^[0-9]+$} $value]} {
   112         -		return -code error "Bad value for $flag ($value), must be integer"
   113         -	    }
   114         -	    set state($flag) $value
   115         -	} else {
   116         -	    return -code error "Unknown option $flag, can be: $usage"
   117         -	}
   118         -    }
   119         -    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
   120         -	    x proto host y port srvurl]} {
   121         -	error "Unsupported URL: $url"
   122         -    }
   123         -    if {[string length $port] == 0} {
   124         -	set port 80
   125         -    }
   126         -    if {[string length $srvurl] == 0} {
   127         -	set srvurl /
   128         -    }
   129         -    if {[string length $proto] == 0} {
   130         -	set url http://$url
   131         -    }
   132         -    set state(url) $url
   133         -    if {![catch {$http(-proxyfilter) $host} proxy]} {
   134         -	set phost [lindex $proxy 0]
   135         -	set pport [lindex $proxy 1]
   136         -    }
   137         -    if {$state(-timeout) > 0} {
   138         -	set state(after) [after $state(-timeout) [list http_reset $token timeout]]
   139         -    }
   140         -    if {[info exists phost] && [string length $phost]} {
   141         -	set srvurl $url
   142         -	set s [socket $phost $pport]
   143         -    } else {
   144         -	set s [socket $host $port]
   145         -    }
   146         -    set state(sock) $s
   147         -
   148         -    # Send data in cr-lf format, but accept any line terminators
   149         -
   150         -    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
   151         -
   152         -    # The following is disallowed in safe interpreters, but the socket
   153         -    # is already in non-blocking mode in that case.
   154         -
   155         -    catch {fconfigure $s -blocking off}
   156         -    set len 0
   157         -    set how GET
   158         -    if {[info exists state(-query)]} {
   159         -	set len [string length $state(-query)]
   160         -	if {$len > 0} {
   161         -	    set how POST
   162         -	}
   163         -    } elseif {$state(-validate)} {
   164         -	set how HEAD
   165         -    }
   166         -    puts $s "$how $srvurl HTTP/1.0"
   167         -    puts $s "Accept: $http(-accept)"
   168         -    puts $s "Host: $host"
   169         -    puts $s "User-Agent: $http(-useragent)"
   170         -    foreach {key value} $state(-headers) {
   171         -	regsub -all \[\n\r\]  $value {} value
   172         -	set key [string trim $key]
   173         -	if {[string length $key]} {
   174         -	    puts $s "$key: $value"
   175         -	}
   176         -    }
   177         -    if {$len > 0} {
   178         -	puts $s "Content-Length: $len"
   179         -	puts $s "Content-Type: application/x-www-form-urlencoded"
   180         -	puts $s ""
   181         -	fconfigure $s -translation {auto binary}
   182         -	puts -nonewline $s $state(-query)
   183         -    } else {
   184         -	puts $s ""
   185         -    }
   186         -    flush $s
   187         -    fileevent $s readable [list httpEvent $token]
   188         -    if {! [info exists state(-command)]} {
   189         -	http_wait $token
   190         -    }
   191         -    return $token
   192         -}
   193         -proc http_data {token} {
   194         -    upvar #0 $token state
   195         -    return $state(body)
   196         -}
   197         -proc http_status {token} {
   198         -    upvar #0 $token state
   199         -    return $state(status)
   200         -}
   201         -proc http_code {token} {
   202         -    upvar #0 $token state
   203         -    return $state(http)
   204         -}
   205         -proc http_size {token} {
   206         -    upvar #0 $token state
   207         -    return $state(currentsize)
   208         -}
   209         -
   210         - proc httpEvent {token} {
   211         -    upvar #0 $token state
   212         -    set s $state(sock)
   213         -
   214         -     if {[eof $s]} {
   215         -	httpEof $token
   216         -	return
   217         -    }
   218         -    if {$state(state) == "header"} {
   219         -	set n [gets $s line]
   220         -	if {$n == 0} {
   221         -	    set state(state) body
   222         -	    if {![regexp -nocase ^text $state(type)]} {
   223         -		# Turn off conversions for non-text data
   224         -		fconfigure $s -translation binary
   225         -		if {[info exists state(-channel)]} {
   226         -		    fconfigure $state(-channel) -translation binary
   227         -		}
   228         -	    }
   229         -	    if {[info exists state(-channel)] &&
   230         -		    ![info exists state(-handler)]} {
   231         -		# Initiate a sequence of background fcopies
   232         -		fileevent $s readable {}
   233         -		httpCopyStart $s $token
   234         -	    }
   235         -	} elseif {$n > 0} {
   236         -	    if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
   237         -		set state(type) [string trim $type]
   238         -	    }
   239         -	    if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
   240         -		set state(totalsize) [string trim $length]
   241         -	    }
   242         -	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
   243         -		lappend state(meta) $key $value
   244         -	    } elseif {[regexp ^HTTP $line]} {
   245         -		set state(http) $line
   246         -	    }
   247         -	}
   248         -    } else {
   249         -	if {[catch {
   250         -	    if {[info exists state(-handler)]} {
   251         -		set n [eval $state(-handler) {$s $token}]
   252         -	    } else {
   253         -		set block [read $s $state(-blocksize)]
   254         -		set n [string length $block]
   255         -		if {$n >= 0} {
   256         -		    append state(body) $block
   257         -		}
   258         -	    }
   259         -	    if {$n >= 0} {
   260         -		incr state(currentsize) $n
   261         -	    }
   262         -	} err]} {
   263         -	    httpFinish $token $err
   264         -	} else {
   265         -	    if {[info exists state(-progress)]} {
   266         -		eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
   267         -	    }
   268         -	}
   269         -    }
   270         -}
   271         - proc httpCopyStart {s token} {
   272         -    upvar #0 $token state
   273         -    if {[catch {
   274         -	fcopy $s $state(-channel) -size $state(-blocksize) -command \
   275         -	    [list httpCopyDone $token]
   276         -    } err]} {
   277         -	httpFinish $token $err
   278         -    }
   279         -}
   280         - proc httpCopyDone {token count {error {}}} {
   281         -    upvar #0 $token state
   282         -    set s $state(sock)
   283         -    incr state(currentsize) $count
   284         -    if {[info exists state(-progress)]} {
   285         -	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
   286         -    }
   287         -    if {([string length $error] != 0)} {
   288         -	httpFinish $token $error
   289         -    } elseif {[eof $s]} {
   290         -	httpEof $token
   291         -    } else {
   292         -	httpCopyStart $s $token
   293         -    }
   294         -}
   295         - proc httpEof {token} {
   296         -    upvar #0 $token state
   297         -    if {$state(state) == "header"} {
   298         -	# Premature eof
   299         -	set state(status) eof
   300         -    } else {
   301         -	set state(status) ok
   302         -    }
   303         -    set state(state) eof
   304         -    httpFinish $token
   305         -}
   306         -proc http_wait {token} {
   307         -    upvar #0 $token state
   308         -    if {![info exists state(status)] || [string length $state(status)] == 0} {
   309         -	vwait $token\(status)
   310         -    }
   311         -    if {[info exists state(error)]} {
   312         -	set errorlist $state(error)
   313         -	unset state(error)
   314         -	eval error $errorlist
   315         -    }
   316         -    return $state(status)
   317         -}
   318         -
   319         -# Call http_formatQuery with an even number of arguments, where the first is
   320         -# a name, the second is a value, the third is another name, and so on.
   321         -
   322         -proc http_formatQuery {args} {
   323         -    set result ""
   324         -    set sep ""
   325         -    foreach i $args {
   326         -	append result  $sep [httpMapReply $i]
   327         -	if {$sep != "="} {
   328         -	    set sep =
   329         -	} else {
   330         -	    set sep &
   331         -	}
   332         -    }
   333         -    return $result
   334         -}
   335         -
   336         -# do x-www-urlencoded character mapping
   337         -# The spec says: "non-alphanumeric characters are replaced by '%HH'"
   338         -# 1 leave alphanumerics characters alone
   339         -# 2 Convert every other character to an array lookup
   340         -# 3 Escape constructs that are "special" to the tcl parser
   341         -# 4 "subst" the result, doing all the array substitutions
   342         -
   343         - proc httpMapReply {string} {
   344         -    global httpFormMap
   345         -    set alphanumeric	a-zA-Z0-9
   346         -    if {![info exists httpFormMap]} {
   347         -
   348         -	for {set i 1} {$i <= 256} {incr i} {
   349         -	    set c [format %c $i]
   350         -	    if {![string match \[$alphanumeric\] $c]} {
   351         -		set httpFormMap($c) %[format %.2x $i]
   352         -	    }
   353         -	}
   354         -	# These are handled specially
   355         -	array set httpFormMap {
   356         -	    " " +   \n %0d%0a
   357         -	}
   358         -    }
   359         -    regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string
   360         -    regsub -all \n $string {\\n} string
   361         -    regsub -all \t $string {\\t} string
   362         -    regsub -all {[][{})\\]\)} $string {\\&} string
   363         -    return [subst $string]
   364         -}
   365         -
   366         -# Default proxy filter.
   367         - proc httpProxyRequired {host} {
   368         -    global http
   369         -    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
   370         -	if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {
   371         -	    set http(-proxyport) 8080
   372         -	}
   373         -	return [list $http(-proxyhost) $http(-proxyport)]
   374         -    } else {
   375         -	return {}
   376         -    }
   377         -}

Deleted library/http1.0/pkgIndex.tcl.

     1         -# Tcl package index file, version 1.0
     2         -# This file is generated by the "pkg_mkIndex" command
     3         -# and sourced either when an application starts up or
     4         -# by a "package unknown" script.  It invokes the
     5         -# "package ifneeded" command to set up package-related
     6         -# information so that packages will be loaded automatically
     7         -# in response to "package require" commands.  When this
     8         -# script is sourced, the variable $dir must contain the
     9         -# full path name of this file's directory.
    10         -
    11         -package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}]

Deleted tests/httpold.test.

     1         -# -*- tcl -*-
     2         -# Commands covered:  http_config, http_get, http_wait, http_reset
     3         -#
     4         -# This file contains a collection of tests for the http script library.
     5         -# Sourcing this file into Tcl runs the tests and
     6         -# generates output for errors.  No output means no errors were found.
     7         -#
     8         -# Copyright (c) 1991-1993 The Regents of the University of California.
     9         -# Copyright (c) 1994-1996 Sun Microsystems, Inc.
    10         -# Copyright (c) 1998-1999 by Scriptics Corporation.
    11         -#
    12         -# See the file "license.terms" for information on usage and redistribution
    13         -# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14         -
    15         -if {[lsearch [namespace children] ::tcltest] == -1} {
    16         -    package require tcltest
    17         -    namespace import -force ::tcltest::*
    18         -}
    19         -
    20         -if {[catch {package require http 1.0}]} {
    21         -    if {[info exists httpold]} {
    22         -	catch {puts "Cannot load http 1.0 package"}
    23         -	::tcltest::cleanupTests
    24         -	return
    25         -    } else {
    26         -	catch {puts "Running http 1.0 tests in slave interp"}
    27         -	set interp [interp create httpold]
    28         -	$interp eval [list set httpold "running"]
    29         -	$interp eval [list set argv $argv]
    30         -	$interp eval [list source [info script]]
    31         -	interp delete $interp
    32         -	::tcltest::cleanupTests
    33         -	return
    34         -    }
    35         -}
    36         -
    37         -if {$::tcl_platform(os) eq "Darwin"} {
    38         -    # Name resolution often a problem on OSX; not focus of HTTP package anyway
    39         -    set HOST localhost
    40         -} else {
    41         -    set HOST [info hostname]
    42         -}
    43         -
    44         -set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
    45         -catch {unset data}
    46         -
    47         -##
    48         -## The httpd script implement a stub http server
    49         -##
    50         -source [file join [file dirname [info script]] httpd]
    51         -
    52         -if [catch {httpd_init 0} listen] {
    53         -    puts "Cannot start http server, http test skipped"
    54         -    catch {unset port}
    55         -    ::tcltest::cleanupTests
    56         -    return
    57         -}
    58         -
    59         -test httpold-1.1 {http_config} {
    60         -    http_config
    61         -} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
    62         -
    63         -test httpold-1.2 {http_config} {
    64         -    http_config -proxyfilter
    65         -} httpProxyRequired
    66         -
    67         -test httpold-1.3 {http_config} {
    68         -    catch {http_config -junk}
    69         -} 1
    70         -
    71         -test httpold-1.4 {http_config} {
    72         -    http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
    73         -    set x [http_config]
    74         -    http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
    75         -	-useragent "Tcl http client package 1.0"
    76         -    set x
    77         -} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
    78         -
    79         -test httpold-1.5 {http_config} {
    80         -    catch {http_config -proxyhost {} -junk 8080}
    81         -} 1
    82         -
    83         -test httpold-2.1 {http_reset} {
    84         -    catch {http_reset http#1}
    85         -} 0
    86         -
    87         -test httpold-3.1 {http_get} {
    88         -    catch {http_get -bogus flag}
    89         -} 1
    90         -test httpold-3.2 {http_get} {
    91         -    catch {http_get http:junk} err
    92         -    set err
    93         -} {Unsupported URL: http:junk}
    94         -
    95         -set url ${::HOST}:$port
    96         -test httpold-3.3 {http_get} {
    97         -    set token [http_get $url]
    98         -    http_data $token
    99         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   100         -<h1>Hello, World!</h1>
   101         -<h2>GET /</h2>
   102         -</body></html>"
   103         -
   104         -set tail /a/b/c
   105         -set url ${::HOST}:$port/a/b/c
   106         -set binurl ${::HOST}:$port/binary
   107         -
   108         -test httpold-3.4 {http_get} {
   109         -    set token [http_get $url]
   110         -    http_data $token
   111         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   112         -<h1>Hello, World!</h1>
   113         -<h2>GET $tail</h2>
   114         -</body></html>"
   115         -
   116         -proc selfproxy {host} {
   117         -    global port
   118         -    return [list ${::HOST} $port]
   119         -}
   120         -test httpold-3.5 {http_get} {
   121         -    http_config -proxyfilter selfproxy
   122         -    set token [http_get $url]
   123         -    http_config -proxyfilter httpProxyRequired
   124         -    http_data $token
   125         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   126         -<h1>Hello, World!</h1>
   127         -<h2>GET http://$url</h2>
   128         -</body></html>"
   129         -
   130         -test httpold-3.6 {http_get} {
   131         -    http_config -proxyfilter bogus
   132         -    set token [http_get $url]
   133         -    http_config -proxyfilter httpProxyRequired
   134         -    http_data $token
   135         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   136         -<h1>Hello, World!</h1>
   137         -<h2>GET $tail</h2>
   138         -</body></html>"
   139         -
   140         -test httpold-3.7 {http_get} {
   141         -    set token [http_get $url -headers {Pragma no-cache}]
   142         -    http_data $token
   143         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   144         -<h1>Hello, World!</h1>
   145         -<h2>GET $tail</h2>
   146         -</body></html>"
   147         -
   148         -test httpold-3.8 {http_get} {
   149         -    set token [http_get $url -query Name=Value&Foo=Bar]
   150         -    http_data $token
   151         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   152         -<h1>Hello, World!</h1>
   153         -<h2>POST $tail</h2>
   154         -<h2>Query</h2>
   155         -<dl>
   156         -<dt>Name<dd>Value
   157         -<dt>Foo<dd>Bar
   158         -</dl>
   159         -</body></html>"
   160         -
   161         -test httpold-3.9 {http_get} {
   162         -    set token [http_get $url -validate 1]
   163         -    http_code $token
   164         -} "HTTP/1.0 200 OK"
   165         -
   166         -
   167         -test httpold-4.1 {httpEvent} {
   168         -    set token [http_get $url]
   169         -    upvar #0 $token data
   170         -    array set meta $data(meta)
   171         -    expr ($data(totalsize) == $meta(Content-Length))
   172         -} 1
   173         -
   174         -test httpold-4.2 {httpEvent} {
   175         -    set token [http_get $url]
   176         -    upvar #0 $token data
   177         -    array set meta $data(meta)
   178         -    string compare $data(type) [string trim $meta(Content-Type)]
   179         -} 0
   180         -
   181         -test httpold-4.3 {httpEvent} {
   182         -    set token [http_get $url]
   183         -    http_code $token
   184         -} {HTTP/1.0 200 Data follows}
   185         -
   186         -test httpold-4.4 {httpEvent} {
   187         -    set testfile [makeFile "" testfile]
   188         -    set out [open $testfile w]
   189         -    set token [http_get $url -channel $out]
   190         -    close $out
   191         -    set in [open $testfile]
   192         -    set x [read $in]
   193         -    close $in
   194         -    removeFile $testfile
   195         -    set x
   196         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   197         -<h1>Hello, World!</h1>
   198         -<h2>GET $tail</h2>
   199         -</body></html>"
   200         -
   201         -test httpold-4.5 {httpEvent} {
   202         -    set testfile [makeFile "" testfile]
   203         -    set out [open $testfile w]
   204         -    set token [http_get $url -channel $out]
   205         -    close $out
   206         -    upvar #0 $token data
   207         -    removeFile $testfile
   208         -    expr $data(currentsize) == $data(totalsize)
   209         -} 1
   210         -
   211         -test httpold-4.6 {httpEvent} {
   212         -    set testfile [makeFile "" testfile]
   213         -    set out [open $testfile w]
   214         -    set token [http_get $binurl -channel $out]
   215         -    close $out
   216         -    set in [open $testfile]
   217         -    fconfigure $in -translation binary
   218         -    set x [read $in]
   219         -    close $in
   220         -    removeFile $testfile
   221         -    set x
   222         -} "$bindata$binurl"
   223         -
   224         -proc myProgress {token total current} {
   225         -    global progress httpLog
   226         -    if {[info exists httpLog] && $httpLog} {
   227         -	puts "progress $total $current"
   228         -    }
   229         -    set progress [list $total $current]
   230         -}
   231         -if 0 {
   232         -    # This test hangs on Windows95 because the client never gets EOF
   233         -    set httpLog 1
   234         -    test httpold-4.6 {httpEvent} {
   235         -	set token [http_get $url -blocksize 50 -progress myProgress]
   236         -	set progress
   237         -    } {111 111}
   238         -}
   239         -test httpold-4.7 {httpEvent} {
   240         -    set token [http_get $url -progress myProgress]
   241         -    set progress
   242         -} {111 111}
   243         -test httpold-4.8 {httpEvent} {
   244         -    set token [http_get $url]
   245         -    http_status $token
   246         -} {ok}
   247         -test httpold-4.9 {httpEvent} {
   248         -    set token [http_get $url -progress myProgress]
   249         -    http_code $token
   250         -} {HTTP/1.0 200 Data follows}
   251         -test httpold-4.10 {httpEvent} {
   252         -    set token [http_get $url -progress myProgress]
   253         -    http_size $token
   254         -} {111}
   255         -test httpold-4.11 {httpEvent} {
   256         -    set token [http_get $url -timeout 1 -command {#}]
   257         -    http_reset $token
   258         -    http_status $token
   259         -} {reset}
   260         -test httpold-4.12 {httpEvent} {
   261         -    update
   262         -    set x {}
   263         -    after 500 {lappend x ok}
   264         -    set token [http_get $url -timeout 1 -command {lappend x fail}]
   265         -    vwait x
   266         -    list [http_status $token] $x
   267         -} {timeout ok}
   268         -
   269         -test httpold-5.1 {http_formatQuery} {
   270         -    http_formatQuery name1 value1 name2 "value two"
   271         -} {name1=value1&name2=value+two}
   272         -
   273         -test httpold-5.2 {http_formatQuery} {
   274         -    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
   275         -} {name1=%7ebwelch&name2=%a1%a2%a2}
   276         -
   277         -test httpold-5.3 {http_formatQuery} {
   278         -    http_formatQuery lines "line1\nline2\nline3"
   279         -} {lines=line1%0d%0aline2%0d%0aline3}
   280         -
   281         -test httpold-6.1 {httpProxyRequired} {
   282         -    update
   283         -    http_config -proxyhost ${::HOST} -proxyport $port
   284         -    set token [http_get $url]
   285         -    http_wait $token
   286         -    http_config -proxyhost {} -proxyport {}
   287         -    upvar #0 $token data
   288         -    set data(body)
   289         -} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   290         -<h1>Hello, World!</h1>
   291         -<h2>GET http://$url</h2>
   292         -</body></html>"
   293         -
   294         -# cleanup
   295         -catch {unset url}
   296         -catch {unset port}
   297         -catch {unset data}
   298         -close $listen
   299         -::tcltest::cleanupTests
   300         -return

Changes to tests/safe.test.

   176    176       lsort $r
   177    177   } {byteOrder engine pathSeparator platform pointerSize wordSize}
   178    178   
   179    179   # More test should be added to check that hostname, nameofexecutable, aren't
   180    180   # leaking infos, but they still do...
   181    181   
   182    182   # high level general test
   183         -test safe-7.1 {tests that everything works at high level} {
          183  +test safe-7.1 {tests that everything works at high level} -body {
   184    184       set i [safe::interpCreate]
   185    185       # no error shall occur:
   186    186       # (because the default access_path shall include 1st level sub dirs so
   187    187       #  package require in a slave works like in the master)
   188         -    set v [interp eval $i {package require http 1}]
          188  +    set v [interp eval $i {package require http 2}]
   189    189       # no error shall occur:
   190         -    interp eval $i {http_config}
          190  +    interp eval $i {http::config}
   191    191       safe::interpDelete $i
   192    192       set v
   193         -} 1.0
          193  +} -match glob -result 2.*
   194    194   test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
   195    195       set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
   196    196       # should not add anything (p0)
   197    197       set token1 [safe::interpAddToAccessPath $i [info library]]
   198    198       # should add as p1
   199    199       set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
   200    200       # an error shall occur (http is not anymore in the secure 0-level

Changes to unix/Makefile.in.

   825    825   	    do \
   826    826   	    if [ ! -d "$$i" ] ; then \
   827    827   		echo "Making directory $$i"; \
   828    828   		$(INSTALL_DATA_DIR) "$$i"; \
   829    829   		else true; \
   830    830   		fi; \
   831    831   	    done;
   832         -	@for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
          832  +	@for i in opt0.4 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
   833    833   	    do \
   834    834   	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
   835    835   		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
   836    836   		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
   837    837   		else true; \
   838    838   		fi; \
   839    839   	    done;
   840    840   	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
   841    841   	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
   842    842   		$(UNIX_DIR)/tclAppInit.c @[email protected] @[email protected]; \
   843    843   	    do \
   844    844   	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
   845    845   	    done;
   846         -	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
   847         -	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
   848         -	    do \
   849         -	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
   850         -	    done;
   851    846   	@echo "Installing package http 2.8.12 as a Tcl Module";
   852    847   	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.12.tm;
   853    848   	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
   854    849   	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
   855    850   	    do \
   856    851   	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
   857    852   	    done;
................................................................................
  2006   2001   	cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
  2007   2002   	cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
  2008   2003   		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
  2009   2004   		$(DISTDIR)
  2010   2005   	@mkdir $(DISTDIR)/library
  2011   2006   	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
  2012   2007   		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
  2013         -	for i in http1.0 http opt msgcat reg dde tcltest platform; \
         2008  +	for i in http opt msgcat reg dde tcltest platform; \
  2014   2009   	    do \
  2015   2010   		mkdir $(DISTDIR)/library/$$i ;\
  2016   2011   		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
  2017   2012   	    done;
  2018   2013   	@mkdir $(DISTDIR)/library/encoding
  2019   2014   	cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
  2020   2015   	@mkdir $(DISTDIR)/library/msgs

Changes to win/Makefile.in.

   626    626   	    do \
   627    627   	    if [ ! -d $$i ] ; then \
   628    628   		echo "Making directory $$i"; \
   629    629   		$(MKDIR) $$i; \
   630    630   		else true; \
   631    631   		fi; \
   632    632   	    done;
   633         -	@for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
          633  +	@for i in opt0.4 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
   634    634   	    do \
   635    635   	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
   636    636   		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
   637    637   		$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
   638    638   		else true; \
   639    639   		fi; \
   640    640   	    done;
................................................................................
   648    648   	    $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
   649    649   	    done;
   650    650   	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
   651    651   	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
   652    652   	    do \
   653    653   	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
   654    654   	    done;
   655         -	@echo "Installing library http1.0 directory";
   656         -	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
   657         -	    do \
   658         -	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
   659         -	    done;
   660    655   	@echo "Installing package http 2.8.12 as a Tcl Module";
   661    656   	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.12.tm;
   662    657   	@echo "Installing library opt0.4 directory";
   663    658   	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
   664    659   	    do \
   665    660   	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
   666    661   	    done;

Changes to win/makefile.vc.

   856    856   	@$(CPY) "$(ROOT)\library\auto.tcl"        "$(SCRIPT_INSTALL_DIR)\"
   857    857   	@$(CPY) "$(OUT_DIR)\tclConfig.sh"         "$(LIB_INSTALL_DIR)\"
   858    858   	@$(CPY) "$(WINDIR)\tclooConfig.sh"        "$(LIB_INSTALL_DIR)\"
   859    859   	@$(CPY) "$(WINDIR)\rules.vc"              "$(LIB_INSTALL_DIR)\nmake\"
   860    860   	@$(CPY) "$(WINDIR)\targets.vc"              "$(LIB_INSTALL_DIR)\nmake\"
   861    861   	@$(CPY) "$(WINDIR)\nmakehlp.c"            "$(LIB_INSTALL_DIR)\nmake\"
   862    862   	@$(CPY) "$(OUT_DIR)\tcl.nmake"            "$(LIB_INSTALL_DIR)\nmake\"
   863         -	@echo Installing library http1.0 directory
   864         -	@$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
   865         -	    "$(SCRIPT_INSTALL_DIR)\http1.0\"
   866    863   	@echo Installing library opt0.4 directory
   867    864   	@$(CPY) "$(ROOT)\library\opt\*.tcl" \
   868    865   	    "$(SCRIPT_INSTALL_DIR)\opt0.4\"
   869    866   	@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
   870    867   	@$(COPY) "$(ROOT)\library\http\http.tcl" \
   871    868   	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
   872    869   	@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module