Mercurial > hg > memcached
diff t/udp.t @ 0:30782bb1fc04 MEMCACHED_1_2_3
memcached-1.2.3
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Sun, 23 Sep 2007 03:58:34 +0400 |
parents | |
children |
line wrap: on
line diff
new file mode 100755 --- /dev/null +++ b/t/udp.t @@ -0,0 +1,131 @@ +#!/usr/bin/perl + +use strict; +use Test::More tests => 33; +use FindBin qw($Bin); +use lib "$Bin/lib"; +use MemcachedTest; + +my $server = new_memcached(); +my $sock = $server->sock; + +# set foo (and should get it) +print $sock "set foo 0 0 6\r\nfooval\r\n"; +is(scalar <$sock>, "STORED\r\n", "stored foo"); +mem_get_is($sock, "foo", "fooval"); + +my $usock = $server->new_udp_sock + or die "Can't bind : $@\n"; + +# test all the steps, one by one: +test_single($usock); + +# testing sequence numbers +for my $offt (1, 1, 2) { + my $seq = 160 + $offt; + my $res = send_udp_request($usock, $seq, "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"); +} + +# 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 test_single { + my $usock = shift; + my $req = pack("nnnn", 45, 0, 1, 0); # request id (opaque), seq num, #packets, reserved (must be 0) + $req .= "get foo\r\n"; + 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); + is(hexify(substr($res, 0, 8)), hexify($id) . '0000' . '0001' . '0000', "header is correct"); + is(length $res, 36, ''); + is(substr($res, 8), "VALUE foo 0 6\r\nfooval\r\nEND\r\n", "payload is as expected"); +} + +sub hexify { + my $val = shift; + $val =~ s/(.)/sprintf("%02x", ord($1))/egs; + return $val; +} + +# returns undef on select timeout, or hashref of "seqnum" -> payload (including headers) +sub send_udp_request { + my ($sock, $reqid, $req) = @_; + + my $pkt = pack("nnnn", $reqid, 0, 1, 0); # request id (opaque), seq num, #packets, reserved (must be 0) + $pkt .= $req; + my $fail = sub { + my $msg = shift; + warn " FAILING send_udp because: $msg\n"; + return undef; + }; + return $fail->("send") unless send($sock, $pkt, 0); + + my $ret = {}; + + my $got = 0; # packets got + my $numpkts = undef; + + while (!defined($numpkts) || $got < $numpkts) { + my $rin = ''; + vec($rin, fileno($sock), 1) = 1; + my $rout; + return $fail->("timeout after $got packets") unless + select($rout = $rin, undef, undef, 1.5); + + my $res; + my $sender = $sock->recv($res, 1500, 0); + my ($resid, $seq, $this_numpkts, $resv) = unpack("nnnn", substr($res, 0, 8)); + die "Response ID of $resid doesn't match request if of $reqid" unless $resid == $reqid; + die "Reserved area not zero" unless $resv == 0; + die "num packets changed midstream!" if defined $numpkts && $this_numpkts != $numpkts; + $numpkts = $this_numpkts; + $ret->{$seq} = $res; + $got++; + } + return $ret; +} + +__END__ +$sender = recv($usock, $ans, 1050, 0); + +__END__ +$usock->send + + + ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!"; +($port, $hisiaddr) = sockaddr_in($hispaddr); +$host = gethostbyaddr($hisiaddr, AF_INET); +$histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;