"Fossies" - the Fresh Open Source Software Archive

Member "redis-6.0.8/tests/integration/redis-cli.tcl" (10 Sep 2020, 8519 Bytes) of package /linux/misc/redis-6.0.8.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "redis-cli.tcl": 6.0.7_vs_6.0.8.

    1 source tests/support/cli.tcl
    2 
    3 start_server {tags {"cli"}} {
    4     proc open_cli {{opts "-n 9"} {infile ""}} {
    5         set ::env(TERM) dumb
    6         set cmdline [rediscli [srv host] [srv port] $opts]
    7         if {$infile ne ""} {
    8             set cmdline "$cmdline < $infile"
    9             set mode "r"
   10         } else {
   11             set mode "r+"
   12         }
   13         set fd [open "|$cmdline" $mode]
   14         fconfigure $fd -buffering none
   15         fconfigure $fd -blocking false
   16         fconfigure $fd -translation binary
   17         set _ $fd
   18     }
   19 
   20     proc close_cli {fd} {
   21         close $fd
   22     }
   23 
   24     proc read_cli {fd} {
   25         set buf [read $fd]
   26         while {[string length $buf] == 0} {
   27             # wait some time and try again
   28             after 10
   29             set buf [read $fd]
   30         }
   31         set _ $buf
   32     }
   33 
   34     proc write_cli {fd buf} {
   35         puts $fd $buf
   36         flush $fd
   37     }
   38 
   39     # Helpers to run tests in interactive mode
   40 
   41     proc format_output {output} {
   42         set _ [string trimright [regsub -all "\r" $output ""] "\n"]
   43     }
   44 
   45     proc run_command {fd cmd} {
   46         write_cli $fd $cmd
   47         set _ [format_output [read_cli $fd]]
   48     }
   49 
   50     proc test_interactive_cli {name code} {
   51         set ::env(FAKETTY) 1
   52         set fd [open_cli]
   53         test "Interactive CLI: $name" $code
   54         close_cli $fd
   55         unset ::env(FAKETTY)
   56     }
   57 
   58     # Helpers to run tests where stdout is not a tty
   59     proc write_tmpfile {contents} {
   60         set tmp [tmpfile "cli"]
   61         set tmpfd [open $tmp "w"]
   62         puts -nonewline $tmpfd $contents
   63         close $tmpfd
   64         set _ $tmp
   65     }
   66 
   67     proc _run_cli {opts args} {
   68         set cmd [rediscli [srv host] [srv port] [list -n 9 {*}$args]]
   69         foreach {key value} $opts {
   70             if {$key eq "pipe"} {
   71                 set cmd "sh -c \"$value | $cmd\""
   72             }
   73             if {$key eq "path"} {
   74                 set cmd "$cmd < $value"
   75             }
   76         }
   77 
   78         set fd [open "|$cmd" "r"]
   79         fconfigure $fd -buffering none
   80         fconfigure $fd -translation binary
   81         set resp [read $fd 1048576]
   82         close $fd
   83         set _ [format_output $resp]
   84     }
   85 
   86     proc run_cli {args} {
   87         _run_cli {} {*}$args
   88     }
   89 
   90     proc run_cli_with_input_pipe {cmd args} {
   91         _run_cli [list pipe $cmd] -x {*}$args
   92     }
   93 
   94     proc run_cli_with_input_file {path args} {
   95         _run_cli [list path $path] -x {*}$args
   96     }
   97 
   98     proc test_nontty_cli {name code} {
   99         test "Non-interactive non-TTY CLI: $name" $code
  100     }
  101 
  102     # Helpers to run tests where stdout is a tty (fake it)
  103     proc test_tty_cli {name code} {
  104         set ::env(FAKETTY) 1
  105         test "Non-interactive TTY CLI: $name" $code
  106         unset ::env(FAKETTY)
  107     }
  108 
  109     test_interactive_cli "INFO response should be printed raw" {
  110         set lines [split [run_command $fd info] "\n"]
  111         foreach line $lines {
  112             assert [regexp {^$|^#|^[a-z0-9_]+:.+} $line]
  113         }
  114     }
  115 
  116     test_interactive_cli "Status reply" {
  117         assert_equal "OK" [run_command $fd "set key foo"]
  118     }
  119 
  120     test_interactive_cli "Integer reply" {
  121         assert_equal "(integer) 1" [run_command $fd "incr counter"]
  122     }
  123 
  124     test_interactive_cli "Bulk reply" {
  125         r set key foo
  126         assert_equal "\"foo\"" [run_command $fd "get key"]
  127     }
  128 
  129     test_interactive_cli "Multi-bulk reply" {
  130         r rpush list foo
  131         r rpush list bar
  132         assert_equal "1) \"foo\"\n2) \"bar\"" [run_command $fd "lrange list 0 -1"]
  133     }
  134 
  135     test_interactive_cli "Parsing quotes" {
  136         assert_equal "OK" [run_command $fd "set key \"bar\""]
  137         assert_equal "bar" [r get key]
  138         assert_equal "OK" [run_command $fd "set key \" bar \""]
  139         assert_equal " bar " [r get key]
  140         assert_equal "OK" [run_command $fd "set key \"\\\"bar\\\"\""]
  141         assert_equal "\"bar\"" [r get key]
  142         assert_equal "OK" [run_command $fd "set key \"\tbar\t\""]
  143         assert_equal "\tbar\t" [r get key]
  144 
  145         # invalid quotation
  146         assert_equal "Invalid argument(s)" [run_command $fd "get \"\"key"]
  147         assert_equal "Invalid argument(s)" [run_command $fd "get \"key\"x"]
  148 
  149         # quotes after the argument are weird, but should be allowed
  150         assert_equal "OK" [run_command $fd "set key\"\" bar"]
  151         assert_equal "bar" [r get key]
  152     }
  153 
  154     test_tty_cli "Status reply" {
  155         assert_equal "OK" [run_cli set key bar]
  156         assert_equal "bar" [r get key]
  157     }
  158 
  159     test_tty_cli "Integer reply" {
  160         r del counter
  161         assert_equal "(integer) 1" [run_cli incr counter]
  162     }
  163 
  164     test_tty_cli "Bulk reply" {
  165         r set key "tab\tnewline\n"
  166         assert_equal "\"tab\\tnewline\\n\"" [run_cli get key]
  167     }
  168 
  169     test_tty_cli "Multi-bulk reply" {
  170         r del list
  171         r rpush list foo
  172         r rpush list bar
  173         assert_equal "1) \"foo\"\n2) \"bar\"" [run_cli lrange list 0 -1]
  174     }
  175 
  176     test_tty_cli "Read last argument from pipe" {
  177         assert_equal "OK" [run_cli_with_input_pipe "echo foo" set key]
  178         assert_equal "foo\n" [r get key]
  179     }
  180 
  181     test_tty_cli "Read last argument from file" {
  182         set tmpfile [write_tmpfile "from file"]
  183         assert_equal "OK" [run_cli_with_input_file $tmpfile set key]
  184         assert_equal "from file" [r get key]
  185         file delete $tmpfile
  186     }
  187 
  188     test_nontty_cli "Status reply" {
  189         assert_equal "OK" [run_cli set key bar]
  190         assert_equal "bar" [r get key]
  191     }
  192 
  193     test_nontty_cli "Integer reply" {
  194         r del counter
  195         assert_equal "1" [run_cli incr counter]
  196     }
  197 
  198     test_nontty_cli "Bulk reply" {
  199         r set key "tab\tnewline\n"
  200         assert_equal "tab\tnewline" [run_cli get key]
  201     }
  202 
  203     test_nontty_cli "Multi-bulk reply" {
  204         r del list
  205         r rpush list foo
  206         r rpush list bar
  207         assert_equal "foo\nbar" [run_cli lrange list 0 -1]
  208     }
  209 
  210     test_nontty_cli "Read last argument from pipe" {
  211         assert_equal "OK" [run_cli_with_input_pipe "echo foo" set key]
  212         assert_equal "foo\n" [r get key]
  213     }
  214 
  215     test_nontty_cli "Read last argument from file" {
  216         set tmpfile [write_tmpfile "from file"]
  217         assert_equal "OK" [run_cli_with_input_file $tmpfile set key]
  218         assert_equal "from file" [r get key]
  219         file delete $tmpfile
  220     }
  221 
  222     proc test_redis_cli_rdb_dump {} {
  223         r flushdb
  224 
  225         set dir [lindex [r config get dir] 1]
  226 
  227         assert_equal "OK" [r debug populate 100000 key 1000]
  228         catch {run_cli --rdb "$dir/cli.rdb"} output
  229         assert_match {*Transfer finished with success*} $output
  230 
  231         file delete "$dir/dump.rdb"
  232         file rename "$dir/cli.rdb" "$dir/dump.rdb"
  233 
  234         assert_equal "OK" [r set should-not-exist 1]
  235         assert_equal "OK" [r debug reload nosave]
  236         assert_equal {} [r get should-not-exist]
  237     }
  238 
  239     test "Dumping an RDB" {
  240         # Disk-based master
  241         assert_match "OK" [r config set repl-diskless-sync no]
  242         test_redis_cli_rdb_dump
  243 
  244         # Disk-less master
  245         assert_match "OK" [r config set repl-diskless-sync yes]
  246         assert_match "OK" [r config set repl-diskless-sync-delay 0]
  247         test_redis_cli_rdb_dump
  248     }
  249 
  250     test "Connecting as a replica" {
  251         set fd [open_cli "--replica"]
  252         wait_for_condition 500 500 {
  253             [string match {*slave0:*state=online*} [r info]]
  254         } else {
  255             fail "redis-cli --replica did not connect"
  256         }
  257 
  258         for {set i 0} {$i < 100} {incr i} {
  259            r set test-key test-value-$i
  260         }
  261         r client kill type slave
  262         catch {
  263             assert_match {*SET*key-a*} [read_cli $fd]
  264         }
  265 
  266         close_cli $fd
  267     }
  268 
  269     test "Piping raw protocol" {
  270         set cmds [tmpfile "cli_cmds"]
  271         set cmds_fd [open $cmds "w"]
  272 
  273         puts $cmds_fd [formatCommand select 9]
  274         puts $cmds_fd [formatCommand del test-counter]
  275 
  276         for {set i 0} {$i < 1000} {incr i} {
  277             puts $cmds_fd [formatCommand incr test-counter]
  278             puts $cmds_fd [formatCommand set large-key [string repeat "x" 20000]]
  279         }
  280 
  281         for {set i 0} {$i < 100} {incr i} {
  282             puts $cmds_fd [formatCommand set very-large-key [string repeat "x" 512000]]
  283         }
  284         close $cmds_fd
  285 
  286         set cli_fd [open_cli "--pipe" $cmds]
  287         fconfigure $cli_fd -blocking true
  288         set output [read_cli $cli_fd]
  289 
  290         assert_equal {1000} [r get test-counter]
  291         assert_match {*All data transferred*errors: 0*replies: 2102*} $output
  292 
  293         file delete $cmds
  294     }
  295 }