Fossil

Check-in [1fae64de]
Login

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
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 1fae64de38a02e955e01b018b2432153b87af680bed2d63a6e1817efc717f333
User & Date: drh 2017-12-28 17:20:14.456
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
Unified Diff Ignore Whitespace Patch
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

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 {








|







|











<




|

>
>
|


>
>
>
>
>
>
>
>






|
<








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

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 {
︙︙
106
107
108
109
110
111
112




















113
114
115
116

  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








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





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

  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