[memcached] bradfitz, r376: failing UDP test
commits at code.sixapart.com
commits at code.sixapart.com
Thu Sep 7 05:26:45 UTC 2006
failing UDP test
U trunk/server/t/lib/MemcachedTest.pm
U trunk/server/t/udp.t
Modified: trunk/server/t/lib/MemcachedTest.pm
===================================================================
--- trunk/server/t/lib/MemcachedTest.pm 2006-09-06 02:44:13 UTC (rev 375)
+++ trunk/server/t/lib/MemcachedTest.pm 2006-09-07 05:26:44 UTC (rev 376)
@@ -6,7 +6,7 @@
use Carp qw(croak);
use vars qw(@EXPORT);
- at EXPORT = qw(new_memcached sleep mem_get_is mem_stats);
+ at EXPORT = qw(new_memcached sleep mem_get_is mem_stats free_port);
sub sleep {
my $n = shift;
@@ -58,13 +58,14 @@
}
sub free_port {
+ my $type = shift || "tcp";
my $sock;
my $port;
while (!$sock) {
$port = int(rand(20000)) + 30000;
$sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
LocalPort => $port,
- Proto => 'tcp',
+ Proto => $type,
ReuseAddr => 1);
}
return $port;
@@ -73,7 +74,8 @@
sub new_memcached {
my $args = shift || "";
my $port = free_port();
- $args .= " -p $port";
+ my $udpport = free_port("udp");
+ $args .= " -p $port -U $udpport";
if ($< == 0) {
$args .= " -u root";
}
@@ -93,6 +95,7 @@
if ($conn) {
return Memcached::Handle->new(pid => $childpid,
conn => $conn,
+ udpport => $udpport,
port => $port);
}
select undef, undef, undef, 0.10;
@@ -114,6 +117,7 @@
}
sub port { $_[0]{port} }
+sub udpport { $_[0]{udpport} }
sub sock {
my $self = shift;
@@ -126,4 +130,15 @@
return IO::Socket::INET->new(PeerAddr => "127.0.0.1:$self->{port}");
}
+sub new_udp_sock {
+ my $self = shift;
+ return IO::Socket::INET->new(PeerAddr => '127.0.0.1',
+ PeerPort => $self->{udpport},
+ Proto => 'udp',
+ LocalAddr => '127.0.0.1',
+ LocalPort => MemcachedTest::free_port('udp'),
+ );
+
+}
+
1;
Modified: trunk/server/t/udp.t
===================================================================
--- trunk/server/t/udp.t 2006-09-06 02:44:13 UTC (rev 375)
+++ trunk/server/t/udp.t 2006-09-07 05:26:44 UTC (rev 376)
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use strict;
-use Test::More skip_all => "Tests not written."; # tests => 1
+use Test::More tests => 10;
use FindBin qw($Bin);
use lib "$Bin/lib";
use MemcachedTest;
@@ -9,3 +9,105 @@
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_single($usock);
+
+for my $pass (1, 2) {
+ my $res = send_udp_request($usock, 160 + $pass, "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");
+}
+
+# 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(substr($res->{0}, 8), "END\r\n");
+
+
+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 ;
More information about the memcached-commits
mailing list