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 => [12011, 12012, 12013, 12014]);
25
26my $p_srv = new_memcached('-o proxy_config=./t/proxyfuncgen.lua -t 1');
27my $ps = $p_srv->sock;
28$ps->autoflush(1);
29
30$t->set_c($ps);
31$t->accept_backends();
32{
33    # Comment out unused sections when debugging.
34    test_pipeline();
35    test_split();
36    test_basic();
37    test_waitfor();
38    # Run test returns twice for extra leak checking.
39    my $func_before = mem_stats($ps, "proxyfuncs");
40    test_returns();
41    test_returns();
42    subtest 'final func counts' => sub {
43        check_func_counts($ps, $func_before);
44    };
45    test_errors();
46}
47
48done_testing();
49
50# This kind of testing is difficult to do from integration level test suites
51# like this, but do what we can.
52sub test_errors {
53    note 'test specific error handling';
54
55    # Looking specifically for slot leaks. So we run the test N times and
56    # check immediately.
57    my $func_before = mem_stats($ps, "proxyfuncs");
58    subtest 'bad data chunk' => sub {
59        for (1 .. 3) {
60            $t->c_send("ms badchunk 2\r\nfail");
61            $t->c_recv("CLIENT_ERROR bad data chunk\r\n", "got bad data chunk response");
62        }
63        $t->clear();
64        check_func_counts($ps, $func_before);
65    };
66
67    # Need to pipeline to force the second slot to generate.
68    subtest 'slot generation failure' => sub {
69        my $cmd = "md failgen/a\r\n";
70        $t->c_send("$cmd$cmd");
71        $t->c_recv("NF\r\n");
72        $t->c_recv("SERVER_ERROR lua start failure\r\n");
73        $t->clear();
74    };
75
76    subtest 'wrong return object' => sub {
77        $t->c_send("mg badreturn/a\r\n");
78        $t->c_recv("SERVER_ERROR bad response\r\n");
79        $t->clear();
80    };
81}
82
83sub test_pipeline {
84    note 'test pipelining of requests';
85
86    # We're expecting the slots to actually increase on the first loop, so
87    # make sure we test that explicitly.
88    my $func_before = mem_stats($ps, "proxyfuncs");
89
90    subtest 'some pipelines' => sub {
91        note 'run a couple pipelines to check for leaks';
92        for my $count (1 .. 3) {
93            my @keys = ("a".."f");
94            my $cmd = '';
95            for my $k (@keys) {
96                $cmd .= "mg all/$k O$k\r\n";
97            }
98            $t->c_send("$cmd");
99            for my $k (@keys) {
100                $t->be_recv([0, 1, 2], "mg all/$k O$k\r\n", "backend received pipelined $k");
101                $t->be_send([0, 1, 2], "HD O$k\r\n");
102            }
103
104            for my $k (@keys) {
105                $t->c_recv("HD O$k\r\n", "client got res $k");
106            }
107            $t->clear();
108
109            if ($count == 1) {
110                my $func_after = mem_stats($ps, "proxyfuncs");
111                cmp_ok($func_after->{"slots_all"}, '>=', $func_before->{"slots_all"}, 'slot count increased');
112                # ensure we don't add more slots after this run.
113                $func_before = $func_after;
114            } else {
115                check_func_counts($ps, $func_before);
116            }
117        }
118    };
119
120    subtest 'ensuring unique slot environments' => sub {
121        # In each loop we send the command three times pipelined, but we
122        # should get three unique lua environments.
123        # In subsequent loops, the numbers will increment in lockstep.
124        for my $x (1 .. 5) {
125            # key doesn't matter; function isn't looking at it.
126            my $cmd = "mg locality/a\r\n";
127            $t->c_send("$cmd$cmd$cmd");
128            for (1 .. 3) {
129                $t->be_recv([0], $cmd, "backend 0 received locaity req");
130                $t->be_send([0], "EN\r\n"); # not sending to client.
131            }
132            for (1 .. 3) {
133                $t->c_recv("HD t$x\r\n", "client got return sequence $x");
134            }
135        }
136    };
137}
138
139sub test_split {
140    note 'test tiering of factories';
141
142    my $func_before = mem_stats($ps, "proxyfuncs");
143    # be's 0 and 3 are in use.
144    subtest 'basic split' => sub {
145        $t->c_send("mg split/a t\r\n");
146        $t->be_recv_c([0, 3], 'each factory be gets the request');
147        $t->be_send(3, "EN\r\n");
148        $t->be_send(0, "HD t70\r\n");
149        $t->c_recv_be('client received hit');
150        $t->clear();
151    };
152
153    # one side of split is a complex function; doing its own waits and wakes.
154    # other side is simple, and response ignored.
155    subtest 'failover split' => sub {
156        $t->c_send("mg splitfailover/f t\r\n");
157        $t->be_recv_c(0, 'first backend receives client req');
158        $t->be_recv_c(3, 'split factory gets client req');
159        $t->be_send(3, "HD t133\r\n");
160
161        # ensure all of the failover backends have their results processed.
162        $t->be_send(0, "EN Ofirst\r\n");
163        $t->be_recv_c([1, 2], 'rest of be receives retry');
164        $t->be_send([1, 2], "EN Ofailover\r\n");
165        $t->c_recv("EN Ofirst\r\n", 'client receives first res');
166        $t->clear();
167    };
168
169    subtest 'tiering func counts' => sub {
170        check_func_counts($ps, $func_before);
171    };
172}
173
174sub test_returns {
175    note 'stress testing return scenarios for ctx and sub-ctx';
176
177    # TODO: check that we don't re-generate a slot after each error type
178    subtest 'top level result errors' => sub {
179        $t->c_send("mg errors/reterror t\r\n");
180        $t->c_recv("SERVER_ERROR lua failure\r\n", "lua threw an error");
181
182        $t->c_send("mg errors/retnil t\r\n");
183        $t->c_recv("SERVER_ERROR bad response\r\n", "lua returned nil");
184
185        $t->c_send("mg errors/retint t\r\n");
186        $t->c_recv("SERVER_ERROR bad response\r\n", "lua returned an integer");
187
188        $t->c_send("mg errors/retnone t\r\n");
189        $t->c_recv("SERVER_ERROR bad response\r\n", "lua returned nothing");
190        $t->clear();
191    };
192
193    # TODO: method to differentiate a sub-rctx failure from a "backend
194    # failure"
195    subtest 'sub-rctx result errors' => sub {
196        $t->c_send("mg suberrors/error t\r\n");
197        $t->c_recv("SERVER_ERROR backend failure\r\n", "lua threw an error");
198
199        $t->c_send("mg suberrors/nil t\r\n");
200        $t->c_recv("SERVER_ERROR backend failure\r\n", "lua returned nil");
201
202        $t->c_send("mg suberrors/int t\r\n");
203        $t->c_recv("SERVER_ERROR backend failure\r\n", "lua returned an integer");
204
205        $t->c_send("mg suberrors/none t\r\n");
206        $t->c_recv("SERVER_ERROR backend failure\r\n", "lua returned nothing");
207        $t->clear();
208    };
209}
210
211sub test_waitfor {
212    note 'stress testing rctx:wait_cond scenarios';
213
214    my $func_before = mem_stats($ps, "proxyfuncs");
215    subtest 'wait_fastgood: hit, c_recv, miss miss' => sub {
216        $t->c_send("mg fastgoodint/a\r\n");
217        $t->be_recv_c([0, 1, 2]);
218        $t->be_send(0, "HD t1\r\n");
219        $t->c_recv_be('first good response');
220        $t->be_send([1, 2], "EN Ohmm\r\n");
221        $t->clear();
222    };
223
224    subtest 'wait_fastgood: miss, miss, c_recv, hit' => sub {
225        $t->c_send("mg fastgoodint/a\r\n");
226        $t->be_recv_c([0, 1, 2]);
227        $t->be_send([1, 2], "EN Ommh\r\n");
228        $t->c_recv_be('received miss');
229        $t->be_send([0], "HD t40\r\n");
230        $t->clear();
231    };
232
233    subtest 'wait_fastgood: miss, hit, hit' => sub {
234        $t->c_send("mg fastgoodint/a\r\n");
235        $t->be_recv_c([0, 1, 2]);
236        $t->be_send(0, "EN Omhh\r\n");
237        $t->be_send(1, "HD t43\r\n");
238        $t->be_send(2, "HD t44\r\n");
239        $t->c_recv("HD t43\r\n", 'received first');
240        $t->clear();
241    };
242
243    subtest 'wait_cond(0)' => sub {
244        $t->c_send("mg waitfor/a\r\n");
245        $t->c_recv("HD t1\r\n", 'client response before backends receive cmd');
246        $t->be_recv_c([0, 1, 2]);
247        $t->be_send([0, 1, 2], "HD t9\r\n");
248        $t->clear();
249    };
250
251    subtest 'wait_cond(0) then wait_cond(2)' => sub {
252        $t->c_send("mg waitfor/b t\r\n");
253        $t->be_recv_c([0, 1, 2]);
254        $t->be_send([0, 1, 2], "HD t13\r\n");
255        $t->c_recv_be();
256        $t->clear();
257    };
258
259    subtest 'wait_cond(0) then queue then wait_cond(1)' => sub {
260        $t->c_send("mg waitfor/c t\r\n");
261        $t->be_recv_c([0, 1, 2]);
262        $t->be_send([0, 1, 2], "HD t11\r\n");
263        $t->c_recv_be();
264        $t->clear();
265    };
266
267    subtest 'queue two, wait_handle individually' => sub {
268        $t->c_send("mg waitfor/d t\r\n");
269        $t->be_recv_c([0, 1]);
270        # respond from the non-waited be first
271        $t->be_send(1, "HD t23\r\n");
272        ok(!$t->wait_c(0.2), 'client doesnt become readable');
273        $t->be_send(0, "HD t17\r\n");
274        $t->c_recv("HD t23\r\n");
275        $t->clear();
276    };
277
278    # failover is referenced from another funcgen, so when we first fetch it
279    # here we end up creating a new slot deliberately.
280    $func_before->{slots_failover}++;
281    subtest 'failover route first success' => sub {
282        $t->c_send("mg failover/a t\r\n");
283        $t->be_recv_c(0);
284        $t->be_send(0, "HD t31\r\n");
285        $t->c_recv_be();
286        $t->clear();
287    };
288
289    subtest 'failover route failover success' => sub {
290        $t->c_send("mg failover/b t\r\n");
291        $t->be_recv_c(0, 'first backend receives client req');
292        $t->be_send(0, "EN\r\n");
293        # TODO: test that they aren't active before we send the resposne to 0?
294        $t->be_recv_c([1, 2], 'rest of be then receive the retry');
295        $t->be_send(1, "EN\r\n");
296        $t->be_send(2, "HD t41\r\n");
297        $t->c_recv_be('client received last response');
298    };
299
300    subtest 'failover route failover fail' => sub {
301        $t->c_send("mg failover/c t\r\n");
302        $t->be_recv_c(0, 'first backend receives client req');
303        $t->be_send(0, "EN Ofirst\r\n");
304        $t->be_recv_c([1, 2], 'rest of be receives retry');
305        $t->be_send([1, 2], "EN Ofailover\r\n");
306        $t->c_recv("EN Ofirst\r\n", 'client receives first res');
307    };
308
309    subtest 'wait cond func counts' => sub {
310        check_func_counts($ps, $func_before);
311    };
312}
313
314sub test_basic {
315    note 'basic functionality tests';
316
317    my $func_before = mem_stats($ps, "proxyfuncs");
318    # actually referenced an extra time.
319    $func_before->{slots_single}++;
320    subtest 'single backend route' => sub {
321        $t->c_send("mg single/a\r\n");
322        $t->be_recv_c(0);
323        $t->be_send(0, "HD\r\n");
324        $t->c_recv_be();
325        $t->clear();
326    };
327
328    subtest 'first route' => sub {
329        $t->c_send("mg first/a t\r\n");
330        $t->be_recv_c([0, 1, 2]);
331        # respond from the other two backends first.
332        $t->be_send([1, 2], "HD t5\r\n");
333        $t->be_send(0, "HD t1\r\n");
334        # receive just the last command.
335        $t->c_recv_be();
336        $t->clear();
337    };
338
339    subtest 'partial route' => sub {
340        $t->c_send("mg partial/a t\r\n");
341        $t->be_recv_c([0, 1, 2]);
342        $t->be_send(0, "HD t4\r\n");
343        ok(!$t->wait_c(0.2), 'client doesnt become readable');
344        $t->be_send(1, "HD t4\r\n");
345        $t->c_recv_be('response received after 2/3 returned');
346        $t->be_send(2, "HD t5\r\n");
347        $t->clear();
348    };
349
350    subtest 'all route' => sub {
351        $t->c_send("mg all/a t\r\n");
352        $t->be_recv_c([0, 1, 2]);
353        $t->be_send([0, 1], "HD t1\r\n");
354        ok(!$t->wait_c(0.2), 'client doesnt become readable');
355        $t->be_send(2, "HD t1\r\n");
356        $t->c_recv_be('response received after 3/3 returned');
357        $t->clear();
358    };
359
360    subtest 'fastgood route' => sub {
361        $t->c_send("mg fastgood/a t\r\n");
362        $t->be_recv_c([0, 1, 2]);
363        # Send one valid but not a hit.
364        $t->be_send(0, "EN\r\n");
365        ok(!$t->wait_c(0.2), 'client doesnt become readable');
366        $t->be_send(1, "HD t5\r\n");
367        $t->c_recv_be('response received after first good');
368        $t->be_send(2, "EN\r\n");
369        $t->clear();
370    };
371
372    subtest 'blocker route' => sub {
373        # The third backend is our blocker, first test that normal backends return
374        # but we don't return to client.
375        $t->c_send("mg blocker/a t Ltest\r\n");
376        $t->be_recv_c([0, 1, 2, 3], 'received blocker requests');
377        $t->be_send([0, 1, 2], "HD t10\r\n");
378        ok(!$t->wait_c(0.2), 'client doesnt become readable');
379        $t->be_send(3, "HD t15\r\n");
380        # Now, be sure we didn't receive the blocker response
381        $t->c_recv("HD t10\r\n");
382        $t->clear();
383
384        note '... failed blocker';
385        $t->c_send("mg blocker/b t Ltest\r\n");
386        $t->be_recv_c([0, 1, 2, 3]);
387        $t->be_send([0, 1, 2], "HD t10\r\n");
388        ok(!$t->wait_c(0.2), 'client doesnt become readable');
389        $t->be_send(3, "EN\r\n");
390        # Should get the blocker failed response.
391        $t->c_recv("SERVER_ERROR blocked\r\n");
392        $t->clear();
393    };
394
395    subtest 'logall route' => sub {
396        my $w = $p_srv->new_sock;
397        print $w "watch proxyuser proxyreqs\n";
398        is(<$w>, "OK\r\n", 'watcher enabled');
399
400        $t->c_send("mg logall/a t\r\n");
401        $t->be_recv_c([0, 1, 2]);
402        $t->be_send([0, 1, 2], "HD t3\r\n");
403        $t->c_recv_be();
404        for (0 .. 2) {
405            like(<$w>, qr/received a response: /, 'got a log line');
406            my $l2 = scalar <$w>;
407            like($l2, qr/even more logs/, 'got logreq line');
408            like($l2, qr/cfd=/, 'client file descriptor present');
409            unlike($l2, qr/cfd=0/, 'client file descriptor is nonzero');
410        }
411        $t->clear();
412    };
413
414    subtest 'summary_factory' => sub {
415        my $w = $p_srv->new_sock;
416        print $w "watch proxyuser\n";
417        is(<$w>, "OK\r\n", 'watcher enabled');
418
419        $t->c_send("mg summary/a t\r\n");
420        $t->be_recv_c([0, 1, 2]);
421        $t->be_send([0, 1, 2], "HD t8\r\n");
422        $t->c_recv_be();
423        like(<$w>, qr/received all responses/, 'got a log summary line');
424        $t->clear();
425    };
426
427    subtest 'basic func counts' => sub {
428        check_func_counts($ps, $func_before);
429    };
430}
431
432# To help debug, if a failure is encountered move this function up in its
433# caller function and bisect.
434# This is an out of band test: it won't fail on the test that breaks it.
435# If a slot isn't returned properly the next test will generate one, and
436# the counts will be off after that.
437# This might mean to be absolutely sure, we should run the last test in a set
438# twice.
439sub check_func_counts {
440    my $c = shift;
441    my $a = shift;
442    my $b = mem_stats($c, "proxyfuncs");
443    my $bad = 0;
444    for my $key (keys %$a) {
445        # Don't want to pollute/slow down the output with tons of ok's here,
446        # so only fail on the fail conditions.
447        if (! exists $b->{$key}) {
448            fail("func stat gone missing: $key");
449            $bad = 1;
450        }
451        if ($a->{$key} != $b->{$key}) {
452            cmp_ok($b->{$key}, '==', $a->{$key}, "func stat for $key");
453            $bad = 1;
454        }
455    }
456    if (!$bad) {
457        pass();
458    }
459}
460