Add cluster slot migration tests (#8649)

Add tests for fixing migrating slot at all stages:

1. when migration is half inited on "migrating" node
2. when migration is half inited on "importing" node
3. migration inited, but not finished
4. migration is half finished on "migrating" node
5. migration is half finished on "importing" node

Also add tests for many simultaneous slot migrations.

Co-authored-by: Yossi Gottlieb <yossigo@gmail.com>

tests/cluster/tests/20-half-migrated-slot.tcl

@@ -0,0 +1,86 @@
+# Tests for fixing migrating slot at all stages:
+# 1. when migration is half inited on "migrating" node
+# 2. when migration is half inited on "importing" node
+# 3. migration inited, but not finished
+# 4. migration is half finished on "migrating" node
+# 5. migration is half finished on "importing" node
+source "../tests/includes/init-tests.tcl"
+source "../tests/includes/utils.tcl"
+
+test "Create a 2 nodes cluster" {
+    create_cluster 2 0
+}
+
+test "Cluster is up" {
+    assert_cluster_state ok
+}
+
+set cluster [redis_cluster 127.0.0.1:[get_instance_attrib redis 0 port]]
+catch {unset nodefrom}
+catch {unset nodeto}
+
+proc reset_cluster {} {
+    uplevel 1 {
+        $cluster refresh_nodes_map
+        array set nodefrom [$cluster masternode_for_slot 609]
+        array set nodeto [$cluster masternode_notfor_slot 609]
+    }
+}
+
+reset_cluster
+
+$cluster set aga xyz
+
+test "Half init migration in 'migrating' is fixable" {
+    $nodefrom(link) cluster setslot 609 migrating $nodeto(id)
+    fix_cluster $nodefrom(addr)
+    assert {[$cluster get aga] eq "xyz"}
+}
+
+test "Half init migration in 'importing' is fixable" {
+    $nodeto(link) cluster setslot 609 importing $nodefrom(id)
+    fix_cluster $nodefrom(addr)
+    assert {[$cluster get aga] eq "xyz"}
+}
+
+test "Init migration and move key" {
+    $nodefrom(link) cluster setslot 609 migrating $nodeto(id)
+    $nodeto(link) cluster setslot 609 importing $nodefrom(id)
+    $nodefrom(link) migrate $nodeto(host) $nodeto(port) aga 0 10000
+    assert {[$cluster get aga] eq "xyz"}
+    fix_cluster $nodefrom(addr)
+    assert {[$cluster get aga] eq "xyz"}
+}
+
+reset_cluster
+
+test "Move key again" {
+    $nodefrom(link) cluster setslot 609 migrating $nodeto(id)
+    $nodeto(link) cluster setslot 609 importing $nodefrom(id)
+    $nodefrom(link) migrate $nodeto(host) $nodeto(port) aga 0 10000
+    assert {[$cluster get aga] eq "xyz"}
+}
+
+test "Half-finish migration" {
+    # half finish migration on 'migrating' node
+    $nodefrom(link) cluster setslot 609 node $nodeto(id)
+    fix_cluster $nodefrom(addr)
+    assert {[$cluster get aga] eq "xyz"}
+}
+
+reset_cluster
+
+test "Move key back" {
+    # 'aga' key is in 609 slot
+    $nodefrom(link) cluster setslot 609 migrating $nodeto(id)
+    $nodeto(link) cluster setslot 609 importing $nodefrom(id)
+    $nodefrom(link) migrate $nodeto(host) $nodeto(port) aga 0 10000
+    assert {[$cluster get aga] eq "xyz"}
+}
+
+test "Half-finish importing" {
+    # Now we half finish 'importing' node
+    $nodeto(link) cluster setslot 609 node $nodeto(id)
+    fix_cluster $nodefrom(addr)
+    assert {[$cluster get aga] eq "xyz"}
+}

tests/cluster/tests/21-many-slot-migration.tcl

@@ -0,0 +1,51 @@
+# Tests for many simlutaneous migrations.
+
+source "../tests/includes/init-tests.tcl"
+source "../tests/includes/utils.tcl"
+
+test "Create a 10 nodes cluster" {
+    create_cluster 10 10
+}
+
+test "Cluster is up" {
+    assert_cluster_state ok
+}
+
+set cluster [redis_cluster 127.0.0.1:[get_instance_attrib redis 0 port]]
+catch {unset nodefrom}
+catch {unset nodeto}
+
+$cluster refresh_nodes_map
+
+test "Set many keys" {
+    for {set i 0} {$i < 40000} {incr i} {
+        $cluster set key:$i val:$i
+    }
+}
+
+test "Keys are accessible" {
+    for {set i 0} {$i < 40000} {incr i} {
+        assert { [$cluster get key:$i] eq "val:$i" }
+    }
+}
+
+test "Init migration of many slots" {
+    for {set slot 0} {$slot < 1000} {incr slot} {
+        array set nodefrom [$cluster masternode_for_slot $slot]
+        array set nodeto [$cluster masternode_notfor_slot $slot]
+
+        $nodefrom(link) cluster setslot $slot migrating $nodeto(id)
+        $nodeto(link) cluster setslot $slot importing $nodefrom(id)
+    }
+}
+
+test "Fix cluster" {
+    fix_cluster $nodefrom(addr)
+}
+
+test "Keys are accessible" {
+    for {set i 0} {$i < 40000} {incr i} {
+        assert { [$cluster get key:$i] eq "val:$i" }
+    }
+}
+

tests/cluster/tests/includes/utils.tcl

@@ -0,0 +1,17 @@
+source "../../../tests/support/cli.tcl"
+
+proc fix_cluster {addr} {
+    set code [catch {
+        exec ../../../src/redis-cli {*}[rediscli_tls_config "../../../tests"] --cluster fix $addr << yes
+    } result]
+    if {$code != 0 && $::verbose} {
+        puts $result
+    }
+    assert {$code == 0}
+    assert_cluster_state ok
+    wait_for_condition 1000 10 {
+        [catch {exec ../../../src/redis-cli {*}[rediscli_tls_config "../../../tests"] --cluster check $addr} _] == 0
+    } else {
+        fail "Cluster could not settle with configuration"
+    }
+}

tests/support/cluster.tcl

@@ -164,6 +164,28 @@ proc ::redis_cluster::__method__close {id} {
     catch {interp alias {} ::redis_cluster::instance$id {}}
 }
 
+proc ::redis_cluster::__method__masternode_for_slot {id slot} {
+    # Get the node mapped to this slot.
+    set node_addr [dict get $::redis_cluster::slots($id) $slot]
+    if {$node_addr eq {}} {
+        error "No mapped node for slot $slot."
+    }
+    return [dict get $::redis_cluster::nodes($id) $node_addr]
+}
+
+proc ::redis_cluster::__method__masternode_notfor_slot {id slot} {
+    # Get a node that is not mapped to this slot.
+    set node_addr [dict get $::redis_cluster::slots($id) $slot]
+    set addrs [dict keys $::redis_cluster::nodes($id)]
+    foreach addr [lshuffle $addrs] {
+        set node [dict get $::redis_cluster::nodes($id) $addr]
+        if {$node_addr ne $addr && [dict get $node slaveof] eq "-"} {
+            return $node
+        }
+    }
+    error "Slot $slot is everywhere"
+}
+
 proc ::redis_cluster::__dispatch__ {id method args} {
     if {[info command ::redis_cluster::__method__$method] eq {}} {
         # Get the keys from the command.
@@ -186,10 +208,15 @@ proc ::redis_cluster::__dispatch__ {id method args} {
 
         # Execute the command in the node we think is the slot owner.
         set retry 100
+        set asking 0
         while {[incr retry -1]} {
             if {$retry < 5} {after 100}
             set node [dict get $::redis_cluster::nodes($id) $node_addr]
             set link [dict get $node link]
+            if {$asking} {
+                $link ASKING
+                set asking 0
+            }
             if {[catch {$link $method {*}$args} e]} {
                 if {$link eq {} || \
                     [string range $e 0 4] eq {MOVED} || \
@@ -202,6 +229,7 @@ proc ::redis_cluster::__dispatch__ {id method args} {
                 } elseif {[string range $e 0 2] eq {ASK}} {
                     # ASK redirection.
                     set node_addr [lindex $e 2]
+                    set asking 1
                     continue
                 } else {
                     # Non redirecting error.

tests/support/util.tcl

@@ -506,18 +506,18 @@ proc stop_write_load {handle} {
 
 proc K { x y } { set x } 
 
-# Shuffle a list. From Tcl wiki. Originally from Steve Cohen that improved
-# other versions. Code should be under public domain.
+# Shuffle a list with Fisher-Yates algorithm.
 proc lshuffle {list} {
     set n [llength $list]
-    while {$n>0} {
+    while {$n>1} {
         set j [expr {int(rand()*$n)}]
-        lappend slist [lindex $list $j]
         incr n -1
-        set temp [lindex $list $n]
-        set list [lreplace [K $list [set list {}]] $j $j $temp]
+        if {$n==$j} continue
+        set v [lindex $list $j]
+        lset list $j [lindex $list $n]
+        lset list $n $v
     }
-    return $slist
+    return $list
 }
 
 # Execute a background process writing complex data for the specified number