#!/usr/bin/perl
# -*- perl -*-

=head1 NAME

bind9 - Plugin to collect statistics from Internet Systems Consortium BIND daemon

=head1 CONFIGURATION

The following environment variables are used by this plugin

 HOST     - Hostname bind9 statchannel listens at
 PORT     - Port bind9 statchannel listens at
 ANYWARN  - Warning level for type ANY queries
 ANYCRIT  - Critical level for type ANY queries
 VIEWS    - The names of the views to use. Defaults to autodiscovery. (comma separated values)
 MASTERZONES
          - The names of the zones for the "answered per zone" graph. Comma-separated.
            Defaults to autodetect. Autodetect will graph all zones with a serial number of
            at least 100. Set to "none" to disable that graph altogether.
 XML_SIMPLE_PREFERRED_PARSER
          - tells XML::Simple which parser to use. If XML::SAX is installed, XML::Simple
            will default to that, and it is EXTREMELY sluggish.
            so we default to XML::Parser. You can override that default choice by setting
            the environment variable (e.g. back to XML::SAX if XML::Parser isn't installed).

=head1 USAGE

=head1 APPLICABLE SYSTEMS

BIND v9.5+ with statistics-channels API.

=head1 AUTHOR

George Kargiotakis 

Original Author:
Andrew Duquette - Clearcable Networks 

=head1 CHANGES

Use STACK instead of just AREA for some graphs
Add warning and critical levels for type ANY queries
Raise timeout to 300 seconds
Add sorting to stacked graphs so they are a bit more readable/comparable
Add autodiscovery of views
Change hardcoded per second period with ${graph_period}
Don't display graphs with no data
Better stacking of graphs

=head1 LICENSE

MIT license

=head1 MAGIC MARKERS

 #%# family=manual
 #%# capabilities=autoconf

=cut

use strict;
use warnings;
use 5.010;
use LWP::UserAgent; #libwww-perl
use XML::Simple; #libxml-simple-perl
#use Net::INET6Glue::INET_is_INET6; #libnet-inet6glue-perl (requires Debian 6+)

my $HOST = $ENV{'HOST'} || "localhost";
my $PORT = $ENV{'PORT'} || "8053";
# check for defined views from the config
my @VIEWS;
# Backwards compatibility with older syntax
if (defined $ENV{'VIEW'}) {
	@VIEWS = split(/,/,$ENV{'VIEW'});
} elsif (defined $ENV{'VIEWS'}) {
	@VIEWS = split(/,/,$ENV{'VIEWS'});
}
unless (defined($ENV{'XML_SIMPLE_PREFERRED_PARSER'})) {
  $ENV{'XML_SIMPLE_PREFERRED_PARSER'} = 'XML::Parser';
}
# check for defined zones from config
my @MASTERZONES;
if (defined($ENV{'MASTERZONES'})) {
	@MASTERZONES = split(/,/, $ENV{'MASTERZONES'});
}

#raise warnings in case of flood of ANY queries
my $anywarn = $ENV{'ANYWARN'} || "10";
my $anycrit = $ENV{'ANYCRIT'} || "50";

#hack to make STACK
my %graph;
$graph{'cache_db_rrsets'}{'count'}=0;
$graph{'queries_in'}{'count'}=0;
$graph{'queries_out'}{'count'}=0;
my $count=0;

my $url = "http://$HOST:$PORT/";
my $browser = LWP::UserAgent->new;
$browser->timeout(300);
my $request = new HTTP::Request 'GET' => $url;

if (defined $ARGV[0] and $ARGV[0] eq 'autoconf') {
	if($browser->request($request)) {
		print "yes\n";
	}
	else {
		print "no (Unable to contact web api at $url)\n";
	}
	exit;
}

my $response = $browser->request($request) or die "Unable to connect to server.\n";

#Do some pre-processing to fix an issue where one cache entry in memory contexts was dropped
my $content = $response->content;
$content=~ s/name>cachecache1XMLin($content) or die "Unable to parse XML.\n";

# If there aren't any views defined at the config, proceed to autodiscovery
my $count_views = @VIEWS;
if ($count_views == 0) {
	# Find all views defined in XML
	foreach my $view_name (keys %{$datain->{bind}{statistics}{views}{view}}) {
		push (@VIEWS,$view_name) unless $view_name eq '_bind';
	}
}
if (int(@MASTERZONES) == 0) { # Autodetect all zones for which we are authoritative
	foreach my $view_name (@VIEWS) {
		foreach my $zonename (keys(%{$datain->{bind}{statistics}{views}{view}{$view_name}{zones}{zone}})) {
			my $zoneserial = $datain->{bind}{statistics}{views}{view}{$view_name}{zones}{zone}{$zonename}{serial};
			unless ($zoneserial >= 100) { next; } # Those are usually dummy zones
			my $statsval = $datain->{bind}{statistics}{views}{view}{$view_name}{zones}{zone}{$zonename}{counters}{QryAuthAns};
			unless (defined($statsval)) { next; } # No stats available in this bind version
			if (grep(/^$zonename$/, @MASTERZONES)) { next; }
			push(@MASTERZONES, $zonename);
		}
	}
} else {
	for (my $i = 0; $i < @MASTERZONES; $i++) {
		$MASTERZONES[$i] .= '/IN' unless ($MASTERZONES[$i] =~ m!/!);
	}
	if ($MASTERZONES[0] eq 'none/IN') {
		@MASTERZONES = ();
	}
}

# Graph Configuration
#
# title: title of graph
# args: arguments for the graph
# vlabel: Vertical label
# location: location of data within retrieved xml in perl format
# fields: if defined, only the listed fields will be graphed
# config: if defined, configures fields for the entire graph based on settings
# fieldconf: like config, but for individual fields

my $graphs = {
	'queries_in' =>
	{
		'title'		=> 'Queries In',
		'args'		=> '-l 0',
		'vlabel'	=> "Queries / \${graph_period}",
		'location'	=> $datain->{bind}{statistics}{server}{'queries-in'}{rdtype},
		'config'	=> { 'type' => 'DERIVE', 'min' => 0, 'draw' => 'AREA', },
		'fieldconf'	=> { 'ANY' => { 'info' => 'ANY queries', 'type' => 'DERIVE', 'min' => 0, 'draw' => 'AREA', 'warning' => "$anywarn", 'critical' => "$anycrit"}, },
	},
	'memory_usage_summary' =>
	{
		'title'		=> 'Memory Usage Summary',
		'args'		=> '-l 0 --base 1024',
		'vlabel'	=> 'Memory in Use',
		'location'	=> $datain->{bind}{statistics}{memory}{summary},
		'fieldconf'	=> { 'TotalUse' => { 'type' => 'DERIVE', 'min' => 0, }, },
	},
	'server_statistics' =>
	{
		'title'		=> 'Server Statistics',
		'args'		=> '-l 0',
		'vlabel'	=> "Usage (Queries / \${graph_period})",
		'location'	=> $datain->{bind}{statistics}{server}{nsstat},
		'fields'	=> [qw(QryRecursion QryNxrrset Requestv4 Requestv6 Response QrySuccess QryAuthAns QryNoauthAns QryNXDOMAIN RespEDNS0)],
		'config'	=> {'type' => 'DERIVE', 'min' => 0, },
	},
	'socket_io_statistics' =>
	{
		'title'		=> 'Socket I/O Statistics',
		'args'		=> '-l 0',
		'vlabel'	=> 'Derived Count',
		'location'	=> $datain->{bind}{statistics}{server}{sockstat},
		'config'	=> { 'type' => 'DERIVE', 'min' => 0, },
		'fields'	=> [qw(UDP4Open UDP6Open TCP4Open TCP6Open UDP4Close UDP6Close TCP4Close TCP6Close UDP4Conn UDP6Conn TCP4Conn TCP6Conn TCP4Accept TCP6Accept TCP6SendErr UDP4RecvErr UDP6RecvErr TCP4RecvErr TCP6RecvErr)],
	},
	'tasks' =>
	{
		'title'		=> 'Tasks',
		'args'		=> '-l 0',
		'vlabel'	=> 'Tasks',
		'location'	=> $datain->{bind}{statistics}{taskmgr}{tasks}{task},
	},
	'memory_contexts' =>
	{
		'title'		=> 'Memory Context "In Use"',
		'args'		=> '-l 0 --base 1024',
		'vlabel'	=> 'Memory Used',
		'location'	=> $datain->{bind}{statistics}{memory}{contexts}{context},
	},
};

# Dynamic graphs based on views
# Create a new hash for each view and merge them later on
my %graphs_dyn;
my %merged;
foreach my $view_name (@VIEWS) {
	%graphs_dyn = (
		"queries_out_${view_name}" =>
			{
				'title'		=> "Queries Out ${view_name}",
				'args'		=> '-l 0',
				'vlabel'	=> "Queries / \${graph_period}",
				'location'	=> $datain->{bind}{statistics}{views}{view}{$view_name}{rdtype},
				'config'	=> { 'type' => 'DERIVE', 'min' => 0, 'draw' => 'AREA', },
			},
		"resolver_statistics_${view_name}" =>
			{
				'title'		=> "Resolver Statistics for View ${view_name}",
				'args'		=> '-l 0',
				'vlabel'	=> 'Derived Count',
				'location'	=> $datain->{bind}{statistics}{views}{view}{$view_name}{resstat},
				'config'	=> { 'type' => 'DERIVE', 'min' => 0, },
				'fields'	=> [qw(Queryv4 Queryv6 Responsev4 Responsev6 NXDOMAIN SERVFAIL FORMERR OtherError EDNS0Fail Lame Retry QueryTimeout GlueFetchv4 GlueFetchv6 GlueFetchv4Fail GlueFetchv6Fail ValAttempt ValOk ValNegOk QryRTT10 QryRTT100 QryRTT500 QryRTT800 QryRTT1600 QryRTT1600+)],
			},
		#This graph should be split into two - one for negative cache and the other for positive cache
		"cache_db_rrsets_${view_name}" =>
		{
			'title'		=> "Cache DB RRsets for View ${view_name}",
			'args'		=> '-l 0',
			'vlabel'	=> 'Derived Count',
			'location'	=> $datain->{bind}{statistics}{views}{view}{$view_name}{cache}{rrset},
			'config'	=> { 'draw' => 'AREA' },
			'fields'	=> [qw(A !A AAAA !AAAA DLV !DLV DS !DS MX !MX NS NSEC CNAME PTR RRSIG DNSKEY TXT NXDOMAIN)],
		},
		"masterzone_reqs_${view_name}" =>
		{
			'title'		=> "Authoritatively answered queries per zone for View ${view_name}",
			'args'		=> '-l 0',
			'vlabel'	=> "Queries / \${graph_period}",
			'location'	=> ((@MASTERZONES > 0)
			                    ? $datain->{bind}{statistics}{views}{view}{$view_name}{zones}{zone}
			                    : undef),
			'config'	=> { 'type' => 'DERIVE', 'min' => 0, 'draw' => 'AREA' },
		},
	);
	# Merge new dynamic hash of this view
	%merged = (%merged, %graphs_dyn);
}

# Merge all hashes, static and dynamic
%{$graphs} = (%{$graphs}, %merged);

if (defined $ARGV[0] and $ARGV[0] eq 'config') {
	foreach my $graph_name (sort keys %{$graphs}) {
		my $data_type = get_datatype($graph_name);
		if ($data_type) {
			print "multigraph ".$graph_name."\n";
			print "graph_title ".$graphs->{$graph_name}{title}."\n";
			print "graph_args ".$graphs->{$graph_name}{args}."\n";
			print "graph_vlabel ".$graphs->{$graph_name}{vlabel}."\n";
			print "graph_category bind\n";

			#Value configuration
			config_fields($graph_name);
			print "\n";
		}

	}
	exit;
}

foreach my $graph_name (sort keys %{$graphs}) {
	my $data_type = get_datatype($graph_name);
	if ($data_type) {
		print "multigraph $graph_name\n";
		format_output($graph_name, $data_type);
		print "\n";
	}
}

#Function grabs and prints all fields/values for a graph and outputs them based on configuration
sub format_output {
	my $graphname = $_[0];
	my $datatype = $_[1];
	my %values = get_values($graphname, $datatype);
	my @list = @{$graphs->{$graphname}{fields}} if defined $graphs->{$graphname}{fields};
	if (!@list) {
		while (my ($field,$value) = each %values) {
			print(getcleanfieldname($field) . ".value $value\n");
		}
	} else {
		foreach my $field (@list) {
			my $v = 0;
			if (defined($values{$field})) { $v = $values{$field}; }
			print(getcleanfieldname($field) . ".value $v\n");
		}
	}
}

#Configure value settings based on graph/variable config. fieldconf overrides config values
sub config_fields {
	my $graphname = $_[0];
	my $datatype = get_datatype($graphname);
	my %fields = get_values($graphname, $datatype);
	my @list = @{$graphs->{$graphname}{fields}} if defined $graphs->{$graphname}{fields};
	if(!@list) {
		foreach my $field (sort keys %fields) {
			checkconf($graphname, $field);
		}
	}
	else {
		for(my $i=0;$i{$graphname}{fieldconf}{$field}) {
		while (my ($cfield, $cvalue) = each(%{${$graphs}{$graphname}{fieldconf}{$field}})) {
            if ("$cvalue" eq "AREA") {
                if (defined $graph{$graphname}{'count'}) {
                    $count = $graph{$graphname}{'count'};
                    $count++;
                    $graph{$graphname}{'count'} = $count;
                } else {
                    $graph{$graphname}{'count'} = 1;
                }
            }
            if (defined $graph{$graphname}{'count'} && $graph{$graphname}{'count'} > 1) {
                if ("$cvalue" eq "AREA") {
                    $cvalue = 'STACK';
                }
            }
			print "$cleanfieldname.$cfield $cvalue\n";
		}
	}
	#Configure fields based on graph config
	elsif (defined %{${$graphs}{$graphname}{config}}) {
		while (my ($dfield, $dvalue) = each(%{${$graphs}{$graphname}{config}})) {
			if ("$dvalue" eq "AREA") {
				if (defined $graph{$graphname}{'count'}) {
					$count = $graph{$graphname}{'count'};
					$count++;
					$graph{$graphname}{'count'} = $count;
				} else {
					$graph{$graphname}{'count'} = 1;
				}
			}
			if (defined $graph{$graphname}{'count'} && $graph{$graphname}{'count'} > 1) {
				if ("$dvalue" eq "AREA") {
					$dvalue = 'STACK';
				}
			}
			print "$cleanfieldname.$dfield $dvalue\n";
		}
	}
}

# Grab graph fields, respecting 'fields' in graph config if it's defined
sub get_fields {
	my $graphname = $_[0];
	my $datatype = $_[1];
	my @keys = sort keys %{${$graphs}{$graphname}{location}};
	my @fields;
	if(defined $graphs->{$graphname}{fields}) {
		for(my $count=0;$count < scalar(@keys);$count++) {
			foreach my $dfield (@{${$graphs}{$graphname}{fields}}) {
				if($dfield eq $keys[$count]) { push(@fields, $keys[$count]); }
			}
		}
	}
	else { @fields = @keys; }
	return(@fields);
}

# Grab values, and operate on them based on graph type
sub get_values {
	my $graphname = $_[0];
	my $datatype = $_[1];
	my %values;
	my @keys = get_fields($graphname);
	given($datatype) {
		when("counter") {
			foreach my $key (sort @keys) {
				while (my ($dkey, $value) = each (%{${$graphs}{$graphname}{location}{$key}})) {
					$values{$key}=$value;
				}
			}
		}
		when("normal") {
			while (my ($key, $value) = each %{${$graphs}{$graphname}{location}}) {
				$values{$key}=$value;
			}
		}
		when("tasks") {
			my @keys = get_fields($graphname);
			my @tasknames;
			my ($nocount, $count) = 0;
			foreach my $key (@keys) {
				$nocount=0;
				$key =~ s/^(\D+)\d+$/$1/;
				foreach my $tname (@tasknames) {
					if($tname eq $key) {
						$nocount = 1;
					}
				}
				if($nocount eq 0) {
					push(@tasknames, $key);
					$count++;
				}
			}
			$values{tasks}=$count;
		}
		when("memory") {
			foreach my $key (@keys) {
				my $inuse = $graphs->{$graphname}{location}{$key}{inuse};
				$key =~ s/^([A-Z]+)\d+$/$1/i;
				if(!defined $values{$key}) {
					$values{$key}=$inuse;
				}
				else {
					$values{$key}+=$inuse;
				}
			}
		}
		when("masterzonestats") {
			foreach my $zone (@MASTERZONES) {
				my $zcnt = $graphs->{$graphname}{location}{$zone}{counters}{QryAuthAns};
				next unless defined($zcnt);
				$zone =~ s!/IN$!!g;
				$values{$zone} = $zcnt;
			}
		}
	}
	return(%values);
}

sub get_datatype {
	my $graphname = $_[0];
	my @values = values %{${$graphs}{$graphname}{location}};
	foreach my $type (@values) {
		if ($type =~ /^[0-9]+$/) {
			return("normal");
		}
		else {
			my @keys = keys %{$type};
			foreach my $key (@keys) {
				if($key eq 'counter') {
					return ("counter");
				}
				elsif($key eq 'inuse') {
					return("memory");
				}
				elsif($key eq 'quantum') {
					return("tasks");
				}
				elsif($key eq 'serial') {
					return("masterzonestats");
				}
			}
		}
	}
}

# This helper function cleans (replaces) fieldnames so that they
# do not contain characters that are NOT tolerable in munin fieldnames.
sub getcleanfieldname {
  my $res = $_[0];
  $res =~ s/[\.\/]/_/g;
  return $res;
}