summaryrefslogtreecommitdiffstats
path: root/library/http/http.tcl
diff options
context:
space:
mode:
authorsandeep <sandeep>2000-04-22 07:07:59 (GMT)
committersandeep <sandeep>2000-04-22 07:07:59 (GMT)
commita8e7531672e83d472bbe36d0e63ce316bb0cf562 (patch)
tree218bd74182d4e5cb8dcc11bc0c12f69ff4a653a2 /library/http/http.tcl
parentf4b99eae61b3fd5e5a1a4027365d214a462d6d9b (diff)
downloadtcl-a8e7531672e83d472bbe36d0e63ce316bb0cf562.zip
tcl-a8e7531672e83d472bbe36d0e63ce316bb0cf562.tar.gz
tcl-a8e7531672e83d472bbe36d0e63ce316bb0cf562.tar.bz2
2000-04-21 Sandeep Tamhankar <sandeep@scriptics.com>
* library/http2.1/http.tcl: Fixed a newly introduced bug where if there's a -command callback and something goes wrong, geturl threw an exception, called the callback, and unset the token. I changed it so that it will not call the callback when throwing an exception (so the caller only finds out about a given error from one place). Also, fixed http::ncode so that it actually gives you back the http return code (i.e. 200, 404, etc.) instead of the first digit of the version of HTTP being used (i.e. 1).
Diffstat (limited to 'library/http/http.tcl')
-rw-r--r--library/http/http.tcl28
1 files changed, 19 insertions, 9 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 2137b00..a524415 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -9,7 +9,7 @@
# 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.31 2000/04/22 00:37:33 welch Exp $
+# RCS: @(#) $Id: http.tcl,v 1.32 2000/04/22 07:07:59 sandeep Exp $
# Rough version history:
# 1.0 Old http_get interface
@@ -136,13 +136,17 @@ proc http::config {args} {
# Clean up the socket and eval close time callbacks
#
# Arguments:
-# token Connection token.
-# errormsg If set, forces status to error.
+# token Connection token.
+# errormsg (optional) If set, forces status to error.
+# skipCB (optional) If set, don't call the -command callback. This
+# is useful when geturl wants to throw an exception instead
+# of calling the callback. That way, the same error isn't
+# reported to two places.
#
# Side Effects:
# Closes the socket
- proc http::Finish { token {errormsg ""} } {
+proc http::Finish { token {errormsg ""} {skipCB 0}} {
variable $token
upvar 0 $token state
global errorInfo errorCode
@@ -152,7 +156,7 @@ proc http::config {args} {
}
catch {close $state(sock)}
catch {after cancel $state(after)}
- if {[info exists state(-command)]} {
+ if {[info exists state(-command)] && !$skipCB} {
if {[catch {eval $state(-command) {$token}} err]} {
if {[string length $errormsg] == 0} {
set state(error) [list $err $errorInfo $errorCode]
@@ -327,8 +331,10 @@ proc http::geturl { url args } {
if {$conStat} {
# something went wrong while trying to establish the connection
-
- Finish $token
+ # 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.
+ Finish $token "" 1
cleanup $token
return -code error $s
}
@@ -448,7 +454,11 @@ proc http::geturl { url args } {
# The socket probably was never connected,
# or the connection dropped later.
- Finish $token $err
+ # 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.
+
+ Finish $token $err 1
cleanup $token
return -code error $err
}
@@ -480,7 +490,7 @@ proc http::code {token} {
proc http::ncode {token} {
variable $token
upvar 0 $token state
- if {[regexp {[0-9]+} $state(http) numeric_code]} {
+ if {[regexp {[0-9]{3}} $state(http) numeric_code]} {
return $numeric_code
} else {
return $state(http)