1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use FindBin qw($Bin);
use lib "$Bin/lib";
use Carp qw(croak);
use MemcachedTest;
use IO::Socket qw(AF_INET SOCK_STREAM);
use IO::Select;
use Data::Dumper qw/Dumper/;
if (!supports_proxy()) {
plan skip_all => 'proxy not enabled';
exit 0;
}
my $t = Memcached::ProxyTest->new(servers => [12173]);
my $p_srv = new_memcached('-o proxy_config=./t/proxymut.lua -t 1');
my $ps = $p_srv->sock;
$ps->autoflush(1);
$t->set_c($ps);
$t->accept_backends();
my $w = $p_srv->new_sock;
print $w "watch proxyevents\r\n";
is(<$w>, "OK\r\n");
{
test_mg();
}
sub test_mg {
note 'test mut with initial mg commands';
subtest 'mgreq' => sub {
$t->c_send("mg mgreq\r\n");
$t->be_recv(0, "mg override\r\n");
$t->be_send(0, "HD\r\n");
$t->c_recv_be();
$t->clear();
};
subtest 'mgflagreq' => sub {
$t->c_send("mg mgflagreq\r\n");
$t->be_recv(0, "mg override s t Oopaque N33\r\n");
$t->be_send(0, "HD s2 t33 Opaque\r\n");
$t->c_recv_be();
$t->clear();
};
subtest 'mgreqcopy' => sub {
$t->c_send("mg mgreqcopy\r\n");
$t->be_recv(0, "md differentkey\r\n");
$t->be_send(0, "NF\r\n");
$t->c_recv_be();
$t->clear();
};
subtest 'mgres' => sub {
$t->c_send("mg mgres\r\n");
$t->c_recv("HD\r\n");
# Do this twice in a row to be sure there isn't junk.
$t->c_send("mg mgres\r\n");
$t->c_recv("HD\r\n");
$t->clear();
};
subtest 'mgresval' => sub {
$t->c_send("mg mgresval\r\n");
$t->c_recv("VA 13\r\n");
$t->c_recv("example value\r\n");
$t->clear();
};
subtest 'mgresflag' => sub {
$t->c_send("mg mgresflag\r\n");
$t->be_recv(0, "mg mgresflag\r\n");
$t->be_send(0, "HD s2 Omgresflag f3\r\n");
$t->c_recv("HD t37 Omgresflag\r\n");
$t->c_send("mg mgresflag\r\n");
$t->be_recv(0, "mg mgresflag\r\n");
$t->be_send(0, "HD s2 f3\r\n");
$t->c_recv("HD t37\r\n");
$t->clear();
};
subtest 'mgresflag2' => sub {
$t->c_send("mg mgresflag2\r\n");
$t->be_recv(0, "mg mgresflag2\r\n");
$t->be_send(0, "HD s2 Omgresflag2 f3\r\n");
$t->c_recv("HD t37 Otoast\r\n");
$t->clear();
};
subtest 'mgresflag3' => sub {
$t->c_send("mg mgresflag3\r\n");
$t->be_recv(0, "mg mgresflag3\r\n");
$t->be_send(0, "HD s2 Omgresflag3 f3\r\n");
$t->c_recv("HD t37\r\n");
$t->clear();
};
subtest 'mgresflag4' => sub {
$t->c_send("mg mgresflag4\r\n");
$t->be_recv(0, "mg mgresflag4\r\n");
$t->be_send(0, "HD s2 Omgresflag4 f3\r\n");
$t->c_recv("HD t37 O\r\n");
$t->clear();
};
subtest 'mgresflagall' => sub {
$t->c_send("mg mgresflagall\r\n");
$t->be_recv(0, "mg mgresflagall\r\n");
# nonsense response for testing.
$t->be_send(0, "VA 2 t41 Oopaque s2 X W Z\r\nhi\r\n");
$t->c_recv("HD t41 Oopaque s2 X W Z\r\n");
$t->clear();
};
subtest 'mgresflagallint' => sub {
$t->c_send("ms mgresflagallint 2\r\nhi\r\n");
$t->c_recv("HD\r\n", "seeded item");
$t->c_send("mg mgresflagallint v t O123456 s h\r\n");
$t->c_recv("HD t-1 O123456 s2 h0\r\n");
$t->clear();
};
subtest 'mgreserr' => sub {
$t->c_send("mg mgresteapot\r\n");
$t->c_recv("SERVER_ERROR teapot\r\n");
$t->clear();
};
}
done_testing();
|
