Cluster test infra (taken from #10920)

* Taking just the test infrastrucutre from that commit.

(cherry picked from commit 8a4e3bcd8d26a50c6d5f4417102f71f8e2e2d70d)

3 files changed, 119 insertions, 3 deletions

diff --git a/tests/support/cluster_helper.tcl b/tests/support/cluster_helper.tcl
new file mode 100644
index 000000000..42b99ca83
--- /dev/null
+++ b/tests/support/cluster_helper.tcl
@@ -0,0 +1,96 @@
+# Helper functions specifically for setting up and configuring redis
+# clusters.
+
+# Check if cluster configuration is consistent.
+proc cluster_config_consistent {} {
+    for {set j 0} {$j < [llength $::servers]} {incr j} {
+        if {$j == 0} {
+            set base_cfg [R $j cluster slots]
+        } else {
+            if {[R $j cluster slots] != $base_cfg} {
+                return 0
+            }
+        }
+    }
+
+    return 1
+}
+
+# Wait for cluster configuration to propagate and be consistent across nodes.
+proc wait_for_cluster_propagation {} {
+    wait_for_condition 50 100 {
+        [cluster_config_consistent] eq 1
+    } else {
+        fail "cluster config did not reach a consistent state"
+    }
+}
+
+# Check that cluster nodes agree about "state", or raise an error.
+proc wait_for_cluster_state {state} {
+    for {set j 0} {$j < [llength $::servers]} {incr j} {
+        wait_for_condition 100 50 {
+            [CI $j cluster_state] eq $state
+        } else {
+            fail "Cluster node $j cluster_state:[CI $j cluster_state]"
+        }
+    }
+}
+
+# Default slot allocation for clusters, each master has a continuous block
+# and approximately equal number of slots.
+proc continuous_slot_allocation {masters} {
+    set avg [expr double(16384) / $masters]
+    set slot_start 0
+    for {set j 0} {$j < $masters} {incr j} {
+        set slot_end [expr int(ceil(($j + 1) * $avg) - 1)]
+        R $j cluster addslotsrange $slot_start $slot_end
+        set slot_start [expr $slot_end + 1]
+    }
+}
+
+# Setup method to be executed to configure the cluster before the
+# tests run.
+proc cluster_setup {masters node_count slot_allocator code} {
+    # Have all nodes meet
+    for {set i 1} {$i < $node_count} {incr i} {
+        R 0 CLUSTER MEET [srv -$i host] [srv -$i port]
+    }
+
+    $slot_allocator $masters
+
+    wait_for_cluster_propagation
+
+    # Setup master/replica relationships
+    for {set i 0} {$i < $masters} {incr i} {
+        set nodeid [R $i CLUSTER MYID]
+        for {set j [expr $i + $masters]} {$j < $node_count} {incr j $masters} {
+            R $j CLUSTER REPLICATE $nodeid
+        }
+    }
+
+    wait_for_cluster_propagation
+    wait_for_cluster_state "ok"
+
+    uplevel 1 $code
+}
+
+# Start a cluster with the given number of masters and replicas. Replicas
+# will be allocated to masters by round robin.
+proc start_cluster {masters replicas options code {slot_allocator continuous_slot_allocation}} {
+    set node_count [expr $masters + $replicas]
+
+    # Set the final code to be the tests + cluster setup
+    set code [list cluster_setup $masters $node_count $slot_allocator $code]
+
+    # Configure the starting of multiple servers. Set cluster node timeout
+    # aggressively since many tests depend on ping/pong messages. 
+    set cluster_options [list overrides [list cluster-enabled yes cluster-node-timeout 500]]
+    set options [concat $cluster_options $options]
+
+    # Cluster mode only supports a single database, so before executing the tests
+    # it needs to be configured correctly and needs to be reset after the tests. 
+    set old_singledb $::singledb
+    set ::singledb 1
+    start_multiple_servers $node_count $options $code
+    set ::singledb $old_singledb
+}
diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 4a993f552..b673b70ae 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -253,12 +253,15 @@ proc tags {tags code} {
 
 # Write the configuration in the dictionary 'config' in the specified
 # file name.
-proc create_server_config_file {filename config} {
+proc create_server_config_file {filename config config_lines} {
     set fp [open $filename w+]
     foreach directive [dict keys $config] {
         puts -nonewline $fp "$directive "
         puts $fp [dict get $config $directive]
     }
+    foreach {config_line_directive config_line_args} $config_lines {
+        puts $fp "$config_line_directive $config_line_args"
+    }
     close $fp
 }
 
@@ -406,6 +409,7 @@ proc start_server {options {code undefined}} {
     set tags {}
     set args {}
     set keep_persistence false
+    set config_lines {}
 
     # parse options
     foreach {option value} $options {
@@ -416,6 +420,9 @@ proc start_server {options {code undefined}} {
             "overrides" {
                 set overrides $value
             }
+            "config_lines" {
+                set config_lines $value
+            }
             "args" {
                 set args $value
             }
@@ -503,7 +510,7 @@ proc start_server {options {code undefined}} {
 
     # write new configuration to temporary file
     set config_file [tmpfile redis.conf]
-    create_server_config_file $config_file $config
+    create_server_config_file $config_file $config $config_lines
 
     set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
@@ -544,7 +551,7 @@ proc start_server {options {code undefined}} {
             } else {
                 dict set config port $port
             }
-            create_server_config_file $config_file $config
+            create_server_config_file $config_file $config $config_lines
 
             # Truncate log so wait_server_started will not be looking at
             # output of the failed server.
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index f6b04c89c..6f7d14782 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -8,6 +8,7 @@ set tcl_precision 17
 source tests/support/redis.tcl
 source tests/support/aofmanifest.tcl
 source tests/support/server.tcl
+source tests/support/cluster_helper.tcl
 source tests/support/tmpfile.tcl
 source tests/support/test.tcl
 source tests/support/util.tcl
@@ -198,6 +199,13 @@ proc r {args} {
     [srv $level "client"] {*}$args
 }
 
+# Provide easy access to a client for an inner server. Requires a positive
+# index, unlike r which uses an optional negative index.
+proc R {n args} {
+    set level [expr -1*$n]
+    [srv $level "client"] {*}$args
+}
+
 proc reconnect {args} {
     set level [lindex $args 0]
     if {[string length $level] == 0 || ![string is integer $level]} {
@@ -276,6 +284,11 @@ proc s {args} {
     status [srv $level "client"] [lindex $args 0]
 }
 
+# Get the specified field from the givens instances cluster info output.
+proc CI {index field} {
+    getInfoProperty [R $index cluster info] $field
+}
+
 # Provide easy access to CLUSTER INFO properties. Same semantic as "proc s".
 proc csi {args} {
     set level 0