1set ::global_overrides {} 2set ::tags {} 3set ::valgrind_errors {} 4 5proc start_server_error {config_file error} { 6 set err {} 7 append err "Can't 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 res [find_valgrind_errors $stderr] 17 if {$res != ""} { 18 send_data_packet $::test_server_fd err "Valgrind error: $res\n" 19 } 20} 21 22proc clean_persistence config { 23 # we may wanna keep the logs for later, but let's clean the persistence 24 # files right away, since they can accumulate and take up a lot of space 25 set config [dict get $config "config"] 26 set rdb [format "%s/%s" [dict get $config "dir"] "dump.rdb"] 27 set aof [format "%s/%s" [dict get $config "dir"] "appendonly.aof"] 28 catch {exec rm -rf $rdb} 29 catch {exec rm -rf $aof} 30} 31 32proc kill_server config { 33 # nothing to kill when running against external server 34 if {$::external} return 35 36 # nevermind if its already dead 37 if {![is_alive $config]} { 38 # Check valgrind errors if needed 39 if {$::valgrind} { 40 check_valgrind_errors [dict get $config stderr] 41 } 42 return 43 } 44 set pid [dict get $config pid] 45 46 # check for leaks 47 if {![dict exists $config "skipleaks"]} { 48 catch { 49 if {[string match {*Darwin*} [exec uname -a]]} { 50 tags {"leaks"} { 51 test "Check for memory leaks (pid $pid)" { 52 set output {0 leaks} 53 catch {exec leaks $pid} output 54 if {[string match {*process does not exist*} $output] || 55 [string match {*cannot examine*} $output]} { 56 # In a few tests we kill the server process. 57 set output "0 leaks" 58 } 59 set output 60 } {*0 leaks*} 61 } 62 } 63 } 64 } 65 66 # kill server and wait for the process to be totally exited 67 send_data_packet $::test_server_fd server-killing $pid 68 catch {exec kill $pid} 69 if {$::valgrind} { 70 set max_wait 60000 71 } else { 72 set max_wait 10000 73 } 74 while {[is_alive $config]} { 75 incr wait 10 76 77 if {$wait >= $max_wait} { 78 puts "Forcing process $pid to exit..." 79 catch {exec kill -KILL $pid} 80 } elseif {$wait % 1000 == 0} { 81 puts "Waiting for process $pid to exit..." 82 } 83 after 10 84 } 85 86 # Check valgrind errors if needed 87 if {$::valgrind} { 88 check_valgrind_errors [dict get $config stderr] 89 } 90 91 # Remove this pid from the set of active pids in the test server. 92 send_data_packet $::test_server_fd server-killed $pid 93} 94 95proc is_alive config { 96 set pid [dict get $config pid] 97 if {[catch {exec kill -0 $pid} err]} { 98 return 0 99 } else { 100 return 1 101 } 102} 103 104proc ping_server {host port} { 105 set retval 0 106 if {[catch { 107 if {$::tls} { 108 set fd [::tls::socket $host $port] 109 } else { 110 set fd [socket $host $port] 111 } 112 fconfigure $fd -translation binary 113 puts $fd "PING\r\n" 114 flush $fd 115 set reply [gets $fd] 116 if {[string range $reply 0 0] eq {+} || 117 [string range $reply 0 0] eq {-}} { 118 set retval 1 119 } 120 close $fd 121 } e]} { 122 if {$::verbose} { 123 puts -nonewline "." 124 } 125 } else { 126 if {$::verbose} { 127 puts -nonewline "ok" 128 } 129 } 130 return $retval 131} 132 133# Return 1 if the server at the specified addr is reachable by PING, otherwise 134# returns 0. Performs a try every 50 milliseconds for the specified number 135# of retries. 136proc server_is_up {host port retrynum} { 137 after 10 ;# Use a small delay to make likely a first-try success. 138 set retval 0 139 while {[incr retrynum -1]} { 140 if {[catch {ping_server $host $port} ping]} { 141 set ping 0 142 } 143 if {$ping} {return 1} 144 after 50 145 } 146 return 0 147} 148 149# doesn't really belong here, but highly coupled to code in start_server 150proc tags {tags code} { 151 # If we 'tags' contain multiple tags, quoted and seperated by spaces, 152 # we want to get rid of the quotes in order to have a proper list 153 set tags [string map { \" "" } $tags] 154 set ::tags [concat $::tags $tags] 155 # We skip unwanted tags 156 foreach tag $::denytags { 157 if {[lsearch $::tags $tag] >= 0} { 158 incr ::num_aborted 159 send_data_packet $::test_server_fd ignore "Tag: $tag" 160 set ::tags [lrange $::tags 0 end-[llength $tags]] 161 return 162 } 163 } 164 uplevel 1 $code 165 set ::tags [lrange $::tags 0 end-[llength $tags]] 166} 167 168# Write the configuration in the dictionary 'config' in the specified 169# file name. 170proc create_server_config_file {filename config} { 171 set fp [open $filename w+] 172 foreach directive [dict keys $config] { 173 puts -nonewline $fp "$directive " 174 puts $fp [dict get $config $directive] 175 } 176 close $fp 177} 178 179proc spawn_server {config_file stdout stderr} { 180 if {$::valgrind} { 181 set pid [exec valgrind --track-origins=yes --trace-children=yes --suppressions=[pwd]/src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file >> $stdout 2>> $stderr &] 182 } elseif ($::stack_logging) { 183 set pid [exec /usr/bin/env MallocStackLogging=1 MallocLogFile=/tmp/malloc_log.txt src/redis-server $config_file >> $stdout 2>> $stderr &] 184 } else { 185 set pid [exec src/redis-server $config_file >> $stdout 2>> $stderr &] 186 } 187 188 if {$::wait_server} { 189 set msg "server started PID: $pid. press any key to continue..." 190 puts $msg 191 read stdin 1 192 } 193 194 # Tell the test server about this new instance. 195 send_data_packet $::test_server_fd server-spawned $pid 196 return $pid 197} 198 199# Wait for actual startup, return 1 if port is busy, 0 otherwise 200proc wait_server_started {config_file stdout pid} { 201 set checkperiod 100; # Milliseconds 202 set maxiter [expr {120*1000/$checkperiod}] ; # Wait up to 2 minutes. 203 set port_busy 0 204 while 1 { 205 if {[regexp -- " PID: $pid" [exec cat $stdout]]} { 206 break 207 } 208 after $checkperiod 209 incr maxiter -1 210 if {$maxiter == 0} { 211 start_server_error $config_file "No PID detected in log $stdout" 212 puts "--- LOG CONTENT ---" 213 puts [exec cat $stdout] 214 puts "-------------------" 215 break 216 } 217 218 # Check if the port is actually busy and the server failed 219 # for this reason. 220 if {[regexp {Could not create server TCP} [exec cat $stdout]]} { 221 set port_busy 1 222 break 223 } 224 } 225 return $port_busy 226} 227 228proc start_server {options {code undefined}} { 229 # setup defaults 230 set baseconfig "default.conf" 231 set overrides {} 232 set tags {} 233 set keep_persistence false 234 235 # parse options 236 foreach {option value} $options { 237 switch $option { 238 "config" { 239 set baseconfig $value 240 } 241 "overrides" { 242 set overrides $value 243 } 244 "tags" { 245 # If we 'tags' contain multiple tags, quoted and seperated by spaces, 246 # we want to get rid of the quotes in order to have a proper list 247 set tags [string map { \" "" } $value] 248 set ::tags [concat $::tags $tags] 249 } 250 "keep_persistence" { 251 set keep_persistence $value 252 } 253 default { 254 error "Unknown option $option" 255 } 256 } 257 } 258 259 # We skip unwanted tags 260 foreach tag $::denytags { 261 if {[lsearch $::tags $tag] >= 0} { 262 incr ::num_aborted 263 send_data_packet $::test_server_fd ignore "Tag: $tag" 264 set ::tags [lrange $::tags 0 end-[llength $tags]] 265 return 266 } 267 } 268 269 # If we are running against an external server, we just push the 270 # host/port pair in the stack the first time 271 if {$::external} { 272 if {[llength $::servers] == 0} { 273 set srv {} 274 dict set srv "host" $::host 275 dict set srv "port" $::port 276 set client [redis $::host $::port 0 $::tls] 277 dict set srv "client" $client 278 $client select 9 279 280 set config {} 281 dict set config "port" $::port 282 dict set srv "config" $config 283 284 # append the server to the stack 285 lappend ::servers $srv 286 } 287 r flushall 288 if {[catch {set retval [uplevel 1 $code]} error]} { 289 if {$::durable} { 290 set msg [string range $error 10 end] 291 lappend details $msg 292 lappend details $::errorInfo 293 lappend ::tests_failed $details 294 295 incr ::num_failed 296 send_data_packet $::test_server_fd err [join $details "\n"] 297 } else { 298 # Re-raise, let handler up the stack take care of this. 299 error $error $::errorInfo 300 } 301 } 302 set ::tags [lrange $::tags 0 end-[llength $tags]] 303 return 304 } 305 306 set data [split [exec cat "tests/assets/$baseconfig"] "\n"] 307 set config {} 308 if {$::tls} { 309 dict set config "tls-cert-file" [format "%s/tests/tls/redis.crt" [pwd]] 310 dict set config "tls-key-file" [format "%s/tests/tls/redis.key" [pwd]] 311 dict set config "tls-dh-params-file" [format "%s/tests/tls/redis.dh" [pwd]] 312 dict set config "tls-ca-cert-file" [format "%s/tests/tls/ca.crt" [pwd]] 313 dict set config "loglevel" "debug" 314 } 315 foreach line $data { 316 if {[string length $line] > 0 && [string index $line 0] ne "#"} { 317 set elements [split $line " "] 318 set directive [lrange $elements 0 0] 319 set arguments [lrange $elements 1 end] 320 dict set config $directive $arguments 321 } 322 } 323 324 # use a different directory every time a server is started 325 dict set config dir [tmpdir server] 326 327 # start every server on a different port 328 set port [find_available_port $::baseport $::portcount] 329 if {$::tls} { 330 dict set config "port" 0 331 dict set config "tls-port" $port 332 dict set config "tls-cluster" "yes" 333 dict set config "tls-replication" "yes" 334 } else { 335 dict set config port $port 336 } 337 338 set unixsocket [file normalize [format "%s/%s" [dict get $config "dir"] "socket"]] 339 dict set config "unixsocket" $unixsocket 340 341 # apply overrides from global space and arguments 342 foreach {directive arguments} [concat $::global_overrides $overrides] { 343 dict set config $directive $arguments 344 } 345 346 # write new configuration to temporary file 347 set config_file [tmpfile redis.conf] 348 create_server_config_file $config_file $config 349 350 set stdout [format "%s/%s" [dict get $config "dir"] "stdout"] 351 set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] 352 353 # if we're inside a test, write the test name to the server log file 354 if {[info exists ::cur_test]} { 355 set fd [open $stdout "a+"] 356 puts $fd "### Starting server for test $::cur_test" 357 close $fd 358 } 359 360 # We need a loop here to retry with different ports. 361 set server_started 0 362 while {$server_started == 0} { 363 if {$::verbose} { 364 puts -nonewline "=== ($tags) Starting server ${::host}:${port} " 365 } 366 367 send_data_packet $::test_server_fd "server-spawning" "port $port" 368 369 set pid [spawn_server $config_file $stdout $stderr] 370 371 # check that the server actually started 372 set port_busy [wait_server_started $config_file $stdout $pid] 373 374 # Sometimes we have to try a different port, even if we checked 375 # for availability. Other test clients may grab the port before we 376 # are able to do it for example. 377 if {$port_busy} { 378 puts "Port $port was already busy, trying another port..." 379 set port [find_available_port $::baseport $::portcount] 380 if {$::tls} { 381 dict set config "tls-port" $port 382 } else { 383 dict set config port $port 384 } 385 create_server_config_file $config_file $config 386 387 # Truncate log so wait_server_started will not be looking at 388 # output of the failed server. 389 close [open $stdout "w"] 390 391 continue; # Try again 392 } 393 394 if {$::valgrind} {set retrynum 1000} else {set retrynum 100} 395 if {$code ne "undefined"} { 396 set serverisup [server_is_up $::host $port $retrynum] 397 } else { 398 set serverisup 1 399 } 400 401 if {$::verbose} { 402 puts "" 403 } 404 405 if {!$serverisup} { 406 set err {} 407 append err [exec cat $stdout] "\n" [exec cat $stderr] 408 start_server_error $config_file $err 409 return 410 } 411 set server_started 1 412 } 413 414 # setup properties to be able to initialize a client object 415 set port_param [expr $::tls ? {"tls-port"} : {"port"}] 416 set host $::host 417 if {[dict exists $config bind]} { set host [dict get $config bind] } 418 if {[dict exists $config $port_param]} { set port [dict get $config $port_param] } 419 420 # setup config dict 421 dict set srv "config_file" $config_file 422 dict set srv "config" $config 423 dict set srv "pid" $pid 424 dict set srv "host" $host 425 dict set srv "port" $port 426 dict set srv "stdout" $stdout 427 dict set srv "stderr" $stderr 428 dict set srv "unixsocket" $unixsocket 429 430 # if a block of code is supplied, we wait for the server to become 431 # available, create a client object and kill the server afterwards 432 if {$code ne "undefined"} { 433 set line [exec head -n1 $stdout] 434 if {[string match {*already in use*} $line]} { 435 error_and_quit $config_file $line 436 } 437 438 while 1 { 439 # check that the server actually started and is ready for connections 440 if {[exec grep -i "Ready to accept" | wc -l < $stdout] > 0} { 441 break 442 } 443 after 10 444 } 445 446 # append the server to the stack 447 lappend ::servers $srv 448 449 # connect client (after server dict is put on the stack) 450 reconnect 451 452 # execute provided block 453 set num_tests $::num_tests 454 if {[catch { uplevel 1 $code } error]} { 455 set backtrace $::errorInfo 456 457 # fetch srv back from the server list, in case it was restarted by restart_server (new PID) 458 set srv [lindex $::servers end] 459 460 # pop the server object 461 set ::servers [lrange $::servers 0 end-1] 462 463 # Kill the server without checking for leaks 464 dict set srv "skipleaks" 1 465 kill_server $srv 466 467 # Print warnings from log 468 puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]] 469 set warnings [warnings_from_file [dict get $srv "stdout"]] 470 if {[string length $warnings] > 0} { 471 puts "$warnings" 472 } else { 473 puts "(none)" 474 } 475 puts "" 476 477 if {$::durable} { 478 set msg [string range $error 10 end] 479 lappend details $msg 480 lappend details $backtrace 481 lappend ::tests_failed $details 482 483 incr ::num_failed 484 send_data_packet $::test_server_fd err [join $details "\n"] 485 } else { 486 # Re-raise, let handler up the stack take care of this. 487 error $error $backtrace 488 } 489 } 490 491 # fetch srv back from the server list, in case it was restarted by restart_server (new PID) 492 set srv [lindex $::servers end] 493 494 # Don't do the leak check when no tests were run 495 if {$num_tests == $::num_tests} { 496 dict set srv "skipleaks" 1 497 } 498 499 # pop the server object 500 set ::servers [lrange $::servers 0 end-1] 501 502 set ::tags [lrange $::tags 0 end-[llength $tags]] 503 kill_server $srv 504 if {!$keep_persistence} { 505 clean_persistence $srv 506 } 507 set _ "" 508 } else { 509 set ::tags [lrange $::tags 0 end-[llength $tags]] 510 set _ $srv 511 } 512} 513 514proc restart_server {level wait_ready} { 515 set srv [lindex $::servers end+$level] 516 kill_server $srv 517 518 set stdout [dict get $srv "stdout"] 519 set stderr [dict get $srv "stderr"] 520 set config_file [dict get $srv "config_file"] 521 522 # if we're inside a test, write the test name to the server log file 523 if {[info exists ::cur_test]} { 524 set fd [open $stdout "a+"] 525 puts $fd "### Restarting server for test $::cur_test" 526 close $fd 527 } 528 529 set prev_ready_count [exec grep -i "Ready to accept" | wc -l < $stdout] 530 531 set pid [spawn_server $config_file $stdout $stderr] 532 533 # check that the server actually started 534 wait_server_started $config_file $stdout $pid 535 536 # update the pid in the servers list 537 dict set srv "pid" $pid 538 # re-set $srv in the servers list 539 lset ::servers end+$level $srv 540 541 if {$wait_ready} { 542 while 1 { 543 # check that the server actually started and is ready for connections 544 if {[exec grep -i "Ready to accept" | wc -l < $stdout] > $prev_ready_count + 1} { 545 break 546 } 547 after 10 548 } 549 } 550 reconnect $level 551} 552