1#!/usr/bin/perl
2#
3# memcached-tool:
4#   stats/management tool for memcached.
5#
6# Author:
7#   Brad Fitzpatrick <[email protected]>
8#
9# Contributor:
10#   Andrey Niakhaichyk <[email protected]>
11#
12# License:
13#   public domain.  I give up all rights to this
14#   tool.  modify and copy at will.
15#
16
17use strict;
18use IO::Socket::INET;
19use URI::Escape;
20
21my $addr = shift;
22my $mode = shift || "display";
23my ($from, $to);
24my $limit;
25my $unescape = 0;
26
27if ($mode eq "display") {
28    undef $mode if @ARGV;
29} elsif ($mode eq "move") {
30    $from = shift;
31    $to = shift;
32    undef $mode if $from < 6 || $from > 17;
33    undef $mode if $to   < 6 || $to   > 17;
34    print STDERR "ERROR: parameters out of range\n\n" unless $mode;
35} elsif ($mode eq 'dump') {
36    if (@ARGV) {
37        $limit = shift;
38        undef $mode if $limit < 1;
39        print STDERR "ERROR: invalid limit (should be a positive number)\n\n" unless $mode;
40    }
41} elsif ($mode eq 'keys') {
42    if (@ARGV) {
43        my $arg = shift;
44        if ($arg eq '-u') {
45            $unescape = 1;
46        } else {
47            $limit = $arg;
48        }
49        if (@ARGV) {
50            $limit = shift;
51        }
52        if ($limit) {
53            undef $mode if $limit < 1;
54            print STDERR "ERROR: invalid limit (should be a positive number)\n\n" unless $mode;
55        }
56    }
57} elsif ($mode eq 'stats') {
58    ;
59} elsif ($mode eq 'settings') {
60    ;
61} elsif ($mode eq 'sizes') {
62    ;
63} else {
64    undef $mode;
65}
66
67undef $mode if @ARGV;
68
69die
70    "Usage: memcached-tool <host[:port] | /path/to/socket> [mode]\n
71       memcached-tool 10.0.0.5:11211 display           # shows slabs
72       memcached-tool 10.0.0.5:11211                   # same.  (default is display)
73       memcached-tool 10.0.0.5:11211 stats             # shows general stats
74       memcached-tool 10.0.0.5:11211 settings          # shows settings stats
75       memcached-tool 10.0.0.5:11211 sizes             # shows sizes stats
76       memcached-tool 10.0.0.5:11211 dump [limit]      # dumps keys and values
77       memcached-tool 10.0.0.5:11211 keys [-u] [limit] # dumps keys (-u: unescape special characters)
78
79WARNING! sizes is a development command.
80As of 1.4 it is still the only command which will lock your memcached instance for some time.
81If you have many millions of stored items, it can become unresponsive for several minutes.
82Run this at your own risk. It is roadmapped to either make this feature optional
83or at least speed it up.
84" unless $addr && $mode;
85
86
87sub server_connect {
88    my $sock;
89    if ($addr =~ m:/:) {
90        $sock = IO::Socket::UNIX->new(
91            Peer => $addr,
92        );
93    }
94    else {
95        $addr .= ':11211' unless $addr =~ /:\d+$/;
96
97        $sock = IO::Socket::INET->new(
98            PeerAddr => $addr,
99            Proto    => 'tcp',
100        );
101    }
102    die "Couldn't connect to $addr\n" unless $sock;
103    return $sock;
104}
105
106my $sock = server_connect();
107
108if ($mode eq 'dump') {
109    print STDERR "Dumping memcache contents";
110    print STDERR " (limiting to $limit keys)" unless !$limit;
111    print STDERR "\n";
112    print $sock "lru_crawler metadump all\r\n";
113    my %keyexp;
114    my $keycount = 0;
115    while (<$sock>) {
116        last if /^END/ or ($limit and $keycount == $limit);
117        # return format looks like this
118        # key=foo exp=2147483647 la=1521046038 cas=717111 fetch=no cls=13 size=1232
119        if (/^key=(\S+) exp=(-?\d+) .*/) {
120            my ($k, $exp) = ($1, $2);
121            $k =~ s/%(.{2})/chr hex $1/eg;
122
123            if ($exp == -1) {
124                $keyexp{$k} = 0;
125            } else {
126                $keyexp{$k} = $exp;
127            }
128        }
129        $keycount++;
130    }
131
132    if ($limit) {
133        # Need to reopen the connection here to stop the metadump in
134        # case the key limit was reached.
135        #
136        # XXX: Once a limit on # of keys returned is introduced in
137        # `lru_crawler metadump`, this should be removed and the proper
138        # parameter passed in the query above.
139        close($sock);
140        $sock = server_connect();
141    }
142
143    foreach my $k (keys(%keyexp)) {
144        print $sock "get $k\r\n";
145        my $response = <$sock>;
146        if ($response =~ /VALUE (\S+) (\d+) (\d+)/) {
147            my $flags = $2;
148            my $len = $3;
149            my $val;
150            read $sock, $val, $len;
151            print "add $k $flags $keyexp{$k} $len\r\n$val\r\n";
152            # get the END
153            $_ = <$sock>;
154            $_ = <$sock>;
155        }
156    }
157    exit;
158}
159
160if ($mode eq 'keys') {
161    print STDERR "Dumping memcache keys";
162    print STDERR " (limiting to $limit keys)" unless !$limit;
163    print STDERR "\n";
164    print $sock "lru_crawler metadump all\r\n";
165    my %keyexp;
166    my $keycount = 0;
167    while (<$sock>) {
168        last if /^END/ or ($limit and $keycount == $limit);
169        # return format looks like this
170        # key=foo exp=2147483647 la=1521046038 cas=717111 fetch=no cls=13 size=1232
171        if (/^key=(\S+) exp=(-?\d+) .*/) {
172            print ($unescape ? uri_unescape($_) : $_)
173        }
174        $keycount++;
175    }
176    exit;
177}
178
179if ($mode eq 'stats') {
180    my %items;
181
182    print $sock "stats\r\n";
183
184    while (<$sock>) {
185        last if /^END/;
186        chomp;
187        if (/^STAT\s+(\S*)\s+(.*)/) {
188            $items{$1} = $2;
189        }
190    }
191    printf ("#%-22s %5s %13s\n", $addr, "Field", "Value");
192    foreach my $name (sort(keys(%items))) {
193        printf ("%29s %14s\n", $name, $items{$name});
194
195    }
196    exit;
197}
198
199if ($mode eq 'settings') {
200    my %items;
201
202    print $sock "stats settings\r\n";
203
204    while (<$sock>) {
205        last if /^END/;
206        chomp;
207        if (/^STAT\s+(\S*)\s+(.*)/) {
208            $items{$1} = $2;
209        }
210    }
211    printf ("#%-17s %5s %11s\n", $addr, "Field", "Value");
212    foreach my $name (sort(keys(%items))) {
213        printf ("%24s %12s\n", $name, $items{$name});
214    }
215    exit;
216}
217
218
219if ($mode eq 'sizes') {
220    my %items;
221
222    print $sock "stats sizes\r\n";
223
224    while (<$sock>) {
225        last if /^END/;
226        chomp;
227        if (/^STAT\s+(\S*)\s+(.*)/) {
228            $items{$1} = $2;
229        }
230    }
231    printf ("#%-17s %5s %11s\n", $addr, "Size", "Count");
232    foreach my $name (sort(keys(%items))) {
233        printf ("%24s %12s\n", $name, $items{$name});
234    }
235    exit;
236}
237
238# display mode:
239
240my %items;  # class -> { number, age, chunk_size, chunks_per_page,
241#            total_pages, total_chunks, used_chunks,
242#            free_chunks, free_chunks_end }
243
244print $sock "stats items\r\n";
245my $max = 0;
246while (<$sock>) {
247    last if /^END/;
248    if (/^STAT items:(\d+):(\w+) (\d+)/) {
249        $items{$1}{$2} = $3;
250    }
251}
252
253print $sock "stats slabs\r\n";
254while (<$sock>) {
255    last if /^END/;
256    if (/^STAT (\d+):(\w+) (\d+)/) {
257        $items{$1}{$2} = $3;
258        $max = $1;
259    }
260}
261
262print "  #  Item_Size  Max_age   Pages   Count   Full?  Evicted Evict_Time OOM\n";
263foreach my $n (1..$max) {
264    my $it = $items{$n};
265    next if (0 == $it->{total_pages});
266    my $size = $it->{chunk_size} < 1024 ?
267        "$it->{chunk_size}B" :
268        sprintf("%.1fK", $it->{chunk_size} / 1024.0);
269    my $full = $it->{used_chunks} == $it->{total_chunks} ? "yes" : " no";
270    printf("%3d %8s %9ds %7d %7d %7s %8d %8d %4d\n",
271           $n, $size, $it->{age}, $it->{total_pages},
272           $it->{number}, $full, $it->{evicted},
273           $it->{evicted_time}, $it->{outofmemory});
274}
275
276