diff options
Diffstat (limited to 't/udp.t')
| -rwxr-xr-x | t/udp.t | 234 |
1 files changed, 175 insertions, 59 deletions
@@ -6,6 +6,27 @@ use FindBin qw($Bin); use lib "$Bin/lib"; use MemcachedTest; +use constant IS_ASCII => 0; +use constant IS_BINARY => 1; +use constant ENTRY_EXISTS => 0; +use constant ENTRY_MISSING => 1; +use constant BIN_REQ_MAGIC => 0x80; +use constant BIN_RES_MAGIC => 0x81; +use constant CMD_GET => 0x00; +use constant CMD_SET => 0x01; +use constant CMD_ADD => 0x02; +use constant CMD_REPLACE => 0x03; +use constant CMD_DELETE => 0x04; +use constant CMD_INCR => 0x05; +use constant CMD_DECR => 0x06; +use constant CMD_APPEND => 0x0E; +use constant CMD_PREPEND => 0x0F; +use constant REQ_PKT_FMT => "CCnCCnNNNN"; +use constant RES_PKT_FMT => "CCnCCnNNNN"; +use constant INCRDECR_PKT_FMT => "NNNNN"; +use constant MIN_RECV_BYTES => length(pack(RES_PKT_FMT)); + + my $server = new_memcached(); my $sock = $server->sock; @@ -17,74 +38,166 @@ mem_get_is($sock, "foo", "fooval"); my $usock = $server->new_udp_sock or die "Can't bind : $@\n"; -# test all the get steps, one by one: -test_single_op($usock,"get foo\r\n","VALUE foo 0 6\r\nfooval\r\nEND\r\n"); - -# test all the set steps, one by one: -test_single_op($usock,"set aval 0 0 1\r\n1\r\n","STORED\r\n"); - -# test all the incr steps, one by one: -test_single_op($usock,"incr aval 1\r\n","2\r\n"); - -# test all the delete steps, one by one: -test_single_op($usock,"delete aval\r\n","DELETED\r\n"); - - -# testing sequence numbers +# testing sequence of request ids for my $offt (1, 1, 2) { - my $seq = 160 + $offt; - my $res = send_udp_request($usock, $seq, "get foo\r\n"); + my $req = 160 + $offt; + my $res = send_udp_request($usock, $req, "get foo\r\n"); ok($res, "got result"); is(keys %$res, 1, "one key (one packet)"); ok($res->{0}, "only got seq number 0"); is(substr($res->{0}, 8), "VALUE foo 0 6\r\nfooval\r\nEND\r\n"); - is(hexify(substr($res->{0}, 0, 2)), hexify(pack("n", $seq)), "sequence number in response ($seq) is correct"); + is(hexify(substr($res->{0}, 0, 2)), hexify(pack("n", $req)), "udp request number in response ($req) is correct"); +} + +# op tests +for my $prot (::IS_ASCII,::IS_BINARY) { + udp_set_test($prot,45,"aval$prot","1",0,0); + udp_set_test($prot,45,"bval$prot","abcd" x 1024,0,0); + udp_get_test($prot,45,"aval$prot","1",::ENTRY_EXISTS); + udp_get_test($prot,45,"404$prot","1",::ENTRY_MISSING); + udp_incr_decr_test($prot,45,"aval$prot","1","incr",1); + udp_incr_decr_test($prot,45,"aval$prot","1","decr",2); + udp_delete_test($prot,45,"aval$prot","0"); +} + +sub udp_set_test { + my ($protocol, $req_id, $key, $value, $flags, $exp) = @_; + my $req = ""; + my $val_len = length($value); + + if ($protocol == ::IS_ASCII) { + $req = "set $key $flags $exp $val_len\r\n$value\r\n"; + } elsif ($protocol == ::IS_BINARY) { + my $key_len = length($key); + my $extra = pack "NN",$flags,$exp; + my $extra_len = length($extra); + my $total_len = $val_len + $extra_len + $key_len; + $req = pack(::REQ_PKT_FMT, ::BIN_REQ_MAGIC, ::CMD_SET, $key_len, $extra_len, 0, 0, $total_len, 0, 0, 0); + $req .= $extra . $key . $value; + } + + my $datagrams = send_udp_request($usock, $req_id, $req); + my $resp = construct_udp_message($datagrams); + + if ($protocol == ::IS_ASCII) { + is($resp,"STORED\r\n","Store key $key using ASCII protocol"); + } elsif ($protocol == ::IS_BINARY) { + my ($resp_magic, $resp_op_code, $resp_key_len, $resp_extra_len, $resp_data_type, $resp_status, $resp_total_len, + $resp_opaque, $resp_ident_hi, $resp_ident_lo) = unpack(::RES_PKT_FMT, $resp); + is($resp_status,"0","Store key $key using binary protocol"); + } +} + +sub udp_get_test { + my ($protocol, $req_id, $key, $value, $exists) = @_; + my $key_len = length($key); + my $value_len = length($value); + my $req = ""; + + if ($protocol == ::IS_ASCII) { + $req = "get $key\r\n"; + } elsif ($protocol == ::IS_BINARY) { + $req = pack(::REQ_PKT_FMT, ::BIN_REQ_MAGIC, ::CMD_GET, $key_len, 0, 0, 0, $key_len, 0, 0, 0); + $req .= $key; + } + + my $datagrams = send_udp_request($usock, $req_id, $req); + my $resp = construct_udp_message($datagrams); + + if ($protocol == ::IS_ASCII) { + if ($exists == ::ENTRY_EXISTS) { + is($resp,"VALUE $key 0 $value_len\r\n$value\r\nEND\r\n","Retrieve entry with key $key using ASCII protocol"); + } else { + is($resp,"END\r\n","Retrieve non existing entry with key $key using ASCII protocol"); + } + } elsif ($protocol == ::IS_BINARY) { + my ($resp_magic, $resp_op_code, $resp_key_len, $resp_extra_len, $resp_data_type, $resp_status, $resp_total_len, + $resp_opaque, $resp_ident_hi, $resp_ident_lo) = unpack(::RES_PKT_FMT, $resp); + if ($exists == ::ENTRY_EXISTS) { + is($resp_status,"0","Retrieve entry with key $key using binary protocol"); + is(substr($resp,::MIN_RECV_BYTES + $resp_extra_len + $resp_key_len, $value_len),$value,"Value for key $key retrieved with binary protocol matches"); + } else { + is($resp_status,"1","Retrieve non existing entry with key $key using binary protocol"); + } + } } -# testing non-existent stuff -my $res = send_udp_request($usock, 404, "get notexist\r\n"); -ok($res, "got result"); -is(keys %$res, 1, "one key (one packet)"); -ok($res->{0}, "only got seq number 0"); -is(hexify(substr($res->{0}, 0, 2)), hexify(pack("n", 404)), "sequence number 404 correct"); -is(substr($res->{0}, 8), "END\r\n"); - -# test multi-packet response -{ - my $big = "abcd" x 1024; - my $len = length $big; - print $sock "set big 0 0 $len\r\n$big\r\n"; - is(scalar <$sock>, "STORED\r\n", "stored big"); - mem_get_is($sock, "big", $big, "big value matches"); - my $res = send_udp_request($usock, 999, "get big\r\n"); - is(scalar keys %$res, 3, "three packet response"); - like($res->{0}, qr/VALUE big 0 4096/, "first packet has value line"); - like($res->{2}, qr/\r\nEND\r\n/, "last packet has end"); - is(hexify(substr($res->{1}, 0, 2)), hexify(pack("n", 999)), "sequence number of middle packet is correct"); +sub udp_delete_test { + my ($protocol, $req_id, $key, $time) = @_; + my $req = ""; + my $key_len = length($key); + + if ($protocol == ::IS_ASCII) { + $req = "delete $key $time\r\n"; + } elsif ($protocol == ::IS_BINARY) { + $req = pack(::REQ_PKT_FMT, ::BIN_REQ_MAGIC, ::CMD_DELETE, $key_len, 0, 0, 0, $key_len, 0, 0, 0); + $req .= $key; + } + + my $datagrams = send_udp_request($usock, $req_id, $req); + my $resp = construct_udp_message($datagrams); + + if ($protocol == ::IS_ASCII) { + is($resp,"DELETED\r\n","Delete key $key using ASCII protocol"); + } elsif ($protocol == ::IS_BINARY) { + my ($resp_magic, $resp_op_code, $resp_key_len, $resp_extra_len, $resp_data_type, $resp_status, $resp_total_len, + $resp_opaque, $resp_ident_hi, $resp_ident_lo) = unpack(::RES_PKT_FMT, $resp); + is($resp_status,"0","Delete key $key using binary protocol"); + } } -sub test_single_op { - my $usock = shift; - my $op = shift; - my $resp = shift; - my $req = pack("nnnn", 45, 0, 1, 0); # request id (opaque), seq num, #packets, reserved (must be 0) - $req .= $op; - ok(defined send($usock, $req, 0), "sent request"); - - my $rin = ''; - vec($rin, fileno($usock), 1) = 1; - my $rout; - ok(select($rout = $rin, undef, undef, 2.0), "got readability"); - - my $sender; - my $res; - $sender = $usock->recv($res, 1500, 0); - - my $id = pack("n", 45); - my $expctdlen = length($resp) + 8; - is(hexify(substr($res, 0, 8)), hexify($id) . '0000' . '0001' . '0000', "header is correct"); - is(length $res,$expctdlen,''); - is(substr($res, 8), $resp, "response is correct"); +sub udp_incr_decr_test { + my ($protocol, $req_id, $key, $val, $optype, $init_val) = @_; + my $req = ""; + my $key_len = length($key); + my $expected_value = 0; + my $acmd = "incr"; + my $bcmd = ::CMD_INCR; + if ($optype eq "incr") { + $expected_value = $init_val + $val; + } else { + $acmd = "decr"; + $bcmd = ::CMD_DECR; + $expected_value = $init_val - $val; + } + + if ($protocol == ::IS_ASCII) { + $req = "$acmd $key $val\r\n"; + } elsif ($protocol == ::IS_BINARY) { + my $extra = pack(::INCRDECR_PKT_FMT, ($val / 2 ** 32),($val % 2 ** 32), 0, 0, 0); + my $extra_len = length($extra); + $req = pack(::REQ_PKT_FMT, ::BIN_REQ_MAGIC, $bcmd, $key_len, $extra_len, 0, 0, $key_len + $extra_len, 0, 0, 0); + $req .= $extra . $key; + } + + my $datagrams = send_udp_request($usock, $req_id, $req); + my $resp = construct_udp_message($datagrams); + + if ($protocol == ::IS_ASCII) { + is($resp,"$expected_value\r\n","perform $acmd math operation on key $key with ASCII protocol"); + } elsif ($protocol == ::IS_BINARY) { + my ($resp_magic, $resp_op_code, $resp_key_len, $resp_extra_len, $resp_data_type, $resp_status, $resp_total_len, + $resp_opaque, $resp_ident_hi, $resp_ident_lo) = unpack(::RES_PKT_FMT, $resp); + is($resp_status,"0","perform $acmd math operation on key $key with binary protocol"); + my ($resp_hi,$resp_lo) = unpack("NN",substr($resp,::MIN_RECV_BYTES + $resp_extra_len + $resp_key_len, + $resp_total_len - $resp_extra_len - $resp_key_len)); + is(($resp_hi * 2 ** 32) + $resp_lo,$expected_value,"validate result of binary protocol math operation $acmd . Expected value $expected_value") + } +} + +sub construct_udp_message { + my $datagrams = shift; + my $num_datagram = keys (%$datagrams); + my $msg = ""; + my $cur_dg =""; + my $cur_udp_header =""; + for (my $cur_dg_index = 0; $cur_dg_index < $num_datagram; $cur_dg_index++) { + $cur_dg = %$datagrams->{$cur_dg_index}; + isnt($cur_dg,"","missing datagram for segment $cur_dg_index"); + $cur_udp_header=substr($cur_dg, 0, 8); + $msg .= substr($cur_dg,8); + } + return $msg; } sub hexify { @@ -94,6 +207,8 @@ sub hexify { } # returns undef on select timeout, or hashref of "seqnum" -> payload (including headers) +# verifies that resp_id is equal to id sent in request +# ensures consistency in num packets that make up response sub send_udp_request { my ($sock, $reqid, $req) = @_; @@ -131,6 +246,7 @@ sub send_udp_request { return $ret; } + __END__ $sender = recv($usock, $ans, 1050, 0); |