Thanks for the help....the script works and i also found out something else for anyone who falls in this category. Actually if i would have RTFM it says in there the "WHO" test for BBWin is not configurable. That answers my questions and thanks everyone for the responses. Derek From: David Baldwin <david.baldwin at ausport.gov.au> To: "hobbit at hswn.dk" <hobbit at hswn.dk> Date: 07/29/2009 07:30 PM Subject: 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, at 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(':', at 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)=@_; 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)=@_; my $hosts=''; foreach (grep(/^$forkey$/,keys %positional)) { $hosts.=$positional{$_}.' '; } return $hosts; } =pod =item Parms($key,$default) =cut sub Parms { my ($package,$key,$default)=@_; 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)=@_; my $items=''; my @items = (); if ($forkey) { foreach (keys %bbitems) { next unless $bbitems{$_}=~/^$forkey$/; push @items,$_; } $items=join(' ', at 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)=@_; my $items=''; my @items = (); if ($forkey) { foreach (keys %bbhosts) { next unless /^$host~$forkey$/; push @items,$bbhosts{$_}; } $items=join(' ', at 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)=@_; 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)=@_; 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} \"\@\" 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 =~ /^\@\@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); } To unsubscribe from the hobbit list, send an e-mail to hobbit-unsubscribe at hswn.dk Notice: This communication is an electronic communication within the meaning of the Electronic Communications Privacy Act, 18 U.S.C. � 2510. Its disclosure is strictly limited to the recipient(s) intended by the sender of this message. This transmission and any attachments may contain proprietary, confidential, attorney-client privileged information and/or attorney work product. If you are not the intended recipient, any disclosure, copying, distribution, reliance on, or use of any of the information contained herein is STRICTLY PROHIBITED. Please destroy the original transmission and its attachments without reading or saving in any matter and confirm by return email.