redis-server 0.0.1

data/redis/redis-2.2.11/tests/integration/aof.tcl

@@ -0,0 +1,104 @@
+set defaults { appendonly {yes} appendfilename {appendonly.aof} }
+set server_path [tmpdir server.aof]
+set aof_path "$server_path/appendonly.aof"
+
+proc append_to_aof {str} {
+    upvar fp fp
+    puts -nonewline $fp $str
+}
+
+proc create_aof {code} {
+    upvar fp fp aof_path aof_path
+    set fp [open $aof_path w+]
+    uplevel 1 $code
+    close $fp
+}
+
+proc start_server_aof {overrides code} {
+    upvar defaults defaults srv srv server_path server_path
+    set config [concat $defaults $overrides]
+    set srv [start_server [list overrides $config]]
+    uplevel 1 $code
+    kill_server $srv
+}
+
+tags {"aof"} {
+    ## Test the server doesn't start when the AOF contains an unfinished MULTI
+    create_aof {
+        append_to_aof [formatCommand set foo hello]
+        append_to_aof [formatCommand multi]
+        append_to_aof [formatCommand set bar world]
+    }
+
+    start_server_aof [list dir $server_path] {
+        test "Unfinished MULTI: Server should not have been started" {
+            assert_equal 0 [is_alive $srv]
+        }
+
+        test "Unfinished MULTI: Server should have logged an error" {
+            set result [exec cat [dict get $srv stdout] | tail -n1]
+            assert_match "*Unexpected end of file reading the append only file*" $result
+        }
+    }
+
+    ## Test that the server exits when the AOF contains a short read
+    create_aof {
+        append_to_aof [formatCommand set foo hello]
+        append_to_aof [string range [formatCommand set bar world] 0 end-1]
+    }
+
+    start_server_aof [list dir $server_path] {
+        test "Short read: Server should not have been started" {
+            assert_equal 0 [is_alive $srv]
+        }
+
+        test "Short read: Server should have logged an error" {
+            set result [exec cat [dict get $srv stdout] | tail -n1]
+            assert_match "*Bad file format reading the append only file*" $result
+        }
+    }
+
+    ## Test that redis-check-aof indeed sees this AOF is not valid
+    test "Short read: Utility should confirm the AOF is not valid" {
+        catch {
+            exec src/redis-check-aof $aof_path
+        } result
+        assert_match "*not valid*" $result
+    }
+
+    test "Short read: Utility should be able to fix the AOF" {
+        set result [exec echo y | src/redis-check-aof --fix $aof_path]
+        assert_match "*Successfully truncated AOF*" $result
+    }
+
+    ## Test that the server can be started using the truncated AOF
+    start_server_aof [list dir $server_path] {
+        test "Fixed AOF: Server should have been started" {
+            assert_equal 1 [is_alive $srv]
+        }
+
+        test "Fixed AOF: Keyspace should contain values that were parsable" {
+            set client [redis [dict get $srv host] [dict get $srv port]]
+            assert_equal "hello" [$client get foo]
+            assert_equal "" [$client get bar]
+        }
+    }
+
+    ## Test that SPOP (that modifies the client its argc/argv) is correctly free'd
+    create_aof {
+        append_to_aof [formatCommand sadd set foo]
+        append_to_aof [formatCommand sadd set bar]
+        append_to_aof [formatCommand spop set]
+    }
+
+    start_server_aof [list dir $server_path] {
+        test "AOF+SPOP: Server should have been started" {
+            assert_equal 1 [is_alive $srv]
+        }
+
+        test "AOF+SPOP: Set should have 1 member" {
+            set client [redis [dict get $srv host] [dict get $srv port]]
+            assert_equal 1 [$client scard set]
+        }
+    }
+}

data/redis/redis-2.2.11/tests/integration/redis-cli.tcl

@@ -0,0 +1,208 @@
+start_server {tags {"cli"}} {
+    proc open_cli {} {
+        set ::env(TERM) dumb
+        set fd [open [format "|src/redis-cli -p %d -n 9" [srv port]] "r+"]
+        fconfigure $fd -buffering none
+        fconfigure $fd -blocking false
+        fconfigure $fd -translation binary
+        assert_equal "redis> " [read_cli $fd]
+        set _ $fd
+    }
+
+    proc close_cli {fd} {
+        close $fd
+    }
+
+    proc read_cli {fd} {
+        set buf [read $fd]
+        while {[string length $buf] == 0} {
+            # wait some time and try again
+            after 10
+            set buf [read $fd]
+        }
+        set _ $buf
+    }
+
+    proc write_cli {fd buf} {
+        puts $fd $buf
+        flush $fd
+    }
+
+    # Helpers to run tests in interactive mode
+    proc run_command {fd cmd} {
+        write_cli $fd $cmd
+        set lines [split [read_cli $fd] "\n"]
+        assert_equal "redis> " [lindex $lines end]
+        join [lrange $lines 0 end-1] "\n"
+    }
+
+    proc test_interactive_cli {name code} {
+        set ::env(FAKETTY) 1
+        set fd [open_cli]
+        test "Interactive CLI: $name" $code
+        close_cli $fd
+        unset ::env(FAKETTY)
+    }
+
+    # Helpers to run tests where stdout is not a tty
+    proc write_tmpfile {contents} {
+        set tmp [tmpfile "cli"]
+        set tmpfd [open $tmp "w"]
+        puts -nonewline $tmpfd $contents
+        close $tmpfd
+        set _ $tmp
+    }
+
+    proc _run_cli {opts args} {
+        set cmd [format "src/redis-cli -p %d -n 9 $args" [srv port]]
+        foreach {key value} $opts {
+            if {$key eq "pipe"} {
+                set cmd "sh -c \"$value | $cmd\""
+            }
+            if {$key eq "path"} {
+                set cmd "$cmd < $value"
+            }
+        }
+
+        set fd [open "|$cmd" "r"]
+        fconfigure $fd -buffering none
+        fconfigure $fd -translation binary
+        set resp [read $fd 1048576]
+        close $fd
+        set _ $resp
+    }
+
+    proc run_cli {args} {
+        _run_cli {} {*}$args
+    }
+
+    proc run_cli_with_input_pipe {cmd args} {
+        _run_cli [list pipe $cmd] {*}$args
+    }
+
+    proc run_cli_with_input_file {path args} {
+        _run_cli [list path $path] {*}$args
+    }
+
+    proc test_nontty_cli {name code} {
+        test "Non-interactive non-TTY CLI: $name" $code
+    }
+
+    # Helpers to run tests where stdout is a tty (fake it)
+    proc test_tty_cli {name code} {
+        set ::env(FAKETTY) 1
+        test "Non-interactive TTY CLI: $name" $code
+        unset ::env(FAKETTY)
+    }
+
+    test_interactive_cli "INFO response should be printed raw" {
+        set lines [split [run_command $fd info] "\n"]
+        foreach line $lines {
+            assert [regexp {^[a-z0-9_]+:[a-z0-9_]+} $line]
+        }
+    }
+
+    test_interactive_cli "Status reply" {
+        assert_equal "OK" [run_command $fd "set key foo"]
+    }
+
+    test_interactive_cli "Integer reply" {
+        assert_equal "(integer) 1" [run_command $fd "incr counter"]
+    }
+
+    test_interactive_cli "Bulk reply" {
+        r set key foo
+        assert_equal "\"foo\"" [run_command $fd "get key"]
+    }
+
+    test_interactive_cli "Multi-bulk reply" {
+        r rpush list foo
+        r rpush list bar
+        assert_equal "1. \"foo\"\n2. \"bar\"" [run_command $fd "lrange list 0 -1"]
+    }
+
+    test_interactive_cli "Parsing quotes" {
+        assert_equal "OK" [run_command $fd "set key \"bar\""]
+        assert_equal "bar" [r get key]
+        assert_equal "OK" [run_command $fd "set key \" bar \""]
+        assert_equal " bar " [r get key]
+        assert_equal "OK" [run_command $fd "set key \"\\\"bar\\\"\""]
+        assert_equal "\"bar\"" [r get key]
+        assert_equal "OK" [run_command $fd "set key \"\tbar\t\""]
+        assert_equal "\tbar\t" [r get key]
+
+        # invalid quotation
+        assert_equal "Invalid argument(s)" [run_command $fd "get \"\"key"]
+        assert_equal "Invalid argument(s)" [run_command $fd "get \"key\"x"]
+
+        # quotes after the argument are weird, but should be allowed
+        assert_equal "OK" [run_command $fd "set key\"\" bar"]
+        assert_equal "bar" [r get key]
+    }
+
+    test_tty_cli "Status reply" {
+        assert_equal "OK\n" [run_cli set key bar]
+        assert_equal "bar" [r get key]
+    }
+
+    test_tty_cli "Integer reply" {
+        r del counter
+        assert_equal "(integer) 1\n" [run_cli incr counter]
+    }
+
+    test_tty_cli "Bulk reply" {
+        r set key "tab\tnewline\n"
+        assert_equal "\"tab\\tnewline\\n\"\n" [run_cli get key]
+    }
+
+    test_tty_cli "Multi-bulk reply" {
+        r del list
+        r rpush list foo
+        r rpush list bar
+        assert_equal "1. \"foo\"\n2. \"bar\"\n" [run_cli lrange list 0 -1]
+    }
+
+    test_tty_cli "Read last argument from pipe" {
+        assert_equal "OK\n" [run_cli_with_input_pipe "echo foo" set key]
+        assert_equal "foo\n" [r get key]
+    }
+
+    test_tty_cli "Read last argument from file" {
+        set tmpfile [write_tmpfile "from file"]
+        assert_equal "OK\n" [run_cli_with_input_file $tmpfile set key]
+        assert_equal "from file" [r get key]
+    }
+
+    test_nontty_cli "Status reply" {
+        assert_equal "OK" [run_cli set key bar]
+        assert_equal "bar" [r get key]
+    }
+
+    test_nontty_cli "Integer reply" {
+        r del counter
+        assert_equal "1" [run_cli incr counter]
+    }
+
+    test_nontty_cli "Bulk reply" {
+        r set key "tab\tnewline\n"
+        assert_equal "tab\tnewline\n" [run_cli get key]
+    }
+
+    test_nontty_cli "Multi-bulk reply" {
+        r del list
+        r rpush list foo
+        r rpush list bar
+        assert_equal "foo\nbar" [run_cli lrange list 0 -1]
+    }
+
+    test_nontty_cli "Read last argument from pipe" {
+        assert_equal "OK" [run_cli_with_input_pipe "echo foo" set key]
+        assert_equal "foo\n" [r get key]
+    }
+
+    test_nontty_cli "Read last argument from file" {
+        set tmpfile [write_tmpfile "from file"]
+        assert_equal "OK" [run_cli_with_input_file $tmpfile set key]
+        assert_equal "from file" [r get key]
+    }
+}

data/redis/redis-2.2.11/tests/integration/replication.tcl

@@ -0,0 +1,98 @@
+start_server {tags {"repl"}} {
+    start_server {} {
+        test {First server should have role slave after SLAVEOF} {
+            r -1 slaveof [srv 0 host] [srv 0 port]
+            after 1000
+            s -1 role
+        } {slave}
+
+        test {BRPOPLPUSH replication, when blocking against empty list} {
+            set rd [redis_deferring_client]
+            $rd brpoplpush a b 5
+            r lpush a foo
+            after 1000
+            assert_equal [r debug digest] [r -1 debug digest]
+        }
+
+        test {BRPOPLPUSH replication, list exists} {
+            set rd [redis_deferring_client]
+            r lpush c 1
+            r lpush c 2
+            r lpush c 3
+            $rd brpoplpush c d 5
+            after 1000
+            assert_equal [r debug digest] [r -1 debug digest]
+        }
+
+        test {MASTER and SLAVE dataset should be identical after complex ops} {
+            createComplexDataset r 10000
+            after 500
+            if {[r debug digest] ne [r -1 debug digest]} {
+                set csv1 [csvdump r]
+                set csv2 [csvdump {r -1}]
+                set fd [open /tmp/repldump1.txt w]
+                puts -nonewline $fd $csv1
+                close $fd
+                set fd [open /tmp/repldump2.txt w]
+                puts -nonewline $fd $csv2
+                close $fd
+                puts "Master - Slave inconsistency"
+                puts "Run diff -u against /tmp/repldump*.txt for more info"
+            }
+            assert_equal [r debug digest] [r -1 debug digest]
+        }
+
+        test {MASTER and SLAVE consistency with expire} {
+            createComplexDataset r 50000 useexpire
+            after 4000 ;# Make sure everything expired before taking the digest
+            r keys *   ;# Force DEL syntesizing to slave
+            after 1000 ;# Wait another second. Now everything should be fine.
+            if {[r debug digest] ne [r -1 debug digest]} {
+                set csv1 [csvdump r]
+                set csv2 [csvdump {r -1}]
+                set fd [open /tmp/repldump1.txt w]
+                puts -nonewline $fd $csv1
+                close $fd
+                set fd [open /tmp/repldump2.txt w]
+                puts -nonewline $fd $csv2
+                close $fd
+                puts "Master - Slave inconsistency"
+                puts "Run diff -u against /tmp/repldump*.txt for more info"
+            }
+            assert_equal [r debug digest] [r -1 debug digest]
+        }
+    }
+}
+
+start_server {tags {"repl"}} {
+    r set mykey foo
+    
+    start_server {} {
+        test {Second server should have role master at first} {
+            s role
+        } {master}
+        
+        test {SLAVEOF should start with link status "down"} {
+            r slaveof [srv -1 host] [srv -1 port]
+            s master_link_status
+        } {down}
+        
+        test {The role should immediately be changed to "slave"} {
+            s role
+        } {slave}
+
+        wait_for_sync r
+        test {Sync should have transferred keys from master} {
+            r get mykey
+        } {foo}
+        
+        test {The link status should be up} {
+            s master_link_status
+        } {up}
+        
+        test {SET on the master should immediately propagate} {
+            r -1 set mykey bar
+            r  0 get mykey
+        } {bar}
+    }
+}

data/redis/redis-2.2.11/tests/support/redis.tcl

@@ -0,0 +1,241 @@
+# Tcl clinet library - used by test-redis.tcl script for now
+# Copyright (C) 2009 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::blocking {}
+array set ::redis::deferred {}
+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::blocking($id) 1
+    set ::redis::deferred($id) $defer
+    ::redis::redis_reset_state $id
+    interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id
+}
+
+proc ::redis::__dispatch__ {id method args} {
+    set fd $::redis::fd($id)
+    set blocking $::redis::blocking($id)
+    set deferred $::redis::deferred($id)
+    if {$blocking == 0} {
+        if {[llength $args] == 0} {
+            error "Please provide a callback in non-blocking mode"
+        }
+        set callback [lindex $args end]
+        set args [lrange $args 0 end-1]
+    }
+    if {[info command ::redis::__method__$method] eq {}} {
+        set cmd "*[expr {[llength $args]+1}]\r\n"
+        append cmd "$[string length $method]\r\n$method\r\n"
+        foreach a $args {
+            append cmd "$[string length $a]\r\n$a\r\n"
+        }
+        ::redis::redis_write $fd $cmd
+        flush $fd
+
+        if {!$deferred} {
+            if {$blocking} {
+                ::redis::redis_read_reply $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] $args
+    }
+}
+
+proc ::redis::__method__blocking {id fd val} {
+    set ::redis::blocking($id) $val
+    fconfigure $fd -blocking $val
+}
+
+proc ::redis::__method__read {id fd} {
+    ::redis::redis_read_reply $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::blocking($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::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 fd {
+    set count [redis_read_line $fd]
+    if {$count == -1} return {}
+    set l {}
+    for {set i 0} {$i < $count} {incr i} {
+        lappend l [redis_read_reply $fd]
+    }
+    return $l
+}
+
+proc ::redis::redis_read_line fd {
+    string trim [gets $fd]
+}
+
+proc ::redis::redis_read_reply 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 $fd}
+        default {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]
+                }
+            }
+        }
+    }
+}