Tcl Source Code

View Ticket
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki
Attach Edit New Ticket Plaintext
Ticket UUID: 6ca52aec14e0b33543d3cd9895f060b852ac4dbc
Title: HTTP package: Memory leak if client requests "Connection: close" but server responses with "Connection: keep-alive"
Type: Bug Version: HTTP package 2.7.10 and 2.8.5
Submitter: anonymous Created on: 2015-07-17 05:23:22
Subsystem: 29. http Package Assigned To: jan.nijtmans
Priority: 5 Medium Severity: Minor
Status: Closed Last Modified: 2017-05-19 15:10:11
Resolution: Fixed Closed By: aspect
    Closed on: 2017-05-19 15:10:11
Description: 
Hello,
The 'geturl' command of the 'http' package does not free up properly the used variables if geturl if a GET request is made and the '-keepalive' option is not used ('Connection: close' is transmitted), but if the server responses (by mistake) with 'Connection: keep-alive'.

After running 10 times ...

   set Handle [::http::geturl "http://localhost:8080/c"]
   puts "$k:\n  Handle:$Handle\n  Status: [::http::status $Handle]\n  Data: [http::data $Handle]"
   ::http::cleanup $Handle

... and having the server responding with 'Connection: keep-alive' the following variables will be defined in the http namespace (info vars http::*):

   ::http::http ::http::urlTypes ::http::1 ::http::encodings ::http::2 ::http::3 ::http::4 ::http::5 ::http::6 ::http::7 ::http::8 ::http::9 ::http::strict ::http::formMap ::http::defaultKeepalive ::http::socketmap ::http::defaultCharset

The variables 1..9 are the temporary variables that should be deleted with the 'http::cleanup' command.

Below there is a test case composed by 2 parts (files):

* HTTP server: It opens and listens the local port 8080. It accepts 3 requests (http://localhost:8080/a, http://localhost:8080/b, http://localhost:8080/c) that are responded in 3 different ways: Request 'a' will not return any 'Connection' attribute, request 'b' will return 'Connection: close', and request 'c' will return 'Connection: keep-alive'.
* HTTP client: It performs for each of the 3 requests accepted by the HTTP server 10 requests. After each request the variables in the 'http' namespace are printed.

------------------------- File 'Run MemoryLeak_TestCase_Server.tcl' -------------------------

namespace eval HttpServer {
	proc Start {port} {
		puts "HttpServer::Start $port"
		set Server [socket -server [namespace current]::Accept $port]
	}

	proc Accept {sock host port} {
		puts "HttpServer::Accept $sock $host $port"
		fconfigure $sock -blocking 0 -buffering none
		fileevent $sock readable [list [namespace current]::Handle $sock]
	}

	proc Handle {Socket} {
		puts "HttpServer::Handle $Socket"
		if {[eof $Socket]} {
			puts "  eof->close socket"
			close $Socket
			return
		}

		puts "  Read data"
		set Data [read $Socket]
		regexp -line {^(.*)$} $Data {} FirstLine
		regsub -all -line {^} $Data {   -> } Data
		puts $Data

		if {[regexp {GET /(.*) HTTP/1.1} $FirstLine {} GetArgs]} {
			puts "  GetArgs:$GetArgs"
			puts "  Return data"
			if {$GetArgs=="a"} {
				puts $Socket "HTTP/1.1 200 OK"
				puts $Socket "Content-length: 31"
				puts $Socket ""
				puts $Socket "Data received on [clock seconds] - a"
			} elseif {$GetArgs=="b"} {
				puts $Socket "HTTP/1.1 200 OK"
				puts $Socket "Content-length: 31"
				puts $Socket "Connection: close"
				puts $Socket ""
				puts $Socket "Data received on [clock seconds] - b"
			} elseif {$GetArgs=="c"} {
				puts $Socket "HTTP/1.1 200 OK"
				puts $Socket "Content-length: 31"
				puts $Socket "Connection: keep-alive"
				puts $Socket ""
				puts $Socket "Data received on [clock seconds] - c"
			} else {
				puts $Socket "HTTP/1.1 404 not found"
				puts $Socket ""
				puts $Socket "<html><h1>404 - Not found '$GetArgs'</h1></html>"
			}
		} else {
			puts $Socket "HTTP/1.1 400 bad request"
			puts $Socket ""
			puts $Socket "<html><h1>400 - Bad request</h1></html>"
		}

		puts "  Close socket $Socket"
		close $Socket
	}
}; # end namespace HttpServer

HttpServer::Start 8080

------------------------- File 'Run MemoryLeak_TestCase_Client.tcl' -------------------------

package require http
# source ./http-2.8.5.tm

proc ListVarHttp {} {
	puts "HttpVars([llength [info vars http::*]]): [info vars http::*]"
}

ListVarHttp

puts "GetUrl http://localhost:8080/a"
for {set k 0} {$k<10} {incr k} {
	set Handle [::http::geturl "http://localhost:8080/a"]
	puts "$k:\n  Handle:$Handle\n  Status: [::http::status $Handle]\n  Data: [http::data $Handle]"
	::http::cleanup $Handle

	ListVarHttp
}

puts "GetUrl http://localhost:8080/b"
for {set k 0} {$k<10} {incr k} {
	set Handle [::http::geturl "http://localhost:8080/b"]
	puts "$k:\n  Handle:$Handle\n  Status: [::http::status $Handle]\n  Data: [http::data $Handle]"
	::http::cleanup $Handle

	ListVarHttp
}

puts "GetUrl http://localhost:8080/c"
for {set k 0} {$k<10} {incr k} {
	set Handle [::http::geturl "http://localhost:8080/c"]
	puts "$k:\n  Handle:$Handle\n  Status: [::http::status $Handle]\n  Data: [http::data $Handle]"
	::http::cleanup $Handle

	ListVarHttp
}
User Comments: aspect added on 2017-05-19 15:10:11: 
Emiliano reported in the chat a test failure on netbsd of http-4.16 (introduced by [8d81ec63d5d] but incorrectly called http-1.15).

I can't see how it's failing, but in any case the test doesn't do what it says on the tin:  -headers {X-Connection keep-alive}  just gets echoed back by tests/httpd (with "X-" intact), and in any case it closes the socket immediately.

Test httpd-4.16 is useless, and I suggest simply removing it - the alternative is to rework tests/httpd to support keepalive, which is both more effort and liable to cause more rework.
jan.nijtmans added on 2017-05-09 11:31:57: 
Fixed in core-8-6-branch and trunk.
aspect added on 2017-02-12 13:02:48: 
patch pushed to branch [bug-0520d17284].

8.6 only - the channel leak did not disappear when I tried it on 8.5; perhaps a deeper problem there since I don't think 8.5 has proper HTTP/1.1 support (?).
anonymous added on 2015-08-19 19:38:13: 
Small correction of the test script provided by 'aspect' on 2015-07-20 04:15:57: The socket opening loop should be:

set port 8080
while {[catch {socket -server {go accept} $port} server]} {
    incr port }

But the proposed fix works well.
anonymous added on 2015-07-20 15:35:13: 
The patch suggested by 'aspect' on 2015-07-20 04:15:57 corrects the memory leakage issue of the http package versions 2.7.10 and 2.8.5.

Since the http package 2.8(.5) requires Tcl version 8.6 it would be good to patch also the http package 2.7(.10). This allows using a corrected http package also with Tcl 8.5.
aspect added on 2015-07-20 04:15:57: 
The following attempts to test more concisely:

----
package require http
#source patch.tcl
package require coroutine

proc go {args} {
    tailcall coroutine ::goro#[llength [info commands ::goro#*]] {*}$args
}

proc accept {chan host port} {
    fconfigure $chan -blocking 0 -buffering none
    fileevent $chan readable [info coroutine]
    catch {
        while {![eof $chan]} {
            while {[coroutine::util gets $chan header] > 0} {
                # discard headers
            }
            foreach line {
                "HTTP/1.1 200 OK"
                "Connection: keep-alive"
                "Content-length: 15"
                ""
                "<html></html>"
            } {
                puts $chan $line
            }
        }
    }
    puts "$chan returning"
    catch {close $chan}
}

set port 8080
while {[catch {socket -server {go accept} 8080} server]} {
    incr port
}
puts "listening on $port"

set before [list [info vars ::http::*] [chan names]]
set tok [::http::geturl http://localhost:$port/c]
::http::cleanup $tok
update  ;# allow events to complete
set after [list [info vars ::http::*] [chan names]]
if {$before eq $after} {} else {
    puts "ERROR: before $before"
    puts "ERROR: after  $after"
}
----

A possible fix appears to be in ::http::Finish, checking that state(-keepalive) exists and is true before testing state(connection):

----
--- library/http/http.tcl       2015-07-02 13:15:03.723694211 +1000
+++ library/http/http.tcl.patched       2015-07-20 14:13:43.063724688 +1000
@@ -197,9 +197,10 @@
        set state(error) [list $errormsg $errorInfo $errorCode]
        set state(status) "error"
     }
-    if {
-       ($state(status) eq "timeout") || ($state(status) eq "error") ||
-       ([info exists state(connection)] && ($state(connection) eq "close"))
+    if { ($state(status) eq "timeout") 
+       || ($state(status) eq "error")
+       || ([info exists state(-keepalive)] && !$state(-keepalive))
+       || ([info exists state(connection)] && ($state(connection) eq "close"))
     } {
         CloseSocket $state(sock) $token
     }
----
This page was generated in about 0.011s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19