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;
19
20my $addr = shift;
21my $mode = shift || "display";
22my ($from, $to);
23
24if ($mode eq "display") {
25    undef $mode if @ARGV;
26} elsif ($mode eq "move") {
27    $from = shift;
28    $to = shift;
29    undef $mode if $from < 6 || $from > 17;
30    undef $mode if $to   < 6 || $to   > 17;
31    print STDERR "ERROR: parameters out of range\n\n" unless $mode;
32} elsif ($mode eq 'dump') {
33    ;
34} elsif ($mode eq 'stats') {
35    ;
36} elsif ($mode eq 'settings') {
37    ;
38} elsif ($mode eq 'sizes') {
39    ;
40} else {
41    undef $mode;
42}
43
44undef $mode if @ARGV;
45
46die
47    "Usage: memcached-tool <host[:port] | /path/to/socket> [mode]\n
48       memcached-tool 10.0.0.5:11211 display    # shows slabs
49       memcached-tool 10.0.0.5:11211            # same.  (default is display)
50       memcached-tool 10.0.0.5:11211 stats      # shows general stats
51       memcached-tool 10.0.0.5:11211 settings   # shows settings stats
52       memcached-tool 10.0.0.5:11211 sizes      # shows sizes stats
53       memcached-tool 10.0.0.5:11211 dump       # dumps keys and values
54
55WARNING! sizes is a development command.
56As of 1.4 it is still the only command which will lock your memcached instance for some time.
57If you have many millions of stored items, it can become unresponsive for several minutes.
58Run this at your own risk. It is roadmapped to either make this feature optional
59or at least speed it up.
60" unless $addr && $mode;
61
62
63my $sock;
64if ($addr =~ m:/:) {
65    $sock = IO::Socket::UNIX->new(
66        Peer => $addr,
67    );
68}
69else {
70    $addr .= ':11211' unless $addr =~ /:\d+$/;
71
72    $sock = IO::Socket::INET->new(
73        PeerAddr => $addr,
74        Proto    => 'tcp',
75    );
76}
77die "Couldn't connect to $addr\n" unless $sock;
78
79if ($mode eq 'dump') {
80    my %items;
81    my $totalitems;
82
83    print $sock "stats items\r\n";
84
85    while (<$sock>) {
86        last if /^END/;
87        if (/^STAT items:(\d*):number (\d*)/) {
88            $items{$1} = $2;
89            $totalitems += $2;
90        }
91    }
92    print STDERR "Dumping memcache contents\n";
93    print STDERR "  Number of buckets: " . scalar(keys(%items)) . "\n";
94    print STDERR "  Number of items  : $totalitems\n";
95
96    foreach my $bucket (sort(keys(%items))) {
97        print STDERR "Dumping bucket $bucket - " . $items{$bucket} . " total items\n";
98        print $sock "stats cachedump $bucket $items{$bucket}\r\n";
99        my %keyexp;
100        while (<$sock>) {
101            last if /^END/;
102            # return format looks like this
103            # ITEM foo [6 b; 1176415152 s]
104            if (/^ITEM (\S+) \[.* (\d+) s\]/) {
105                $keyexp{$1} = $2;
106            }
107        }
108
109        foreach my $k (keys(%keyexp)) {
110            print $sock "get $k\r\n";
111            my $response = <$sock>;
112            if ($response =~ /VALUE (\S+) (\d+) (\d+)/) {
113                my $flags = $2;
114                my $len = $3;
115                my $val;
116                read $sock, $val, $len;
117                print "add $k $flags $keyexp{$k} $len\r\n$val\r\n";
118                # get the END
119                $_ = <$sock>;
120                $_ = <$sock>;
121            }
122        }
123    }
124    exit;
125}
126
127if ($mode eq 'stats') {
128    my %items;
129
130    print $sock "stats\r\n";
131
132    while (<$sock>) {
133        last if /^END/;
134        chomp;
135        if (/^STAT\s+(\S*)\s+(.*)/) {
136            $items{$1} = $2;
137        }
138    }
139    printf ("#%-17s %5s %11s\n", $addr, "Field", "Value");
140    foreach my $name (sort(keys(%items))) {
141        printf ("%24s %12s\n", $name, $items{$name});
142
143    }
144    exit;
145}
146
147if ($mode eq 'settings') {
148    my %items;
149
150    print $sock "stats settings\r\n";
151
152    while (<$sock>) {
153        last if /^END/;
154        chomp;
155        if (/^STAT\s+(\S*)\s+(.*)/) {
156            $items{$1} = $2;
157        }
158    }
159    printf ("#%-17s %5s %11s\n", $addr, "Field", "Value");
160    foreach my $name (sort(keys(%items))) {
161        printf ("%24s %12s\n", $name, $items{$name});
162    }
163    exit;
164}
165
166
167if ($mode eq 'sizes') {
168    my %items;
169
170    print $sock "stats sizes\r\n";
171
172    while (<$sock>) {
173        last if /^END/;
174        chomp;
175        if (/^STAT\s+(\S*)\s+(.*)/) {
176            $items{$1} = $2;
177        }
178    }
179    printf ("#%-17s %5s %11s\n", $addr, "Size", "Count");
180    foreach my $name (sort(keys(%items))) {
181        printf ("%24s %12s\n", $name, $items{$name});
182    }
183    exit;
184}
185
186# display mode:
187
188my %items;  # class -> { number, age, chunk_size, chunks_per_page,
189#            total_pages, total_chunks, used_chunks,
190#            free_chunks, free_chunks_end }
191
192print $sock "stats items\r\n";
193my $max = 0;
194while (<$sock>) {
195    last if /^END/;
196    if (/^STAT items:(\d+):(\w+) (\d+)/) {
197        $items{$1}{$2} = $3;
198    }
199}
200
201print $sock "stats slabs\r\n";
202while (<$sock>) {
203    last if /^END/;
204    if (/^STAT (\d+):(\w+) (\d+)/) {
205        $items{$1}{$2} = $3;
206        $max = $1;
207    }
208}
209
210print "  #  Item_Size  Max_age   Pages   Count   Full?  Evicted Evict_Time OOM\n";
211foreach my $n (1..$max) {
212    my $it = $items{$n};
213    next if (0 == $it->{total_pages});
214    my $size = $it->{chunk_size} < 1024 ?
215        "$it->{chunk_size}B" :
216        sprintf("%.1fK", $it->{chunk_size} / 1024.0);
217    my $full = $it->{free_chunks_end} == 0 ? "yes" : " no";
218    printf("%3d %8s %9ds %7d %7d %7s %8d %8d %4d\n",
219           $n, $size, $it->{age}, $it->{total_pages},
220           $it->{number}, $full, $it->{evicted},
221           $it->{evicted_time}, $it->{outofmemory});
222}
223
224