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 true] 17 if {$res != ""} { 18 send_data_packet $::test_server_fd err "Valgrind error: $res\n" 19 } 20} 21 22proc check_sanitizer_errors stderr { 23 set res [sanitizer_errors_from_file $stderr] 24 if {$res != ""} { 25 send_data_packet $::test_server_fd err "Sanitizer error: $res\n" 26 } 27} 28 29proc clean_persistence config { 30 # we may wanna keep the logs for later, but let's clean the persistence 31 # files right away, since they can accumulate and take up a lot of space 32 set config [dict get $config "config"] 33 set rdb [format "%s/%s" [dict get $config "dir"] "dump.rdb"] 34 set aof [format "%s/%s" [dict get $config "dir"] "appendonly.aof"] 35 catch {exec rm -rf $rdb} 36 catch {exec rm -rf $aof} 37} 38 39proc kill_server config { 40 # nothing to kill when running against external server 41 if {$::external} return 42 43 # Close client connection if exists 44 if {[dict exists $config "client"]} { 45 [dict get $config "client"] close 46 } 47 48 # nevermind if its already dead 49 if {![is_alive $config]} { 50 # Check valgrind errors if needed 51 if {$::valgrind} { 52 check_valgrind_errors [dict get $config stderr] 53 } 54 55 check_sanitizer_errors [dict get $config stderr] 56 return 57 } 58 set pid [dict get $config pid] 59 60 # check for leaks 61 if {![dict exists $config "skipleaks"]} { 62 catch { 63 if {[string match {*Darwin*} [exec uname -a]]} { 64 tags {"leaks"} { 65 test "Check for memory leaks (pid $pid)" { 66 set output {0 leaks} 67 catch {exec leaks $pid} output option 68 # In a few tests we kill the server process, so leaks will not find it. 69 # It'll exits with exit code >1 on error, so we ignore these. 70 if {[dict exists $option -errorcode]} { 71 set details [dict get $option -errorcode] 72 if {[lindex $details 0] eq "CHILDSTATUS"} { 73 set status [lindex $details 2] 74 if {$status > 1} { 75 set output "0 leaks" 76 } 77 } 78 } 79 set output 80 } {*0 leaks*} 81 } 82 } 83 } 84 } 85 86 # kill server and wait for the process to be totally exited 87 send_data_packet $::test_server_fd server-killing $pid 88 catch {exec kill $pid} 89 # Node might have been stopped in the test 90 catch {exec kill -SIGCONT $pid} 91 if {$::valgrind} { 92 set max_wait 120000 93 } else { 94 set max_wait 10000 95 } 96 while {[is_alive $config]} { 97 incr wait 10 98 99 if {$wait == $max_wait} { 100 puts "Forcing process $pid to crash..." 101 catch {exec kill -SEGV $pid} 102 } elseif {$wait >= $max_wait * 2} { 103 puts "Forcing process $pid to exit..." 104 catch {exec kill -KILL $pid} 105 } elseif {$wait % 1000 == 0} { 106 puts "Waiting for process $pid to exit..." 107 } 108 after 10 109 } 110 111 # Check valgrind errors if needed 112 if {$::valgrind} { 113 check_valgrind_errors [dict get $config stderr] 114 } 115 116 check_sanitizer_errors [dict get $config stderr] 117 118 # Remove this pid from the set of active pids in the test server. 119 send_data_packet $::test_server_fd server-killed $pid 120} 121 122proc is_alive config { 123 set pid [dict get $config pid] 124 if {[catch {exec kill -0 $pid} err]} { 125 return 0 126 } else { 127 return 1 128 } 129} 130 131proc ping_server {host port} { 132 set retval 0 133 if {[catch { 134 if {$::tls} { 135 set fd [::tls::socket $host $port] 136 } else { 137 set fd [socket $host $port] 138 } 139 fconfigure $fd -translation binary 140 puts $fd "PING\r\n" 141 flush $fd 142 set reply [gets $fd] 143 if {[string range $reply 0 0] eq {+} || 144 [string range $reply 0 0] eq {-}} { 145 set retval 1 146 } 147 close $fd 148 } e]} { 149 if {$::verbose} { 150 puts -nonewline "." 151 } 152 } else { 153 if {$::verbose} { 154 puts -nonewline "ok" 155 } 156 } 157 return $retval 158} 159 160# Return 1 if the server at the specified addr is reachable by PING, otherwise 161# returns 0. Performs a try every 50 milliseconds for the specified number 162# of retries. 163proc server_is_up {host port retrynum} { 164 after 10 ;# Use a small delay to make likely a first-try success. 165 set retval 0 166 while {[incr retrynum -1]} { 167 if {[catch {ping_server $host $port} ping]} { 168 set ping 0 169 } 170 if {$ping} {return 1} 171 after 50 172 } 173 return 0 174} 175 176# Check if current ::tags match requested tags. If ::allowtags are used, 177# there must be some intersection. If ::denytags are used, no intersection 178# is allowed. Returns 1 if tags are acceptable or 0 otherwise, in which 179# case err_return names a return variable for the message to be logged. 180proc tags_acceptable {tags err_return} { 181 upvar $err_return err 182 183 # If tags are whitelisted, make sure there's match 184 if {[llength $::allowtags] > 0} { 185 set matched 0 186 foreach tag $::allowtags { 187 if {[lsearch $tags $tag] >= 0} { 188 incr matched 189 } 190 } 191 if {$matched < 1} { 192 set err "Tag: none of the tags allowed" 193 return 0 194 } 195 } 196 197 foreach tag $::denytags { 198 if {[lsearch $tags $tag] >= 0} { 199 set err "Tag: $tag denied" 200 return 0 201 } 202 } 203 204 if {$::external && [lsearch $tags "external:skip"] >= 0} { 205 set err "Not supported on external server" 206 return 0 207 } 208 209 if {$::singledb && [lsearch $tags "singledb:skip"] >= 0} { 210 set err "Not supported on singledb" 211 return 0 212 } 213 214 if {$::cluster_mode && [lsearch $tags "cluster:skip"] >= 0} { 215 set err "Not supported in cluster mode" 216 return 0 217 } 218 219 if {$::tls && [lsearch $tags "tls:skip"] >= 0} { 220 set err "Not supported in tls mode" 221 return 0 222 } 223 224 if {!$::large_memory && [lsearch $tags "large-memory"] >= 0} { 225 set err "large memory flag not provided" 226 return 0 227 } 228 229 return 1 230} 231 232# doesn't really belong here, but highly coupled to code in start_server 233proc tags {tags code} { 234 # If we 'tags' contain multiple tags, quoted and separated by spaces, 235 # we want to get rid of the quotes in order to have a proper list 236 set tags [string map { \" "" } $tags] 237 set ::tags [concat $::tags $tags] 238 if {![tags_acceptable $::tags err]} { 239 incr ::num_aborted 240 send_data_packet $::test_server_fd ignore $err 241 set ::tags [lrange $::tags 0 end-[llength $tags]] 242 return 243 } 244 uplevel 1 $code 245 set ::tags [lrange $::tags 0 end-[llength $tags]] 246} 247 248# Write the configuration in the dictionary 'config' in the specified 249# file name. 250proc create_server_config_file {filename config} { 251 set fp [open $filename w+] 252 foreach directive [dict keys $config] { 253 puts -nonewline $fp "$directive " 254 puts $fp [dict get $config $directive] 255 } 256 close $fp 257} 258 259proc spawn_server {config_file stdout stderr} { 260 if {$::valgrind} { 261 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 &] 262 } elseif ($::stack_logging) { 263 set pid [exec /usr/bin/env MallocStackLogging=1 MallocLogFile=/tmp/malloc_log.txt src/redis-server $config_file >> $stdout 2>> $stderr &] 264 } else { 265 # ASAN_OPTIONS environment variable is for address sanitizer. If a test 266 # tries to allocate huge memory area and expects allocator to return 267 # NULL, address sanitizer throws an error without this setting. 268 set pid [exec /usr/bin/env ASAN_OPTIONS=allocator_may_return_null=1 src/redis-server $config_file >> $stdout 2>> $stderr &] 269 } 270 271 if {$::wait_server} { 272 set msg "server started PID: $pid. press any key to continue..." 273 puts $msg 274 read stdin 1 275 } 276 277 # Tell the test server about this new instance. 278 send_data_packet $::test_server_fd server-spawned $pid 279 return $pid 280} 281 282# Wait for actual startup, return 1 if port is busy, 0 otherwise 283proc wait_server_started {config_file stdout pid} { 284 set checkperiod 100; # Milliseconds 285 set maxiter [expr {120*1000/$checkperiod}] ; # Wait up to 2 minutes. 286 set port_busy 0 287 while 1 { 288 if {[regexp -- " PID: $pid" [exec cat $stdout]]} { 289 break 290 } 291 after $checkperiod 292 incr maxiter -1 293 if {$maxiter == 0} { 294 start_server_error $config_file "No PID detected in log $stdout" 295 puts "--- LOG CONTENT ---" 296 puts [exec cat $stdout] 297 puts "-------------------" 298 break 299 } 300 301 # Check if the port is actually busy and the server failed 302 # for this reason. 303 if {[regexp {Failed listening on port} [exec cat $stdout]]} { 304 set port_busy 1 305 break 306 } 307 } 308 return $port_busy 309} 310 311proc dump_server_log {srv} { 312 set pid [dict get $srv "pid"] 313 puts "\n===== Start of server log (pid $pid) =====\n" 314 puts [exec cat [dict get $srv "stdout"]] 315 puts "===== End of server log (pid $pid) =====\n" 316 317 puts "\n===== Start of server stderr log (pid $pid) =====\n" 318 puts [exec cat [dict get $srv "stderr"]] 319 puts "===== End of server stderr log (pid $pid) =====\n" 320} 321 322proc run_external_server_test {code overrides} { 323 set srv {} 324 dict set srv "host" $::host 325 dict set srv "port" $::port 326 set client [redis $::host $::port 0 $::tls] 327 dict set srv "client" $client 328 if {!$::singledb} { 329 $client select 9 330 } 331 332 set config {} 333 dict set config "port" $::port 334 dict set srv "config" $config 335 336 # append the server to the stack 337 lappend ::servers $srv 338 339 if {[llength $::servers] > 1} { 340 if {$::verbose} { 341 puts "Notice: nested start_server statements in external server mode, test must be aware of that!" 342 } 343 } 344 345 r flushall 346 347 # store overrides 348 set saved_config {} 349 foreach {param val} $overrides { 350 dict set saved_config $param [lindex [r config get $param] 1] 351 r config set $param $val 352 353 # If we enable appendonly, wait for for rewrite to complete. This is 354 # required for tests that begin with a bg* command which will fail if 355 # the rewriteaof operation is not completed at this point. 356 if {$param == "appendonly" && $val == "yes"} { 357 waitForBgrewriteaof r 358 } 359 } 360 361 if {[catch {set retval [uplevel 2 $code]} error]} { 362 if {$::durable} { 363 set msg [string range $error 10 end] 364 lappend details $msg 365 lappend details $::errorInfo 366 lappend ::tests_failed $details 367 368 incr ::num_failed 369 send_data_packet $::test_server_fd err [join $details "\n"] 370 } else { 371 # Re-raise, let handler up the stack take care of this. 372 error $error $::errorInfo 373 } 374 } 375 376 # restore overrides 377 dict for {param val} $saved_config { 378 r config set $param $val 379 } 380 381 set srv [lpop ::servers] 382 383 if {[dict exists $srv "client"]} { 384 [dict get $srv "client"] close 385 } 386} 387 388proc start_server {options {code undefined}} { 389 # setup defaults 390 set baseconfig "default.conf" 391 set overrides {} 392 set omit {} 393 set tags {} 394 set keep_persistence false 395 396 # parse options 397 foreach {option value} $options { 398 switch $option { 399 "config" { 400 set baseconfig $value 401 } 402 "overrides" { 403 set overrides $value 404 } 405 "omit" { 406 set omit $value 407 } 408 "tags" { 409 # If we 'tags' contain multiple tags, quoted and separated by spaces, 410 # we want to get rid of the quotes in order to have a proper list 411 set tags [string map { \" "" } $value] 412 set ::tags [concat $::tags $tags] 413 } 414 "keep_persistence" { 415 set keep_persistence $value 416 } 417 default { 418 error "Unknown option $option" 419 } 420 } 421 } 422 423 # We skip unwanted tags 424 if {![tags_acceptable $::tags err]} { 425 incr ::num_aborted 426 send_data_packet $::test_server_fd ignore $err 427 set ::tags [lrange $::tags 0 end-[llength $tags]] 428 return 429 } 430 431 # If we are running against an external server, we just push the 432 # host/port pair in the stack the first time 433 if {$::external} { 434 run_external_server_test $code $overrides 435 436 set ::tags [lrange $::tags 0 end-[llength $tags]] 437 return 438 } 439 440 set data [split [exec cat "tests/assets/$baseconfig"] "\n"] 441 set config {} 442 if {$::tls} { 443 dict set config "tls-cert-file" [format "%s/tests/tls/server.crt" [pwd]] 444 dict set config "tls-key-file" [format "%s/tests/tls/server.key" [pwd]] 445 dict set config "tls-client-cert-file" [format "%s/tests/tls/client.crt" [pwd]] 446 dict set config "tls-client-key-file" [format "%s/tests/tls/client.key" [pwd]] 447 dict set config "tls-dh-params-file" [format "%s/tests/tls/redis.dh" [pwd]] 448 dict set config "tls-ca-cert-file" [format "%s/tests/tls/ca.crt" [pwd]] 449 dict set config "loglevel" "debug" 450 } 451 foreach line $data { 452 if {[string length $line] > 0 && [string index $line 0] ne "#"} { 453 set elements [split $line " "] 454 set directive [lrange $elements 0 0] 455 set arguments [lrange $elements 1 end] 456 dict set config $directive $arguments 457 } 458 } 459 460 # use a different directory every time a server is started 461 dict set config dir [tmpdir server] 462 463 # start every server on a different port 464 set port [find_available_port $::baseport $::portcount] 465 if {$::tls} { 466 dict set config "port" 0 467 dict set config "tls-port" $port 468 dict set config "tls-cluster" "yes" 469 dict set config "tls-replication" "yes" 470 } else { 471 dict set config port $port 472 } 473 474 set unixsocket [file normalize [format "%s/%s" [dict get $config "dir"] "socket"]] 475 dict set config "unixsocket" $unixsocket 476 477 # apply overrides from global space and arguments 478 foreach {directive arguments} [concat $::global_overrides $overrides] { 479 dict set config $directive $arguments 480 } 481 482 # remove directives that are marked to be omitted 483 foreach directive $omit { 484 dict unset config $directive 485 } 486 487 # write new configuration to temporary file 488 set config_file [tmpfile redis.conf] 489 create_server_config_file $config_file $config 490 491 set stdout [format "%s/%s" [dict get $config "dir"] "stdout"] 492 set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] 493 494 # if we're inside a test, write the test name to the server log file 495 if {[info exists ::cur_test]} { 496 set fd [open $stdout "a+"] 497 puts $fd "### Starting server for test $::cur_test" 498 close $fd 499 } 500 501 # We need a loop here to retry with different ports. 502 set server_started 0 503 while {$server_started == 0} { 504 if {$::verbose} { 505 puts -nonewline "=== ($tags) Starting server ${::host}:${port} " 506 } 507 508 send_data_packet $::test_server_fd "server-spawning" "port $port" 509 510 set pid [spawn_server $config_file $stdout $stderr] 511 512 # check that the server actually started 513 set port_busy [wait_server_started $config_file $stdout $pid] 514 515 # Sometimes we have to try a different port, even if we checked 516 # for availability. Other test clients may grab the port before we 517 # are able to do it for example. 518 if {$port_busy} { 519 puts "Port $port was already busy, trying another port..." 520 set port [find_available_port $::baseport $::portcount] 521 if {$::tls} { 522 dict set config "tls-port" $port 523 } else { 524 dict set config port $port 525 } 526 create_server_config_file $config_file $config 527 528 # Truncate log so wait_server_started will not be looking at 529 # output of the failed server. 530 close [open $stdout "w"] 531 532 continue; # Try again 533 } 534 535 if {$::valgrind} {set retrynum 1000} else {set retrynum 100} 536 if {$code ne "undefined"} { 537 set serverisup [server_is_up $::host $port $retrynum] 538 } else { 539 set serverisup 1 540 } 541 542 if {$::verbose} { 543 puts "" 544 } 545 546 if {!$serverisup} { 547 set err {} 548 append err [exec cat $stdout] "\n" [exec cat $stderr] 549 start_server_error $config_file $err 550 return 551 } 552 set server_started 1 553 } 554 555 # setup properties to be able to initialize a client object 556 set port_param [expr $::tls ? {"tls-port"} : {"port"}] 557 set host $::host 558 if {[dict exists $config bind]} { set host [dict get $config bind] } 559 if {[dict exists $config $port_param]} { set port [dict get $config $port_param] } 560 561 # setup config dict 562 dict set srv "config_file" $config_file 563 dict set srv "config" $config 564 dict set srv "pid" $pid 565 dict set srv "host" $host 566 dict set srv "port" $port 567 dict set srv "stdout" $stdout 568 dict set srv "stderr" $stderr 569 dict set srv "unixsocket" $unixsocket 570 571 # if a block of code is supplied, we wait for the server to become 572 # available, create a client object and kill the server afterwards 573 if {$code ne "undefined"} { 574 set line [exec head -n1 $stdout] 575 if {[string match {*already in use*} $line]} { 576 error_and_quit $config_file $line 577 } 578 579 while 1 { 580 # check that the server actually started and is ready for connections 581 if {[count_message_lines $stdout "Ready to accept"] > 0} { 582 break 583 } 584 after 10 585 } 586 587 # append the server to the stack 588 lappend ::servers $srv 589 590 # connect client (after server dict is put on the stack) 591 reconnect 592 593 # remember previous num_failed to catch new errors 594 set prev_num_failed $::num_failed 595 596 # execute provided block 597 set num_tests $::num_tests 598 if {[catch { uplevel 1 $code } error]} { 599 set backtrace $::errorInfo 600 set assertion [string match "assertion:*" $error] 601 602 # fetch srv back from the server list, in case it was restarted by restart_server (new PID) 603 set srv [lindex $::servers end] 604 605 # pop the server object 606 set ::servers [lrange $::servers 0 end-1] 607 608 # Kill the server without checking for leaks 609 dict set srv "skipleaks" 1 610 kill_server $srv 611 612 if {$::dump_logs && $assertion} { 613 # if we caught an assertion ($::num_failed isn't incremented yet) 614 # this happens when the test spawns a server and not the other way around 615 dump_server_log $srv 616 } else { 617 # Print crash report from log 618 set crashlog [crashlog_from_file [dict get $srv "stdout"]] 619 if {[string length $crashlog] > 0} { 620 puts [format "\nLogged crash report (pid %d):" [dict get $srv "pid"]] 621 puts "$crashlog" 622 puts "" 623 } 624 625 set sanitizerlog [sanitizer_errors_from_file [dict get $srv "stderr"]] 626 if {[string length $sanitizerlog] > 0} { 627 puts [format "\nLogged sanitizer errors (pid %d):" [dict get $srv "pid"]] 628 puts "$sanitizerlog" 629 puts "" 630 } 631 } 632 633 if {!$assertion && $::durable} { 634 # durable is meant to prevent the whole tcl test from exiting on 635 # an exception. an assertion will be caught by the test proc. 636 set msg [string range $error 10 end] 637 lappend details $msg 638 lappend details $backtrace 639 lappend ::tests_failed $details 640 641 incr ::num_failed 642 send_data_packet $::test_server_fd err [join $details "\n"] 643 } else { 644 # Re-raise, let handler up the stack take care of this. 645 error $error $backtrace 646 } 647 } else { 648 if {$::dump_logs && $prev_num_failed != $::num_failed} { 649 dump_server_log $srv 650 } 651 } 652 653 # fetch srv back from the server list, in case it was restarted by restart_server (new PID) 654 set srv [lindex $::servers end] 655 656 # Don't do the leak check when no tests were run 657 if {$num_tests == $::num_tests} { 658 dict set srv "skipleaks" 1 659 } 660 661 # pop the server object 662 set ::servers [lrange $::servers 0 end-1] 663 664 set ::tags [lrange $::tags 0 end-[llength $tags]] 665 kill_server $srv 666 if {!$keep_persistence} { 667 clean_persistence $srv 668 } 669 set _ "" 670 } else { 671 set ::tags [lrange $::tags 0 end-[llength $tags]] 672 set _ $srv 673 } 674} 675 676proc restart_server {level wait_ready rotate_logs {reconnect 1}} { 677 set srv [lindex $::servers end+$level] 678 kill_server $srv 679 # Remove the default client from the server 680 dict unset srv "client" 681 682 set pid [dict get $srv "pid"] 683 set stdout [dict get $srv "stdout"] 684 set stderr [dict get $srv "stderr"] 685 if {$rotate_logs} { 686 set ts [clock format [clock seconds] -format %y%m%d%H%M%S] 687 file rename $stdout $stdout.$ts.$pid 688 file rename $stderr $stderr.$ts.$pid 689 } 690 set prev_ready_count [count_message_lines $stdout "Ready to accept"] 691 692 # if we're inside a test, write the test name to the server log file 693 if {[info exists ::cur_test]} { 694 set fd [open $stdout "a+"] 695 puts $fd "### Restarting server for test $::cur_test" 696 close $fd 697 } 698 699 set config_file [dict get $srv "config_file"] 700 701 set pid [spawn_server $config_file $stdout $stderr] 702 703 # check that the server actually started 704 wait_server_started $config_file $stdout $pid 705 706 # update the pid in the servers list 707 dict set srv "pid" $pid 708 # re-set $srv in the servers list 709 lset ::servers end+$level $srv 710 711 if {$wait_ready} { 712 while 1 { 713 # check that the server actually started and is ready for connections 714 if {[count_message_lines $stdout "Ready to accept"] > $prev_ready_count} { 715 break 716 } 717 after 10 718 } 719 } 720 if {$reconnect} { 721 reconnect $level 722 } 723} 724