Fossil SCM
In fossil-stress.tcl, retry connection failures after a 1-second delay.
Commit
7ce35a048d450a78f41130f8348a7ed86973a5954be59230f8e78f84b3d4b1f9
Parent
08f5fb624124eaa…
1 file changed
+19
-14
+19
-14
| --- tools/fossil-stress.tcl | ||
| +++ tools/fossil-stress.tcl | ||
| @@ -33,24 +33,29 @@ | ||
| 33 | 33 | set path [string trimright $path /] |
| 34 | 34 | set port [string trimleft $port :] |
| 35 | 35 | if {$port==""} {set port 80} |
| 36 | 36 | |
| 37 | 37 | proc send_one_request {tid domain port path} { |
| 38 | - set x [socket $domain $port] | |
| 39 | - fconfigure $x -translation binary | |
| 40 | - puts $x "GET $path HTTP/1.0\r" | |
| 41 | - if {$port==80} { | |
| 42 | - puts $x "Host: $domain\r" | |
| 43 | - } else { | |
| 44 | - puts $x "Host: $domain:$port\r" | |
| 45 | - } | |
| 46 | - puts $x "User-Agent: $::useragent\r" | |
| 47 | - puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r" | |
| 48 | - puts $x "Accept-Language: en-US,en;q=0.5\r" | |
| 49 | - puts $x "Connection: close\r" | |
| 50 | - puts $x "\r" | |
| 51 | - flush $x | |
| 38 | + while {[catch { | |
| 39 | + set x [socket $domain $port] | |
| 40 | + fconfigure $x -translation binary | |
| 41 | + puts $x "GET $path HTTP/1.0\r" | |
| 42 | + if {$port==80} { | |
| 43 | + puts $x "Host: $domain\r" | |
| 44 | + } else { | |
| 45 | + puts $x "Host: $domain:$port\r" | |
| 46 | + } | |
| 47 | + puts $x "User-Agent: $::useragent\r" | |
| 48 | + puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r" | |
| 49 | + puts $x "Accept-Language: en-US,en;q=0.5\r" | |
| 50 | + puts $x "Connection: close\r" | |
| 51 | + puts $x "\r" | |
| 52 | + flush $x | |
| 53 | + } msg]} { | |
| 54 | + puts "ERROR: $msg" | |
| 55 | + after 1000 | |
| 56 | + } | |
| 52 | 57 | global cnt |
| 53 | 58 | set cnt($x) 0 |
| 54 | 59 | fconfigure $x -blocking 0 |
| 55 | 60 | fileevent $x readable [list get_reply $tid $path $x] |
| 56 | 61 | } |
| 57 | 62 |
| --- tools/fossil-stress.tcl | |
| +++ tools/fossil-stress.tcl | |
| @@ -33,24 +33,29 @@ | |
| 33 | set path [string trimright $path /] |
| 34 | set port [string trimleft $port :] |
| 35 | if {$port==""} {set port 80} |
| 36 | |
| 37 | proc send_one_request {tid domain port path} { |
| 38 | set x [socket $domain $port] |
| 39 | fconfigure $x -translation binary |
| 40 | puts $x "GET $path HTTP/1.0\r" |
| 41 | if {$port==80} { |
| 42 | puts $x "Host: $domain\r" |
| 43 | } else { |
| 44 | puts $x "Host: $domain:$port\r" |
| 45 | } |
| 46 | puts $x "User-Agent: $::useragent\r" |
| 47 | puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r" |
| 48 | puts $x "Accept-Language: en-US,en;q=0.5\r" |
| 49 | puts $x "Connection: close\r" |
| 50 | puts $x "\r" |
| 51 | flush $x |
| 52 | global cnt |
| 53 | set cnt($x) 0 |
| 54 | fconfigure $x -blocking 0 |
| 55 | fileevent $x readable [list get_reply $tid $path $x] |
| 56 | } |
| 57 |
| --- tools/fossil-stress.tcl | |
| +++ tools/fossil-stress.tcl | |
| @@ -33,24 +33,29 @@ | |
| 33 | set path [string trimright $path /] |
| 34 | set port [string trimleft $port :] |
| 35 | if {$port==""} {set port 80} |
| 36 | |
| 37 | proc send_one_request {tid domain port path} { |
| 38 | while {[catch { |
| 39 | set x [socket $domain $port] |
| 40 | fconfigure $x -translation binary |
| 41 | puts $x "GET $path HTTP/1.0\r" |
| 42 | if {$port==80} { |
| 43 | puts $x "Host: $domain\r" |
| 44 | } else { |
| 45 | puts $x "Host: $domain:$port\r" |
| 46 | } |
| 47 | puts $x "User-Agent: $::useragent\r" |
| 48 | puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r" |
| 49 | puts $x "Accept-Language: en-US,en;q=0.5\r" |
| 50 | puts $x "Connection: close\r" |
| 51 | puts $x "\r" |
| 52 | flush $x |
| 53 | } msg]} { |
| 54 | puts "ERROR: $msg" |
| 55 | after 1000 |
| 56 | } |
| 57 | global cnt |
| 58 | set cnt($x) 0 |
| 59 | fconfigure $x -blocking 0 |
| 60 | fileevent $x readable [list get_reply $tid $path $x] |
| 61 | } |
| 62 |