Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Improvements to the fossil-stress.tcl script to automaticall restart stalled request threads. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
1fae64de38a02e955e01b018b2432153 |
| User & Date: | drh 2017-12-28 17:20:14 |
Context
|
2017-12-28
| ||
| 20:37 | Improvements to "fossil server" performance on Windows. check-in: 47ade67e user: drh tags: trunk | |
| 17:20 | Improvements to the fossil-stress.tcl script to automaticall restart stalled request threads. check-in: 1fae64de user: drh tags: trunk | |
| 17:16 | In the Win32 server code, prevent fclose() from being called on an already closed FILE. check-in: 8d60cd57 user: mistachkin tags: trunk | |
Changes
Changes to tools/fossil-stress.tcl.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
106
107
108
109
110
111
112
113
114
115
116
|
if {![info exists url]} {
error "Usage: $argv0 [-threads N] URL"
}
if {![regexp {^https?://([^/:]+)(:\d+)?(/.*)$} $url all domain port path]} {
error "could not parse the URL [list $url] -- should be of the\
form \"http://domain/path\""
}
set useragent {Mozilla/5.0 (X11; Linux x86_64; rv:57.0) Gecko/20100101 Firefox/57.0}
set path [string trimright $path /]
set port [string trimleft $port :]
if {$port==""} {set port 80}
proc send_one_request {tid domain port path} {
while {[catch {
set x [socket $domain $port]
fconfigure $x -translation binary
puts $x "GET $path HTTP/1.0\r"
if {$port==80} {
puts $x "Host: $domain\r"
} else {
puts $x "Host: $domain:$port\r"
}
puts $x "User-Agent: $::useragent\r"
puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r"
puts $x "Accept-Language: en-US,en;q=0.5\r"
puts $x "Connection: close\r"
puts $x "\r"
flush $x
} msg]} {
puts "ERROR: $msg"
after 1000
}
global cnt
set cnt($x) 0
fconfigure $x -blocking 0
fileevent $x readable [list get_reply $tid $path $x]
}
proc get_reply {tid info x} {
global cnt
if {[eof $x]} {
puts "[format %3d: $tid] $info ($cnt($x) bytes)"
flush stdout
close $x
unset cnt($x)
start_another_request $tid
} else {
incr cnt($x) [string length [read $x]]
}
}
set pages {
................................................................................
global pages pageidx domain port path
set p [lindex $pages $pageidx]
incr pageidx
if {$pageidx>=[llength $pages]} {set pageidx 0}
send_one_request $tid $domain $port $path$p
}
for {set i 1} {$i<=$nthread} {incr i} {
start_another_request $i
}
vwait forever
|
|
|
<
|
|
>
>
>
>
>
>
>
>
>
>
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
if {![info exists url]} {
error "Usage: $argv0 [-threads N] URL"
}
if {![regexp {^https?://([^/:]+)(:\d+)?(/.*)$} $url all domain port path]} {
error "could not parse the URL [list $url] -- should be of the\
form \"http://domain/path\""
}
set useragent {Mozilla/5.0 (fossil-stress.tcl) Gecko/20100101 Firefox/57.0}
set path [string trimright $path /]
set port [string trimleft $port :]
if {$port==""} {set port 80}
proc send_one_request {tid domain port path} {
while {[catch {
set x [socket $domain $port]
fconfigure $x -translation binary -blocking 0
puts $x "GET $path HTTP/1.0\r"
if {$port==80} {
puts $x "Host: $domain\r"
} else {
puts $x "Host: $domain:$port\r"
}
puts $x "User-Agent: $::useragent\r"
puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r"
puts $x "Accept-Language: en-US,en;q=0.5\r"
puts $x "Connection: close\r"
puts $x "\r"
} msg]} {
puts "ERROR: $msg"
after 1000
}
global cnt stime threadid
set cnt($x) 0
set stime($x) [clock seconds]
set threadid($x) $tid
flush $x
fileevent $x readable [list get_reply $tid $path $x]
}
proc close_connection {x} {
global cnt stime tid
close $x
unset -nocomplain cnt($x)
unset -nocomplain stime($x)
unset -nocomplain threadid($x)
}
proc get_reply {tid info x} {
global cnt
if {[eof $x]} {
puts "[format %3d: $tid] $info ($cnt($x) bytes)"
flush stdout
close_connection $x
start_another_request $tid
} else {
incr cnt($x) [string length [read $x]]
}
}
set pages {
................................................................................
global pages pageidx domain port path
set p [lindex $pages $pageidx]
incr pageidx
if {$pageidx>=[llength $pages]} {set pageidx 0}
send_one_request $tid $domain $port $path$p
}
proc unhang_stalled_threads {} {
global stime threadid
set now [clock seconds]
# puts "checking for stalled threads...."
foreach x [array names stime] {
# puts -nonewline " $threadid($x)=[expr {$now-$stime($x)}]"
if {$stime($x)+0<$now-10} {
set t $threadid($x)
puts "RESTART thread $t"
flush stdout
close_connection $x
start_another_request $t
}
}
# puts ""
flush stdout
after 10000 unhang_stalled_threads
}
unhang_stalled_threads
for {set i 1} {$i<=$nthread} {incr i} {
start_another_request $i
}
vwait forever
|