diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | doc/http.n | 79 | ||||
| -rw-r--r-- | library/http/http.tcl | 63 | ||||
| -rw-r--r-- | library/http2.3/http.tcl | 63 | ||||
| -rw-r--r-- | tests/http.test | 13 |
5 files changed, 164 insertions, 69 deletions
@@ -1,3 +1,18 @@ +2000-05-29 Sandeep Tamhankar <sandeep@scriptics.com> + + * tests/http.test + * doc/http.n + * library/http2.3/http.tcl: Fixed bug 5741, where unsuccessful + geturl calls sometimes leaked memory and resources (sockets). + Also, switched around some of the logic so that http::wait never + throws an exception. This is because in an asynchronous geturl, + the command callback will probably end up doing all the error + handling anyway, and in an asynchronous situation, the user + expects to check the state when the transaction completes, as + opposed to being thrown an exception. For the http package, this + menas the user can check http::status for "error" and http::error + for the error message after doing the http::wait. + 2000-05-31 Jeff Hobbs <hobbs@scriptics.com> * tests/set-old.test: @@ -1,11 +1,11 @@ '\" '\" Copyright (c) 1995-1997 Sun Microsystems, Inc. -'\" Copyright (c) 1999 by Scriptics Corporation. +'\" Copyright (c) 1998-2000 by Ajuba Solutions. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: http.n,v 1.10 2000/04/09 23:55:54 welch Exp $ +'\" RCS: @(#) $Id: http.n,v 1.11 2000/06/02 23:14:46 hobbs Exp $ '\" .so man.macros .TH "Http" n 8.3 Tcl "Tcl Built-In Commands" @@ -14,7 +14,7 @@ .SH NAME Http \- Client-side implementation of the HTTP/1.0 protocol. .SH SYNOPSIS -\fBpackage require http ?2.2?\fP +\fBpackage require http ?2.3?\fP .sp \fB::http::config \fI?options?\fR .sp @@ -32,8 +32,12 @@ Http \- Client-side implementation of the HTTP/1.0 protocol. .sp \fB::http::code \fItoken\fR .sp +\fB::http::ncode \fItoken\fR +.sp \fB::http::data \fItoken\fR .sp +\fB::http::error \fItoken\fR +.sp \fB::http::cleanup \fItoken\fR .sp \fB::http::register \fIproto port command\fR @@ -57,9 +61,8 @@ Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction is performed. The return value of \fB::http::geturl\fR is a token for the transaction. The value is also the name of an array in the ::http namespace - that contains state -information about the transaction. The elements of this array are -described in the STATE ARRAY section. +that contains state information about the transaction. The elements +of this array are described in the STATE ARRAY section. .PP If the \fB-command\fP option is specified, then the HTTP operation is done in the background. @@ -262,12 +265,20 @@ any. This sets the \fBstate(status)\fP value to \fIwhy\fP, which defaults to \f \fB::http::wait\fP \fItoken\fP This is a convenience procedure that blocks and waits for the transaction to complete. This only works in trusted code because it -uses \fBvwait\fR. +uses \fBvwait\fR. Also, it's not useful for the case where +\fB::http::geturl\fP is called \fIwithout\fP the \fB-command\fP option +because in this case the \fB::http::geturl\fP call doesn't return +until the HTTP transaction is complete, and thus there's nothing to +wait for. .TP \fB::http::data\fP \fItoken\fP This is a convenience procedure that returns the \fBbody\fP element (i.e., the URL data) of the state array. .TP +\fB::http::error\fP \fItoken\fP +This is a convenience procedure that returns the \fBerror\fP element +of the state array. +.TP \fB::http::status\fP \fItoken\fP This is a convenience procedure that returns the \fBstatus\fP element of the state array. @@ -276,15 +287,24 @@ the state array. This is a convenience procedure that returns the \fBhttp\fP element of the state array. .TP +\fB::http::ncode\fP \fItoken\fP +This is a convenience procedure that returns just the numeric return +code (200, 404, etc.) from the \fBhttp\fP element of the state array. +.TP \fB::http::size\fP \fItoken\fP This is a convenience procedure that returns the \fBcurrentsize\fP -element of the state array. +element of the state array, which represents the number of bytes +received from the URL in the \fB::http::geturl\fP call. .TP \fB::http::cleanup\fP \fItoken\fP This procedure cleans up the state associated with the connection identified by \fItoken\fP. After this call, the procedures like \fB::http::data\fP cannot be used to get information -about the operation. +about the operation. It is \fIstrongly\fP recommended that you call +this function after you're done with a given HTTP request. Not doing +so will result in memory not being freed, and if your app calls +\fB::http::geturl\fP enough times, the memory leak could cause a +performance hit...or worse. .TP \fB::http::register\fP \fIproto port command\fP This procedure allows one to provide custom HTTP transport types @@ -309,19 +329,36 @@ registered via \fBhttp::register\fR. The \fBhttp::geturl\fP procedure will raise errors in the following cases: invalid command line options, an invalid URL, -or a URL on a non-existent host, +a URL on a non-existent host, +or a URL at a bad port on an existing host. These errors mean that it cannot even start the network transaction. It will also raise an error if it gets an I/O error while writing out the HTTP request header. +For synchronous \fB::http::geturl\fP calls (where \fB-command\fP is +not specified), it will raise an error if it gets an I/O error while +reading the HTTP reply headers or data. Because \fB::http::geturl\fP +doesn't return a token in these cases, it does all the required +cleanup and there's no issue of your app having to call +\fB::http::cleanup\fP. +.PP +For asynchronous \fB::http::geturl\fP calls, all of the above error +situations apply, except that if there's any error while +reading the +HTTP reply headers or data, no exception is thrown. This is because +after writing the HTTP headers, \fB::http::geturl\fP returns, and the +rest of the HTTP transaction occurs in the background. The command +callback can check if any error occurred during the read by calling +\fB::http::status\fP to check the status and if it's \fIerror\fP, +calling \fB::http::error\fP to get the error message. +.PP +Alternatively, if the main program flow reaches a point where it needs +to know the result of the asynchronous HTTP request, it can call +\fB::http::wait\fP and then check status and error, just as the +callback does. .PP -The \fBhttp::wait\fP procedure will raise errors if an I/O error -occurs while reading the HTTP reply headers or data. If the -\fB-command\fP flag is not passed to \fBhttp::geturl\fP, -then it will call \fBhttp::wait\fP and so these errors will -occur in \fBhttp::geturl\fP. -If you get an error from \fBhttp::wait\fP, you must still call -\fBhttp::cleanup\fP to delete the state array. +In any case, you must still call +\fBhttp::cleanup\fP to delete the state array when you're done. .PP There are other possible results of the HTTP transaction determined by examining the status from \fBhttp::status\fP. @@ -336,12 +373,11 @@ procedure returns a value like "HTTP 404 File not found". .TP eof If the server closes the socket without replying, then no error -is rasied, but the status of the transaction will be \fBeof\fP. +is raised, but the status of the transaction will be \fBeof\fP. .TP error -In this case \fBhttp::wait\fP should have raised an error. The error message will also be stored in the \fBerror\fP status -array element. +array element, accessible via \fB::http::error\fP. .PP Another error possibility is that \fBhttp::geturl\fP is unable to write all the post query data to the server before the server @@ -424,7 +460,8 @@ the post query data to the server. .TP \fBstatus\fR Either \fBok\fR, for successful completion, \fBreset\fR for -user-reset, or \fBerror\fR for an error condition. During the +user-reset, \fBtimeout\fP if a timeout occurred before the transaction +could complete, or \fBerror\fR for an error condition. During the transaction this value is the empty string. .TP \fBtotalsize\fR diff --git a/library/http/http.tcl b/library/http/http.tcl index a524415..c8c9908 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.32 2000/04/22 07:07:59 sandeep Exp $ +# RCS: @(#) $Id: http.tcl,v 1.33 2000/06/02 23:14:46 hobbs Exp $ # Rough version history: # 1.0 Old http_get interface @@ -280,7 +280,7 @@ proc http::geturl { url args } { if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \ x prefix proto host y port srvurl]} { unset $token - error "Unsupported URL: $url" + return -code error "Unsupported URL: $url" } if {[string length $proto] == 0} { set proto http @@ -288,7 +288,7 @@ proc http::geturl { url args } { } if {![info exists urlTypes($proto)]} { unset $token - return -code error "unsupported url type \"$proto\"" + return -code error "Unsupported URL type \"$proto\"" } set defport [lindex $urlTypes($proto) 0] set defcmd [lindex $urlTypes($proto) 1] @@ -345,12 +345,17 @@ proc http::geturl { url args } { if {$state(-timeout) > 0} { fileevent $s writable [list http::Connect $token] http::wait $token - if {$state(status) != "connect"} { - - # Likely to be connection timeout. If there was a connection - # error, (e.g., bad port), then http::wait will have - # raised an error already + if {[string equal $state(status) "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 + } elseif {![string equal $state(status) "connect"]} { + # Likely to be connection timeout return $token } set state(status) "" @@ -449,6 +454,11 @@ proc http::geturl { url args } { # calls it synchronously, we just do a wait here. wait $token + if {[string equal $state(status) "error"]} { + # Something went wrong, so throw the exception, and the + # enclosing catch will do cleanup. + return -code error [lindex $state(error) 0] + } } } err]} { # The socket probably was never connected, @@ -457,8 +467,12 @@ proc http::geturl { url args } { # 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 + + # if state(status) is error, it means someone's already called Finish + # to do the above-described clean up. + if {[string equal $state(status) "error"]} { + Finish $token $err 1 + } cleanup $token return -code error $err } @@ -502,6 +516,15 @@ proc http::size {token} { return $state(currentsize) } +proc http::error {token} { + variable $token + upvar 0 $token state + if {[info exists state(error)]} { + return $state(error) + } + return "" +} + # http::cleanup # # Garbage collect the state associated with a transaction @@ -531,21 +554,19 @@ proc http::cleanup {token} { # Sets the status of the connection, which unblocks # the waiting geturl call - proc http::Connect {token} { +proc http::Connect {token} { variable $token upvar 0 $token state global errorInfo errorCode if {[eof $state(sock)] || - [string length [fconfigure $state(sock) -error]]} { - set state(status) error - set state(error) [list \ - "connect failed [fconfigure $state(sock) -error]" \ - $errorInfo $errorCode] + [string length [fconfigure $state(sock) -error]]} { + Finish $token "connect failed [fconfigure $state(sock) -error]" 1 } else { set state(status) connect + fileevent $state(sock) writable {} } - fileevent $state(sock) writable {} - } + return +} # http::Write # @@ -780,11 +801,7 @@ proc http::wait {token} { # We must wait on the original variable name, not the upvar alias vwait $token\(status) } - if {[info exists state(error)]} { - set errorlist $state(error) - unset state - eval error $errorlist - } + return $state(status) } diff --git a/library/http2.3/http.tcl b/library/http2.3/http.tcl index a524415..c8c9908 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.32 2000/04/22 07:07:59 sandeep Exp $ +# RCS: @(#) $Id: http.tcl,v 1.33 2000/06/02 23:14:46 hobbs Exp $ # Rough version history: # 1.0 Old http_get interface @@ -280,7 +280,7 @@ proc http::geturl { url args } { if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \ x prefix proto host y port srvurl]} { unset $token - error "Unsupported URL: $url" + return -code error "Unsupported URL: $url" } if {[string length $proto] == 0} { set proto http @@ -288,7 +288,7 @@ proc http::geturl { url args } { } if {![info exists urlTypes($proto)]} { unset $token - return -code error "unsupported url type \"$proto\"" + return -code error "Unsupported URL type \"$proto\"" } set defport [lindex $urlTypes($proto) 0] set defcmd [lindex $urlTypes($proto) 1] @@ -345,12 +345,17 @@ proc http::geturl { url args } { if {$state(-timeout) > 0} { fileevent $s writable [list http::Connect $token] http::wait $token - if {$state(status) != "connect"} { - - # Likely to be connection timeout. If there was a connection - # error, (e.g., bad port), then http::wait will have - # raised an error already + if {[string equal $state(status) "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 + } elseif {![string equal $state(status) "connect"]} { + # Likely to be connection timeout return $token } set state(status) "" @@ -449,6 +454,11 @@ proc http::geturl { url args } { # calls it synchronously, we just do a wait here. wait $token + if {[string equal $state(status) "error"]} { + # Something went wrong, so throw the exception, and the + # enclosing catch will do cleanup. + return -code error [lindex $state(error) 0] + } } } err]} { # The socket probably was never connected, @@ -457,8 +467,12 @@ proc http::geturl { url args } { # 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 + + # if state(status) is error, it means someone's already called Finish + # to do the above-described clean up. + if {[string equal $state(status) "error"]} { + Finish $token $err 1 + } cleanup $token return -code error $err } @@ -502,6 +516,15 @@ proc http::size {token} { return $state(currentsize) } +proc http::error {token} { + variable $token + upvar 0 $token state + if {[info exists state(error)]} { + return $state(error) + } + return "" +} + # http::cleanup # # Garbage collect the state associated with a transaction @@ -531,21 +554,19 @@ proc http::cleanup {token} { # Sets the status of the connection, which unblocks # the waiting geturl call - proc http::Connect {token} { +proc http::Connect {token} { variable $token upvar 0 $token state global errorInfo errorCode if {[eof $state(sock)] || - [string length [fconfigure $state(sock) -error]]} { - set state(status) error - set state(error) [list \ - "connect failed [fconfigure $state(sock) -error]" \ - $errorInfo $errorCode] + [string length [fconfigure $state(sock) -error]]} { + Finish $token "connect failed [fconfigure $state(sock) -error]" 1 } else { set state(status) connect + fileevent $state(sock) writable {} } - fileevent $state(sock) writable {} - } + return +} # http::Write # @@ -780,11 +801,7 @@ proc http::wait {token} { # We must wait on the original variable name, not the upvar alias vwait $token\(status) } - if {[info exists state(error)]} { - set errorlist $state(error) - unset state - eval error $errorlist - } + return $state(status) } diff --git a/tests/http.test b/tests/http.test index 4efde80..c18a3c9 100644 --- a/tests/http.test +++ b/tests/http.test @@ -6,13 +6,13 @@ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.19 2000/04/22 07:07:59 sandeep Exp $ +# RCS: @(#) $Id: http.test,v 1.20 2000/06/02 23:14:47 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -290,6 +290,15 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} { list [http::status $t] [http::code $t] } {ok {HTTP/1.0 200 Data follows}} +test http-3.13 {http::geturl socket leak test} { + set chanCount [llength [file channels]] + for {set i 0} {$i<200} {incr i} { + catch {http::geturl $badurl -timeout 10000} + } + + # No extra channels should be taken + expr {[llength [file channels]] == $chanCount} +} 1 test http-4.1 {http::Event} { set token [http::geturl $url] |