memcached: t/proxy.t

"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();