summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorwelch <welch>1999-06-30 17:43:51 (GMT)
committerwelch <welch>1999-06-30 17:43:51 (GMT)
commitc9e74e1ec6bda78dcd75b74fe1f1c592838f7935 (patch)
treec97256fd6bf24b9a5e172bb1efbd26cbbe464b48 /library
parentc6757f9c3257da19e8a8eac40a52fbb55aa537c1 (diff)
downloadtcl-c9e74e1ec6bda78dcd75b74fe1f1c592838f7935.zip
tcl-c9e74e1ec6bda78dcd75b74fe1f1c592838f7935.tar.gz
tcl-c9e74e1ec6bda78dcd75b74fe1f1c592838f7935.tar.bz2
Fixed -timeout bug to handle connections to dead servers properly.
Added http::cleanup function
Diffstat (limited to 'library')
-rw-r--r--library/http/http.tcl76
-rw-r--r--library/http2.0/http.tcl76
-rw-r--r--library/http2.1/http.tcl76
-rw-r--r--library/http2.3/http.tcl76
4 files changed, 268 insertions, 36 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 6ad16df..dc3c890 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -9,9 +9,9 @@
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: http.tcl,v 1.5 1999/02/02 22:28:30 stanton Exp $
+# RCS: @(#) $Id: http.tcl,v 1.6 1999/06/30 17:43:51 welch Exp $
-package provide http 2.0 ;# This uses Tcl namespaces
+package provide http 2.1 ;# This uses Tcl namespaces
namespace eval http {
variable http
@@ -134,15 +134,20 @@ proc http::reset { token {why reset} } {
# Establishes a connection to a remote url via http.
#
# Arguments:
-# url The http URL to goget.
-# args Option value pairs. Valid options include:
+# url The http URL to goget.
+# args Option value pairs. Valid options include:
# -blocksize, -validate, -headers, -timeout
# Results:
-# Returns a token for this connection.
-
+# Returns a token for this connection.
+# This token is the name of an array that the caller should
+# unset to garbage collect the state.
proc http::geturl { url args } {
variable http
+
+ # Initialize the state variable, an array. We'll return the
+ # name of this array as the token for the transaction.
+
if {![info exists http(uid)]} {
set http(uid) 0
}
@@ -150,6 +155,9 @@ proc http::geturl { url args } {
variable $token
upvar 0 $token state
reset $token
+
+ # Process command options.
+
array set state {
-blocksize 8192
-validate 0
@@ -170,7 +178,9 @@ proc http::geturl { url args } {
set pat ^-([join $options |])$
foreach {flag value} $args {
if {[regexp $pat $flag]} {
+
# Validate numbers
+
if {[info exists state($flag)] && \
[regexp {^[0-9]+$} $state($flag)] && \
![regexp {^[0-9]+$} $value]} {
@@ -199,17 +209,39 @@ proc http::geturl { url args } {
set phost [lindex $proxy 0]
set pport [lindex $proxy 1]
}
+
+ # If a timeout is specified we set up the after event
+ # and arrange for an asynchronous socket connection.
+
if {$state(-timeout) > 0} {
- set state(after) [after $state(-timeout) [list http::reset $token timeout]]
+ set state(after) [after $state(-timeout) \
+ [list http::reset $token timeout]]
+ set async -async
+ } else {
+ set async ""
}
+
+ # If we are using the proxy, we must pass in the full URL that
+ # includes the server name.
+
if {[info exists phost] && [string length $phost]} {
set srvurl $url
- set s [socket $phost $pport]
+ set s [eval socket $async {$phost $pport}]
} else {
- set s [socket $host $port]
+ set s [eval socket $async {$host $port}]
}
set state(sock) $s
+ # Wait for the connection to complete
+
+ if {$state(-timeout) > 0} {
+ #fileevent $s writable [list set $token\(status) connect]
+ fileevent $s writable [list http::Connect $token]
+ http::wait $token
+ fileevent $s writable {}
+ unset state(status)
+ }
+
# Send data in cr-lf format, but accept any line terminators
fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
@@ -283,6 +315,29 @@ proc http::size {token} {
return $state(currentsize)
}
+# http::cleanup
+#
+# Garbage collect the state associated with a transaction
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# unsets the state array
+
+proc http::cleanup {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exist state]} {
+ unset state
+ }
+}
+ proc http::Connect {token} {
+ variable $token
+ upvar 0 $token state
+ set state(status) connect
+ }
+
proc http::Event {token} {
variable $token
upvar 0 $token state
@@ -399,6 +454,9 @@ proc http::wait {token} {
upvar 0 $token state
if {![info exists state(status)] || [string length $state(status)] == 0} {
+
+ # We must wait on the original variable name, not the upvar alias
+
vwait $token\(status)
}
if {[info exists state(error)]} {
diff --git a/library/http2.0/http.tcl b/library/http2.0/http.tcl
index 6ad16df..dc3c890 100644
--- a/library/http2.0/http.tcl
+++ b/library/http2.0/http.tcl
@@ -9,9 +9,9 @@
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: http.tcl,v 1.5 1999/02/02 22:28:30 stanton Exp $
+# RCS: @(#) $Id: http.tcl,v 1.6 1999/06/30 17:43:51 welch Exp $
-package provide http 2.0 ;# This uses Tcl namespaces
+package provide http 2.1 ;# This uses Tcl namespaces
namespace eval http {
variable http
@@ -134,15 +134,20 @@ proc http::reset { token {why reset} } {
# Establishes a connection to a remote url via http.
#
# Arguments:
-# url The http URL to goget.
-# args Option value pairs. Valid options include:
+# url The http URL to goget.
+# args Option value pairs. Valid options include:
# -blocksize, -validate, -headers, -timeout
# Results:
-# Returns a token for this connection.
-
+# Returns a token for this connection.
+# This token is the name of an array that the caller should
+# unset to garbage collect the state.
proc http::geturl { url args } {
variable http
+
+ # Initialize the state variable, an array. We'll return the
+ # name of this array as the token for the transaction.
+
if {![info exists http(uid)]} {
set http(uid) 0
}
@@ -150,6 +155,9 @@ proc http::geturl { url args } {
variable $token
upvar 0 $token state
reset $token
+
+ # Process command options.
+
array set state {
-blocksize 8192
-validate 0
@@ -170,7 +178,9 @@ proc http::geturl { url args } {
set pat ^-([join $options |])$
foreach {flag value} $args {
if {[regexp $pat $flag]} {
+
# Validate numbers
+
if {[info exists state($flag)] && \
[regexp {^[0-9]+$} $state($flag)] && \
![regexp {^[0-9]+$} $value]} {
@@ -199,17 +209,39 @@ proc http::geturl { url args } {
set phost [lindex $proxy 0]
set pport [lindex $proxy 1]
}
+
+ # If a timeout is specified we set up the after event
+ # and arrange for an asynchronous socket connection.
+
if {$state(-timeout) > 0} {
- set state(after) [after $state(-timeout) [list http::reset $token timeout]]
+ set state(after) [after $state(-timeout) \
+ [list http::reset $token timeout]]
+ set async -async
+ } else {
+ set async ""
}
+
+ # If we are using the proxy, we must pass in the full URL that
+ # includes the server name.
+
if {[info exists phost] && [string length $phost]} {
set srvurl $url
- set s [socket $phost $pport]
+ set s [eval socket $async {$phost $pport}]
} else {
- set s [socket $host $port]
+ set s [eval socket $async {$host $port}]
}
set state(sock) $s
+ # Wait for the connection to complete
+
+ if {$state(-timeout) > 0} {
+ #fileevent $s writable [list set $token\(status) connect]
+ fileevent $s writable [list http::Connect $token]
+ http::wait $token
+ fileevent $s writable {}
+ unset state(status)
+ }
+
# Send data in cr-lf format, but accept any line terminators
fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
@@ -283,6 +315,29 @@ proc http::size {token} {
return $state(currentsize)
}
+# http::cleanup
+#
+# Garbage collect the state associated with a transaction
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# unsets the state array
+
+proc http::cleanup {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exist state]} {
+ unset state
+ }
+}
+ proc http::Connect {token} {
+ variable $token
+ upvar 0 $token state
+ set state(status) connect
+ }
+
proc http::Event {token} {
variable $token
upvar 0 $token state
@@ -399,6 +454,9 @@ proc http::wait {token} {
upvar 0 $token state
if {![info exists state(status)] || [string length $state(status)] == 0} {
+
+ # We must wait on the original variable name, not the upvar alias
+
vwait $token\(status)
}
if {[info exists state(error)]} {
diff --git a/library/http2.1/http.tcl b/library/http2.1/http.tcl
index 6ad16df..dc3c890 100644
--- a/library/http2.1/http.tcl
+++ b/library/http2.1/http.tcl
@@ -9,9 +9,9 @@
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: http.tcl,v 1.5 1999/02/02 22:28:30 stanton Exp $
+# RCS: @(#) $Id: http.tcl,v 1.6 1999/06/30 17:43:51 welch Exp $
-package provide http 2.0 ;# This uses Tcl namespaces
+package provide http 2.1 ;# This uses Tcl namespaces
namespace eval http {
variable http
@@ -134,15 +134,20 @@ proc http::reset { token {why reset} } {
# Establishes a connection to a remote url via http.
#
# Arguments:
-# url The http URL to goget.
-# args Option value pairs. Valid options include:
+# url The http URL to goget.
+# args Option value pairs. Valid options include:
# -blocksize, -validate, -headers, -timeout
# Results:
-# Returns a token for this connection.
-
+# Returns a token for this connection.
+# This token is the name of an array that the caller should
+# unset to garbage collect the state.
proc http::geturl { url args } {
variable http
+
+ # Initialize the state variable, an array. We'll return the
+ # name of this array as the token for the transaction.
+
if {![info exists http(uid)]} {
set http(uid) 0
}
@@ -150,6 +155,9 @@ proc http::geturl { url args } {
variable $token
upvar 0 $token state
reset $token
+
+ # Process command options.
+
array set state {
-blocksize 8192
-validate 0
@@ -170,7 +178,9 @@ proc http::geturl { url args } {
set pat ^-([join $options |])$
foreach {flag value} $args {
if {[regexp $pat $flag]} {
+
# Validate numbers
+
if {[info exists state($flag)] && \
[regexp {^[0-9]+$} $state($flag)] && \
![regexp {^[0-9]+$} $value]} {
@@ -199,17 +209,39 @@ proc http::geturl { url args } {
set phost [lindex $proxy 0]
set pport [lindex $proxy 1]
}
+
+ # If a timeout is specified we set up the after event
+ # and arrange for an asynchronous socket connection.
+
if {$state(-timeout) > 0} {
- set state(after) [after $state(-timeout) [list http::reset $token timeout]]
+ set state(after) [after $state(-timeout) \
+ [list http::reset $token timeout]]
+ set async -async
+ } else {
+ set async ""
}
+
+ # If we are using the proxy, we must pass in the full URL that
+ # includes the server name.
+
if {[info exists phost] && [string length $phost]} {
set srvurl $url
- set s [socket $phost $pport]
+ set s [eval socket $async {$phost $pport}]
} else {
- set s [socket $host $port]
+ set s [eval socket $async {$host $port}]
}
set state(sock) $s
+ # Wait for the connection to complete
+
+ if {$state(-timeout) > 0} {
+ #fileevent $s writable [list set $token\(status) connect]
+ fileevent $s writable [list http::Connect $token]
+ http::wait $token
+ fileevent $s writable {}
+ unset state(status)
+ }
+
# Send data in cr-lf format, but accept any line terminators
fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
@@ -283,6 +315,29 @@ proc http::size {token} {
return $state(currentsize)
}
+# http::cleanup
+#
+# Garbage collect the state associated with a transaction
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# unsets the state array
+
+proc http::cleanup {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exist state]} {
+ unset state
+ }
+}
+ proc http::Connect {token} {
+ variable $token
+ upvar 0 $token state
+ set state(status) connect
+ }
+
proc http::Event {token} {
variable $token
upvar 0 $token state
@@ -399,6 +454,9 @@ proc http::wait {token} {
upvar 0 $token state
if {![info exists state(status)] || [string length $state(status)] == 0} {
+
+ # We must wait on the original variable name, not the upvar alias
+
vwait $token\(status)
}
if {[info exists state(error)]} {
diff --git a/library/http2.3/http.tcl b/library/http2.3/http.tcl
index 6ad16df..dc3c890 100644
--- a/library/http2.3/http.tcl
+++ b/library/http2.3/http.tcl
@@ -9,9 +9,9 @@
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: http.tcl,v 1.5 1999/02/02 22:28:30 stanton Exp $
+# RCS: @(#) $Id: http.tcl,v 1.6 1999/06/30 17:43:51 welch Exp $
-package provide http 2.0 ;# This uses Tcl namespaces
+package provide http 2.1 ;# This uses Tcl namespaces
namespace eval http {
variable http
@@ -134,15 +134,20 @@ proc http::reset { token {why reset} } {
# Establishes a connection to a remote url via http.
#
# Arguments:
-# url The http URL to goget.
-# args Option value pairs. Valid options include:
+# url The http URL to goget.
+# args Option value pairs. Valid options include:
# -blocksize, -validate, -headers, -timeout
# Results:
-# Returns a token for this connection.
-
+# Returns a token for this connection.
+# This token is the name of an array that the caller should
+# unset to garbage collect the state.
proc http::geturl { url args } {
variable http
+
+ # Initialize the state variable, an array. We'll return the
+ # name of this array as the token for the transaction.
+
if {![info exists http(uid)]} {
set http(uid) 0
}
@@ -150,6 +155,9 @@ proc http::geturl { url args } {
variable $token
upvar 0 $token state
reset $token
+
+ # Process command options.
+
array set state {
-blocksize 8192
-validate 0
@@ -170,7 +178,9 @@ proc http::geturl { url args } {
set pat ^-([join $options |])$
foreach {flag value} $args {
if {[regexp $pat $flag]} {
+
# Validate numbers
+
if {[info exists state($flag)] && \
[regexp {^[0-9]+$} $state($flag)] && \
![regexp {^[0-9]+$} $value]} {
@@ -199,17 +209,39 @@ proc http::geturl { url args } {
set phost [lindex $proxy 0]
set pport [lindex $proxy 1]
}
+
+ # If a timeout is specified we set up the after event
+ # and arrange for an asynchronous socket connection.
+
if {$state(-timeout) > 0} {
- set state(after) [after $state(-timeout) [list http::reset $token timeout]]
+ set state(after) [after $state(-timeout) \
+ [list http::reset $token timeout]]
+ set async -async
+ } else {
+ set async ""
}
+
+ # If we are using the proxy, we must pass in the full URL that
+ # includes the server name.
+
if {[info exists phost] && [string length $phost]} {
set srvurl $url
- set s [socket $phost $pport]
+ set s [eval socket $async {$phost $pport}]
} else {
- set s [socket $host $port]
+ set s [eval socket $async {$host $port}]
}
set state(sock) $s
+ # Wait for the connection to complete
+
+ if {$state(-timeout) > 0} {
+ #fileevent $s writable [list set $token\(status) connect]
+ fileevent $s writable [list http::Connect $token]
+ http::wait $token
+ fileevent $s writable {}
+ unset state(status)
+ }
+
# Send data in cr-lf format, but accept any line terminators
fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
@@ -283,6 +315,29 @@ proc http::size {token} {
return $state(currentsize)
}
+# http::cleanup
+#
+# Garbage collect the state associated with a transaction
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# unsets the state array
+
+proc http::cleanup {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exist state]} {
+ unset state
+ }
+}
+ proc http::Connect {token} {
+ variable $token
+ upvar 0 $token state
+ set state(status) connect
+ }
+
proc http::Event {token} {
variable $token
upvar 0 $token state
@@ -399,6 +454,9 @@ proc http::wait {token} {
upvar 0 $token state
if {![info exists state(status)] || [string length $state(status)] == 0} {
+
+ # We must wait on the original variable name, not the upvar alias
+
vwait $token\(status)
}
if {[info exists state(error)]} {