summaryrefslogtreecommitdiff
path: root/tests/support
diff options
context:
space:
mode:
Diffstat (limited to 'tests/support')
-rw-r--r--tests/support/cluster.tcl307
-rw-r--r--tests/support/redis.tcl294
-rw-r--r--tests/support/server.tcl329
-rw-r--r--tests/support/test.tcl127
-rw-r--r--tests/support/tmpfile.tcl15
-rw-r--r--tests/support/util.tcl377
6 files changed, 1449 insertions, 0 deletions
diff --git a/tests/support/cluster.tcl b/tests/support/cluster.tcl
new file mode 100644
index 0000000..1576053
--- /dev/null
+++ b/tests/support/cluster.tcl
@@ -0,0 +1,307 @@
+# Tcl redis cluster client as a wrapper of redis.rb.
+# Copyright (C) 2014 Salvatore Sanfilippo
+# Released under the BSD license like Redis itself
+#
+# Example usage:
+#
+# set c [redis_cluster 127.0.0.1 6379 127.0.0.1 6380]
+# $c set foo
+# $c get foo
+# $c close
+
+package require Tcl 8.5
+package provide redis_cluster 0.1
+
+namespace eval redis_cluster {}
+set ::redis_cluster::id 0
+array set ::redis_cluster::startup_nodes {}
+array set ::redis_cluster::nodes {}
+array set ::redis_cluster::slots {}
+
+# List of "plain" commands, which are commands where the sole key is always
+# the first argument.
+set ::redis_cluster::plain_commands {
+ get set setnx setex psetex append strlen exists setbit getbit
+ setrange getrange substr incr decr rpush lpush rpushx lpushx
+ linsert rpop lpop brpop llen lindex lset lrange ltrim lrem
+ sadd srem sismember scard spop srandmember smembers sscan zadd
+ zincrby zrem zremrangebyscore zremrangebyrank zremrangebylex zrange
+ zrangebyscore zrevrangebyscore zrangebylex zrevrangebylex zcount
+ zlexcount zrevrange zcard zscore zrank zrevrank zscan hset hsetnx
+ hget hmset hmget hincrby hincrbyfloat hdel hlen hkeys hvals
+ hgetall hexists hscan incrby decrby incrbyfloat getset move
+ expire expireat pexpire pexpireat type ttl pttl persist restore
+ dump bitcount bitpos pfadd pfcount
+}
+
+proc redis_cluster {nodes} {
+ set id [incr ::redis_cluster::id]
+ set ::redis_cluster::startup_nodes($id) $nodes
+ set ::redis_cluster::nodes($id) {}
+ set ::redis_cluster::slots($id) {}
+ set handle [interp alias {} ::redis_cluster::instance$id {} ::redis_cluster::__dispatch__ $id]
+ $handle refresh_nodes_map
+ return $handle
+}
+
+# Totally reset the slots / nodes state for the client, calls
+# CLUSTER NODES in the first startup node available, populates the
+# list of nodes ::redis_cluster::nodes($id) with an hash mapping node
+# ip:port to a representation of the node (another hash), and finally
+# maps ::redis_cluster::slots($id) with an hash mapping slot numbers
+# to node IDs.
+#
+# This function is called when a new Redis Cluster client is initialized
+# and every time we get a -MOVED redirection error.
+proc ::redis_cluster::__method__refresh_nodes_map {id} {
+ # Contact the first responding startup node.
+ set idx 0; # Index of the node that will respond.
+ set errmsg {}
+ foreach start_node $::redis_cluster::startup_nodes($id) {
+ set ip_port [lindex [split $start_node @] 0]
+ lassign [split $ip_port :] start_host start_port
+ if {[catch {
+ set r {}
+ set r [redis $start_host $start_port]
+ set nodes_descr [$r cluster nodes]
+ $r close
+ } e]} {
+ if {$r ne {}} {catch {$r close}}
+ incr idx
+ if {[string length $errmsg] < 200} {
+ append errmsg " $ip_port: $e"
+ }
+ continue ; # Try next.
+ } else {
+ break; # Good node found.
+ }
+ }
+
+ if {$idx == [llength $::redis_cluster::startup_nodes($id)]} {
+ error "No good startup node found. $errmsg"
+ }
+
+ # Put the node that responded as first in the list if it is not
+ # already the first.
+ if {$idx != 0} {
+ set l $::redis_cluster::startup_nodes($id)
+ set left [lrange $l 0 [expr {$idx-1}]]
+ set right [lrange $l [expr {$idx+1}] end]
+ set l [concat [lindex $l $idx] $left $right]
+ set ::redis_cluster::startup_nodes($id) $l
+ }
+
+ # Parse CLUSTER NODES output to populate the nodes description.
+ set nodes {} ; # addr -> node description hash.
+ foreach line [split $nodes_descr "\n"] {
+ set line [string trim $line]
+ if {$line eq {}} continue
+ set args [split $line " "]
+ lassign $args nodeid addr flags slaveof pingsent pongrecv configepoch linkstate
+ set slots [lrange $args 8 end]
+ set addr [lindex [split $addr @] 0]
+ if {$addr eq {:0}} {
+ set addr $start_host:$start_port
+ }
+ lassign [split $addr :] host port
+
+ # Connect to the node
+ set link {}
+ catch {set link [redis $host $port]}
+
+ # Build this node description as an hash.
+ set node [dict create \
+ id $nodeid \
+ addr $addr \
+ host $host \
+ port $port \
+ flags $flags \
+ slaveof $slaveof \
+ slots $slots \
+ link $link \
+ ]
+ dict set nodes $addr $node
+ lappend ::redis_cluster::startup_nodes($id) $addr
+ }
+
+ # Close all the existing links in the old nodes map, and set the new
+ # map as current.
+ foreach n $::redis_cluster::nodes($id) {
+ catch {
+ [dict get $n link] close
+ }
+ }
+ set ::redis_cluster::nodes($id) $nodes
+
+ # Populates the slots -> nodes map.
+ dict for {addr node} $nodes {
+ foreach slotrange [dict get $node slots] {
+ lassign [split $slotrange -] start end
+ if {$end == {}} {set end $start}
+ for {set j $start} {$j <= $end} {incr j} {
+ dict set ::redis_cluster::slots($id) $j $addr
+ }
+ }
+ }
+
+ # Only retain unique entries in the startup nodes list
+ set ::redis_cluster::startup_nodes($id) [lsort -unique $::redis_cluster::startup_nodes($id)]
+}
+
+# Free a redis_cluster handle.
+proc ::redis_cluster::__method__close {id} {
+ catch {
+ set nodes $::redis_cluster::nodes($id)
+ dict for {addr node} $nodes {
+ catch {
+ [dict get $node link] close
+ }
+ }
+ }
+ catch {unset ::redis_cluster::startup_nodes($id)}
+ catch {unset ::redis_cluster::nodes($id)}
+ catch {unset ::redis_cluster::slots($id)}
+ catch {interp alias {} ::redis_cluster::instance$id {}}
+}
+
+proc ::redis_cluster::__dispatch__ {id method args} {
+ if {[info command ::redis_cluster::__method__$method] eq {}} {
+ # Get the keys from the command.
+ set keys [::redis_cluster::get_keys_from_command $method $args]
+ if {$keys eq {}} {
+ error "Redis command '$method' is not supported by redis_cluster."
+ }
+
+ # Resolve the keys in the corresponding hash slot they hash to.
+ set slot [::redis_cluster::get_slot_from_keys $keys]
+ if {$slot eq {}} {
+ error "Invalid command: multiple keys not hashing to the same 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."
+ }
+
+ # Execute the command in the node we think is the slot owner.
+ set retry 100
+ 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 {[catch {$link $method {*}$args} e]} {
+ if {$link eq {} || \
+ [string range $e 0 4] eq {MOVED} || \
+ [string range $e 0 2] eq {I/O} \
+ } {
+ # MOVED redirection.
+ ::redis_cluster::__method__refresh_nodes_map $id
+ set node_addr [dict get $::redis_cluster::slots($id) $slot]
+ continue
+ } elseif {[string range $e 0 2] eq {ASK}} {
+ # ASK redirection.
+ set node_addr [lindex $e 2]
+ continue
+ } else {
+ # Non redirecting error.
+ error $e $::errorInfo $::errorCode
+ }
+ } else {
+ # OK query went fine
+ return $e
+ }
+ }
+ error "Too many redirections or failures contacting Redis Cluster."
+ } else {
+ uplevel 1 [list ::redis_cluster::__method__$method $id] $args
+ }
+}
+
+proc ::redis_cluster::get_keys_from_command {cmd argv} {
+ set cmd [string tolower $cmd]
+ # Most Redis commands get just one key as first argument.
+ if {[lsearch -exact $::redis_cluster::plain_commands $cmd] != -1} {
+ return [list [lindex $argv 0]]
+ }
+
+ # Special handling for other commands
+ switch -exact $cmd {
+ mget {return $argv}
+ eval {return [lrange $argv 2 1+[lindex $argv 1]]}
+ evalsha {return [lrange $argv 2 1+[lindex $argv 1]]}
+ }
+
+ # All the remaining commands are not handled.
+ return {}
+}
+
+# Returns the CRC16 of the specified string.
+# The CRC parameters are described in the Redis Cluster specification.
+set ::redis_cluster::XMODEMCRC16Lookup {
+ 0x0000 0x1021 0x2042 0x3063 0x4084 0x50a5 0x60c6 0x70e7
+ 0x8108 0x9129 0xa14a 0xb16b 0xc18c 0xd1ad 0xe1ce 0xf1ef
+ 0x1231 0x0210 0x3273 0x2252 0x52b5 0x4294 0x72f7 0x62d6
+ 0x9339 0x8318 0xb37b 0xa35a 0xd3bd 0xc39c 0xf3ff 0xe3de
+ 0x2462 0x3443 0x0420 0x1401 0x64e6 0x74c7 0x44a4 0x5485
+ 0xa56a 0xb54b 0x8528 0x9509 0xe5ee 0xf5cf 0xc5ac 0xd58d
+ 0x3653 0x2672 0x1611 0x0630 0x76d7 0x66f6 0x5695 0x46b4
+ 0xb75b 0xa77a 0x9719 0x8738 0xf7df 0xe7fe 0xd79d 0xc7bc
+ 0x48c4 0x58e5 0x6886 0x78a7 0x0840 0x1861 0x2802 0x3823
+ 0xc9cc 0xd9ed 0xe98e 0xf9af 0x8948 0x9969 0xa90a 0xb92b
+ 0x5af5 0x4ad4 0x7ab7 0x6a96 0x1a71 0x0a50 0x3a33 0x2a12
+ 0xdbfd 0xcbdc 0xfbbf 0xeb9e 0x9b79 0x8b58 0xbb3b 0xab1a
+ 0x6ca6 0x7c87 0x4ce4 0x5cc5 0x2c22 0x3c03 0x0c60 0x1c41
+ 0xedae 0xfd8f 0xcdec 0xddcd 0xad2a 0xbd0b 0x8d68 0x9d49
+ 0x7e97 0x6eb6 0x5ed5 0x4ef4 0x3e13 0x2e32 0x1e51 0x0e70
+ 0xff9f 0xefbe 0xdfdd 0xcffc 0xbf1b 0xaf3a 0x9f59 0x8f78
+ 0x9188 0x81a9 0xb1ca 0xa1eb 0xd10c 0xc12d 0xf14e 0xe16f
+ 0x1080 0x00a1 0x30c2 0x20e3 0x5004 0x4025 0x7046 0x6067
+ 0x83b9 0x9398 0xa3fb 0xb3da 0xc33d 0xd31c 0xe37f 0xf35e
+ 0x02b1 0x1290 0x22f3 0x32d2 0x4235 0x5214 0x6277 0x7256
+ 0xb5ea 0xa5cb 0x95a8 0x8589 0xf56e 0xe54f 0xd52c 0xc50d
+ 0x34e2 0x24c3 0x14a0 0x0481 0x7466 0x6447 0x5424 0x4405
+ 0xa7db 0xb7fa 0x8799 0x97b8 0xe75f 0xf77e 0xc71d 0xd73c
+ 0x26d3 0x36f2 0x0691 0x16b0 0x6657 0x7676 0x4615 0x5634
+ 0xd94c 0xc96d 0xf90e 0xe92f 0x99c8 0x89e9 0xb98a 0xa9ab
+ 0x5844 0x4865 0x7806 0x6827 0x18c0 0x08e1 0x3882 0x28a3
+ 0xcb7d 0xdb5c 0xeb3f 0xfb1e 0x8bf9 0x9bd8 0xabbb 0xbb9a
+ 0x4a75 0x5a54 0x6a37 0x7a16 0x0af1 0x1ad0 0x2ab3 0x3a92
+ 0xfd2e 0xed0f 0xdd6c 0xcd4d 0xbdaa 0xad8b 0x9de8 0x8dc9
+ 0x7c26 0x6c07 0x5c64 0x4c45 0x3ca2 0x2c83 0x1ce0 0x0cc1
+ 0xef1f 0xff3e 0xcf5d 0xdf7c 0xaf9b 0xbfba 0x8fd9 0x9ff8
+ 0x6e17 0x7e36 0x4e55 0x5e74 0x2e93 0x3eb2 0x0ed1 0x1ef0
+}
+
+proc ::redis_cluster::crc16 {s} {
+ set s [encoding convertto ascii $s]
+ set crc 0
+ foreach char [split $s {}] {
+ scan $char %c byte
+ set crc [expr {(($crc<<8)&0xffff) ^ [lindex $::redis_cluster::XMODEMCRC16Lookup [expr {(($crc>>8)^$byte) & 0xff}]]}]
+ }
+ return $crc
+}
+
+# Hash a single key returning the slot it belongs to, Implemented hash
+# tags as described in the Redis Cluster specification.
+proc ::redis_cluster::hash {key} {
+ # TODO: Handle hash slots.
+ expr {[::redis_cluster::crc16 $key] & 16383}
+}
+
+# Return the slot the specified keys hash to.
+# If the keys hash to multiple slots, an empty string is returned to
+# signal that the command can't be run in Redis Cluster.
+proc ::redis_cluster::get_slot_from_keys {keys} {
+ set slot {}
+ foreach k $keys {
+ set s [::redis_cluster::hash $k]
+ if {$slot eq {}} {
+ set slot $s
+ } elseif {$slot != $s} {
+ return {} ; # Error
+ }
+ }
+ return $slot
+}
diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl
new file mode 100644
index 0000000..cd8ae3a
--- /dev/null
+++ b/tests/support/redis.tcl
@@ -0,0 +1,294 @@
+# Tcl client library - used by the Redis test
+# Copyright (C) 2009-2014 Salvatore Sanfilippo
+# Released under the BSD license like Redis itself
+#
+# Example usage:
+#
+# set r [redis 127.0.0.1 6379]
+# $r lpush mylist foo
+# $r lpush mylist bar
+# $r lrange mylist 0 -1
+# $r close
+#
+# Non blocking usage example:
+#
+# proc handlePong {r type reply} {
+# puts "PONG $type '$reply'"
+# if {$reply ne "PONG"} {
+# $r ping [list handlePong]
+# }
+# }
+#
+# set r [redis]
+# $r blocking 0
+# $r get fo [list handlePong]
+#
+# vwait forever
+
+package require Tcl 8.5
+package provide redis 0.1
+
+namespace eval redis {}
+set ::redis::id 0
+array set ::redis::fd {}
+array set ::redis::addr {}
+array set ::redis::blocking {}
+array set ::redis::deferred {}
+array set ::redis::reconnect {}
+array set ::redis::callback {}
+array set ::redis::state {} ;# State in non-blocking reply reading
+array set ::redis::statestack {} ;# Stack of states, for nested mbulks
+
+proc redis {{server 127.0.0.1} {port 6379} {defer 0}} {
+ set fd [socket $server $port]
+ fconfigure $fd -translation binary
+ set id [incr ::redis::id]
+ set ::redis::fd($id) $fd
+ set ::redis::addr($id) [list $server $port]
+ set ::redis::blocking($id) 1
+ set ::redis::deferred($id) $defer
+ set ::redis::reconnect($id) 0
+ ::redis::redis_reset_state $id
+ interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id
+}
+
+# This is a wrapper to the actual dispatching procedure that handles
+# reconnection if needed.
+proc ::redis::__dispatch__ {id method args} {
+ set errorcode [catch {::redis::__dispatch__raw__ $id $method $args} retval]
+ if {$errorcode && $::redis::reconnect($id) && $::redis::fd($id) eq {}} {
+ # Try again if the connection was lost.
+ # FIXME: we don't re-select the previously selected DB, nor we check
+ # if we are inside a transaction that needs to be re-issued from
+ # scratch.
+ set errorcode [catch {::redis::__dispatch__raw__ $id $method $args} retval]
+ }
+ return -code $errorcode $retval
+}
+
+proc ::redis::__dispatch__raw__ {id method argv} {
+ set fd $::redis::fd($id)
+
+ # Reconnect the link if needed.
+ if {$fd eq {}} {
+ lassign $::redis::addr($id) host port
+ set ::redis::fd($id) [socket $host $port]
+ fconfigure $::redis::fd($id) -translation binary
+ set fd $::redis::fd($id)
+ }
+
+ set blocking $::redis::blocking($id)
+ set deferred $::redis::deferred($id)
+ if {$blocking == 0} {
+ if {[llength $argv] == 0} {
+ error "Please provide a callback in non-blocking mode"
+ }
+ set callback [lindex $argv end]
+ set argv [lrange $argv 0 end-1]
+ }
+ if {[info command ::redis::__method__$method] eq {}} {
+ set cmd "*[expr {[llength $argv]+1}]\r\n"
+ append cmd "$[string length $method]\r\n$method\r\n"
+ foreach a $argv {
+ append cmd "$[string length $a]\r\n$a\r\n"
+ }
+ ::redis::redis_write $fd $cmd
+ if {[catch {flush $fd}]} {
+ set ::redis::fd($id) {}
+ return -code error "I/O error reading reply"
+ }
+
+ if {!$deferred} {
+ if {$blocking} {
+ ::redis::redis_read_reply $id $fd
+ } else {
+ # Every well formed reply read will pop an element from this
+ # list and use it as a callback. So pipelining is supported
+ # in non blocking mode.
+ lappend ::redis::callback($id) $callback
+ fileevent $fd readable [list ::redis::redis_readable $fd $id]
+ }
+ }
+ } else {
+ uplevel 1 [list ::redis::__method__$method $id $fd] $argv
+ }
+}
+
+proc ::redis::__method__blocking {id fd val} {
+ set ::redis::blocking($id) $val
+ fconfigure $fd -blocking $val
+}
+
+proc ::redis::__method__reconnect {id fd val} {
+ set ::redis::reconnect($id) $val
+}
+
+proc ::redis::__method__read {id fd} {
+ ::redis::redis_read_reply $id $fd
+}
+
+proc ::redis::__method__write {id fd buf} {
+ ::redis::redis_write $fd $buf
+}
+
+proc ::redis::__method__flush {id fd} {
+ flush $fd
+}
+
+proc ::redis::__method__close {id fd} {
+ catch {close $fd}
+ catch {unset ::redis::fd($id)}
+ catch {unset ::redis::addr($id)}
+ catch {unset ::redis::blocking($id)}
+ catch {unset ::redis::deferred($id)}
+ catch {unset ::redis::reconnect($id)}
+ catch {unset ::redis::state($id)}
+ catch {unset ::redis::statestack($id)}
+ catch {unset ::redis::callback($id)}
+ catch {interp alias {} ::redis::redisHandle$id {}}
+}
+
+proc ::redis::__method__channel {id fd} {
+ return $fd
+}
+
+proc ::redis::__method__deferred {id fd val} {
+ set ::redis::deferred($id) $val
+}
+
+proc ::redis::redis_write {fd buf} {
+ puts -nonewline $fd $buf
+}
+
+proc ::redis::redis_writenl {fd buf} {
+ redis_write $fd $buf
+ redis_write $fd "\r\n"
+ flush $fd
+}
+
+proc ::redis::redis_readnl {fd len} {
+ set buf [read $fd $len]
+ read $fd 2 ; # discard CR LF
+ return $buf
+}
+
+proc ::redis::redis_bulk_read {fd} {
+ set count [redis_read_line $fd]
+ if {$count == -1} return {}
+ set buf [redis_readnl $fd $count]
+ return $buf
+}
+
+proc ::redis::redis_multi_bulk_read {id fd} {
+ set count [redis_read_line $fd]
+ if {$count == -1} return {}
+ set l {}
+ set err {}
+ for {set i 0} {$i < $count} {incr i} {
+ if {[catch {
+ lappend l [redis_read_reply $id $fd]
+ } e] && $err eq {}} {
+ set err $e
+ }
+ }
+ if {$err ne {}} {return -code error $err}
+ return $l
+}
+
+proc ::redis::redis_read_line fd {
+ string trim [gets $fd]
+}
+
+proc ::redis::redis_read_reply {id fd} {
+ set type [read $fd 1]
+ switch -exact -- $type {
+ : -
+ + {redis_read_line $fd}
+ - {return -code error [redis_read_line $fd]}
+ $ {redis_bulk_read $fd}
+ * {redis_multi_bulk_read $id $fd}
+ default {
+ if {$type eq {}} {
+ set ::redis::fd($id) {}
+ return -code error "I/O error reading reply"
+ }
+ return -code error "Bad protocol, '$type' as reply type byte"
+ }
+ }
+}
+
+proc ::redis::redis_reset_state id {
+ set ::redis::state($id) [dict create buf {} mbulk -1 bulk -1 reply {}]
+ set ::redis::statestack($id) {}
+}
+
+proc ::redis::redis_call_callback {id type reply} {
+ set cb [lindex $::redis::callback($id) 0]
+ set ::redis::callback($id) [lrange $::redis::callback($id) 1 end]
+ uplevel #0 $cb [list ::redis::redisHandle$id $type $reply]
+ ::redis::redis_reset_state $id
+}
+
+# Read a reply in non-blocking mode.
+proc ::redis::redis_readable {fd id} {
+ if {[eof $fd]} {
+ redis_call_callback $id eof {}
+ ::redis::__method__close $id $fd
+ return
+ }
+ if {[dict get $::redis::state($id) bulk] == -1} {
+ set line [gets $fd]
+ if {$line eq {}} return ;# No complete line available, return
+ switch -exact -- [string index $line 0] {
+ : -
+ + {redis_call_callback $id reply [string range $line 1 end-1]}
+ - {redis_call_callback $id err [string range $line 1 end-1]}
+ $ {
+ dict set ::redis::state($id) bulk \
+ [expr [string range $line 1 end-1]+2]
+ if {[dict get $::redis::state($id) bulk] == 1} {
+ # We got a $-1, hack the state to play well with this.
+ dict set ::redis::state($id) bulk 2
+ dict set ::redis::state($id) buf "\r\n"
+ ::redis::redis_readable $fd $id
+ }
+ }
+ * {
+ dict set ::redis::state($id) mbulk [string range $line 1 end-1]
+ # Handle *-1
+ if {[dict get $::redis::state($id) mbulk] == -1} {
+ redis_call_callback $id reply {}
+ }
+ }
+ default {
+ redis_call_callback $id err \
+ "Bad protocol, $type as reply type byte"
+ }
+ }
+ } else {
+ set totlen [dict get $::redis::state($id) bulk]
+ set buflen [string length [dict get $::redis::state($id) buf]]
+ set toread [expr {$totlen-$buflen}]
+ set data [read $fd $toread]
+ set nread [string length $data]
+ dict append ::redis::state($id) buf $data
+ # Check if we read a complete bulk reply
+ if {[string length [dict get $::redis::state($id) buf]] ==
+ [dict get $::redis::state($id) bulk]} {
+ if {[dict get $::redis::state($id) mbulk] == -1} {
+ redis_call_callback $id reply \
+ [string range [dict get $::redis::state($id) buf] 0 end-2]
+ } else {
+ dict with ::redis::state($id) {
+ lappend reply [string range $buf 0 end-2]
+ incr mbulk -1
+ set bulk -1
+ }
+ if {[dict get $::redis::state($id) mbulk] == 0} {
+ redis_call_callback $id reply \
+ [dict get $::redis::state($id) reply]
+ }
+ }
+ }
+ }
+}
diff --git a/tests/support/server.tcl b/tests/support/server.tcl
new file mode 100644
index 0000000..c36b307
--- /dev/null
+++ b/tests/support/server.tcl
@@ -0,0 +1,329 @@
+set ::global_overrides {}
+set ::tags {}
+set ::valgrind_errors {}
+
+proc start_server_error {config_file error} {
+ set err {}
+ append err "Cant' start the Redis server\n"
+ append err "CONFIGURATION:"
+ append err [exec cat $config_file]
+ append err "\nERROR:"
+ append err [string trim $error]
+ send_data_packet $::test_server_fd err $err
+}
+
+proc check_valgrind_errors stderr {
+ set fd [open $stderr]
+ set buf [read $fd]
+ close $fd
+
+ if {[regexp -- { at 0x} $buf] ||
+ (![regexp -- {definitely lost: 0 bytes} $buf] &&
+ ![regexp -- {no leaks are possible} $buf])} {
+ send_data_packet $::test_server_fd err "Valgrind error: $buf\n"
+ }
+}
+
+proc kill_server config {
+ # nothing to kill when running against external server
+ if {$::external} return
+
+ # nevermind if its already dead
+ if {![is_alive $config]} { return }
+ set pid [dict get $config pid]
+
+ # check for leaks
+ if {![dict exists $config "skipleaks"]} {
+ catch {
+ if {[string match {*Darwin*} [exec uname -a]]} {
+ tags {"leaks"} {
+ test "Check for memory leaks (pid $pid)" {
+ set output {0 leaks}
+ catch {exec leaks $pid} output
+ if {[string match {*process does not exist*} $output] ||
+ [string match {*cannot examine*} $output]} {
+ # In a few tests we kill the server process.
+ set output "0 leaks"
+ }
+ set output
+ } {*0 leaks*}
+ }
+ }
+ }
+ }
+
+ # kill server and wait for the process to be totally exited
+ catch {exec kill $pid}
+ if {$::valgrind} {
+ set max_wait 60000
+ } else {
+ set max_wait 10000
+ }
+ while {[is_alive $config]} {
+ incr wait 10
+
+ if {$wait >= $max_wait} {
+ puts "Forcing process $pid to exit..."
+ catch {exec kill -KILL $pid}
+ } elseif {$wait % 1000 == 0} {
+ puts "Waiting for process $pid to exit..."
+ }
+ after 10
+ }
+
+ # Check valgrind errors if needed
+ if {$::valgrind} {
+ check_valgrind_errors [dict get $config stderr]
+ }
+
+ # Remove this pid from the set of active pids in the test server.
+ send_data_packet $::test_server_fd server-killed $pid
+}
+
+proc is_alive config {
+ set pid [dict get $config pid]
+ if {[catch {exec ps -p $pid} err]} {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc ping_server {host port} {
+ set retval 0
+ if {[catch {
+ set fd [socket $host $port]
+ fconfigure $fd -translation binary
+ puts $fd "PING\r\n"
+ flush $fd
+ set reply [gets $fd]
+ if {[string range $reply 0 0] eq {+} ||
+ [string range $reply 0 0] eq {-}} {
+ set retval 1
+ }
+ close $fd
+ } e]} {
+ if {$::verbose} {
+ puts -nonewline "."
+ }
+ } else {
+ if {$::verbose} {
+ puts -nonewline "ok"
+ }
+ }
+ return $retval
+}
+
+# Return 1 if the server at the specified addr is reachable by PING, otherwise
+# returns 0. Performs a try every 50 milliseconds for the specified number
+# of retries.
+proc server_is_up {host port retrynum} {
+ after 10 ;# Use a small delay to make likely a first-try success.
+ set retval 0
+ while {[incr retrynum -1]} {
+ if {[catch {ping_server $host $port} ping]} {
+ set ping 0
+ }
+ if {$ping} {return 1}
+ after 50
+ }
+ return 0
+}
+
+# doesn't really belong here, but highly coupled to code in start_server
+proc tags {tags code} {
+ set ::tags [concat $::tags $tags]
+ uplevel 1 $code
+ set ::tags [lrange $::tags 0 end-[llength $tags]]
+}
+
+proc start_server {options {code undefined}} {
+ # If we are running against an external server, we just push the
+ # host/port pair in the stack the first time
+ if {$::external} {
+ if {[llength $::servers] == 0} {
+ set srv {}
+ dict set srv "host" $::host
+ dict set srv "port" $::port
+ set client [redis $::host $::port]
+ dict set srv "client" $client
+ $client select 9
+
+ # append the server to the stack
+ lappend ::servers $srv
+ }
+ uplevel 1 $code
+ return
+ }
+
+ # setup defaults
+ set baseconfig "default.conf"
+ set overrides {}
+ set tags {}
+
+ # parse options
+ foreach {option value} $options {
+ switch $option {
+ "config" {
+ set baseconfig $value }
+ "overrides" {
+ set overrides $value }
+ "tags" {
+ set tags $value
+ set ::tags [concat $::tags $value] }
+ default {
+ error "Unknown option $option" }
+ }
+ }
+
+ set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
+ set config {}
+ foreach line $data {
+ if {[string length $line] > 0 && [string index $line 0] ne "#"} {
+ set elements [split $line " "]
+ set directive [lrange $elements 0 0]
+ set arguments [lrange $elements 1 end]
+ dict set config $directive $arguments
+ }
+ }
+
+ # use a different directory every time a server is started
+ dict set config dir [tmpdir server]
+
+ # start every server on a different port
+ set ::port [find_available_port [expr {$::port+1}]]
+ dict set config port $::port
+
+ # apply overrides from global space and arguments
+ foreach {directive arguments} [concat $::global_overrides $overrides] {
+ dict set config $directive $arguments
+ }
+
+ # write new configuration to temporary file
+ set config_file [tmpfile redis.conf]
+ set fp [open $config_file w+]
+ foreach directive [dict keys $config] {
+ puts -nonewline $fp "$directive "
+ puts $fp [dict get $config $directive]
+ }
+ close $fp
+
+ set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
+ set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
+
+ if {$::valgrind} {
+ set pid [exec valgrind --track-origins=yes --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &]
+ } elseif ($::stack_logging) {
+ set pid [exec /usr/bin/env MallocStackLogging=1 MallocLogFile=/tmp/malloc_log.txt src/redis-server $config_file > $stdout 2> $stderr &]
+ } else {
+ set pid [exec src/redis-server $config_file > $stdout 2> $stderr &]
+ }
+
+ # Tell the test server about this new instance.
+ send_data_packet $::test_server_fd server-spawned $pid
+
+ # check that the server actually started
+ # ugly but tries to be as fast as possible...
+ if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
+
+ if {$::verbose} {
+ puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+ }
+
+ if {$code ne "undefined"} {
+ set serverisup [server_is_up $::host $::port $retrynum]
+ } else {
+ set serverisup 1
+ }
+
+ if {$::verbose} {
+ puts ""
+ }
+
+ if {!$serverisup} {
+ set err {}
+ append err [exec cat $stdout] "\n" [exec cat $stderr]
+ start_server_error $config_file $err
+ return
+ }
+
+ # Wait for actual startup
+ while {![info exists _pid]} {
+ regexp {PID:\s(\d+)} [exec cat $stdout] _ _pid
+ after 100
+ }
+
+ # setup properties to be able to initialize a client object
+ set host $::host
+ set port $::port
+ if {[dict exists $config bind]} { set host [dict get $config bind] }
+ if {[dict exists $config port]} { set port [dict get $config port] }
+
+ # setup config dict
+ dict set srv "config_file" $config_file
+ dict set srv "config" $config
+ dict set srv "pid" $pid
+ dict set srv "host" $host
+ dict set srv "port" $port
+ dict set srv "stdout" $stdout
+ dict set srv "stderr" $stderr
+
+ # if a block of code is supplied, we wait for the server to become
+ # available, create a client object and kill the server afterwards
+ if {$code ne "undefined"} {
+ set line [exec head -n1 $stdout]
+ if {[string match {*already in use*} $line]} {
+ error_and_quit $config_file $line
+ }
+
+ while 1 {
+ # check that the server actually started and is ready for connections
+ if {[exec grep -i "Ready to accept" | wc -l < $stdout] > 0} {
+ break
+ }
+ after 10
+ }
+
+ # append the server to the stack
+ lappend ::servers $srv
+
+ # connect client (after server dict is put on the stack)
+ reconnect
+
+ # execute provided block
+ set num_tests $::num_tests
+ if {[catch { uplevel 1 $code } error]} {
+ set backtrace $::errorInfo
+
+ # Kill the server without checking for leaks
+ dict set srv "skipleaks" 1
+ kill_server $srv
+
+ # Print warnings from log
+ puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]]
+ set warnings [warnings_from_file [dict get $srv "stdout"]]
+ if {[string length $warnings] > 0} {
+ puts "$warnings"
+ } else {
+ puts "(none)"
+ }
+ puts ""
+
+ error $error $backtrace
+ }
+
+ # Don't do the leak check when no tests were run
+ if {$num_tests == $::num_tests} {
+ dict set srv "skipleaks" 1
+ }
+
+ # pop the server object
+ set ::servers [lrange $::servers 0 end-1]
+
+ set ::tags [lrange $::tags 0 end-[llength $tags]]
+ kill_server $srv
+ } else {
+ set ::tags [lrange $::tags 0 end-[llength $tags]]
+ set _ $srv
+ }
+}
diff --git a/tests/support/test.tcl b/tests/support/test.tcl
new file mode 100644
index 0000000..d60eb3c
--- /dev/null
+++ b/tests/support/test.tcl
@@ -0,0 +1,127 @@
+set ::num_tests 0
+set ::num_passed 0
+set ::num_failed 0
+set ::tests_failed {}
+
+proc fail {msg} {
+ error "assertion:$msg"
+}
+
+proc assert {condition} {
+ if {![uplevel 1 [list expr $condition]]} {
+ error "assertion:Expected condition '$condition' to be true ([uplevel 1 [list subst -nocommands $condition]])"
+ }
+}
+
+proc assert_match {pattern value} {
+ if {![string match $pattern $value]} {
+ error "assertion:Expected '$value' to match '$pattern'"
+ }
+}
+
+proc assert_equal {expected value {detail ""}} {
+ if {$expected ne $value} {
+ if {$detail ne ""} {
+ set detail " (detail: $detail)"
+ }
+ error "assertion:Expected '$value' to be equal to '$expected'$detail"
+ }
+}
+
+proc assert_error {pattern code} {
+ if {[catch {uplevel 1 $code} error]} {
+ assert_match $pattern $error
+ } else {
+ error "assertion:Expected an error but nothing was caught"
+ }
+}
+
+proc assert_encoding {enc key} {
+ set dbg [r debug object $key]
+ assert_match "* encoding:$enc *" $dbg
+}
+
+proc assert_type {type key} {
+ assert_equal $type [r type $key]
+}
+
+# Wait for the specified condition to be true, with the specified number of
+# max retries and delay between retries. Otherwise the 'elsescript' is
+# executed.
+proc wait_for_condition {maxtries delay e _else_ elsescript} {
+ while {[incr maxtries -1] >= 0} {
+ set errcode [catch {uplevel 1 [list expr $e]} result]
+ if {$errcode == 0} {
+ if {$result} break
+ } else {
+ return -code $errcode $result
+ }
+ after $delay
+ }
+ if {$maxtries == -1} {
+ set errcode [catch [uplevel 1 $elsescript] result]
+ return -code $errcode $result
+ }
+}
+
+proc test {name code {okpattern undefined}} {
+ # abort if tagged with a tag to deny
+ foreach tag $::denytags {
+ if {[lsearch $::tags $tag] >= 0} {
+ return
+ }
+ }
+
+ # check if tagged with at least 1 tag to allow when there *is* a list
+ # of tags to allow, because default policy is to run everything
+ if {[llength $::allowtags] > 0} {
+ set matched 0
+ foreach tag $::allowtags {
+ if {[lsearch $::tags $tag] >= 0} {
+ incr matched
+ }
+ }
+ if {$matched < 1} {
+ return
+ }
+ }
+
+ incr ::num_tests
+ set details {}
+ lappend details "$name in $::curfile"
+
+ send_data_packet $::test_server_fd testing $name
+
+ if {[catch {set retval [uplevel 1 $code]} error]} {
+ if {[string match "assertion:*" $error]} {
+ set msg [string range $error 10 end]
+ lappend details $msg
+ lappend ::tests_failed $details
+
+ incr ::num_failed
+ send_data_packet $::test_server_fd err [join $details "\n"]
+ } else {
+ # Re-raise, let handler up the stack take care of this.
+ error $error $::errorInfo
+ }
+ } else {
+ if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
+ incr ::num_passed
+ send_data_packet $::test_server_fd ok $name
+ } else {
+ set msg "Expected '$okpattern' to equal or match '$retval'"
+ lappend details $msg
+ lappend ::tests_failed $details
+
+ incr ::num_failed
+ send_data_packet $::test_server_fd err [join $details "\n"]
+ }
+ }
+
+ if {$::traceleaks} {
+ set output [exec leaks redis-server]
+ if {![string match {*0 leaks*} $output]} {
+ send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output"
+ }
+ }
+}
diff --git a/tests/support/tmpfile.tcl b/tests/support/tmpfile.tcl
new file mode 100644
index 0000000..809f587
--- /dev/null
+++ b/tests/support/tmpfile.tcl
@@ -0,0 +1,15 @@
+set ::tmpcounter 0
+set ::tmproot "./tests/tmp"
+file mkdir $::tmproot
+
+# returns a dirname unique to this process to write to
+proc tmpdir {basename} {
+ set dir [file join $::tmproot $basename.[pid].[incr ::tmpcounter]]
+ file mkdir $dir
+ set _ $dir
+}
+
+# return a filename unique to this process to write to
+proc tmpfile {basename} {
+ file join $::tmproot $basename.[pid].[incr ::tmpcounter]
+}
diff --git a/tests/support/util.tcl b/tests/support/util.tcl
new file mode 100644
index 0000000..64c36b3
--- /dev/null
+++ b/tests/support/util.tcl
@@ -0,0 +1,377 @@
+proc randstring {min max {type binary}} {
+ set len [expr {$min+int(rand()*($max-$min+1))}]
+ set output {}
+ if {$type eq {binary}} {
+ set minval 0
+ set maxval 255
+ } elseif {$type eq {alpha}} {
+ set minval 48
+ set maxval 122
+ } elseif {$type eq {compr}} {
+ set minval 48
+ set maxval 52
+ }
+ while {$len} {
+ append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]]
+ incr len -1
+ }
+ return $output
+}
+
+# Useful for some test
+proc zlistAlikeSort {a b} {
+ if {[lindex $a 0] > [lindex $b 0]} {return 1}
+ if {[lindex $a 0] < [lindex $b 0]} {return -1}
+ string compare [lindex $a 1] [lindex $b 1]
+}
+
+# Return all log lines starting with the first line that contains a warning.
+# Generally, this will be an assertion error with a stack trace.
+proc warnings_from_file {filename} {
+ set lines [split [exec cat $filename] "\n"]
+ set matched 0
+ set logall 0
+ set result {}
+ foreach line $lines {
+ if {[string match {*REDIS BUG REPORT START*} $line]} {
+ set logall 1
+ }
+ if {[regexp {^\[\d+\]\s+\d+\s+\w+\s+\d{2}:\d{2}:\d{2} \#} $line]} {
+ set matched 1
+ }
+ if {$logall || $matched} {
+ lappend result $line
+ }
+ }
+ join $result "\n"
+}
+
+# Return value for INFO property
+proc status {r property} {
+ if {[regexp "\r\n$property:(.*?)\r\n" [{*}$r info] _ value]} {
+ set _ $value
+ }
+}
+
+proc waitForBgsave r {
+ while 1 {
+ if {[status r rdb_bgsave_in_progress] eq 1} {
+ if {$::verbose} {
+ puts -nonewline "\nWaiting for background save to finish... "
+ flush stdout
+ }
+ after 1000
+ } else {
+ break
+ }
+ }
+}
+
+proc waitForBgrewriteaof r {
+ while 1 {
+ if {[status r aof_rewrite_in_progress] eq 1} {
+ if {$::verbose} {
+ puts -nonewline "\nWaiting for background AOF rewrite to finish... "
+ flush stdout
+ }
+ after 1000
+ } else {
+ break
+ }
+ }
+}
+
+proc wait_for_sync r {
+ while 1 {
+ if {[status $r master_link_status] eq "down"} {
+ after 10
+ } else {
+ break
+ }
+ }
+}
+
+# Random integer between 0 and max (excluded).
+proc randomInt {max} {
+ expr {int(rand()*$max)}
+}
+
+# Random signed integer between -max and max (both extremes excluded).
+proc randomSignedInt {max} {
+ set i [randomInt $max]
+ if {rand() > 0.5} {
+ set i -$i
+ }
+ return $i
+}
+
+proc randpath args {
+ set path [expr {int(rand()*[llength $args])}]
+ uplevel 1 [lindex $args $path]
+}
+
+proc randomValue {} {
+ randpath {
+ # Small enough to likely collide
+ randomSignedInt 1000
+ } {
+ # 32 bit compressible signed/unsigned
+ randpath {randomSignedInt 2000000000} {randomSignedInt 4000000000}
+ } {
+ # 64 bit
+ randpath {randomSignedInt 1000000000000}
+ } {
+ # Random string
+ randpath {randstring 0 256 alpha} \
+ {randstring 0 256 compr} \
+ {randstring 0 256 binary}
+ }
+}
+
+proc randomKey {} {
+ randpath {
+ # Small enough to likely collide
+ randomInt 1000
+ } {
+ # 32 bit compressible signed/unsigned
+ randpath {randomInt 2000000000} {randomInt 4000000000}
+ } {
+ # 64 bit
+ randpath {randomInt 1000000000000}
+ } {
+ # Random string
+ randpath {randstring 1 256 alpha} \
+ {randstring 1 256 compr}
+ }
+}
+
+proc findKeyWithType {r type} {
+ for {set j 0} {$j < 20} {incr j} {
+ set k [{*}$r randomkey]
+ if {$k eq {}} {
+ return {}
+ }
+ if {[{*}$r type $k] eq $type} {
+ return $k
+ }
+ }
+ return {}
+}
+
+proc createComplexDataset {r ops {opt {}}} {
+ for {set j 0} {$j < $ops} {incr j} {
+ set k [randomKey]
+ set k2 [randomKey]
+ set f [randomValue]
+ set v [randomValue]
+
+ if {[lsearch -exact $opt useexpire] != -1} {
+ if {rand() < 0.1} {
+ {*}$r expire [randomKey] [randomInt 2]
+ }
+ }
+
+ randpath {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ randpath {set d +inf} {set d -inf}
+ }
+ set t [{*}$r type $k]
+
+ if {$t eq {none}} {
+ randpath {
+ {*}$r set $k $v
+ } {
+ {*}$r lpush $k $v
+ } {
+ {*}$r sadd $k $v
+ } {
+ {*}$r zadd $k $d $v
+ } {
+ {*}$r hset $k $f $v
+ } {
+ {*}$r del $k
+ }
+ set t [{*}$r type $k]
+ }
+
+ switch $t {
+ {string} {
+ # Nothing to do
+ }
+ {list} {
+ randpath {{*}$r lpush $k $v} \
+ {{*}$r rpush $k $v} \
+ {{*}$r lrem $k 0 $v} \
+ {{*}$r rpop $k} \
+ {{*}$r lpop $k}
+ }
+ {set} {
+ randpath {{*}$r sadd $k $v} \
+ {{*}$r srem $k $v} \
+ {
+ set otherset [findKeyWithType {*}$r set]
+ if {$otherset ne {}} {
+ randpath {
+ {*}$r sunionstore $k2 $k $otherset
+ } {
+ {*}$r sinterstore $k2 $k $otherset
+ } {
+ {*}$r sdiffstore $k2 $k $otherset
+ }
+ }
+ }
+ }
+ {zset} {
+ randpath {{*}$r zadd $k $d $v} \
+ {{*}$r zrem $k $v} \
+ {
+ set otherzset [findKeyWithType {*}$r zset]
+ if {$otherzset ne {}} {
+ randpath {
+ {*}$r zunionstore $k2 2 $k $otherzset
+ } {
+ {*}$r zinterstore $k2 2 $k $otherzset
+ }
+ }
+ }
+ }
+ {hash} {
+ randpath {{*}$r hset $k $f $v} \
+ {{*}$r hdel $k $f}
+ }
+ }
+ }
+}
+
+proc formatCommand {args} {
+ set cmd "*[llength $args]\r\n"
+ foreach a $args {
+ append cmd "$[string length $a]\r\n$a\r\n"
+ }
+ set _ $cmd
+}
+
+proc csvdump r {
+ set o {}
+ for {set db 0} {$db < 16} {incr db} {
+ {*}$r select $db
+ foreach k [lsort [{*}$r keys *]] {
+ set type [{*}$r type $k]
+ append o [csvstring $db] , [csvstring $k] , [csvstring $type] ,
+ switch $type {
+ string {
+ append o [csvstring [{*}$r get $k]] "\n"
+ }
+ list {
+ foreach e [{*}$r lrange $k 0 -1] {
+ append o [csvstring $e] ,
+ }
+ append o "\n"
+ }
+ set {
+ foreach e [lsort [{*}$r smembers $k]] {
+ append o [csvstring $e] ,
+ }
+ append o "\n"
+ }
+ zset {
+ foreach e [{*}$r zrange $k 0 -1 withscores] {
+ append o [csvstring $e] ,
+ }
+ append o "\n"
+ }
+ hash {
+ set fields [{*}$r hgetall $k]
+ set newfields {}
+ foreach {k v} $fields {
+ lappend newfields [list $k $v]
+ }
+ set fields [lsort -index 0 $newfields]
+ foreach kv $fields {
+ append o [csvstring [lindex $kv 0]] ,
+ append o [csvstring [lindex $kv 1]] ,
+ }
+ append o "\n"
+ }
+ }
+ }
+ }
+ {*}$r select 9
+ return $o
+}
+
+proc csvstring s {
+ return "\"$s\""
+}
+
+proc roundFloat f {
+ format "%.10g" $f
+}
+
+proc find_available_port start {
+ for {set j $start} {$j < $start+1024} {incr j} {
+ if {[catch {set fd1 [socket 127.0.0.1 $j]}] &&
+ [catch {set fd2 [socket 127.0.0.1 [expr $j+10000]]}]} {
+ return $j
+ } else {
+ catch {
+ close $fd1
+ close $fd2
+ }
+ }
+ }
+ if {$j == $start+1024} {
+ error "Can't find a non busy port in the $start-[expr {$start+1023}] range."
+ }
+}
+
+# Test if TERM looks like to support colors
+proc color_term {} {
+ expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]}
+}
+
+proc colorstr {color str} {
+ if {[color_term]} {
+ set b 0
+ if {[string range $color 0 4] eq {bold-}} {
+ set b 1
+ set color [string range $color 5 end]
+ }
+ switch $color {
+ red {set colorcode {31}}
+ green {set colorcode {32}}
+ yellow {set colorcode {33}}
+ blue {set colorcode {34}}
+ magenta {set colorcode {35}}
+ cyan {set colorcode {36}}
+ white {set colorcode {37}}
+ default {set colorcode {37}}
+ }
+ if {$colorcode ne {}} {
+ return "\033\[$b;${colorcode};49m$str\033\[0m"
+ }
+ } else {
+ return $str
+ }
+}
+
+# Execute a background process writing random data for the specified number
+# of seconds to the specified Redis instance.
+proc start_write_load {host port seconds} {
+ set tclsh [info nameofexecutable]
+ exec $tclsh tests/helpers/gen_write_load.tcl $host $port $seconds &
+}
+
+# Stop a process generating write load executed with start_write_load.
+proc stop_write_load {handle} {
+ catch {exec /bin/kill -9 $handle}
+}
generated by cgit v1.2.3 (git 2.39.1) at 2025-12-30 16:50:34 +0000