1#!/usr/bin/env perl23use strict;4use warnings;5use Test::More;6use FindBin qw($Bin);7use lib "$Bin/lib";8use MemcachedTest;9use Data::Dumper qw/Dumper/;1011# Enable manual slab reassign, cap at 6 slabs12# Items above 16kb are chunked13# disable LRU crawler so we can be sure to move expired items14my $server = new_memcached('-o no_lru_crawler,slab_reassign,slab_automove=0,slab_chunk_max=16 -m 12');15my $sock = $server->sock;1617{18    subtest 'automove window' => \&test_automove_window;19    subtest 'syntax' => \&test_syntax;20    subtest 'fill and move pages' => \&test_fill;21    subtest 'chunked items' => \&test_chunked;22    subtest 'test locked' => \&test_locked;23    subtest 'expired items' => \&test_expired;24    # Need clean memory for the reflock tests25    print $sock "flush_all\r\n";26    is(scalar <$sock>, "OK\r\n", "flushed items before reflock test");27    wait_for_stat("curr_items", 0);28    subtest 'reflocked items' => \&test_reflocked;29    # test reflocked chunked items (ensure busy_deletes)30}3132# If I still remembered perl I'd do that dynamic comparator thing33sub wait_for_stat {34    my $stat = shift;35    my $amt = shift; # 0 is valid3637    my $stats_a;38    my $to_sleep = 0.01;39    for my $cnt (1 .. 500) {40        $stats_a = mem_stats($sock);41        last if ($stats_a->{$stat} == $amt);42        sleep $to_sleep;43        $to_sleep += $cnt / 100;44        $to_sleep = 0.2 if $to_sleep > 0.2;45        #print STDERR "SLEEPING: $to_sleep STAT: ", $stats_a->{$stat}, " LAST BUSY: ", $stats_a->{slab_reassign_last_busy_status}, "\n";46    }47    return $stats_a;48}4950sub wait_for_stat_incr {51    my $stats = shift;52    my $stat = shift;53    my $amt = shift; # 0 is valid5455    my $stats_a;56    my $to_sleep = 0.01;57    for my $cnt (1 .. 500) {58        $stats_a = mem_stats($sock);59        last if ($stats_a->{$stat} > $stats->{$stat}+$amt);60        sleep $to_sleep;61        $to_sleep += $cnt / 100;62        $to_sleep = 0.2 if $to_sleep > 0.2;63        #print STDERR "SLEEPING: $to_sleep STAT: ", $stats_a->{$stat}, " LAST BUSY: ", $stats_a->{slab_reassign_last_busy_status}, "\n";64        #print STDERR Dumper(map { $_ => $stats_a->{$_} } sort keys %$stats_a), "\n";65    }66    return $stats_a;67}6869sub find_largest_clsid {70    my $s = mem_stats($sock, 'slabs');71    my $sid = 0;72    my $total_pages = 0;73    # Find the highest ID to source from.74    for my $k (keys %$s) {75        next unless $k =~ m/^(\d+):total_pages/;76        if ($s->{$k} > $total_pages) {77            $sid = $1;78            $total_pages = $s->{$k};79        }80    }81    return $sid;82}8384# TODO: mc metric for automove runs so we can loop for that instead of blind85# sleep.86sub test_automove_window {87    print $sock "slabs automove 1\r\n";88    is(scalar <$sock>, "OK\r\n", "automover on");89    print $sock "slabs automove window 0\r\n";90    is(scalar <$sock>, "CLIENT_ERROR automove window too low or too high\r\n", "invalid window");9192    sleep 4;93    print $sock "version\r\n";94    like(scalar <$sock>, qr/VERSION/, "daemon still alive");9596    print $sock "slabs automove window 67108864\r\n";97    is(scalar <$sock>, "CLIENT_ERROR automove window too low or too high\r\n", "invalid window");98    sleep 4;99100    print $sock "version\r\n";101    like(scalar <$sock>, qr/VERSION/, "daemon still alive");102103    print $sock "slabs automove 0\r\n";104    is(scalar <$sock>, "OK\r\n", "automover off");105}106107# NOTE: Can't validate reflocked items in an integration test since we leak108# the memory and cannot de-ref an unlinked item.109# TODO: test reflocked chunked items as well110sub test_reflocked {111    my $size = 9000;112    my $bigdata = 'x' x $size;113    my $stats;114    my $count = 1;115    $stats = mem_stats($sock);116    for my $c (1 .. 10000) {117        my $exp = $c % 2 == 1 ? "T0" : "T240";118        print $sock "ms rfoo$c $size $exp\r\n", $bigdata, "\r\n";119        is(scalar <$sock>, "HD\r\n", "stored big key: $c [$exp]");120        my $s_after = mem_stats($sock);121        last if ($s_after->{evictions} > $stats->{evictions});122        $count++;123    }124125    # delete one page worth so we have memory to work with to move pages126    # non-destructively.127    my $todelete = int((1024 * 1024) / $size)+1;128    for (0 .. $todelete) {129        # delete from the newest since we move the oldest page.130        # encourages chunk rescues.131        my $i = $count - $_;132        print $sock "delete rfoo$i\r\n";133        is(scalar <$sock>, "DELETED\r\n", "deleted rfoo$i");134    }135136    # attempt to reflock a bunch so we hit both expired and active rescue137    for (2 .. $count - ($todelete+1)) {138        print $sock "debugitem ref rfoo$_\r\n";139        is(scalar <$sock>, "OK\r\n", "reflocked rfoo$_");140    }141142    mem_move_time($sock, 480);143144    my $sid = find_largest_clsid($sock);145146    $stats = mem_stats($sock);147    print $sock "slabs reassign $sid 0\r\n";148    is(scalar <$sock>, "OK\r\n", "reassign started");149    my $stats_a = wait_for_stat_incr($stats, "slab_reassign_busy_items", 500);150151    cmp_ok($stats_a->{slab_reassign_busy_items}, '>', $stats->{slab_reassign_busy_items}+500, "page mover busy");152    is($stats_a->{slab_reassign_last_busy_status}, "busy_floating", "recorded busy status correctly");153    # TODO: rescue counter is only updated after a page completes moving.154    #cmp_ok($stats_a->{slab_reassign_rescues}, '>', $stats->{slab_reassign_rescues}+50, "page mover rescued data");155    cmp_ok($stats_a->{slabs_moved}, '==', $stats->{slabs_moved}, "no page moved");156157}158159# TODO: reflock some items so we hit the "expired but reflocked" path160# TODO: use debugtime to move clock and avoid having to sleep.161# - also so we can reflock some items without having a race condition by162# setting the expire time out a minute/hour.163sub test_expired {164    my $size = 9000;165    my $bigdata = 'x' x $size;166    my $stats;167    my $count = 1;168    $stats = mem_stats($sock);169    for my $c (1 .. 10000) {170        my $exp = $c % 2 == 1 ? "T0" : "T30";171        print $sock "ms efoo$c $size $exp\r\n", $bigdata, "\r\n";172        is(scalar <$sock>, "HD\r\n", "stored big key");173        my $s_after = mem_stats($sock);174        last if ($s_after->{evictions} > $stats->{evictions});175        $count++;176    }177178    mem_move_time($sock, 60);179180    my $sid = find_largest_clsid($sock);181182    $stats = mem_stats($sock);183    empty_class(mem_stats($sock), $sid);184185    my $stats_a = mem_stats($sock);186    # TODO: there's no counter for "expired items reaped"187    # if we get here we at least didn't crash though.188}189190# use debugitem command to deliberately hang the page mover191# NOTE: test is slightly flaky since we have to pick an item to lock that's in192# the page we want to move. this won't normally change but could if you193# re-order the tests.194sub test_locked {195    my $size = 9000;196    my $bigdata = 'x' x $size;197    my $stats;198    my $count = 1;199    $stats = mem_stats($sock);200    for (1 .. 10000) {201        print $sock "set lfoo$_ 0 0 $size\r\n", $bigdata, "\r\n";202        is(scalar <$sock>, "STORED\r\n", "stored big key");203        my $s_after = mem_stats($sock);204        last if ($s_after->{evictions} > $stats->{evictions});205        $count++;206    }207208    my $s = mem_stats($sock, 'slabs');209    my $sid = 0;210    my $total_pages = 0;211    # Find the highest ID to source from.212    for my $k (keys %$s) {213        next unless $k =~ m/^(\d+):total_pages/;214        if ($s->{$k} > $total_pages) {215            $sid = $1;216            $total_pages = $s->{$k};217        }218    }219220    print $sock "debugitem lock lfoo50\r\n";221    is(scalar <$sock>, "OK\r\n", "locked item");222223    $stats = mem_stats($sock);224    print $sock "slabs reassign $sid 0\r\n";225    is(scalar <$sock>, "OK\r\n", "reassign started");226    my $stats_a = wait_for_stat_incr($stats, "slab_reassign_busy_items", 500);227228    cmp_ok($stats_a->{slab_reassign_busy_items}, '>', $stats->{slab_reassign_busy_items}+500, "page mover busy");229    cmp_ok($stats_a->{slabs_moved}, '==', $stats->{slabs_moved}, "no page moved");230    is($stats_a->{slab_reassign_running}, 1, "reassign stuck running");231232    print $sock "debugitem unlock lfoo50\r\n";233    is(scalar <$sock>, "OK\r\n", "unlocked item");234235    $stats_a = wait_for_stat_incr($stats, "slabs_moved", 0);236    cmp_ok($stats_a->{slabs_moved}, '>', $stats->{slabs_moved}, "page moved");237    is($stats_a->{slab_reassign_running}, 0, "reassign stopped running");238239    empty_class(mem_stats($sock), $sid);240    $stats = mem_stats($sock);241    cmp_ok($stats->{slab_global_page_pool}, '>', 5, "pages back in global pool");242}243244sub test_chunked {245    # Patterned value so we can tell if chunks get corrupted246    my $value;247    my $size = 30000;248    {249        my @chars = ("C".."Z");250        for (1 .. $size) {251            $value .= $chars[rand @chars];252        }253    }254255    my $stats = mem_stats($sock);256257    my $count = 1;258    while (1) {259        print $sock "set cfoo$count 0 0 $size\r\n$value\r\n";260        is(scalar <$sock>, "STORED\r\n", "stored chunked item");261        my $s_after = mem_stats($sock);262        last if ($s_after->{evictions} > $stats->{evictions});263        $count++;264    }265266    # hold stats to compare evictions later267    $stats = mem_stats($sock);268    my $s = mem_stats($sock, 'slabs');269    my $sid = 0;270    # Find the highest ID to source from.271    for my $k (keys %$s) {272        next unless $k =~ m/^(\d+):/;273        $sid = $1 if $1 > $sid;274    }275276    cmp_ok($s->{"$sid:total_pages"}, '>', 5, "most pages in high class");277    cmp_ok($s->{"$sid:used_chunks"}, '>', 500, "many chunks in use");278279    # move one page while full to force evictions280    print $sock "slabs reassign $sid 0\r\n";281    my $stats_a = wait_for_stat_incr($stats, "slabs_moved", 0);282    cmp_ok($stats_a->{evictions}, '>', $stats->{evictions}, "page move caused some evictions: " . ($stats_a->{evictions} - $stats->{evictions}));283284    # delete at least a page worth so we can test rescuing data285    $s = mem_stats($sock, 'slabs');286    cmp_ok($s->{"$sid:free_chunks"}, '<', 5, "few free chunks available to start");287    cmp_ok($stats->{slab_reassign_chunk_rescues}, '<', 1, 'few chunk rescues happened');288    my $todelete = int((1024 * 1024) / $size)+1;289    for (0 .. $todelete) {290        # delete from the newest since we move the oldest page.291        # encourages chunk rescues.292        my $i = $count - $_;293        print $sock "delete cfoo$i\r\n";294        is(scalar <$sock>, "DELETED\r\n", "deleted cfoo$i");295    }296297    $stats = mem_stats($sock);298    print $sock "slabs reassign $sid 0\r\n";299    $stats_a = wait_for_stat_incr($stats, "slabs_moved", 0);300301    cmp_ok($stats_a->{slab_reassign_chunk_rescues}, '>', 50, 'more chunk rescues happened');302    cmp_ok($stats_a->{slab_reassign_busy_deletes}, '==', $stats->{slab_reassign_busy_deletes}, 'no busy deletes');303304    # TODO: fetch all items back and check value305306    empty_class(mem_stats($sock), $sid);307    $stats = mem_stats($sock);308    cmp_ok($stats->{slab_global_page_pool}, '>', 6, "pages back in global pool");309}310311# Fill test, no chunked items.312sub test_fill {313    my $size = 15000;314    my $bigdata = 'x' x $size;315    my $stats;316    for (1 .. 10000) {317        print $sock "set bfoo$_ 0 0 $size\r\n", $bigdata, "\r\n";318        is(scalar <$sock>, "STORED\r\n", "stored big key");319        $stats = mem_stats($sock);320        last if ($stats->{evictions} != 0);321    }322323    # fill a smaller slab too324    $size = 2000;325    my $smalldata = 'y' x $size;326    for (1 .. 10000) {327        print $sock "set sfoo$_ 0 0 $size\r\n", $smalldata, "\r\n";328        is(scalar <$sock>, "STORED\r\n", "stored small key");329        my $nstats = mem_stats($sock);330        last if ($stats->{evictions} < $nstats->{evictions});331    }332333    my $slabs_before = mem_stats($sock, "slabs");334    #print STDERR Dumper($slabs_before), "\n\n";335    # Find our two slab classes.336    # low, high337    my @classes = sort map { /(\d+):/ } grep {/total_pages/} keys %$slabs_before;338    is(scalar @classes, 2, "right number of active classes");339    my $cls_small = $classes[0];340    my $cls_big = $classes[1];341342    $stats = mem_stats($sock);343    is($stats->{slabs_moved}, 0, "no slabs moved before testing");344    is($stats->{evictions}, 2, "only two total evictions before testing");345    print $sock "slabs reassign $cls_big $cls_small\r\n";346    is(scalar <$sock>, "OK\r\n", "slab rebalancer started: $cls_big -> $cls_small");347348    $stats = wait_for_stat_incr($stats, "slabs_moved", 0);349350    isnt($stats->{slabs_moved}, 0, "slab moved within time limit");351    my $slabs_after = mem_stats($sock, "slabs");352    isnt($slabs_before->{"$cls_small:total_pages"}, $slabs_after->{"$cls_small:total_pages"},353        "slab $cls_small pagecount changed");354    isnt($slabs_before->{"$cls_big:total_pages"}, $slabs_after->{"$cls_big:total_pages"},355        "slab $cls_big pagecount changed");356    cmp_ok($stats->{slab_reassign_busy_nomem}, '>', 1, 'busy looped due to lack of memory');357    cmp_ok($stats->{evictions}, '>', 10, 'ran normal evictions to move page');358    # inline reclaim and other stats might be nonzero: evicted, then tried to359    # allocate memory and it was from the page we intended to move.360    # not intentionally causing that here.361362    # Move another page363    my $stats_after;364    print $sock "slabs reassign $cls_big $cls_small\r\n";365    is(scalar <$sock>, "OK\r\n", "slab rebalancer started: $cls_big -> $cls_small");366367    $stats_after = wait_for_stat_incr($stats, "slabs_moved", 0);368369    cmp_ok($stats_after->{slabs_moved}, '>', $stats->{slabs_moved}, 'moved another page');370371    # move all possible pages back to global372    empty_class(mem_stats($sock), $cls_big);373    empty_class(mem_stats($sock), $cls_small);374    $stats = mem_stats($sock);375    is($stats->{slab_global_page_pool}, 10, "pages back in global pool");376377    #print STDERR Dumper(map { $_ => $stats->{$_} } sort keys %$stats), "\n";378}379380sub empty_class {381    my $stats = shift;382    my $cls = shift;383    my $stats_after = $stats;384    while (1) {385        $stats = $stats_after;386        print $sock "slabs reassign $cls 0\r\n";387        my $res = <$sock>;388        if ($res =~ m/NOSPARE/) {389            pass("NOSPARE received while moving pages");390            last;391        }392        is($res, "OK\r\n", "slab rebalancer started: $cls -> 0");393        $stats_after = wait_for_stat_incr($stats, "slabs_moved", 0);394    }395}396397sub test_syntax {398    my $stats = mem_stats($sock, ' settings');399    is($stats->{slab_reassign}, "yes");400401    print $sock "slabs reassign invalid1 invalid2\r\n";402    is(scalar <$sock>, "CLIENT_ERROR bad command line format\r\n");403404    print $sock "slabs reassign 5\r\n";405    is(scalar <$sock>, "ERROR\r\n");406407    print $sock "slabs reassign 1 1\r\n";408    is(scalar <$sock>, "SAME src and dst class are identical\r\n");409410    print $sock "slabs reassign -5 70\r\n";411    is(scalar <$sock>, "BADCLASS invalid src or dst class id\r\n");412413    print $sock "slabs reassign 2 1\r\n";414    is(scalar <$sock>, "NOSPARE source class has no spare pages\r\n");415}416417done_testing();