1#!/usr/bin/env perl
2# Test the "Error on get" path for extstore.
3# the entire error handling code for process_get_command() never worked, and
4# would infinite loop. get_extstore() can hit it sometimes.
5
6use strict;
7use warnings;
8
9use Test::More;
10use FindBin qw($Bin);
11use lib "$Bin/lib";
12use MemcachedTest;
13
14my $ext_path;
15
16if (!supports_extstore()) {
17    plan skip_all => 'extstore not enabled';
18    exit 0;
19}
20
21$ext_path = "/tmp/extstore.$$";
22
23my $server = new_memcached("-m 64 -I 4m -U 0 -o ext_page_size=8,ext_wbuf_size=8,ext_threads=1,ext_io_depth=2,ext_item_size=512,ext_item_age=2,ext_recache_rate=10000,ext_max_frag=0.9,ext_path=$ext_path:64m,slab_automove=0,ext_compact_under=1,ext_max_sleep=100000");
24my $sock = $server->sock;
25
26# Wait until all items have flushed
27sub wait_for_ext {
28    my $sum = 1;
29    while ($sum != 0) {
30        my $s = mem_stats($sock, "items");
31        $sum = 0;
32        for my $key (keys %$s) {
33            if ($key =~ m/items:(\d+):number/) {
34                # Ignore classes which can contain extstore items
35                next if $1 < 3;
36                $sum += $s->{$key};
37            }
38        }
39        sleep 1 if $sum != 0;
40    }
41}
42
43# We're testing to ensure item chaining doesn't corrupt or poorly overlap
44# data, so create a non-repeating pattern.
45my @parts = ();
46for (1 .. 8000) {
47    push(@parts, $_);
48}
49my $pattern = join(':', @parts);
50my $plen = length($pattern);
51
52# Set some large items and let them flush to extstore.
53for (1..5) {
54    my $size = 3000 * 1024;
55    my $data = "x" x $size;
56    print $sock "set foo$_ 0 0 $size\r\n$data\r\n";
57    my $res = <$sock>;
58    is($res, "STORED\r\n", "stored some big items");
59}
60
61wait_for_ext();
62
63{
64    my $long_key = "f" x 512;
65    print $sock "get foo1 foo2 foo3 $long_key\r\n";
66    ok(scalar <$sock> =~ /CLIENT_ERROR bad command line format/, 'long key fails');
67    my $stats = mem_stats($sock);
68    cmp_ok($stats->{get_aborted_extstore}, '>', 1, 'some extstore queries aborted');
69}
70
71# Infinite loop: if we aborted some extstore requests, the next request would hang
72# the daemon.
73{
74    my $size = 3000 * 1024;
75    my $data = "x" x $size;
76    mem_get_is($sock, "foo1", $data);
77}
78
79# Disable automatic page balancing, then move enough pages that the large
80# items can no longer be loaded from extstore
81{
82    print $sock "slabs automove 0\r\n";
83    my $res = <$sock>;
84    my $source = 0;
85    while (1) {
86        print $sock "slabs reassign $source 1\r\n";
87        $res = <$sock>;
88        if ($res =~ m/NOSPARE/) {
89            $source = -1;
90            my $stats = mem_stats($sock, 'slabs');
91            for my $key (grep { /total_pages/ } keys %$stats) {
92                if ($key =~ m/(\d+):total_pages/) {
93                    next if $1 < 3;
94                    $source = $1 if $stats->{$key} > 1;
95                }
96            }
97            last if $source == -1;
98        }
99        select undef, undef, undef, 0.10;
100    }
101}
102
103# fetching the large keys should now fail.
104{
105    print $sock "get foo1\r\n";
106    my $res = <$sock>;
107    $res =~ s/[\r\n]//g;
108    is($res, 'SERVER_ERROR out of memory writing get response', 'can no longer read back item');
109    my $stats = mem_stats($sock);
110    is($stats->{get_oom_extstore}, 1, 'check extstore oom counter');
111}
112
113# Leaving this for future generations.
114# The process_get_command() function had several memory leaks.
115my $LEAK_TEST = 0;
116if ($LEAK_TEST) {
117    my $tries = 0;
118    while ($tries) {
119        print $sock "slabs reassign 1 39\r\n";
120        my $res = <$sock>;
121        if ($res =~ m/BUSY/) {
122            select undef, undef, undef, 0.10;
123        } else {
124            $tries--;
125        }
126    }
127    my $long_key = "f" x 512;
128    while (1) {
129        print $sock "get foo1 foo2 foo3 $long_key\r\n";
130        my $res = <$sock>;
131    }
132}
133
134done_testing();
135
136END {
137    unlink $ext_path if $ext_path;
138}
139