"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/scripts/memcached-tool" (21 Feb 2022, 6196 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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