From 3fa8112c7afe69df643dcccb9570e698f2173da4 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Fri, 2 Sep 2022 17:02:56 +0000
Subject: really closes [2641672fff] - resolved timing sensitivity of
 httpold-4.12 and speed-up all httpd depending tests (removed 50ms delay
 unneeded in other cases)

---
 tests/httpd        |  6 +++++-
 tests/httpold.test | 19 +++++++++++++------
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/tests/httpd b/tests/httpd
index 3cf2170..9fd23e7 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -45,7 +45,7 @@ proc httpdAccept {newsock ipaddr port} {
     fconfigure $newsock -blocking 0 -translation {auto crlf}
     httpd_log $newsock Connect $ipaddr $port
     set data(ipaddr) $ipaddr
-    after 50 [list fileevent $newsock readable [list httpdRead $newsock]]
+    fileevent $newsock readable [list httpdRead $newsock]
 }
 
 # read data from a client request
@@ -69,6 +69,10 @@ proc httpdRead { sock } {
 	    httpd_log $sock Error "bad first line:$line"
 	    httpdSockDone $sock
 	}
+	if {[regexp {[\?&]delay=([^&]+)} val]} {
+	    fileevent $sock readable {}
+	    after $val [list fileevent $sock readable [list httpdRead $sock]]
+	}
 	return
     } elseif {$data(state) == "mime"} {
 
diff --git a/tests/httpold.test b/tests/httpold.test
index e43a550..439ce92 100644
--- a/tests/httpold.test
+++ b/tests/httpold.test
@@ -256,14 +256,21 @@ test httpold-4.11 {httpEvent} {
     http_reset $token
     http_status $token
 } {reset}
-test httpold-4.12 {httpEvent See [2641672]} knownBug {
+test httpold-4.12 {httpEvent} -body {
+    set tout {}
     update
     set x {}
-    after 500 {lappend x ok}
-    set token [http_get $url -timeout 1 -command {lappend x fail}]
-    vwait x
-    list [http_status $token] $x
-} {timeout ok}
+    set token [http_get $url -query delay=500 -timeout 1 -command {lappend x fail}]
+    set i 0; while {$x eq {} && [incr i] < 50} {
+	set tout [after 20 {set x progress}]
+	vwait x
+	if {$x ne "progress"} break
+	set x [http_status $token]
+    }
+    set x
+} -cleanup {
+    if {$tout ne {}} {after cancel $tout}
+} -result timeout
 
 test httpold-5.1 {http_formatQuery} {
     http_formatQuery name1 value1 name2 "value two"
-- 
cgit v0.12


From 337b5ab155b13596235bd36549efe9673cc6c7c9 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Fri, 2 Sep 2022 17:17:53 +0000
Subject: amend to [2641672fff], guarantees a delay to cause a timeout
 definitely + switch delay-argument from post to get (it expects delay in
 query string of url)

---
 tests/httpd        | 2 +-
 tests/httpold.test | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/httpd b/tests/httpd
index 9fd23e7..682556b 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -69,7 +69,7 @@ proc httpdRead { sock } {
 	    httpd_log $sock Error "bad first line:$line"
 	    httpdSockDone $sock
 	}
-	if {[regexp {[\?&]delay=([^&]+)} val]} {
+	if {[regexp {(?:^|[\?&])delay=([^&]+)} $data(query) {} val]} {
 	    fileevent $sock readable {}
 	    after $val [list fileevent $sock readable [list httpdRead $sock]]
 	}
diff --git a/tests/httpold.test b/tests/httpold.test
index 439ce92..e760c92 100644
--- a/tests/httpold.test
+++ b/tests/httpold.test
@@ -260,7 +260,7 @@ test httpold-4.12 {httpEvent} -body {
     set tout {}
     update
     set x {}
-    set token [http_get $url -query delay=500 -timeout 1 -command {lappend x fail}]
+    set token [http_get $url?delay=500 -timeout 1 -command {lappend x fail}]
     set i 0; while {$x eq {} && [incr i] < 50} {
 	set tout [after 20 {set x progress}]
 	vwait x
-- 
cgit v0.12


From df50b9ade238e19ef27748a4a037b384d70bdf0a Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Mon, 5 Sep 2022 10:30:34 +0000
Subject: closes [2641672fff], httpd - don't parse delay argument by error 400
 (wrong URI/proto)

---
 tests/httpd | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/tests/httpd b/tests/httpd
index 682556b..48e14ea 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -64,15 +64,15 @@ proc httpdRead { sock } {
 		-> data(proto) data(url) data(query) data(httpversion)]} {
 	    set data(state) mime
 	    httpd_log $sock Query $line
+	    if {[regexp {(?:^|[\?&])delay=([^&]+)} $data(query) {} val]} {
+		fileevent $sock readable {}
+		after $val [list fileevent $sock readable [list httpdRead $sock]]
+	    }
 	} else {
 	    httpdError $sock 400
 	    httpd_log $sock Error "bad first line:$line"
 	    httpdSockDone $sock
 	}
-	if {[regexp {(?:^|[\?&])delay=([^&]+)} $data(query) {} val]} {
-	    fileevent $sock readable {}
-	    after $val [list fileevent $sock readable [list httpdRead $sock]]
-	}
 	return
     } elseif {$data(state) == "mime"} {
 
-- 
cgit v0.12