Differences

no way to compare when less than two revisions

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

@@ 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
+;
+__END__
+</code>
+</hidden>
+===== Known  Bugs and Issues =====
+===== To Do =====
+===== Credits =====
+===== Changelog =====
+  * **2010-07-29**
+    * Initial release