1#!/usr/bin/perl
2#
3# memcached-tool:
4#   stats/management tool for memcached.
5#
6# Author:
7#   Brad Fitzpatrick <[email protected]>
8#
9# License:
10#   public domain.  I give up all rights to this
11#   tool.  modify and copy at will.
12#
13
14use strict;
15use IO::Socket::INET;
16
17my $host = shift;
18my $mode = shift || "display";
19my ($from, $to);
20
21if ($mode eq "display") {
22    undef $mode if @ARGV;
23} elsif ($mode eq "move") {
24    $from = shift;
25    $to = shift;
26    undef $mode if $from < 6 || $from > 17;
27    undef $mode if $to   < 6 || $to   > 17;
28    print STDERR "ERROR: parameters out of range\n\n" unless $mode;
29} else {
30    undef $mode;
31}
32
33undef $mode if @ARGV;
34
35die
36"Usage: memcached-tool <host[:port]> [mode]\n
37       memcached-tool 10.0.0.5:11211 display    # shows slabs
38       memcached-tool 10.0.0.5:11211            # same.  (default is display)
39       memcached-tool 10.0.0.5:11211 move 7 9   # takes 1MB slab from class #7
40                                                # to class #9.
41
42You can only move slabs around once memory is totally allocated, and only
43once the target class is full.  (So you can't move from #6 to #9 and #7
44to #9 at the same itme, since you'd have to wait for #9 to fill from
45the first reassigned page)
46" unless $host && $mode;
47
48$host .= ":11211" unless $host =~ /:\d+/;
49
50my $sock = IO::Socket::INET->new(PeerAddr => $host,
51				 Proto    => 'tcp');
52die "Couldn't connect to $host\n" unless $sock;
53
54
55if ($mode eq "move") {
56    my $tries = 0;
57    while (1) {
58	print $sock "slabs reassign $from $to\r\n";
59	my $res = <$sock>;
60	$res =~ s/\s+//;
61	if ($res eq "DONE") {
62	    print "Success.\n";
63	    exit 0;
64	} elsif ($res eq "CANT") {
65	    print "Error: can't move from $from to $to.  Destination not yet full?  See usage docs.\n";
66	    exit;
67	} elsif ($res eq "BUSY") {
68	    if (++$tries == 3) {
69		print "Failed to move after 3 tries.  Try again later.\n";
70		exit;
71	    }
72
73	    print "Page busy, retrying...\n";
74	    sleep 1;
75	}
76    }
77
78    exit;
79}
80
81# display mode:
82
83my %items;  # class -> { number, age, chunk_size, chunks_per_page,
84            #            total_pages, total_chunks, used_chunks,
85            #            free_chunks, free_chunks_end }
86
87print $sock "stats items\r\n";
88while (<$sock>) {
89    last if /^END/;
90    if (/^STAT items:(\d+):(\w+) (\d+)/) {
91	$items{$1}{$2} = $3;
92    }
93}
94
95print $sock "stats slabs\r\n";
96while (<$sock>) {
97    last if /^END/;
98    if (/^STAT (\d+):(\w+) (\d+)/) {
99	$items{$1}{$2} = $3;
100    }
101}
102
103print "  # Item_Size  Max_age  1MB_pages Full?\n";
104foreach my $n (6..17) {
105    my $it = $items{$n};
106    my $size = $it->{chunk_size} < 1024 ? "$it->{chunk_size} B" :
107	sprintf("%d kB", $it->{chunk_size} / 1024);
108    my $full = $it->{free_chunks_end} == 0 ? "yes" : " no";
109    printf "%3d    %6s%7d s %7d     $full\n", $n, $size, $it->{age}, $it->{total_pages};
110}
111
112