Fossil SCM

Add the "--threads N" option to the fossil-stress.tcl script. Default value is 10.

drh 2017-12-28 15:49 trunk
Commit 08f5fb624124eaa88499d8d5b65db24e8f1e8399ba9ea297a24909b4af5ccc6f
Parent 0a6d8ff505faea0…
1 file changed +49 -19
~ tools/fossil-stress.tcl
M tools/fossil-stress.tcl
+49 -19
--- tools/fossil-stress.tcl
+++ tools/fossil-stress.tcl
@@ -3,13 +3,29 @@
33
 # Run this script, giving the url of a Fossil server instances as the
44
 # argument, and this script will start sending HTTP requests into the
55
 # that server instance as fast as it can, as a stress test for the
66
 # server implementation.
77
 #
8
-set url [lindex $argv 0]
9
-if {$url==""} {
10
- error "Usage: $argv0 URL"
8
+set nthread 10
9
+for {set i 0} {$i<[llength $argv]} {incr i} {
10
+ set x [lindex $argv $i]
11
+ if {[regexp {^--[a-z]} $x]} {
12
+ set x [string range $x 1 end]
13
+ }
14
+ if {$x=="-threads"} {
15
+ incr i
16
+ set nthread [lindex $argv $i]
17
+ } elseif {[string index $x 0]=="-"} {
18
+ error "unknown option \"$x\""
19
+ } elseif {[info exists url]} {
20
+ error "unknown argment \"$x\""
21
+ } else {
22
+ set url $x
23
+ }
24
+}
25
+if {![info exists url]} {
26
+ error "Usage: $argv0 [-threads N] URL"
1127
 }
1228
 if {![regexp {^https?://([^/:]+)(:\d+)?(/.*)$} $url all domain port path]} {
1329
 error "could not parse the URL [list $url] -- should be of the\
1430
 form \"http://domain/path\""
1531
 }
@@ -16,11 +32,11 @@
1632
 set useragent {Mozilla/5.0 (X11; Linux x86_64; rv:57.0) Gecko/20100101 Firefox/57.0}
1733
 set path [string trimright $path /]
1834
 set port [string trimleft $port :]
1935
 if {$port==""} {set port 80}
2036
21
-proc send_one_request {domain port path} {
37
+proc send_one_request {tid domain port path} {
2238
 set x [socket $domain $port]
2339
 fconfigure $x -translation binary
2440
 puts $x "GET $path HTTP/1.0\r"
2541
 if {$port==80} {
2642
 puts $x "Host: $domain\r"
@@ -31,16 +47,27 @@
3147
 puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r"
3248
 puts $x "Accept-Language: en-US,en;q=0.5\r"
3349
 puts $x "Connection: close\r"
3450
 puts $x "\r"
3551
 flush $x
36
- set cnt 0
37
- while {![eof $x]} {
38
- incr cnt [string length [read $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
+
58
+proc get_reply {tid info x} {
59
+ global cnt
60
+ if {[eof $x]} {
61
+ puts "[format %3d: $tid] $info ($cnt($x) bytes)"
62
+ flush stdout
63
+ close $x
64
+ unset cnt($x)
65
+ start_another_request $tid
66
+ } else {
67
+ incr cnt($x) [string length [read $x]]
3968
 }
40
- close $x
41
- return $cnt
4269
 }
4370
4471
 set pages {
4572
 /timeline?n=20
4673
 /timeline?n=20&a=1970-01-01
@@ -67,15 +94,18 @@
6794
 /test-all-help
6895
 /timewarps
6996
 /taglist
7097
 }
7198
72
-set cnt 0
73
-while {1} {
74
- foreach p $pages {
75
- incr cnt
76
- puts -nonewline "$cnt: $path$p... "
77
- flush stdout
78
- set n [send_one_request $domain $port $path$p]
79
- puts "$n bytes"
80
- }
81
-}
99
+set pageidx 0
100
+proc start_another_request {tid} {
101
+ global pages pageidx domain port path
102
+ set p [lindex $pages $pageidx]
103
+ incr pageidx
104
+ if {$pageidx>=[llength $pages]} {set pageidx 0}
105
+ send_one_request $tid $domain $port $path$p
106
+}
107
+
108
+for {set i 1} {$i<=$nthread} {incr i} {
109
+ start_another_request $i
110
+}
111
+vwait forever
82112
--- tools/fossil-stress.tcl
+++ tools/fossil-stress.tcl
@@ -3,13 +3,29 @@
3 # Run this script, giving the url of a Fossil server instances as the
4 # argument, and this script will start sending HTTP requests into the
5 # that server instance as fast as it can, as a stress test for the
6 # server implementation.
7 #
8 set url [lindex $argv 0]
9 if {$url==""} {
10 error "Usage: $argv0 URL"
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
11 }
12 if {![regexp {^https?://([^/:]+)(:\d+)?(/.*)$} $url all domain port path]} {
13 error "could not parse the URL [list $url] -- should be of the\
14 form \"http://domain/path\""
15 }
@@ -16,11 +32,11 @@
16 set useragent {Mozilla/5.0 (X11; Linux x86_64; rv:57.0) Gecko/20100101 Firefox/57.0}
17 set path [string trimright $path /]
18 set port [string trimleft $port :]
19 if {$port==""} {set port 80}
20
21 proc send_one_request {domain port path} {
22 set x [socket $domain $port]
23 fconfigure $x -translation binary
24 puts $x "GET $path HTTP/1.0\r"
25 if {$port==80} {
26 puts $x "Host: $domain\r"
@@ -31,16 +47,27 @@
31 puts $x "Accept: text/html,q=0.9,*/*;q=0.8\r"
32 puts $x "Accept-Language: en-US,en;q=0.5\r"
33 puts $x "Connection: close\r"
34 puts $x "\r"
35 flush $x
36 set cnt 0
37 while {![eof $x]} {
38 incr cnt [string length [read $x]]
 
 
 
 
 
 
 
 
 
 
 
 
 
39 }
40 close $x
41 return $cnt
42 }
43
44 set pages {
45 /timeline?n=20
46 /timeline?n=20&a=1970-01-01
@@ -67,15 +94,18 @@
67 /test-all-help
68 /timewarps
69 /taglist
70 }
71
72 set cnt 0
73 while {1} {
74 foreach p $pages {
75 incr cnt
76 puts -nonewline "$cnt: $path$p... "
77 flush stdout
78 set n [send_one_request $domain $port $path$p]
79 puts "$n bytes"
80 }
81 }
 
 
 
82
--- tools/fossil-stress.tcl
+++ tools/fossil-stress.tcl
@@ -3,13 +3,29 @@
3 # Run this script, giving the url of a Fossil server instances as the
4 # argument, and this script will start sending HTTP requests into the
5 # that server instance as fast as it can, as a stress test for the
6 # server implementation.
7 #
8 set nthread 10
9 for {set i 0} {$i<[llength $argv]} {incr i} {
10 set x [lindex $argv $i]
11 if {[regexp {^--[a-z]} $x]} {
12 set x [string range $x 1 end]
13 }
14 if {$x=="-threads"} {
15 incr i
16 set nthread [lindex $argv $i]
17 } elseif {[string index $x 0]=="-"} {
18 error "unknown option \"$x\""
19 } elseif {[info exists url]} {
20 error "unknown argment \"$x\""
21 } else {
22 set url $x
23 }
24 }
25 if {![info exists url]} {
26 error "Usage: $argv0 [-threads N] URL"
27 }
28 if {![regexp {^https?://([^/:]+)(:\d+)?(/.*)$} $url all domain port path]} {
29 error "could not parse the URL [list $url] -- should be of the\
30 form \"http://domain/path\""
31 }
@@ -16,11 +32,11 @@
32 set useragent {Mozilla/5.0 (X11; Linux x86_64; rv:57.0) Gecko/20100101 Firefox/57.0}
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"
@@ -31,16 +47,27 @@
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
58 proc get_reply {tid info x} {
59 global cnt
60 if {[eof $x]} {
61 puts "[format %3d: $tid] $info ($cnt($x) bytes)"
62 flush stdout
63 close $x
64 unset cnt($x)
65 start_another_request $tid
66 } else {
67 incr cnt($x) [string length [read $x]]
68 }
 
 
69 }
70
71 set pages {
72 /timeline?n=20
73 /timeline?n=20&a=1970-01-01
@@ -67,15 +94,18 @@
94 /test-all-help
95 /timewarps
96 /taglist
97 }
98
99 set pageidx 0
100 proc start_another_request {tid} {
101 global pages pageidx domain port path
102 set p [lindex $pages $pageidx]
103 incr pageidx
104 if {$pageidx>=[llength $pages]} {set pageidx 0}
105 send_one_request $tid $domain $port $path$p
106 }
107
108 for {set i 1} {$i<=$nthread} {incr i} {
109 start_another_request $i
110 }
111 vwait forever
112

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button