]> git.saurik.com Git - redis.git/blob - tests/support/server.tcl
More robust maxclients test.
[redis.git] / tests / support / server.tcl
1 set ::global_overrides {}
2 set ::tags {}
3 set ::valgrind_errors {}
4
5 proc start_server_error {config_file error} {
6 set err {}
7 append err "Cant' start the Redis server\n"
8 append err "CONFIGURATION:"
9 append err [exec cat $config_file]
10 append err "\nERROR:"
11 append err [string trim $error]
12 send_data_packet $::test_server_fd err $err
13 }
14
15 proc check_valgrind_errors stderr {
16 set fd [open $stderr]
17 set buf [read $fd]
18 close $fd
19
20 if {[regexp -- { at 0x} $buf] ||
21 (![regexp -- {definitely lost: 0 bytes} $buf] &&
22 ![regexp -- {no leaks are possible} $buf])} {
23 send_data_packet $::test_server_fd err "Valgrind error: $buf\n"
24 }
25 }
26
27 proc kill_server config {
28 # nothing to kill when running against external server
29 if {$::external} return
30
31 # nevermind if its already dead
32 if {![is_alive $config]} { return }
33 set pid [dict get $config pid]
34
35 # check for leaks
36 if {![dict exists $config "skipleaks"]} {
37 catch {
38 if {[string match {*Darwin*} [exec uname -a]]} {
39 tags {"leaks"} {
40 test "Check for memory leaks (pid $pid)" {
41 exec leaks $pid
42 } {*0 leaks*}
43 }
44 }
45 }
46 }
47
48 # kill server and wait for the process to be totally exited
49 catch {exec kill $pid}
50 while {[is_alive $config]} {
51 incr wait 10
52
53 if {$wait >= 5000} {
54 puts "Forcing process $pid to exit..."
55 catch {exec kill -KILL $pid}
56 } elseif {$wait % 1000 == 0} {
57 puts "Waiting for process $pid to exit..."
58 }
59 after 10
60 }
61
62 # Check valgrind errors if needed
63 if {$::valgrind} {
64 check_valgrind_errors [dict get $config stderr]
65 }
66 }
67
68 proc is_alive config {
69 set pid [dict get $config pid]
70 if {[catch {exec ps -p $pid} err]} {
71 return 0
72 } else {
73 return 1
74 }
75 }
76
77 proc ping_server {host port} {
78 set retval 0
79 if {[catch {
80 set fd [socket $::host $::port]
81 fconfigure $fd -translation binary
82 puts $fd "PING\r\n"
83 flush $fd
84 set reply [gets $fd]
85 if {[string range $reply 0 4] eq {+PONG} ||
86 [string range $reply 0 3] eq {-ERR}} {
87 set retval 1
88 }
89 close $fd
90 } e]} {
91 if {$::verbose} {
92 puts -nonewline "."
93 }
94 } else {
95 if {$::verbose} {
96 puts -nonewline "ok"
97 }
98 }
99 return $retval
100 }
101
102 # doesn't really belong here, but highly coupled to code in start_server
103 proc tags {tags code} {
104 set ::tags [concat $::tags $tags]
105 uplevel 1 $code
106 set ::tags [lrange $::tags 0 end-[llength $tags]]
107 }
108
109 proc start_server {options {code undefined}} {
110 # If we are runnign against an external server, we just push the
111 # host/port pair in the stack the first time
112 if {$::external} {
113 if {[llength $::servers] == 0} {
114 set srv {}
115 dict set srv "host" $::host
116 dict set srv "port" $::port
117 set client [redis $::host $::port]
118 dict set srv "client" $client
119 $client select 9
120
121 # append the server to the stack
122 lappend ::servers $srv
123 }
124 uplevel 1 $code
125 return
126 }
127
128 # setup defaults
129 set baseconfig "default.conf"
130 set overrides {}
131 set tags {}
132
133 # parse options
134 foreach {option value} $options {
135 switch $option {
136 "config" {
137 set baseconfig $value }
138 "overrides" {
139 set overrides $value }
140 "tags" {
141 set tags $value
142 set ::tags [concat $::tags $value] }
143 default {
144 error "Unknown option $option" }
145 }
146 }
147
148 set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
149 set config {}
150 foreach line $data {
151 if {[string length $line] > 0 && [string index $line 0] ne "#"} {
152 set elements [split $line " "]
153 set directive [lrange $elements 0 0]
154 set arguments [lrange $elements 1 end]
155 dict set config $directive $arguments
156 }
157 }
158
159 # use a different directory every time a server is started
160 dict set config dir [tmpdir server]
161
162 # start every server on a different port
163 set ::port [find_available_port [expr {$::port+1}]]
164 dict set config port $::port
165
166 # apply overrides from global space and arguments
167 foreach {directive arguments} [concat $::global_overrides $overrides] {
168 dict set config $directive $arguments
169 }
170
171 # write new configuration to temporary file
172 set config_file [tmpfile redis.conf]
173 set fp [open $config_file w+]
174 foreach directive [dict keys $config] {
175 puts -nonewline $fp "$directive "
176 puts $fp [dict get $config $directive]
177 }
178 close $fp
179
180 set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
181 set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
182
183 if {$::valgrind} {
184 exec valgrind --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &
185 } else {
186 exec src/redis-server $config_file > $stdout 2> $stderr &
187 }
188
189 # check that the server actually started
190 # ugly but tries to be as fast as possible...
191 if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
192 set serverisup 0
193
194 if {$::verbose} {
195 puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
196 }
197
198 after 10
199 if {$code ne "undefined"} {
200 while {[incr retrynum -1]} {
201 catch {
202 if {[ping_server $::host $::port]} {
203 set serverisup 1
204 }
205 }
206 if {$serverisup} break
207 after 50
208 }
209 } else {
210 set serverisup 1
211 }
212
213 if {$::verbose} {
214 puts ""
215 }
216
217 if {!$serverisup} {
218 set err {}
219 append err [exec cat $stdout] "\n" [exec cat $stderr]
220 start_server_error $config_file $err
221 return
222 }
223
224 # find out the pid
225 while {![info exists pid]} {
226 regexp {\[(\d+)\]} [exec cat $stdout] _ pid
227 after 100
228 }
229
230 # setup properties to be able to initialize a client object
231 set host $::host
232 set port $::port
233 if {[dict exists $config bind]} { set host [dict get $config bind] }
234 if {[dict exists $config port]} { set port [dict get $config port] }
235
236 # setup config dict
237 dict set srv "config_file" $config_file
238 dict set srv "config" $config
239 dict set srv "pid" $pid
240 dict set srv "host" $host
241 dict set srv "port" $port
242 dict set srv "stdout" $stdout
243 dict set srv "stderr" $stderr
244
245 # if a block of code is supplied, we wait for the server to become
246 # available, create a client object and kill the server afterwards
247 if {$code ne "undefined"} {
248 set line [exec head -n1 $stdout]
249 if {[string match {*already in use*} $line]} {
250 error_and_quit $config_file $line
251 }
252
253 while 1 {
254 # check that the server actually started and is ready for connections
255 if {[exec cat $stdout | grep "ready to accept" | wc -l] > 0} {
256 break
257 }
258 after 10
259 }
260
261 # append the server to the stack
262 lappend ::servers $srv
263
264 # connect client (after server dict is put on the stack)
265 reconnect
266
267 # execute provided block
268 set num_tests $::num_tests
269 if {[catch { uplevel 1 $code } error]} {
270 set backtrace $::errorInfo
271
272 # Kill the server without checking for leaks
273 dict set srv "skipleaks" 1
274 kill_server $srv
275
276 # Print warnings from log
277 puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]]
278 set warnings [warnings_from_file [dict get $srv "stdout"]]
279 if {[string length $warnings] > 0} {
280 puts "$warnings"
281 } else {
282 puts "(none)"
283 }
284 puts ""
285
286 error $error $backtrace
287 }
288
289 # Don't do the leak check when no tests were run
290 if {$num_tests == $::num_tests} {
291 dict set srv "skipleaks" 1
292 }
293
294 # pop the server object
295 set ::servers [lrange $::servers 0 end-1]
296
297 set ::tags [lrange $::tags 0 end-[llength $tags]]
298 kill_server $srv
299 } else {
300 set ::tags [lrange $::tags 0 end-[llength $tags]]
301 set _ $srv
302 }
303 }