diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | library/http/http.tcl | 28 | ||||
| -rw-r--r-- | library/http2.1/http.tcl | 28 | ||||
| -rw-r--r-- | library/http2.3/http.tcl | 28 | ||||
| -rw-r--r-- | tests/http.test | 3 |
5 files changed, 69 insertions, 29 deletions
@@ -1,3 +1,14 @@ +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). + 2000-04-21 Brent Welch <welch@scriptics.com> * library/http2.1/http.tcl: More thrashing with the "server closes 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) diff --git a/library/http2.1/http.tcl b/library/http2.1/http.tcl index 2137b00..a524415 100644 --- a/library/http2.1/http.tcl +++ b/library/http2.1/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) diff --git a/library/http2.3/http.tcl b/library/http2.3/http.tcl index 2137b00..a524415 100644 --- a/library/http2.3/http.tcl +++ b/library/http2.3/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) diff --git a/tests/http.test b/tests/http.test index a7c1045..4efde80 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.18 2000/04/10 17:18:59 ericm Exp $ +# RCS: @(#) $Id: http.test,v 1.19 2000/04/22 07:07:59 sandeep Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -475,4 +475,3 @@ if {[info exist removeHttpd]} { } ::tcltest::cleanupTests -return |