[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [hobbit] BBwin (who test)



Derek,
> I was wondering if anyone has tried to use the 'who' test to see if anyone
> is logged on and if someone is logged on have the test go yellow?
>
> I am looking at doing this and instead of trying to re-invent the wheel i
> was wondering if anyone has tried/or did this already?
>
>   
I have done it using a client channel test based on Henrik's template,
which can be extended for various other functionality - I've put some
stuff in there for checking whether the client has a default gateway on
.1 (this bit me once with a host with static IP but gateway coming - or
not - from DHCP), and also a check for amount of memory allocated to the
service console on an ESX host.

You need the following in ~hobbit/server/etc/hobbitlaunch.cfg

|#
# script that checks incoming "client" messages for various conditions
#
[client-check]
       ENVFILE /usr/lib/hobbit/server/etc/hobbitserver.cfg
       NEEDS hobbitd
       CMD hobbitd_channel --channel=client
--log=$BBSERVERLOGS/client-check.log $BBHOME/ext/client-check.pl

|The client-check.pl script attached sits in the ext directory. It uses
the hacked version of BigBrother.pm (also attached). It was originally
from deadcat but I've tweaked it a bit - there's also some ancient
history in there no longer relevant to xymon. Really need a
Xymon::Client module that Buchan suggested.

David.

-- 
David Baldwin - IT Unit
Australian Sports Commission          www.ausport.gov.au
Tel 02 62147830 Fax 02 62141830       PO Box 176 Belconnen ACT 2616
david.baldwin (at) ausport.gov.au          Leverrier Street Bruce ACT 2617


-------------------------------------------------------------------------------------
Keep up to date with what's happening in Australian sport visit http://www.ausport.gov.au

This message is intended for the addressee named and may contain confidential and privileged information. If you are not the intended recipient please note that any form of distribution, copying or use of this communication or the information in it is strictly prohibited and may be unlawful. If you receive this message in error, please delete it and notify the sender.
-------------------------------------------------------------------------------------
package BigBrother;

use 5.008005;
use strict 'subs';
use strict 'vars';
use warnings;

require Exporter;
#use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use BigBrother ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = '0.01';


=pod
=head1 NAME

BigBrother - Perl extension to simplify writing Big Brother external scripts in PERL.

=head1 SYNOPSIS

  use BigBrother;

  BigBrother->import();

  test stuff...

  BigBrother->Report($HostName,$function,$color,$status);

=head1 DESCRIPTION

Requires: $BBHOME environment variable to be set

=head2 EXPORT

None by default.



=head2 Methods

=over 12

=item import()

This function imports the BigBrother environment referenced using $ENV{BBHOME}

=cut

my(%bbhosts,%bbhost,%bbhostsIP,%positional,%bbitems,%parms);
my(%fromtime,%tilltime);

sub import {
	my ($caller_package)=caller;
	#print "BBHOME: $ENV{BBHOME}\n";
	if (!exists $ENV{BBHOME}) {
		my($work,$script)=$0=~/(.*?)\/?([^\/]*)$/;	# now strip out the dir and our name
		$work="$work/../";				# we assume a subdir of BBHOME
		chomp(my $dir=`pwd`);				# change to BBHOME
		chdir($work);					#   to get
		chomp($work=`pwd`);				#   the real dir name
		$ENV{BBHOME}=$work;				# now set BBHOME to something real
		chdir($dir);					# and retunr to our dir
	}
	my $BBHOME=$ENV{BBHOME};
        #warn "BBHOME: $ENV{BBHOME}\n";
        #printf "Running $0 at %s\n",scalar localtime;
	if (!exists $ENV{BBTMP}) {				# only run if not set
		foreach (`sh -c 'cd $BBHOME;. /etc/hobbit/hobbitserver.cfg;set'`) {
			chomp;						# drop EOL
			if(my ($var,$val)=/^\s*(.*?)\s*=\s*(.*)/) {	# get var and value
				$ENV{$var}=$val unless $var eq "SHELLOPTS";	# and set
			}
		}
	}
	foreach my $env_key (keys %ENV) {
		next if ($env_key=~/^\s*$/sig);
		*{"${caller_package}::${env_key}"}=\$ENV{$env_key};
	}
	if( -x "$BBHOME/bin/bbhostshow") {
	    open(IN,"$BBHOME/bin/bbhostshow|");		# run bbhostshow (handles includes)
	} else {
	    open(IN,"$ENV{BBHOSTS}");			# open bb-hosts - better than nothing...
	}
	foreach (<IN>) {				# read contents
		chomp;					# trim EOL
		next if (/^\s*#/);			# Skip comments
		my($ip,$host,$pound,@parms)=split;	# Split into pieces
		my $name=lc($host);			# force lower case to make finding easier
		next unless (defined $pound && $pound eq '#');		# Skip if token 3 isn't a '#'
		foreach my $parm (@parms) {		# Process all the parms
			$bbhosts{"$name~$parm"}=$parm;	# and store as keys in %bbhosts "$name~$parm"
			$bbhost{"$name~$parm"}=$host;	# and store as keys in %bbhost "$name~$parm"
			$bbhostsIP{$name}=$ip unless $ip =~ /^0+\.0+\.0+\.0+$/;	# and store as keys in %bbhostsIP "$ip~$parm"
		}
	}
	close(IN);					# and close
	foreach my $key (keys %bbhosts) {			# We also need to parse parms
		my($host,$function,$parms);
		if (($host,$function,$parms)=$key=~/^(.*)~(\w+)\((.*)\)/) {
		} elsif (($host,$function,$parms)=$key=~/^(.*)~(\w+)=(.*)/) {
		} else {
			($host,$function)=$key=~/^(.*)~(.*)/;	# so break it into host, function
			$parms=$function;
		}
		my $name=$bbhost{"$key"};					# and retrieve the name
		my %temp=();						# clear the work hash
		my @positional=();
		foreach (split(/,/,$parms)) {				# split up and process each parm
			if (/=/) {					# two choices, positional or keyword
				my ($var,$val)=split(/=/);			# split it on the on the '='
				$var=lc($var);				# store as lower case to be sure it's unique
				$temp{$var}=$val;			# and save for when it is needed
			} else {					
				push @positional,$_;				# it is positional
			}
		}
		if (@positional) {
		} else {
			$positional[0]=$function;
		}
		my $positional=join(':',@positional);
		$bbitems{"$bbhost{$key}.$positional[0]"}=$function;
		$positional{"$function"}.="$positional ";
		foreach (keys %temp) {
			$parms{"$positional~$function~$_"}=$temp{$_};
		}
	}
	#my $hosts=join(' ',keys %host);
	use Date::Manip qw(ParseDate DateCalc Date_Cmp);
	if (-r "$BBHOME/ext/down.cfg") {
		open(DOWN,"$BBHOME/ext/down.cfg");
		my $now=ParseDate("now");
                my %index = ();
		foreach (<DOWN>) {
			chomp;
			s/#.*//sig;
			next if /^\s*$/sig;
			my($name,$duration,$when)=split(',');
			my $key="$name~".++$index{$name};
			$fromtime{$key}=ParseDate($when);
			$tilltime{$key}=DateCalc($when,$duration);
		}
	}
}

=pod

=item InitStatus()

Resets test status to "green"

=item UpdateStatus($status)

Updates test status to $status if more severe than cureent status

=item GetStatus()

Returns current test status

=cut

my $bbstatus;

sub InitStatus { $bbstatus = "green"; }

sub UpdateStatus {
  my ($package,$sigsts) = @_;
  if (($sigsts eq "red") ||
      ($bbstatus ne "red" && $sigsts eq "yellow")) {
    $bbstatus = $sigsts;
  }
}

sub GetStatus { return $bbstatus; }

=pod

=item IsDown($string)

returns true if the file $BBHOME/ext/down.cfg contains a line for $string,from,to that the current time
falls between from and to. From and to are specified in the syntax of Date::Manip (see perldoc for it to see how to specify).

=cut

sub IsDown {
	my ($package,$key)= (at) _;
        my $now = "today";
	foreach my $temp (grep /^$key~/,keys %fromtime) {
		if ((Date_Cmp($fromtime{$temp},$now)<0) and (Date_Cmp($tilltime{$temp},$now)>0)) {
			return 1;
		}
	}
	return 0;
} 

=pod

=item Positional($forkey)

=cut

sub Positional {
	my ($package,$forkey)= (at) _;
	my $hosts='';
	foreach (grep(/^$forkey$/,keys %positional)) {
		$hosts.=$positional{$_}.' ';
	}
	return $hosts;
}

=pod

=item Parms($key,$default)

=cut

sub Parms {
	my ($package,$key,$default)= (at) _;
	if (exists $parms{$key}) {
		return $parms{$key};
	} else {
		return $default;
	}
}

=pod

=item Items($forkey)

returns space separated list of items that match $forkey

=cut

sub Items {
	my ($package,$forkey)= (at) _;
	my $items='';
        my @items = ();
	if ($forkey) {
		foreach (keys %bbitems) {
			next unless $bbitems{$_}=~/^$forkey$/;
			push @items,$_;
		}
		$items=join(' ',@items);
	} else {
		$items=join(' ',keys %bbitems);
	}
	return $items;
}

=pod

=item HostItems($host,$forkey)

returns space separated list of items for $host that match $forkey

=cut

sub HostItems {
	my ($package,$host,$forkey)= (at) _;
	my $items='';
        my @items = ();
	if ($forkey) {
		foreach (keys %bbhosts) {
			next unless /^$host~$forkey$/;
			push @items,$bbhosts{$_};
		}
		$items=join(' ',@items);
	} else {
		$items=join(' ',keys %bbhosts);
	}
	return $items;
}

=pod

=item HostsByTest($test)

returns list of hosts for plain $test

=cut

sub HostsByTest {
	my ($package,$test)= (at) _;
	my $host='';
        my @hosts = ();
	if ($test) {
		foreach (keys %bbhost) {
			next unless /([^~]*)\~$test/;
			push @hosts,($bbhost{$_});
		}
	}
	return @hosts;
}

=pod

=item HostIP($host)

returns IP for $host

=cut

sub HostIP {
	my ($package,$host)= (at) _;
	return $bbhostsIP{$host};
}

=pod

=item Report($HostName,$test,$color,$status)

Reports to BB server that $Hostname.$test has status $colour and with status message $status

=cut

sub Report {
        my($package,$HostName, $inst, $color, $status) = @_ ;
        ($inst)=split(/\./,$inst);
        # Substitute dots by commas in the host name
        $HostName =~ s/\./,/g;
        # Build the command to report to Big Brother
        $color=lc($color);
        # delete trailing spaces before line feeds in message
        $status =~ s/[ \t]+\n/\n/g;
        my $MyCmd= "$ENV{BB} $ENV{BBDISP} ".'"'."status $HostName.$inst $color ".localtime(time).' '.$status.'"';
        # For debugging purposes
        # Execute the command.
        # print "$MyCmd\n";
        `$MyCmd`;
}

=item Client($HostName,$ostype,$configclass,$rep)

Reports client report for $Hostname with OS type $ostype (linux,bbwin,etc) and config class $configclass (linux,win32,etc)
client report details in $rep

=cut

sub Client {
        my($package,$HostName, $ostype,$configclass,$rep) = @_ ;
        # Substitute dots by commas in the host name
        $HostName =~ s/\./,/g;
        # Build the command to report to Big Brother
        $ostype=lc($ostype);
        $configclass=lc($configclass);
        $rep =~ s/^(\s*\n)*//g; # delete leading blank lines
        # redirect STDOUT and STDERR to /dev/null since client report returns local config updates
        my $MyCmd= "$ENV{BB} $ENV{BBDISP} \"\ (at) \" 2>&1 >/dev/null";
        # For debugging purposes
        # Execute the command.
        #print "$MyCmd\n" if $debug > 1;
        open CL,"|$MyCmd";
	print CL "client $HostName.$ostype $configclass\n$rep";
	close CL;
}

sub QueryColor {
        my($package,$HostName, $test) = @_ ;
        #my $MyCmd= "$ENV{BB} $ENV{BBDISP} \"hobbitdboard host=$HostName test=$test field=$field\"";
        my $MyCmd= "$ENV{BB} $ENV{BBDISP} \"query $HostName.$test\"";
        # For debugging purposes
        # Execute the command.
        #print "$MyCmd\n";
        my $str = `$MyCmd`;
	#chomp $str;
	#print "PRE: $str\n";
	$str =~ s/^\s*(\S+)(\s.*)?$/$1/;
	#print "POST: $str\n";
	return $str;
}

sub Dump_Vars {
        use Data::Dumper;
        print "Dumping \%bbhosts:\n";
	print Dumper(\%bbhosts);
        print "Dumping \%bbhost:\n";
	print Dumper(\%bbhost);
        print "Dumping \%bbhostsIP:\n";
	print Dumper(\%bbhostsIP);
        print "Dumping \%positional:\n";
	print Dumper(\%positional);
        print "Dumping \%bbitems:\n";
	print Dumper(\%bbitems);
        print "Dumping \%parms:\n";
	print Dumper(\%parms);
}

=pod

=back

=head1 SEE ALSO

=head1 AUTHOR

David Baldwin

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by David Baldwin

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;
__END__
#!/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 <henrik (at) hswn.dk>                     */
#*                                                                            */
#* 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 =~ /^\ (at) \@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 =~ /^\ (at) \@/) {
		# 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);
}