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