Differences

This shows you the differences between two versions of the page.

Link to this comparison view

monitors:xymonext.pm [2010/07/29 07:00] (current)
Line 1: Line 1:
 +====== My Monitor (CHANGEME) ======
 +
 +^ Author | [[ dbaldwin@users.sf.net | David Baldwin ]] |
 +^ Compatibility | Xymon 4.2 |
 +^ Requirements | Perl |
 +^ Download | XymonExt.pm |
 +^ Last Update | 2010-07-29 |
 +
 +===== Description =====
 +
 +===== Installation =====
 +=== Client side ===
 +
 +=== Server side ===
 +
 +===== Source =====
 +==== XymonExt.pm ====
 +
 +<hidden onHidden="​Show Code ⇲" onVisible="​Hide Code ⇱">​
 +<code perl XymonExt.pm>​
 +package XymonExt;
 +
 +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 XymonExt ':​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
 +
 +XymonExt - Perl extension to simplify writing XymonExt external scripts in PERL.
 +
 +=head1 SYNOPSIS
 +
 +  use XymonExt;
 +
 +  XymonExt->​import();​
 +
 +  test stuff...
 +
 +  XymonExt->​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 Xymon environment referenced using $ENV{BBHOME}
 +
 +=cut
 +
 +my(%bbhosts,​%bbhost,​%bbhostsIP,​%positional,​%bbitems,​%parms,​%client);​
 +my(%fromtime,​%tilltime);​
 +
 +sub import {
 + # reinitialise all variables since sometimes gets called in persistent processes (e.g. client-check.pl)
 + #
 + %bbhosts = ();
 + %bbhost = ();
 + %bbhostsIP = ();
 + %positional = ();
 + %bbitems = ();
 + %parms = ();
 + %client = ();
 + %fromtime = ();
 + %tilltime = ();
 +
 + 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 return 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};​
 + }
 + return if $ENV{BBHOME} =~ /client/;
 + 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
 + if(defined $pound && $pound =~ /^#(.+)/) { # handle missed space after "#"​
 +     $pound = "#";​
 +     unshift @parms,​($2);​
 + }
 + next unless (defined $pound && $pound eq '#'​);​ #​ Skip if token 3 isn't a '#'​
 + $bbhostsIP{$name}=$ip unless $ip =~ /​^0+\.0+\.0+\.0+$/;​ #​ and store as keys in %bbhostsIP "​$ip~$parm"​
 + 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"​
 + }
 + }
 + 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{$_};​
 + }
 + }
 +}
 +
 +=pod
 +
 +=item InitStatus([$host])
 +
 +Resets test status to "​green"​ (optionally for $host)
 +
 +=item UpdateStatus($status[,​$host])
 +
 +Updates test status to $status if more severe than current status (optionally for $host)
 +order is: green clear yellow red
 +
 +=item GetStatus([$host])
 +
 +Returns current test status (optionally for $host)
 +
 +=cut
 +
 +my %bbstatus;
 +
 +sub InitStatus {
 +  my ($package,​$host) = @_;
 +  $host ||= "";​
 +  $bbstatus{$host} = "​green";​
 +}
 +
 +sub UpdateStatus {
 +  my ($package,​$sigsts,​$host) = @_;
 +  $host ||= "";​
 +  if (($sigsts eq "​red"​) ||
 +      ($bbstatus{$host} ne "​red"​ && $sigsts eq "​yellow"​) ||
 +      ($sigsts eq "​clear"​ && $bbstatus{$host} eq "​green"​)) {
 +    $bbstatus{$host} = $sigsts;
 +  }
 +}
 +
 +sub GetStatus {
 +  my ($package,​$host) = @_;
 +  $host ||= "";​
 +  return $bbstatus{$host};​
 +}
 +
 +=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('​ ',​@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('​ ',​@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, $lifetime) = @_ ;
 +        ($inst)=split(/​\./,​$inst);​
 +        # Substitute dots by commas in the host name
 +        $HostName =~ s/\./,/g;
 +        # Build the command to report to Xymon
 +        $color=lc($color);​
 +        # delete trailing spaces before line feeds in message
 +        $status =~ s/[ \t]+\n/​\n/​g;​
 +        $status =~ s/"/​\\"/​g;​
 + $lifetime ||= ""; ​ # blank if undefined - for format see man bb
 + my @bbds = ($ENV{BBDISP} eq "​0.0.0.0"​) ? split (/​\s+/,​$ENV{BBDISPLAYS}) : ($ENV{BBDISP});​
 + foreach my $dh (@bbds) {
 + warn "​$ENV{BB} $dh \"​status$lifetime $HostName.$inst $color "​.localtime(time)."​ $status\""​ if $status =~ /^\s*$/;
 + my $MyCmd= "​$ENV{BB} $dh \"​status$lifetime $HostName.$inst $color "​.localtime(time)."​ $status\"";​
 + # For debugging purposes
 + # Execute the command.
 + # print "​$MyCmd\n";​
 + `$MyCmd`;
 + }
 +}
 +
 +=pod
 +
 +=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 Xymon
 +        $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;
 +}
 +
 +=pod
 +
 +=item QueryColor($HostName,​$test)
 +
 +returns current colour of test from hobbit server
 +
 +=cut
 +
 +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/;​
 + chomp $str;
 + #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
 +
 +Xymon website: http://​xymon.sourceforge.net/​
 +
 +=head1 AUTHOR
 +
 +David Baldwin, E<​lt>​dbaldwin@users.sf.netE<​gt>​
 +
 +=head1 COPYRIGHT AND LICENSE
 +
 +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__
 +</​code>​
 +</​hidden>​
 +
 +===== Known  Bugs and Issues =====
 +
 +===== To Do =====
 +
 +===== Credits =====
 +
 +===== Changelog =====
 +
 +  * **2010-07-29**
 +    * Initial release
  
  • monitors/xymonext.pm.txt
  • Last modified: 2010/07/29 07:00
  • (external edit)