diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/Makefile.tplt /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/Makefile.tplt
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/Makefile.tplt 2009-02-22 17:42:35.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/Makefile.tplt 2010-01-10 17:23:12.000000000 -0500
@@ -3,9 +3,9 @@
# Created: 2002-Jun-27
# Function: Makefile template
#
-# $Id: Makefile.tplt,v 1.183 2009/02/22 22:42:35 jaw Exp $
+# $Id: Makefile.tplt,v 1.185 2010/01/10 22:23:12 jaw Exp $
-VERSION = dev-20090222
+VERSION = dev-20100109
MESSAGE = This is unstable development code
INSTALL = please see the INSTALL document for the next steps
UPGRADE1 = be sure to install the new misc/argus.css and misc/argus.js files
@@ -29,7 +29,8 @@
NullCtl.pm UserCron.pm TestPort.pm Resolv.pm \
misc.pl localization.pl Argus::HashDir.pm \
Argus::MonEl::Expand.pm Argus::MonEl::Noise.pm Argus::MonEl::Trans.pm \
- Argus::Archivist.pm Argus::Archive.pm Argus::Web::Overview.pm
+ Argus::Archivist.pm Argus::Archive.pm Argus::Web::Overview.pm \
+ Argus::ReadConfig.pm Argus::Schedule.pm
# Service Modules
LIBS_S = Argus::IP.pm TCP.pm UDP.pm Ping.pm Prog.pm \
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/examples/config-new-features /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/examples/config-new-features
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/examples/config-new-features 2007-12-22 16:46:21.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/examples/config-new-features 2010-01-10 15:00:23.000000000 -0500
@@ -1,4 +1,24 @@
+# schedules
+
+Method "mail" {
+ # ...
+
+ # don't send warning severity notifications off hours
+ Schedule warning {
+ # day start - end => result
+ sat => no
+ sun => no
+ * 0000 - 0900 => no
+ * 1700 - 2400 => no
+ }
+
+ # don't send minor severity notifications in the morning
+ Schedule minor {
+ * 0000 - 1000 => no
+ }
+}
+
################
# compute service
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Alias.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Alias.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Alias.pm 2007-12-22 11:32:47.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Alias.pm 2010-01-10 17:23:16.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-03 08:56 (EST)
# Function: the alias pseudo-object
#
-# $Id: Alias.pm,v 1.18 2007/09/01 16:51:34 jaw Exp $
+# $Id: Alias.pm,v 1.19 2010/01/10 22:23:16 jaw Exp $
# this file is for Sydney Bristow
@@ -46,37 +46,21 @@
sub config {
my $me = shift;
my $cf = shift;
-
- $me->init_from_config( $cf, $doc, 'alias' );
-
- return undef unless $me->init($cf);
-}
+ my $targ = shift;
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new();
- my( $line, $name, $targ );
-
- $me->{parents} = [ $mom ] if $mom;
-
- $line = $cf->nextline();
- ($name, $targ) = $line =~ /Alias\s+\"([^\"]+)\"\s+\"([^\"]+)\"/;
-
- $me->cfinit($cf, $name, 'Alias');
$me->{config}{target} = $targ;
- if( !$name || !$targ ){
- eval {
- $cf->error( "invalid alias spec: '$_'" );
- };
+ if( !$me->{name} || !$targ ){
+ $cf->nonfatal( "invalid alias spec: '$_'" );
return undef;
}
- $me->config($cf);
- $me;
+ $me->init_from_config( $cf, $doc, 'alias' );
+
+ return undef unless $me->init($cf);
}
+
sub gen_conf {
my $me = shift;
my $in = shift;
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::Agent.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::Agent.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::Agent.pm 2008-03-04 22:45:55.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::Agent.pm 2010-01-05 23:35:20.000000000 -0500
@@ -5,14 +5,14 @@
# Date: 2002-Nov-06 18:03 (EST)
# Function: monitor various system values via a remote agent
#
-# $Id: Argus::Agent.pm,v 1.16 2008/03/05 03:45:55 jaw Exp $
+# $Id: Argus::Agent.pm,v 1.17 2010/01/06 04:35:20 jaw Exp $
package Argus::Agent;
use Argus::Encode;
# and trust no agent
# -- Shakespeare
-
+
@ISA = qw(TCP);
$doc = {
package => __PACKAGE__,
@@ -49,23 +49,23 @@
my $me = shift;
my $cf = shift;
my( $l );
-
+
bless $me;
$me->init_from_config( $cf, $doc, 'agent' );
-
+
if( $me->{name} =~ /(SYS|Agent)\/(.*)/ ){
$me->{agent}{param} ||= $2;
}
-
+
return $cf->error("no agent param specified")
unless $me->{agent}{param};
-
+
$me->{tcp}{send} = $me->{agent}{param};
- $me->{tcp}{send} .= " " . $me->{agent}{arg} if $me->{agent}{arg};
+ $me->{tcp}{send} .= " " . $me->{agent}{arg} if defined $me->{agent}{arg};
$me->{tcp}{send} .= "\n";
$me->{tcp}{port} = $me->{agent}{agent_port};
$me->{tcp}{readhow} = 'toeof';
-
+
$l = $me->{tcp}{send};
chop( $l );
$l =~ s/\s+/_/g;
@@ -74,7 +74,7 @@
$me->SUPER::config($cf);
$me->{uname} = "SYS_$me->{ip}{hostname}_$l";
$me->{friendlyname} = "$l on $me->{ip}{hostname}";
-
+
}
sub about_more {
@@ -86,7 +86,7 @@
$me->more_about_whom($ctl, 'agent');
}
-
+
################################################################
# global config
################################################################
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::Graph::Data.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::Graph::Data.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::Graph::Data.pm 2008-09-14 11:37:55.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::Graph::Data.pm 2010-01-05 23:35:20.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Nov-01 15:57 (EST)
# Function: misc graph data handling
#
-# $Id: Argus::Graph::Data.pm,v 1.15 2008/09/14 15:37:55 jaw Exp $
+# $Id: Argus::Graph::Data.pm,v 1.16 2010/01/06 04:35:20 jaw Exp $
package Argus::Graph::Data;
use strict;
@@ -13,7 +13,7 @@
use vars qw($MAGIC $HDR_SIZE $SAMP_SIZE $SAMP_NMAX);
use vars qw($HOURS_SIZE $HOURS_NMAX $DAYS_SIZE $DAYS_NMAX);
-$MAGIC = "AGD3"; # Argus Graphing Data
+$MAGIC = "AGD3"; # Argus Graphing Data
$HDR_SIZE = 1024; # total size of header, currently mostly unused
# raw samples
@@ -31,7 +31,7 @@
# Header:
# magic, lastT, sampl_cnt, sampl_indx
# hrs_cnt, hrs_indx, day_cnt, day_indx
-#
+#
# hrs_min, hrs_max, hrs_nsamp, hrs_sigm
# hrs_sigm2-------, hrs_flags, unused,
#
@@ -69,7 +69,7 @@
open( $fh, $file )
|| return ::error( "'$file' is stubborn and refuses to open: $!" );
binmode $fh;
-
+
# read file header
my $magic = $me->read_header();
@@ -89,10 +89,10 @@
my @samp;
my $fh = $me->{fd};
-
+
my $start = ($me->{sampl_index} - $me->{sampl_count} + $me->{sampl_nmax}) % $me->{sampl_nmax};
# print STDERR "samples=$me->{sampl_count} index=$me->{sampl_index} start=$start\n";
-
+
for( my $i=0; $i<$me->{sampl_count}; $i++ ){
my $n = ($i + $start) % $me->{sampl_nmax};
my $off = $n * $SAMP_SIZE + $me->{sampl_start};
@@ -111,28 +111,27 @@
($f ? (color => ($f==2 ? 'gray' : 'red')) : ()),
};
}
-
+
$me->{samples} = \@samp;
}
sub readsamples {
- my $me = shift;
+ my $me = shift;
my $limit = shift;
$me->readallsamples();
my $samp = $me->{samples};
-
+
# remove end-errors
if( @$samp > 1 ){
shift @$samp
if( $samp->[0]{time} > $samp->[1]{time} );
}
-
- # temporal limit - default 36 hours
- if( @$samp ){
- my $et = $samp->[-1]{time};
- $limit ||= 36 * 3600;
- while( $et - $samp->[0]{time} > $limit ){
+
+ # temporal limit
+ if( @$samp && $limit ){
+
+ while( @$samp && $samp->[0]{time} < $limit ){
shift @$samp;
}
}
@@ -147,7 +145,7 @@
my $wh = shift;
my $ns = shift;
my $limit = shift;
- my( $fh, $start, $first, $cnt, $idx, $nmax, $nsmall, $dflmt, @samp );
+ my( $fh, $start, $first, $cnt, $idx, $nmax, $nsmall, @samp );
$fh = $me->{fd};
# day+hours data is same, different offset
@@ -156,19 +154,16 @@
$idx = $me->{hours_index};
$start = $me->{hours_start};
$nmax = $me->{hours_nmax};
- $dflmt ||= 180 * 3600;
}else{
$cnt = $me->{days_count};
$idx = $me->{days_index};
$start = $me->{days_start};
$nmax = $me->{days_nmax};
- $dflmt ||= 90 * 24 * 3600;
}
# limit number of points
$cnt = $ns if $cnt > $ns && ! $limit;
- $limit ||= $dflmt;
$first = ($idx - $cnt + $nmax) % $nmax;
for( my $i=0; $i<$cnt; $i++ ){
@@ -192,7 +187,7 @@
ave => $ave, stdv => $sdv,
ns => $ns,
value => $ave,
- ($f ? (color => ($f==2 ? 'gray' : 'red')) : ()),
+ ($f ? (color => ($f==2 ? 'gray' : 'red')) : ()),
};
}
@@ -200,18 +195,18 @@
shift @samp
if( $samp[0]{time} > $samp[1]{time} );
}
-
+
if( @samp ){
# skip small partial edge values
@samp = grep { $_->{ns} > 1 } @samp if $nsmall < $cnt/2;
-
+
# temporal limit
my $et = $samp[-1]{time};
- while( $et - $samp[0]{time} > $limit ){
+ while( @samp && $samp[0]{time} < $limit ){
shift @samp;
}
}
-
+
$me->{samples} = \@samp;
}
@@ -227,17 +222,17 @@
$me->{sampl_count}, $me->{sampl_index},
$me->{hours_count}, $me->{hours_index},
$me->{days_count}, $me->{days_index},
-
+
$me->{hours_min}, $me->{hours_max},
$me->{hours_nsamp}, $me->{hours_sigma},
$me->{hours_sigm2}, $me->{hours_flags},
-
+
$me->{days_min}, $me->{days_max},
$me->{days_nsamp}, $me->{days_sigma},
$me->{days_sigm2}, $me->{days_flags},
$me->{sampl_nmax}, $me->{hours_nmax}, $me->{days_nmax},
-
+
) = unpack( "a4N NN NN NN ffNfdNx4 ffNfdNx4 NNN", $buf );
$me->header_init();
@@ -255,7 +250,7 @@
$me->{sampl_start} = $HDR_SIZE;
$me->{hours_start} = $me->{sampl_start} + $SAMP_SIZE * $me->{sampl_nmax};
$me->{days_start} = $me->{hours_start} + $HOURS_SIZE * $me->{hours_nmax};
-
+
}
sub write_header {
@@ -278,7 +273,7 @@
$me->{days_sigm2}, $me->{days_flags},
$me->{sampl_nmax}, $me->{hours_nmax}, $me->{days_nmax},
-
+
);
sysseek( $fh, 0, 0 );
syswrite($fh, $hdr );
@@ -300,14 +295,14 @@
my %d = (
s => { idx => $me->{sampl_index}, cnt => $me->{sampl_count}, nx => $ss,
max => $me->{sampl_nmax}, str => $me->{sampl_start}, sz => $SAMP_SIZE },
-
+
h => { idx => $me->{hours_index}, cnt => $me->{hours_count}, nx => $hs,
max => $me->{hours_nmax}, str => $me->{hours_start}, sz => $HOURS_SIZE },
-
+
d => { idx => $me->{days_index}, cnt => $me->{days_count}, nx => $ds,
max => $me->{days_nmax}, str => $me->{days_start}, sz => $DAYS_SIZE },
);
-
+
foreach my $k (qw(s h d)){
my $x = $d{$k};
@@ -329,7 +324,7 @@
# new header values?
# new count is always either: old count, new nmax
# new index is always either: 0, old count
-
+
$x->{ncnt} = $x->{cnt} > $x->{nx} ? $x->{nx} : $x->{cnt};
if( $x->{ncnt} < $x->{cnt} ){
@@ -348,9 +343,9 @@
}
$x->{data} = $buf;
}
-
+
# rejigger header
-
+
$me->{sampl_index} = $d{s}{nidx};
$me->{hours_index} = $d{h}{nidx};
$me->{days_index} = $d{d}{nidx};
@@ -360,7 +355,7 @@
$me->{sampl_nmax} = $d{s}{nx};
$me->{hours_nmax} = $d{h}{nx};
$me->{days_nmax} = $d{d}{nx};
-
+
$me->{sampl_start} = $HDR_SIZE;
$me->{hours_start} = $me->{sampl_start} + $SAMP_SIZE * $me->{sampl_nmax};
@@ -370,7 +365,7 @@
$me->write_header();
sysseek($fh, $me->{sampl_start}, 0);
syswrite($fh, $d{s}{data});
-
+
sysseek($fh, $me->{hours_start}, 0);
syswrite($fh, $d{h}{data});
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::ReadConfig.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::ReadConfig.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::ReadConfig.pm 1969-12-31 19:00:00.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::ReadConfig.pm 2010-01-10 17:23:16.000000000 -0500
@@ -0,0 +1,302 @@
+# -*- perl -*-
+
+# Copyright (c) 2010 by Jeff Weisberg
+# Author: Jeff Weisberg
+# Created: 2010-Jan-06 19:19 (EST)
+# Function: read+parse config file
+#
+# $Id: Argus::ReadConfig.pm,v 1.1 2010/01/10 22:23:16 jaw Exp $
+
+package Argus::ReadConfig;
+use strict;
+
+my %TYPE = (
+ notme => 'method',
+ 'usercron' => 'cron',
+ 'darp::conf' => 'slave',
+ );
+
+my %READ = (
+ top => { mknext(qw(group host resolv method darp)) },
+ group => { quot => 1, onel => 0, level => 2, func => \&read_group, mknext(qw(group host service alias cron schedule)) },
+ host => { quot => 1, onel => 0, level => 2, func => \&read_host, mknext(qw(group host service alias cron schedule)) },
+ alias => { quot => 2, onel => 1, level => 2, func => \&read_alias, mknext(qw(group host service alias cron)) },
+ service => { quot => 0, onel => 1, level => 2, func => \&read_service, mknext(qw(cron schedule)) },
+ cron => { quot => 1, onel => 1, level => 2, func => \&read_cron },
+ method => { quot => 1, onel => 1, level => 1, func => \&read_meth, mknext(qw(schedule)) },
+ resolv => { quot => 0, onel => 1, level => 1, func => \&read_resolv },
+ schedule => { quot => 0, onel => 0, level => 1, func => \&read_sched },
+
+ # DARP
+ darp => { quot => 1, onel => 0, level => 1, func => \&read_darp, mknext(qw(master slave)) },
+ master => { quot => 1, onel => 0, level => 1, func => \&read_master },
+ slave => { quot => 1, onel => 0, level => 1, func => \&read_slave },
+ );
+
+# Reading maketh a full man
+# -- Francis Bacon
+
+sub readconfig {
+ my $class = shift;
+ my $cf = shift;
+ my $mom = shift;
+ my $more = shift;
+
+ my $me = $class->new();
+ my $opt = $READ{ $TYPE{lc($class)} || lc($class) };
+
+ $me->{parents} = [ $mom ] if $mom;
+
+ my $line = $cf->nextline();
+ my($type, $name, $extra);
+ if( $opt->{quot} == 2 ){
+ ($type, $name, $extra) = $line =~ /^\s*([^:\s]+)\s+\"([^\"]+)\"\s+\"([^\"]+)\"/;
+ $more = $extra;
+ }elsif( $opt->{quot} ){
+ ($type, $name) = $line =~ /^\s*([^:\s]+)\s+\"(.+)\"/;
+ }else{
+ ($type, $name) = $line =~ /^\s*([^:\s]+):?\s+([^\{\s]+)/;
+ }
+ unless( $type ){
+ ($type) = $line =~ m|^\s*([^\s:/])|;
+ }
+
+ $me->cfinit($cf, $name, "\u\L$type");
+
+ unless( $name ){
+ $cf->nonfatal( "invalid entry in config file: '$_'" );
+ $cf->eat_block() if $line =~ /\{\s*$/;
+ return ;
+ }
+
+ if( $line =~ /\{\s*$/ ){
+ readblock( $me, $cf, $class, 1 );
+ }else{
+ unless( $opt->{onel} ){
+ eval{ $cf->error( "invalid entry in config file: '$_'" ); };
+ return ;
+ }
+ }
+
+ $me->config($cf, $more);
+ return $me;
+}
+
+# The bookful blockhead, ignorantly read,
+# With loads of learned lumber in his head.
+# -- Alexander Pope, Essay on Criticism
+
+sub readblock {
+ my $me = shift;
+ my $cf = shift;
+ my $class = shift;
+ my $open = shift;
+ my $doc = shift;
+
+ my $opt = $READ{ $TYPE{lc($class)} || lc($class) };
+ my $balanced = ! $open;
+ my $level = 0;
+ my $nhost = 0;
+
+ while( defined($_ = $cf->nextline()) ){
+ # print STDERR ">> $_\n";
+ if( /^\s*\}/ ){
+ $balanced = 1;
+ last;
+ }
+
+ my($what) = m|^\s*([^\s:/]+)|i;
+ $what = lc $what;
+
+ if( $opt->{next}{$what} && $READ{$what} ){
+ $cf->ungetline($_);
+
+ my $nl = $READ{$what}{level};
+ $cf->error("$what block must appear before any Groups or Services")
+ if $nl < $level;
+ $level = $nl;
+
+ $READ{$what}{func}->($cf, $me);
+ }
+ elsif( /:/ ){
+ my($k, $v) = split /:[ \t]*/, $_, 2;
+ # data must be before Service|Group|Alias
+ if( $level ){
+ $cf->warning( "additional data not permitted here (ignored)" );
+ next;
+ }
+
+ my $warn;
+ $warn = 1 if defined $me->{config}{$k};
+
+ if( $k eq 'hostname' && $me->{type} eq 'Host' ){
+ # allow Host to redefine hostname without a warning
+ $warn = 0 unless $nhost++ > 0;
+ }
+
+ if( $doc && Configable::has_attr($k, $doc, 'multi') ){
+ push @{$me->{config}{$k}}, $v; # QQQ
+ }else{
+ $cf->warning( "redefinition of parameter '$k'" )
+ if $warn;
+
+ $me->{config}{$k} = $v;
+ }
+
+ if( $doc ){
+ $me->{confck}{$k} = 1 if Configable::has_attr($k, $doc, 'top');
+ if( my $c = $doc->{fields}{$k}{callback} ){
+ $c->($v, $cf) unless $::opt_t;
+ }
+ }
+ }
+ else{
+ # Reading what they never wrote
+ # -- William Cowper, The Task
+ $cf->nonfatal( "invalid entry in config file: '$_'" );
+ $cf->eat_block() if /\{\s*$/;
+ $me->{conferrs} ++;
+ # attempt to continue
+ }
+ }
+
+ unless( $balanced ){
+ $cf->error( "end of file reached looking for closing }");
+ return;
+ }
+
+ return;
+}
+
+sub read_group {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = Group->readconfig($cf, $me);
+ push @{$me->{children}}, $x if $x;
+ $x;
+}
+
+sub read_host {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = Group->readconfig($cf, $me);
+ push @{$me->{children}}, $x if $x;
+ $x;
+}
+
+sub read_alias {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = Alias->readconfig($cf, $me);
+ push @{$me->{children}}, $x if $x;
+ $x;
+}
+
+sub read_service {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = Service->readconfig($cf, $me);
+ push @{$me->{children}}, $x if $x;
+ $x;
+}
+
+sub read_cron {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = UserCron->readconfig($cf, $me);
+ push @{$me->{cronjobs}}, $x if $x;
+ $x;
+}
+
+sub read_meth {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = NotMe->readconfig($cf, $me);
+ $x;
+}
+
+sub read_resolv {
+ my $cf = shift;
+ my $me = shift;
+
+ $cf->nextline();
+ $cf->ungetline( "Service $_" ); # magic!
+
+ my $x = Service->readconfig($cf, $me);
+ $x;
+}
+
+sub read_sched {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = Argus::Schedule->readconfig($cf, $me);
+ $x;
+}
+
+sub read_darp {
+ my $cf = shift;
+ my $me = shift;
+
+ if( $::HAVE_DARP ){
+ my $x = DARP->readconfig($cf, $me);
+ return $x;
+ }
+ $cf->nonfatal( "DARP not available on this system" );
+ $cf->nextline();
+ $cf->eat_block();
+ undef;
+}
+
+sub read_master {
+ my $cf = shift;
+ my $me = shift;
+
+ $cf->nextline();
+ $cf->ungetline( "DARP_Slave __DARP {" );
+
+ my $x = Service->readconfig($cf, $me, { darp => 1, tag => $me->{name} });
+ if( $x ){
+ push @{$me->{masters}}, $x;
+ push @{$me->{children}}, $x;
+ }
+ $x;
+}
+
+sub read_slave {
+ my $cf = shift;
+ my $me = shift;
+
+ my $x = DARP::Conf->readconfig($cf, $me);
+ if( $x ){
+ push @{$me->{slaves}}, $x;
+ push @{$me->{children}}, $x;
+ }
+ $x;
+}
+
+################################################################
+
+sub mknext {
+ my %n;
+ @n{@_} = @_;
+ return (next => \%n);
+}
+
+sub import {
+ my $pkg = shift;
+ my $caller = caller;
+
+ for my $f (qw(readconfig readblock)){
+ no strict;
+ *{$caller . '::' . $f} = $pkg->can($f);
+ }
+}
+
+1;
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::SNMP::Helper.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::SNMP::Helper.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::SNMP::Helper.pm 2008-07-28 19:19:26.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::SNMP::Helper.pm 2010-01-05 23:35:20.000000000 -0500
@@ -5,7 +5,7 @@
# Created: 2007-Jun-24 17:04 (EDT)
# Function: look up interface names, to permit easier config
#
-# $Id: Argus::SNMP::Helper.pm,v 1.10 2008/07/28 23:19:26 jaw Exp $
+# $Id: Argus::SNMP::Helper.pm,v 1.11 2010/01/06 04:35:20 jaw Exp $
# let the config file say:
# oid: ifOperStatus[Serial1/0]
@@ -324,6 +324,7 @@
}
my $help = Service->new(
+ type => 'Service',
name => '_SNMP_HELPER',
parents => [ $me ], # so we can inherit snmp params
transient => 1,
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::Schedule.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::Schedule.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Argus::Schedule.pm 1969-12-31 19:00:00.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Argus::Schedule.pm 2010-01-10 17:23:17.000000000 -0500
@@ -0,0 +1,177 @@
+# -*- perl -*-
+
+# Copyright (c) 2010 by Jeff Weisberg
+# Author: Jeff Weisberg
+# Created: 2010-Jan-09 11:08 (EST)
+# Function: scheduling
+#
+# $Id: Argus::Schedule.pm,v 1.1 2010/01/10 22:23:17 jaw Exp $
+
+package Argus::Schedule;
+@ISA = qw(Configable);
+use vars qw(@ISA);
+use strict;
+
+my %DAYNO = (
+ sun => 0, mon => 1, tue => 2, wed => 3,
+ thu => 4, fri => 5, sat => 6,
+ );
+
+# The stars are not wanted now; put out every one:
+# Pack up the moon and dismantle the sun;
+# Pour away the ocean and sweep up the woods:
+# For nothing now can ever come to any good.
+# -- W.H. Auden
+sub permit_now {
+ my $me = shift;
+
+ my $res = 1; # default = permit
+ my @t = localtime($^T);
+ my $day = $t[6];
+ my $time = sprintf '%d%02d', $t[2], $t[1];
+
+ # last match wins
+ for my $s (@{$me->{schedule}}){
+ # My fellow-scholars, and to keep those statutes
+ # That are recorded in this schedule here:
+ # -- Shakespeare, Loves Labor Lost
+ next unless $s->{dayno} eq 'all' || $s->{dayno} == $day;
+ next if $time < $s->{start};
+ next if $time > $s->{end};
+ $res = $s->{res};
+ }
+
+ return $res;
+}
+
+
+sub readconfig {
+ my $class = shift;
+ my $cf = shift;
+ my $mom = shift;
+
+ my $line = $cf->nextline();
+ my($type, $name) = $line =~ /^\s*([^:\s]+):?\s+([^\{\s]+)/;
+
+ my $me = $class->new();
+ $me->cfinit($cf, $name, "\u\L$type");
+
+ unless( $name ){
+ $cf->nonfatal( "invalid entry in config file: '$_'" );
+ $cf->eat_block() if $line =~ /\{\s*$/;
+ return ;
+ }
+
+ # What's here? the portrait of a blinking idiot,
+ # Presenting me a schedule! I will read it.
+ # -- Shakespeare, Merchant of Venice
+ my @sched;
+ while( defined($_ = $cf->nextline()) ){
+ if( /^\s*\}/ ){
+ last;
+ }
+
+ # parse: day, start, end, result
+ eval {
+ push @sched, _parse($cf, $_);
+ };
+ if(my $e = $@){
+ chomp $e;
+ $cf->nonfatal("invalid schedule: $e");
+ $cf->eat_block();
+ return;
+ }
+ }
+
+ $me->{schedule} = \@sched;
+ $me->config($cf, $mom);
+ return $me;
+}
+
+sub unserialize {
+ my $class = shift;
+ my $cf = shift;
+ my $mom = shift;
+ my $name = shift;
+ my $line = shift;
+
+ my $me = $class->new();
+ $me->cfinit($cf, $name, 'Schedule');
+
+ my @sched;
+ for my $l (split /\n/, $line){
+ eval {
+ push @sched, _parse($cf, $l);
+ };
+ }
+
+ $me->{schedule} = \@sched;
+ $me->config($cf, $mom);
+ return $me;
+}
+
+sub _parse {
+ my $cf = shift;
+ my $l = shift;
+
+ my($day, $times, $res) = $l =~ /^\s*(\S+)\s+(.*)\s+=>\s*(\S+)/;
+ $times =~ s/://g;
+ my($start, $end) = $times =~ /(\d+)\s*-\s*(\d+)/;
+ $start ||= '0000';
+ $end ||= '2400';
+ $day = 'all' if $day eq '*';
+ $day = lc $day;
+
+ die "invalid day spec '$day'\n" unless grep {$day eq $_} qw(all mon tue wed thu fri sat sun);
+ die "invalid start time '$start'n" unless $start =~ /^[0-9]{3,4}/;
+ die "invalid end time '$end'n" unless $end =~ /^[0-9]{3,4}/;
+
+ my $dayno = exists($DAYNO{$day}) ? $DAYNO{$day} : $day;
+
+ return { day => $day, dayno => $dayno, start => $start, end => $end, res => ::ckbool($res) };
+}
+
+sub config {
+ my $me = shift;
+ my $cf = shift;
+ my $mom = shift;
+
+ my $name = $me->{name};
+
+ if( $mom->{config}{"schedule $name"} ){
+ $cf->warning( "redefinition of schedule '$name'" )
+ }
+
+ $mom->{config}{"schedule $name"} = $me;
+ $me;
+}
+
+sub _gen_spec {
+ my $s = shift;
+
+ "$s->{day} $s->{start} - $s->{end} => " . ($s->{res} ? 'yes' : 'no');
+}
+
+sub gen_conf {
+ my $me = shift;
+
+ my $r = "Schedule $me->{name} {\n";
+ for my $s ( @{$me->{schedule}} ){
+ $r .= "\t" . _gen_spec($s) . "\n";
+ }
+ $r .= "}\n";
+ return $r;
+}
+
+sub get_config_data {
+ my $me = shift;
+
+ my $r;
+ for my $s ( @{$me->{schedule}} ){
+ $r .= _gen_spec($s) . "\n";
+ }
+ return $r;
+}
+
+
+1;
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/BaseIO.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/BaseIO.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/BaseIO.pm 2008-03-03 10:45:16.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/BaseIO.pm 2010-01-05 23:35:21.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-02 09:47 (EST)
# Function: BaseIO class
#
-# $Id: BaseIO.pm,v 1.52 2008/03/03 15:45:16 jaw Exp $
+# $Id: BaseIO.pm,v 1.53 2010/01/06 04:35:21 jaw Exp $
# low-level I/O, non-blocking, select-loop
@@ -195,6 +195,7 @@
my $i = ::binary_search(\@timeouts, 'timeout', $me->{timeout});
my @e = grep { $_ != $me } @{$timeouts[$i]{elem}};
$timeouts[$i]{elem} = \@e;
+ delete $me->{timeout};
}
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Chart::Strip.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Chart::Strip.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Chart::Strip.pm 2008-07-18 23:34:13.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Chart::Strip.pm 2009-03-29 11:06:04.000000000 -0400
@@ -5,9 +5,9 @@
# Date: 2002-Nov-01 16:11 (EST)
# Function: draw strip charts
#
-# $Id: Strip.pm,v 1.17 2008/07/19 03:34:13 jaw Exp $
+# $Id: Strip.pm,v 1.21 2009/03/28 17:34:54 jaw Exp $
-$Chart::Strip::VERSION = "1.05";
+$Chart::Strip::VERSION = "1.07";
=head1 NAME
@@ -67,42 +67,42 @@
=item C
The title of the graph. Will be placed centered at the top.
-
+
=item C<x_label>
The label for the x axis. Will be placed centered at the bottom.
-
+
=item C<y_label>
The label for the y axis. Will be placed vertically along the left side.
-
+
=item C<draw_grid>
Should a grid be drawn on the graph?
-
+
=item C<draw_border>
Should a border be drawn around the edge of the image?
-
+
=item C<draw_tic_labels>
Should value labels be shown?
-
+
=item C<draw_data_labels>
Should each data set be labeled?
-
+
=item C<transparent>
Should the background be transparent?
-
+
=item C<grid_on_top>
Should the grid be drawn over the data (1) or below the data (0)?
=item C<binary>
-Use powers of 2 instead of powers of 10 for the y axis labels.
+Use powers of 2 instead of powers of 10 for the y axis labels.
=item C<data_label_style>
@@ -130,24 +130,24 @@
The data should be an array ref of data points. Each data point
should be a hash ref containing:
-
+
{
- time => $time_t, # must be a unix time_t
+ time => $time_t, # must be a unix time_t
value => $value, # the data value
color => $color, # optional, used for this one point
}
or, range style graphs should contain:
-
+
{
- time => $time_t, # must be a unix time_t
+ time => $time_t, # must be a unix time_t
min => $low, # the minimum data value
max => $high, # the maximum data value
color => $color, # optional, used for this one point
}
and the options may contain:
-
+
{
style => 'line', # graph style: line, filled, range, points, box
color => 'FF00FF', # color used for the graph
@@ -158,6 +158,16 @@
box style graphs may specify the box width, as C<width>
+line and filled graphs may specify a C<smooth> parameter, to connect
+points using smooth curves instead of straight lines. A value of C<1>
+is recommended, larger values will be less smooth.
+
+line, points, box, and filled graphs may specify a drop shadow,
+consisting of a hashref containing C<dx>, C<dy>, C<dw>, and optionally, C<color>
+
+ shadow => { dx => 3, dy => 3, dw => 3, color => 'CCCCCC' }
+
+
=head2 Outputing The Image
=over 4
@@ -173,7 +183,7 @@
=item $chart->gd()
Will return the underlying GD object.
-
+
=back
=cut
@@ -211,7 +220,7 @@
margin_right => 8,
margin_top => 8,
n_y_tics => 4, # aprox.
-
+
transparent => 1,
grid_on_top => 1,
draw_grid => 1,
@@ -221,27 +230,33 @@
limit_factor => 0,
data_label_style => 'text', # or 'box'
thickness => 1,
-
+ tm_time => \&POSIX::localtime, # or gmtime, or...
+ shadow_color => '#CCCCCC',
+# GD can only antialias on a truecolor image, and only if thickness==1
+# yes, I know what the GD documentation says. I also know what the src says...
+ antialias => 0,
+ truecolor => 0,
+
# title
# x_label
# y_label
-
+
# user specified params override defaults
%param,
-
+
}, $class;
$me->adjust();
- my $im = GD::Image->new( $me->{width}, $me->{height} );
+ my $im = GD::Image->new( $me->{width}, $me->{height}, $me->{truecolor} );
$me->{img} = $im;
-
- # Nor long the sun his daily course withheld,
- # But added colors to the world reveal'd:
- # When early Turnus, wak'ning with the light,
+
+ # Nor long the sun his daily course withheld,
+ # But added colors to the world reveal'd:
+ # When early Turnus, wak'ning with the light,
# -- Virgil, Aeneid
# allocate some useful colors, 1st is used for bkg
- $me->color({ color => $me->{background_color} }) if $me->{background_color};
+ my $bkg = $me->color({ color => $me->{background_color} }) if $me->{background_color};
$me->{color}{white} = $im->colorAllocate(255,255,255);
$me->{color}{black} = $im->colorAllocate(0,0,0);
$me->{color}{blue} = $im->colorAllocate(0, 0, 255);
@@ -256,8 +271,11 @@
$im->transparent($me->{color}{white})
if $me->{transparent};
- $im->rectangle(0, 0, $me->{width}-1, $me->{height}-1,
- $me->color({ color => ($me->{border_color} || 'black') }))
+ $im->filledRectangle( 0, 0, $me->{width}-1, $me->{height}-1, ($bkg || $me->{color}{white}));
+
+ my $bc = $me->{border_color} ? $me->img_color($me->{border_color}) : $me->{color}{black};
+
+ $im->rectangle(0, 0, $me->{width}-1, $me->{height}-1, $bc )
if $me->{draw_border};
$me;
@@ -269,13 +287,14 @@
my $opts = shift;
$me->analyze( $data, $opts );
-
+
unless( $opts->{style} ){
$opts->{style} = defined $data->[0]{min} ? 'range' : 'line';
}
-
+
push @{$me->{data}}, {data => $data, opts => $opts};
-
+ $me->{has_shadow} = 1 if $opts->{shadow};
+
$me;
}
@@ -286,13 +305,13 @@
return unless $me->{data};
return if $me->{all_done};
-
+
$me->adjust();
$me->clabels();
$me->xlabel();
$me->ylabel();
$me->title();
-
+
if( $me->{draw_tic_labels} ){
# move margin for xtics before we do ytics
$me->{margin_bottom} += 12;
@@ -301,14 +320,21 @@
$me->ytics();
$me->xtics();
+
+ # draw shadows
+ foreach my $d ( @{$me->{data}} ){
+ next unless $d->{opts}{shadow};
+ $me->plot_data( $d->{data}, $d->{opts}, $d->{opts}{shadow} );
+ }
+
$me->axii();
$me->drawgrid() unless $me->{grid_on_top};
-
+
# plot
foreach my $d ( @{$me->{data}} ){
- $me->plot_data( $d->{data}, $d->{opts} );
+ $me->plot_data( $d->{data}, $d->{opts}, undef );
}
-
+
$me->drawgrid() if $me->{grid_on_top};
$me->{all_done} = 1;
@@ -317,7 +343,7 @@
# The axis of the earth sticks out visibly through the centre of each and every town or city.
-# -- Oliver Wendell Holmes, The Autocrat of the Breakfast-Table
+# -- Oliver Wendell Holmes, The Autocrat of the Breakfast-Table
sub axii {
my $me = shift;
my $im = $me->{img};
@@ -325,7 +351,7 @@
# draw axii
$im->line( $me->xpt(-1), $me->ypt(-1), $me->xpt(-1), $me->ypt($me->{ymax}), $me->{color}{black});
$im->line( $me->xpt(-1), $me->ypt(-1), $me->xpt($me->{xmax}), $me->ypt(-1), $me->{color}{black});
-
+
# 'Talking of axes,' said the Duchess, 'chop off her head!'
# -- Alice in Wonderland
$me;
@@ -361,7 +387,7 @@
$me->plot();
$me->{img}->jpeg( @_ );
}
-
+
# xpt, ypt - convert graph space => image space
sub xpt {
@@ -393,13 +419,13 @@
$pt = $pt < $me->{yd_min} ? $me->{yd_min} : $pt;
$pt = $pt > $me->{yd_max} ? $me->{yd_max} : $pt;
-
+
$me->ypt( ($pt - $me->{yd_min}) * $me->{yd_scale} );
}
sub adjust {
my $me = shift;
-
+
# I have touched the highest point of all my greatness;
# -- Shakespeare, King Henry VIII
$me->{xmax} = $me->{width} - $me->{margin_right} - $me->{margin_left};
@@ -408,11 +434,11 @@
if( $me->{data} ){
$me->{xd_scale} = ($me->{xd_min} == $me->{xd_max}) ? 1
: $me->{xmax} / ($me->{xd_max} - $me->{xd_min});
-
+
$me->{yd_scale} = ($me->{yd_min} == $me->{yd_max}) ? 1
: $me->{ymax} / ($me->{yd_max} - $me->{yd_min});
}
-
+
$me;
}
@@ -425,7 +451,7 @@
$st = $data->[0]{time}; # start time
$et = $data->[-1]{time}; # end time
$pt = $st;
-
+
foreach my $s (@$data){
croak "data point out of order" if $s->{time} < $pt;
my $a = defined $s->{min} ? $s->{min} : $s->{value};
@@ -433,7 +459,7 @@
$a ||= 0 unless $me->{skip_undefined} || $opts->{skip_undefined};
$b ||= 0 unless $me->{skip_undefined} || $opts->{skip_undefined};
($a, $b) = ($b, $a) if $a > $b;
-
+
$min = $a if defined($a) && ( !defined($min) || $a < $min );
$max = $b if defined($b) && ( !defined($max) || $b > $max );
$pt = $s->{time};
@@ -451,7 +477,40 @@
# boxes are drawn from y=0
$min = 0 if $min > 0;
}
-
+
+ if( $opts->{smooth} || $me->{smooth} ){
+ # calculate derivative at each point (which may or may not be evenly spaced)
+ for my $i (0 .. @$data-1){
+ my $here = $data->[$i];
+ my $left = $i ? $data->[$i-1] : $data->[$i];
+ my $right = ($i!=@$data-1) ? $data->[$i+1] : $data->[$i];
+
+ my $dxl = $here->{time} - $left->{time};
+ my $dxr = $right->{time} - $here->{time};
+ my $dyl = $here->{value} - $left->{value};
+ my $dyr = $right->{value} - $here->{value};
+
+ if( $dxr && $dxl ){
+ my $dl = $dyl / $dxl;
+ my $dr = $dyr / $dxr;
+ if( $dl < 0 && $dr > 0 || $dl > 0 && $dr < 0 ){
+ # local extrema
+ $data->[$i]{dydx} = 0;
+ }else{
+ my $dm = ( $dl * $dxr + $dr * $dxl ) / ($dxr + $dxl);
+ # mathematicaly, $dm is the best estimate of the derivative, and gives the smoothest curve
+ # but, this way looks nicer...
+ my $d = (sort { abs($a) <=> abs($b) } ($dl, $dr, $dm))[0];
+ $data->[$i]{dydx} = ($d + $dm) / 2;
+ }
+ }elsif($dxr){
+ $data->[$i]{dydx} = $dyr / $dxr;
+ }elsif($dxl){
+ $data->[$i]{dydx} = $dyl / $dxl;
+ }
+ }
+ }
+
$me->{xd_min} = $st if $st && (!defined($me->{xd_min}) || $st < $me->{xd_min});
$me->{xd_max} = $et if $et && (!defined($me->{xd_max}) || $et > $me->{xd_max});
$me->{yd_min} = $min if !defined($me->{yd_min}) || $min < $me->{yd_min};
@@ -484,6 +543,21 @@
$me->adjust();
}
+sub img_color {
+ my $me = shift;
+ my $color = shift;
+
+ $color =~ s/^#//;
+ $color =~ s/\s//g;
+
+ return $me->{color}{$color} if $me->{color}{$color};
+ my($r,$g,$b) = map {hex} unpack('a2 a2 a2', $color);
+ my $i = $me->{img}->colorAllocate( $r, $g, $b );
+ $me->{color}{$color} = $i;
+
+ return $i;
+}
+
# choose proper color for plot
sub color {
my $me = shift;
@@ -495,14 +569,9 @@
# -- Monty Python, Holy Grail
my $c = $data->{color} || $opts->{color};
if( $c ){
- return $me->{color}{$c} if $me->{color}{$c};
- my($r,$g,$b) = map {hex} unpack('a2 a2 a2', $c);
- my $i = $me->{img}->colorAllocate( $r, $g, $b );
-
- $me->{color}{$c} = $i;
- return $i;
+ return $me->img_color( $c );
}
-
+
return $me->{color}{green};
}
@@ -557,10 +626,11 @@
my $st = shift;
my( $ay, $sc, $b, $prec );
+ return $me->{fmt_value}->($y) if $me->{fmt_value};
$sc = '';
$ay = abs($y);
$b = $me->{binary} ? 1024 : 1000;
-
+
if( $ay < 1 ){
if( $ay < 1/$b**3 ){
return "0";
@@ -612,7 +682,7 @@
$min = $me->{yd_min};
$max = $me->{yd_max};
$maxw = 0;
-
+
if( $min == $max ){
# not a very interesting graph...
my $lb = $me->pretty($min, 1); # QQQ
@@ -636,11 +706,11 @@
my $label = $me->pretty($y, $st);
my $w = 5 * length($label) + 6;
$maxw = $w if $w > $maxw;
-
+
push @tics, [$yy, $label, $w];
}
}
-
+
if( $me->{draw_tic_labels} ){
# move margin
$me->{margin_left} += $maxw;
@@ -653,7 +723,7 @@
sub drawgrid {
my $me = shift;
my $im = $me->{img};
-
+
foreach my $tic (@{$me->{grid}{y}}){
# ytics + horiz lines
my $yy = $tic->[0];
@@ -697,7 +767,7 @@
# too close to edge, shift
$a = $me->xdatapt($t) - $me->{width} + length($label) * 6 + 2;
}
-
+
$im->string(gdSmallFont, $me->xdatapt($t)-$a, $me->ypt(-6),
$label, $ll ? $me->{color}{red} : $me->{color}{black} );
}
@@ -712,7 +782,7 @@
my $range_days = $range_hrs / 24;
# return: step, labeltype, marktype, lti, tmod
-
+
if( $range < 720 ){
(60, $LT_HM, $MT_HR, 1, 1); # tics: 1 min
}
@@ -764,7 +834,7 @@
elsif( $range_days < 2000 ){
(3600*24*31, $LT_DM, $MT_NO, 4, 6); # tics: 6 month
}
-
+
else{
# NB: years less than 366 days are corrected for below
(3600*24*366, $LT_YR, $MT_NO, 4, 12); # tics: 1 yr
@@ -774,14 +844,14 @@
sub xtic_align_initial {
my $me = shift;
my $step = shift;
-
+
my $t = ($step < 3600) ? (int($me->{xd_min} / $step) * $step)
: (int($me->{xd_min} / 3600) * 3600);
if( $step >= 3600*24*365 ){
while(1){
# search for 1jan
- my @lt = localtime $t;
+ my @lt = $me->{tm_time}($t);
last if $lt[4] == 0 && $lt[3] == 1 && $lt[2] == 0;
# jump fwd: 1M, 1D, or 1H
my $dt = ($lt[4] != 11) ? 24*30 : ($lt[3] < 30) ? 24 : 1;
@@ -791,7 +861,7 @@
elsif( $step >= 3600*24*31 ){
while(1){
# find 1st of mon
- my @lt = localtime $t;
+ my @lt = $me->{tm_time}($t);
last if $lt[3] == 1 && $lt[2] == 0;
my $dt = ($lt[3] < 28) ? 24 : 1;
$t += $dt * 3600;
@@ -800,7 +870,7 @@
elsif( $step >= 3600*24 ){
while(1){
# search for midnight
- my @lt = localtime $t;
+ my @lt = $me->{tm_time}($t);
last unless $lt[2];
$t += 3600;
}
@@ -819,17 +889,17 @@
my $range = $me->{xd_max} - $me->{xd_min};
my $range_hrs = $range / 3600;
my $range_days = $range_hrs / 24;
-
+
my ($step, $labtyp, $marktyp, $lti, $tmod) = $me->xtic_range_data( $range );
my $t = $me->xtic_align_initial( $step );
# print "days: $range_days, lt: $labtyp, lti: $lti, tmod: $tmod, st: $step\n";
# print STDERR "t: $t ", scalar(localtime $t), "\n";
-
+
for( ; $t<$me->{xd_max}; $t+=$step ){
my $redmark = 0;
next if $t < $me->{xd_min};
- my @lt = localtime $t;
+ my @lt = $me->{tm_time}($t);
my @rlt = @lt;
# months go from 0. days from 1. absurd!
$lt[3]--;
@@ -850,7 +920,7 @@
$t -= $dt;
redo;
}
-
+
next if $lt[$lti] % $tmod;
next if $lt[3] && $lti > 3;
next if $lt[2] && $lti > 2;
@@ -863,7 +933,7 @@
$redmark = 1 if $marktyp == $MT_SU && !$lt[6]; # sunday
$redmark = 1 if $marktyp == $MT_M1 && !$lt[3]; # 1st of month
$redmark = 1 if $marktyp == $MT_Y1 && !$lt[3] && !$lt[4]; # 1 jan
-
+
my $label;
# NB: strftime obeys LC_TIME for localized day/month names
# (if locales are supported in the OS and perl)
@@ -897,7 +967,7 @@
push @tics, [$t, $redmark, $label];
}
$me->{grid}{x} = \@tics;
-
+
}
# it shall be inventoried, and every particle and utensil
@@ -910,7 +980,7 @@
my $me = shift;
return unless $me->{draw_data_labels};
-
+
my $rs = 0;
my $rm = 0;
if( $me->{data_label_style} eq 'box' ){
@@ -929,7 +999,7 @@
next unless $l;
my $w = length($l) * 5 + 6;
$w += $rm + $rs;
-
+
if( $tw + $w > $me->{width} - $me->{margin_left} - $me->{margin_right} ){
$r ++;
$tw = 0;
@@ -961,31 +1031,32 @@
my $me = shift;
my $data = shift;
my $opts = shift;
+ my $shadow = shift;
return unless $data && @$data;
-
+
# 'What did they draw?' said Alice, quite forgetting her promise.
# -- Alice in Wonderland
if( $opts->{style} eq 'line' ){
# 'You can draw water out of a water-well,' said the Hatter
# -- Alice in Wonderland
- $me->draw_line( $data, $opts );
+ $me->draw_line( $data, $opts, $shadow );
}
elsif( $opts->{style} eq 'filled' ){
# I should think you could draw treacle out of a treacle-well
# -- Alice in Wonderland
- $me->draw_filled( $data, $opts );
+ $me->draw_filled( $data, $opts, $shadow );
}
elsif( $opts->{style} eq 'range' ){
# did you ever see such a thing as a drawing of a muchness?
# -- Alice in Wonderland
- $me->draw_range( $data, $opts );
+ $me->draw_range( $data, $opts, $shadow );
}elsif( $opts->{style} eq 'points' ){
# and they drew all manner of things--everything that begins with an M--'
# -- Alice in Wonderland
- $me->draw_points( $data, $opts );
+ $me->draw_points( $data, $opts, $shadow );
}elsif( $opts->{style} eq 'box' ){
- $me->draw_boxes( $data, $opts );
+ $me->draw_boxes( $data, $opts, $shadow );
}else{
croak "unknown graph style--cannot draw";
}
@@ -999,77 +1070,128 @@
my $me = shift;
my $data = shift;
my $opts = shift;
+ my $shadow = shift;
my $im = $me->{img};
my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
- my($px, $py, $pxdpt, $pydpt);
+ my $thick = $opts->{thickness} || $me->{thickness};
+ my $smooth = $opts->{smooth} || $me->{smooth};
+ my $shcolor = $shadow ? $me->img_color($shadow->{color} || $me->{shadow_color} ) : undef;
+ my($px, $py, $pxdpt, $pydpt, $pdydx);
my $ypt0 = $me->ypt(0);
-
+
+ $thick += $shadow->{dw} if $shadow;
+ $me->set_thickness( $thick ) if $thick;
+
foreach my $s ( @$data ){
my $x = $s->{time};
my $y = $s->{value};
-
+
next if $x < $me->{xd_min} || $x > $me->{xd_max};
my $xdpt = $me->xdatapt($x);
my $ydpt = $me->ydatapt($y);
+ my $dydx;
+
+ if( $shadow ){
+ $xdpt += $shadow->{dx};
+ $ydpt += $shadow->{dy};
+ }
if( defined($y) || !$skipundef ){
-
+ my $color = $shadow ? $shcolor : $me->color($s, $opts);
+
if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <= $limit) ){
- my $poly = GD::Polygon->new;
- $poly->addPt($pxdpt, $ypt0);
- $poly->addPt($pxdpt, $pydpt);
- $poly->addPt($xdpt, $ydpt);
- $poly->addPt($xdpt, $ypt0);
- $im->filledPolygon($poly, $me->color($s, $opts));
+ if( $smooth ){
+ next unless defined $s->{dydx};
+ $dydx = - $s->{dydx} * $me->{yd_scale} / $me->{xd_scale};
+ $me->curve($pxdpt, $pydpt, $pdydx,
+ $xdpt, $ydpt, $dydx,
+ $smooth, \&curve_filled, [$color, $ypt0]);
+ }else{
+ my $poly = GD::Polygon->new;
+ $poly->addPt($pxdpt, $ypt0);
+ $poly->addPt($pxdpt, $pydpt);
+ $poly->addPt($xdpt, $ydpt);
+ $poly->addPt($xdpt, $ypt0);
+ $im->filledPolygon($poly, $color);
+ }
}else{
$im->line( $xdpt, $ypt0,
$xdpt, $ydpt,
- $me->color($s, $opts) );
+ $color);
}
$px = $x; $pxdpt = $xdpt;
$py = $y; $pydpt = $ydpt;
+ $pdydx = $dydx;
}else{
$px = undef;
}
}
+ $me->set_thickness( 1 ) if $thick;
}
sub draw_line {
my $me = shift;
my $data = shift;
my $opts = shift;
+ my $shadow = shift;
my $im = $me->{img};
my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
my $thick = $opts->{thickness} || $me->{thickness};
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
- my($px, $py, $pxdpt, $pydpt);
+ my $smooth = $opts->{smooth} || $me->{smooth};
+ my($px, $py, $pxdpt, $pydpt, $pdydx);
+ $thick += $shadow->{dw} if $shadow;
$me->set_thickness( $thick ) if $thick;
-
+
+ my $shcolor = $shadow ? $me->img_color($shadow->{color} || $me->{shadow_color} ) : undef;
+
foreach my $s ( @$data ){
my $x = $s->{time};
my $y = $s->{value};
next if $x < $me->{xd_min} || $x > $me->{xd_max};
-
+
my $xdpt = $me->xdatapt($x);
my $ydpt = $me->ydatapt($y);
+ my $dydx = $smooth ? - $s->{dydx} * $me->{yd_scale} / $me->{xd_scale} : undef;
+
+ if( $shadow ){
+ $xdpt += $shadow->{dx};
+ $ydpt += $shadow->{dy};
+ }
if( defined($y) || !$skipundef ){
+ my $color = $shadow ? $shcolor : $me->color($s, $opts);
+
+ if( $me->{antialias} && $thick == 1 ){
+ # GD cannot antialias a thick line
+ $im->setAntiAliased($color);
+ $color = gdAntiAliased;
+ }
+
if( defined($px) && (!$limit || $x - $px <= $limit) ){
- $im->line( $pxdpt, $pydpt,
- $xdpt, $ydpt,
- $me->color($s, $opts) );
+ if( $smooth ){
+ next unless defined $s->{dydx};
+ $me->curve($pxdpt, $pydpt, $pdydx,
+ $xdpt, $ydpt, $dydx,
+ $smooth, \&curve_line, [$color]);
+ }else{
+ $im->line( $pxdpt, $pydpt,
+ $xdpt, $ydpt,
+ $color );
+ }
}else{
$im->setPixel($xdpt, $ydpt,
- $me->color($s, $opts) );
+ $color );
}
$px = $x; $pxdpt = $xdpt;
$py = $y; $pydpt = $ydpt;
+ $pdydx = $dydx;
}else{
$px = undef;
}
@@ -1077,29 +1199,116 @@
$me->set_thickness( 1 ) if $thick;
}
+# GD has only circular arcs, not bezier or cubic splines
+# bezier math is easier than trying to use circular arcs
+sub curve {
+ my $me = shift;
+ my( $x0, $y0, $dydx0,
+ $x1, $y1, $dydx1,
+ $smooth, $fnc, $args ) = @_;
+
+ # pick bezier control points
+ # smooth = (.5 - 1) gives nice curves
+ # smooth > 1 gives straighter segments
+ # smooth <= .5 takes the graph on a drug trip
+ my $dxt = ($x1 - $x0) / ($smooth * 3);
+ my $cx0 = $x0 + $dxt;
+ my $cx1 = $x1 - $dxt;
+ my $cy0 = $y0 + $dydx0 * $dxt;
+ my $cy1 = $y1 - $dydx1 * $dxt;
+
+ # bezier coefficients
+ my $ax = - $x0 + 3 * $cx0 - 3 * $cx1 + $x1;
+ my $ay = - $y0 + 3 * $cy0 - 3 * $cy1 + $y1;
+ my $bx = 3 * $x0 - 6 * $cx0 + 3 * $cx1;
+ my $by = 3 * $y0 - 6 * $cy0 + 3 * $cy1;
+ my $cx = - 3 * $x0 + 3 * $cx0;
+ my $cy = - 3 * $y0 + 3 * $cy0;
+ my $dx = $x0;
+ my $dy = $y0;
+
+ # draw bezier curve
+ my $px = $x0;
+ my $py = $y0;
+
+ # my $im = $me->{img};
+ # $im->line($x0,$y0, $cx0,$cy0, $me->img_color('00ff00'));
+ # $im->line($x1,$y1, $cx1,$cy1, $me->img_color('00ff00'));
+ # $im->line($cx0,$cy0, $cx1,$cy1, $me->img_color('0000ff'));
+
+ my $ymax = $me->{height} - $me->{margin_bottom};
+ my $ymin = $me->{margin_top};
+
+ my $T = ($x1 - $x0) + abs($y1 - $y0);
+ for my $tt (1 .. $T){
+ my $t = $tt / $T;
+ my $x = $ax * $t**3 + $bx * $t**2 + $cx * $t + $dx;
+ my $y = $ay * $t**3 + $by * $t**2 + $cy * $t + $dy;
+
+ # QQQ - handle out-of-bounds segments how?
+ if( $y >= $ymin && $y <= $ymax && $py >= $ymin && $py <= $ymax ){
+ $fnc->($me, $px,$py, $x,$y, 0, @$args);
+ }else{
+ $fnc->($me, $px,$py, $x,$y, [$ymin, $ymax], @$args);
+ }
+ $px = $x; $py = $y;
+ }
+}
+
+sub curve_line {
+ my $me = shift;
+ my ($px, $py, $x, $y, $oob, $color) = @_;
+
+ return if $oob;
+ $me->{img}->line($px,$py, $x,$y, $color);
+}
+
+sub curve_filled {
+ my $me = shift;
+ my ($px, $py, $x, $y, $oob, $color, $y0) = @_;
+
+ if( $oob ){
+ my($ymin, $ymax) = @$oob;
+ $y = $ymin if $y < $ymin;
+ $py = $ymin if $py < $ymin;
+ $y = $ymax if $y > $ymax;
+ $py = $ymax if $py > $ymax;
+ }
+
+ my $poly = GD::Polygon->new;
+ $poly->addPt($px, $y0);
+ $poly->addPt($px, $py);
+ $poly->addPt($x, $y);
+ $poly->addPt($x, $y0);
+ $me->{img}->filledPolygon($poly, $color);
+}
+
+
sub draw_range {
my $me = shift;
my $data = shift;
my $opts = shift;
-
+ my $shadow = shift;
+
+ return if $shadow;
my $im = $me->{img};
my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
my($px, $pn, $pm, $pxdpt);
-
+
foreach my $s ( @$data ){
my $x = $s->{time};
my $a = defined $s->{min} ? $s->{min} : $s->{value};
my $b = defined $s->{max} ? $s->{max} : $s->{value};
my $xdpt = $me->xdatapt($x);
-
+
next if $x < $me->{xd_min} || $x > $me->{xd_max};
-
+
$a = $b if !defined($a) && $skipundef;
$b = $a if !defined($b) && $skipundef;
-
+
if( defined($a) || !$skipundef ){
-
+
if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <= $limit) ){
my $poly = GD::Polygon->new;
$poly->addPt($pxdpt, $me->ydatapt($pn));
@@ -1124,21 +1333,29 @@
my $me = shift;
my $data = shift;
my $opts = shift;
-
+ my $shadow = shift;
+
my $im = $me->{img};
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
-
+ my $shcolor = $shadow ? $me->img_color($shadow->{color} || $me->{shadow_color} ) : undef;
+
foreach my $s ( @$data ){
my $x = $s->{time};
my $y = $s->{value};
my $d = $s->{diam} || $opts->{diam} || 4;
- my $c = $me->color($s, $opts);
+ my $c = $shadow ? $shcolor : $me->color($s, $opts);
next if $x < $me->{xd_min} || $x > $me->{xd_max};
next if !defined($y) && $skipundef;
my $xdpt = $me->xdatapt($x);
my $ydpt = $me->ydatapt($y);
-
+
+ if( $shadow ){
+ $d += $shadow->{dw};
+ $xdpt += $shadow->{dx};
+ $ydpt += $shadow->{dy};
+ }
+
while( $d > 0 ){
$im->arc( $xdpt, $ydpt,
$d, $d, 0, 360,
@@ -1162,39 +1379,47 @@
my $me = shift;
my $data = shift;
my $opts = shift;
-
+ my $shadow = shift;
+
my $im = $me->{img};
my $defwid = def_box_width($data->[0]{time}, $data->[-1]{time}, scalar(@$data));
my $thick = $opts->{thickness} || $me->{thickness};
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
-
+ my $shcolor = $shadow ? $me->img_color($shadow->{color} || $me->{shadow_color} ) : undef;
+
+ $thick += $shadow->{dw} if $shadow;
$me->set_thickness( $thick ) if $thick;
-
+
foreach my $s ( @$data ){
my $x = $s->{time};
my $y = $s->{value};
my $w = $s->{width} || $opts->{width} || $me->{boxwidth} || $defwid;
- my $c = $me->color($s, $opts);
my $y0 = $opts->{boxbase} || $me->{boxbase} || 0;
-
+ my $c = $shadow ? $shcolor : $me->color($s, $opts);
+
next if $x < $me->{xd_min} || $x > $me->{xd_max};
next if !defined($y) && $skipundef;
# because GD cares...
- my $ya = $y > $y0 ? $y : $y0;
- my $yb = $y > $y0 ? $y0 : $y;
-
+ my $ya = $me->ydatapt($y > $y0 ? $y : $y0);
+ my $yb = $me->ydatapt($y > $y0 ? $y0 : $y);
+ my $xa = $me->xdatapt($x - $w/2);
+ my $xb = $me->xdatapt($x + $w/2);
+
+ if( $shadow ){
+ $xa += $shadow->{dx};
+ $xb += $shadow->{dx};
+ $ya += $shadow->{dy};
+ $yb += $shadow->{dy};
+ }
+
if( $opts->{filled} || $s->{filled} ){
- $im->filledRectangle( $me->xdatapt($x - $w/2), $me->ydatapt($ya),
- $me->xdatapt($x + $w/2), $me->ydatapt($yb),
- $c);
+ $im->filledRectangle( $xa, $ya, $xb, $yb, $c);
}else{
- $im->rectangle( $me->xdatapt($x - $w/2), $me->ydatapt($ya),
- $me->xdatapt($x + $w/2), $me->ydatapt($yb),
- $c);
+ $im->rectangle( $xa, $ya, $xb, $yb, $c);
}
}
-
+
$me->set_thickness( 1 ) if $thick;
}
@@ -1202,14 +1427,22 @@
=head1 EXAMPLE IMAGES
http://argus.tcp4me.com/shots.html
- http://search.cpan.org/src/JAW/Chart-Strip-1.05/eg/
+ http://search.cpan.org/src/JAW/Chart-Strip-1.07/eg/index.html
+
+=head1 LICENSE
+
+This software may be copied and distributed under the terms
+found in the Perl "Artistic License".
+
+A copy of the "Artistic License" may be found in the standard
+Perl distribution.
=head1 BUGS
There are no known bugs in the module.
=head1 SEE ALSO
-
+
Yellowstone National Park.
=head1 AUTHOR
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Conf.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Conf.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Conf.pm 2009-02-22 17:42:40.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Conf.pm 2010-01-10 17:23:17.000000000 -0500
@@ -5,10 +5,11 @@
# Date: 2002-Apr-03 09:13 (EST)
# Function: config file reading
#
-# $Id: Conf.pm,v 1.65 2009/02/22 22:42:40 jaw Exp $
+# $Id: Conf.pm,v 1.66 2010/01/10 22:23:17 jaw Exp $
# some bozo put a Config.pm in the standard perl dist
package Conf;
+use Argus::ReadConfig;
use strict;
use vars qw($doc $has_errors);
@@ -128,7 +129,7 @@
# read the config file(s)
-sub readconfig {
+sub readconfigfiles {
my $file = shift;
my $me = {};
my( @files );
@@ -166,101 +167,16 @@
$top->{cfdepth} = 0;
# $top->{notypos} = 1;
$top->{_test_mode} = 1 if $::opt_t || $::datadir eq '__' . 'DATADIR' . '__';
-
- while( defined( $_ = $me->nextline() ) ){
- # print STDERR " gotline: $_\n" if $::opt_d;
- eval {
- if( /^(Group|Host)\s/i ){
- $nomoredata = 1;
- $nomorespec = 1;
- $me->ungetline($_);
- $o = Group::readconfig($me, $top);
- push @kids, $o if $o;
- }
- elsif( /^Alias\s/i ){
- $nomoredata = 1;
- $nomorespec = 1;
- $me->ungetline($_);
- $o = Alias::readconfig($me, $top);
- push @kids, $o if $o;
- }
- elsif( /^Method\s/i ){
- $nomoredata = 1;
- $me->ungetline($_);
- NotMe::readconfig($me, $top);
- }
- elsif( /^cron\s/i ){
- $me->ungetline($_);
- my $c = UserCron::readconfig($me, $top);
- push @{ $top->{cronjobs} }, $c if $c;
- }
- elsif( /^Resolv\b/i ){
- $me->error( "Resolv block must appear before any Groups or Services" )
- if $nomorespec;
- $nomoredata = 1;
- $me->ungetline( "Service $_" ); # magic!
- $o = Service::readconfig($me, $top);
- }
- elsif( /^DARP\s/i ) {
- $me->error( "DARP block must appear before any Groups or Services" )
- if $nomorespec;
- $nomoredata = 1;
-
- if( $::HAVE_DARP ){
- $me->ungetline($_);
- DARP::readconfig($me, $top);
- }else{
- $me->error( "DARP not available on this system" );
- $me->eat_block();
- }
- }
-
- elsif( /:/ ){
- my ($k, $v) = split /:[ \t]*/, $_, 2;
- if( $nomoredata ){
- $me->warning( "additional data not permitted here (ignored)" );
- next;
- }
- if( Configable::has_attr($k, $doc, 'timespec') ){
- eval {
- $v = ::timespec($v);
- };
- $me->nonfatal("invalid timespec '$v'") if $@;
- }
-
- if( defined $top->{config}{$k} && $k !~ /^_/ ){
- if( Configable::has_attr($k, $doc, 'multi') ){
- $top->{config}{$k} .= $v;
- }else{
- $me->warning( "redefinition of parameter '$k'" );
- $top->{config}{$k} = $v;
- }
- }else{
- $top->{config}{$k} = $v;
- $top->{confck}{$k} = 1 if grep {$_ eq 'top'} @{$doc->{fields}{$k}{attrs}};
- }
-
- if( my $c = $doc->{fields}{$k}{callback} ){
- $c->($v, $me) unless $::opt_t;
- }
- }
- else{
- $me->nonfatal( "Huh? This does not look like a vaild config entry: '$_'" );
- $me->eat_block() if /\{\s*$/;
- $top->{conferrs} ++;
- die $me;
- }
- };
- if( $@ ){
- # QQQ
- die $@ if $@ != $me;
- }
+ eval {
+ readblock( $top, $me, 'top', 0, $doc );
+ $top->config($me);
+ };
+ if( $@ ){
+ # QQQ
+ die $@ if $@ != $me;
}
- push @{$top->{children}}, @kids;
- $top->config($me);
-
return if $::opt_t;
$top->clearcache(); # reclaim memory used by hasattr cache
eval {
@@ -277,13 +193,111 @@
$top;
}
+#sub _xxx {
+# while( defined( $_ = $me->nextline() ) ){
+# # print STDERR " gotline: $_\n" if $::opt_d;
+# eval {
+# if( /^(Group|Host)\s/i ){
+# $nomoredata = 1;
+# $nomorespec = 1;
+# $me->ungetline($_);
+# $o = Group->readconfig($me, $top);
+# push @kids, $o if $o;
+# }
+# elsif( /^Alias\s/i ){
+# $nomoredata = 1;
+# $nomorespec = 1;
+# $me->ungetline($_);
+# $o = Alias->readconfig($me, $top);
+# push @kids, $o if $o;
+# }
+# elsif( /^Method\s/i ){
+# $nomoredata = 1;
+# $me->ungetline($_);
+# NotMe->readconfig($me, $top);
+# }
+# elsif( /^cron\s/i ){
+# $me->ungetline($_);
+# my $c = UserCron->readconfig($me, $top);
+# push @{ $top->{cronjobs} }, $c if $c;
+# }
+# elsif( /^Resolv\b/i ){
+# $me->error( "Resolv block must appear before any Groups or Services" )
+# if $nomorespec;
+# $nomoredata = 1;
+# $me->ungetline( "Service $_" ); # magic!
+# $o = Service->readconfig($me, $top);
+# }
+# elsif( /^DARP\s/i ) {
+# $me->error( "DARP block must appear before any Groups or Services" )
+# if $nomorespec;
+# $nomoredata = 1;
+#
+# if( $::HAVE_DARP ){
+# $me->ungetline($_);
+# DARP->readconfig($me, $top);
+# }else{
+# $me->error( "DARP not available on this system" );
+# $me->eat_block();
+# }
+# }
+#
+# elsif( /:/ ){
+# my ($k, $v) = split /:[ \t]*/, $_, 2;
+# if( $nomoredata ){
+# $me->warning( "additional data not permitted here (ignored)" );
+# next;
+# }
+# if( Configable::has_attr($k, $doc, 'timespec') ){
+# eval {
+# $v = ::timespec($v);
+# };
+# $me->nonfatal("invalid timespec '$v'") if $@;
+# }
+#
+# if( defined $top->{config}{$k} && $k !~ /^_/ ){
+# if( Configable::has_attr($k, $doc, 'multi') ){
+# $top->{config}{$k} .= $v;
+# }else{
+# $me->warning( "redefinition of parameter '$k'" );
+# $top->{config}{$k} = $v;
+# }
+# }else{
+# $top->{config}{$k} = $v;
+# $top->{confck}{$k} = 1 if grep {$_ eq 'top'} @{$doc->{fields}{$k}{attrs}};
+# }
+#
+# if( my $c = $doc->{fields}{$k}{callback} ){
+# $c->($v, $me) unless $::opt_t;
+# }
+#
+# }
+# else{
+# $me->nonfatal( "Huh? This does not look like a vaild config entry: '$_'" );
+# $me->eat_block() if /\{\s*$/;
+# $top->{conferrs} ++;
+# die $me;
+# }
+# };
+# if( $@ ){
+# # QQQ
+# die $@ if $@ != $me;
+# }
+# }
+#
+# push @{$top->{children}}, @kids;
+# $top->config($me);
+#
+# }
+
sub eat_block {
my $me = shift;
+ my $n = shift;
while( defined( $_ = $me->nextline() ) ){
- print STDERR " ignoring: $_\n" if $::opt_d;
+ print STDERR " ignoring $n: $_\n" if $::opt_d;
last if /^\s*\}/;
- $me->eat_block() if /\{\s*$/;
+ $me->eat_block($n+1) if /\{\s*$/;
}
}
@@ -387,6 +401,7 @@
$fh = $me->{fd};
close $fh if $fh;
+ delete $me->{fd};
if( @{$me->{openfiles}} ){
($me->{fd}, $me->{file}, $me->{line}) = @{ pop @{$me->{openfiles}} };
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Configable.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Configable.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Configable.pm 2008-07-26 17:00:14.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Configable.pm 2010-01-10 17:23:18.000000000 -0500
@@ -5,10 +5,11 @@
# Date: 2002-Dec-30 23:29 (EST)
# Function: configurable objects
#
-# $Id: Configable.pm,v 1.27 2008/06/25 16:03:16 jaw Exp $
+# $Id: Configable.pm,v 1.28 2010/01/10 22:23:18 jaw Exp $
package Configable;
+use Argus::ReadConfig;
use strict;
use vars qw($doc);
@@ -251,8 +252,10 @@
# QQQ - this can be quite noisy
$cf->nonfatal("invalid timespec '$v'") if $@;
}
-
+
# install value
+ $kk =~ s/.*\s//; # 'foo bar' => 'bar'
+
if( $base ){
$me->{$base}{$kk} = $v;
}else{
@@ -399,6 +402,7 @@
foreach my $k (sort keys %{$me->{config}}){
my $v = $me->{config}{$k};
next if ($k =~ /^_/) && ::topconf('_hide_expr');
+ next if $k =~ / /;
$v =~ s/\#/\\\#/g;
$v =~ s/\n/\\n/g;
$v =~ s/\r/\\r/g;
@@ -407,9 +411,20 @@
unless $me->{confck}{$k} || $d->{conf}{notypos};
$r .= "\n";
}
+
+ # schedules
+ foreach my $k (sort keys %{$me->{config}}){
+ next unless $k =~ /^schedule /;
+ my $v = $me->{config}{$k};
+ my $rc = $v->gen_conf();
+ $rc =~ s/^/\t/gm;
+ $r .= $rc;
+ }
+
if(exists $me->{children} || $me->{cronjobs}){
my $rc;
foreach my $c (@{$me->{cronjobs}}, @{$me->{children}}){
+ print STDERR "ch: $c->{name}\n";
$rc .= $c->gen_conf();
}
if( $rc ){
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/DARP.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/DARP.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/DARP.pm 2008-06-25 12:03:17.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/DARP.pm 2010-01-10 17:23:18.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2003-Jan-23 21:23 (EST)
# Function: Distributed Argus Redundancy Protocol
#
-# $Id: DARP.pm,v 1.30 2008/06/25 16:03:17 jaw Exp $
+# $Id: DARP.pm,v 1.31 2010/01/10 22:23:18 jaw Exp $
package DARP;
@ISA = qw(Configable);
@@ -16,7 +16,7 @@
require Digest::HMAC;
Digest::MD5->import('md5');
Digest::HMAC->import('hmac_hex');
-
+
$::HAVE_DARP = 1;
};
}
@@ -127,69 +127,6 @@
sub unique { 'DARP' };
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new;
- my( $nomoredata );
-
- my $line = $cf->nextline();
- my($tag) = $line =~ /^DARP\s+\"(.*)\"/i;
-
- $me->{name} = $tag;
- $me->{parents} = [ $mom ] if $mom;
- $me->cfinit($cf, $tag, 'DARP');
- $me->{masters} = [];
- $me->{slaves} = [];
-
- while( defined($_ = $cf->nextline()) ){
- print STDERR " gotline: $_\n" if $::opt_d;
- if( /^\s*\}/ ){
- # done
- last;
- }
-
- elsif( /^master\s+\"(.*)\"\s+\{/i ){
- my $tag = $1;
- $nomoredata = 1;
- $cf->ungetline( "DARP_Slave __DARP {" );
- my $x = Service::readconfig($cf, $me, {tag => $tag, darp => 1} );
- push @{$me->{masters}}, $x;
- push @{$me->{children}}, $x;
- }
-
- elsif( /^slave /i ){
- $nomoredata = 1;
- $cf->ungetline( $_ );
- eval {
- my $x = DARP::Conf::readconfig($cf, $me);
- push @{ $me->{slaves} }, $x;
- push @{$me->{children}}, $x;
- };
- }
-
- elsif( /:/ ){
- my($k, $v) = split /:[ \t]*/, $_, 2;
-
- if( $nomoredata ){
- $me->warning( "additional data not permitted here (ignored)" );
- next;
- }
- $cf->warning( "redefinition of parameter '$k'" )
- if defined $me->{config}{$k};
- $me->{config}{$k} = $v;
- }
-
- else{
- eval{ $cf->error( "invalid entry in config file: '$_'" ); };
- $cf->eat_block() if /\{\s*$/;
- }
- }
-
- $me->config( $cf );
-
-}
-
sub gen_confs {
my $r = '';
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/DARP::Conf.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/DARP::Conf.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/DARP::Conf.pm 2008-06-25 12:03:17.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/DARP::Conf.pm 2010-01-10 17:23:18.000000000 -0500
@@ -5,7 +5,7 @@
# Created: 2003-Dec-04 16:53 (EST)
# Function: DARP Master (Server) config for each slave
#
-# $Id: DARP::Conf.pm,v 1.19 2008/06/25 16:03:17 jaw Exp $
+# $Id: DARP::Conf.pm,v 1.20 2010/01/10 22:23:18 jaw Exp $
# on darp master, darp::conf describes config for each slave.
@@ -91,44 +91,6 @@
}
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new();
- my( $line, $tag );
-
- $me->{parents} = [ $mom ] if $mom;
-
- $line = $cf->nextline();
-
- ($tag) = $line =~ /\"(.*)\"/;
-
- $me->cfinit($cf, $tag, 'Slave');
-
- while( defined($_ = $cf->nextline()) ){
- print STDERR "readconf: $_\n" if $::opt_d;
- if( /^\s*\}/ ){
- $me->config($cf);
- return $me;
- }
-
- elsif( /:/ ){
- my($k, $v) = split /:[ \t]*/, $_, 2;
-
- $cf->warning( "redefinition of parameter '$k'" )
- if defined $me->{config}{$k};
- $me->{config}{$k} = $v;
- }
-
- else{
- eval{ $cf->error( "invalid entry in config file: '$_'" ); };
- $cf->eat_block() if /\{\s*$/;
- }
- }
-
- $me;
-}
-
################################################################
Doc::register( $doc );
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Group.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Group.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Group.pm 2008-07-28 19:19:27.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Group.pm 2010-01-10 17:23:18.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-03 08:56 (EST)
# Function: the group class
#
-# $Id: Group.pm,v 1.44 2008/07/28 23:19:27 jaw Exp $
+# $Id: Group.pm,v 1.45 2010/01/10 22:23:18 jaw Exp $
package Group;
@@ -54,95 +54,6 @@
$me->{cftype} = 'Group';
}
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new;
- my( $line, $type, $name, $x, $nomoredata, $nhost, @kinder );
-
- $me->{parents} = [ $mom ] if $mom;
-
- $line = $cf->nextline();
- ($type, $name) = $line =~ /(Group|Host)\s+\"(.*)\"/i;
- $me->cfinit($cf, $name, "\u\L$type");
-
- unless( $name ){
- eval{ $cf->error( "invalid entry in config file: '$_'" ); };
- $cf->eat_block() if $line =~ /\{\s*$/;
- return ;
- }
-
- while( defined($_ = $cf->nextline()) ){
- # print STDERR "readgroup: $_\n" if $::opt_d;
- if( /^\s*\}/ ){
- $me->{children} = [ @kinder ];
- $me->config($cf);
- return $me;
- }
-
- elsif( /^(Group|Host)\s/i ){
- $nomoredata = 1;
- $cf->ungetline($_);
- $x = Group::readconfig($cf, $me);
- push @kinder, $x if $x;
- }
-
- elsif( /^Alias\s/i ){
- $nomoredata = 1;
- $cf->ungetline($_);
- $x = Alias::readconfig($cf, $me);
- push @kinder, $x if $x;
- }
-
- elsif( /^(Service)/i ){ # no, not Service\s, we permit a ':' for symmetry
- $nomoredata = 1;
- $cf->ungetline($_);
- $x = Service::readconfig($cf, $me);
- push @kinder, $x if $x;
- }
- elsif( /^cron\s/i ){
- $cf->ungetline($_);
- my $c = UserCron::readconfig($cf, $me);
- push @{ $me->{cronjobs} }, $c if $c;
- }
-
- elsif( /:/ ){
- my($k, $v) = split /:[ \t]*/, $_, 2;
- # data must be before Service|Group|Alias
- # disallow
- # Group "foo" {
- # x1: value
- # Service TCP/FOO
- # x2: value <- error
- # }
- if( $nomoredata ){
- $cf->warning( "additional data not permitted here (ignored)" );
- next;
- }
-
- my $warn = 1 if defined $me->{config}{$k};
-
- if( $k eq 'hostname' ){
- # allow Host to redefine hostname without a warning
- $warn = 0 unless $nhost++ > 0;
- }
-
- $cf->warning( "redefinition of parameter '$k'" )
- if $warn;
- $me->{config}{$k} = $v;
- }
-
- else{
- eval{ $cf->error( "invalid entry in config file: '$_'" ); };
- $cf->eat_block() if /\{\s*$/;
- $me->{conferrs} ++;
- # attempt to continue
- }
- }
-
- $me;
-}
-
sub gen_conf {
my $me = shift;
my( $k, $c, $r, $rc, $t );
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/MonEl.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/MonEl.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/MonEl.pm 2008-10-25 12:34:53.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/MonEl.pm 2010-01-10 17:23:19.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-02 17:11 (EST)
# Function: Monitor Element class
#
-# $Id: MonEl.pm,v 1.164 2008/10/25 16:34:53 jaw Exp $
+# $Id: MonEl.pm,v 1.166 2010/01/10 22:23:19 jaw Exp $
package MonEl;
@ISA = qw(Configable);
@@ -90,7 +90,7 @@
descr => 'is the siren currently ringing',
attrs => ['bool'],
},
-
+
definedinfile => {
descr => 'file the object was defined in',
},
@@ -178,7 +178,7 @@
depend::onme => {
descr => 'list of objects for which I am the dependency culprit',
},
-
+
# transition
siren => {
descr => 'should alarm ring',
@@ -207,7 +207,7 @@
attrs => ['config', 'bool'],
default => 'no',
},
-
+
status => {
descr => 'current real status (up or down)',
vals => ['up', 'down'], # degraded, attention, bouncing
@@ -222,7 +222,7 @@
prevovstatus => {
descr => 'previous value of ovstatus',
},
-
+
transtime => {
descr => 'time of last transition',
},
@@ -243,7 +243,7 @@
prevseverity => {
descr => 'previous severity level',
},
-
+
# notification
# message_fmt + message{up,dn} => %M
@@ -313,7 +313,7 @@
default => 'friendly',
html => 'notif',
},
-
+
notify::notify => {
descr => 'list of addresses to notify',
exmpl => 'mail:user@example.com qpage:sysop aim:joeysmith vxml:2155551234',
@@ -364,7 +364,7 @@
attrs => ['config', 'inherit', 'timespec'],
default => 3600,
versn => '3.6',
- html => 'notif',
+ html => 'notif',
},
notify::autoack => {
descr => 'automatically ack notifications',
@@ -390,7 +390,7 @@
versn => '3.6',
html => 'notif',
},
-
+
notify::escalate => {
descr => 'list of times (in minutes or as a timespec) and addresses for notification escalation',
attrs => ['config', 'inherit'],
@@ -411,7 +411,7 @@
versn => '3.5',
html => 'notif',
},
-
+
notify::priority => {
# not used by internal notification methods, but is available
# for user defined methods to use as they see fit
@@ -428,7 +428,7 @@
notify::list => {
descr => 'list of all outstanding notifications',
},
-
+
# web page
web::transtime => {
descr => 'last time the object changed',
@@ -564,7 +564,7 @@
versn => '3.5',
default => 120,
},
-
+
label_left => {
descr => 'label to use on the left side of the webpage',
attrs => ['config'],
@@ -602,8 +602,8 @@
descr => 'informational text to be used in VXML TTS, may contain SSML',
attrs => ['config'],
versn => '3.5',
- },
-
+ },
+
#### ACLs
acl_mode => {
descr => 'deprecated, acl mode is now automatic',
@@ -661,7 +661,7 @@
},
acl_flush => {
descr => 'extended mode access control list - flush page access',
- attrs => ['config', 'acl'],
+ attrs => ['config', 'acl'],
ifacl => 'acl_root',
versn => '3.1',
html => 'acl',
@@ -722,7 +722,7 @@
versn => '3.5',
html => 'acl',
},
-
+
# stats
logsize => {
descr => 'maximum number of log entries to keep',
@@ -735,7 +735,7 @@
versn => '3.5', # previously, not inherited
default => 'no',
},
-
+
stats::log => {
descr => 'object event log - array of [Time, status, ovstatus, tag, msg]',
},
@@ -774,7 +774,7 @@
image::gr_colors => {
descr => 'colors used on group-level graphs - list of RRGGBB RRGGBB ...',
attrs => ['config', 'inherit'],
- exmpl => 'FF2222 4456CC CCFF44',
+ exmpl => 'FF2222 4456CC CCFF44',
versn => '3.2',
html => 'graphing',
},
@@ -810,10 +810,25 @@
descr => 'thickness of lines on large graphs (requires GD >= 2.07)',
attrs => ['config', 'inherit'],
exmpl => '3',
- default => 1,
+ default => 2,
versn => '3.5',
html => 'graphing',
},
+ image::gr_drop_shadow => {
+ descr => 'add a drop shadow on graphs',
+ attrs => ['config', 'inherit', 'bool'],
+ default => 'yes',
+ versn => '3.7',
+ html => 'graphing',
+ },
+ image::gr_smooth => {
+ descr => 'connect the dots with smooth curves instead of straight lines',
+ attrs => ['config', 'inherit'],
+ default => 1,
+ versn => '3.7',
+ html => 'graphing',
+ },
+
image::xlabel => {
descr => 'text label to use on x-axis of graphs',
attrs => ['config', 'inherit'],
@@ -885,21 +900,21 @@
attrs => ['config', 'inherit', 'bool'],
default => 'yes',
versn => '3.5',
- html => 'graphing',
+ html => 'graphing',
},
image::gr_show_hours => {
descr => 'should the hours graph be displayed',
attrs => ['config', 'inherit', 'bool'],
default => 'yes',
versn => '3.5',
- html => 'graphing',
+ html => 'graphing',
},
image::gr_show_days => {
descr => 'should the days graph be displayed',
attrs => ['config', 'inherit', 'bool'],
default => 'yes',
versn => '3.5',
- html => 'graphing',
+ html => 'graphing',
},
image::transparent => {
descr => 'should the background of graphs be transparent',
@@ -924,7 +939,7 @@
versn => '3.5',
html => 'interfacing',
},
-
+
################################################################
# misc
################################################################
@@ -961,7 +976,7 @@
sub unique {
my $me = shift;
my( $x, $n, $nn );
-
+
return $me->{unique} if $me->{unique};
if( $me->{parents} && $me->{parents}[0] ){
@@ -1019,7 +1034,7 @@
$me->init_from_config( $cf, $doc, 'image' ) if $me->{graph};
$me->DARP::Misc::init($cf) if $::HAVE_DARP;
$me->cfcleanup();
-
+
$me->{uname} ||= $me->{name};
$u = $me->unique();
if( $byname{$u} ){
@@ -1033,7 +1048,7 @@
$me->{children} ||= []; # prevent warning
$me->{label_left} = $me->{label_left} || $me->{label} || $me->{label_left_maybe};
$me->{label_right} = $me->{label_right} || $me->{label} || $me->{label_right_maybe};
-
+
$me->{status} = $me->{ovstatus} = 'up';
$me->{currseverity} = 'clear';
$me->{alarm} = 0;
@@ -1064,7 +1079,7 @@
$me->{image}{title} = $me->{label_right}
unless defined $me->{image}{title};
-
+
if( $me->{passive} ){
$me->{flags} .= " *passive*";
$me->{siren} = 0;
@@ -1073,7 +1088,7 @@
$me->{notify}{"sendnotify.$_"} = 0 for qw(critical major minor warning clear);
# QQQ - set an override ?
}
-
+
$me->{flags} .= " status-ignored" if $me->{nostatus};
$me->{flags} .= " gravity-up" if $me->{gravity} eq 'up';
$me->{flags} .= " siren-quiet" unless $me->{siren};
@@ -1088,17 +1103,17 @@
my $oldf = "$::datadir/$d/" . $me->filename();
rename $oldf, $newf if -f $oldf && !-f $newf;
}
-
+
$me->check_typos( $cf ) if $cf;
Doc::check( $me ) if $::opt_T;
$me->stats_load();
-
+
if( $me->can('init_hook') ){
$me->init_hook($cf);
}
$isdown{$u} = 1 if $me->{ovstatus} eq 'down';
-
+
1;
}
@@ -1107,7 +1122,7 @@
sub friendly_messageup {}
sub friendly_messagedn {}
-
+
END {
deconfigure();
}
@@ -1127,7 +1142,7 @@
sub recycle {
my $me = shift;
my $cascade = shift;
-
+
# remove myself from my parents and children
foreach my $c (@{$me->{children}}){
$c->{parents} = [ grep { $_ ne $me }
@@ -1143,7 +1158,7 @@
@{$p->{children}} ];
$p->{web}{transtime} = $^T; # force web page rebuild
}
-
+
$me->{children} = $me->{parents} = undef;
$me->{notify}{list} = undef;
delete $byname{ $me->unique() };
@@ -1178,7 +1193,7 @@
sort { $a->[1] cmp $b->[1] }
map { [ $_, $_->sort_key() ] }
@{$me->{children}};
-
+
}
foreach my $c ( @{$me->{children}} ){
@@ -1231,7 +1246,7 @@
sub check_depends {
my $me = shift;
-
+
# check dependencies
foreach my $dn (split /\s+/, $me->{depends}){
my $dp = $byname{$dn};
@@ -1257,12 +1272,12 @@
my $cf = shift;
my( $dt, @ndl );
-
+
# check depend list. make sure targets are valid.
if( $me->{depends} && !ref $me->{depends} ){
foreach my $d (split /\s+/, $me->{depends}){
my $x = $byname{$d};
-
+
if( $x == $me ){
$me->warning("Cannot depend on self (ignored)");
next;
@@ -1275,7 +1290,7 @@
# we keep it, even if invalid...
push @ndl, $d;
}
-
+
if( @ndl ){
# and we keep it in a string (not [obj, ...]) :
# - keep recycle easier
@@ -1291,7 +1306,7 @@
# We are interested in others when they are interested in us.
# -- Publius Syrus, maxim 16
# determine if they are interested in us
-
+
if( $me->{parents} && @{$me->{parents}}){
my $mom = $me->{parents}[0];
my $ip;
@@ -1316,13 +1331,13 @@
# Top is not particularly interesting
$me->{interesting} = undef;
}
-
+
# recurse
foreach my $c (@{$me->{children}}){
$c->resolve_depends($cf);
}
-
+
}
my %TYPEMAP = (
@@ -1333,14 +1348,14 @@
cron => 'UserCron',
error => 'Error',
alias => 'Alias',
- # RSN - DARP,
+ # RSN - DARP,
);
sub create_object {
my $cf = shift;
my $param = shift;
- my( $mom, $name, $type, $jiggle, %conf );
-
+ my( $mom, $name, $type, $jiggle, %conf, %sched );
+
foreach my $k (keys %$param){
my $v = $param->{$k};
@@ -1350,20 +1365,25 @@
$mom = $p;
next;
}
-
+
if( $k eq 'name' ){ $name = $v; next }
if( $k eq 'type' ){ $type = $v; next }
if( $k eq 'jiggle'){ $jiggle = $v; next }
-
+
next if $k =~ /^(arguscgi|argusctl|func|quiet|seqno)$/;
-
+
if( $k =~ /^(notypos|definedinfile|definedonline|definedattime)$/ ){
$conf{$k} = $v;
next;
}
if( $k =~ /^config::(.+)/ ){
- $conf{config}{$1} = $v;
+ my $kk = $1;
+ if( $k =~ /schedule (.+)/ ){
+ $sched{$1} = $v;
+ next;
+ }
+ $conf{config}{$kk} = $v;
}
}
@@ -1375,15 +1395,19 @@
my $me = $t->new( %conf );
$me->{parents} = [ $mom ] if $mom;
$me->cfinit($cf, $name, $type);
-
+
+ for my $sk (keys %sched){
+ my $s = Argus::Schedule->unserialize($cf, $me, $sk, $sched{$sk});
+ }
+
return $cf->error( $cf->{error} || 'create failed' )
unless $me->config($cf);
-
+
push @{$mom->{children}}, $me if $mom;
$mom->{web}{transtime} = $^T if $mom; # force web page rebuild
$me->resolve_depends($cf);
-
+
if( !defined($jiggle) || $jiggle ){
$me->jiggle();
}
@@ -1408,7 +1432,7 @@
sub summary_old {
my $me = shift;
-
+
my($csv, %cs);
for my $c (@{$me->{children}}){
my $cc = $c;
@@ -1423,12 +1447,12 @@
$cs{ $cc->{ovstatus} } ++;
next;
}
-
+
if( $cc->{override} ){
$cs{override} += @{$cc->{children}};
next;
}
-
+
# what severity are down items?
$csv = $cc->{currseverity} if $cc->{ovstatus} eq 'down' &&
$MonEl::severity_sort{$cc->{currseverity}} > $MonEl::severity_sort{$csv};
@@ -1453,7 +1477,7 @@
sub janitor {
my %keep = map { ($_->filename() => 1) } @all;
-
+
# clean up orphaned html, stats + graph files
foreach my $d ( [ "$::datadir/html", $MID_AGE ],
[ "$::datadir/stats", $OLD_AGE ],
@@ -1468,11 +1492,11 @@
my $dir = shift;
my $age = shift;
my $keep = shift;
-
+
opendir(MD, $dir);
my @files = readdir(MD);
closedir MD;
-
+
foreach my $f (@files){
my $fd = "$dir/$f";
next if $f =~ /^\./;
@@ -1493,7 +1517,7 @@
sub cmd_list {
my $ctl = shift;
my( $x );
-
+
$ctl->ok();
foreach $x (@all){
@@ -1536,7 +1560,7 @@
my $v = $x->{$k};
next unless defined $v;
next if $b eq 'snmp' && $k =~ /community|snmppass|snmpprivpass/ && ::topconf('_hide_comm');
-
+
if( ref($v) ){
$v = '#<REF>';
}else{
@@ -1551,7 +1575,7 @@
my $ctl = shift;
my $param = shift;
my( $b, $x, $k, $v );
-
+
$x = $byname{ $param->{object} };
if( $x ){
$ctl->ok();
@@ -1565,7 +1589,7 @@
$ctl->write( "__osinfo:\t$::OSINFO\n" );
# ...
}
-
+
foreach $b ('', 'override', 'stats', 'web', 'notify', 'image', 'depend', 'bios', 'ovstatussummary'){
next unless !$b || $x->{$b};
foreach $k (sort ($b ? (keys %{$x->{$b}}) : (keys %$x))){
@@ -1590,7 +1614,7 @@
sub cmd_annotate {
my $ctl = shift;
my $param = shift;
-
+
my $x = $byname{ $param->{object} };
if( $x ){
if( $param->{text} ){
@@ -1625,7 +1649,7 @@
my $ctl = shift;
my $param = shift;
my( $c );
-
+
my $x = $byname{ $param->{object} };
if( $x ){
$ctl->ok();
@@ -1644,7 +1668,7 @@
my $ctl = shift;
my $param = shift;
my( $c );
-
+
my $x = $byname{ $param->{object} };
if( $x ){
$ctl->ok();
@@ -1652,9 +1676,10 @@
$ctl->write("name:\t$x->{name}\n");
$ctl->write("parent:\t". $x->{parents}[0]->unique() ."\n")
if $x->{parents} && $x->{parents}[0];
-
+
foreach my $k (sort keys %{$x->{config}}){
my $v = $x->{config}{$k};
+ $v = $v->get_config_data() if ref($v); # schedules
next unless defined $v;
$v = encode($v);
$ctl->write("config::$k:\t$v\n");
@@ -1669,7 +1694,7 @@
}
# ...
}
-
+
$ctl->final();
}else{
$ctl->bummer(404, 'Object Not Found');
@@ -1704,7 +1729,7 @@
my( $x, $p, $r );
$x = $byname{ $param->{object} };
-
+
if( $x ){
$p = decode( $param->{param} );
eval {
@@ -1712,7 +1737,7 @@
};
if( $@ ){
return $ctl->bummer(404, ${$@} );
- }
+ }
$ctl->ok();
$ctl->write( "param: $param->{param}\n" );
$ctl->write( "object: $param->{object}\n" );
@@ -1723,7 +1748,7 @@
}
}
-# setparam should be used with extreme caution, you can cause serious damage...
+# setparam should be used with extreme caution, you can cause serious damage...
# perhaps it should be removed/disabled in non-development versions?
# hmmm, well for now, here is a gun, don't shoot your foot.
sub cmd_setparam {
@@ -1825,7 +1850,7 @@
foreach my $c (@{$me->{children}}){
my $cc = $c;
# if an alias, pass through, but use the label of the alias
- $cc = $c->aliaslookup() if $c->can('aliaslookup');
+ $cc = $c->aliaslookup() if $c->can('aliaslookup');
next if $cc->{web}{hidden};
my @x = $cc->graphlist();
foreach my $x (@x){
@@ -1846,7 +1871,7 @@
my $l = $d->[1];
next unless $l;
my $w = length($l) * 5 + 15;
-
+
if( $tw + $w > 624 ){
$th += 10;
$tw = 0;
@@ -1882,7 +1907,7 @@
$ctl->write( "icon: ". encode($x->{web}{icon}) . "\n");
$ctl->write( "picasso: ". encode(::topconf('picasso_prog')) . "\n")
if ::topconf('picasso_prog');
-
+
foreach my $k (keys %{$x->{image}} ){
$ctl->write("$k:\t" . encode($x->{image}{$k}) ."\n" );
}
@@ -1891,7 +1916,7 @@
my $t = join( ' ', map{ encode($_) } (sort keys %{$x->{darp}{tags}}) );
$ctl->write("taglist: $t\n");
}
-
+
$ctl->final();
}else{
$ctl->bummer(404, 'Object Not Graphable');
@@ -1945,7 +1970,7 @@
if( $mom && (!defined($param->{jiggle}) || $param->{jiggle}) ){
$mom->jiggle();
}
-
+
$byname{Top}->{definedattime} = $^T;
$ctl->ok_n();
}else{
@@ -1963,7 +1988,7 @@
my $obj;
eval {
my $cf = NullConf->new();
-
+
$obj = create_object( $cf, $param );
$obj->loggit( msg => "Created $param->{type} $obj->{name}",
tag => 'CREATE' ) unless $param->{quiet};
@@ -2032,7 +2057,7 @@
sub cmd_summary {
my $ctl = shift;
my $param = shift;
-
+
my $x = $byname{ $param->{object} };
if( $x ){
my $smy = $x->summary();
@@ -2051,7 +2076,7 @@
sub cmd_check_now {
my $ctl = shift;
my $param = shift;
-
+
my $x = $byname{ $param->{object} };
if( $x ){
$x->check_now();
@@ -2064,7 +2089,7 @@
sub cmd_down_list {
my $ctl = shift;
my $param = shift;
-
+
$ctl->ok();
for my $o ( keys %isdown ){
my $x = $byname{ $o };
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/NotMe.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/NotMe.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/NotMe.pm 2008-06-25 12:03:18.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/NotMe.pm 2010-01-10 17:23:19.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Oct-22 16:06 (EDT)
# Function: Notification Method base class
#
-# $Id: NotMe.pm,v 1.40 2008/06/25 16:03:18 jaw Exp $
+# $Id: NotMe.pm,v 1.41 2010/01/10 22:23:19 jaw Exp $
package NotMe;
# but I seek my master, and my master seeks not me
@@ -55,9 +55,51 @@
attrs => ['config'],
versn => '3.3',
},
+
+ 'schedule::schedule critical' => {
+ descr => 'schedule specifying when to send critical notifications',
+ attrs => ['config', 'sched'],
+ versn => '3.7',
+ html => 'schedule',
+ },
+ 'schedule::schedule major' => {
+ descr => 'schedule specifying when to send major notifications',
+ attrs => ['config', 'sched'],
+ versn => '3.7',
+ html => 'schedule',
+ },
+ 'schedule::schedule minor' => {
+ descr => 'schedule specifying when to send minor notifications',
+ attrs => ['config', 'sched'],
+ versn => '3.7',
+ html => 'schedule',
+ },
+ 'schedule::schedule warning' => {
+ descr => 'schedule specifying when to send warning notifications',
+ attrs => ['config', 'sched'],
+ versn => '3.7',
+ html => 'schedule',
+ },
+ 'schedule::schedule clear' => {
+ descr => 'schedule specifying when to send clear notifications',
+ attrs => ['config', 'sched'],
+ versn => '3.7',
+ html => 'schedule',
+ },
},
};
+sub permit_now {
+ my $dst = shift;
+ my $sev = shift;
+
+ my( $meth, $addr ) = dst2m_a($dst);
+ my $m = $methods{$meth};
+
+ return 1 unless $m->{schedule}{$sev};
+ return $m->{schedule}{$sev}->permit_now();
+}
+
sub transmit {
my $note = shift;
my $dst = shift;
@@ -150,12 +192,6 @@
$me;
}
-sub config {
- my $me = shift;
-
- $me;
-}
-
# null notification method
sub null {}
@@ -257,43 +293,21 @@
$txt;
}
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new();
-
- my $line = $cf->nextline();
- my($name) = $line =~ /^Method\s+\"(.*)\"/i;
- $me->{parents} = [ $mom ] if $mom;
- $me->cfinit($cf, $name, 'Method');
-
- while( defined($_ = $cf->nextline()) ){
- # print STDERR " gotline: $_\n" if $::opt_d;
- if( /^\s*\}/ ){
- # done
- last;
- }
- elsif( /:/ ){
- my($k, $v) = split /:[ \t]*/, $_, 2;
- $cf->warning( "redefinition of parameter '$k'" )
- if defined $me->{config}{$k};
- $me->{config}{$k} = $v;
- }
- else{
- $me->{conferrs} ++;
- return $cf->error( "invalid entry in config file: '$_'" );
- }
- }
+sub config {
+ my $me = shift;
+ my $cf = shift;
+ my $name = $me->{name};
$me->init_from_config($cf, $doc, '');
+ $me->init_from_config($cf, $doc, 'schedule');
# if redefining a builtin, and no command is specified, copy
if( $methods{$name} && $methods{$name}{builtin} ){
$me->{command} ||= $methods{$name}{command};
}
-
+
unless($me->{command}){
- eval{ $cf->error( "invalid Notification Method - command not specified" ) };
+ $cf->nonfatal( "invalid Notification Method - command not specified" );
return;
};
@@ -302,7 +316,7 @@
if $methods{$name} && !$methods{$name}{builtin};
$me->check_typos($cf);
-
+
$methods{$name} = $me;
}
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Notify.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Notify.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Notify.pm 2008-10-25 12:34:53.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Notify.pm 2010-01-10 17:23:20.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-12 20:06 (EDT)
# Function: Tell someone what happened
#
-# $Id: Notify.pm,v 1.76 2008/10/25 16:34:53 jaw Exp $
+# $Id: Notify.pm,v 1.77 2010/01/10 22:23:20 jaw Exp $
package Notify;
use NotMe;
@@ -15,7 +15,7 @@
use strict;
my $lastupd; # time of last notification or ack
-my %byid = ();
+my %byid = ();
my %lastsent = (); # by dest
my %queue = (); # by dest => {not, tag}
my %unacked = (); # by id
@@ -45,7 +45,7 @@
# do not notify if notifies are not wanted
return unless value_at_severity('sendnotify', $obj);
-
+
if( $obj->{status} eq 'down' ){
$msg = $obj->{notify}{messagedn};
$fmt = $obj->{notify}{message_fmtdn};
@@ -57,16 +57,16 @@
}
$fmt ||= $obj->{notify}{message_fmt};
-
+
if( $param{audit} ){
# notify is an audit channel
$msg = 'audit: %A';
$aa = 1;
}
-
+
# do not notify if user specified an empty msg
return unless $msg;
-
+
$me = {
obj => $obj,
created => $^T,
@@ -93,13 +93,13 @@
bless $me; # gesundheit
$me->{msg} = $me->expand($fmt, $msg, $obj);
-
+
if( $me->can('notify_policy') ){
return unless $me->notify_policy();
}
-
+
return unless $me->init($obj);
-
+
$me->loggit( 'system', 'created' );
$me->notify();
}
@@ -148,7 +148,7 @@
}
$notify = $n;
}
-
+
# set status of each rcpt
$me->{sendto} = [ { n => 0, start => 0, who => [] } ];
foreach my $dst ( split /\s+/, $notify ){
@@ -188,7 +188,7 @@
::loggit( "invalid timespec ($nt) for escalation.", 1 );
}
next unless $nt;
-
+
$me->{sendto}[$n] = { n => $n, start => $nt, who => [@a] };
$n ++;
}
@@ -197,10 +197,10 @@
push @{$obj->{notify}{list}}, $me
unless $me->{audit}; # do not list audit msgs in object notify list
-
+
$byid{$me->{idno}} = $me;
$lastupd = $^T;
-
+
if( $me->{state} eq 'active' ){
$unacked{$me->{idno}} = $me;
}
@@ -211,7 +211,7 @@
$me->{timezone} = $obj->{notify}{timezone};
$me->{mailfrom} = $obj->{notify}{mail_from};
$me->{unack_to} = $obj->{notify}{unack_timeout};
-
+
1;
}
@@ -235,7 +235,7 @@
chop( $id = <F> );
$id ++;
while( exists $byid{$id} ){ $id = int(rand( 65535 << (++$n/1000) )); }
-
+
seek F, 0, 0;
print F "$id\n";
close F;
@@ -269,7 +269,7 @@
foreach my $dst (keys %{$me->{status}}){
print N "status: ", encode($dst), " ", encode($me->{status}{$dst}), "\n";
}
-
+
foreach my $s (@{$me->{sendto}}){
print N "sendto: $s->{start}";
foreach my $dst (@{$s->{who}}){
@@ -281,7 +281,7 @@
foreach my $l (@{$me->{log}}){
print N "log: $l->{time} ", (encode($l->{who}) || '_') , " ", encode($l->{msg}), "\n";
}
-
+
close N;
}
@@ -313,13 +313,13 @@
}
}
close N;
-
+
# too old and not still active? toss
if( $me->{state} ne 'active' && $^T - $me->{created} > $OLD_AGE ){
unlink $f;
return;
}
-
+
bless $me;
$me->init($obj);
}
@@ -329,11 +329,11 @@
sub notify {
my $me = shift;
my( $l );
-
+
foreach my $dst ( @{$me->{sendto}[0]{who}} ){
$me->sendorqueue($dst);
}
-
+
$me->{sentcnt} ++;
$me->{lastsent} = $^T;
$me->ack() if $me->{autoack};
@@ -344,7 +344,7 @@
sub renotify {
my $me = shift;
my( $l );
-
+
# auto-ack if aa and it has already been sent
return $me->ack() if $me->{autoack};
@@ -353,12 +353,12 @@
# too early to resend the escalation
last;
}
-
+
foreach my $dst ( @{$me->{sendto}[$l]{who}} ){
$me->sendorqueue($dst, 'RESENT');
}
}
-
+
$me->{sentcnt} ++;
$me->{lastsent} = $^T;
}
@@ -369,17 +369,17 @@
# auto-ack if aa and it has already been sent
return $me->ack() if $me->{autoack};
-
+
# postpone if no longer down for X minutes
if( $me->{obj}->{status} ne 'down'
&& $^T - $me->{obj}->{transtime} > $DELAY_ESCALATE ){
$me->loggit('system', 'delaying escalation');
return;
}
-
+
$me->{escalated} ++;
return if $me->{escalated} >= @{$me->{sendto}};
-
+
foreach my $dst ( @{$me->{sendto}[$me->{escalated}]{who}} ){
$me->sendorqueue($dst ); # 'ESCALATED' will be tagged automatically
}
@@ -406,9 +406,9 @@
my $me = shift;
my $dst = shift;
my $tag = shift;
-
+
push @{$queue{$dst}}, {not => $me, tag => $tag};
-
+
$me->{status}{$dst} = 'queued';
$me->loggit( $dst, 'queued' );
$me->save();
@@ -420,7 +420,7 @@
my $me = shift;
my $who = shift;
my( $dst, $aap );
-
+
return undef if $me->{state} ne 'active';
unless($who){
$who = 'auto-ack';
@@ -429,7 +429,7 @@
# as in some cases autoack = 1, but the ack is from an
# override or timeout in which case we want to de-queue
}
-
+
$me->{state} = 'acked';
$me->{ackedat} = $^T;
$me->{ackedby} = $who;
@@ -445,16 +445,16 @@
$me->{status}{$dst} = "acked by $who";
}
}
-
+
# remove from unacked
delete $unacked{ $me->{idno} };
$lastupd = $^T;
-
+
# stats, ...
-
+
$me->save();
-
+
1;
}
@@ -462,7 +462,7 @@
sub supress {
my $me = shift;
-
+
# RSN - supress...
}
@@ -471,7 +471,7 @@
my $who = shift;
my $msg = shift;
my $loudly = shift;
-
+
push @{$me->{log}}, { time => $^T, who => $who, msg => $msg };
$msg = "<$me->{priority}> $msg" if $me->{priority};
$msg .= " - $who" if $who;
@@ -501,7 +501,7 @@
# what should I do with outstanding notifs?
foreach my $p (values %unacked){
-
+
# auto-ack if in override
if( $p->{obj}->{ovstatus} eq 'override' ){
$p->ack('override');
@@ -548,7 +548,7 @@
my $qt = NotMe::qtime($dst);
$qt = ::topconf('qtime') unless defined $qt;
$qt = $QUEUETIME unless defined $qt;
-
+
if( $lastsent{$dst} + $qt <= $^T ){
# print STDERR "sending q $dst\n";
my $p = shift @{$queue{$dst}};
@@ -570,7 +570,7 @@
sub janitor {
my( %n_byid, %n_unacked );
-
+
foreach my $n (values %byid){
# if no longer active, and old, => toss
if( $n->{state} ne 'active' && $^T - $n->{created} > $OLD_AGE ){
@@ -600,7 +600,7 @@
unlink "$dir/$f";
}
closedir ND;
-
+
}
# On this Iris, fleet as the wind, sped forth to deliver her message.
@@ -616,16 +616,22 @@
if( $dstparam{$dst} && $dstparam{$dst}{disabled} ){
# $me->loggit( $dst, 'not sent' );
$me->{status}{$dst} = 'disabled';
-
+
return;
}
-
+
+ # is dst off schedule
+ unless( NotMe::permit_now($dst, $me->{severity}) ){
+ $me->{status}{$dst} = 'off-schedule';
+ return;
+ }
+
# if many, summarize
if( @more ){
-
+
my $nolots = NotMe::nolots( $dst );
$nolots ||= ::topconf('nolotsmsgs');
-
+
if( $nolots ){
# list all messages, don't summarize into Lots UP/DOWN
@@ -635,7 +641,7 @@
}else{
$j = "\n";
}
-
+
$msg = join($j, map { $_->{msg} } $msg, @more);
}else{
my $d;
@@ -655,7 +661,7 @@
$extra .= " $tag" if $tag;
$extra .= " ESCALATED" if $me->{escalated}; # RSN - from $who...
- my $err = ::topconf('_dont_ntfy') ? 0 :
+ my $err = ::topconf('_dont_ntfy') ? 0 :
NotMe::transmit($me, $dst, $msg, $extra, @more);
if( $err ){
@@ -664,7 +670,7 @@
}
return;
}
-
+
$lastsent{$dst} = $^T;
foreach my $p ( $me, @more ){
$p->loggit( $dst, 'transmit' );
@@ -694,7 +700,7 @@
}
$v =~ s/\r/\\r/gs;
$v =~ s/\n/\\n/gs;
-
+
my $res = $obj->expand($fmt,
localtime => 1,
dtformat => "%d/%b %R", # dd/Mon hh:mm
@@ -724,7 +730,7 @@
sub cmd_list_line {
my $me = shift;
my $ctl = shift;
-
+
$ctl->write("$me->{idno} $me->{state} $me->{objstate} $me->{created} " .
encode($me->{obj}->filename()) . " " .
encode($me->{msg} || '_') . ' ' .
@@ -735,7 +741,7 @@
sub cmd_list {
my $ctl = shift;
my $param = shift;
-
+
$ctl->ok();
if( $param->{which} eq 'unacked' ){
@@ -771,7 +777,7 @@
$ctl->bummer(404, 'Notification Not Found');
return;
}
-
+
my $p = $byid{$idno};
$ctl->ok();
foreach my $k (sort keys %$p){
@@ -784,7 +790,7 @@
$ctl->write( "$k:\t$v\n" );
}
$ctl->write( "object: " . encode( $p->{obj}->unique() ) . "\n" );
-
+
for my $e (qw(style_sheet javascript bkgimage icon icon_up icon_down)){
my $v = $p->{obj}->{web}{$e};
next unless $v;
@@ -798,7 +804,7 @@
$ctl->write("status $we: " . $p->{status}{$w} . "\n" );
}
$ctl->write("statuswho: $ww\n");
-
+
my $n = 0;
foreach my $l (@{$p->{log}}){
$ctl->write( "log $n: $l->{time} " . ($l->{who}? encode($l->{who}) : '_') .
@@ -813,7 +819,7 @@
my $ctl = shift;
my $param = shift;
my( $p, $u );
-
+
$p = $param->{idno};
$u = $param->{user} || 'anonymous';
@@ -822,7 +828,7 @@
$ctl->bummer(401, 'Not Permitted');
}
}
-
+
if( $p eq 'all' ){
$ctl->ok_n();
foreach $p (values %unacked){
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Service.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Service.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Service.pm 2009-02-22 17:42:41.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Service.pm 2010-01-10 17:23:20.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-03 08:56 (EST)
# Function: the service class
#
-# $Id: Service.pm,v 1.120 2009/02/22 22:42:41 jaw Exp $
+# $Id: Service.pm,v 1.121 2010/01/10 22:23:20 jaw Exp $
package Service;
@ISA = qw(MonEl BaseIO);
@@ -287,7 +287,14 @@
versn => '3.5',
html => 'graphing',
},
-
+
+ 'schedule::schedule testing' => {
+ descr => 'schedule specifying when to/not to test',
+ attrs => ['config', 'inherit', 'sched'],
+ versn => '3.7',
+ html => 'schedule',
+ },
+
srvc::starts => {},
srvc::dones => {},
srvc::alsorun => {},
@@ -339,6 +346,7 @@
$me->init_from_config( $cf, $doc, 'srvc' );
$me->init_from_config( $cf, $doc, 'graphd' );
$me->init_from_config( $cf, $doc, 'test' );
+ $me->init_from_config( $cf, $doc, 'schedule' );
# frequency = 0 is not permitted
$me->{srvc}{frequency} ||= $ZERO_FREQ;
@@ -420,7 +428,7 @@
sub pre_start_check {
my $me = shift;
-
+
return $me->reschedule() if $me->{srvc}{disabled};
# throttle back if we are going to run out of fds
@@ -429,6 +437,11 @@
$me->debug("file descriptor limit reached - delaying check");
return $me->reschedule(1);
}
+
+ if( my $s = $me->{schedule}{testing} ){
+ return $me->reschedule() unless $s->permit_now();
+ }
+
$me->start();
}
@@ -963,50 +976,6 @@
################################################################
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new();
- my $more = shift;
- my( $line, $name, $type );
-
- $me->{parents} = [ $mom ] if $mom;
-
- $line = $cf->nextline();
- ($type, $name) = $line =~ /^\s*([^:\s]+):?\s+([^\{\s]+)/;
-
- $me->cfinit($cf, $name, "\u\L$type");
-
- if( $line =~ /\{/ ){
- while( defined($_ = $cf->nextline()) ){
- # print STDERR "read service: $_\n" if $::opt_d;
- if( /^\s*\}/ ){
- last;
- }
- elsif( /^cron\s/i ){
- $cf->ungetline($_);
- my $c = UserCron::readconfig($cf, $me);
- push @{ $me->{cronjobs} }, $c if $c;
- }
-
- elsif( /:/ ){
- my($k, $v) = split /:[ \t]*/, $_, 2;
- $cf->warning( "redefinition of parameter '$k'" )
- if defined $me->{config}{$k};
- $me->{config}{$k} = $v;
- }
- else{
- $cf->nonfatal( "invalid entry in config file: '$_'" );
- $cf->eat_block() if /\{\s*$/;
- $me->{conferrs} ++;
- # attempt to continue
- }
- }
- }
-
- return $me->config($cf, $more);
-}
-
sub graphlist {
my $me = shift;
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Stats.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Stats.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/Stats.pm 2008-03-03 10:45:18.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/Stats.pm 2010-01-14 19:33:35.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-05 10:28 (EST)
# Function: maintain object statistics
#
-# $Id: Stats.pm,v 1.48 2008/03/03 15:45:18 jaw Exp $
+# $Id: Stats.pm,v 1.51 2010/01/15 00:33:35 jaw Exp $
package MonEl;
@@ -319,7 +319,6 @@
return if $me->{nostats};
$me->stats_update_and_maybe_roll();
- $me->stats_save();
$me->{web}{transtime} = $^T;
}
@@ -404,12 +403,21 @@
}
}
-sub stats_cron_job {
+sub stats_cron_job_hourly {
foreach my $x (@MonEl::all){
$x->stats_hourly();
}
}
+sub stats_cron_job_save {
+ # save a few at a time
+ my $n = int $^T / 300;
+ foreach my $x (@MonEl::all){
+ next if $n++ % 47;
+ $x->stats_save();
+ }
+}
+
# update some global status
sub status_update {
unshift @statuses, [$^T, $::idletime, $Service::n_tested, $::loopcount ];
@@ -428,7 +436,7 @@
time => $^T + (3600 - ($^T % 3600)),
freq => 3600,
text => 'Stats hourly update',
- func => \&stats_cron_job,
+ func => \&stats_cron_job_hourly,
);
Cron->new(
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/TCP.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/TCP.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/TCP.pm 2009-02-22 17:42:41.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/TCP.pm 2010-01-10 17:23:21.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-03 15:59 (EST)
# Function: testing of TCP services
#
-# $Id: TCP.pm,v 1.81 2009/02/22 22:42:41 jaw Exp $
+# $Id: TCP.pm,v 1.83 2010/01/10 22:23:21 jaw Exp $
package TCP;
@@ -39,7 +39,7 @@
descr => 'TCP port to test',
attrs => ['config'],
},
-
+
tcp::send => {
descr => 'text to send once connected',
attrs => ['config'],
@@ -60,7 +60,7 @@
versn => '3.2',
exmpl => 'http://argus.tcp4me.com/',
},
-
+
tcp::readhow => {
descr => 'how much data should be read from the server before checking expect',
attrs => ['config'],
@@ -71,7 +71,7 @@
attrs => ['config', 'bool'],
versn => '3.3',
},
-
+
tcp::altsend => {
descr => 'text to send once connected, instead of normal value',
# used by redirect handler
@@ -99,19 +99,19 @@
# send => "MAIL\r\n", # not RFC compliant, but quiets sendmails logs
port => 25, expect => '^220', readhow => "banner",
},
-
+
FTP => {
port => 21, expect => '^220', readhow => "banner",
},
-
+
POP => {
port => 110, expect => '^\+OK', readhow => "banner",
},
-
+
NNTP => {
port => 119, expect => '^200', readhow => "banner",
},
-
+
HTTP => {
port => 80,
# send gets built below
@@ -124,7 +124,7 @@
URL => {
expect => "HTTP/[0-9\.]+ 200", readhow => 'toeof',
},
-
+
Telnet => {
port => 23,
},
@@ -134,7 +134,7 @@
send => "\r\n",
expect => "\.\r\n", readhow => 'toeof',
},
-
+
SSH => {
port => 22, readhow => 'banner',
send => "SSH-1.99-argus\r\n",
@@ -182,12 +182,12 @@
port => 995, expect => '^\+OK', readhow => "banner",
ssl => 1,
},
-
+
IMAPS => {
port => 993, ssl => 1,
expect => '^\* OK', readhow => 'banner',
},
-
+
SMTPS => {
port => 465, expect => '^220', readhow => "banner",
ssl => 1,
@@ -206,8 +206,8 @@
port => 9090, send => "version ?\r\n",
readhow => 'banner', expect => 'version',
},
-
-
+
+
);
# what? like this might change?
@@ -232,18 +232,14 @@
$me->{tcp}{send} ||= $config{$name}{send};
$me->{tcp}{readhow} ||= $config{$name}{readhow};
$me->{tcp}{ssl} ||= $config{$name}{ssl};
+ $me->{tcp}{maybe_expect} ||= $config{$name}{expect};
}
-
+
$me->{label_right_maybe} ||= $name;
-
+
$me->Argus::IP::init( $cf );
$me->init_from_config( $cf, $doc, 'tcp' );
- if( !defined($me->{test}{expect}) && !($me->{test}{pluck} || $me->{test}{unpack}) ){
- # don't use default expect, if expected value will not be there
- $me->{test}{expect} = $config{$name}{expect} if $config{$name};
- }
-
if( $name =~ /^(HTTP|HTTPS|SSL)$/ ){
my $http = http_request($me);
$me->{tcp}{send} ||= "HEAD / HTTP/1.0\r\n$http\r\n";
@@ -268,16 +264,18 @@
}else{
$host .= ":$port" if $port && $port != 80;
}
-
+
my $http = http_request($me);
$file =~ s/\s/%20/g;
- $me->{tcp}{send} = "GET $file HTTP/1.0\r\nHost: $host\r\n$http\r\n";
+ $me->{tcp}{http_host} = $host;
+ $me->{tcp}{http_file} = $file;
+ $me->{tcp}{send} = "GET $file HTTP/1.0\r\nHost: $host\r\n$http\r\n";
}
$me->Argus::IP::config( $cf );
$me->{friendlyname} = ($config{$name} ? $name : "TCP/$me->{udp}{port}") . " on $me->{ip}{hostname}";
-
+
if( $name eq 'URL' ){
$me->{friendlyname} = "URL $me->{tcp}{url}";
}elsif( $name =~ /NFS/ ){
@@ -301,18 +299,30 @@
unless( $me->{tcp}{port} ){
return $cf->error( "Incomplete specification or unknown protocol for Service $name" );
}
-
+
bless $me if( ref($me) eq 'Service' );
$me;
}
+sub configured {
+ my $me = shift;
+
+ my $t = $me->{test};
+ # do not use the expect from above if the value is being changed
+ unless( $t->{expect} || $t->{pluck} || $t->{unpack} ){
+ $t->{expect} = $me->{tcp}{maybe_expect} if $me->{tcp}{maybe_expect};
+ }
+ delete $me->{tcp}{maybe_expect};
+
+}
+
sub http_request {
my $me = shift;
-
+
# build http request
my $http = "Connection: close\r\n";
- $http .= "User-Agent: $me->{tcp}{browser}\r\n" if $me->{tcp}{browser};
+ $http .= "User-Agent: $me->{tcp}{browser}\r\n" if $me->{tcp}{browser};
$http .= "Referer: $me->{tcp}{referer}\r\n" if $me->{tcp}{referer};
# to assist in debugging...
$http .= "X-Argus-Version: $::VERSION\r\n";
@@ -325,24 +335,24 @@
my( $i, $fh, $ip, $ipv );
$me->SUPER::start();
-
+
if( $me->{ip}{resolvp} ){
$ip = Resolv::resolv_check( $me->{ip}{hostname} );
$me->debug( "IP addr changed" ) if $ip && $me->{ip}{addr} && $ip ne $me->{ip}{addr};
$me->{ip}{addr} = $ip if defined $ip;
-
+
unless( $me->{ip}{addr} ){
if( $me->resolv_timed_out() ){
return $me->isdown( "cannot resolve hostname" );
}else{
$me->debug( 'Test skipped - resolv still pending' );
# prevent retrydelay from kicking in
- $me->{srvc}{tries} = 0;
+ $me->{srvc}{tries} = 0;
return $me->done();
}
}
}
-
+
$ip = $me->{ip}{addr};
$me->{fd} = $fh = BaseIO::anon_fh();
@@ -363,10 +373,10 @@
$me->debug( "TCP Start: connecting -$ipv tcp/$me->{tcp}{port}, ".
"$me->{ip}{hostname}, try $me->{srvc}{tries}" );
-
+
$me->set_src_addr( 1 )
|| return $me->done();
-
+
alarm(3);
# in some cases this may block, even though we set non-blocking
if( length($ip) == 4 ){
@@ -381,18 +391,18 @@
}
# if the connect fails for other reasons, we get the error in writable()
-
+
if( $me->{tcp}{build} ){
$me->{tcp}{build}->($me);
}
-
+
$me->{srvc}{state} = 'connecting';
$me->wantread(0);
$me->wantwrit(1);
$me->settimeout( $me->{srvc}{timeout} );
$me->{tcp}{rbuffer} = '';
$me->{tcp}{wbuffer} = '';
-
+
}
sub timeout {
@@ -414,14 +424,14 @@
# NB: this code path never calls done
$me->shutdown();
-
+
($loc) = grep /^Location:/, split( /\n/, $me->{tcp}{rbuffer} );
$loc =~ tr/\r//d;
($url) = $loc =~ /^Location:\s+(.*)/;
($file) = $url =~ m|(?:https?://[^/]*)?(.*)|;
# NB: cannot redirect to another host
-
- $me->{tcp}{altsend} = "GET $file HTTP/1.1\r\nHost: $me->{ip}{hostname}:$me->{tcp}{port}\r\n";
+
+ $me->{tcp}{altsend} = "GET $file HTTP/1.1\r\nHost: $me->{tcp}{http_host}\r\n";
$me->{tcp}{altsend} .= $me->http_request();
$me->{tcp}{altsend} .= "\r\n";
$me->debug( "HTTP Redirect -> $url" );
@@ -433,6 +443,36 @@
$me->start();
}
+sub http_auth {
+ my $me = shift;
+ my( $url, $file, $loc );
+
+ $me->shutdown();
+
+ my($auth) = grep /^WWW-Authenticate:/, split( /\n/, $me->{tcp}{rbuffer} );
+ my($scheme, $realm) = $auth =~ /^WWW-Authenticate:\s+(\S+)\s+realm="(.*)"/;
+
+
+ # ...
+
+
+ $me->{tcp}{send} = "GET $me->{tcp}{http_file} HTTP/1.1\r\nHost: $me->{tcp}{http_host}\r\n";
+ $me->{tcp}{send} .= $me->http_request();
+
+ $me->{tcp}{send} .= "\r\n";
+ $me->debug( "HTTP Auth [$scheme, $realm] -> $url" );
+
+ if( ++$me->{tcp}{redircount} > 15 ){
+ undef $me->{tcp}{redircount} ;
+ return $me->isdown( 'HTTP Redirect/Auth Loop', 'loop' );
+ }
+
+ # start over without rescheduling
+ $me->start();
+}
+
+
+
sub writable {
my $me = shift;
@@ -445,14 +485,14 @@
# QQQ, should I try to sort out errors, down on some, sysproblem on others?
return $me->isdown( "TCP connect failed: $!", 'connect failed' );
}
-
+
$me->debug( 'TCP - connected' );
$me->{tcp}{wbuffer} = $me->{tcp}{altsend} || $me->{tcp}{send};
undef $me->{tcp}{altsend};
$me->{srvc}{state} = 'sending';
$me->settimeout( $me->{srvc}{timeout} );
}
-
+
if( $me->{tcp}{wbuffer} ){
my( $b, $i, $l, $fh );
@@ -515,7 +555,7 @@
# My ears have not yet drunk a hundred words
# Of that tongue's utterance, yet I know the sound:
# -- Shakespeare, Romeo+Juliet
-
+
$testp = 1 if $me->{tcp}{rbuffer} =~ /\n/;
}
elsif( $me->{tcp}{readhow} eq 'toblank' ){
@@ -544,22 +584,26 @@
sub test {
my $me = shift;
my( $e );
-
- if( $me->{name} eq 'TCP/URL' && $me->{tcp}{rbuffer} =~ /HTTP\/1\.\d+\s+30[12]/ ){
- # once or twice she had peeped into the book her sister was reading, but
- # it had no pictures or conversations in it,
- # -- Alice in Wonderland
- # try to handle redirect
- return $me->http_redirect();
- }else{
- undef $me->{tcp}{redircount};
+
+ if( $me->{name} eq 'TCP/URL' ){
+ if( $me->{tcp}{rbuffer} =~ /HTTP\/1\.\d+\s+30[12]/ ){
+ # once or twice she had peeped into the book her sister was reading, but
+ # it had no pictures or conversations in it,
+ # -- Alice in Wonderland
+ # try to handle redirect
+ return $me->http_redirect();
+ # }elsif( $me->{tcp}{rbuffer} =~ /HTTP\/1\.\d+\s+401/ ){
+ # return $me->http_auth();
+ }else{
+ undef $me->{tcp}{redircount};
+ }
}
-
+
# There is a written scroll! I'll read the writing.
# -- Shakespeare, Merchant of Venice
return $me->generic_test($me->{tcp}{rbuffer});
-
+
}
@@ -580,7 +624,7 @@
my $fh = shift;
$me->Argus::IP::webpage_more($fh);
-
+
foreach my $k (qw(port url)){
my $v = $me->{tcp}{$k};
next unless defined $v;
@@ -595,7 +639,7 @@
}
}
-
+
################################################################
# global config
################################################################
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/UDP.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/UDP.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/UDP.pm 2009-02-22 17:42:42.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/UDP.pm 2010-01-05 23:35:23.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2002-Apr-03 18:25 (EST)
# Function: testing of UDP services
#
-# $Id: UDP.pm,v 1.74 2009/02/22 22:42:42 jaw Exp $
+# $Id: UDP.pm,v 1.75 2010/01/06 04:35:23 jaw Exp $
package UDP;
@@ -45,13 +45,13 @@
},
udp::verify_response_ip => {
descr => 'verify that responses come from the correct IP address',
- attrs => ['config', 'inherit'],
+ attrs => ['config', 'inherit', 'bool'],
versn => 3.7,
default => 'yes',
},
udp::verify_response_port => {
descr => 'verify that responses come from the correct port',
- attrs => ['config', 'inherit'],
+ attrs => ['config', 'inherit', 'bool'],
versn => 3.7,
default => 'yes',
},
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/UserCron.pm /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/UserCron.pm
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/UserCron.pm 2008-06-25 12:03:19.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/UserCron.pm 2010-01-10 17:23:21.000000000 -0500
@@ -5,7 +5,7 @@
# Date: 2003-Sep-12 18:30 (EDT)
# Function: run things at a specified time
#
-# $Id: UserCron.pm,v 1.9 2008/06/25 16:03:19 jaw Exp $
+# $Id: UserCron.pm,v 1.10 2010/01/10 22:23:21 jaw Exp $
# replacement for using a system cronjob to run argusctl
@@ -34,7 +34,7 @@
sub config {
my $me = shift;
-
+
# $me->init_from_config($cf, $doc, '');
Cron->new( spec => $me->{name},
@@ -60,44 +60,6 @@
%{$me->{config}} );
}
-# cron "spec" { ... }
-sub readconfig {
- my $cf = shift;
- my $mom = shift;
- my $me = __PACKAGE__->new();
-
- my $line = $cf->nextline();
- my($name) = $line =~ /^cron\s+\"(.*)\"/i;
- $me->{parents} = [ $mom ] if $mom;
-
- $me->cfinit($cf, $name, 'cron');
-
- while( defined($_ = $cf->nextline()) ){
- # print STDERR " gotline: $_\n" if $::opt_d;
- if( /^\s*\}/ ){
- # done
- last;
- }
- elsif( /:/ ){
- my($k, $v) = split /:[ \t]*/, $_, 2;
- $cf->warning( "redefinition of parameter '$k'" )
- if defined $me->{config}{$k};
- $me->{config}{$k} = $v;
- }
- else{
- return $cf->error( "invalid entry in config file: '$_'" );
- }
- }
-
- unless($me->{config}{func}){
- eval{ $cf->error( "invalid cron spec - func not specified" ) };
- return;
- };
-
- $me->config();
-
- $me;
-}
################################################################
Doc::register( $doc );
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/main.pl /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/main.pl
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/main.pl 2008-10-25 12:34:54.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/main.pl 2010-01-10 17:23:22.000000000 -0500
@@ -6,7 +6,7 @@
# Date: 2002-Apr-02 12:09 (EST)
# Function: argus startup and glue
#
-# $Id: main.pl,v 1.70 2008/10/25 16:34:54 jaw Exp $
+# $Id: main.pl,v 1.71 2010/01/10 22:23:22 jaw Exp $
# In God we trust, everyone else we monitor.
# -- U2 pilot motto
@@ -38,6 +38,7 @@
use TestPort;
use Argus::Ctl;
use Argus::HashDir;
+use Argus::Schedule;
use Resolv;
use DARP;
@@ -100,7 +101,7 @@
Doc::describe_control( $opt_H ) if $opt_C;
if( $opt_t ){
- Conf::readconfig( $opt_c || "$datadir/config" );
+ Conf::readconfigfiles( $opt_c || "$datadir/config" );
exit $Conf::has_errors;
}
@@ -163,7 +164,7 @@
# daemonize
unless( $opt_f ){
- # The victor daemon mounts obscure in air,
+ # The victor daemon mounts obscure in air,
# While the ship sails without the pilot's care.
# -- Virgil, Aeneid
close STDIN;
@@ -215,19 +216,19 @@
exit;
};
$SIG{ALRM} = sub {};
-
+
# for children programs
$ENV{ARGUS_PID} = $$;
$ENV{ARGUS_VER} = $::VERSION;
$ENV{ARGUS_DATA} = $datadir;
$ENV{ARGUS_LIB} = '__LIBDIR__';
-
- Conf::readconfig( $opt_c || "$datadir/config" );
+
+ Conf::readconfigfiles( $opt_c || "$datadir/config" );
Doc->check_all();
Control->Server::new_local( "$datadir/control", oct(topconf('chmod_control')) );
$ENV{ARGUS_CTL} = "$datadir/control";
-
+
# load user specified perl code
unshift @INC, "$datadir/perl";
foreach my $m (split /\s+/, topconf('load_modules')){
@@ -236,7 +237,7 @@
}
# run user specified program
system( topconf('runatstartup') ) if topconf('runatstartup');
-
+
$^T = time();
$starttime = $^T;
loggit( "successful restart - $NAME running", 1 );
@@ -246,7 +247,7 @@
DB::reset();
rename "prof.out", "prof.out.startup";
}
-
+
BaseIO::mainloop(
maxperiod => $MAX_PERIOD,
# run => \&Prog::reap, # annoys the profiler
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/picasso.pl /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/picasso.pl
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/picasso.pl 2008-07-20 18:01:14.000000000 -0400
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/picasso.pl 2010-01-05 23:35:23.000000000 -0500
@@ -6,7 +6,7 @@
# Date: 2002-Nov-01 11:54 (EST)
# Function: lay paint on canvas. make pretty graphs.
#
-# $Id: picasso.pl,v 1.20 2008/07/20 22:01:14 jaw Exp $
+# $Id: picasso.pl,v 1.21 2010/01/06 04:35:23 jaw Exp $
# Computers are useless. They can only give you answers.
# -- Picasso
@@ -81,6 +81,15 @@
FFCC44 FF44CC 44CC88 88CC44 4488CC 8844CC);
usecolors(decode($opt{gr_colors}));
+# barstyle: '', minmax, stddev
+# grstyle: line, filled
+
+my $grstyle = ($which eq 'samples' && @ARGV == 1) ? 'filled' : 'line';
+my $barstyle = $which eq 'samples' ? '' : $opt{barstyle};
+$barstyle = '' if $barstyle eq 'none';
+
+
+my @dataopts;
my @imgopts = (
transparent => $opt{transparent},
draw_border => $opt{drawborder},
@@ -95,24 +104,23 @@
if( $size eq 'thumb' ){
push @imgopts, width => 160, height => 64;
push @imgopts, draw_data_labels => 0, draw_tic_labels => 0;
+
+ push @dataopts, smooth => $opt{gr_smooth};
+ push @dataopts, shadow => {dx => 1, dy => 1, dw => 0} if $opt{gr_drop_shadow};
}else{
push @imgopts, height => ($opt{gr_height} || 192);
push @imgopts, width => 640, margin_right => 16;
push @imgopts, title => decode($opt{title});
push @imgopts, x_label => decode($opt{xlabel});
push @imgopts, y_label => decode($opt{ylabel});
- push @imgopts, thickness => decode($opt{gr_line_thickness});
+
+ push @dataopts, thickness => decode($opt{gr_line_thickness}) if $grstyle eq 'line';
+ push @dataopts, smooth => $opt{gr_smooth};
+ push @dataopts, shadow => {dx => 2, dy => 2, dw => 3} if $opt{gr_drop_shadow};
}
my $img = Chart::Strip->new( @imgopts );
-# barstyle: '', minmax, stddev
-# grstyle: line, filled
-
-my $grstyle = ($which eq 'samples' && @ARGV == 1) ? 'filled' : 'line';
-my $barstyle = $which eq 'samples' ? '' : $opt{barstyle};
-$barstyle = '' if $barstyle eq 'none';
-
my $colorn = 0;
my $notenough = 0;
@@ -120,18 +128,24 @@
my $m = Argus::Graph::Data->new($n);
my $color = color($colorn++);
my $label = shift @labels;
-
+
if( $which eq 'samples' ){
- $m->readsamples( $opt{gr_xrange_samples} );
-
+ my $limit = $^T - ($opt{gr_xrange_samples} || 36*3600);
+ $m->readsamples( $limit );
+
if( @{$m->{samples}} < 2 ){
$notenough ++;
next;
}
- $img->add_data( $m->{samples}, {style => $grstyle, color => $color, label => $label} );
+
+ $img->add_data( $m->{samples}, {style => $grstyle, color => $color, label => $label,
+ @dataopts,
+ } );
}else{
+ my $limit = $^T - ($opt{"gr_xrange_$which"} ||($which eq 'hours' ? 180 * 3600 : 90 * 24 * 3600));
+
# limit to either 576 points, or specified range
- $m->readsummary( $which, 576, $opt{"gr_xrange_$which"} );
+ $m->readsummary( $which, 576, $limit );
# print STDERR "data: ", scalar(@{$m->{samples}}), "\n";
if( @{$m->{samples}} < 2 ){
@@ -149,8 +163,10 @@
}
$img->add_data( $m->{samples}, {style => 'range', color => 'blue'} );
}
-
- $img->add_data( $m->{samples}, {style => $grstyle, color => $color, label => $label} );
+
+ $img->add_data( $m->{samples}, {style => $grstyle, color => $color, label => $label,
+ @dataopts,
+ } );
}
}
@@ -193,7 +209,7 @@
my $im;
print STDERR "picasso: ERROR $msg\n";
-
+
$im = new GD::Image(160, 64);
my $blk = $im->colorAllocate(0,0,0);
my $red = $im->colorAllocate(0xFF,0x88,0x88);
@@ -209,7 +225,7 @@
$im->string(GD::gdSmallFont, 4, $y, $_, $blk);
$y += 10;
}
-
+
if( $opt{filetype} eq 'gif' ){
print $im->gif();
}else{
@@ -226,9 +242,9 @@
$colors[ $n % @colors ];
}
-# Nor long the sun his daily course withheld,
-# But added colors to the world reveal'd:
-# When early Turnus, wak'ning with the light,
+# Nor long the sun his daily course withheld,
+# But added colors to the world reveal'd:
+# When early Turnus, wak'ning with the light,
# -- Virgil, Aeneid
sub usecolors {
my $cs = shift;
@@ -271,7 +287,7 @@
[3, 21, 0], [1, 21, 0], [1, 19, 3], [2, 18, 0], [1, 17, 0], [2, 16, 2], [1, 14, 3], [4, 13, 0],
[2, 13, 0], [0, 13, 0], [4, 12, 0], [2, 12, 0], [0, 12, 0], [3, 11, 0], [3, 9, 0], [4, 8, 0],
[3, 7, 0], [1, 6, 3], [1, 4, 3], [4, 3, 0], [2, 3, 0], [4, 2, 0], [1, 2, 0], [2, 1, 1] );
-
+
foreach my $l (@data){
foreach my $i ($l->[0] .. $l->[0] + $l->[2]){
$im->setPixel($img->{width} - 9 + $i, 2 + $l->[1], $img->{color}{blue});
diff -ruBNx HTML /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/sys_agent.pl /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/sys_agent.pl
--- /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20090222/src/sys_agent.pl 2005-11-25 12:11:43.000000000 -0500
+++ /home/hostedsites/www.jeremykister.com/data/argus/argus-dev-20100109/src/sys_agent.pl 2010-01-05 23:35:23.000000000 -0500
@@ -6,7 +6,7 @@
# Date: 2002-Nov-06 17:57 (EST)
# Function: remote system monitoring agent
#
-# $Id: sys_agent.pl,v 1.9 2005/11/25 17:11:43 jaw Exp $
+# $Id: sys_agent.pl,v 1.10 2010/01/06 04:35:23 jaw Exp $
# run from inetd.conf
@@ -20,15 +20,45 @@
# it probably won't work on your system without customization
use Socket;
+my $HAVE_S6;
BEGIN{ eval{ require Socket6; import Socket6; $HAVE_S6 = 1; }}
+use strict;
+
+$> = $< = -1; # if we are root, drop privileges
+
verify_access(@ARGV) if @ARGV;
# read request
-chop($line = <STDIN>);
+chop(my $line = <STDIN>);
$line =~ tr/\r//d;
-($what, $arg) = split /\s+/, $line, 2;
+my ($what, $arg) = split /\s+/, $line, 2;
+
+
+my %FUNC = (
+ load => \&get_load,
+ uptime => \&uptime,
+ disk => \&disk_usage,
+ smart => \&disk_smart,
+ iostat => \&disk_iostat,
+ zpool => \&zpool_status,
+ kstat => \&kstat,
+ netstat => \&netstat,
+ );
+
+my $func = $FUNC{$what};
+unless( $func ){
+ print "error\n";
+ exit -1;
+}
+
+$func->( $arg );
+exit;
+
+################################################################
+
+sub get_load {
+ my $arg = shift;
-if( $what eq 'load' ){
if( open(F, "/proc/loadavg") ){
# linux
my $l = <F>;
@@ -50,7 +80,9 @@
}
}
-if( $what eq 'uptime' ){
+sub uptime {
+ my $arg = shift;
+
if( open(F, "/proc/uptime") ){
# linux
my $l = <F>;
@@ -70,10 +102,11 @@
}
}
-if( $what eq 'disk' ){
+sub disk_usage {
+ my $arg = shift;
my $df;
-
- if( $^O eq 'solaris' ){
+
+ if( $^O eq 'solaris' || $^O eq 'netbsd' ){
$df = output_of_command( 'df', '-k', $arg );
$df =~ s/.*\s+(\d+)%.*\n?/$1/s;
}else{
@@ -83,12 +116,23 @@
print "$df\n";
}
-if( $what eq 'netstat' ){
+sub disk_smart {
+ my $arg = shift;
+
+ my $st = output_of_command('/usr/local/sbin/smartctl', '-H', $arg);
+ $st =~ s/.*Status:\s+//s;
+ chomp($st);
+ print "$st\n";
+}
+
+sub netstat {
+ my $arg = shift;
+
# arg: interface [in|out]
# extremely non-portable
my( $int, $dir ) = split /\s+/, $arg;
my $r;
-
+
if( $^O eq 'solaris' ){
my $st = output_of_command( '/bin/kstat', '-p', '-n',
$int, '-s', ($dir eq 'in' ? 'rbytes' : 'obytes'));
@@ -120,6 +164,93 @@
print "$r\n";
}
+# => iostat c0t0d0s0 busy
+sub disk_iostat {
+ my $arg = shift;
+
+ my($disk, $stat) = split /\s+/, $arg;
+
+ # NB: this is about as portable as a house
+ if( $^O eq 'solaris' ){
+ my %STAT = ( read => 3, write => 4, wait => 5, actv => 6, svct => 7, wpct => 8, busy => 9 );
+ my $n = $STAT{$stat};
+
+ # translate cNtNdNsN => sdN
+ my $dev = readlink("/dev/dsk/$disk");
+ $dev =~ s|../../devices||;
+ $dev =~ s|:.*||;
+
+ my $name;
+ open(P, '/etc/path_to_inst');
+ while(<P>){
+ chop;
+ my($long, $i, $driver) = /"(\S+)"\s+(\d+)\s+"(\S+)"/;
+ if( $long eq $dev ){
+ $name = $driver . $i;
+ last;
+ }
+ }
+ close P;
+
+ unless( $name ){
+ print "error\n";
+ exit -1;
+ }
+
+ my $out = output_of_command( 'iostat', '-x', $name, 5, 2 );
+ my @dat = split /\s+/, ((split /\n/, $out)[-1]);
+
+ if( $stat eq 'total' ){
+ my $res = $dat[3] + $dat[4]; # read + write
+ print "$res\n";
+ }else{
+ print "$dat[$n]\n";
+ }
+ exit;
+ }
+
+ if( $^O eq 'netbsd' ){
+ my %STAT = (read => 4, write => 8);
+ my $n = $STAT{$stat};
+ my $out = output_of_command( 'iostat', '-Dx', $disk, 5, 2 );
+ my @dat = split /\s+/, ((split /\n/, $out)[-1]);
+ if( $stat eq 'total' ){
+ print ($dat[4] + $dat[8]) * 1000, "\n";
+ }else{
+ print ($dat[$n] * 1000), "\n";
+ }
+ exit;
+ }
+
+ # ...
+}
+
+sub zpool_status {
+ my $arg = shift; # pool name
+
+ my $out = output_of_command( 'zpool', 'status', $arg );
+ for my $l (split /\n/, $out){
+ if( $l =~ /^\s+state:\s+(.*)/ ){
+ my $v = $1;
+ print "$v\n";
+ exit;
+ }
+ }
+ print "UNKNOWN\n";
+}
+
+sub kstat {
+ my $arg = shift;
+
+ my $out = output_of_command( 'kstat', '-p', $arg );
+ chomp($out);
+ my($key, $res) = split /\t/, $out, 2;
+
+ print "$res\n";
+}
+
+################################################################
+
sub output_of_command {
my $cmd = shift;
my @arg = @_;
@@ -140,18 +271,18 @@
# get address of peer
my $sk = getpeername(STDIN);
die "getpeername failed: $!\n" unless $sk;
-
+
my $af = unpack('xC', $sk);
- my( $srcip, $scrport );
-
+ my( $srcip, $srcport );
+
if( $HAVE_S6 && $af == AF_INET6 ){
($srcport, $srcip) = unpack_sockaddr_in6($sk);
}else{
($srcport, $srcip) = sockaddr_in($sk);
}
-
+
$srcip = xxx_inet_ntoa($srcip);
-
+
# check
foreach my $a (@addr){
# canonicalize
@@ -159,9 +290,9 @@
return 1 if $a eq $srcip;
}
-
+
die "access denied from $srcip\n";
-
+
}
sub xxx_inet_ntoa {
@@ -170,7 +301,7 @@
return inet_ntoa($n) if length($n) == 4;
return undef unless $HAVE_S6;
return inet_ntop(AF_INET6, $n) if length($n) == 16;
-
+
"X.X.X.X";
}