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} elsif ($mode eq 'dump') {
30    ;
31} else {
32    undef $mode;
33}
34
35undef $mode if @ARGV;
36
37die
38"Usage: memcached-tool <host[:port]> [mode]\n
39       memcached-tool 10.0.0.5:11211 display    # shows slabs
40       memcached-tool 10.0.0.5:11211            # same.  (default is display)
41       memcached-tool 10.0.0.5:11211 move 7 9   # takes 1MB slab from class #7
42                                                # to class #9.
43
44You can only move slabs around once memory is totally allocated, and only
45once the target class is full.  (So you can't move from #6 to #9 and #7
46to #9 at the same itme, since you'd have to wait for #9 to fill from
47the first reassigned page)
48" unless $host && $mode;
49
50$host .= ":11211" unless $host =~ /:\d+/;
51
52my $sock = IO::Socket::INET->new(PeerAddr => $host,
53				 Proto    => 'tcp');
54die "Couldn't connect to $host\n" unless $sock;
55
56
57if ($mode eq "move") {
58    my $tries = 0;
59    while (1) {
60	print $sock "slabs reassign $from $to\r\n";
61	my $res = <$sock>;
62	$res =~ s/\s+//;
63	if ($res eq "DONE") {
64	    print "Success.\n";
65	    exit 0;
66	} elsif ($res eq "CANT") {
67	    print "Error: can't move from $from to $to.  Destination not yet full?  See usage docs.\n";
68	    exit;
69	} elsif ($res eq "BUSY") {
70	    if (++$tries == 3) {
71		print "Failed to move after 3 tries.  Try again later.\n";
72		exit;
73	    }
74
75	    print "Page busy, retrying...\n";
76	    sleep 1;
77	}
78    }
79
80    exit;
81}
82
83if ($mode eq 'dump') {
84    my %items;
85    my $totalitems;
86
87    print $sock "stats items\r\n";
88
89    while (<$sock>) {
90        last if /^END/;
91        if (/^STAT items:(\d*):number (\d*)/) {
92            $items{$1} = $2;
93            $totalitems += $2;
94        }
95    }
96    print STDERR "Dumping memcache contents\n";
97    print STDERR "  Number of buckets: " . scalar(keys(%items)) . "\n";
98    print STDERR "  Number of items  : $totalitems\n";
99
100    foreach my $bucket (sort(keys(%items))) {
101        print STDERR "Dumping bucket $bucket - " . $items{$bucket} . " total items\n";
102        print $sock "stats cachedump $bucket $items{$bucket} 1\r\n";
103        my %keyexp;
104        while (<$sock>) {
105            last if /^END/;
106            # return format looks like this
107            # ITEM foo [6 b; 1176415152 s]
108            if (/^ITEM (\w+) \[.* (\d+) s\]/) {
109                $keyexp{$1} = $2;
110            }
111        }
112
113        foreach my $k (keys(%keyexp)) {
114            my $val;
115            print $sock "get $k\r\n";
116            my $response = <$sock>;
117            $response =~ /VALUE (\w+) (\d+) (\d+)/;
118            my $flags = $2;
119            my $len = $3;
120            read $sock, $val , $len;
121            # get the END
122            $_ = <$sock>;
123            $_ = <$sock>;
124            print "add $k $flags $keyexp{$k} $len\r\n$val\r\n";
125        }
126    }
127    exit;
128}
129
130# display mode:
131
132my %items;  # class -> { number, age, chunk_size, chunks_per_page,
133            #            total_pages, total_chunks, used_chunks,
134            #            free_chunks, free_chunks_end }
135
136print $sock "stats items\r\n";
137while (<$sock>) {
138    last if /^END/;
139    if (/^STAT items:(\d+):(\w+) (\d+)/) {
140	$items{$1}{$2} = $3;
141    }
142}
143
144print $sock "stats slabs\r\n";
145while (<$sock>) {
146    last if /^END/;
147    if (/^STAT (\d+):(\w+) (\d+)/) {
148	$items{$1}{$2} = $3;
149    }
150}
151
152print "  # Item_Size  Max_age  1MB_pages Full?\n";
153foreach my $n (6..17) {
154    my $it = $items{$n};
155    my $size = $it->{chunk_size} < 1024 ? "$it->{chunk_size} B" :
156	sprintf("%d kB", $it->{chunk_size} / 1024);
157    my $full = $it->{free_chunks_end} == 0 ? "yes" : " no";
158    printf "%3d    %6s%7d s %7d     $full\n", $n, $size, $it->{age}, $it->{total_pages};
159}
160
161