1#!/usr/bin/env perl
2# Was wondering why we didn't use subtest more.
3# Turns out it's "relatively new", so it wasn't included in CentOS 5. which we
4# had to support until a few years ago. So most of the tests had been written
5# beforehand.
6
7use strict;
8use warnings;
9use Test::More;
10use FindBin qw($Bin);
11use lib "$Bin/lib";
12use Carp qw(croak);
13use MemcachedTest;
14use IO::Socket qw(AF_INET SOCK_STREAM);
15use IO::Select;
16
17if (!supports_proxy()) {
18    plan skip_all => 'proxy not enabled';
19    exit 0;
20}
21
22# Set up the listeners _before_ starting the proxy.
23# the fourth listener is only occasionally used.
24my $t = Memcached::ProxyTest->new(servers => [12021]);
25
26my $p_srv = new_memcached('-o proxy_config=./t/proxyrouter.lua -t 1');
27my $ps = $p_srv->sock;
28$ps->autoflush(1);
29
30$t->set_c($ps);
31$t->accept_backends();
32
33{
34    test_cmap();
35    test_submap();
36    test_basic();
37    test_separators();
38}
39
40done_testing();
41
42sub test_cmap {
43    subtest 'check cmap only router' => sub {
44        $t->c_send("gets one|test\r\n");
45        $t->c_recv("SERVER_ERROR cmap_only gets\r\n");
46
47        $t->c_send("gat 5 one|test\r\n");
48        $t->c_recv("SERVER_ERROR cmap_only default\r\n");
49
50        $t->clear();
51    };
52}
53
54sub test_submap {
55    subtest 'check sub map routing' => sub {
56        $t->c_send("get cmd|test\r\n");
57        $t->c_recv("SERVER_ERROR cmd_get\r\n", "routed to sub-mg function");
58
59        $t->c_send("set cmd|test 0 0 2\r\nhi\r\n");
60        $t->c_recv("SERVER_ERROR cmd_set\r\n", "routed to sub-ms function");
61
62        $t->c_send("delete cmd|test\r\n");
63        $t->c_recv("SERVER_ERROR default route\r\n", "routed to sub-ms function");
64
65        $t->c_send("delete cmdd|test\r\n");
66        $t->c_recv("SERVER_ERROR cmd_default\r\n", "fall all the way back to default route");
67
68        $t->c_send("incr bar|foo 1\r\n");
69        $t->c_recv("SERVER_ERROR cmap incr\r\n", "routed fallback to cmap");
70
71        $t->c_send("decr bar|foo 1\r\n");
72        $t->c_recv("SERVER_ERROR cmap decr\r\n", "routed fallback to cmap");
73
74        $t->clear();
75    };
76}
77
78sub test_basic {
79    # If there's a lua stack leak somewhere running the query a few hundred
80    # times will cause a crash.
81    my $func_before = mem_stats($ps, "proxyfuncs");
82    subtest 'loop checking for lua leak' => sub {
83        for (1 .. 500) {
84            $t->c_send("mg one|key t$_\r\n");
85            $t->be_recv_c(0);
86            $t->be_send(0, "EN\r\n");
87            $t->c_recv_be();
88        }
89    };
90    check_func_counts($ps, $func_before);
91}
92
93# Router has short and long prefix and anchored prefix modes
94sub test_separators {
95    subtest 'short separator' => sub {
96        $t->c_send("mg one|key t3\r\n");
97        $t->be_recv_c(0, 'backend received mg');
98        $t->be_send(0, "EN\r\n");
99        $t->c_recv_be();
100
101        $t->c_send("mg one/found\r\n");
102        $t->c_recv("SERVER_ERROR default route\r\n", 'got default route');
103        $t->clear();
104    };
105
106    subtest 'long separator' => sub {
107        $t->c_send("ms one+#+foo 2\r\nhi\r\n");
108        $t->be_recv(0, "ms one+#+foo 2\r\n", 'backend received ms');
109        $t->be_recv(0, "hi\r\n", 'backend received data');
110        $t->be_send(0, "HD\r\n");
111        $t->c_recv_be();
112
113        $t->c_send("ms one+#found 2\r\nhi\r\n");
114        $t->c_recv("SERVER_ERROR default route\r\n", 'got default route');
115
116        $t->c_send("ms borked+ 2\r\nhi\r\n");
117        $t->c_recv("SERVER_ERROR default route\r\n", 'got default route');
118        $t->clear();
119    };
120
121    subtest 'short anchor' => sub {
122        $t->c_send("md _one,bar\r\n");
123        $t->be_recv_c(0);
124        $t->be_send(0, "HD\r\n");
125        $t->c_recv_be();
126
127        $t->c_send("md _one+nothing\r\n");
128        $t->c_recv("SERVER_ERROR default route\r\n", 'got default route');
129        $t->clear();
130    };
131
132    subtest 'long anchor' => sub {
133        $t->c_send("ma =?=one__key\r\n");
134        $t->be_recv_c(0, 'backend received ma');
135        $t->be_send(0, "HD\r\n");
136        $t->c_recv_be();
137
138        $t->c_send("ma =?=one_nothing\r\n");
139        $t->c_recv("SERVER_ERROR default route\r\n", 'got default route');
140        $t->clear();
141    };
142}
143
144sub check_func_counts {
145    my $c = shift;
146    my $a = shift;
147    my $b = mem_stats($c, "proxyfuncs");
148    for my $key (keys %$a) {
149        # Don't want to pollute/slow down the output with tons of ok's here,
150        # so only fail on the fail conditions.
151        if (! exists $b->{$key}) {
152            fail("func stat gone missing: $key");
153        }
154        if ($a->{$key} != $b->{$key}) {
155            cmp_ok($b->{$key}, '==', $a->{$key}, "func stat for $key");
156        }
157    }
158}
159