#!/usr/bin/perl -w
 
#*----------------------------------------------------------------------------*/
#* Xymon client message processor.                                           */
#*                                                                            */
#* This perl program shows how to create a server-side module using the       */
#* data sent by the Xymon clients. This program is fed data from the         */
#* Xymon "client" channel via the hobbitd_channel program; each client       */
#* message is processed by looking at the [who] section and generates         */
#* a "login" status that goes red when an active "root" login is found.       */
#*                                                                            */
#* Written 2007-Jan-28 by Henrik Storner <user-ce4a2c883f75@xymon.invalid>                     */
#*                                                                            */
#* This program is in the public domain, and may be used freely for           */
#* creating your own Xymon server-side modules.                              */
#*                                                                            */
#*----------------------------------------------------------------------------*/
#
# add to hobbitlaunch.cfg
#[client-check]
#	ENVFILE /usr/lib/hobbit/server/etc/hobbitserver.cfg
#	NEEDS hobbitd
#	CMD hobbitd_channel --channel=client --log=$BBSERVERLOGS/rootlogin.log $BBHOME/ext/client-check.pl

 
# $Id: client-check.pl,v 1.1 2007/01/28 12:42:34 henrik Exp $
 
use strict;
use lib "/usr/lib/hobbit/server/ext";
use BigBrother;

 
my $bb;
my $bbdisp;
 
my $hostname = "";
my $clientip = "";
my $clientname = "";
my $clientos = "";
my $msgtxt = "";
my %sections = ();
my $cursection = "";
 
my $debug=0;
my $ipsubre = qr/\d|\d\d|1\d\d|2[0-4]\d|25[0-5]/;
my $ipre = qr/$ipsubre\.$ipsubre\.$ipsubre\.$ipsubre/;
$|=1;
 
# Get the BB and BBDISP environment settings.
$bb = $ENV{"BB"} || die "BB not defined";
$bbdisp = $ENV{"BBDISP"} || die "BBDISP not defined";

for(my $i=0; $i<=$#ARGV; $i++) {
  if($ARGV[$i] =~ /^-(d|-debug)$/) {
    $debug++;
  } elsif($i=$#ARGV) {
    $debug ||= 1;
    $clientname=$ARGV[$i];
  }
}
 
 
if($clientname ne "") {
  open CL,"bb logmon \'clientlog $clientname\'|";
  $hostname = $clientname;
  $clientip = BigBrother->HostIP($hostname);
  warn "DBG: using clientlog for $hostname ($clientip)\n" if $debug;
} else {
  open CL,"/dev/stdin";
}
# Main routine. 
#
# This reads client messages from <CL>, looking for the
# delimiters that separate each message, and also looking for the
# section markers that delimit each part of the client message.
# When a message is complete, the processmessage() subroutine
# is invoked. $msgtxt contains the complete message, and the
# %sections hash contains the individual sections of the client 
# message.
 
while (my $line = <CL>) {
	if ($line =~ /^\@\@client\#/) {
		# It's the start of a new client message - the header looks like this:
		# @@client#830759/HOSTNAME|1169985951.340108|10.60.65.152|HOSTNAME|sunos|sunos
 
		# Grab the hostname field from the header
		my @hdrfields = split(/\|/, $line);
		$hostname = $hdrfields[3];
		$hostname =~ s/,/./g;
		#$clientip = $hdrfields[2];
		BigBrother->import; # if don't do this, won't see changes....
		$clientip = BigBrother->HostIP($hostname);
		warn "DBG: processing $hostname ($clientip)\n" if $debug;
 
		# Clear the variables we use to store the message in
		$msgtxt = "";
		%sections = ();
		$cursection = ""; # none found yet!
                $clientname = "";
                $clientos = "";
	}
	elsif ($line =~ /^\@\@/) {
		# End of a message. Do something with it.
		whoCheck();
		netCheck();
		memCheck();
	}
	elsif ($line =~ /^\[(.+)\]/) {
		# Start of new message section.
 
		$cursection = $1;
		$sections{ $cursection } = "\n";
	}
	elsif ($line =~ /^client\s+\S+\.([^.]+)\s+(\w+)/) {
		# client header
		#   client esxsv01,ausport,gov,au.linux linux
		#   client sa01sv1.ausport.gov.au.bbwin win32

		$msgtxt .= $line;
 
                $clientname = $1;
                $clientos = $2;
		warn "DBG: clientID $clientname ($clientos)\n" if $debug;
	}
	else {
		# Add another line to the entire message text variable,
		# and the the current section.
		$msgtxt .= $line;
		if($cursection) {
			$sections{ $cursection } .= $line;
		} else {
			my $time = scalar localtime;
			warn "$time client-check: no current section for client $hostname\n$line";
		}
	}
}
# End of a message. Do something with it. Will only get here using clientlog (we hope)
whoCheck();
netCheck();
memCheck();
 
sub report {
 
	my($hostname, $hobbitcolumn, $color, $summary, $statusmsg) = @_;
	# Build the command we use to send a status to the Xymon daemon
	my $cmd = $bb . " " . $bbdisp . " \"status " . $hostname . "." . $hobbitcolumn . " " . $color . " " . $summary . "\n\n" . $statusmsg . "\"";
 
	if($debug) {
	  print "$cmd\n\n";
	} else {
	# And send the message
	  system $cmd;
	}
}

# This subroutine processes the client message. In this case,
# we watch the [who] section of the client message and alert
# if there is a root login active.
 
sub whoCheck {
	my $color;
	my $summary;
	my $statusmsg;
	my $sec = "who";
	my $hobbitcolumn = "who";
 
	# Dont do anything unless we have the "who" section
	return unless ( $sections{$sec} );
 
	# Is there a "root" login somewhere in the "who" section?
	# Note that we must match with /m because there are multiple
	# lines in the [who] section.
	if ( $sections{$sec} =~ /^root /m ) {
		$color = "yellow";
		$summary = "ROOT login active";
		$statusmsg = "&yellow ROOT login detected!\n\n" . $sections{$sec};
	}
	else {
		$color = "green";
		$summary = "OK";
		$statusmsg = "&green No root login active\n\n" . $sections{$sec};
	}
	report($hostname, $hobbitcolumn, $color, $summary, $statusmsg);
}

# This subroutine processes the client message. In this case,
# we watch the [route] section of the client message and alert
# if the default route is incorrect
 
sub netCheck {
	my $color;
	my $summary;
	my $statusmsg;
	my $sec = "route";
	my $hobbitcolumn = "route";
 
	# Dont do anything unless we have the "route" section
	return unless ( $sections{$sec} );
 
	# Is there a default gateway somewhere in the "route" section?
	# Note that we must match with /m because there are multiple
	# lines
	$color = "green";
	$summary = "OK";
	$statusmsg = "&green Default route OK\n\n" . $sections{$sec};
	#darwin form:
	# default            10.1.0.190         UGSc        6       91    en0
	# 10.1/16            link#4             UCS        40        0    en0
	# 10.1.0.1           0:12:1e:ae:ce:87   UHLW        0        0    en0   1196
	
	if ( $sections{$sec} =~ /^(?:0\.0\.0\.0|default)\s+($ipre)\s+($ipre|\w+)\s+(\S+)\s/m ) {
		my $gw = ($clientname eq "bbwin") ? $2 : $1;
		my $sm = ($clientname eq "bbwin") ? $1 : $2;
		warn "DBG: netCheck $hostname ($clientip) GW: $gw SM: $sm\n" if $debug;
		my $isok = 1;
		if( $gw =~ /^(.*)\.1$/) {
		        my $net = $1;
			$isok = 0 unless $clientip =~ /^$net/;
		}
		if(!$isok) {
			$color = "red";
			$summary = "Bad default route $gw for $clientip found";
			$statusmsg = "&red Bad default route $gw for $clientip found\n\n" . $sections{$sec};
		}
	} else {
		$color = "red";
		$summary = "Error";
		$statusmsg = "&red No default route found\n\n" . $sections{$sec};
	}
 
	report($hostname, $hobbitcolumn, $color, $summary, $statusmsg);
}

# This subroutine processes the client message. In this case,
# we watch the [free] section of the client message and alert
# if the machine is an ESX server and the physical memory size is not 800MB
 
sub memCheck {
	my $color;
	my $summary;
	my $statusmsg;
	my $sec = "free";
	my $hobbitcolumn = "pmem";
	my $min = 799000;
 
	# Dont do anything unless we have the "free" section
	return unless ( $sections{$sec} && $hostname =~ /^esx/ );
 
	# Get the Mem: line
	# Note that we must match with /m because there are multiple
	# lines
	$color = "green";
	$summary = "OK";
	
	if ( $sections{$sec} =~ /^Mem:\s+(\d+)\s+(\d+)\s+(\d+)\s/m ) {
		my $tot = $1;
	        $statusmsg = sprintf("&green memory allocation %dMB OK (at least %dMB)\n\n",$tot/1024,$min/1024) . $sections{$sec};
		warn "DBG: memCheck $hostname ($clientip) PhysMEM: $tot\n" if $debug;
		my $isok = $tot > $min;
		if(!$isok) {
			$color = "red";
			$summary = sprintf("Bad memory allocation %dMB for %s found (require at least %dMB)",$tot/1024,$hostname,$min/1024);
			$statusmsg = "&red ". sprintf("Bad memory allocation %dMB for %s found (require at least %dMB)\n\n",$tot/1024,$hostname,$min/1024) . $sections{$sec};
		}
	} else {
		$color = "red";
		$summary = "Error";
		$statusmsg = "&red No Mem: line found\n\n" . $sections{$sec};
	}
 
	report($hostname, $hobbitcolumn, $color, $summary, $statusmsg);
}