Tcl Source Code

2013-01-23  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait
	for connect to avoid reentrancy problems (except when operating
	without a -command option). Internally, this means that all sockets
	created by the http package will always be operated in asynchronous
	mode.

2013-01-18  Jan Nijtmans  <[email protected]>

	* generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include
	sys/stat.h

2013-01-17  Donal K. Fellows  <[email protected]>

    append url $srvurl
    # Don't append the fragment!
    set state(url) $url

    # If a timeout is specified we set up the after event and arrange for an
    # asynchronous socket connection.

    set sockopts [list -async]
    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]

    }

    # If we are using the proxy, we must pass in the full URL that includes
    # the server name.

    if {[info exists phost] && ($phost ne "")} {
	set srvurl $url

    set state(sock) $sock
    Log "Using $sock for $state(socketinfo)" \
        [expr {$state(-keepalive)?"keepalive":""}]
    if {$state(-keepalive)} {
        set socketmap($state(socketinfo)) $sock
    }

    if {![info exists phost]} {
	set phost ""
    }

    fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]

    # Wait for the connection to complete.
    if {![info exists state(-command)]} {
	# geturl does EVERYTHING asynchronously, so if the user
	# calls it synchronously, we just do a wait here.
	http::wait $token

	if {![info exists state]} {
	    # If we timed out then Finish has been called and the users
	    # command callback may have cleaned up the token. If so we end up
	    # here with nothing left to do.
	    return $token
	} elseif {$state(status) eq "error"} {
	    # Something went wrong while trying to establish the connection.
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	}
    }


    return $token
}


proc http::Connected { token proto phost srvurl} {
    variable http
    variable urlTypes

    variable $token
    upvar 0 $token state

    # Set back the variables needed here
    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]

    set defport [lindex $urlTypes($proto) 0]

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

	    fileevent $sock writable [list http::Write $token]
	} else {
	    puts $sock ""
	    flush $sock
	    fileevent $sock readable [list http::Event $sock $token]
	}












    } err]} {
	# The socket probably was never connected, or the connection dropped
	# later.





	# if state(status) is error, it means someone's already called Finish
	# to do the above-described clean up.
	if {$state(status) ne "error"} {
	    Finish $token $err
	}


    }


}

# Data access functions:
# Data - the URL data
# Status - the transaction status: ok, reset, eof, timeout
# Code - the HTTP transaction code, e.g., 200
# Size - the size of the URL data

# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

proc http::Connect {token proto phost srvurl} {
    variable $token
    upvar 0 $token state
    set err "due to unexpected EOF"
    if {
	[eof $state(sock)] ||
	[set err [fconfigure $state(sock) -error]] ne ""
    } {
	Finish $token "connect failed $err"
    } else {

	fileevent $state(sock) writable {}
	::http::Connected $token $proto $phost $srvurl
    }
    return
}

# http::Write
#
#	Write POST query data to the socket

#	connection "completes" but the socket is bad.
test http-4.14 {http::Event} -body {
    set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#]
    if {$token eq ""} {
	error "bogus return from http::geturl"
    }
    http::wait $token
    lindex [http::error $token] 0

} -cleanup {
    catch {http::cleanup $token}
} -result {connect failed connection refused}
# Bogus host
test http-4.15 {http::Event} -body {
    # This test may fail if you use a proxy server. That is to be
    # expected and is not a problem with Tcl.
    set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#]
    http::wait $token
    http::status $token

    /* See: <http://en.wikipedia.org/wiki/CPUID> */
#if defined(HAVE_CPUID)
    __asm__ __volatile__("mov %%ebx, %%edi     \n\t" /* save %ebx */
                 "cpuid            \n\t"
                 "mov %%ebx, %%esi   \n\t" /* save what cpuid just put in %ebx */
                 "mov %%edi, %%ebx  \n\t" /* restore the old %ebx */
                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                 : "a"(index) : "edi","ebx");
    status = TCL_OK;
#endif
    return status;
}

/*
 * Local Variables: