1set ::global_overrides {} 2set ::tags {} 3set ::valgrind_errors {} 4 5proc 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 15proc 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 27proc 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 set output {0 leaks} 42 catch {exec leaks $pid} output 43 if {[string match {*process does not exist*} $output] || 44 [string match {*cannot examine*} $output]} { 45 # In a few tests we kill the server process. 46 set output "0 leaks" 47 } 48 set output 49 } {*0 leaks*} 50 } 51 } 52 } 53 } 54 55 # kill server and wait for the process to be totally exited 56 catch {exec kill $pid} 57 if {$::valgrind} { 58 set max_wait 60000 59 } else { 60 set max_wait 10000 61 } 62 while {[is_alive $config]} { 63 incr wait 10 64 65 if {$wait >= $max_wait} { 66 puts "Forcing process $pid to exit..." 67 catch {exec kill -KILL $pid} 68 } elseif {$wait % 1000 == 0} { 69 puts "Waiting for process $pid to exit..." 70 } 71 after 10 72 } 73 74 # Check valgrind errors if needed 75 if {$::valgrind} { 76 check_valgrind_errors [dict get $config stderr] 77 } 78 79 # Remove this pid from the set of active pids in the test server. 80 send_data_packet $::test_server_fd server-killed $pid 81} 82 83proc is_alive config { 84 set pid [dict get $config pid] 85 if {[catch {exec ps -p $pid} err]} { 86 return 0 87 } else { 88 return 1 89 } 90} 91 92proc ping_server {host port} { 93 set retval 0 94 if {[catch { 95 set fd [socket $host $port] 96 fconfigure $fd -translation binary 97 puts $fd "PING\r\n" 98 flush $fd 99 set reply [gets $fd] 100 if {[string range $reply 0 0] eq {+} || 101 [string range $reply 0 0] eq {-}} { 102 set retval 1 103 } 104 close $fd 105 } e]} { 106 if {$::verbose} { 107 puts -nonewline "." 108 } 109 } else { 110 if {$::verbose} { 111 puts -nonewline "ok" 112 } 113 } 114 return $retval 115} 116 117# Return 1 if the server at the specified addr is reachable by PING, otherwise 118# returns 0. Performs a try every 50 milliseconds for the specified number 119# of retries. 120proc server_is_up {host port retrynum} { 121 after 10 ;# Use a small delay to make likely a first-try success. 122 set retval 0 123 while {[incr retrynum -1]} { 124 if {[catch {ping_server $host $port} ping]} { 125 set ping 0 126 } 127 if {$ping} {return 1} 128 after 50 129 } 130 return 0 131} 132 133# doesn't really belong here, but highly coupled to code in start_server 134proc tags {tags code} { 135 set ::tags [concat $::tags $tags] 136 uplevel 1 $code 137 set ::tags [lrange $::tags 0 end-[llength $tags]] 138} 139 140proc start_server {options {code undefined}} { 141 # If we are running against an external server, we just push the 142 # host/port pair in the stack the first time 143 if {$::external} { 144 if {[llength $::servers] == 0} { 145 set srv {} 146 dict set srv "host" $::host 147 dict set srv "port" $::port 148 set client [redis $::host $::port] 149 dict set srv "client" $client 150 $client select 9 151 152 # append the server to the stack 153 lappend ::servers $srv 154 } 155 uplevel 1 $code 156 return 157 } 158 159 # setup defaults 160 set baseconfig "default.conf" 161 set overrides {} 162 set tags {} 163 164 # parse options 165 foreach {option value} $options { 166 switch $option { 167 "config" { 168 set baseconfig $value } 169 "overrides" { 170 set overrides $value } 171 "tags" { 172 set tags $value 173 set ::tags [concat $::tags $value] } 174 default { 175 error "Unknown option $option" } 176 } 177 } 178 179 set data [split [exec cat "tests/assets/$baseconfig"] "\n"] 180 set config {} 181 foreach line $data { 182 if {[string length $line] > 0 && [string index $line 0] ne "#"} { 183 set elements [split $line " "] 184 set directive [lrange $elements 0 0] 185 set arguments [lrange $elements 1 end] 186 dict set config $directive $arguments 187 } 188 } 189 190 # use a different directory every time a server is started 191 dict set config dir [tmpdir server] 192 193 # start every server on a different port 194 set ::port [find_available_port [expr {$::port+1}]] 195 dict set config port $::port 196 197 # apply overrides from global space and arguments 198 foreach {directive arguments} [concat $::global_overrides $overrides] { 199 dict set config $directive $arguments 200 } 201 202 # write new configuration to temporary file 203 set config_file [tmpfile redis.conf] 204 set fp [open $config_file w+] 205 foreach directive [dict keys $config] { 206 puts -nonewline $fp "$directive " 207 puts $fp [dict get $config $directive] 208 } 209 close $fp 210 211 set stdout [format "%s/%s" [dict get $config "dir"] "stdout"] 212 set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] 213 214 if {$::valgrind} { 215 set pid [exec valgrind --track-origins=yes --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &] 216 } elseif ($::stack_logging) { 217 set pid [exec /usr/bin/env MallocStackLogging=1 MallocLogFile=/tmp/malloc_log.txt src/redis-server $config_file > $stdout 2> $stderr &] 218 } else { 219 set pid [exec src/redis-server $config_file > $stdout 2> $stderr &] 220 } 221 222 # Tell the test server about this new instance. 223 send_data_packet $::test_server_fd server-spawned $pid 224 225 # check that the server actually started 226 # ugly but tries to be as fast as possible... 227 if {$::valgrind} {set retrynum 1000} else {set retrynum 100} 228 229 if {$::verbose} { 230 puts -nonewline "=== ($tags) Starting server ${::host}:${::port} " 231 } 232 233 if {$code ne "undefined"} { 234 set serverisup [server_is_up $::host $::port $retrynum] 235 } else { 236 set serverisup 1 237 } 238 239 if {$::verbose} { 240 puts "" 241 } 242 243 if {!$serverisup} { 244 set err {} 245 append err [exec cat $stdout] "\n" [exec cat $stderr] 246 start_server_error $config_file $err 247 return 248 } 249 250 # Wait for actual startup 251 while {![info exists _pid]} { 252 regexp {PID:\s(\d+)} [exec cat $stdout] _ _pid 253 after 100 254 } 255 256 # setup properties to be able to initialize a client object 257 set host $::host 258 set port $::port 259 if {[dict exists $config bind]} { set host [dict get $config bind] } 260 if {[dict exists $config port]} { set port [dict get $config port] } 261 262 # setup config dict 263 dict set srv "config_file" $config_file 264 dict set srv "config" $config 265 dict set srv "pid" $pid 266 dict set srv "host" $host 267 dict set srv "port" $port 268 dict set srv "stdout" $stdout 269 dict set srv "stderr" $stderr 270 271 # if a block of code is supplied, we wait for the server to become 272 # available, create a client object and kill the server afterwards 273 if {$code ne "undefined"} { 274 set line [exec head -n1 $stdout] 275 if {[string match {*already in use*} $line]} { 276 error_and_quit $config_file $line 277 } 278 279 if {$::wait_server} { 280 set msg "server started PID: [dict get $srv "pid"]. press any key to continue..." 281 puts $msg 282 read stdin 1 283 } 284 285 while 1 { 286 # check that the server actually started and is ready for connections 287 if {[exec grep -i "Ready to accept" | wc -l < $stdout] > 0} { 288 break 289 } 290 after 10 291 } 292 293 # append the server to the stack 294 lappend ::servers $srv 295 296 # connect client (after server dict is put on the stack) 297 reconnect 298 299 # execute provided block 300 set num_tests $::num_tests 301 if {[catch { uplevel 1 $code } error]} { 302 set backtrace $::errorInfo 303 304 # Kill the server without checking for leaks 305 dict set srv "skipleaks" 1 306 kill_server $srv 307 308 # Print warnings from log 309 puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]] 310 set warnings [warnings_from_file [dict get $srv "stdout"]] 311 if {[string length $warnings] > 0} { 312 puts "$warnings" 313 } else { 314 puts "(none)" 315 } 316 puts "" 317 318 error $error $backtrace 319 } 320 321 # Don't do the leak check when no tests were run 322 if {$num_tests == $::num_tests} { 323 dict set srv "skipleaks" 1 324 } 325 326 # pop the server object 327 set ::servers [lrange $::servers 0 end-1] 328 329 set ::tags [lrange $::tags 0 end-[llength $tags]] 330 kill_server $srv 331 } else { 332 set ::tags [lrange $::tags 0 end-[llength $tags]] 333 set _ $srv 334 } 335} 336