"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/proxy.t" (21 Feb 2022, 7995 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl 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.

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use warnings;
    5 use Test::More;
    6 use FindBin qw($Bin);
    7 use lib "$Bin/lib";
    8 use Carp qw(croak);
    9 use MemcachedTest;
   10 
   11 # TODO: to module?
   12 # or "gettimedrun" etc
   13 use Cwd;
   14 my $builddir = getcwd;
   15 
   16 if (!supports_proxy()) {
   17     plan skip_all => 'proxy not enabled';
   18     exit 0;
   19 }
   20 
   21 # TODO: the lua file has hardcoded ports. any way to make this dynamic?
   22 # TODO: once basic tests are done, actually split out the instances rather
   23 # than the shared backend; validate keys go where they should be going.
   24 
   25 # FIXME: this listend on unix socket still. either need a manual runner or a
   26 # fix upstream.
   27 my @srv = ();
   28 for (2 .. 6) {
   29     my $srv = run_server("-p 1121$_", 11210 + $_);
   30     push(@srv, $srv);
   31 }
   32 #my $sock = $srv->sock;
   33 
   34 my $p_srv = new_memcached('-o proxy_config=./t/startfile.lua -l 127.0.0.1', 11211);
   35 my $p_sock = $p_srv->sock;
   36 
   37 # hack to help me use T_MEMD_USE_DAEMON for proxy.
   38 #print STDERR "Sleeping\n";
   39 #sleep 900;
   40 
   41 # cmds to test:
   42 # - noreply for main text commands?
   43 # meta:
   44 # me
   45 # mn
   46 # mg
   47 # ms
   48 # md
   49 # ma
   50 # - noreply?
   51 # stats
   52 # pass-thru?
   53 
   54 # incr/decr
   55 {
   56     print $p_sock "set /foo/num 0 0 1\r\n1\r\n";
   57     is(scalar <$p_sock>, "STORED\r\n", "stored num");
   58     mem_get_is($p_sock, "/foo/num", 1, "stored 1");
   59 
   60     print $p_sock "incr /foo/num 1\r\n";
   61     is(scalar <$p_sock>, "2\r\n", "+ 1 = 2");
   62     mem_get_is($p_sock, "/foo/num", 2);
   63 
   64     print $p_sock "incr /foo/num 8\r\n";
   65     is(scalar <$p_sock>, "10\r\n", "+ 8 = 10");
   66     mem_get_is($p_sock, "/foo/num", 10);
   67 
   68     print $p_sock "decr /foo/num 1\r\n";
   69     is(scalar <$p_sock>, "9\r\n", "- 1 = 9");
   70 
   71     print $p_sock "decr /foo/num 9\r\n";
   72     is(scalar <$p_sock>, "0\r\n", "- 9 = 0");
   73 
   74     print $p_sock "decr /foo/num 5\r\n";
   75     is(scalar <$p_sock>, "0\r\n", "- 5 = 0");
   76 }
   77 
   78 # gat
   79 {
   80     # cache miss
   81     print $p_sock "gat 10 /foo/foo1\r\n";
   82     is(scalar <$p_sock>, "END\r\n", "cache miss");
   83 
   84     # set /foo/foo1 and /foo/foo2 (and should get it)
   85     print $p_sock "set /foo/foo1 0 2 7\r\nfooval1\r\n";
   86     is(scalar <$p_sock>, "STORED\r\n", "stored foo");
   87 
   88     print $p_sock "set /foo/foo2 0 2 7\r\nfooval2\r\n";
   89     is(scalar <$p_sock>, "STORED\r\n", "stored /foo/foo2");
   90 
   91     # get and touch it with cas
   92     print $p_sock "gats 10 /foo/foo1 /foo/foo2\r\n";
   93     like(scalar <$p_sock>, qr/VALUE \/foo\/foo1 0 7 (\d+)\r\n/, "get and touch foo1 with cas regexp success");
   94     is(scalar <$p_sock>, "fooval1\r\n","value");
   95     like(scalar <$p_sock>, qr/VALUE \/foo\/foo2 0 7 (\d+)\r\n/, "get and touch foo2 with cas regexp success");
   96     is(scalar <$p_sock>, "fooval2\r\n","value");
   97     is(scalar <$p_sock>, "END\r\n", "end");
   98 
   99     # get and touch it without cas
  100     print $p_sock "gat 10 /foo/foo1 /foo/foo2\r\n";
  101     like(scalar <$p_sock>, qr/VALUE \/foo\/foo1 0 7\r\n/, "get and touch foo1 without cas regexp success");
  102     is(scalar <$p_sock>, "fooval1\r\n","value");
  103     like(scalar <$p_sock>, qr/VALUE \/foo\/foo2 0 7\r\n/, "get and touch foo2 without cas regexp success");
  104     is(scalar <$p_sock>, "fooval2\r\n","value");
  105     is(scalar <$p_sock>, "END\r\n", "end");
  106 }
  107 
  108 # gets/cas
  109 {
  110     print $p_sock "add /foo/moo 0 0 6\r\nmooval\r\n";
  111     is(scalar <$p_sock>, "STORED\r\n", "stored mooval");
  112     mem_get_is($p_sock, "/foo/moo", "mooval");
  113 
  114     # check-and-set (cas) failure case, try to set value with incorrect cas unique val
  115     print $p_sock "cas /foo/moo 0 0 6 0\r\nMOOVAL\r\n";
  116     is(scalar <$p_sock>, "EXISTS\r\n", "check and set with invalid id");
  117 
  118     # test "gets", grab unique ID
  119     print $p_sock "gets /foo/moo\r\n";
  120     # VALUE moo 0 6 3084947704
  121     #
  122     my @retvals = split(/ /, scalar <$p_sock>);
  123     my $data = scalar <$p_sock>; # grab data
  124     my $dot  = scalar <$p_sock>; # grab dot on line by itself
  125     is($retvals[0], "VALUE", "get value using 'gets'");
  126     my $unique_id = $retvals[4];
  127     # clean off \r\n
  128     $unique_id =~ s/\r\n$//;
  129     ok($unique_id =~ /^\d+$/, "unique ID '$unique_id' is an integer");
  130     # now test that we can store moo with the correct unique id
  131     print $p_sock "cas /foo/moo 0 0 6 $unique_id\r\nMOOVAL\r\n";
  132     is(scalar <$p_sock>, "STORED\r\n");
  133     mem_get_is($p_sock, "/foo/moo", "MOOVAL");
  134 }
  135 
  136 # touch
  137 {
  138     print $p_sock "set /foo/t 0 2 6\r\nfooval\r\n";
  139     is(scalar <$p_sock>, "STORED\r\n", "stored foo");
  140     mem_get_is($p_sock, "/foo/t", "fooval");
  141 
  142     # touch it
  143     print $p_sock "touch /foo/t 10\r\n";
  144     is(scalar <$p_sock>, "TOUCHED\r\n", "touched foo");
  145 
  146     # don't need to sleep/validate the touch worked. We're testing the
  147     # protocol, not the functionality.
  148 }
  149 
  150 # command endings
  151 # NOTE: memcached always allowed [\r]\n for single command lines, but payloads
  152 # (set/etc) require exactly \r\n as termination.
  153 # doc/protocol.txt has always specified \r\n for command/response.
  154 # Proxy is more strict than normal server in this case.
  155 {
  156     my $s = $srv[0]->sock;
  157     print $s "version\n";
  158     like(<$s>, qr/VERSION/, "direct server version cmd with just newline");
  159     print $p_sock "version\n";
  160     like(<$p_sock>, qr/SERVER_ERROR/, "proxy version cmd with just newline");
  161     print $p_sock "version\r\n";
  162     like(<$p_sock>, qr/VERSION/, "proxy version cmd with full CRLF");
  163 }
  164 
  165 # set through proxy.
  166 {
  167     print $p_sock "set /foo/z 0 0 5\r\nhello\r\n";
  168     is(scalar <$p_sock>, "STORED\r\n", "stored test value through proxy");
  169     # ensure it's fetchable.
  170     mem_get_is($p_sock, "/foo/z", "hello");
  171     # delete it.
  172     print $p_sock "delete /foo/z\r\n";
  173     is(scalar <$p_sock>, "DELETED\r\n", "removed test value");
  174     # ensure it's deleted.
  175     mem_get_is($p_sock, "/foo/z", undef);
  176 }
  177 
  178 # test add.
  179 {
  180     print $p_sock "add /foo/a 0 0 3\r\nmoo\r\n";
  181     is(scalar <$p_sock>, "STORED\r\n", "add test value through proxy");
  182     # ensure it's fetchable
  183     mem_get_is($p_sock, "/foo/a", "moo");
  184     # check re-adding fails.
  185     print $p_sock "add /foo/a 0 0 3\r\ngoo\r\n";
  186     is(scalar <$p_sock>, "NOT_STORED\r\n", "re-add fails");
  187     # ensure we still hae the old value
  188     mem_get_is($p_sock, "/foo/a", "moo");
  189 }
  190 
  191 # pipelined set.
  192 {
  193     my $str = "set /foo/k 0 0 5\r\nhello\r\n";
  194     print $p_sock "$str$str$str$str$str";
  195     is(scalar <$p_sock>, "STORED\r\n", "stored test value through proxy");
  196     is(scalar <$p_sock>, "STORED\r\n", "stored test value through proxy");
  197     is(scalar <$p_sock>, "STORED\r\n", "stored test value through proxy");
  198     is(scalar <$p_sock>, "STORED\r\n", "stored test value through proxy");
  199     is(scalar <$p_sock>, "STORED\r\n", "stored test value through proxy");
  200 }
  201 
  202 # Load some keys through proxy.
  203 my $bdata = 'x' x 256000;
  204 {
  205     for (1..20) {
  206         print $p_sock "set /foo/a$_ 0 0 2\r\nhi\r\n";
  207         is(scalar <$p_sock>, "STORED\r\n", "stored test value");
  208         print $p_sock "set /bar/b$_ 0 0 2\r\nhi\r\n";
  209         is(scalar <$p_sock>, "STORED\r\n", "stored test value");
  210     }
  211 
  212     # load a couple larger values
  213     for (1..4) {
  214         print $p_sock "set /foo/big$_ 0 0 256000\r\n$bdata\r\n";
  215         is(scalar <$p_sock>, "STORED\r\n", "stored big value");
  216     }
  217     diag "set large values";
  218 }
  219 
  220 # fetch through proxy.
  221 {
  222     for (1..20) {
  223         mem_get_is($p_sock, "/foo/a$_", "hi");
  224     }
  225     diag "fetched small values";
  226     mem_get_is($p_sock, "/foo/big1", $bdata);
  227     diag "fetched big value";
  228 }
  229 
  230 sub run_server {
  231     my ($args, $port) = @_;
  232 
  233     my $exe = get_memcached_exe();
  234 
  235     my $childpid = fork();
  236 
  237     my $root = '';
  238     $root = "-u root" if ($< == 0);
  239 
  240     # test build requires more privileges
  241     $args .= " -o relaxed_privileges";
  242 
  243     my $cmd = "$builddir/timedrun 120 $exe $root $args";
  244 
  245     unless($childpid) {
  246         exec $cmd;
  247         exit; # NOTREACHED
  248     }
  249 
  250     for (1..20) {
  251         my $conn = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port");
  252         if ($conn) {
  253             return Memcached::Handle->new(pid  => $childpid,
  254                 conn => $conn,
  255                 host => "127.0.0.1",
  256                 port => $port);
  257         }
  258         select undef, undef, undef, 0.10;
  259     }
  260     croak "Failed to start server.";
  261 }
  262 
  263 done_testing();