# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.9.3

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {

	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html
	body		{}
	status		""
	http		""
	connection	keep-alive
    }
    set state(-keepalive) $defaultKeepalive
    set state(-strict) $strict
    # These flags have their types verified [Bug 811170]
    array set type {
	-binary		boolean
	-blocksize	integer

		# is handled by socketWrQueue later in this command.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"

	    }
	    # Do not automatically close the connection socket.
	    set state(connection) keep-alive
	}
    }

    if {$reusing} {
	# Define state(tmpState) and state(tmpOpenCmd) for use
	# by http::ReplayIfDead if the persistent connection has died.
	set state(tmpState) [array get state]

			}
			transfer-encoding {
			    set state(transfer) \
				    [string trim [string tolower $value]]
			}
			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] == -1} {
				# Not a comma-separated list, not "close",
				# therefore "keep-alive".
				set tmpHeader keep-alive
			    } else {
				set tmpHeader keep-alive
				set tmpCsl [split $tmpHeader ,]
				# Optional whitespace either side of separator.
				foreach el $tmpCsl {
				    if {[string trim $el] eq {close}} {
					set tmpHeader close
					break
				    }
			        }
			    }
			    set state(connection) $tmpHeader

			}
			set-cookie {
			    if {$http(-cookiejar) ne ""} {
				ParseCookie $token [string trim $value]
			    }
			}
		    }

if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.9.3 [list tclPkgSetup $dir http 2.9.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
  set ::test [info script]
  set isafe [interp issafe]
  foreach {safe package version file} {
    0 http            2.9.3  {http http.tcl}
    1 msgcat          1.7.1  {msgcat msgcat.tcl}
    1 opt             0.4.7  {opt optparse.tcl}
    0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
    0 tcl::idna       1.0.1  {cookiejar idna.tcl}
    0 platform        1.0.14 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.3  {tcltest tcltest.tcl}

# http11.test --                                                -*- tcl-*-
#
#	Test HTTP/1.1 features.
#
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace import -force ::tcltest::*

package require http 2.9

# start the server
variable httpd_output
proc create_httpd {} {
    proc httpd_read {chan} {
        variable httpd_output
        if {[gets $chan line] != -1} {

            return [dict get $meta $key]
        } else {
            return ""
        }
    }
    return $meta
}

proc state {tok {key ""}} {
    upvar 1 $tok state
    if {$key ne ""} {
        if {[array names state -exact $key] ne {}} {
            return $state($key)
        } else {
            return ""
        }
    }
    set res [array get state]
    dict set res body <elided>
    return $res
}

proc check_crc {tok args} {
    set crc [meta $tok x-crc32]
    set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
    set chk [format %x [zlib crc32 $data]]
    if {$crc ne $chk} {
        return  "crc32 mismatch: $crc ne $chk"

    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}

test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup {
    variable httpd [create_httpd]
    set zipTmp [http::config -zip]
    http::config -zip 0
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
                 -protocol 1.1 -keepalive 1 -timeout 10000]
    http::wait $tok
    set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]]
    set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
                 -protocol 1.1 -keepalive 1 -timeout 10000]
    http::wait $toj
    set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \
        [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]]
    concat $res1 -- $res2
} -cleanup {
    http::cleanup $tok
    http::cleanup $toj
    halt_httpd
    http::config -zip $zipTmp
} -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive}

# -------------------------------------------------------------------------

test http11-2.0 "-channel" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \

# httpPipeline.test
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace import -force ::tcltest::*

package require http 2.9

set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
source [file join $sourcedir httpTestScript.tcl]

# ------------------------------------------------------------------------------
# (1) Define the test scripts that will be used to generate logs for analysis -

test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
    if {![catch {socket -server dodo 0x1} msg]} {
	close $msg
        return {htons problem, should be disallowed, are you running as SU?}
    }
    return {couldn't open socket: not owner}
} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}
test socket_$af-5.2 {byte order problems, socket numbers, htons} -body {
    if {![catch {socket -server dodo 0x10000} msg]} {
	close $msg
	return {port resolution problem, should be disallowed}
    }
    return {couldn't open socket: port number too high}
} -constraints [list socket supported_$af] -result {couldn't open socket: port number too high}
test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
    if {![catch {socket -server dodo 21} msg]} {
	close $msg
	return {htons problem, should be disallowed, are you running as SU?}
    }
    return {couldn't open socket: not owner}
} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}

test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup {
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]

	@echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/"
	@for i in $(TOP_DIR)/library/cookiejar/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	done
	@for i in $(TOP_DIR)/library/cookiejar/*.gz; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	done
	@echo "Installing package http 2.9.3 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/http-2.9.3.tm"
	@echo "Installing package opt 0.4.7"
	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	done
	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"

	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package cookiejar 0.2"
	@for j in $(ROOT_DIR)/library/cookiejar/*.{tcl,txt.gz}; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    done;
	@echo "Installing package http 2.9.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.9.3.tm";
	@echo "Installing package opt 0.4.7";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm";