1# Tcl redis cluster client as a wrapper of redis.rb. 2# Copyright (C) 2014 Salvatore Sanfilippo 3# Released under the BSD license like Redis itself 4# 5# Example usage: 6# 7# set c [redis_cluster 127.0.0.1 6379 127.0.0.1 6380] 8# $c set foo 9# $c get foo 10# $c close 11 12package require Tcl 8.5 13package provide redis_cluster 0.1 14 15namespace eval redis_cluster {} 16set ::redis_cluster::id 0 17array set ::redis_cluster::startup_nodes {} 18array set ::redis_cluster::nodes {} 19array set ::redis_cluster::slots {} 20 21# List of "plain" commands, which are commands where the sole key is always 22# the first argument. 23set ::redis_cluster::plain_commands { 24 get set setnx setex psetex append strlen exists setbit getbit 25 setrange getrange substr incr decr rpush lpush rpushx lpushx 26 linsert rpop lpop brpop llen lindex lset lrange ltrim lrem 27 sadd srem sismember scard spop srandmember smembers sscan zadd 28 zincrby zrem zremrangebyscore zremrangebyrank zremrangebylex zrange 29 zrangebyscore zrevrangebyscore zrangebylex zrevrangebylex zcount 30 zlexcount zrevrange zcard zscore zrank zrevrank zscan hset hsetnx 31 hget hmset hmget hincrby hincrbyfloat hdel hlen hkeys hvals 32 hgetall hexists hscan incrby decrby incrbyfloat getset move 33 expire expireat pexpire pexpireat type ttl pttl persist restore 34 dump bitcount bitpos pfadd pfcount 35} 36 37proc redis_cluster {nodes} { 38 set id [incr ::redis_cluster::id] 39 set ::redis_cluster::startup_nodes($id) $nodes 40 set ::redis_cluster::nodes($id) {} 41 set ::redis_cluster::slots($id) {} 42 set handle [interp alias {} ::redis_cluster::instance$id {} ::redis_cluster::__dispatch__ $id] 43 $handle refresh_nodes_map 44 return $handle 45} 46 47# Totally reset the slots / nodes state for the client, calls 48# CLUSTER NODES in the first startup node available, populates the 49# list of nodes ::redis_cluster::nodes($id) with an hash mapping node 50# ip:port to a representation of the node (another hash), and finally 51# maps ::redis_cluster::slots($id) with an hash mapping slot numbers 52# to node IDs. 53# 54# This function is called when a new Redis Cluster client is initialized 55# and every time we get a -MOVED redirection error. 56proc ::redis_cluster::__method__refresh_nodes_map {id} { 57 # Contact the first responding startup node. 58 set idx 0; # Index of the node that will respond. 59 set errmsg {} 60 foreach start_node $::redis_cluster::startup_nodes($id) { 61 set ip_port [lindex [split $start_node @] 0] 62 lassign [split $ip_port :] start_host start_port 63 if {[catch { 64 set r {} 65 set r [redis $start_host $start_port 0 $::tls] 66 set nodes_descr [$r cluster nodes] 67 $r close 68 } e]} { 69 if {$r ne {}} {catch {$r close}} 70 incr idx 71 if {[string length $errmsg] < 200} { 72 append errmsg " $ip_port: $e" 73 } 74 continue ; # Try next. 75 } else { 76 break; # Good node found. 77 } 78 } 79 80 if {$idx == [llength $::redis_cluster::startup_nodes($id)]} { 81 error "No good startup node found. $errmsg" 82 } 83 84 # Put the node that responded as first in the list if it is not 85 # already the first. 86 if {$idx != 0} { 87 set l $::redis_cluster::startup_nodes($id) 88 set left [lrange $l 0 [expr {$idx-1}]] 89 set right [lrange $l [expr {$idx+1}] end] 90 set l [concat [lindex $l $idx] $left $right] 91 set ::redis_cluster::startup_nodes($id) $l 92 } 93 94 # Parse CLUSTER NODES output to populate the nodes description. 95 set nodes {} ; # addr -> node description hash. 96 foreach line [split $nodes_descr "\n"] { 97 set line [string trim $line] 98 if {$line eq {}} continue 99 set args [split $line " "] 100 lassign $args nodeid addr flags slaveof pingsent pongrecv configepoch linkstate 101 set slots [lrange $args 8 end] 102 set addr [lindex [split $addr @] 0] 103 if {$addr eq {:0}} { 104 set addr $start_host:$start_port 105 } 106 lassign [split $addr :] host port 107 108 # Connect to the node 109 set link {} 110 catch {set link [redis $host $port 0 $::tls]} 111 112 # Build this node description as an hash. 113 set node [dict create \ 114 id $nodeid \ 115 addr $addr \ 116 host $host \ 117 port $port \ 118 flags $flags \ 119 slaveof $slaveof \ 120 slots $slots \ 121 link $link \ 122 ] 123 dict set nodes $addr $node 124 lappend ::redis_cluster::startup_nodes($id) $addr 125 } 126 127 # Close all the existing links in the old nodes map, and set the new 128 # map as current. 129 foreach n $::redis_cluster::nodes($id) { 130 catch { 131 [dict get $n link] close 132 } 133 } 134 set ::redis_cluster::nodes($id) $nodes 135 136 # Populates the slots -> nodes map. 137 dict for {addr node} $nodes { 138 foreach slotrange [dict get $node slots] { 139 lassign [split $slotrange -] start end 140 if {$end == {}} {set end $start} 141 for {set j $start} {$j <= $end} {incr j} { 142 dict set ::redis_cluster::slots($id) $j $addr 143 } 144 } 145 } 146 147 # Only retain unique entries in the startup nodes list 148 set ::redis_cluster::startup_nodes($id) [lsort -unique $::redis_cluster::startup_nodes($id)] 149} 150 151# Free a redis_cluster handle. 152proc ::redis_cluster::__method__close {id} { 153 catch { 154 set nodes $::redis_cluster::nodes($id) 155 dict for {addr node} $nodes { 156 catch { 157 [dict get $node link] close 158 } 159 } 160 } 161 catch {unset ::redis_cluster::startup_nodes($id)} 162 catch {unset ::redis_cluster::nodes($id)} 163 catch {unset ::redis_cluster::slots($id)} 164 catch {interp alias {} ::redis_cluster::instance$id {}} 165} 166 167proc ::redis_cluster::__dispatch__ {id method args} { 168 if {[info command ::redis_cluster::__method__$method] eq {}} { 169 # Get the keys from the command. 170 set keys [::redis_cluster::get_keys_from_command $method $args] 171 if {$keys eq {}} { 172 error "Redis command '$method' is not supported by redis_cluster." 173 } 174 175 # Resolve the keys in the corresponding hash slot they hash to. 176 set slot [::redis_cluster::get_slot_from_keys $keys] 177 if {$slot eq {}} { 178 error "Invalid command: multiple keys not hashing to the same slot." 179 } 180 181 # Get the node mapped to this slot. 182 set node_addr [dict get $::redis_cluster::slots($id) $slot] 183 if {$node_addr eq {}} { 184 error "No mapped node for slot $slot." 185 } 186 187 # Execute the command in the node we think is the slot owner. 188 set retry 100 189 while {[incr retry -1]} { 190 if {$retry < 5} {after 100} 191 set node [dict get $::redis_cluster::nodes($id) $node_addr] 192 set link [dict get $node link] 193 if {[catch {$link $method {*}$args} e]} { 194 if {$link eq {} || \ 195 [string range $e 0 4] eq {MOVED} || \ 196 [string range $e 0 2] eq {I/O} \ 197 } { 198 # MOVED redirection. 199 ::redis_cluster::__method__refresh_nodes_map $id 200 set node_addr [dict get $::redis_cluster::slots($id) $slot] 201 continue 202 } elseif {[string range $e 0 2] eq {ASK}} { 203 # ASK redirection. 204 set node_addr [lindex $e 2] 205 continue 206 } else { 207 # Non redirecting error. 208 error $e $::errorInfo $::errorCode 209 } 210 } else { 211 # OK query went fine 212 return $e 213 } 214 } 215 error "Too many redirections or failures contacting Redis Cluster." 216 } else { 217 uplevel 1 [list ::redis_cluster::__method__$method $id] $args 218 } 219} 220 221proc ::redis_cluster::get_keys_from_command {cmd argv} { 222 set cmd [string tolower $cmd] 223 # Most Redis commands get just one key as first argument. 224 if {[lsearch -exact $::redis_cluster::plain_commands $cmd] != -1} { 225 return [list [lindex $argv 0]] 226 } 227 228 # Special handling for other commands 229 switch -exact $cmd { 230 mget {return $argv} 231 eval {return [lrange $argv 2 1+[lindex $argv 1]]} 232 evalsha {return [lrange $argv 2 1+[lindex $argv 1]]} 233 } 234 235 # All the remaining commands are not handled. 236 return {} 237} 238 239# Returns the CRC16 of the specified string. 240# The CRC parameters are described in the Redis Cluster specification. 241set ::redis_cluster::XMODEMCRC16Lookup { 242 0x0000 0x1021 0x2042 0x3063 0x4084 0x50a5 0x60c6 0x70e7 243 0x8108 0x9129 0xa14a 0xb16b 0xc18c 0xd1ad 0xe1ce 0xf1ef 244 0x1231 0x0210 0x3273 0x2252 0x52b5 0x4294 0x72f7 0x62d6 245 0x9339 0x8318 0xb37b 0xa35a 0xd3bd 0xc39c 0xf3ff 0xe3de 246 0x2462 0x3443 0x0420 0x1401 0x64e6 0x74c7 0x44a4 0x5485 247 0xa56a 0xb54b 0x8528 0x9509 0xe5ee 0xf5cf 0xc5ac 0xd58d 248 0x3653 0x2672 0x1611 0x0630 0x76d7 0x66f6 0x5695 0x46b4 249 0xb75b 0xa77a 0x9719 0x8738 0xf7df 0xe7fe 0xd79d 0xc7bc 250 0x48c4 0x58e5 0x6886 0x78a7 0x0840 0x1861 0x2802 0x3823 251 0xc9cc 0xd9ed 0xe98e 0xf9af 0x8948 0x9969 0xa90a 0xb92b 252 0x5af5 0x4ad4 0x7ab7 0x6a96 0x1a71 0x0a50 0x3a33 0x2a12 253 0xdbfd 0xcbdc 0xfbbf 0xeb9e 0x9b79 0x8b58 0xbb3b 0xab1a 254 0x6ca6 0x7c87 0x4ce4 0x5cc5 0x2c22 0x3c03 0x0c60 0x1c41 255 0xedae 0xfd8f 0xcdec 0xddcd 0xad2a 0xbd0b 0x8d68 0x9d49 256 0x7e97 0x6eb6 0x5ed5 0x4ef4 0x3e13 0x2e32 0x1e51 0x0e70 257 0xff9f 0xefbe 0xdfdd 0xcffc 0xbf1b 0xaf3a 0x9f59 0x8f78 258 0x9188 0x81a9 0xb1ca 0xa1eb 0xd10c 0xc12d 0xf14e 0xe16f 259 0x1080 0x00a1 0x30c2 0x20e3 0x5004 0x4025 0x7046 0x6067 260 0x83b9 0x9398 0xa3fb 0xb3da 0xc33d 0xd31c 0xe37f 0xf35e 261 0x02b1 0x1290 0x22f3 0x32d2 0x4235 0x5214 0x6277 0x7256 262 0xb5ea 0xa5cb 0x95a8 0x8589 0xf56e 0xe54f 0xd52c 0xc50d 263 0x34e2 0x24c3 0x14a0 0x0481 0x7466 0x6447 0x5424 0x4405 264 0xa7db 0xb7fa 0x8799 0x97b8 0xe75f 0xf77e 0xc71d 0xd73c 265 0x26d3 0x36f2 0x0691 0x16b0 0x6657 0x7676 0x4615 0x5634 266 0xd94c 0xc96d 0xf90e 0xe92f 0x99c8 0x89e9 0xb98a 0xa9ab 267 0x5844 0x4865 0x7806 0x6827 0x18c0 0x08e1 0x3882 0x28a3 268 0xcb7d 0xdb5c 0xeb3f 0xfb1e 0x8bf9 0x9bd8 0xabbb 0xbb9a 269 0x4a75 0x5a54 0x6a37 0x7a16 0x0af1 0x1ad0 0x2ab3 0x3a92 270 0xfd2e 0xed0f 0xdd6c 0xcd4d 0xbdaa 0xad8b 0x9de8 0x8dc9 271 0x7c26 0x6c07 0x5c64 0x4c45 0x3ca2 0x2c83 0x1ce0 0x0cc1 272 0xef1f 0xff3e 0xcf5d 0xdf7c 0xaf9b 0xbfba 0x8fd9 0x9ff8 273 0x6e17 0x7e36 0x4e55 0x5e74 0x2e93 0x3eb2 0x0ed1 0x1ef0 274} 275 276proc ::redis_cluster::crc16 {s} { 277 set s [encoding convertto ascii $s] 278 set crc 0 279 foreach char [split $s {}] { 280 scan $char %c byte 281 set crc [expr {(($crc<<8)&0xffff) ^ [lindex $::redis_cluster::XMODEMCRC16Lookup [expr {(($crc>>8)^$byte) & 0xff}]]}] 282 } 283 return $crc 284} 285 286# Hash a single key returning the slot it belongs to, Implemented hash 287# tags as described in the Redis Cluster specification. 288proc ::redis_cluster::hash {key} { 289 set keylen [string length $key] 290 set s {} 291 set e {} 292 for {set s 0} {$s < $keylen} {incr s} { 293 if {[string index $key $s] eq "\{"} break 294 } 295 296 if {[expr {$s == $keylen}]} { 297 set res [expr {[crc16 $key] & 16383}] 298 return $res 299 } 300 301 for {set e [expr {$s+1}]} {$e < $keylen} {incr e} { 302 if {[string index $key $e] == "\}"} break 303 } 304 305 if {$e == $keylen || $e == [expr {$s+1}]} { 306 set res [expr {[crc16 $key] & 16383}] 307 return $res 308 } 309 310 set key_sub [string range $key [expr {$s+1}] [expr {$e-1}]] 311 return [expr {[crc16 $key_sub] & 16383}] 312} 313 314# Return the slot the specified keys hash to. 315# If the keys hash to multiple slots, an empty string is returned to 316# signal that the command can't be run in Redis Cluster. 317proc ::redis_cluster::get_slot_from_keys {keys} { 318 set slot {} 319 foreach k $keys { 320 set s [::redis_cluster::hash $k] 321 if {$slot eq {}} { 322 set slot $s 323 } elseif {$slot != $s} { 324 return {} ; # Error 325 } 326 } 327 return $slot 328} 329