"Fossies" - the Fresh Open Source Software Archive

Member "redis-6.0.8/tests/instances.tcl" (10 Sep 2020, 19472 Bytes) of package /linux/misc/redis-6.0.8.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "instances.tcl": 6.0.7_vs_6.0.8.

    1 # Multi-instance test framework.
    2 # This is used in order to test Sentinel and Redis Cluster, and provides
    3 # basic capabilities for spawning and handling N parallel Redis / Sentinel
    4 # instances.
    5 #
    6 # Copyright (C) 2014 Salvatore Sanfilippo antirez@gmail.com
    7 # This software is released under the BSD License. See the COPYING file for
    8 # more information.
    9 
   10 package require Tcl 8.5
   11 
   12 set tcl_precision 17
   13 source ../support/redis.tcl
   14 source ../support/util.tcl
   15 source ../support/server.tcl
   16 source ../support/test.tcl
   17 
   18 set ::verbose 0
   19 set ::valgrind 0
   20 set ::tls 0
   21 set ::pause_on_error 0
   22 set ::dont_clean 0
   23 set ::simulate_error 0
   24 set ::failed 0
   25 set ::sentinel_instances {}
   26 set ::redis_instances {}
   27 set ::sentinel_base_port 20000
   28 set ::redis_base_port 30000
   29 set ::redis_port_count 1024
   30 set ::pids {} ; # We kill everything at exit
   31 set ::dirs {} ; # We remove all the temp dirs at exit
   32 set ::run_matching {} ; # If non empty, only tests matching pattern are run.
   33 
   34 if {[catch {cd tmp}]} {
   35     puts "tmp directory not found."
   36     puts "Please run this test from the Redis source root."
   37     exit 1
   38 }
   39 
   40 # Execute the specified instance of the server specified by 'type', using
   41 # the provided configuration file. Returns the PID of the process.
   42 proc exec_instance {type dirname cfgfile} {
   43     if {$type eq "redis"} {
   44         set prgname redis-server
   45     } elseif {$type eq "sentinel"} {
   46         set prgname redis-sentinel
   47     } else {
   48         error "Unknown instance type."
   49     }
   50 
   51     set errfile [file join $dirname err.txt]
   52     if {$::valgrind} {
   53         set pid [exec valgrind --track-origins=yes --suppressions=../../../src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full ../../../src/${prgname} $cfgfile 2>> $errfile &]
   54     } else {
   55         set pid [exec ../../../src/${prgname} $cfgfile 2>> $errfile &]
   56     }
   57     return $pid
   58 }
   59 
   60 # Spawn a redis or sentinel instance, depending on 'type'.
   61 proc spawn_instance {type base_port count {conf {}}} {
   62     for {set j 0} {$j < $count} {incr j} {
   63         set port [find_available_port $base_port $::redis_port_count]
   64 
   65         # Create a directory for this instance.
   66         set dirname "${type}_${j}"
   67         lappend ::dirs $dirname
   68         catch {exec rm -rf $dirname}
   69         file mkdir $dirname
   70 
   71         # Write the instance config file.
   72         set cfgfile [file join $dirname $type.conf]
   73         set cfg [open $cfgfile w]
   74         if {$::tls} {
   75             puts $cfg "tls-port $port"
   76             puts $cfg "tls-replication yes"
   77             puts $cfg "tls-cluster yes"
   78             puts $cfg "port 0"
   79             puts $cfg [format "tls-cert-file %s/../../tls/redis.crt" [pwd]]
   80             puts $cfg [format "tls-key-file %s/../../tls/redis.key" [pwd]]
   81             puts $cfg [format "tls-dh-params-file %s/../../tls/redis.dh" [pwd]]
   82             puts $cfg [format "tls-ca-cert-file %s/../../tls/ca.crt" [pwd]]
   83             puts $cfg "loglevel debug"
   84         } else {
   85             puts $cfg "port $port"
   86         }
   87         puts $cfg "dir ./$dirname"
   88         puts $cfg "logfile log.txt"
   89         # Add additional config files
   90         foreach directive $conf {
   91             puts $cfg $directive
   92         }
   93         close $cfg
   94 
   95         # Finally exec it and remember the pid for later cleanup.
   96         set retry 100
   97         while {$retry} {
   98             set pid [exec_instance $type $dirname $cfgfile]
   99 
  100             # Check availability
  101             if {[server_is_up 127.0.0.1 $port 100] == 0} {
  102                 puts "Starting $type #$j at port $port failed, try another"
  103                 incr retry -1
  104                 set port [find_available_port $base_port $::redis_port_count]
  105                 set cfg [open $cfgfile a+]
  106                 if {$::tls} {
  107                     puts $cfg "tls-port $port"
  108                 } else {
  109                     puts $cfg "port $port"
  110                 }
  111                 close $cfg
  112             } else {
  113                 puts "Starting $type #$j at port $port"
  114                 lappend ::pids $pid
  115                 break
  116             }
  117         }
  118 
  119         # Check availability finally
  120         if {[server_is_up 127.0.0.1 $port 100] == 0} {
  121             set logfile [file join $dirname log.txt]
  122             puts [exec tail $logfile]
  123             abort_sentinel_test "Problems starting $type #$j: ping timeout, maybe server start failed, check $logfile"
  124         }
  125 
  126         # Push the instance into the right list
  127         set link [redis 127.0.0.1 $port 0 $::tls]
  128         $link reconnect 1
  129         lappend ::${type}_instances [list \
  130             pid $pid \
  131             host 127.0.0.1 \
  132             port $port \
  133             link $link \
  134         ]
  135     }
  136 }
  137 
  138 proc log_crashes {} {
  139     set start_pattern {*REDIS BUG REPORT START*}
  140     set logs [glob */log.txt]
  141     foreach log $logs {
  142         set fd [open $log]
  143         set found 0
  144         while {[gets $fd line] >= 0} {
  145             if {[string match $start_pattern $line]} {
  146                 puts "\n*** Crash report found in $log ***"
  147                 set found 1
  148             }
  149             if {$found} {
  150                 puts $line
  151                 incr ::failed
  152             }
  153         }
  154     }
  155 
  156     set logs [glob */err.txt]
  157     foreach log $logs {
  158         set res [find_valgrind_errors $log]
  159         if {$res != ""} {
  160             puts $res
  161             incr ::failed
  162         }
  163     }
  164 }
  165 
  166 proc is_alive pid {
  167     if {[catch {exec ps -p $pid} err]} {
  168         return 0
  169     } else {
  170         return 1
  171     }
  172 }
  173 
  174 proc stop_instance pid {
  175     catch {exec kill $pid}
  176     if {$::valgrind} {
  177         set max_wait 60000
  178     } else {
  179         set max_wait 10000
  180     }
  181     while {[is_alive $pid]} {
  182         incr wait 10
  183 
  184         if {$wait >= $max_wait} {
  185             puts "Forcing process $pid to exit..."
  186             catch {exec kill -KILL $pid}
  187         } elseif {$wait % 1000 == 0} {
  188             puts "Waiting for process $pid to exit..."
  189         }
  190         after 10
  191     }
  192 }
  193 
  194 proc cleanup {} {
  195     puts "Cleaning up..."
  196     foreach pid $::pids {
  197         puts "killing stale instance $pid"
  198         stop_instance $pid
  199     }
  200     log_crashes
  201     if {$::dont_clean} {
  202         return
  203     }
  204     foreach dir $::dirs {
  205         catch {exec rm -rf $dir}
  206     }
  207 }
  208 
  209 proc abort_sentinel_test msg {
  210     incr ::failed
  211     puts "WARNING: Aborting the test."
  212     puts ">>>>>>>> $msg"
  213     if {$::pause_on_error} pause_on_error
  214     cleanup
  215     exit 1
  216 }
  217 
  218 proc parse_options {} {
  219     for {set j 0} {$j < [llength $::argv]} {incr j} {
  220         set opt [lindex $::argv $j]
  221         set val [lindex $::argv [expr $j+1]]
  222         if {$opt eq "--single"} {
  223             incr j
  224             set ::run_matching "*${val}*"
  225         } elseif {$opt eq "--pause-on-error"} {
  226             set ::pause_on_error 1
  227         } elseif {$opt eq {--dont-clean}} {
  228             set ::dont_clean 1
  229         } elseif {$opt eq "--fail"} {
  230             set ::simulate_error 1
  231         } elseif {$opt eq {--valgrind}} {
  232             set ::valgrind 1
  233         } elseif {$opt eq {--tls}} {
  234             package require tls 1.6
  235             ::tls::init \
  236                 -cafile "$::tlsdir/ca.crt" \
  237                 -certfile "$::tlsdir/redis.crt" \
  238                 -keyfile "$::tlsdir/redis.key"
  239             set ::tls 1
  240         } elseif {$opt eq "--help"} {
  241             puts "--single <pattern>      Only runs tests specified by pattern."
  242             puts "--dont-clean            Keep log files on exit."
  243             puts "--pause-on-error        Pause for manual inspection on error."
  244             puts "--fail                  Simulate a test failure."
  245             puts "--valgrind              Run with valgrind."
  246             puts "--help                  Shows this help."
  247             exit 0
  248         } else {
  249             puts "Unknown option $opt"
  250             exit 1
  251         }
  252     }
  253 }
  254 
  255 # If --pause-on-error option was passed at startup this function is called
  256 # on error in order to give the developer a chance to understand more about
  257 # the error condition while the instances are still running.
  258 proc pause_on_error {} {
  259     puts ""
  260     puts [colorstr yellow "*** Please inspect the error now ***"]
  261     puts "\nType \"continue\" to resume the test, \"help\" for help screen.\n"
  262     while 1 {
  263         puts -nonewline "> "
  264         flush stdout
  265         set line [gets stdin]
  266         set argv [split $line " "]
  267         set cmd [lindex $argv 0]
  268         if {$cmd eq {continue}} {
  269             break
  270         } elseif {$cmd eq {show-redis-logs}} {
  271             set count 10
  272             if {[lindex $argv 1] ne {}} {set count [lindex $argv 1]}
  273             foreach_redis_id id {
  274                 puts "=== REDIS $id ===="
  275                 puts [exec tail -$count redis_$id/log.txt]
  276                 puts "---------------------\n"
  277             }
  278         } elseif {$cmd eq {show-sentinel-logs}} {
  279             set count 10
  280             if {[lindex $argv 1] ne {}} {set count [lindex $argv 1]}
  281             foreach_sentinel_id id {
  282                 puts "=== SENTINEL $id ===="
  283                 puts [exec tail -$count sentinel_$id/log.txt]
  284                 puts "---------------------\n"
  285             }
  286         } elseif {$cmd eq {ls}} {
  287             foreach_redis_id id {
  288                 puts -nonewline "Redis $id"
  289                 set errcode [catch {
  290                     set str {}
  291                     append str "@[RI $id tcp_port]: "
  292                     append str "[RI $id role] "
  293                     if {[RI $id role] eq {slave}} {
  294                         append str "[RI $id master_host]:[RI $id master_port]"
  295                     }
  296                     set str
  297                 } retval]
  298                 if {$errcode} {
  299                     puts " -- $retval"
  300                 } else {
  301                     puts $retval
  302                 }
  303             }
  304             foreach_sentinel_id id {
  305                 puts -nonewline "Sentinel $id"
  306                 set errcode [catch {
  307                     set str {}
  308                     append str "@[SI $id tcp_port]: "
  309                     append str "[join [S $id sentinel get-master-addr-by-name mymaster]]"
  310                     set str
  311                 } retval]
  312                 if {$errcode} {
  313                     puts " -- $retval"
  314                 } else {
  315                     puts $retval
  316                 }
  317             }
  318         } elseif {$cmd eq {help}} {
  319             puts "ls                     List Sentinel and Redis instances."
  320             puts "show-sentinel-logs \[N\] Show latest N lines of logs."
  321             puts "show-redis-logs \[N\]    Show latest N lines of logs."
  322             puts "S <id> cmd ... arg     Call command in Sentinel <id>."
  323             puts "R <id> cmd ... arg     Call command in Redis <id>."
  324             puts "SI <id> <field>        Show Sentinel <id> INFO <field>."
  325             puts "RI <id> <field>        Show Sentinel <id> INFO <field>."
  326             puts "continue               Resume test."
  327         } else {
  328             set errcode [catch {eval $line} retval]
  329             if {$retval ne {}} {puts "$retval"}
  330         }
  331     }
  332 }
  333 
  334 # We redefine 'test' as for Sentinel we don't use the server-client
  335 # architecture for the test, everything is sequential.
  336 proc test {descr code} {
  337     set ts [clock format [clock seconds] -format %H:%M:%S]
  338     puts -nonewline "$ts> $descr: "
  339     flush stdout
  340 
  341     if {[catch {set retval [uplevel 1 $code]} error]} {
  342         incr ::failed
  343         if {[string match "assertion:*" $error]} {
  344             set msg [string range $error 10 end]
  345             puts [colorstr red $msg]
  346             if {$::pause_on_error} pause_on_error
  347             puts "(Jumping to next unit after error)"
  348             return -code continue
  349         } else {
  350             # Re-raise, let handler up the stack take care of this.
  351             error $error $::errorInfo
  352         }
  353     } else {
  354         puts [colorstr green OK]
  355     }
  356 }
  357 
  358 # Check memory leaks when running on OSX using the "leaks" utility.
  359 proc check_leaks instance_types {
  360     if {[string match {*Darwin*} [exec uname -a]]} {
  361         puts -nonewline "Testing for memory leaks..."; flush stdout
  362         foreach type $instance_types {
  363             foreach_instance_id [set ::${type}_instances] id {
  364                 if {[instance_is_killed $type $id]} continue
  365                 set pid [get_instance_attrib $type $id pid]
  366                 set output {0 leaks}
  367                 catch {exec leaks $pid} output
  368                 if {[string match {*process does not exist*} $output] ||
  369                     [string match {*cannot examine*} $output]} {
  370                     # In a few tests we kill the server process.
  371                     set output "0 leaks"
  372                 } else {
  373                     puts -nonewline "$type/$pid "
  374                     flush stdout
  375                 }
  376                 if {![string match {*0 leaks*} $output]} {
  377                     puts [colorstr red "=== MEMORY LEAK DETECTED ==="]
  378                     puts "Instance type $type, ID $id:"
  379                     puts $output
  380                     puts "==="
  381                     incr ::failed
  382                 }
  383             }
  384         }
  385         puts ""
  386     }
  387 }
  388 
  389 # Execute all the units inside the 'tests' directory.
  390 proc run_tests {} {
  391     set tests [lsort [glob ../tests/*]]
  392     foreach test $tests {
  393         if {$::run_matching ne {} && [string match $::run_matching $test] == 0} {
  394             continue
  395         }
  396         if {[file isdirectory $test]} continue
  397         puts [colorstr yellow "Testing unit: [lindex [file split $test] end]"]
  398         source $test
  399         check_leaks {redis sentinel}
  400     }
  401 }
  402 
  403 # Print a message and exists with 0 / 1 according to zero or more failures.
  404 proc end_tests {} {
  405     if {$::failed == 0} {
  406         puts "GOOD! No errors."
  407         exit 0
  408     } else {
  409         puts "WARNING $::failed test(s) failed."
  410         exit 1
  411     }
  412 }
  413 
  414 # The "S" command is used to interact with the N-th Sentinel.
  415 # The general form is:
  416 #
  417 # S <sentinel-id> command arg arg arg ...
  418 #
  419 # Example to ping the Sentinel 0 (first instance): S 0 PING
  420 proc S {n args} {
  421     set s [lindex $::sentinel_instances $n]
  422     [dict get $s link] {*}$args
  423 }
  424 
  425 # Returns a Redis instance by index.
  426 # Example:
  427 #     [Rn 0] info
  428 proc Rn {n} {
  429     return [dict get [lindex $::redis_instances $n] link]
  430 }
  431 
  432 # Like R but to chat with Redis instances.
  433 proc R {n args} {
  434     [Rn $n] {*}$args
  435 }
  436 
  437 proc get_info_field {info field} {
  438     set fl [string length $field]
  439     append field :
  440     foreach line [split $info "\n"] {
  441         set line [string trim $line "\r\n "]
  442         if {[string range $line 0 $fl] eq $field} {
  443             return [string range $line [expr {$fl+1}] end]
  444         }
  445     }
  446     return {}
  447 }
  448 
  449 proc SI {n field} {
  450     get_info_field [S $n info] $field
  451 }
  452 
  453 proc RI {n field} {
  454     get_info_field [R $n info] $field
  455 }
  456 
  457 # Iterate over IDs of sentinel or redis instances.
  458 proc foreach_instance_id {instances idvar code} {
  459     upvar 1 $idvar id
  460     for {set id 0} {$id < [llength $instances]} {incr id} {
  461         set errcode [catch {uplevel 1 $code} result]
  462         if {$errcode == 1} {
  463             error $result $::errorInfo $::errorCode
  464         } elseif {$errcode == 4} {
  465             continue
  466         } elseif {$errcode == 3} {
  467             break
  468         } elseif {$errcode != 0} {
  469             return -code $errcode $result
  470         }
  471     }
  472 }
  473 
  474 proc foreach_sentinel_id {idvar code} {
  475     set errcode [catch {uplevel 1 [list foreach_instance_id $::sentinel_instances $idvar $code]} result]
  476     return -code $errcode $result
  477 }
  478 
  479 proc foreach_redis_id {idvar code} {
  480     set errcode [catch {uplevel 1 [list foreach_instance_id $::redis_instances $idvar $code]} result]
  481     return -code $errcode $result
  482 }
  483 
  484 # Get the specific attribute of the specified instance type, id.
  485 proc get_instance_attrib {type id attrib} {
  486     dict get [lindex [set ::${type}_instances] $id] $attrib
  487 }
  488 
  489 # Set the specific attribute of the specified instance type, id.
  490 proc set_instance_attrib {type id attrib newval} {
  491     set d [lindex [set ::${type}_instances] $id]
  492     dict set d $attrib $newval
  493     lset ::${type}_instances $id $d
  494 }
  495 
  496 # Create a master-slave cluster of the given number of total instances.
  497 # The first instance "0" is the master, all others are configured as
  498 # slaves.
  499 proc create_redis_master_slave_cluster n {
  500     foreach_redis_id id {
  501         if {$id == 0} {
  502             # Our master.
  503             R $id slaveof no one
  504             R $id flushall
  505         } elseif {$id < $n} {
  506             R $id slaveof [get_instance_attrib redis 0 host] \
  507                           [get_instance_attrib redis 0 port]
  508         } else {
  509             # Instances not part of the cluster.
  510             R $id slaveof no one
  511         }
  512     }
  513     # Wait for all the slaves to sync.
  514     wait_for_condition 1000 50 {
  515         [RI 0 connected_slaves] == ($n-1)
  516     } else {
  517         fail "Unable to create a master-slaves cluster."
  518     }
  519 }
  520 
  521 proc get_instance_id_by_port {type port} {
  522     foreach_${type}_id id {
  523         if {[get_instance_attrib $type $id port] == $port} {
  524             return $id
  525         }
  526     }
  527     fail "Instance $type port $port not found."
  528 }
  529 
  530 # Kill an instance of the specified type/id with SIGKILL.
  531 # This function will mark the instance PID as -1 to remember that this instance
  532 # is no longer running and will remove its PID from the list of pids that
  533 # we kill at cleanup.
  534 #
  535 # The instance can be restarted with restart-instance.
  536 proc kill_instance {type id} {
  537     set pid [get_instance_attrib $type $id pid]
  538     set port [get_instance_attrib $type $id port]
  539 
  540     if {$pid == -1} {
  541         error "You tried to kill $type $id twice."
  542     }
  543 
  544     stop_instance $pid
  545     set_instance_attrib $type $id pid -1
  546     set_instance_attrib $type $id link you_tried_to_talk_with_killed_instance
  547 
  548     # Remove the PID from the list of pids to kill at exit.
  549     set ::pids [lsearch -all -inline -not -exact $::pids $pid]
  550 
  551     # Wait for the port it was using to be available again, so that's not
  552     # an issue to start a new server ASAP with the same port.
  553     set retry 100
  554     while {[incr retry -1]} {
  555         set port_is_free [catch {set s [socket 127.0.0.1 $port]}]
  556         if {$port_is_free} break
  557         catch {close $s}
  558         after 100
  559     }
  560     if {$retry == 0} {
  561         error "Port $port does not return available after killing instance."
  562     }
  563 }
  564 
  565 # Return true of the instance of the specified type/id is killed.
  566 proc instance_is_killed {type id} {
  567     set pid [get_instance_attrib $type $id pid]
  568     expr {$pid == -1}
  569 }
  570 
  571 # Restart an instance previously killed by kill_instance
  572 proc restart_instance {type id} {
  573     set dirname "${type}_${id}"
  574     set cfgfile [file join $dirname $type.conf]
  575     set port [get_instance_attrib $type $id port]
  576 
  577     # Execute the instance with its old setup and append the new pid
  578     # file for cleanup.
  579     set pid [exec_instance $type $dirname $cfgfile]
  580     set_instance_attrib $type $id pid $pid
  581     lappend ::pids $pid
  582 
  583     # Check that the instance is running
  584     if {[server_is_up 127.0.0.1 $port 100] == 0} {
  585         set logfile [file join $dirname log.txt]
  586         puts [exec tail $logfile]
  587         abort_sentinel_test "Problems starting $type #$id: ping timeout, maybe server start failed, check $logfile"
  588     }
  589 
  590     # Connect with it with a fresh link
  591     set link [redis 127.0.0.1 $port 0 $::tls]
  592     $link reconnect 1
  593     set_instance_attrib $type $id link $link
  594 
  595     # Make sure the instance is not loading the dataset when this
  596     # function returns.
  597     while 1 {
  598         catch {[$link ping]} retval
  599         if {[string match {*LOADING*} $retval]} {
  600             after 100
  601             continue
  602         } else {
  603             break
  604         }
  605     }
  606 }
  607