1#!/usr/bin/env perl 2 3use strict; 4use warnings; 5use Test::More; 6use FindBin qw($Bin); 7use lib "$Bin/lib"; 8use Carp qw(croak); 9use MemcachedTest; 10use IO::Socket qw(AF_INET SOCK_STREAM); 11use IO::Select; 12 13if (!supports_proxy()) { 14 plan skip_all => 'proxy not enabled'; 15 exit 0; 16} 17 18my $modefile = "/tmp/proxytagmode.lua"; 19my $t = Memcached::ProxyTest->new(servers => [12050]); 20 21write_modefile('return "start"'); 22my $p_srv = new_memcached('-l 127.0.0.1:12051 -l tag_b_:127.0.0.1:12052 -l tag_cccc_:127.0.0.1:12053 -o proxy_config=./t/proxytags.lua -t 1', 12051); 23my $ps = $p_srv->sock; 24$ps->autoflush(1); 25 26my $tagpsb = IO::Socket::INET->new(PeerAddr => "127.0.0.1:12052"); 27my $tagpsc = IO::Socket::INET->new(PeerAddr => "127.0.0.1:12053"); 28 29$t->set_c($ps); 30$t->accept_backends(); 31 32{ 33 test_basic(); 34} 35 36done_testing(); 37 38sub test_basic { 39 subtest 'untagged pass-thru' => sub { 40 $t->set_c($ps); 41 $t->c_send("mg foo t\r\n"); 42 $t->be_recv_c(0, 'backend received pass-thru cmd'); 43 $t->be_send(0, "HD t97\r\n"); 44 $t->c_recv_be('client received pass-thru response'); 45 }; 46 47 subtest 'tag B works' => sub { 48 $t->set_c($tagpsb); 49 $t->c_send("mg bar t\r\n"); 50 # No backend, looking for string response. 51 $t->c_recv("SERVER_ERROR tag B\r\n", 'received resp from tagged handler'); 52 }; 53 54 subtest 'tag CCCC works' => sub { 55 $t->set_c($tagpsc); 56 $t->c_send("mg baz t\r\n"); 57 # No backend, looking for string response. 58 $t->c_recv("SERVER_ERROR tag CCCC\r\n", 'received resp from tagged handler'); 59 }; 60} 61 62sub write_modefile { 63 my $cmd = shift; 64 open(my $fh, "> $modefile") or die "Couldn't overwrite $modefile: $!"; 65 print $fh $cmd; 66 close($fh); 67} 68 69sub wait_reload { 70 my $w = shift; 71 like(<$w>, qr/ts=(\S+) gid=\d+ type=proxy_conf status=start/, "reload started"); 72 like(<$w>, qr/ts=(\S+) gid=\d+ type=proxy_conf status=done/, "reload completed"); 73} 74 75END { 76 unlink $modefile; 77} 78