|
0
|
1 #!/usr/bin/perl
|
|
|
2 #
|
|
|
3 # memcached-tool:
|
|
|
4 # stats/management tool for memcached.
|
|
|
5 #
|
|
|
6 # Author:
|
|
|
7 # Brad Fitzpatrick <brad@danga.com>
|
|
|
8 #
|
|
|
9 # License:
|
|
|
10 # public domain. I give up all rights to this
|
|
|
11 # tool. modify and copy at will.
|
|
|
12 #
|
|
|
13
|
|
|
14 use strict;
|
|
|
15 use IO::Socket::INET;
|
|
|
16
|
|
|
17 my $host = shift;
|
|
|
18 my $mode = shift || "display";
|
|
|
19 my ($from, $to);
|
|
|
20
|
|
|
21 if ($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
|
|
|
35 undef $mode if @ARGV;
|
|
|
36
|
|
|
37 die
|
|
|
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
|
|
|
44 You can only move slabs around once memory is totally allocated, and only
|
|
|
45 once the target class is full. (So you can't move from #6 to #9 and #7
|
|
|
46 to #9 at the same itme, since you'd have to wait for #9 to fill from
|
|
|
47 the first reassigned page)
|
|
|
48 " unless $host && $mode;
|
|
|
49
|
|
|
50 $host .= ":11211" unless $host =~ /:\d+/;
|
|
|
51
|
|
|
52 my $sock = IO::Socket::INET->new(PeerAddr => $host,
|
|
|
53 Proto => 'tcp');
|
|
|
54 die "Couldn't connect to $host\n" unless $sock;
|
|
|
55
|
|
|
56
|
|
|
57 if ($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
|
|
|
83 if ($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
|
|
|
132 my %items; # class -> { number, age, chunk_size, chunks_per_page,
|
|
|
133 # total_pages, total_chunks, used_chunks,
|
|
|
134 # free_chunks, free_chunks_end }
|
|
|
135
|
|
|
136 print $sock "stats items\r\n";
|
|
|
137 while (<$sock>) {
|
|
|
138 last if /^END/;
|
|
|
139 if (/^STAT items:(\d+):(\w+) (\d+)/) {
|
|
|
140 $items{$1}{$2} = $3;
|
|
|
141 }
|
|
|
142 }
|
|
|
143
|
|
|
144 print $sock "stats slabs\r\n";
|
|
|
145 while (<$sock>) {
|
|
|
146 last if /^END/;
|
|
|
147 if (/^STAT (\d+):(\w+) (\d+)/) {
|
|
|
148 $items{$1}{$2} = $3;
|
|
|
149 }
|
|
|
150 }
|
|
|
151
|
|
|
152 print " # Item_Size Max_age 1MB_pages Full?\n";
|
|
|
153 foreach 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
|
