summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Config/Grammar.pm (renamed from lib/ISG/ParseConfig.pm)92
-rw-r--r--lib/Smokeping.pm471
-rw-r--r--lib/Smokeping/RRDtools.pm73
-rw-r--r--lib/Smokeping/matchers/Avgratio.pm2
-rw-r--r--lib/Smokeping/probes/AnotherDNS.pm18
-rw-r--r--lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm41
-rw-r--r--lib/Smokeping/probes/Curl.pm56
-rw-r--r--lib/Smokeping/probes/base.pm51
-rw-r--r--lib/Smokeping/probes/passwordchecker.pm2
9 files changed, 540 insertions, 266 deletions
diff --git a/lib/ISG/ParseConfig.pm b/lib/Config/Grammar.pm
index 9afdb11..bd3deea 100644
--- a/lib/ISG/ParseConfig.pm
+++ b/lib/Config/Grammar.pm
@@ -1,4 +1,4 @@
-package ISG::ParseConfig;
+package Config::Grammar;
# TODO:
# - _order for sections
@@ -6,7 +6,7 @@ package ISG::ParseConfig;
use strict;
use vars qw($VERSION);
-$VERSION = 1.9;
+$VERSION = '1.02';
sub new($$)
{
@@ -58,7 +58,7 @@ sub _quotesplit($)
push @items, $frag;
}
else {
- die "Internal parser error for '$line'\n";
+ die "Internal parser error for '$line'";
}
}
return @items;
@@ -93,7 +93,7 @@ sub _check_mandatory($$$$)
if (not defined $g->{$_}) {
$g->{$_} = {};
-#$self->{'err'} = "ParseConfig internal error: mandatory name $_ not found in grammar";
+#$self->{'err'} = "Config::Grammar internal error: mandatory name $_ not found in grammar";
#return 0;
}
if (not defined $c->{$_}) {
@@ -201,7 +201,7 @@ sub _next_level($$$)
my $s = $self->_search_section($name);
return 0 unless defined $s;
if (not defined $self->{grammar}{$s}) {
- $self->_make_error("ParseConfig internal error (no grammar for $s)");
+ $self->_make_error("Config::Grammar internal error (no grammar for $s)");
return 0;
}
push @{$self->{grammar_stack}}, $self->{grammar};
@@ -587,7 +587,7 @@ sub _parse_line($$$)
return 1;
};
/^\@define\s+(\S+)\s+(.*)$/ and do {
- $self->{defines}{$1}=quotemeta $2;
+ $self->{defines}{$1}=$2;
return 1;
};
@@ -1039,31 +1039,31 @@ __END__
=head1 NAME
-ISG::ParseConfig - Simple config parser
+Config::Grammar - A grammar-based, user-friendly config parser
=head1 SYNOPSIS
- use ISG::ParseConfig;
+ use Config::Grammar;
- my $parser = ISG::ParseConfig->new(\%grammar);
+ my $parser = Config::Grammar->new(\%grammar);
my $cfg = $parser->parse('app.cfg') or die "ERROR: $parser->{err}\n";
my $pod = $parser->makepod();
my $ex = $parser->maketmpl('TOP','SubNode');
=head1 DESCRIPTION
-ISG::ParseConfig is a module to parse configuration files. The
+Config::Grammar is a module to parse configuration files. The
configuration may consist of multiple-level sections with assignments
and tabular data. The parsed data will be returned as a hash
-containing the whole configuration. ISG::ParseConfig uses a grammar
-that is supplied upon creation of a ISG::ParseConfig object to parse
+containing the whole configuration. Config::Grammar uses a grammar
+that is supplied upon creation of a Config::Grammar object to parse
the configuration file and return helpful error messages in case of
-syntax errors. Using the B<makepod> methode you can generate
+syntax errors. Using the B<makepod> method you can generate
documentation of the configuration file format.
The B<maketmpl> method can generate a template configuration file. If
your grammar contains regexp matches, the template will not be all
-that helpful as ParseConfig is not smart enough to give you sensible
+that helpful as Config::Grammar is not smart enough to give you sensible
template data based in regular expressions.
=head2 Grammar Definition
@@ -1321,7 +1321,7 @@ be escaped with a backslash as well.
=head3 Sections
-ISG::ParseConfig supports hierarchical configurations through sections, whose
+Config::Grammar supports hierarchical configurations through sections, whose
syntax is as follows:
=over 15
@@ -1358,7 +1358,7 @@ The data is interpreted as one or more columns separated by spaces.
=head3 Code
- my $parser = ISG::ParseConfig->new({
+ my $parser = Config::Grammar->new({
_sections => [ 'network', 'hosts' ],
network => {
_vars => [ 'dns' ],
@@ -1426,18 +1426,18 @@ The data is interpreted as one or more columns separated by spaces.
*** network ***
- dns = 129.132.7.87
+ dns = 192.168.7.87
- + 129.132.7.64
+ + 192.168.7.64
netmask = 255.255.255.192
- gateway = 129.132.7.65
+ gateway = 192.168.7.65
*** hosts ***
- 00:50:fe:bc:65:11 129.132.7.97 plain.hades
- 00:50:fe:bc:65:12 129.132.7.98 isg.ee.hades
- 00:50:fe:bc:65:14 129.132.7.99 isg.ee.hades
+ 00:50:fe:bc:65:11 192.168.7.97 plain.hades
+ 00:50:fe:bc:65:12 192.168.7.98 isg.ee.hades
+ 00:50:fe:bc:65:14 192.168.7.99 isg.ee.hades
=head3 Result
@@ -1445,68 +1445,48 @@ The data is interpreted as one or more columns separated by spaces.
'hosts' => {
'00:50:fe:bc:65:11' => [
'00:50:fe:bc:65:11',
- '129.132.7.97',
+ '192.168.7.97',
'plain.hades'
],
'00:50:fe:bc:65:12' => [
'00:50:fe:bc:65:12',
- '129.132.7.98',
+ '192.168.7.98',
'isg.ee.hades'
],
'00:50:fe:bc:65:14' => [
'00:50:fe:bc:65:14',
- '129.132.7.99',
+ '192.168.7.99',
'isg.ee.hades'
]
},
'network' => {
- '129.132.7.64' => {
+ '192.168.7.64' => {
'netmask' => '255.255.255.192',
- 'gateway' => '129.132.7.65'
+ 'gateway' => '192.168.7.65'
},
- 'dns' => '129.132.7.87'
+ 'dns' => '192.168.7.87'
}
};
=head1 COPYRIGHT
-Copyright (c) 2000, 2001 by ETH Zurich. All rights reserved.
+Copyright (c) 2000-2005 by ETH Zurich. All rights reserved.
=head1 LICENSE
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
=head1 AUTHOR
-S<David Schweikert E<lt>dws@ee.ethz.chE<gt>>
-S<Tobias Oetiker E<lt>oetiker@ee.ethz.chE<gt>>
+David Schweikert E<lt>dws_at_ee.ethz.chE<gt>,
+Tobias Oetiker E<lt>oetiker_at_ee.ethz.chE<gt>,
+Niko Tyni E<lt>ntyni_at_iki.fiE<gt>
=head1 HISTORY
- 2001-05-11 ds 1.2 Initial Version for policy 0.3
- 2001-09-04 ds 1.3 Remove space before comments, more strict variable definition
- 2001-09-19 to 1.4 Added _sub error parsing and _doc self documentation
- 2001-10-20 to Improved Rendering of _doc information
- 2002-01-09 to Added Documentation to the _text section documentation
- 2002-01-28 to Fixed quote parsing in tables
- 2002-03-12 ds 1.5 Implemented @define, make makepod return a string and not an array
- 2002-08-28 to Added maketmpl methode
- 2002-10-10 ds 1.6 More verbatim _text sections
- 2004-02-09 to 1.7 Added _example propperty for pod and template generation
- 2004-08-17 to 1.8 Allow special input files like "program|"
- 2005-01-10 ds 1.9 Implemented _dyn, _default, _recursive, and _inherited (Niko Tyni)
+ 2001-05-11 ds Initial Version of ISG::ParseConfig
+ 2005-03-08 ds 1.00 Renamed from ISG::ParseConfig to Config::Grammar
=cut
diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm
index 8cd5897..28923e7 100644
--- a/lib/Smokeping.pm
+++ b/lib/Smokeping.pm
@@ -9,18 +9,25 @@ use Digest::MD5 qw(md5_base64);
use SNMP_util;
use SNMP_Session;
use POSIX;
-use ISG::ParseConfig;
+use Config::Grammar;
use RRDs;
use Sys::Syslog qw(:DEFAULT setlogsock);
+
setlogsock('unix')
if grep /^ $^O $/xo, ("linux", "openbsd", "freebsd", "netbsd");
+
+# make sure we do not end up with , in odd places where one would expect a '.'
+# we set the environment variable so that our 'kids' get the benefit too
+$ENV{LC_NUMERIC}='C';
+POSIX::setlocale(&POSIX::LC_NUMERIC,"");
+
use File::Basename;
use Smokeping::Examples;
use Smokeping::RRDtools;
# globale persistent variables for speedy
use vars qw($cfg $probes $VERSION $havegetaddrinfo $cgimode);
-$VERSION="1.99001";
+$VERSION="1.99006";
# we want opts everywhere
my %opt;
@@ -50,6 +57,10 @@ sub find_libdir {
sub do_log(@);
sub load_probe($$$$);
+sub dummyCGI::param {
+ return wantarray ? () : "";
+}
+
sub load_probes ($){
my $cfg = shift;
my %prbs;
@@ -99,6 +110,11 @@ sub lnk ($$) {
}
}
+sub dyndir ($) {
+ my $cfg = shift;
+ return $cfg->{General}{dyndir} || $cfg->{General}{datadir};
+}
+
sub update_dynaddr ($$){
my $cfg = shift;
my $q = shift;
@@ -107,14 +123,19 @@ sub update_dynaddr ($$){
my $address = $ENV{REMOTE_ADDR};
my $targetptr = $cfg->{Targets};
foreach my $step (@target){
- return "Error: Unknown Target $step"
+ return "Error: Unknown target $step"
unless defined $targetptr->{$step};
$targetptr = $targetptr->{$step};
};
- return "Error: Invalid Target"
+ return "Error: Invalid target or secret"
unless defined $targetptr->{host} and
$targetptr->{host} eq "DYNAMIC/${secret}";
- my $file = $cfg->{General}{datadir}."/".(join "/", @target);
+ my $file = dyndir($cfg);
+ for (0..$#target-1) {
+ $file .= "/" . $target[$_];
+ ( -d $file ) || mkdir $file, 0755;
+ }
+ $file.= "/" . $target[-1];
my $prevaddress = "?";
my $snmp = snmpget_ident $address;
if (-r "$file.adr" and not -z "$file.adr"){
@@ -342,7 +363,7 @@ sub init_target_tree ($$$$) {
foreach my $prop (keys %{$tree}) {
if (ref $tree->{$prop} eq 'HASH'){
- if (not -d $name) {
+ if (not -d $name and not $cgimode) {
mkdir $name, 0755 or die "ERROR: mkdir $name: $!\n";
};
init_target_tree $cfg, $probes, $tree->{$prop}, "$name/$prop";
@@ -381,6 +402,7 @@ sub init_target_tree ($$$$) {
my $comparison = Smokeping::RRDtools::compare($name.".rrd", \@create);
die("Error: RRD parameter mismatch ('$comparison'). You must delete $name.rrd or fix the configuration parameters.\n")
if $comparison;
+ Smokeping::RRDtools::tuneds($name.".rrd", \@create);
}
}
}
@@ -542,6 +564,9 @@ sub get_overview ($$$$){
my $date = $cfg->{Presentation}{overview}{strftime} ?
POSIX::strftime($cfg->{Presentation}{overview}{strftime},
localtime(time)) : scalar localtime(time);
+ if ( $RRDs::VERSION >= 1.199908 ){
+ $date =~ s|:|\\:|g;
+ }
foreach my $prop (sort {$tree->{$a}{_order} <=> $tree->{$b}{_order}}
grep { ref $tree->{$_} eq 'HASH' and defined $tree->{$_}{host}}
keys %$tree) {
@@ -556,9 +581,11 @@ sub get_overview ($$$$){
'--start','-'.exp2seconds($cfg->{Presentation}{overview}{range}),
'--title',$tree->{$prop}{title},
'--height',$cfg->{Presentation}{overview}{height},
- '--width',,$cfg->{Presentation}{overview}{width},
+ '--width',$cfg->{Presentation}{overview}{width},
'--vertical-label',"Seconds",
'--imgformat','PNG',
+ '--alt-autoscale-max',
+ '--alt-y-grid',
'--lower-limit','0',
"DEF:median=${rrd}:median:AVERAGE",
"DEF:loss=${rrd}:loss:AVERAGE",
@@ -566,11 +593,10 @@ sub get_overview ($$$$){
"CDEF:dm=median,0,$max,LIMIT",
"CDEF:dm2=median,1.5,*,0,$max,LIMIT",
"LINE1:dm2", # this is for kicking things down a bit
- "LINE1:dm#$medc:median RTT avg\\: ",
- "GPRINT:median:AVERAGE: %0.2lf %ss ",
- "GPRINT:median:LAST: latest RTT\\: %0.2lf %ss ",
- "GPRINT:ploss:AVERAGE: avg pkg loss\\: %.2lf %% ",
- "COMMENT: $date\\j");
+ "LINE1:dm#$medc:median RTT",
+ "GPRINT:median:AVERAGE:avg RTT\\: %.2lf %ss",
+ "GPRINT:ploss:AVERAGE:avg pkt loss\\: %.2lf %%",
+ "COMMENT:$date\\j");
my $ERROR = RRDs::error();
$page .= "<div>";
if (defined $ERROR) {
@@ -645,26 +671,46 @@ sub smokecol ($) {
return \@items;
}
+sub parse_datetime($){
+ my $in = shift;
+ for ($in){
+ /^\s*(\d{4})-(\d{1,2})-(\d{1,2})(?:\s+(\d{1,2}):(\d{2})(?::(\d{2}))?)?\s*$/ &&
+ return POSIX::mktime($6||0,$5||0,$4||0,$3,$2-1,$1-1900,0,0,-1);
+ /([ -:a-z0-9]+)/ && return $1;
+ };
+}
+
sub get_detail ($$$$){
+ # when drawing the detail page there are two modes for doing it
+ # a) classic with several static graphs on the page
+ # b) with one graph and below the graph one can specify the end time
+ # and the length of the graph.
my $cfg = shift;
my $q = shift;
my $tree = shift;
my $open = shift;
+
return "" unless $tree->{host};
+
my @dirs = @{$open};
my $file = pop @dirs;
my $dir = "";
- die "ERROR: ".(join ".", @dirs)." has no probe defined\n"
+
+ return "<div>ERROR: ".(join ".", @dirs)." has no probe defined</div>"
unless $tree->{probe};
- die "ERROR: ".(join ".", @dirs)." $tree->{probe} is not known\n"
+
+ return "<div>ERROR: ".(join ".", @dirs)." $tree->{probe} is not known</div>"
unless $cfg->{__probes}{$tree->{probe}};
+
my $probe = $cfg->{__probes}{$tree->{probe}};
my $ProbeDesc = $probe->ProbeDesc();
my $step = $probe->step();
my $pings = $probe->_pings($tree);
-
my $page;
+ my $mode = $q->param('displaymode') || 's';
+ return "<div>ERROR: unknown displaymode $mode</div>"
+ unless $mode =~ /^[sn]$/;
for (@dirs) {
$dir .= "/$_";
@@ -674,142 +720,190 @@ sub get_detail ($$$$){
unless -d $cfg->{General}{imgcache}.$dir;
}
- my $rrd = $cfg->{General}{datadir}."/".(join "/", @dirs)."/${file}.rrd";
- my $img = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}.rrd";
-
- my %lasthight;
- if (open (HG,"<${img}.maxhight")){
- while (<HG>){
- chomp;
- my @l = split / /;
- $lasthight{$l[0]} = $l[1];
- }
- close HG;
- }
- my $max = findmax $cfg, $rrd;
- if (open (HG,">${img}.maxhight")){
- foreach my $s (keys %{$max}){
- print HG "$s $max->{$s}\n";
- }
- close HG;
- }
+ my $rrd = $cfg->{General}{datadir}."/".$dir."/${file}.rrd";
+
+ my $imgbase;
+ my $imghref;
+ my $max;
+ my @tasks;
+ my %lasthight;
+
+ if ($mode eq 's'){
+ # in nave mode there is only one graph, so the height calculation
+ # is not necessary.
+ $imgbase = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}";
+ $imghref = $cfg->{General}{imgurl}."/".(join "/", @dirs)."/${file}";
+ @tasks = @{$cfg->{Presentation}{detail}{_table}};
+ if (open (HG,"<${imgbase}.maxhight")){
+ while (<HG>){
+ chomp;
+ my @l = split / /;
+ $lasthight{$l[0]} = $l[1];
+ }
+ close HG;
+ }
+ $max = findmax $cfg, $rrd;
+ if (open (HG,">${imgbase}.maxhight")){
+ foreach my $s (keys %{$max}){
+ print HG "$s $max->{$s}\n";
+ }
+ close HG;
+ }
+ } else {
+ mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $cfg->{General}{imgcache}."/__navcache";
+ # remove old images after one hour
+ my $pattern = $cfg->{General}{imgcache}."/__navcache/*.png";
+ for (glob $pattern){
+ unlink $_ if time - (stat $_)[9] > 3600;
+ }
+ $imgbase =$cfg->{General}{imgcache}."/__navcache/".time()."$$";
+ $imghref =$cfg->{General}{imgurl}."/__navcache/".time()."$$";
+ @tasks = (["Navigator Mode", parse_datetime($q->param('start')),parse_datetime($q->param('end'))]);
+ my ($graphret,$xs,$ys) = RRDs::graph
+ ("dummy",
+ '--start', $tasks[0][1],
+ '--end',$tasks[0][2],
+ "DEF:maxping=${rrd}:median:AVERAGE",
+ 'PRINT:maxping:MAX:%le' );
+ my $ERROR = RRDs::error();
+ return "<div>RRDtool did not understand your input: $ERROR.</div>" if $ERROR;
+ my $val = $graphret->[0];
+ $val = 1 if $val =~ /nan/i;
+ $max = { $tasks[0][1] => $val * 1.5 };
+ }
+
my $smoke = $pings >= 3
- ? smokecol $pings :
- [ 'COMMENT:(Not enough pings to draw any smoke.)\s', 'COMMENT:\s' ];
- # one \s doesn't seem to be enough
+ ? smokecol $pings :
+ [ 'COMMENT:(Not enough pings to draw any smoke.)\s', 'COMMENT:\s' ];
+ # one \s doesn't seem to be enough
my @upargs;
my @upsmoke;
- my @median;
- my $date = $cfg->{Presentation}{detail}{strftime} ?
- POSIX::strftime($cfg->{Presentation}{detail}{strftime},
- localtime(time)) : scalar localtime(time);
-
- for (@{$cfg->{Presentation}{detail}{_table}}) {
- my ($desc,$start) = @{$_};
- $start = exp2seconds($start);
- do {
- @median = ("DEF:median=${rrd}:median:AVERAGE",
- "DEF:loss=${rrd}:loss:AVERAGE",
- "CDEF:ploss=loss,$pings,/,100,*",
- "GPRINT:median:AVERAGE:Median Ping RTT (avg %.1lf %ss) ",
- "LINE1:median#202020"
- );
+ my %lc;
+ if ( defined $cfg->{Presentation}{detail}{loss_colors}{_table} ) {
+ for (@{$cfg->{Presentation}{detail}{loss_colors}{_table}}) {
+ my ($num,$col,$txt) = @{$_};
+ $lc{$num} = [ $txt, "#".$col ];
+ }
+ } else {
my $p = $pings;
+ %lc = (0 => ['0', '#26ff00'],
+ 1 => ["1/$p", '#00b8ff'],
+ 2 => ["2/$p", '#0059ff'],
+ 3 => ["3/$p", '#5e00ff'],
+ 4 => ["4/$p", '#7e00ff'],
+ int($p/2) => [int($p/2)."/$p", '#dd00ff'],
+ $p-1 => [($p-1)."/$p", '#ff0000'],
+ );
+ };
- my %lc;
- my $lastup = 0;
- if ( defined $cfg->{Presentation}{detail}{loss_colors}{_table} ) {
- for (@{$cfg->{Presentation}{detail}{loss_colors}{_table}}) {
- my ($num,$col,$txt) = @{$_};
- $lc{$num} = [ $txt, "#".$col ];
- }
- } else {
- %lc = (0 => ['0', '#26ff00'],
- 1 => ["1/$p", '#00b8ff'],
- 2 => ["2/$p", '#0059ff'],
- 3 => ["3/$p", '#5e00ff'],
- 4 => ["4/$p", '#7e00ff'],
- int($p/2) => [int($p/2)."/$p", '#dd00ff'],
- $p-1 => [($p-1)."/$p", '#ff0000'],
+ my %upt;
+ if ( defined $cfg->{Presentation}{detail}{uptime_colors}{_table} ) {
+ for (@{$cfg->{Presentation}{detail}{uptime_colors}{_table}}) {
+ my ($num,$col,$txt) = @{$_};
+ $upt{$num} = [ $txt, "#".$col];
+ }
+ } else {
+ %upt = ( 3600 => ['<1h', '#FFD3D3'],
+ 2*3600 => ['<2h', '#FFE4C7'],
+ 6*3600 => ['<6h', '#FFF9BA'],
+ 12*3600 => ['<12h','#F3FFC0'],
+ 24*3600 => ['<1d', '#E1FFCC'],
+ 7*24*3600 => ['<1w', '#BBFFCB'],
+ 30*24*3600 => ['<1m', '#BAFFF5'],
+ '1e100' => ['>1m', '#DAECFF']
+ );
+ }
+
+ my $date = $cfg->{Presentation}{detail}{strftime} ?
+ POSIX::strftime($cfg->{Presentation}{detail}{strftime},
+ localtime(time)) : scalar localtime(time);
+ my $BS = '';
+ if ( $RRDs::VERSION >= 1.199908 ){
+ $date =~ s|:|\\:|g;
+ $ProbeDesc =~ s|:|\\:|g;
+ $BS = '\\';
+ }
+
+ for (@tasks) {
+ my ($desc,$start,$end) = @{$_};
+ $end ||= 'last';
+ $start = exp2seconds($start) if $mode eq 's';
+
+ my $startstr = $start =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)) : $start;
+ my $endstr = $end =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)) : $end;
+
+ my $last = -1;
+ my $swidth = $max->{$start} / $cfg->{Presentation}{detail}{height};
+ my @median = ("DEF:median=${rrd}:median:AVERAGE",
+ "DEF:loss=${rrd}:loss:AVERAGE",
+ "CDEF:ploss=loss,$pings,/,100,*",
+ "GPRINT:median:AVERAGE:Median Ping RTT (%.1lf %ss avg) ",
+ "LINE1:median#202020"
);
- };
- my $last = -1;
- my $swidth = $max->{$start} / $cfg->{Presentation}{detail}{height};
foreach my $loss (sort {$a <=> $b} keys %lc){
next if $loss >= $pings;
- my $lvar = $loss; $lvar =~ s/\./d/g ;
+ my $lvar = $loss; $lvar =~ s/\./d/g ;
push @median,
- (
- "CDEF:me$lvar=loss,$last,GT,loss,$loss,LE,*,1,UNKN,IF,median,*",
- "CDEF:meL$lvar=me$lvar,$swidth,-",
- "CDEF:meH$lvar=me$lvar,0,*,$swidth,2,*,+",
- "AREA:meL$lvar",
- "STACK:meH$lvar$lc{$loss}[1]:$lc{$loss}[0]"
- );
- $last = $loss;
+ (
+ "CDEF:me$lvar=loss,$last,GT,loss,$loss,LE,*,1,UNKN,IF,median,*",
+ "CDEF:meL$lvar=me$lvar,$swidth,-",
+ "CDEF:meH$lvar=me$lvar,0,*,$swidth,2,*,+",
+ "AREA:meL$lvar",
+ "STACK:meH$lvar$lc{$loss}[1]:$lc{$loss}[0]"
+ # "LINE2:me$lvar$lc{$loss}[1]:$lc{$loss}[0]"
+ );
+ $last = $loss;
}
- push @median, ( "GPRINT:ploss:AVERAGE: avg pkg loss\\: %.2lf %%\\l" );
-# map {print "$_<br/>"} @median;
- };
+ push @median, ( "COMMENT:\\l",
+ "GPRINT:ploss:AVERAGE:Packet Loss\\: %.2lf %% average",
+ "GPRINT:ploss:MAX:%.2lf %% maximum",
+ "GPRINT:ploss:LAST:%.2lf %% current\\l"
+ );
+
# if we have uptime draw a colorful background or the graph showing the uptime
- my $cdir=$cfg->{General}{datadir}."/".(join "/", @dirs)."/";
+ my $cdir=dyndir($cfg)."/".(join "/", @dirs)."/";
if (-f "$cdir/${file}.adr") {
- @upsmoke = ();
- @upargs = ('COMMENT:Link Up: ',
- "DEF:uptime=${rrd}:uptime:AVERAGE",
- "CDEF:duptime=uptime,86400,/",
- 'GPRINT:duptime:LAST: %0.1lf days (');
- my %upt;
- if ( defined $cfg->{Presentation}{detail}{uptime_colors}{_table} ) {
- for (@{$cfg->{Presentation}{detail}{uptime_colors}{_table}}) {
- my ($num,$col,$txt) = @{$_};
- $upt{$num} = [ $txt, "#".$col];
- }
- } else {
- %upt = ( 3600 => ['<1h', '#FFD3D3'],
- 2*3600 => ['<2h', '#FFE4C7'],
- 6*3600 => ['<6h', '#FFF9BA'],
- 12*3600 => ['<12h','#F3FFC0'],
- 24*3600 => ['<1d', '#E1FFCC'],
- 7*24*3600 => ['<1w', '#BBFFCB'],
- 30*24*3600 => ['<1m', '#BAFFF5'],
- '1e100' => ['>1m', '#DAECFF']
- );
- }
- my $lastup = 0;
- foreach my $uptime (sort {$a <=> $b} keys %upt){
- push @upargs,
- (
- "CDEF:up$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,INF,UNKN,IF",
- "AREA:up$uptime$upt{$uptime}[1]:$upt{$uptime}[0]"
- );
- push @upsmoke,
- (
- "CDEF:ups$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,cp2,UNKN,IF",
- "AREA:ups$uptime$upt{$uptime}[1]"
+ @upsmoke = ();
+ @upargs = ("COMMENT:Link Up${BS}: ",
+ "DEF:uptime=${rrd}:uptime:AVERAGE",
+ "CDEF:duptime=uptime,86400,/",
+ 'GPRINT:duptime:LAST: %0.1lf days (');
+ my $lastup = 0;
+ foreach my $uptime (sort {$a <=> $b} keys %upt){
+ push @upargs,
+ (
+ "CDEF:up$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,INF,UNKN,IF",
+ "AREA:up$uptime$upt{$uptime}[1]:$upt{$uptime}[0]"
+ );
+ push @upsmoke,
+ (
+ "CDEF:ups$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,cp2,UNKN,IF",
+ "AREA:ups$uptime$upt{$uptime}[1]"
);
- $lastup=$uptime;
- }
-
- push @upargs, 'COMMENT:)\l';
-# map {print "$_<br/>"} @upargs;
- };
+ $lastup=$uptime;
+ }
+
+ push @upargs, 'COMMENT:)\l';
+ # map {print "$_<br/>"} @upargs;
+ };
my @log = ();
push @log, "--logarithmic" if $cfg->{Presentation}{detail}{logarithmic} and
- $cfg->{Presentation}{detail}{logarithmic} eq 'yes';
-
+ $cfg->{Presentation}{detail}{logarithmic} eq 'yes';
+
my @lazy =();
- @lazy = ('--lazy') if $lasthight{$start} and $lasthight{$start} == $max->{$start};
- my ($graphret,$xs,$ys) = RRDs::graph
- ($cfg->{General}{imgcache}.$dir."/${file}_last_${start}.png",
+ @lazy = ('--lazy') if $mode eq 's' and $lasthight{$start} and $lasthight{$start} == $max->{$start};
+ $desc = "Navigator Graph" if $mode eq 'n';
+ my $timer_start = time();
+ my @task =
+ ("${imgbase}_${end}_${start}.png",
@lazy,
- '--start','-'.$start,
+ '--start',( $mode eq 's' ? '-'.$start : $start),
+ ($end ne 'last' ? ('--end',$end) : ()),
'--height',$cfg->{Presentation}{detail}{height},
'--width',,$cfg->{Presentation}{detail}{width},
'--title',$desc,
- '--rigid',
- '--upper-limit', $max->{$start},
+ '--rigid','--upper-limit', $max->{$start},
@log,
'--lower-limit',(@log ? ($max->{$start} > 0.01) ? '0.001' : '0.0001' : '0'),
'--vertical-label',"Seconds",
@@ -824,8 +918,6 @@ sub get_detail ($$$$){
@$smoke,
@upsmoke, # draw the rest of the uptime bg color
@median,
-# 'LINE3:median#ff0000:Median RTT in grey '.$cfg->{Database}{pings}.' pings sorted by RTT',
-# 'LINE1:median#ff8080',
# Gray background for times when no data was collected, so they can
# be distinguished from network being down.
( $cfg->{Presentation}{detail}{nodata_color} ? (
@@ -834,14 +926,39 @@ sub get_detail ($$$$){
()),
'HRULE:0#000000',
'COMMENT:\s',
- "COMMENT:Probe: $pings $ProbeDesc every $step seconds",
+ "COMMENT:Probe${BS}: $pings $ProbeDesc every $step seconds",
'COMMENT:created on '.$date.'\j' );
+
+ my ($graphret,$xs,$ys) = RRDs::graph @task;
my $ERROR = RRDs::error();
- $page .= "<div>".
- ( $ERROR ||
- "<IMG BORDER=\"0\" WIDTH=\"$xs\" HEIGHT=\"$ys\" ".
- "SRC=\"".$cfg->{General}{imgurl}.$dir."/${file}_last_${start}.png\">" )."</div>";
+ if ($mode eq 'n'){
+ $page .= "<div>";
+ $page .= ( $ERROR || qq|<IMG BORDER="0" WIDTH="$xs" HEIGHT="$ys" SRC="${imghref}_${end}_${start}.png">| );
+ $page .= "</div>";
+ $page .= $q->start_form(-method=>'GET')
+ . "<p>Time range: "
+ . $q->textfield(-name=>'start',-default=>$startstr)
+ . "&nbsp;&nbsp;to&nbsp;&nbsp;".$q->textfield(-name=>'end',-default=>$endstr)
+ . $q->hidden(-name=>'target' )
+ . $q->hidden(-name=>'displaymode',-default=>$mode )
+ . "&nbsp;"
+ . $q->submit(-name=>'Generate!')
+ . "</p>"
+ . $q->end_form();
+ } else {
+ $startstr =~ s/\s/%20/g;
+ $endstr =~ s/\s/%20/g;
+ $page .= "<div>";
+# $page .= (time-$timer_start)."<br/>";
+# $page .= join " ",map {"'$_'"} @task;
+ $page .= "<br/>";
+ $page .= ( $ERROR ||
+ qq{<a href="?displaymode=n;start=$startstr;end=now;}."target=".$q->param('target').'">'
+ . qq{<IMG BORDER="0" WIDTH="$xs" HEIGHT="$ys" SRC="${imghref}_${end}_${start}.png">}."</a>" );
+ $page .= "</div>";
+
+ }
}
return $page;
@@ -918,13 +1035,16 @@ sub update_rrds($$$$$) {
my $justthisprobe = shift; # if defined, update only the targets probed by this probe
my $probe = $tree->{probe};
- my $probeobj = $probes->{$probe};
foreach my $prop (keys %{$tree}) {
if (ref $tree->{$prop} eq 'HASH'){
update_rrds $cfg, $probes, $tree->{$prop}, $name."/$prop", $justthisprobe;
}
- next if defined $justthisprobe and $probe ne $justthisprobe;
+ # if we are looking down a branche where no probe propperty is set there is not sense
+ # in further exploring it
+ next unless defined $probe;
+ next if defined $justthisprobe and $probe ne $justthisprobe;
+ my $probeobj = $probes->{$probe};
if ($prop eq 'host' and check_filter($cfg,$name)) {
#print "update $name\n";
my $updatestring = $probeobj->rrdupdate_string($tree);
@@ -1383,7 +1503,7 @@ DOC
# if there is a subprobe, the top-level section
# of this probe turns into a template, and we
# need to delete its _mandatory list.
- # Note that ISG::ParseConfig does mandatory checking
+ # Note that Config::Grammar does mandatory checking
# after the whole config tree is read, so we can fiddle
# here with "_mandatory" all we want.
# see 1.3 above
@@ -1446,7 +1566,7 @@ DOC
},
}; # $PROBES
- my $parser = ISG::ParseConfig->new
+ my $parser = Config::Grammar->new
(
{
_sections => [ qw(General Database Presentation Probes Alerts Targets) ],
@@ -1457,9 +1577,9 @@ DOC
General configuration values valid for the whole SmokePing setup.
DOC
_vars =>
- [ qw(owner imgcache imgurl datadir pagedir piddir sendmail offset
+ [ qw(owner imgcache imgurl datadir dyndir pagedir piddir sendmail offset
smokemail cgiurl mailhost contact netsnpp
- syslogfacility syslogpriority concurrentprobes changeprocessnames) ],
+ syslogfacility syslogpriority concurrentprobes changeprocessnames tmail) ],
_mandatory =>
[ qw(owner imgcache imgurl datadir piddir
smokemail cgiurl contact) ],
@@ -1527,7 +1647,16 @@ DOC
The directory where SmokePing can keep its rrd files.
DOC
},
+ dyndir =>
+ {
+ %$DIRCHECK_SUB,
+ _doc => <<DOC,
+The base directory where SmokePing keeps the files related to the DYNAMIC function.
+This directory must be writeable by the WWW server.
+If this variable is not specified, the value of C<datadir> will be used instead.
+DOC
+ },
piddir =>
{
%$DIRCHECK_SUB,
@@ -1618,6 +1747,13 @@ be appended to the process name as '[probe]', eg. '/usr/bin/smokeping
If 'concurrentprobes' is not set to 'yes', this variable has no effect.
DOC
},
+ tmail =>
+ {
+ %$FILECHECK_SUB,
+ _doc => <<DOC,
+Path to your tSmoke HTML mail template file. See the tSmoke documentation for details.
+DOC
+ }
},
Database =>
{
@@ -2036,7 +2172,7 @@ let the pattern match:
>10%,*10*,>10%
-will fire if more than 10% of the packets have been losst twice over the
+will fire if more than 10% of the packets have been lost at least twice over the
last 10 samples.
A complete example
@@ -2278,6 +2414,7 @@ sub daemonize_me ($) {
sub initialize_cgilog (){
$use_cgilog = 1;
+ CGI::Carp::set_progname($0 . " [client " . ($ENV{REMOTE_ADDR}||"(unknown)") . "]");
$logging=1;
}
@@ -2305,7 +2442,7 @@ sub daemonize_me ($) {
sub do_cgilog ($){
my $str = shift;
print "<p>" , $str, "</p>\n";
- print STDERR $str,"\n"; # for the webserver log
+ warn $str, "\n"; # for the webserver log
}
sub do_debuglog ($){
@@ -2359,6 +2496,7 @@ sub load_cfg ($) {
sub makepod ($){
my $parser = shift;
my $e='=';
+ my $a='@';
my $retval = <<POD;
${e}head1 NAME
@@ -2374,7 +2512,7 @@ The contents of this manual is generated directly from the configuration
file parser.
The Parser for the Configuration file is written using David Schweikers
-ParseConfig module. Read all about it in L<ISG::ParseConfig>.
+Config::Grammar module. Read all about it in L<Config::Grammar>.
The Configuration file has a tree-like structure with section headings at
various levels. It also contains variable assignments and tables.
@@ -2384,7 +2522,29 @@ for simple configuration examples.
${e}head1 REFERENCE
-The text below describes the syntax of the SmokePing configuration file.
+${e}head2 GENERAL SYNTAX
+
+The text below describes the general syntax of the SmokePing configuration file.
+It was copied from the Config::Grammar documentation.
+
+'#' denotes a comment up to the end-of-line, empty lines are allowed and space
+at the beginning and end of lines is trimmed.
+
+'\\' at the end of the line marks a continued line on the next line. A single
+space will be inserted between the concatenated lines.
+
+'${a}include filename' is used to include another file.
+
+'${a}define a some value' will replace all occurences of 'a' in the following text
+with 'some value'.
+
+Fields in tables that contain white space can be enclosed in either C<'> or C<">.
+Whitespace can also be escaped with C<\\>. Quotes inside quotes are allowed but must
+be escaped with a backslash as well.
+
+${e}head2 SPECIFIC SYNTAX
+
+The text below describes the specific syntax of the SmokePing configuration file.
POD
@@ -2427,14 +2587,21 @@ sub cgi ($) {
umask 022;
load_cfg shift;
my $q=new CGI;
- print $q->header(-type=>'text/html',
+ initialize_cgilog();
+ if ($q->param(-name=>'secret') && $q->param(-name=>'target') ) {
+ my $ret = update_dynaddr $cfg,$q;
+ if (defined $ret and $ret ne "") {
+ print $q->header(-status => "404 Not Found");
+ do_cgilog("Updating DYNAMIC address failed: $ret");
+ } else {
+ print $q->header; # no HTML output on success
+ }
+ } else {
+ print $q->header(-type=>'text/html',
-expires=>'+'.($cfg->{Database}{step}).'s',
-charset=> ( $cfg->{Presentation}{charset} || 'iso-8859-15')
);
- if ($q->param(-name=>'secret') && $q->param(-name=>'target') ) {
- update_dynaddr $cfg,$q;
- } else {
- display_webpage $cfg,$q;
+ display_webpage $cfg,$q;
}
}
diff --git a/lib/Smokeping/RRDtools.pm b/lib/Smokeping/RRDtools.pm
index 7260cca..2b7ad2b 100644
--- a/lib/Smokeping/RRDtools.pm
+++ b/lib/Smokeping/RRDtools.pm
@@ -4,7 +4,7 @@ package Smokeping::RRDtools;
Smokeping::RRDtools - Tools for RRD file handling
-=head1 SYNOPSYS
+=head1 SYNOPSIS
use Smokeping::RRDtools;
use RRDs;
@@ -22,12 +22,15 @@ Smokeping::RRDtools - Tools for RRD file handling
my $comparison = Smokeping::RRDtools::compare($file, \@create);
print "Create arguments didn't match: $comparison\n" if $comparison;
+ Smokeping::RRDtools::tuneds($file, \@create);
+
=head1 DESCRIPTION
-This module offers two functions, C<info2create> and C<compare>.
-The first can be used to recreate the arguments that an RRD file
-was created with. The second checks if an RRD file was created
-with the given arguments.
+This module offers three functions, C<info2create>, C<compare> and
+C<tuneds>. The first can be used to recreate the arguments that an RRD file
+was created with. The second checks if an RRD file was created with the
+given arguments. The thirds tunes the DS parameters according to the
+supplied create string.
The function C<info2create> must be called with one argument:
the path to the interesting RRD file. It will return an array
@@ -35,14 +38,17 @@ reference of the argument list that can be fed to C<RRDs::create>.
Note that this list will never contain the C<start> parameter,
but it B<will> contain the C<step> parameter.
-The function C<compare> must be called with two arguments: the path
-to the interesting RRD file, and a reference to an argument list that
-could be fed to C<RRDs::create>. The function will then simply compare
-the result of C<info2create> with this argument list. It will return
-C<undef> if the arguments matched, and a string indicating the difference
-if a discrepancy was found. Note that if there is a C<start> parameter in
-the argument list, C<compare> disregards it. If C<step> isn't specified,
-C<compare> will use the C<rrdtool> default of 300 seconds.
+The function C<compare> must be called with two arguments: the path to the
+interesting RRD file, and a reference to an argument list that could be fed
+to C<RRDs::create>. The function will then simply compare the result of
+C<info2create> with this argument list. It will return C<undef> if the
+arguments matched, and a string indicating the difference if a discrepancy
+was found. Note that if there is a C<start> parameter in the argument list,
+C<compare> disregards it. If C<step> isn't specified, C<compare> will use
+the C<rrdtool> default of 300 seconds. C<compare> ignores non-matching DS
+parameters since C<tuneds> will fix them.
+
+C<tuneds> talks on stderr about the parameters it fixes.
=head1 NOTES
@@ -57,6 +63,10 @@ Probably.
Copyright (c) 2005 by Niko Tyni.
+=head1 AUTHOR
+
+Niko Tyni <ntyni@iki.fi>
+
=head1 LICENSE
This program is free software; you can redistribute it
@@ -89,11 +99,13 @@ use RRDs;
sub info2create {
my $file = shift;
my @create;
+ my $buggy_perl_version = 1 if $^V and $^V eq v5.8.0;
my $info = RRDs::info($file);
my $error = RRDs::error;
die("RRDs::info $file: ERROR: $error") if $error;
die("$file: unknown RRD version: $info->{rrd_version}")
- unless $info->{rrd_version} eq '0001';
+ unless $info->{rrd_version} eq '0001'
+ or $info->{rrd_version} eq '0003';
my $cf = $info->{"rra[0].cf"};
die("$file: no RRAs found?")
unless defined $cf;
@@ -107,7 +119,8 @@ sub info2create {
my @s = ("DS", $ds);
for (qw(type minimal_heartbeat min max)) {
die("$file: missing $_ for DS $ds?")
- unless exists $info->{"ds[$ds].$_"};
+ unless exists $info->{"ds[$ds].$_"}
+ or $buggy_perl_version;
my $val = $info->{"ds[$ds].$_"};
push @s, defined $val ? $val : "U";
}
@@ -117,7 +130,8 @@ sub info2create {
my @s = ("RRA", $info->{"rra[$i].cf"});
for (qw(xff pdp_per_row rows)) {
die("$file: missing $_ for RRA $i")
- unless exists $info->{"rra[$i].$_"};
+ unless exists $info->{"rra[$i].$_"}
+ or $buggy_perl_version;
push @s, $info->{"rra[$i].$_"};
}
push @create, join(":", @s);
@@ -160,10 +174,37 @@ sub compare {
while (my $arg = shift @create) {
my $arg2 = shift @create2;
+ my @ds = split /:/, $arg;
+ my @ds2 = split /:/, $arg2;
+ next if $ds[0] eq 'DS' and $ds[0] eq $ds2[0] and $ds[1] eq $ds2[1] and $ds[2] eq $ds2[2];
return "Different arguments: $file has $arg2, create string has $arg"
unless $arg eq $arg2;
}
return undef;
}
+sub tuneds {
+ my $file = shift;
+ my $create = shift;
+ my @create2 = sort grep /^DS/, @{info2create($file)};
+ my @create = sort grep /^DS/, @$create;
+ while (@create){
+ my @ds = split /:/, shift @create;
+ my @ds2 = split /:/, shift @create2;
+ next unless $ds[1] eq $ds2[1] and $ds[2] eq $ds[2];
+ if ($ds[3] ne $ds2[3]){
+ warn "## Updating $file DS:$ds[1] heartbeat $ds2[3] -> $ds[3]\n";
+ RRDs::tune $file,"--hearbeat","$ds[1]:$ds[3]" unless $ds[3] eq $ds2[3];
+ }
+ if ($ds[4] ne $ds2[4]){
+ warn "## Updating $file DS:$ds[1] minimum $ds2[4] -> $ds[4]\n";
+ RRDs::tune $file,"--minimum","$ds[1]:$ds[4]" unless $ds[4] eq $ds2[4];
+ }
+ if ($ds[5] ne $ds2[5]){
+ warn "## Updating $file DS:$ds[1] maximum $ds2[5] -> $ds[5]\n";
+ RRDs::tune $file,"--maximum","$ds[1]:$ds[5]" unless $ds[5] eq $ds2[5];
+ }
+ }
+}
+
1;
diff --git a/lib/Smokeping/matchers/Avgratio.pm b/lib/Smokeping/matchers/Avgratio.pm
index 8679fe9..e97fcf0 100644
--- a/lib/Smokeping/matchers/Avgratio.pm
+++ b/lib/Smokeping/matchers/Avgratio.pm
@@ -5,7 +5,7 @@ package Smokeping::matchers::Avgratio;
Smokeping::matchers::Avgratio - detect changes in average median latency
=head1 OVERVIEW
-
+
The Avgratio matcher establishes a historic average median latency over
several measurement rounds. It compares this average, against a second
average latency value again build over several rounds of measurement.
diff --git a/lib/Smokeping/probes/AnotherDNS.pm b/lib/Smokeping/probes/AnotherDNS.pm
index 65a1bd4..d4f0397 100644
--- a/lib/Smokeping/probes/AnotherDNS.pm
+++ b/lib/Smokeping/probes/AnotherDNS.pm
@@ -69,6 +69,7 @@ sub pingone ($) {
my $recordtype = $target->{vars}{recordtype};
my $timeout = $target->{vars}{timeout};
my $port = $target->{vars}{port};
+ my $require_noerror = $target->{vars}{require_noerror};
$lookuphost = $target->{addr} unless defined $lookuphost;
my $packet = Net::DNS::Packet->new( $lookuphost, $recordtype )->data;
@@ -93,9 +94,20 @@ sub pingone ($) {
my $t1 = [gettimeofday];
$elapsed = tv_interval( $t0, $t1 );
if ( defined $ready ) {
- push @times, $elapsed;
my $buf = '';
$ready->recv( $buf, &Net::DNS::PACKETSZ );
+ my ($recvPacket, $err) = Net::DNS::Packet->new(\$buf);
+ if (defined $recvPacket) {
+ if (not $require_noerror) {
+ push @times, $elapsed;
+ } else {
+ # Check the Response Code for the NOERROR.
+ my $recvHeader = $recvPacket->header();
+ if ($recvHeader->rcode() eq "NOERROR") {
+ push @times, $elapsed;
+ }
+ }
+ }
}
}
@times =
@@ -127,6 +139,10 @@ DOC
_default => .5,
_re => '(\d*\.)?\d+',
},
+ require_noerror => {
+ _doc => 'Only Count Answers with Response Status NOERROR.',
+ _default => 0,
+ },
recordtype => {
_doc => 'Record type to look up.',
_default => 'A',
diff --git a/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm b/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm
index f763fde..c542ed1 100644
--- a/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm
+++ b/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm
@@ -92,8 +92,7 @@ sub new($$$)
sub ProbeDesc($){
my $self = shift;
- my $bytes = $self->{properties}{packetsize};
- return "CiscoRTTMonEchoICMP ($bytes Bytes)";
+ return "CiscoRTTMonEchoICMP";
}
sub pingone ($$) {
@@ -102,7 +101,7 @@ sub pingone ($$) {
my $pings = $self->pings($target) || 20;
my $tos = $target->{vars}{tos};
- my $bytes = $target->{properties}{packetsize};
+ my $bytes = $target->{vars}{packetsize};
# use the proces ID as as row number to make this poll distinct on the router;
my $row=$$;
@@ -260,27 +259,6 @@ sub DestroyData ($$) {
&snmpset($host, "rttMonCtrlAdminStatus.$row", 'integer', 6);
}
-sub probevars {
- my $class = shift;
- return $class->_makevars($class->SUPER::probevars, {
- packetsize => {
- _doc => <<DOC,
-The packetsize parameter lets you configure the packetsize for the pings
-sent. The minimum is 8, the maximum 16392. Use the same number as with
-fping, if you want the same packet sizes being used on the network.
-DOC
- _default => 56,
- _re => '\d+',
- _sub => sub {
- my $val = shift;
- return "ERROR: packetsize must be between 8 and 16392"
- unless $val >= 8 and $val <= 16392;
- return undef;
- },
- },
- });
-}
-
sub targetvars {
my $class = shift;
return $class->_makevars($class->SUPER::targetvars, {
@@ -315,6 +293,21 @@ corresponds to a DSCP value 40 and a Precedence value of 5. The RTTMon
MIB versions before IOS 12.0(3)T didn't support this parameter.
DOC
},
+ packetsize => {
+ _doc => <<DOC,
+The packetsize parameter lets you configure the packetsize for the pings
+sent. The minimum is 8, the maximum 16392. Use the same number as with
+fping, if you want the same packet sizes being used on the network.
+DOC
+ _default => 56,
+ _re => '\d+',
+ _sub => sub {
+ my $val = shift;
+ return "ERROR: packetsize must be between 8 and 16392"
+ unless $val >= 8 and $val <= 16392;
+ return undef;
+ },
+ },
});
}
diff --git a/lib/Smokeping/probes/Curl.pm b/lib/Smokeping/probes/Curl.pm
index 56dd338..af5be29 100644
--- a/lib/Smokeping/probes/Curl.pm
+++ b/lib/Smokeping/probes/Curl.pm
@@ -102,6 +102,48 @@ host to be probed.
DOC
_example => "http://%host%/",
},
+ insecure_ssl => {
+ _doc => <<DOC,
+The "-k" curl(1) option. Accept SSL connections that don't have a secure
+certificate chain to a trusted CA. Note that if you are going to monitor
+https targets, you'll probably have to either enable this option or specify
+the CA path to curl through extraargs below. For more info, see the
+curl(1) manual page.
+DOC
+ _example => 1,
+ },
+ extrare=> {
+ _doc => <<DOC,
+The regexp used to split the extraargs string into an argument list,
+in the "/regexp/" notation. This contains just the space character
+(" ") by default, but if you need to specify any arguments containing spaces,
+you can set this variable to a different value.
+DOC
+ _default => "/ /",
+ _example => "/ /",
+ _sub => sub {
+ my $val = shift;
+ return "extrare should be specified in the /regexp/ notation"
+ unless $val =~ m,^/.*/$,;
+ return undef;
+ },
+ },
+ extraargs => {
+ _doc => <<DOC,
+Any extra arguments you might want to hand to curl(1). The arguments
+should be separated by the regexp specified in "extrare", which
+contains just the space character (" ") by default.
+
+Note that curl will be called with the resulting list of arguments
+without any shell expansion. If you need to specify any arguments
+containing spaces, you should set "extrare" to something else.
+
+As a complicated example, to explicitly set the "Host:" header in Curl
+requests, you need to set "extrare" to something else, eg. "/;/",
+and then specify C<extraargs = --header;Host: www.example.com>.
+DOC
+ _example => "-6 --head --user user:password",
+ },
});
}
@@ -178,9 +220,22 @@ sub proto_args {
my @args = ("-o", "/dev/null", "-w", "Time: %{time_total} DNS time: %{time_namelookup}\\n");
my $ssl2 = $target->{vars}{ssl2};
push (@args, "-2") if defined($ssl2);
+ my $insecure_ssl = $target->{vars}{insecure_ssl};
+ push (@args, '-k') if defined $insecure_ssl;
+
return(@args);
}
+sub extra_args {
+ my $self = shift;
+ my $target = shift;
+ my $args = $target->{vars}{extraargs};
+ return () unless defined $args;
+ my $re = $target->{vars}{extrare};
+ ($re =~ m,^/(.*)/$,) and $re = qr{$1};
+ return split($re, $args);
+}
+
sub make_commandline {
my $self = shift;
my $target = shift;
@@ -191,6 +246,7 @@ sub make_commandline {
my $host = $target->{addr};
$url =~ s/%host%/$host/g;
push @args, $self->proto_args($target);
+ push @args, $self->extra_args($target);
return ($self->{properties}{binary}, @args, $url);
}
diff --git a/lib/Smokeping/probes/base.pm b/lib/Smokeping/probes/base.pm
index 8cc4def..c0525b6 100644
--- a/lib/Smokeping/probes/base.pm
+++ b/lib/Smokeping/probes/base.pm
@@ -42,12 +42,14 @@ sub pod {
my $class = shift;
my $pod = "";
my $podhash = $class->pod_hash;
- $podhash->{synopsys} = $class->pod_synopsys;
+ $podhash->{synopsis} = $class->pod_synopsis;
$podhash->{variables} = $class->pod_variables;
- for my $what (qw(name overview synopsys description variables authors notes bugs see_also)) {
+ for my $what (qw(name overview synopsis description variables authors notes bugs see_also)) {
my $contents = $podhash->{$what};
next if not defined $contents or $contents eq "";
- $pod .= "=head1 " . uc $what . "\n\n";
+ my $headline = uc $what;
+ $headline =~ s/_/ /; # see_also => SEE ALSO
+ $pod .= "=head1 $headline\n\n";
$pod .= $contents;
chomp $pod;
$pod .= "\n\n";
@@ -88,6 +90,23 @@ sub ProbeDesc ($) {
return "Probe which does not overrivd the ProbeDesc methode";
}
+sub target2dynfile ($$) {
+ # the targets are stored in the $self->{targets}
+ # hash as filenames pointing to the RRD files
+ #
+ # now that we use a (optionally) different dir for the
+ # . adr files, we need to derive the .adr filename
+ # from the RRD filename with a simple substitution
+
+ my $self = shift;
+ my $target = shift; # filename with <datadir> embedded
+ my $dyndir = $self->{cfg}{General}{dyndir};
+ return $target unless defined $dyndir; # nothing to do
+ my $datadir = $self->{cfg}{General}{datadir};
+ $target =~ s/^\Q$datadir\E/$dyndir/;
+ return $target;
+}
+
sub rrdupdate_string($$)
{ my $self = shift;
my $tree = shift;
@@ -105,17 +124,18 @@ sub rrdupdate_string($$)
my $upperloss = $loss - $lowerloss;
@times = ((map {'U'} 1..$lowerloss),@times, (map {'U'} 1..$upperloss));
my $age;
- if ( -f $self->{targets}{$tree}.".adr" ) {
- $age = time - (stat($self->{targets}{$tree}.".adr"))[9];
+ my $dynbase = $self->target2dynfile($self->{targets}{$tree});
+ if ( -f $dynbase.".adr" ) {
+ $age = time - (stat($dynbase.".adr"))[9];
} else {
$age = 'U';
}
if ( $entries == 0 ){
$age = 'U';
$loss = 'U';
- if ( -f $self->{targets}{$tree}.".adr"
- and not -f $self->{targets}{$tree}.".snmp" ){
- unlink $self->{targets}{$tree}.".adr";
+ if ( -f $dynbase.".adr"
+ and not -f $dynbase.".snmp" ){
+ unlink $dynbase.".adr";
}
} ;
return "${age}:${loss}:${median}:".(join ":", @times);
@@ -129,12 +149,13 @@ sub addresses($)
foreach my $tree (keys %{$self->{targets}}){
my $target = $self->{targets}{$tree};
if ($target =~ m|/|) {
- if ( open D, "<$target.adr" ) {
+ my $dynbase = $self->target2dynfile($target);
+ if ( open D, "<$dynbase.adr" ) {
my $ip;
chomp($ip = <D>);
close D;
- if ( open D, "<$target.snmp" ) {
+ if ( open D, "<$dynbase.snmp" ) {
my $snmp = <D>;
chomp($snmp);
if ($snmp ne Smokeping::snmpget_ident $ip) {
@@ -316,7 +337,7 @@ sub _makevars {
return $to;
}
-sub pod_synopsys {
+sub pod_synopsis {
my $class = shift;
my $classname = ref $class||$class;
$classname =~ s/^Smokeping::probes:://;
@@ -329,8 +350,8 @@ sub pod_synopsys {
+$classname
DOC
- $pod .= $class->_pod_synopsys($probevars);
- my $targetpod = $class->_pod_synopsys($targetvars);
+ $pod .= $class->_pod_synopsis($probevars);
+ my $targetpod = $class->_pod_synopsis($targetvars);
$pod .= "\n # The following variables can be overridden in each target section\n$targetpod"
if defined $targetpod and $targetpod ne "";
$pod .= <<DOC;
@@ -353,8 +374,8 @@ DOC
return $pod;
}
-# synopsys for one hash ref
-sub _pod_synopsys {
+# synopsis for one hash ref
+sub _pod_synopsis {
my $class = shift;
my $vars = shift;
my %mandatory;
diff --git a/lib/Smokeping/probes/passwordchecker.pm b/lib/Smokeping/probes/passwordchecker.pm
index 7633eba..d1cc128 100644
--- a/lib/Smokeping/probes/passwordchecker.pm
+++ b/lib/Smokeping/probes/passwordchecker.pm
@@ -31,7 +31,7 @@ for storing passwords and a method for accessing them.
DOC
description => <<DOC,
-${e}head2 synopsys with more detail
+${e}head2 synopsis with more detail
SmokePing main configuration file:
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-11-17 16:41:51 +0100