summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-11-06 10:40:09 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-11-06 10:40:09 (GMT)
commit4d3a8115170564c6159e793451ea25fead36adb6 (patch)
tree31ac5216afd93567c82b06482cc6f437cc42d41e
parentfc54b6df2024f882d6ef731a22a83756d940ef84 (diff)
downloadtcl-4d3a8115170564c6159e793451ea25fead36adb6.zip
tcl-4d3a8115170564c6159e793451ea25fead36adb6.tar.gz
tcl-4d3a8115170564c6159e793451ea25fead36adb6.tar.bz2
[Bug 3581754]: Ensure that http -command callbacks are done at most once.
-rw-r--r--ChangeLog9
-rw-r--r--library/http/http.tcl16
-rw-r--r--library/http/pkgIndex.tcl2
3 files changed, 17 insertions, 10 deletions
diff --git a/ChangeLog b/ChangeLog
index 87893c7..d0e6ebd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2012-11-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/http/http.tcl (http::Finish): [Bug 3581754]: Ensure that
+ callbacks are done at most once to prevent problems with timeouts on a
+ keep-alive connection (combined with reentrant http package use)
+ causing excessive stack growth. Not a fix for the underlying problem,
+ but ensures that pain will be mostly kept away from users.
+ Bump http package to 2.7.10.
+
2012-10-23 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclInt.h: Remove unused TclpLoadFile function.
diff --git a/library/http/http.tcl b/library/http/http.tcl
index ce9f634..fa0425d 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.7.9
+package provide http 2.7.10
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -199,15 +199,13 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
if {[info exists state(after)]} {
after cancel $state(after)
}
- if {[info exists state(-command)] && !$skipCB} {
- if {[catch {eval $state(-command) {$token}} err]} {
- if {$errormsg eq ""} {
- set state(error) [list $err $errorInfo $errorCode]
- set state(status) error
- }
+ if {[info exists state(-command)] && !$skipCB
+ && ![info exists state(done-command-cb)]} {
+ set state(done-command-cb) yes
+ if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
+ set state(error) [list $err $errorInfo $errorCode]
+ set state(status) error
}
- # Command callback may already have unset our state
- unset -nocomplain state(-command)
}
}
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 815ac12..0b5cdeb 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,4 +1,4 @@
# Tcl package index file, version 1.1
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.7.9 [list tclPkgSetup $dir http 2.7.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.7.10 [list tclPkgSetup $dir http 2.7.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]