#!/usr/bin/perl
#
=head1 NAME

Memcached - A Plugin to monitor Memcached Servers (Multigraph)

=head1 MUNIN CONFIGURATION

[memcached_*]
 env.host 127.0.0.1     *default*
 env.port 11211         *default*
 env.timescale 3        *default*

=head2 MUNIN ENVIRONMENT CONFIGURATION EXPLANATION

 host = host we are going to monitor
 port = port we are connecting to, in order to gather stats
 timescale = what time frame do we want to format our graphs too

=head1 NODE CONFIGURATION

Please make sure you can telnet to your memcache servers and issue the
 following commands: stats, stats settings, stats items and stats slabs.

Available Graphs contained in this Plugin

bytes => This graphs the current network traffic in and out

commands => I<MULTIGRAPH> This graphs the current commands being issued to the memcache machine. B<Multigraph breaks this down to per slab.>

conns => This graphs the current, max connections as well as avg conns per sec avg conns per sec is derived from total_conns / uptime.

evictions => I<MULTIGRAPH> This graphs the current evictions on the node. B<Multigraph breaks this down to per slab.>

items => I<MULTIGRAPH> This graphs the current items and total items in the memcached node. B<Multigraph breaks this down to per slab.>

memory => I<MULTIGRAPH> This graphs the current and max memory allocation B<Multigraph breaks this down to per slab.>

The following example holds true for all graphing options in this plugin.
 Example: ln -s /usr/share/munin/plugins/memcached_multi_ /etc/munin/plugins/memcached_multi_bytes

=head1 ADDITIONAL INFORMATION

You will find that some of the graphs have LEI on them. This was done in order to save room
on space for text and stands for B<Last Evicted Item>.

The B<Timescale> variable formats certain graphs based on the following guidelines.
 1 => Seconds
 2 => Minutes
 3 => Hours  B<*Default*>
 4 => Days

=head1 ACKNOWLEDGEMENTS

The core of this plugin is based on the mysql_ plugin maintained by Kjell-Magne Ãierud

Thanks to dormando as well for putting up with me ;)

=head1 AUTHOR

Matt West < https://code.google.com/p/memcached-munin-plugin/ >

=head1 LICENSE

GPLv2

=head1 MAGIC MARKERS

    #%# family=auto
    #%# capabilities=autoconf suggest

=cut

use strict;
use IO::Socket;
use Munin::Plugin;

need_multigraph();

my $host = $ENV{host} || "127.0.0.1";
my $port = $ENV{port} || 11211;

my %stats;
# This hash contains the information contained in two memcache commands
# stats and stats settings.

my %items;
# This gives us eviction rates and other hit stats per slab
# We track this so we can see if something was evicted earlier than necessary

my %chnks;
# This gives us the memory size and usage per slab
# We track this so we can see what slab is being used the most and has no free chunks 
# so we can re-tune memcached to allocate more pages for the specified chunk size

my $timescale = $ENV{timescale} || 3;
# This gives us the ability to control the timescale our graphs are displaying.
# The default it set to divide by hours, if you want to get seconds set it to 1.
# Options: 1 = seconds, 2 = minutes, 3 = hours, 4 = days

# So I was trying to figure out how to build this up, and looking at some good examples
# I decided to use the format, or for the most part, the format from the mysql_ munin plugin
# for Innodb by Kjell-Magne Ãierud, it just spoke ease of flexibility especially with multigraphs
# thanks btw ;)
#
# %graphs   is a container for all of the graph definition information. In here is where you'll
#           find the configuration information for munin's graphing procedure.
#   Format:
#
#   $graph{graph_name} => {
#       config => {
#           # You'll find keys and values stored here for graph manipulation
#       },
#       datasrc => [
#           # Name: name given to data value
#           # Attr: Attribute for given value
#           { name => 'Name', (Attr) },
#           { ... },
#       ],
#   }
my %graphs;

$graphs{items} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Items in Memcached',
        category => 'memcached',
        title => 'Items',
        info => 'This graph shows the number of items in use by memcached',
    },
    datasrc => [
        { name => 'curr_items', label => 'Current Items', min => '0' },
        { name => 'total_items', label => 'New Items', min => '0', type => 'DERIVE' },
    ],
};

$graphs{memory} = {
    config => {
        args => '--base 1024 --lower-limit 0',
        vlabel => 'Bytes Used',
        category => 'memcached',
        title => 'Memory Usage',
        info => 'This graph shows the memory consumption of memcached',
    },
    datasrc => [
        { name => 'limit_maxbytes', draw => 'AREA', label => 'Maximum Bytes Allocated', min => '0' },
        { name => 'bytes', draw => 'AREA', label => 'Current Bytes Used', min => '0' },
    ],
};

$graphs{bytes} = {
    config => {
        args => '--base 1000',
        vlabel => 'bits in (-) / out (+)',
        title => 'Network Traffic',
        category => 'memcached',
        info => 'This graph shows the network traffic in (-) / out (+) of the machine',
        order => 'bytes_read bytes_written',
    },
    datasrc => [
        { name => 'bytes_read', type => 'DERIVE', label => 'Network Traffic coming in (-)', graph => 'no', cdef => 'bytes_read,8,*', min => '0' },
        { name => 'bytes_written', type => 'DERIVE', label => 'Traffic in (-) / out (+)', negative => 'bytes_read', cdef => 'bytes_written,8,*', min => '0' },
    ],
};

$graphs{conns} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Connections per ${graph_period}',
        category => 'memcached',
        title => 'Connections',
        info => 'This graph shows the number of connections being handled by memcached',
        order => 'max_conns curr_conns avg_conns',
    },
    datasrc => [
        { name => 'curr_conns', label => 'Current Connections', min => '0' },
        { name => 'max_conns', label => 'Max Connections', min => '0' },
        { name => 'avg_conns' , label => 'Avg Connections', min => '0' },
    ],
};

$graphs{commands} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Commands per ${graph_period}',
        category => 'memcached',
        title => 'Commands',
        info => 'This graph shows the number of commands being handled by memcached',
    },
    datasrc => [
        { name => 'cmd_get', type => 'DERIVE', label => 'Gets', info => 'Cumulative number of retrieval reqs', min => '0' },
        { name => 'cmd_set', type => 'DERIVE', label => 'Sets', info => 'Cumulative number of storage reqs', min => '0' },
        { name => 'get_hits', type => 'DERIVE', label => 'Get Hits', info => 'Number of keys that were requested and found', min => '0' },
        { name => 'get_misses', type => 'DERIVE', label => 'Get Misses', info => 'Number of keys there were requested and not found', min => '0' },
        { name => 'delete_hits', type => 'DERIVE', label => 'Delete Hits', info => 'Number of delete requests that resulted in a deletion of a key', min => '0' },
        { name => 'delete_misses', type => 'DERIVE', label => 'Delete Misses', info => 'Number of delete requests for missing key', min => '0' },
        { name => 'incr_hits', type => 'DERIVE', label => 'Increment Hits', info => 'Number of successful increment requests', min => '0' },
        { name => 'incr_misses', type => 'DERIVE', label => 'Increment Misses', info => 'Number of unsuccessful increment requests', min => '0' },
        { name => 'decr_hits', type => 'DERIVE', label => 'Decrement Hits', info => 'Number of successful decrement requests', min => '0' },
        { name => 'decr_misses', type => 'DERIVE', label => 'Decrement Misses', info => 'Number of unsuccessful decrement requests', min => '0' },
    ],
};

$graphs{evictions} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Evictions per ${graph_period}',
        category => 'memcached',
        title => 'Evictions',
        info => 'This graph shows the number of evictions per second',
    },
    datasrc => [
        { name => 'evictions', label => 'Evictions', info => 'Cumulative Evictions Across All Slabs', type => 'DERIVE', min => '0' },
        { name => 'evicted_nonzero', label => 'Evictions prior to Expire', info => 'Cumulative Evictions forced to expire prior to expiration', type => 'DERIVE', min => '0' },
        { name => 'reclaimed', label => 'Reclaimed Items', info => 'Cumulative Reclaimed Item Entries Across All Slabs', type => 'DERIVE', min => '0' },
    ],
};

$graphs{slabchnks} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Available Chunks for this Slab',
        category => 'memcached',
        title => 'Chunk Usage for Slab: ',
        info => 'This graph shows you the chunk usage for this memory slab.',
    },
    datasrc => [
        { name => 'total_chunks', label => 'Total Chunks Available', min => '0' },
        { name => 'used_chunks', label => 'Total Chunks in Use', min => '0' },
        { name => 'free_chunks', label => 'Total Chunks Not in Use (Free)', min => '0' },
    ],
};

$graphs{slabhits} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Hits per Slab per ${graph_period}',
        category => 'memcached',
        title => 'Hits for Slab: ',
        info => 'This graph shows you the successful hit rate for this memory slab.',
    },
    datasrc => [
        { name => 'get_hits', label => 'Get Requests', type => 'DERIVE', min => '0' },
        { name => 'cmd_set', label => 'Set Requests', type => 'DERIVE', min => '0' },
        { name => 'delete_hits', label => 'Delete Requests', type => 'DERIVE', min => '0' },
        { name => 'incr_hits', label => 'Increment Requests', type => 'DERIVE', min => '0' },
        { name => 'decr_hits', label => 'Decrement Requests', type => 'DERIVE', min => '0' },
    ],
};

$graphs{slabevics} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Evictions per Slab per ${graph_period}',
        category => 'memcached',
        title => 'Evictions for Slab: ',
        info => 'This graph shows you the eviction rate for this memory slab.',
    },
    datasrc => [
        { name => 'evicted', label => 'Total Evictions', type => 'DERIVE', min => '0' },
        { name => 'evicted_nonzero', label => 'Evictions from LRU Prior to Expire', type => 'DERIVE', min => '0' },
        { name => 'reclaimed', label => 'Reclaimed Expired Items', info => 'This is number of times items were stored in expired entry memory space', type => 'DERIVE', min => '0' },
    ],
};

$graphs{slabevictime} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => ' since Request for LEI',
        category => 'memcached',
        title => 'Eviction Request Time for Slab: ',
        info => 'This graph shows you the time since we requested the last evicted item',
    },
    datasrc => [
        { name => 'evicted_time', label => 'Eviction Time (LEI)', info => 'Time Since Request for Last Evicted Item', min => '0' },
    ],
};

$graphs{slabitems} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Items per Slab',
        category => 'memcached',
        title => 'Items in Slab: ',
        info => 'This graph shows you the number of items and reclaimed items per slab.',
    },
    datasrc => [
        { name => 'number', label => 'Items', info => 'This is the amount of items stored in this slab', min => '0' },
    ],
};

$graphs{slabitemtime} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => ' since item was stored',
        category => 'memcached',
        title => 'Age of Eldest Item in Slab: ',
        info => 'This graph shows you the time of the eldest item in this slab',
    },
    datasrc => [
        { name => 'age', label => 'Eldest Item\'s Age', min => '0' },
    ],
};

##
#### Config Check ####
##

if (defined $ARGV[0] && $ARGV[0] eq 'config') {

    $0 =~ /memcached_multi_(.+)*/;
    my $plugin = $1;

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    # We need to fetch the stats before we do any config, cause its needed for multigraph
    fetch_stats();

    # Now lets go ahead and print out our config.
	do_config($plugin);
	exit 0;
}

##
#### Autoconf Check ####
##

if (defined $ARGV[0] && $ARGV[0] eq 'autoconf') {

    my $s = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $host,
        PeerPort => $port,
    );

    if (defined($s)) {
        print "yes\n";
        exit 0;
    } else {
        print "no (unable to connect to $host\[:$port\])\n";
        exit 0;
    }
}

##
#### Suggest Check ####
##

if (defined $ARGV[0] && $ARGV[0] eq 'suggest') {

    my $s = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $host,
        PeerPort => $port,
    );

    if (defined($s)) {
        my @rootplugins = ('bytes','conns','commands','evictions','items','memory');
        foreach my $plugin (@rootplugins) {
            print "$plugin\n";
        }
        exit 0;
    } else {
        print "no (unable to connect to $host\[:$port\])\n";
        exit 0;
    }
}

##
#### Well We aren't running (auto)config/suggest so lets print some stats ####
##

fetch_output();

##
#### Subroutines for printing info gathered from memcached ####
##

##
#### This subroutine performs the bulk processing for printing statistics.
##

sub fetch_output {

    $0 =~ /memcached_multi_(.+)*/;
    my $plugin = $1;

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    # Well we need to actually fetch the stats before we do anything to them.
    fetch_stats();
    
    # Now lets go ahead and print out our output.
    my @subgraphs;
    if ($plugin eq 'memory') {
        @subgraphs = ('slabchnks');
        foreach my $slabid(sort{$a <=> $b} keys %chnks) {
            print_submulti_output($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_output($plugin);
    } elsif ($plugin eq 'commands') {
        @subgraphs = ('slabhits');
        foreach my $slabid(sort{$a <=> $b} keys %chnks) {
            print_submulti_output($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_output($plugin);
    } elsif ($plugin eq 'evictions') {
        @subgraphs = ('slabevics','slabevictime');
        foreach my $slabid (sort{$a <=> $b} keys %items) {
            print_submulti_output($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_output($plugin);
    } elsif ($plugin eq 'items') {
        @subgraphs = ('slabitems','slabitemtime');
        foreach my $slabid (sort{$a <=> $b} keys %items) {
            print_submulti_output($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_output($plugin);
    } else {
        print_root_output($plugin);
    }

    return;
}

##
#### This subroutine is for the root non-multigraph graphs which render on the main node page ####
##

sub print_root_output {
    my ($plugin) = (@_);

    my $graph = $graphs{$plugin};

    print "graph memcached_$plugin\n";

    if ($plugin ne 'conns') {
        foreach my $dsrc (@{$graph->{datasrc}}) {
            my %datasrc = %$dsrc;
            while ( my ($key, $value) = each(%datasrc)) {
                next if ($key ne 'name');
                my $output = $stats{$value};
                print "$dsrc->{name}.value $output\n";
            }
        }
    } else {
        my $output;
        foreach my $dsrc (@{$graph->{datasrc}}) {
            my %datasrc = %$dsrc;
            while ( my ($key, $value) = each(%datasrc)) {
                if ($value eq 'max_conns') {
                    $output = $stats{maxconns};
                } elsif ($value eq 'curr_conns') {
                    $output = $stats{curr_connections};
                } elsif ($value eq 'avg_conns') {
                    $output = sprintf("%02d", $stats{total_connections} / $stats{uptime});
                } else {
                    next;
                }
                print "$dsrc->{name}.value $output\n";
            }
        }
    }

    return;
}

##
#### This subroutine is for the root multigraph graphs which render on the main node page ####
##

sub print_rootmulti_output {
    my ($plugin) = (@_);

    my $graph = $graphs{$plugin};

    print "multigraph memcached_$plugin\n";
    
    foreach my $dsrc (@{$graph->{datasrc}}) {
        my $output = 0;
        my %datasrc = %$dsrc;
        while ( my ($key, $value) = each(%datasrc)) {
            next if ($key ne 'name');
            if (($plugin eq 'evictions') && ($value eq 'evicted_nonzero')) {
                foreach my $slabid (sort{$a <=> $b} keys %items) {
                    $output += $items{$slabid}->{evicted_nonzero};
                }
            } else {
                $output = $stats{$value};
            }
            print "$dsrc->{name}.value $output\n";
        }
    }

    return;
}

##
#### This subroutine is for the sub multigraph graphs created via the multigraph plugin ####
##

sub print_submulti_output {
    my ($slabid,$plugin,@subgraphs) = (@_);
    my $currslab = undef;

    foreach my $sgraph (@subgraphs) {

        my $graph = $graphs{$sgraph};

        print "multigraph memcached_$plugin.$sgraph\_$slabid\n";

        if ($plugin eq 'evictions') {
            $currslab = $items{$slabid};
        } elsif ($plugin eq 'memory') {
            $currslab = $chnks{$slabid};
        } elsif ($plugin eq 'commands') {
            $currslab = $chnks{$slabid};
        } elsif ($plugin eq 'items') {
            $currslab = $items{$slabid};
        } else {
            return;
        }

        foreach my $dsrc (@{$graph->{datasrc}}) {
            my %datasrc = %$dsrc;
            while ( my ($key, $value) = each(%datasrc)) {
                next if ($key ne 'name');
                my $output = $currslab->{$value};
                if (($sgraph eq 'slabevictime') || ($sgraph eq 'slabitemtime')) {
                    $output = time_scale('data',$output); ;
                }
                print "$dsrc->{name}.value $output\n";
            }
        }
    }

    return;
}

##
#### Subroutines for printing out config information for graphs ####
##

##
#### This subroutine does the bulk printing the config info per graph ####
##

sub do_config {
    my ($plugin) = (@_);
    my @subgraphs;
    if ($plugin eq 'memory') {
        @subgraphs = ('slabchnks');
        foreach my $slabid (sort{$a <=> $b} keys %chnks) {
            print_submulti_config($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_config($plugin);
    } elsif ($plugin eq 'commands') {
        @subgraphs = ('slabhits');
        foreach my $slabid (sort{$a <=> $b} keys %chnks) {
            print_submulti_config($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_config($plugin);
    } elsif ($plugin eq 'evictions') {
        @subgraphs = ('slabevics','slabevictime');
        foreach my $slabid (sort{$a <=> $b}  keys %items) {
            print_submulti_config($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_config($plugin);
    } elsif ($plugin eq 'items') {
        @subgraphs = ('slabitems','slabitemtime');
        foreach my $slabid (sort{$a <=> $b} keys %items) {
            print_submulti_config($slabid,$plugin,@subgraphs);
        }
        print_rootmulti_config($plugin);
    } else {
        print_root_config($plugin);
    }

    return;
}

##
#### This subroutine is for the config info for sub multigraph graphs created via the multigraph plugin ####
##

sub print_submulti_config {
    my ($slabid,$plugin,@subgraphs) = (@_);
    my ($slabitems,$slabchnks) = undef;

    foreach my $sgraph (@subgraphs) {

        my $graph = $graphs{$sgraph};

        my %graphconf = %{$graph->{config}};
        
        print "multigraph memcached_$plugin.$sgraph\_$slabid\n";

        while ( my ($key, $value) = each(%graphconf)) {
	        if ($key eq 'title') {
	            print "graph_$key $value" . "$slabid" . " ($chnks{$slabid}->{chunk_size} Bytes)\n";
	        } elsif (($key eq 'vlabel') && (($sgraph eq 'slabevictime') || ($sgraph eq 'slabitemtime'))) {
                $value = time_scale('config',$value);
                print "graph_$key $value\n";
            } else {
                print "graph_$key $value\n";
	        }
        }

        foreach my $dsrc (@{$graph->{datasrc}}) {
            my %datasrc = %$dsrc;
            while ( my ($key, $value) = each(%datasrc)) {
                next if ($key eq 'name');
                print "$dsrc->{name}.$key $value\n";
            }
        }
    }

    return;
}

##
#### This subroutine is for the config info for root multigraph graphs which render on the main node page ####
##

sub print_rootmulti_config {
    my ($plugin) = (@_);

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    my $graph = $graphs{$plugin};

    my %graphconf = %{$graph->{config}};

    print "multigraph memcached_$plugin\n";

    while ( my ($key, $value) = each(%graphconf)) {
        print "graph_$key $value\n";
    }

    foreach my $dsrc (@{$graph->{datasrc}}) {
        my %datasrc = %$dsrc;
        while ( my ($key, $value) = each(%datasrc)) {
            next if ($key eq 'name');
            print "$dsrc->{name}.$key $value\n";
        }
    }

    return;
}

##
#### This subroutine is for the config info for non multigraph graphs which render on the main node page ####
##

sub print_root_config {
    my ($plugin) = (@_);

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    my $graph = $graphs{$plugin};

    my %graphconf = %{$graph->{config}};

    print "graph memcached_$plugin\n";

    while ( my ($key, $value) = each(%graphconf)) {
        print "graph_$key $value\n";
    }

    foreach my $dsrc (@{$graph->{datasrc}}) {
        my %datasrc = %$dsrc;
        while ( my ($key, $value) = each(%datasrc)) {
            next if ($key eq 'name');
            print "$dsrc->{name}.$key $value\n";
        }
    }

    return;
}

##
#### This subroutine actually performs the data fetch for us ####
#### These commands do not lock up Memcache at all ####
##

sub fetch_stats {
    my $s = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $host,
        PeerPort => $port,
    );

    die "Error: Unable to Connect to $host\[:$port\]\n" unless $s;

    print $s "stats\r\n";

    while (my $line = <$s>) {
        if ($line =~ /STAT\s(.+?)\s(\d+)/) {
            my ($skey,$svalue) = ($1,$2);
            $stats{$skey} = $svalue;
        }
        last if $line =~ /^END/;
    }

    print $s "stats settings\r\n";

    while (my $line = <$s>) {
        if ($line =~ /STAT\s(.+?)\s(\d+)/) {
            my ($skey,$svalue) = ($1,$2);
            $stats{$skey} = $svalue;
        }
        last if $line =~ /^END/;
    }

    print $s "stats slabs\r\n";

    while (my $line = <$s>) {
        if ($line =~ /STAT\s(\d+):(.+)\s(\d+)/) {
            my ($slabid,$slabkey,$slabvalue) = ($1,$2,$3);
            $chnks{$slabid}->{$slabkey} = $slabvalue;
        }
        last if $line =~ /^END/;
    }

    print $s "stats items\r\n";

    while (my $line = <$s>) {
        if ($line =~ /STAT\sitems:(\d+):(.+?)\s(\d+)/) {
            my ($itemid,$itemkey,$itemvalue) = ($1,$2,$3);
            $items{$itemid}->{$itemkey} = $itemvalue;
        }
        last if $line =~ /^END/;
    }
}

##
#### This subroutine is to help manage the time_scale settings for the graph
##

sub time_scale {
    my ($configopt,$origvalue) = (@_);
    my $value;

    if ($configopt eq 'config') {
        if ($timescale == 1) {
            $value = "Seconds" . $origvalue;
        } elsif ($timescale == 2) {
            $value = "Minutes" . $origvalue;
        } elsif (($timescale == 3) || ($timescale > 4) || (!defined($timescale))) {
            $value = "Hours" . $origvalue;
        } elsif ($timescale == 4) {
            $value = "Days" . $origvalue;
        }
    } elsif ($configopt eq 'data') {
        if ($timescale == 1) {
            $value = sprintf("%02.2f", $origvalue / 1);
        } elsif ($timescale == 2) {
            $value = sprintf("%02.2f", $origvalue / 60);
        } elsif (($timescale == 3) || ($timescale > 4) || (!defined($timescale))) {
            $value = sprintf("%02.2f", $origvalue / 3600);
        } elsif ($timescale == 4) {
            $value = sprintf("%02.2f", $origvalue / 86400);
        }
    } else {
        die "Unknown time_scale option given: either [config/data]\n";
    }
    return $value;
}