--- /dev/null
+#! /usr/bin/perl
+# See memcached for LICENSE
+# Copyright 2011 Dormando (dormando@rydia.net)
+
+=head1 NAME
+
+mc_slab_mover -- example utility for slab page reassignment for memcached
+
+=head1 SYNOPSIS
+
+ $ mc_slab_mover --host="127.0.0.1:11211" --verbose
+ $ mc_slab_mover --host="127.0.0.1:11211" --automove
+ $ mc_slab_mover --host="127.0.0.1:11211" --sleep=60 --loops=4 --automove
+
+=head1 DESCRIPTION
+
+This utility is an example implementation of an algorithm for reassigning
+slab memory in a running memcached instance. If memcached's built-in
+automover isn't working for you, you may use this script as an example
+base and expand on it. We welcome modifications or alternatives on the
+mailing list.
+
+=head1 ALGORITHM
+
+The default algorithm is simple, and may serve for a common case: over
+time one slab may grow in use compare to others, and as evictions stop
+in one slab and start in another it will reassign memory.
+
+If a slab has the most evictions three times in a row, it will pull a page
+from a slab which has had zero evictions three times in a row.
+
+There are many traffic patterns where this does not work well. IE: If you
+never use expirations and rely on the LRU (so all slabs always evict),
+it will not be as likely to find source pages to move.
+
+=head1 OPTIONS
+
+=over
+
+=item --host="IP:PORT"
+
+The hostname to connect to. NOTE: If connection to the host breaks, script
+will stop.
+
+=item --sleep=10
+
+How long to wait between loops for gathering stats.
+
+=item --loops=3
+
+How many loops to run before making a decision for a move.
+
+=item --verbose
+
+Prints a formatted dump of some common statistics per loop.
+
+=item --automove
+
+Enables the automover, and will attempt to move memory around if it finds
+viable candidates.
+
+=back
+
+=head1 AUTHOR
+
+Dormando E<lt>L<dormando@rydia.net>E<gt>
+
+=head1 LICENSE
+
+Licensed for use and redistribution under the same terms as Memcached itself.
+
+=cut
+
+use warnings;
+use strict;
+
+use IO::Socket::INET;
+
+use FindBin;
+use Data::Dumper qw/Dumper/;
+use Getopt::Long;
+
+my %opts = ('sleep' => 10, automove => 0, verbose => 0, loops => 3);
+GetOptions(
+ "host=s" => \$opts{host},
+ "sleep=i" => \$opts{'sleep'},
+ "loops=i" => \$opts{loops},
+ "automove" => \$opts{automove},
+ "verbose" => \$opts{verbose},
+ ) or usage();
+
+die "Must specify at least --host='127.0.0.1:11211'" unless $opts{host};
+my $sock = IO::Socket::INET->new(PeerAddr => $opts{host},
+ Timeout => 3);
+die "$!\n" unless $sock;
+
+my %stats = ();
+my %move = (winner => 0, wins => 0);
+
+$SIG{INT} = sub {
+ print "STATS: ", Dumper(\%stats), "\n";
+ exit;
+};
+$SIG{USR1} = sub {
+ print "STATS: ", Dumper(\%stats), "\n";
+};
+run();
+
+sub usage {
+ print qq{Usage:
+ mc_slab_ratios --host="127.0.0.1:11211" --verbose --automove
+ run `perldoc mc_slab_ratios` for full information
+
+};
+ exit 1;
+}
+
+sub run {
+ my $slabs_before = grab_stats();
+
+ while (1) {
+ sleep $opts{'sleep'};
+ my $slabs_after = grab_stats();
+
+ my ($totals, $sorted) = calc_results_evicted($slabs_before, $slabs_after);
+# my ($totals, $sorted) = calc_results_numratio($slabs_before, $slabs_after);
+
+ my $pct = sub {
+ my ($num, $divisor) = @_;
+ return 0 unless $divisor;
+ return ($num / $divisor);
+ };
+ if ($opts{verbose}) {
+ printf " %02s: %-8s (pct ) %-10s (pct ) %-6s (pct ) get_hits (pct ) cmd_set (pct )\n",
+ 'sb', 'evicted', 'items', 'pages';
+ for my $slab (@$sorted) {
+ printf " %02d: %-8d (%.2f%%) %-10s (%.4f%%) %-6d (%.2f%%) %-8d (%.3f%%) %-7d (%.2f%%)\n",
+ $slab->{slab}, $slab->{evicted_d},
+ $pct->($slab->{evicted_d}, $totals->{evicted_d}),
+ $slab->{number},
+ $pct->($slab->{number}, $totals->{number}),
+ $slab->{total_pages},
+ $pct->($slab->{total_pages}, $totals->{total_pages}),
+ $slab->{get_hits_d},
+ $pct->($slab->{get_hits_d}, $totals->{get_hits_d}),
+ $slab->{cmd_set_d},
+ $pct->($slab->{cmd_set_d}, $totals->{cmd_set_d});
+ }
+ }
+
+ next unless @$sorted;
+ my $highest = $sorted->[-1];
+ $stats{$highest->{slab}}++;
+ print " (winner: ", $highest->{slab}, " wins: ", $stats{$highest->{slab}}, ")\n";
+ automove_basic($totals, $sorted) if ($opts{automove});
+
+ $slabs_before = $slabs_after;
+ }
+}
+
+sub grab_stats {
+ my %slabs = ();
+ for my $stat (qw/items slabs/) {
+ print $sock "stats $stat\r\n";
+ while (my $line = <$sock>) {
+ chomp $line;
+ last if ($line =~ m/^END/);
+ if ($line =~ m/^STAT (?:items:)?(\d+):(\S+) (\S+)/) {
+ my ($slab, $var, $val) = ($1, $2, $3);
+ $slabs{$slab}->{$var} = $val;
+ }
+ }
+ }
+
+ return \%slabs;
+}
+
+# Really stupid algo, same as the initial algo built into memcached.
+# If a slab "wins" most evictions 3 times in a row, pick from a slab which
+# has had 0 evictions 3 times in a row and move it over.
+sub automove_basic {
+ my ($totals, $sorted) = @_;
+
+ my $source = 0;
+ my $dest = 0;
+ my $high = $sorted->[-1];
+ return unless $high->{evicted_d} > 0;
+ if ($move{winner} == $high->{slab}) {
+ $move{wins}++;
+ $dest = $move{winner} if $move{wins} >= $opts{loops};
+ } else {
+ $move{wins} = 1;
+ $move{winner} = $high->{slab};
+ }
+ for my $slab (@$sorted) {
+ my $id = $slab->{slab};
+ if ($slab->{evicted_d} == 0 && $slab->{total_pages} > 2) {
+ $move{zeroes}->{$id}++;
+ $source = $id if (!$source && $move{zeroes}->{$id} >= $opts{loops});
+ } else {
+ delete $move{zeroes}->{$slab->{slab}}
+ if exists $move{zeroes}->{$slab->{slab}};
+ }
+ }
+
+ if ($source && $dest) {
+ print " slabs reassign $source $dest\n";
+ print $sock "slabs reassign $source $dest\r\n";
+ my $res = <$sock>;
+ print " RES: ", $res;
+ } elsif ($dest && !$source) {
+ print "FAIL: want to move memory to $dest but no valid source slab available\n";
+ }
+}
+
+# Using just the evicted stats.
+sub calc_results_evicted {
+ my ($slabs, $totals) = calc_slabs(@_);
+ my @sorted = sort { $a->{evicted_d} <=> $b->{evicted_d} } values %$slabs;
+ return ($totals, \@sorted);
+}
+
+# Weighted ratios of evictions vs total stored items
+# Seems to fail as an experiment, but it tries to weight stats.
+# In this case evictions in underused classes tend to get vastly inflated
+sub calc_results_numratio {
+ my ($slabs, $totals) = calc_slabs(@_, sub {
+ my ($sb, $sa, $s) = @_;
+ if ($s->{evicted_d}) {
+ $s->{numratio} = $s->{evicted_d} / $s->{number};
+ } else { $s->{numratio} = 0; }
+ });
+ my @sorted = sort { $a->{numratio} <=> $b->{numratio} } values %$slabs;
+ return ($totals, \@sorted);
+}
+
+sub calc_slabs {
+ my ($slabs_before, $slabs_after, $code) = @_;
+ my %slabs = ();
+ my %totals = ();
+ for my $id (keys %$slabs_after) {
+ my $sb = $slabs_before->{$id};
+ my $sa = $slabs_after->{$id};
+ next unless ($sb && $sa);
+ my %slab = %$sa;
+ for my $key (keys %slab) {
+ # Add totals, diffs
+ if ($slab{$key} =~ m/^\d+$/) {
+ $totals{$key} += $slab{$key};
+ $slab{$key . '_d'} = $sa->{$key} - $sb->{$key};
+ $totals{$key . '_d'} += $sa->{$key} - $sb->{$key};
+ }
+ }
+ # External code
+ $code->($sb, $sa, \%slab) if $code;
+ $slab{slab} = $id;
+ $slabs{$id} = \%slab;
+ }
+ return (\%slabs, \%totals);
+}
projects / awesomized / libmemcached / blobdiff