2
0
mirror of https://github.com/munin-monitoring/contrib.git synced 2018-11-08 00:59:34 +01:00

Merge pull request #24 from mhwest13/master

shoutcast2 plugin rewrite in perl instead of php
memcached updates
This commit is contained in:
Kenyon Ralph 2012-02-09 19:08:23 -08:00
commit 12d6e547c6
2 changed files with 731 additions and 179 deletions

View File

@ -1,6 +1,6 @@
#!/usr/bin/perl
#
=head1 NAME
=head1 MEMCACHED
Memcached - A Plugin to monitor Memcached Servers (Multigraph)
@ -36,9 +36,6 @@ items => I<MULTIGRAPH> This graphs the current items and total items in the memc
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
@ -52,13 +49,11 @@ The B<Timescale> variable formats certain graphs based on the following guidelin
=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 ;)
Thanks to dormando for putting up with me ;)
=head1 AUTHOR
Matt West < https://code.google.com/p/memcached-munin-plugin/ >
Matt West < https://github.com/mhwest13/Memcached-Munin-Plugin >
=head1 LICENSE
@ -72,54 +67,77 @@ GPLv2
=cut
use strict;
use warnings;
use IO::Socket;
use Munin::Plugin;
use File::Basename;
if (basename($0) !~ /^memcached_multi_/) {
print "This script needs to be named memcached_multi_ and have symlinks which start the same.\n";
exit 1;
}
# tell munin about our multigraph capabilities
need_multigraph();
=head1 Variable Declarations
This section of code is to declare the variables used throughout the plugin
Some of them are imported as environment variables from munin plugin conf.d
file, others are hashes used for storing information that comes from the
stats commands issued to memcached.
=cut
# lets import environment variables for the plugin or use the default
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
my $timescale = $ENV{timescale} || 3;
# This hash contains the information contained in two memcache commands
# stats and stats settings.
my %stats;
# 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 %items;
# 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 %chnks;
=head2 Graph Declarations
This block of code builds up all of the graph info for all root / sub graphs.
%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 the main graph config stored here
{ key => value },
{ ... },
},
datasrc => [
Name: name given to data value
Attr: Attribute and value, attribute must be valid plugin argument
{ name => 'Name', info => 'info about graph', ... },
{ ... },
],
}
=cut
# 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;
# main graph for memcached item count
$graphs{items} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -133,7 +151,7 @@ $graphs{items} = {
{ name => 'total_items', label => 'New Items', min => '0', type => 'DERIVE' },
],
};
# main graph for memcached memory usage
$graphs{memory} = {
config => {
args => '--base 1024 --lower-limit 0',
@ -147,7 +165,7 @@ $graphs{memory} = {
{ name => 'bytes', draw => 'AREA', label => 'Current Bytes Used', min => '0' },
],
};
# main graph for memcached network usage
$graphs{bytes} = {
config => {
args => '--base 1000',
@ -162,7 +180,7 @@ $graphs{bytes} = {
{ name => 'bytes_written', type => 'DERIVE', label => 'Traffic in (-) / out (+)', negative => 'bytes_read', cdef => 'bytes_written,8,*', min => '0' },
],
};
# graph for memcached connections
$graphs{conns} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -178,7 +196,7 @@ $graphs{conns} = {
{ name => 'avg_conns' , label => 'Avg Connections', min => '0' },
],
};
# main graph for memcached commands issued
$graphs{commands} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -200,7 +218,7 @@ $graphs{commands} = {
{ name => 'decr_misses', type => 'DERIVE', label => 'Decrement Misses', info => 'Number of unsuccessful decrement requests', min => '0' },
],
};
# main graph for memcached eviction rates
$graphs{evictions} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -215,7 +233,7 @@ $graphs{evictions} = {
{ name => 'reclaimed', label => 'Reclaimed Items', info => 'Cumulative Reclaimed Item Entries Across All Slabs', type => 'DERIVE', min => '0' },
],
};
# sub graph for breaking memory info down by slab ( sub graph of memory )
$graphs{slabchnks} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -230,7 +248,7 @@ $graphs{slabchnks} = {
{ name => 'free_chunks', label => 'Total Chunks Not in Use (Free)', min => '0' },
],
};
# sub graph for breaking commands down by slab ( sub graph of commands )
$graphs{slabhits} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -247,7 +265,7 @@ $graphs{slabhits} = {
{ name => 'decr_hits', label => 'Decrement Requests', type => 'DERIVE', min => '0' },
],
};
# sub graph for breaking evictions down by slab ( sub graph of evictions )
$graphs{slabevics} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -262,7 +280,7 @@ $graphs{slabevics} = {
{ name => 'reclaimed', label => 'Reclaimed Expired Items', info => 'This is number of times items were stored in expired entry memory space', type => 'DERIVE', min => '0' },
],
};
# sub graph for showing the time between an item was last evicted and requested ( sub graph of evictions )
$graphs{slabevictime} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -275,7 +293,7 @@ $graphs{slabevictime} = {
{ name => 'evicted_time', label => 'Eviction Time (LEI)', info => 'Time Since Request for Last Evicted Item', min => '0' },
],
};
# sub graph for breaking items down by slab ( sub graph of items )
$graphs{slabitems} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -288,7 +306,7 @@ $graphs{slabitems} = {
{ name => 'number', label => 'Items', info => 'This is the amount of items stored in this slab', min => '0' },
],
};
# sub graph for showing the age of the eldest item stored in a slab ( sub graph of items )
$graphs{slabitemtime} = {
config => {
args => '--base 1000 --lower-limit 0',
@ -302,37 +320,47 @@ $graphs{slabitemtime} = {
],
};
##
#### Config Check ####
##
=head1 Munin Checks
These checks look for config / autoconf / suggest params
=head2 Config Check
This block of code looks at the argument that is possibly supplied,
should it be config, it then checks to make sure the plugin
specified exists, assuming it does, it will run the do_config
subroutine for the plugin specified, otherwise it dies complaining
about an unknown plugin.
=cut
if (defined $ARGV[0] && $ARGV[0] eq 'config') {
# Lets get our plugin from the symlink being called up, we'll also verify its a valid
# plugin that we have graph information for
$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
# subgraphs which use slab information for title / info per slab
fetch_stats();
# Now lets go ahead and print out our config.
do_config($plugin);
exit 0;
}
##
#### Autoconf Check ####
##
=head2 Autoconf Check
This block of code looks at the argument that is possibly supplied,
should it be autoconf, we will attempt to connect to the memcached
service specified on the host:port, upon successful connection it
prints yes, otherwise it prints no.
=cut
if (defined $ARGV[0] && $ARGV[0] eq 'autoconf') {
my $s = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port,
);
# Lets attempt to connect to memcached
my $s = get_conn();
# Lets verify that we did connect to memcached
if (defined($s)) {
print "yes\n";
exit 0;
@ -342,18 +370,21 @@ if (defined $ARGV[0] && $ARGV[0] eq 'autoconf') {
}
}
##
#### Suggest Check ####
##
=head2 Suggest Check
This block of code looks at the argument that is possibly supplied,
should it be suggest, we are going to print the possible plugins
which can be specified. Note we only specify the root graphs for the
multigraphs, since the rest of the subgraphs will appear "behind" the
root graphs. It also attempts to connect to the memcached service to
verify it is infact running.
=cut
if (defined $ARGV[0] && $ARGV[0] eq 'suggest') {
my $s = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port,
);
# Lets attempt to connect to memcached
my $s = get_conn();
# Lets check that we did connect to memcached
if (defined($s)) {
my @rootplugins = ('bytes','conns','commands','evictions','items','memory');
foreach my $plugin (@rootplugins) {
@ -366,30 +397,29 @@ if (defined $ARGV[0] && $ARGV[0] eq 'suggest') {
}
}
##
#### Well We aren't running (auto)config/suggest so lets print some stats ####
##
=head1 Output Subroutines
Output Subroutine calls to output data values
=head2 fetch_output
This subroutine is the main call for printing data for the plugin.
No parameters are taken as this is the default call if no arguments
are supplied from the command line.
=cut
# Well, no arguments were supplied that we know about, so lets print some data
fetch_output();
##
#### Subroutines for printing info gathered from memcached ####
##
##
#### This subroutine performs the bulk processing for printing statistics.
##
sub fetch_output {
# Lets get our plugin from the symlink being called up, we'll also verify its a valid
# plugin that we have graph information for
$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') {
@ -423,17 +453,24 @@ sub fetch_output {
return;
}
##
#### This subroutine is for the root non-multigraph graphs which render on the main node page ####
##
=head2 print_root_output
This block of code prints out the return values for our root graphs. It takes
one parameter $plugin. Returns when completed, this is the non multigraph
output subroutine.
$plugin; graph we are calling up to print data values for
Example: print_root_output($plugin);
=cut
sub print_root_output {
# Lets get our plugin, set our graph reference and print out info for Munin
my ($plugin) = (@_);
my $graph = $graphs{$plugin};
print "graph memcached_$plugin\n";
# The conns plugin has some specific needs, looking for plugin type
if ($plugin ne 'conns') {
foreach my $dsrc (@{$graph->{datasrc}}) {
my %datasrc = %$dsrc;
@ -461,26 +498,33 @@ sub print_root_output {
}
}
}
return;
}
##
#### This subroutine is for the root multigraph graphs which render on the main node page ####
##
=head2 print_rootmulti_output
This block of code prints out the return values for our root graphs. It takes
one parameter $plugin. Returns when completed, this is the multigraph
output subroutine
$plugin; main(root) graph we are calling up to print data values for
Example: print_rootmulti_output($plugin);
=cut
sub print_rootmulti_output {
# Lets get our plugin, set our graph reference and print out info for Munin
my ($plugin) = (@_);
my $graph = $graphs{$plugin};
print "multigraph memcached_$plugin\n";
# Lets print our data values with their appropriate name
foreach my $dsrc (@{$graph->{datasrc}}) {
my $output = 0;
my %datasrc = %$dsrc;
while ( my ($key, $value) = each(%datasrc)) {
next if ($key ne 'name');
next if (($plugin eq 'evictions') && ($value eq 'reclaimed') && ($stats{version} =~ /1\.4\.[0-2]/));
if (($plugin eq 'evictions') && ($value eq 'evicted_nonzero')) {
foreach my $slabid (sort{$a <=> $b} keys %items) {
$output += $items{$slabid}->{evicted_nonzero};
@ -491,24 +535,33 @@ sub print_rootmulti_output {
print "$dsrc->{name}.value $output\n";
}
}
return;
}
##
#### This subroutine is for the sub multigraph graphs created via the multigraph plugin ####
##
=head2 print_submulti_output
This block of code prints out the return values for our root graphs. It takes
three parameters $slabid, $plugin and @subgraphs. Returns when completed, this
is the multigraph output subroutine for our subgraphs
$slabid; slab id that we will use to grab info from and print out
$plugin; main(root) being called, used for multigraph output and slab id
@subgraphs; graphs we are actually trying to print data values for
Example: print_submulti_output($slabid,$plugin,@subgraphs);
=cut
sub print_submulti_output {
# Lets get our slabid, plugin, and subgraphs
my ($slabid,$plugin,@subgraphs) = (@_);
my $currslab = undef;
# Time to loop over our subgraphs array
foreach my $sgraph (@subgraphs) {
# Lets set our graph reference for quick calling, and print some info for munin
my $graph = $graphs{$sgraph};
print "multigraph memcached_$plugin.$sgraph\_$slabid\n";
# Lets figure out what slab info we are trying to call up
if ($plugin eq 'evictions') {
$currslab = $items{$slabid};
} elsif ($plugin eq 'memory') {
@ -520,11 +573,12 @@ sub print_submulti_output {
} else {
return;
}
# Lets print our data values with their appropriate name
foreach my $dsrc (@{$graph->{datasrc}}) {
my %datasrc = %$dsrc;
while ( my ($key, $value) = each(%datasrc)) {
next if ($key ne 'name');
next if (($sgraph eq 'slabevics') && ($value eq 'reclaimed') && ($stats{version} =~ /1\.4\.[0-2]/));
my $output = $currslab->{$value};
if (($sgraph eq 'slabevictime') || ($sgraph eq 'slabitemtime')) {
$output = time_scale('data',$output); ;
@ -533,17 +587,23 @@ sub print_submulti_output {
}
}
}
return;
}
##
#### Subroutines for printing out config information for graphs ####
##
=head1 Config Subroutines
##
#### This subroutine does the bulk printing the config info per graph ####
##
These subroutines handle the config portion of munin calls.
=head2 do_config
This is the main call issued assuming we call up config and plugin specified exists
The subroutine takes one parameter $plugin, and returns when completed.
$plugin; main(root) graph being called
Example: do_config($plugin);
=cut
sub do_config {
my ($plugin) = (@_);
@ -579,22 +639,59 @@ sub do_config {
return;
}
##
#### This subroutine is for the config info for sub multigraph graphs created via the multigraph plugin ####
##
=head2 get_conn
This subroutine returns a socket connection
=cut
sub get_conn {
my $s = undef;
# check if we want to use sockets instead of tcp
my ($sock) = ($host =~ /unix:\/\/(.+)*$/);
if ($sock) {
$s = IO::Socket::UNIX->new(
Peer => $sock
);
} else {
$s = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port,
Timeout => 10,
);
}
return $s;
}
=head2 print_submulti_config
This subroutine prints out the config information for all of the subgraphs.
It takes three parameters, $slabid, $plugin and @subgraphs, returns when
completed, this is the mutligraph config output for our subgraphs
$slabid; slab id that we will use to grab info from and print out
$plugin; main(root) being called, used for multigraph output and slab id
@subgraphs; graphs we are actually trying to print data values for
Example: print_submulti_config($slabid,$plugin,@subgraphs);
=cut
sub print_submulti_config {
# Lets get our slabid, plugin, and subgraphs
my ($slabid,$plugin,@subgraphs) = (@_);
my ($slabitems,$slabchnks) = undef;
# Time to loop over our subgraphs array
foreach my $sgraph (@subgraphs) {
# Lets set our graph reference, and main graph config for easy handling
my $graph = $graphs{$sgraph};
my %graphconf = %{$graph->{config}};
# Lets tell munin which graph we are graphing, and what our main graph config info is
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";
@ -605,7 +702,7 @@ sub print_submulti_config {
print "graph_$key $value\n";
}
}
# Lets tell munin about our data values and how to treat them
foreach my $dsrc (@{$graph->{datasrc}}) {
my %datasrc = %$dsrc;
while ( my ($key, $value) = each(%datasrc)) {
@ -618,25 +715,28 @@ sub print_submulti_config {
return;
}
##
#### This subroutine is for the config info for root multigraph graphs which render on the main node page ####
##
=head2 print_rootmulti_config
This subroutine prints out the config information for all of the main(root) graphs.
It takes one parameter, $plugin, returns when completed.
$plugin; main(root) graph used for multigraph call
Example: print_rootmulti_config($plugin);
=cut
sub print_rootmulti_config {
# Lets get out plugin, set our graph reference and our graph config info
my ($plugin) = (@_);
die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};
my $graph = $graphs{$plugin};
my %graphconf = %{$graph->{config}};
# Lets tell munin about the graph we are referencing and print the main config
print "multigraph memcached_$plugin\n";
while ( my ($key, $value) = each(%graphconf)) {
print "graph_$key $value\n";
}
# Lets tell munin about our data values and how to treat them
foreach my $dsrc (@{$graph->{datasrc}}) {
my %datasrc = %$dsrc;
while ( my ($key, $value) = each(%datasrc)) {
@ -644,29 +744,31 @@ sub print_rootmulti_config {
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 ####
##
=head2 print_root_config
This subroutine prints out the config information for all of the main(root) graphs.
It takes one parameter, $plugin, returns when completed.
$plugin; main(root) graph used for multigraph call
Example: print_root_config($plugin);
=cut
sub print_root_config {
# Lets get our plugin, set our graph reference and our graph config info
my ($plugin) = (@_);
die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};
my $graph = $graphs{$plugin};
my %graphconf = %{$graph->{config}};
# Lets tell munin about the graph we are referencing and print the main config
print "graph memcached_$plugin\n";
while ( my ($key, $value) = each(%graphconf)) {
print "graph_$key $value\n";
}
# Lets tell munin about our data values and how to treat them
foreach my $dsrc (@{$graph->{datasrc}}) {
my %datasrc = %$dsrc;
while ( my ($key, $value) = each(%datasrc)) {
@ -674,46 +776,46 @@ sub print_root_config {
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 ####
##
=head1 Misc Subroutines
These subroutines are misc ones, and are referenced inside of the code. They
should never be called up by Munin.
=head2 fetch_stats
This subroutine fetches the information from memcached and stores it into our
hashes for later referencing throughout the graph. Returns when completed
=cut
sub fetch_stats {
my $s = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port,
);
# Lets try and connect to memcached
my $s = get_conn();
# Die if we can't establish a connection to memcached
die "Error: Unable to Connect to $host\[:$port\]\n" unless $s;
# Lets print the stats command and store the info from the output
print $s "stats\r\n";
while (my $line = <$s>) {
if ($line =~ /STAT\s(.+?)\s(\d+)/) {
if ($line =~ /STAT\s(.+?)\s(.*)/) {
my ($skey,$svalue) = ($1,$2);
$stats{$skey} = $svalue;
}
last if $line =~ /^END/;
}
# Lets print the stats settings command and store the info from the output
print $s "stats settings\r\n";
while (my $line = <$s>) {
if ($line =~ /STAT\s(.+?)\s(\d+)/) {
if ($line =~ /STAT\s(.+?)\s(.*)/) {
my ($skey,$svalue) = ($1,$2);
$stats{$skey} = $svalue;
}
last if $line =~ /^END/;
}
# Lets print the stats slabs command and store the info from the output
print $s "stats slabs\r\n";
while (my $line = <$s>) {
if ($line =~ /STAT\s(\d+):(.+)\s(\d+)/) {
my ($slabid,$slabkey,$slabvalue) = ($1,$2,$3);
@ -721,9 +823,8 @@ sub fetch_stats {
}
last if $line =~ /^END/;
}
# Lets print the stats items command and store the info from the output
print $s "stats items\r\n";
while (my $line = <$s>) {
if ($line =~ /STAT\sitems:(\d+):(.+?)\s(\d+)/) {
my ($itemid,$itemkey,$itemvalue) = ($1,$2,$3);
@ -733,14 +834,23 @@ sub fetch_stats {
}
}
##
#### This subroutine is to help manage the time_scale settings for the graph
##
=head2 time_scale
This subroutine is here for me to adjust the timescale of the time graphs
for last evicted item and age of eldest item in cache.
Please note, after long usage I have noticed these counters may not
be accurate, I believe the developers are aware and have submitted
a patch upstream.
=cut
sub time_scale {
# Lets get our config option and value to adjust
my ($configopt,$origvalue) = (@_);
my $value;
# If config is defined, it returns the config info for time scale
# If data is defined, it returns the original value after its been adjusted
if ($configopt eq 'config') {
if ($timescale == 1) {
$value = "Seconds" . $origvalue;

442
plugins/other/shoutcast2_multi Executable file
View File

@ -0,0 +1,442 @@
#!/usr/bin/perl
#
=head1 Shoutcast 2.0.x Plugin
A Plugin for monitoring a Shoutcast 2.0.x Server (Multigraph)
=head1 Munin Configuration
[shoutcast2_multi]
env.host 127.0.0.1 *default*
env.port 8000 *default*
env.pass changeme *default*
=head2 Munin Configuration Explanation
host = host we are attempting to connection to, can be ip, or hostname
port = port we need to connect to in order to get to admin.cgi
pass = password to use to authenticate as admin user
=head1 AUTHOR
Matt West < https://github.com/mhwest13 >
=head1 License
GPLv2
=head1 Magic Markers
#%# family=auto
#%# capabilities=autoconf
=cut
use strict;
use warnings;
use LWP::UserAgent;
use XML::Simple;
use Munin::Plugin;
need_multigraph();
=head1 Variable Declarations
This section is mainly for importing / declaring our environment variables.
This is were we will import the data from our plugin-conf.d file so we can
override the default settings which will only work for Shoutcast test configs.
=cut
my $host = $ENV{host} || '127.0.0.1';
my $port = $ENV{port} || 8000;
my $pass = $ENV{pass} || 'changeme';
# Initialize hashref for storing results information...
my $dataRef;
# Create a hashref for our graph information that we will call up later...
my $graphsRef;
my $ua = LWP::UserAgent->new();
$ua->agent('Munin Shoutcast Plugin/0.1');
$ua->timeout(5);
$ua->credentials($host.':'.$port, 'Shoutcast Server', 'admin'=>$pass);
=head1 Graphs Declarations
The following section of code contains our graph information. This is the data
provided to Munin, so that it may properly draw our graphs based on the values
the plugin returns.
While you are free to change colors or labels changing the type, min, or max
could cause unfortunate problems with your graphs.
=cut
$graphsRef->{active} = {
config => {
args => '--base 1000 --lower-limit 0',
vlabel => 'Is a DJ Actively Connected?',
category => 'shoutcast2',
title => 'Active States',
info => 'This graph shows us the active state or not, depending on if a DJ is connected',
},
datasrc => [
{ name => 'active', draw => 'AREA', min => '0', max => '1', label => 'On or Off', type => 'GAUGE' },
],
};
$graphsRef->{listeners} = {
config => {
args => '--base 1000 --lower-limit 0',
vlabel => 'Listener Count',
category => 'shoutcast2',
title => 'Listeners',
info => 'This graph shows us the various counts for listener states we are tracking',
},
datasrc => [
{ name => 'maxlisteners', draw => 'STACK', min => '0', label => 'Max Listeners', type => 'GAUGE' },
{ name => 'currlisteners', draw => 'AREA', min => '0', label => 'Current Listeners', type => 'GAUGE' },
],
};
$graphsRef->{sid_active} = {
config => {
args => '--base 1000 --lower-limit 0',
vlabel => 'Is a DJ Actively Connected?',
title => 'Active State',
info => 'This graph shows us the active state or not, depending on if a DJ is connected',
},
datasrc => [
{ name => 'active', draw => 'AREA', min => '0', max => '1', label => 'On or Off', type => 'GAUGE', xmlkey => 'STREAMSTATUS' },
],
};
$graphsRef->{sid_listeners} = {
config => {
args => '--base 1000 --lower-limit 0',
vlabel => 'Listener Count',
title => 'Listeners',
info => 'This graph shows us the various counts for listener states we are tracking',
},
datasrc => [
{ name => 'maxlisteners', draw => 'STACK', min => '0', label => 'Max Listeners', type => 'GAUGE', xmlkey => 'MAXLISTENERS' },
{ name => 'currlisteners', draw => 'AREA', min => '0', label => 'Current Listeners', type => 'GAUGE', xmlkey => 'CURRENTLISTENERS' },
{ name => 'peaklisteners', draw => 'LINE2', min => '0', label => 'Peak Listeners', type => 'GAUGE', xmlkey => 'PEAKLISTENERS' },
{ name => 'uniqlisteners', draw => 'LINE2', min => '0', label => 'Unique Listeners', type => 'GAUGE', xmlkey => 'UNIQUELISTENERS' },
],
};
if (defined($ARGV[0]) && ($ARGV[0] eq 'config')) {
config();
exit;
}
if (defined($ARGV[0]) && ($ARGV[0] eq 'autoconf')) {
check_autoconf();
exit;
}
# I guess we are collecting stats to return, execute main subroutine.
main();
exit;
=head1 Subroutines
The following is a description of what each subroutine is for and does
=head2 main
This subroutine is our main routine should we not be calling up autoconf
or config. Ultimately this routine will print out the values for each graph
and graph data point we are tracking.
=cut
sub main {
my ($returnBit,$adminRef) = fetch_admin_data();
if ($returnBit == 0) {
exit;
}
my $streamConfigRef = $adminRef->{STREAMCONFIGS}->{STREAMCONFIG};
my $sidDataRef;
if ($adminRef->{STREAMCONFIGS}->{TOTALCONFIGS} == 1) {
my $sid = $streamConfigRef->{id};
my ($return,$tmpSidRef) = fetch_sid_data($sid);
if ($return == 0) {
# Only one stream, and we didn't get a good response.
exit;
}
$sidDataRef->{$sid} = $tmpSidRef;
} else {
foreach my $sid (keys %{$streamConfigRef}) {
my ($return,$tmpSidRef) = fetch_sid_data($sid);
if ($return == 0) {
next;
}
$sidDataRef->{$sid} = $tmpSidRef;
}
}
print_active_data($sidDataRef);
print_listener_data($adminRef->{STREAMCONFIGS}->{SERVERMAXLISTENERS}, $sidDataRef);
return;
}
=head2 print_active_data
Thie subroutine prints out the active graph values for each stream and ultimately for
the entire shoutcast service. Should 1 Stream be active, but 5 streams available,
the global graph should show the state as active for the service, but clicking into
that graph, should give you a stream level view of which stream was in use during
what time periods.
=cut
sub print_active_data {
my ($sidDataRef) = (@_);
my $globalActive = 0;
foreach my $sid (sort keys %{$sidDataRef}) {
print "multigraph shoutcast2_active.active_sid_$sid\n";
foreach my $dsrc (@{$graphsRef->{sid_active}->{datasrc}}) {
print "$dsrc->{name}.value $sidDataRef->{$sid}->{$dsrc->{xmlkey}}\n";
if ($sidDataRef->{$sid}->{$dsrc->{xmlkey}} == 1) {
$globalActive = 1;
}
}
}
print "multigraph shoutcast2_active\n";
foreach my $dsrc (@{$graphsRef->{active}->{datasrc}}) {
print "$dsrc->{name}.value $globalActive\n";
}
return;
}
=head2 print_listener_data
This subroutine prints out the listener graph values for each stream and ultimately
adds all of the current users together to show that against the maxserver count in
the global graph. Clicking on the global graph will reveal a bit more information
about the users on a stream by stream basis.
=cut
sub print_listener_data {
my ($maxListeners,$sidDataRef) = (@_);
my $globalListeners = 0;
foreach my $sid (sort keys %{$sidDataRef}) {
print "multigraph shoutcast2_listeners.listeners_sid_$sid\n";
foreach my $dsrc (@{$graphsRef->{sid_listeners}->{datasrc}}) {
print "$dsrc->{name}.value $sidDataRef->{$sid}->{$dsrc->{xmlkey}}\n";
if ($dsrc->{name} eq 'currlisteners') {
$globalListeners += $sidDataRef->{$sid}->{$dsrc->{xmlkey}};
}
}
}
print "multigraph shoutcast2_active\n";
foreach my $dsrc (@{$graphsRef->{listeners}->{datasrc}}) {
if ($dsrc->{name} eq 'maxlisteners') {
print "$dsrc->{name}.value $maxListeners\n";
} else {
print "$dsrc->{name}.value $globalListeners\n";
}
}
return;
}
=head2 config
The config subroutine can be seen as the main config routine, which
will call up to your shoutcast server to figure out how many streams
you have running, and then print out the appropriate multigraph info.
Ultimately this subroutine will call two more routines to print out
the graph args / configuration information.
=cut
sub config {
my ($returnBit,$adminRef) = fetch_admin_data();
if ($returnBit == 0) {
# $adminRef returned a string, we'll just print it out.
print "no (error response: $adminRef)\n";
exit;
}
my $streamConfigRef = $adminRef->{STREAMCONFIGS}->{STREAMCONFIG};
my $sidDataRef;
if ($adminRef->{STREAMCONFIGS}->{TOTALCONFIGS} == 1) {
my $sid = $streamConfigRef->{id};
my ($return,$tmpSidRef) = fetch_sid_data($sid);
if ($return == 0) {
# Only one stream, and we didn't get a good response.
exit;
}
$sidDataRef->{$sid} = $tmpSidRef;
} else {
foreach my $sid (keys %{$streamConfigRef}) {
my ($return,$tmpSidRef) = fetch_sid_data($sid);
if ($return == 0) {
next;
}
$sidDataRef->{$sid} = $tmpSidRef;
}
}
print_active_config($sidDataRef);
print_listener_config($sidDataRef);
return;
}
=head2 print_active_config
This subroutine prints out the graph information for our active graphs.
It prints the sub-multigraphs first based on stream id, and finally the
root active graph. Its not suggested that you mess with this routine
unless you fully understand what its doing and how munin graph_args work.
=cut
sub print_active_config {
my ($sidDataRef) = (@_);
foreach my $sid (sort keys %{$sidDataRef}) {
# Print the Config Info First
print "multigraph shoutcast2_active.active\_sid\_$sid\n";
print "graph_title ".$graphsRef->{sid_active}->{config}->{title}." for StreamID: $sid\n";
print "graph_args ".$graphsRef->{sid_active}->{config}->{args}."\n";
print "graph_vlabel ".$graphsRef->{sid_active}->{config}->{vlabel}."\n";
print "graph_category streamid_$sid\n";
print "graph_info ".$graphsRef->{sid_active}->{config}->{info}."\n";
# Print the Data Value Info
foreach my $dsrc (@{$graphsRef->{sid_active}->{datasrc}}) {
while ( my ($key, $value) = each (%{$dsrc})) {
next if ($key eq 'name');
next if ($key eq 'xmlkey');
print "$dsrc->{name}.$key $value\n";
}
}
}
print "multigraph shoutcast2_active\n";
print "graph_title ".$graphsRef->{active}->{config}->{title}."\n";
print "graph_args ".$graphsRef->{active}->{config}->{args}."\n";
print "graph_vlabel ".$graphsRef->{active}->{config}->{vlabel}."\n";
print "graph_category ".$graphsRef->{active}->{config}->{category}."\n";
print "graph_info ".$graphsRef->{active}->{config}->{info}."\n";
# Print the Data Value Info
foreach my $dsrc (@{$graphsRef->{active}->{datasrc}}) {
while ( my ($key, $value) = each (%{$dsrc})) {
next if ($key eq 'name');
print "$dsrc->{name}.$key $value\n";
}
}
return;
}
=head2 print_listener_config
This subroutine prints out the graph information for our listeners graphs.
It prints the sub-multigraphs first based on stream id, and finally the
root listeners graph. Its not suggested that you mess with this routine
unless you fully understand what its doing and how munin graph_args work.
=cut
sub print_listener_config {
my ($sidDataRef) = (@_);
foreach my $sid (sort keys %{$sidDataRef}) {
# Print the Config Info First
print "multigraph shoutcast2_listeners.listeners\_sid\_$sid\n";
print "graph_title ".$graphsRef->{sid_listeners}->{config}->{title}." for StreamID: $sid\n";
print "graph_args ".$graphsRef->{sid_listeners}->{config}->{args}."\n";
print "graph_vlabel ".$graphsRef->{sid_listeners}->{config}->{vlabel}."\n";
print "graph_category streamid_$sid\n";
print "graph_info ".$graphsRef->{sid_listeners}->{config}->{info}."\n";
# Print the Data Value Info
foreach my $dsrc (@{$graphsRef->{sid_listeners}->{datasrc}}) {
while ( my ($key, $value) = each (%{$dsrc})) {
next if ($key eq 'name');
next if ($key eq 'xmlkey');
print "$dsrc->{name}.$key $value\n";
}
}
}
print "multigraph shoutcast2_listeners\n";
print "graph_title ".$graphsRef->{listeners}->{config}->{title}."\n";
print "graph_args ".$graphsRef->{listeners}->{config}->{args}."\n";
print "graph_vlabel ".$graphsRef->{listeners}->{config}->{vlabel}."\n";
print "graph_category ".$graphsRef->{listeners}->{config}->{category}."\n";
print "graph_info ".$graphsRef->{listeners}->{config}->{info}."\n";
# Print the Data Value Info
foreach my $dsrc (@{$graphsRef->{listeners}->{datasrc}}) {
while ( my ($key, $value) = each (%{$dsrc})) {
next if ($key eq 'name');
print "$dsrc->{name}.$key $value\n";
}
}
return;
}
=head2 check_autoconf
This subroutine is called up when we intercept autoconf specified in ARGV[0]
If we are able to connect to the shoutcast service as admin and fetch the main
admin stats page, we will return ok, otherwise we will return no and the error
response we got from LWP::UserAgent.
=cut
sub check_autoconf {
my ($returnBit,$adminRef) = fetch_admin_data();
if ($returnBit == 0) {
# $adminRef returned a string, we'll just print it out.
print "no (error response: $adminRef)\n";
} else {
print "yes\n";
}
return;
}
=head2 fetch_sid_data
This subroutine is called up to fetch information on a per stream mentality.
If we are able to connect to the shoutcast service and get the stats we will
return 1 and a hashref of the de-coded xml information, otherwise we return 0
so that we know that we have failed and can handle it gracefully.
=cut
sub fetch_sid_data {
my ($sid) = (@_);
my $url = 'http://'.$host.':'.$port.'/stats?sid='.$sid;
my $response = $ua->get($url);
if ($response->is_success) {
my $returnRef = XMLin($response->decoded_content);
return (1, $returnRef);
} else {
return (0, $response->status_line);
}
}
=head2 fetch_admin_data
This subroutine is called up to fetch information from the admin page to get stream ids.
This subroutine is also used to test that we can connect to the shoutcast service
and if not we can fail gracefully. If we are able to connect to the shoutcast service
and get the stats we will return 1 and a hashref of the de-coded xml information,
otherwise we return 0 so that we know that we have failed and can handle it gracefully.
=cut
sub fetch_admin_data {
my $url = 'http://'.$host.':'.$port.'/admin.cgi?sid=1&mode=viewxml&page=6';
my $response = $ua->get($url);
if ($response->is_success) {
my $returnRef = XMLin($response->decoded_content);
if (($returnRef->{STREAMCONFIGS}->{TOTALCONFIGS} > 0) && (defined($returnRef->{STREAMCONFIGS}->{STREAMCONFIG}))) {
return (1, $returnRef);
} else {
return (0, 'Unable to Detect any Stream Configurations');
}
} else {
return (0, $response->status_line);
}
}