-- cgit v1.2.3-24-g4f1b From 3dbf456570a2fc2ab25e246a8f656ab709c79586 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Tue, 22 Feb 2005 22:27:31 +0000 Subject: synced Makefile Changes --- Makefile | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index bb56142..3096129 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,6 @@ SHELL = /bin/sh -VERSION = 1.38 +VERSION = 2.0BRANCHE +NUMVERSION = 1.99002 IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp GROFF = groff .PHONY: man html txt ref examples check-examples patch killdoc doc tar rename-man symlinks remove-symlinks @@ -123,8 +124,8 @@ doc/smokeping_config.pod: lib/Smokeping.pm doc/smokeping_examples.pod: lib/Smokeping/Examples.pm etc/config.dist $(GENEX) patch: - perl -i~ -p -e 's/VERSION="\d.*?"/VERSION="$(VERSION)"/' lib/Smokeping.pm - perl -i~ -p -e 's/Smokeping \d.*?;/Smokeping $(VERSION);/' bin/smokeping.dist htdocs/smokeping.cgi.dist + perl -i~ -p -e 's/VERSION="\d.*?"/VERSION="$(NUMVERSION)"/' lib/Smokeping.pm + perl -i~ -p -e 's/Smokeping \d.*?;/Smokeping $(NUMVERSION);/' bin/smokeping.dist htdocs/smokeping.cgi.dist killdoc: -rm doc/*.[1357] doc/*.txt doc/*.html doc/Smokeping/* doc/Smokeping/probes/* doc/Smokeping/matchers/* doc/ISG/* doc/examples/* doc/smokeping_examples.pod doc/smokeping_config.pod doc/smokeping.pod doc/smokeping.cgi.pod -- cgit v1.2.3-24-g4f1b From 90caa79fbf5c6be6d42e2768d7a5868ac851895d Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Wed, 23 Feb 2005 06:36:45 +0000 Subject: exclude .svn directories --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 3096129..05553c0 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ SHELL = /bin/sh VERSION = 2.0BRANCHE NUMVERSION = 1.99002 -IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp +IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp|.svn GROFF = groff .PHONY: man html txt ref examples check-examples patch killdoc doc tar rename-man symlinks remove-symlinks .SUFFIXES: -- cgit v1.2.3-24-g4f1b From 30f15c0632513caff0c322c4cf1a8a1e10d9865c Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sat, 26 Feb 2005 18:00:27 +0000 Subject: SYNOPSYS is really spelled SYNOPSIS. Shame on me. --- doc/smokeping_extend.pod | 6 +++--- lib/Smokeping/RRDtools.pm | 2 +- lib/Smokeping/probes/base.pm | 14 +++++++------- lib/Smokeping/probes/passwordchecker.pm | 2 +- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/smokeping_extend.pod b/doc/smokeping_extend.pod index eef0bf6..402efac 100644 --- a/doc/smokeping_extend.pod +++ b/doc/smokeping_extend.pod @@ -46,7 +46,7 @@ manpage. The supported section names are C, C, C, C, C, C, and C. If you don't need a particular section, just leave it out. -The special sections C and C are automatically +The special sections C and C are automatically generated from the description of your variables. See below. Note that if you use 'here documents' ('<<') that have POD markup inside, @@ -114,7 +114,7 @@ Description of the variable. =item _example -An example value. This will be used in the SYNOPSYS section in the +An example value. This will be used in the SYNOPSIS section in the probe manual. =back @@ -185,7 +185,7 @@ That's it, you're done! =head1 EXAMPLE CONFIGURATIONS If you would like to provide a documented example configuration for your -probe (in addition to the automatically generated SYNOPSYS section in +probe (in addition to the automatically generated SYNOPSIS section in the probe manual), you can do so by adding it to the L module. Look for the 'examples' subroutine and add your example there. diff --git a/lib/Smokeping/RRDtools.pm b/lib/Smokeping/RRDtools.pm index 7260cca..3363f55 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; diff --git a/lib/Smokeping/probes/base.pm b/lib/Smokeping/probes/base.pm index 8cc4def..4ae81b5 100644 --- a/lib/Smokeping/probes/base.pm +++ b/lib/Smokeping/probes/base.pm @@ -42,9 +42,9 @@ 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"; @@ -316,7 +316,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 +329,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 .= < < Date: Sat, 26 Feb 2005 18:09:15 +0000 Subject: Changed my e-mail address to the @iki.fi one. --- CONTRIBUTORS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTORS b/CONTRIBUTORS index 90973d3..d801601 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -3,7 +3,7 @@ Contributors * Tobias Oetiker => Main Author -* Niko Tyni => Many Patches +* Niko Tyni => Many Patches * Simon Leinen => SNMP_Session.pm * David Schweikert => ISG::ParseConfig.pm * Jack Cummings => Proper graphs with pings > 10s. -- cgit v1.2.3-24-g4f1b From f65e5b94977a51279c81e781720334d46b5c4e78 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 27 Feb 2005 07:51:28 +0000 Subject: Update to David's newest version (only HISTORY changes). --- lib/ISG/ParseConfig.pm | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/lib/ISG/ParseConfig.pm b/lib/ISG/ParseConfig.pm index 9afdb11..b2fb8d0 100644 --- a/lib/ISG/ParseConfig.pm +++ b/lib/ISG/ParseConfig.pm @@ -1495,18 +1495,19 @@ Soetiker@ee.ethz.chE> =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 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) + 2005-02-21 ds 2.00 Implemented _dyndoc, _varlist and _sub for sections (Niko Tyni) =cut -- cgit v1.2.3-24-g4f1b From a4c71fe71c8f40a3534490a010cde424063003ef Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Sun, 27 Feb 2005 23:03:00 +0000 Subject: rc2 --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 05553c0..de1ec81 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ SHELL = /bin/sh VERSION = 2.0BRANCHE -NUMVERSION = 1.99002 +NUMVERSION = 1.99003 IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp|.svn GROFF = groff .PHONY: man html txt ref examples check-examples patch killdoc doc tar rename-man symlinks remove-symlinks -- cgit v1.2.3-24-g4f1b From 455ab143f72d62c07c9cef46ad3a726e2dcde065 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 6 Mar 2005 17:16:04 +0000 Subject: * lib/Smokeping/probes/base.pm: + probe documents had a 'SEE_ALSO' section; fixed to read "SEE ALSO". --- lib/Smokeping/probes/base.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/Smokeping/probes/base.pm b/lib/Smokeping/probes/base.pm index 4ae81b5..a322a21 100644 --- a/lib/Smokeping/probes/base.pm +++ b/lib/Smokeping/probes/base.pm @@ -47,7 +47,9 @@ sub pod { 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"; -- cgit v1.2.3-24-g4f1b From 6ffe2a9773e56a77bd1f3a07301154f0eeb10db3 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 6 Mar 2005 17:41:33 +0000 Subject: * trunk/website/bin/nestfix.pl: + renamed to branches/2.0/util/fix-pod2html.pl * branches/2.0/Makefile: + fix pod2html output with util/fix-pod2html.pl * branches/2.0/util/fix-pod2html.pl: + v1.4: insert the "N" letter into too. * trunk/website/bin/pod2wml.sh: + use fix-pod2html.pl from branches/2.0 --- Makefile | 2 +- util/fix-pod2html.pl | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+), 1 deletion(-) create mode 100755 util/fix-pod2html.pl diff --git a/Makefile b/Makefile index de1ec81..8a4795a 100644 --- a/Makefile +++ b/Makefile @@ -29,7 +29,7 @@ HTML= $(addsuffix .html,$(BASE)) POD2MAN = pod2man --release=$(VERSION) --center=SmokePing $< MAN2TXT = $(GROFF) -man -Tascii $< > $@ # pod2html apparently needs to be in the target directory to get L<> links right -POD2HTML= cd $(dir $@); top="$(shell echo $(dir $@)|sed -e 's,doc/,,' -e 's,[^/]*/,../,g' -e 's,/$$,,')"; top=$${top:-.}; pod2html --infile=$(CURDIR)/$< --outfile=$(notdir $@) --noindex --htmlroot=. --podroot=. --podpath=$${top} --title=$* +POD2HTML= cd $(dir $@); top="$(shell echo $(dir $@)|sed -e 's,doc/,,' -e 's,[^/]*/,../,g' -e 's,/$$,,')"; top=$${top:-.}; pod2html --infile=$(CURDIR)/$< --noindex --htmlroot=. --podroot=. --podpath=$${top} --title=$* | $${top}/../util/fix-pod2html.pl > $(notdir $@) # we go to this trouble to ensure that MAKEPOD only uses modules in the installation directory MAKEPOD= perl -Ilib -I/usr/pack/rrdtool-1.0.47-to/lib/perl -mSmokeping -e 'Smokeping::main()' -- --makepod GENEX= perl -Ilib -I/usr/pack/rrdtool-1.0.47-to/lib/perl -mSmokeping -e 'Smokeping::main()' -- --gen-examples diff --git a/util/fix-pod2html.pl b/util/fix-pod2html.pl new file mode 100755 index 0000000..fa51400 --- /dev/null +++ b/util/fix-pod2html.pl @@ -0,0 +1,73 @@ +#!/usr/bin/perl -w + +use strict; +use HTML::Parser; + +# fix pod2html output: +# v1.0: defer and tags until +# the next
,
or + +# v1.1: don't nest any elements; +# end one before beginning another + +# v1.2: insert
tags if
occurs +# inside
+ +# v1.3: anchors must not start with a digit; +# insert a letter "N" at the start if they do + +# v1.4: insert the "N" letter into too. + +my $p = HTML::Parser->new(api_version => 3); +$p->handler(start => \&startsub, 'tagname, text'); +$p->handler(end => \&endsub, 'tagname, text'); +$p->handler(default => sub { print shift() }, 'text'); +$p->parse_file(shift||"-") or die("parse: $!"); + +my @stack; +my $a=0; + +sub startsub { + my $tag = shift; + my $text = shift; + if ($tag eq "dl") { + if (@stack and $stack[0] eq "dt") { + $stack[0] = "dd"; + print "
"; + } + unshift @stack, 0; + } + if (($tag eq "dt" or $tag eq "dd") and $stack[0]) { + print ""; + $stack[0] = 0; + } + if ($tag eq "a") { + if ($a) { + print ""; + } else { + $a++; + } + $text =~ s/(name="|href="#)(\d)/$1N$2/; + } + print $text; +} + + +sub endsub { + my $tag = shift; + my $text = shift; + if ($tag eq "dl") { + print "" if $stack[0]; + shift @stack; + } + if ($tag eq "a") { + if ($a) { + print ""; + $a--; + } + } elsif ($tag eq "dd" or $tag eq "dt") { + $stack[0] = $tag; + } else { + print $text; + } +} -- cgit v1.2.3-24-g4f1b From 6e6508791dd10e9e2b5869187973b551dabc6fc9 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 8 Mar 2005 19:57:08 +0000 Subject: * branches/2.0/lib/Smokeping/RRDtools.pm: + add AUTHOR section to the POD documentation. --- lib/Smokeping/RRDtools.pm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/Smokeping/RRDtools.pm b/lib/Smokeping/RRDtools.pm index 3363f55..2b8e3a4 100644 --- a/lib/Smokeping/RRDtools.pm +++ b/lib/Smokeping/RRDtools.pm @@ -57,6 +57,10 @@ Probably. Copyright (c) 2005 by Niko Tyni. +=head1 AUTHOR + +Niko Tyni + =head1 LICENSE This program is free software; you can redistribute it -- cgit v1.2.3-24-g4f1b From 8acdb5d58ba10ecc1dc1d57be7fdc151515c82e0 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 8 Mar 2005 20:13:55 +0000 Subject: * branches/2.0/lib/ISG/ParseConfig.pm: + remove S<> tags from AUTHORS section as pod2html messes them up + explicitly set VERSION to 2.0 --- lib/ISG/ParseConfig.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/ISG/ParseConfig.pm b/lib/ISG/ParseConfig.pm index b2fb8d0..824ea79 100644 --- a/lib/ISG/ParseConfig.pm +++ b/lib/ISG/ParseConfig.pm @@ -6,7 +6,7 @@ package ISG::ParseConfig; use strict; use vars qw($VERSION); -$VERSION = 1.9; +$VERSION = 2.0; sub new($$) { @@ -1490,8 +1490,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =head1 AUTHOR -Sdws@ee.ethz.chE> -Soetiker@ee.ethz.chE> +David Schweikert Edws@ee.ethz.chE, +Tobias Oetiker Eoetiker@ee.ethz.chE =head1 HISTORY -- cgit v1.2.3-24-g4f1b From 1eda41862b7279427ab2da51b8dd12767118bfa4 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 9 Mar 2005 17:17:06 +0000 Subject: * change all ISG::ParseConfig references to its new name, Config::Grammar --- CHANGES | 1 + CONTRIBUTORS | 2 +- Makefile | 10 +- doc/smokeping_extend.pod | 10 +- lib/Config/Grammar.pm | 1502 +++++++++++++++++++++++++++++++++++++++++++++ lib/ISG/ParseConfig.pm | 1523 ---------------------------------------------- lib/Smokeping.pm | 8 +- 7 files changed, 1518 insertions(+), 1538 deletions(-) create mode 100644 lib/Config/Grammar.pm delete mode 100644 lib/ISG/ParseConfig.pm diff --git a/CHANGES b/CHANGES index 0383933..8a2e9c2 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,4 @@ +* change ISG::ParseConfig references to its new name, Config::Grammar -- niko * don't create any RRD files if running as a CGI -- niko * Curl timeouts work better now -- niko, reported by Chris Wilson * Curl User-Agent string doesn't need quotes anymore -- niko diff --git a/CONTRIBUTORS b/CONTRIBUTORS index d801601..c9d0ed6 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -5,5 +5,5 @@ Contributors * Niko Tyni => Many Patches * Simon Leinen => SNMP_Session.pm -* David Schweikert => ISG::ParseConfig.pm +* David Schweikert => Config::Grammar * Jack Cummings => Proper graphs with pings > 10s. diff --git a/Makefile b/Makefile index 8a4795a..dca0f23 100644 --- a/Makefile +++ b/Makefile @@ -9,7 +9,7 @@ GROFF = groff DOCS = $(filter-out doc/smokeping_config.pod doc/smokeping.pod doc/smokeping.cgi.pod,$(wildcard doc/*.pod)) doc/smokeping_examples.pod # section 7 DOCSCONFIG := doc/smokeping_config.pod # section 5 -PM := lib/ISG/ParseConfig.pm lib/Smokeping.pm lib/Smokeping/Examples.pm lib/Smokeping/RRDtools.pm +PM := lib/Config/Grammar.pm lib/Smokeping.pm lib/Smokeping/Examples.pm lib/Smokeping/RRDtools.pm PODPROBE := $(wildcard lib/Smokeping/probes/*.pm) PODMATCH := $(wildcard lib/Smokeping/matchers/*.pm) @@ -53,7 +53,7 @@ doc/Smokeping/probes/%.3: doc/Smokeping/probes/%.pod $(POD2MAN) --section 3 > $@ doc/Smokeping/matchers/%.3: lib/Smokeping/matchers/%.pm $(POD2MAN) --section 3 > $@ -doc/ISG/%.3: lib/ISG/%.pm +doc/Config/%.3: lib/Config/%.pm $(POD2MAN) --section 3 > $@ doc/smokeping.1: bin/smokeping.dist $(POD2MAN) --section 1 > $@ @@ -71,7 +71,7 @@ doc/Smokeping/RRDtools.html: lib/Smokeping/RRDtools.pm doc/Smokeping/matchers/%.html: lib/Smokeping/matchers/%.pm $(POD2HTML) -doc/ISG/%.html: lib/ISG/%.pm +doc/Config/%.html: lib/Config/%.pm $(POD2HTML) doc/smokeping.html: bin/smokeping.dist $(POD2HTML) @@ -99,7 +99,7 @@ rename-man: $(MAN) mv $$i `echo $$i | sed s,$$j/,$$j/Smokeping::$$j::,`; \ done; \ done - mv doc/ISG/ParseConfig.3 doc/ISG/ISG::ParseConfig.3 + mv doc/Config/Grammar.3 doc/Config/Config::Grammar.3 mv doc/Smokeping/Examples.3 doc/Smokeping/Smokeping::Examples.3 mv doc/Smokeping/RRDtools.3 doc/Smokeping/Smokeping::RRDtools.3 @@ -128,7 +128,7 @@ patch: perl -i~ -p -e 's/Smokeping \d.*?;/Smokeping $(NUMVERSION);/' bin/smokeping.dist htdocs/smokeping.cgi.dist killdoc: - -rm doc/*.[1357] doc/*.txt doc/*.html doc/Smokeping/* doc/Smokeping/probes/* doc/Smokeping/matchers/* doc/ISG/* doc/examples/* doc/smokeping_examples.pod doc/smokeping_config.pod doc/smokeping.pod doc/smokeping.cgi.pod + -rm doc/*.[1357] doc/*.txt doc/*.html doc/Smokeping/* doc/Smokeping/probes/* doc/Smokeping/matchers/* doc/Config/* doc/examples/* doc/smokeping_examples.pod doc/smokeping_config.pod doc/smokeping.pod doc/smokeping.cgi.pod doc: killdoc ref examples man html txt rename-man diff --git a/doc/smokeping_extend.pod b/doc/smokeping_extend.pod index 402efac..0a0eb41 100644 --- a/doc/smokeping_extend.pod +++ b/doc/smokeping_extend.pod @@ -94,13 +94,13 @@ convenience method called C<_makevars> that does this, and the common idiom is } The variables are declared in a syntax that comes from the module used -for parsing the configuration file, C. Each variable +for parsing the configuration file, C. Each variable should be a hash that uses the "special variable keys" documented in -L. See C and the other +L. See C and the other probes for examples. For reference, here are the keys the hash should have. Much of this -is taken straight from the C manual. +is taken straight from the C manual. =over @@ -150,11 +150,11 @@ the returned string as content. The C and C methods should return hash references that contain the variable names as keys and the hashes described above -as values. In addition the C special section key +as values. In addition the C special section key C<_mandatory> is supported and should contain a reference to a list of mandatory variables. The C<_makevars> method is available of this special key and merges the mandatory lists in its arguments. Note that no other -C special section keys are supported. +C special section keys are supported. =head1 INITIALIZATION diff --git a/lib/Config/Grammar.pm b/lib/Config/Grammar.pm new file mode 100644 index 0000000..ede1a48 --- /dev/null +++ b/lib/Config/Grammar.pm @@ -0,0 +1,1502 @@ +package Config::Grammar; + +# TODO: +# - _order for sections + +use strict; + +use vars qw($VERSION); +$VERSION = '1.01'; + +sub new($$) +{ + my $proto = shift; + my $grammar = shift; + my $class = ref($proto) || $proto; + + my $self = {grammar => $grammar}; + bless($self, $class); + return $self; +} + +sub err($) +{ + my $self = shift; + return $self->{'err'}; +} + +sub _make_error($$) +{ + my $self = shift; + my $text = shift; + $self->{'err'} = "$self->{file}, line $self->{line}: $text"; +} + +sub _peek($) +{ + my $a = shift; + return $a->[$#$a]; +} + +sub _quotesplit($) +{ + my $line = shift; + my @items; + while ($line ne "") { + if ($line =~ s/^"((?:\\.|[^"])*)"\s*//) { + my $frag = $1; + $frag =~ s/\\(.)/$1/g; + push @items, $frag; + } elsif ($line =~ s/^'((?:\\.|[^'])*)'\s*//) { + my $frag = $1; + $frag =~ s/\\(.)/$1/g; + push @items, $frag; + } + elsif ($line =~ s/^((?:\\.|[^\s])*)(?:\s+|$)//) { + my $frag = $1; + $frag =~ s/\\(.)/$1/g; + push @items, $frag; + } + else { + die "Internal parser error for '$line'\n"; + } + } + return @items; +} + +sub _deepcopy { + # this handles circular references on consecutive levels, + # but breaks if there are any levels in between + # the makepod() and maketmpl() methods have the same limitation + my $what = shift; + return $what unless ref $what; + for (ref $what) { + /^ARRAY$/ and return [ map { $_ eq $what ? $_ : _deepcopy($_) } @$what ]; + /^HASH$/ and return { map { $_ => $what->{$_} eq $what ? + $what->{$_} : _deepcopy($what->{$_}) } keys %$what }; + /^CODE$/ and return $what; # we don't need to copy the subs + /^Regexp$/ and return $what; # neither Regexp objects + } + die "Cannot _deepcopy reference type @{[ref $what]}"; +} + +sub _check_mandatory($$$$) +{ + my $self = shift; + my $g = shift; + my $c = shift; + my $section = shift; + + # check _mandatory sections, variables and tables + if (defined $g->{_mandatory}) { + for (@{$g->{_mandatory}}) { + if (not defined $g->{$_}) { + $g->{$_} = {}; + +#$self->{'err'} = "ParseConfig internal error: mandatory name $_ not found in grammar"; + #return 0; + } + if (not defined $c->{$_}) { + if (defined $section) { + $self->{'err'} .= "$self->{file} ($section): "; + } + else { + $self->{'err'} = "$self->{file}: "; + } + + if (defined $g->{$_}{_is_section}) { + $self->{'err'} .= "mandatory (sub)section '$_' not defined"; + } + elsif ($_ eq '_table') { + $self->{'err'} .= "mandatory table not defined"; + } + else { + $self->{'err'} .= "mandatory variable '$_' not defined"; + } + return 0; + } + } + } + + for (keys %$c) { + + # do some cleanup + ref $c->{$_} eq 'HASH' or next; + defined $c->{$_}{_is_section} or next; + $self->_check_mandatory($g->{$c->{$_}{_grammar}}, $c->{$_}, + defined $section ? "$section/$_" : "$_") or return 0; + delete $c->{$_}{_is_section}; + delete $c->{$_}{_grammar}; + delete $c->{$_}{_order_count} if exists $c->{$_}{_order_count}; + } + + return 1; +} + +######### SECTIONS ######### + +# search grammar definition of a section +sub _search_section($$) +{ + my $self = shift; + my $name = shift; + + if (not defined $self->{grammar}{_sections}) { + $self->_make_error("no sections are allowed"); + return undef; + } + + # search exact match + for (@{$self->{grammar}{_sections}}) { + if ($name eq $_) { + return $_; + } + } + + # search regular expression + for (@{$self->{grammar}{_sections}}) { + if (m|^/(.*)/$|) { + if ($name =~ /^$1$/) { + return $_; + } + } + } + + # no match + $self->_make_error("unknown section '$name'"); + return undef; +} + +# fill in default values for this section +sub _fill_defaults ($) { + my $self = shift; + my $g = $self->{grammar}; + my $c = $self->{cfg}; + if ($g->{_vars}) { + for my $var (@{$g->{_vars}}) { + next if exists $c->{$var}; + my $value = $g->{$var}{_default} + if exists $g->{$var}{_default}; + next unless defined $value; + $c->{$var} = $value; + } + } + +} + +sub _next_level($$$) +{ + my $self = shift; + my $name = shift; + + # section name + if (defined $self->{section}) { + $self->{section} .= "/$name"; + } + else { + $self->{section} = $name; + } + + # grammar context + 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)"); + return 0; + } + push @{$self->{grammar_stack}}, $self->{grammar}; + if ($s =~ m|^/(.*)/$|) { + # for sections specified by a regexp, we create + # a new branch with a deep copy of the section + # grammar so that any _dyn sub further below will edit + # just this branch + + $self->{grammar}{$name} = _deepcopy($self->{grammar}{$s}); + + # put it at the head of the section list + $self->{grammar}{_sections} ||= []; + unshift @{$self->{grammar}{_sections}}, $name; + } + + # support for recursive sections + # copy the section syntax to the subsection + + if ($self->{grammar}{_recursive} + and grep { $_ eq $s } @{$self->{grammar}{_recursive}}) { + $self->{grammar}{$name}{_sections} ||= []; + $self->{grammar}{$name}{_recursive} ||= []; + push @{$self->{grammar}{$name}{_sections}}, $s; + push @{$self->{grammar}{$name}{_recursive}}, $s; + my $grammarcopy = _deepcopy($self->{grammar}{$name}); + if (exists $self->{grammar}{$name}{$s}) { + # there's syntax for a variable by the same name too + # make sure we don't lose it + %{$self->{grammar}{$name}{$s}} = ( %$grammarcopy, %{$self->{grammar}{$name}{$s}} ); + } else { + $self->{grammar}{$name}{$s} = $grammarcopy; + } + } + + # this uses the copy created above for regexp sections + # and the original for non-regexp sections (where $s == $name) + $self->{grammar} = $self->{grammar}{$name}; + + # support for inherited values + # note that we have to do this on the way down + # and keep track of which values were inherited + # so that we can propagate the values even further + # down if needed + my %inherited; + if ($self->{grammar}{_inherited}) { + for my $var (@{$self->{grammar}{_inherited}}) { + next unless exists $self->{cfg}{$var}; + my $value = $self->{cfg}{$var}; + next unless defined $value; + next if ref $value; # it's a section + $inherited{$var} = $value; + } + } + + # config context + my $order; + if (defined $self->{grammar}{_order}) { + if (defined $self->{cfg}{_order_count}) { + $order = ++$self->{cfg}{_order_count}; + } + else { + $order = $self->{cfg}{_order_count} = 0; + } + } + + if (defined $self->{cfg}{$name}) { + $self->_make_error('section or variable already exists'); + return 0; + } + $self->{cfg}{$name} = { %inherited }; # inherit the values + push @{$self->{cfg_stack}}, $self->{cfg}; + $self->{cfg} = $self->{cfg}{$name}; + + # keep track of the inherited values here; + # we delete it on the way up in _prev_level() + $self->{cfg}{_inherited} = \%inherited; + + # list of already defined variables on this level + if (defined $self->{grammar}{_varlist}) { + $self->{cfg}{_varlist} = []; + } + + # meta data for _mandatory test + $self->{grammar}{_is_section} = 1; + $self->{cfg}{_is_section} = 1; + + # this uses the copy created above for regexp sections + # and the original for non-regexp sections (where $s == $name) + $self->{cfg}{_grammar} = $name; + + $self->{cfg}{_order} = $order if defined $order; + + # increase level + $self->{level}++; + + # if there's a _dyn sub, apply it + if (defined $self->{grammar}{_dyn}) { + &{$self->{grammar}{_dyn}}($s, $name, $self->{grammar}); + } + + return 1; +} + +sub _prev_level($) +{ + my $self = shift; + + # fill in the values from _default keywords when going up + $self->_fill_defaults; + + # section name + if (defined $self->{section}) { + if ($self->{section} =~ /\//) { + $self->{section} =~ s/\/.*?$//; + } + else { + $self->{section} = undef; + } + } + + # clean up the _inherited hash, we won't need it anymore + delete $self->{cfg}{_inherited}; + + # config context + $self->{cfg} = pop @{$self->{cfg_stack}}; + + # grammar context + $self->{grammar} = pop @{$self->{grammar_stack}}; + + # decrease level + $self->{level}--; +} + +sub _goto_level($$$) +{ + my $self = shift; + my $level = shift; + my $name = shift; + + # _text is multi-line. Check when changing level + $self->_check_text($self->{section}) or return 0; + + if ($level > $self->{level}) { + if ($level > $self->{level} + 1) { + $self->_make_error("section nesting error"); + return 0; + } + $self->_next_level($name) or return 0; + } + else { + + while ($self->{level} > $level) { + $self->_prev_level; + } + if ($level != 0) { + $self->_prev_level; + $self->_next_level($name) or return 0; + } + } + + return 1; +} + +######### VARIABLES ######### + +# search grammar definition of a variable +sub _search_variable($$) +{ + my $self = shift; + my $name = shift; + + if (not defined $self->{grammar}{_vars}) { + $self->_make_error("no variables are allowed"); + return undef; + } + + # search exact match + for (@{$self->{grammar}{_vars}}) { + if ($name eq $_) { + return $_; + } + } + + # search regular expression + for (@{$self->{grammar}{_vars}}) { + if (m|^/(.*)/$|) { + if ($name =~ /^$1$/) { + return $_; + } + } + } + + # no match + $self->_make_error("unknown variable '$name'"); + return undef; +} + +sub _set_variable($$$) +{ + my $self = shift; + my $key = shift; + my $value = shift; + + my $gn = $self->_search_variable($key); + defined $gn or return 0; + + my $varlistref; + if (defined $self->{grammar}{_varlist}) { + $varlistref = $self->{cfg}{_varlist}; + } + + if (defined $self->{grammar}{$gn}) { + my $g = $self->{grammar}{$gn}; + + # check regular expression + if (defined $g->{_re}) { + $value =~ /^$g->{_re}$/ or do { + if (defined $g->{_re_error}) { + $self->_make_error($g->{_re_error}); + } + else { + $self->_make_error("syntax error in value of '$key'"); + } + return 0; + } + } + if (defined $g->{_sub}){ + my $error = &{$g->{_sub}}($value, $varlistref); + if (defined $error){ + $self->_make_error($error); + return 0; + } + } + # if there's a _dyn sub, apply it + if (defined $g->{_dyn}) { + &{$g->{_dyn}}($key, $value, $self->{grammar}); + } + } + $self->{cfg}{$key} = $value; + push @{$varlistref}, $key if ref $varlistref; + + return 1; +} + +######### PARSER ######### + +sub _parse_table($$) +{ + my $self = shift; + local $_ = shift; + + my $g = $self->{grammar}{_table}; + defined $g or do { + $self->_make_error("table syntax error"); + return 0; + }; + + my @l = _quotesplit $_; + + # check number of columns + my $columns = $g->{_columns}; + if (defined $columns and $#l + 1 != $columns) { + $self->_make_error("row must have $columns columns (has " . ($#l + 1) + . ")"); + return 0; + } + + # check columns + my $n = 0; + for my $c (@l) { + my $gc = $g->{$n}; + defined $gc or next; + + # regular expression + if (defined $gc->{_re}) { + $c =~ /^$gc->{_re}$/ or do { + if (defined $gc->{_re_error}) { + $self->_make_error($gc->{_re_error}); + } + else { + $self->_make_error("syntax error in column $n"); + } + return 0; + }; + } + if (defined $gc->{_sub}){ + my $error = &{$gc->{_sub}}($c); + if (defined $error) { + $self->_make_error($error); + return 0; + } + } + $n++; + } + + # hash (keyed table) + if (defined $g->{_key}) { + my $kn = $g->{_key}; + if ($kn < 0 or $kn > $#l) { + $self->_make_error("grammar error: key out of bounds"); + } + my $k = $l[$kn]; + + if (defined $self->{cfg}{$k}) { + $self->_make_error("table row $k already defined"); + return 0; + } + $self->{cfg}{$k} = \@l; + } + + # list (unkeyed table) + else { + push @{$self->{cfg}{_table}}, \@l; + } + + return 1; +} + +sub _parse_text($$) +{ + my ($self, $line) = @_; + + $self->{cfg}{_text} .= $line; + + return 1; +} + +sub _check_text($$) +{ + my ($self, $name) = @_; + + my $g = $self->{grammar}{_text}; + defined $g or return 1; + + # chop empty lines at beginning and end + if(defined $self->{cfg}{_text}) { + $self->{cfg}{_text} =~ s/\A([ \t]*[\n\r]+)*//m; + $self->{cfg}{_text} =~ s/^([ \t]*[\n\r]+)*\Z//m; + } + + # TODO: not good for META. Use _mandatory ? + #defined $self->{cfg}{_text} or do { + # $self->_make_error("value of '$name' not defined"); + # return 0; + #}; + + if (defined $g->{_re}) { + $self->{cfg}{_text} =~ /^$g->{_re}$/ or do { + if (defined $g->{_re_error}) { + $self->_make_error($g->{_re_error}); + } + else { + $self->_make_error("syntax error"); + } + return 0; + } + } + if (defined $g->{_sub}){ + my $error = &{$g->{_sub}}($self->{cfg}{_text}); + if (defined $error) { + $self->_make_error($error); + return 0; + } + } + return 1; +} + +sub _parse_file($$); + +sub _parse_line($$$) +{ + my $self = shift; + local $_ = shift; + my $source = shift; + + /^\@include\s+["']?(.*)["']?$/ and do { + push @{$self->{file_stack}}, $self->{file}; + push @{$self->{line_stack}}, $self->{line}; + $self->_parse_file($1) or return 0; + $self->{file} = pop @{$self->{file_stack}}; + $self->{line} = pop @{$self->{line_stack}}; + return 1; + }; + /^\@define\s+(\S+)\s+(.*)$/ and do { + $self->{defines}{$1}=quotemeta $2; + return 1; + }; + + if(defined $self->{defines}) { + for my $d (keys %{$self->{defines}}) { + s/$d/$self->{defines}{$d}/g; + } + } + + /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do { + my $name = $1; + $self->_goto_level(1, $name) or return 0; + $self->_check_section_sub($name) or return 0; + return 1; + }; + /^(\++)\s*(.*)$/ and do { + my $level = length $1; + my $name = $2; + $self->_goto_level($level + 1, $name) or return 0; + $self->_check_section_sub($name) or return 0; + return 1; + }; + + if (defined $self->{grammar}{_text}) { + $self->_parse_text($source) or return 0; + return 1; + } + /^(\S+)\s*=\s*(.*)$/ and do { + if (defined $self->{cfg}{$1}) { + if (exists $self->{cfg}{_inherited}{$1}) { + # it's OK to override any inherited values + delete $self->{cfg}{_inherited}{$1}; + delete $self->{cfg}{$1}; + } else { + $self->_make_error('variable already defined'); + return 0; + } + } + $self->_set_variable($1, $2) or return 0; + return 1; + }; + + $self->_parse_table($_) or return 0; + + return 1; +} + +sub _check_section_sub($$) { + my $self = shift; + my $name = shift; + my $g = $self->{grammar}; + if (defined $g->{_sub}){ + my $error = &{$g->{_sub}}($name); + if (defined $error){ + $self->_make_error($error); + return 0; + } + } + return 1; +} + +sub _parse_file($$) +{ + my $self = shift; + my $file = shift; + + local *File; + unless ($file) { $self->{'err'} = "no filename given" ; + return undef;}; + + open(File, "$file") or do { + $self->{'err'} = "can't open $file: $!"; + return undef; + }; + $self->{file} = $file; + + local $_; + my $source = ''; + while () { + $source .= $_; + chomp; + s/^\s+//; + s/\s+$//; # trim + s/\s*#.*$//; # comments + next if $_ eq ''; # empty lines + while (/\\$/) {# continuation + s/\\$//; + my $n = ; + last if not defined $n; + chomp $n; + $n =~ s/^\s+//; + $n =~ s/\s+$//; # trim + $_ .= ' ' . $n; + } + + $self->{line} = $.; + $self->_parse_line($_, $source) or do{ close File; return 0; }; + $source = ''; + } + close File; + return 1; +} + +# find variables in old grammar list 'listname' +# that aren't in the corresponding list in the new grammar +# and list them as a POD document, possibly with a callback +# function 'docfunc' + +sub _findmissing($$$;$) { + my $old = shift; + my $new = shift; + my $listname = shift; + my $docfunc = shift; + + my @doc; + if ($old->{$listname}) { + my %newlist; + if ($new->{$listname}) { + @newlist{@{$new->{$listname}}} = undef; + } + for my $v (@{$old->{$listname}}) { + next if exists $newlist{$v}; + if ($docfunc) { + push @doc, &$docfunc($old, $v) + } else { + push @doc, "=item $v"; + } + } + } + return @doc; +} + +# find variables in new grammar list 'listname' +# that aren't in the corresponding list in the new grammar +# +# this is just _findmissing with the arguments swapped + +sub _findnew($$$;$) { + my $old = shift; + my $new = shift; + my $listname = shift; + my $docfunc = shift; + return _findmissing($new, $old, $listname, $docfunc); +} + +# compare two lists for element equality + +sub _listseq($$); +sub _listseq($$) { + my ($k, $l) = @_; + my $length = @$k; + return 0 unless @$l == $length; + for (my $i=0; $i<$length; $i++) { + return 0 unless $k->[$i] eq $l->[$i]; + } + return 1; +} + +# diff two grammar trees, documenting the differences + +sub _diffgrammars($$); +sub _diffgrammars($$) { + my $old = shift; + my $new = shift; + my @doc; + + my @vdoc; + @vdoc = _findmissing($old, $new, '_vars'); + push @doc, "The following variables are not valid anymore:", "=over" , @vdoc, "=back" + if @vdoc; + @vdoc = _findnew($old, $new, '_vars', \&_describevar); + push @doc, "The following new variables are valid:", "=over" , @vdoc, "=back" + if @vdoc; + @vdoc = _findmissing($old, $new, '_sections'); + push @doc, "The following subsections are not valid anymore:", "=over" , @vdoc, "=back" + if @vdoc; + @vdoc = _findnew($old, $new, '_sections', sub { + my ($tree, $sec) = @_; + my @tdoc; + _genpod($tree->{$sec}, 0, \@tdoc); + return @tdoc; + }); + push @doc, "The following new subsections are defined:", "=over" , @vdoc, "=back" + if @vdoc; + for (@{$old->{_sections}}) { + next unless exists $new->{$_}; + @vdoc = _diffgrammars($old->{$_}, $new->{$_}); + push @doc, "Syntax changes for subsection B<$_>", "=over", @vdoc, "=back" + if @vdoc; + } + return @doc; +} + +# describe a variable + +sub _describevar { + my $tree = shift; + my $var = shift; + my $mandatory = ( $tree->{_mandatory} and + grep {$_ eq $var} @{$tree->{_mandatory}} ) ? + " I<(mandatory setting)>" : ""; + my @doc; + push @doc, "=item B<$var>".$mandatory; + push @doc, $tree->{$var}{_doc} if $tree->{$var}{_doc} ; + my $inherited = ( $tree->{_inherited} and + grep {$_ eq $var} @{$tree->{_inherited}}); + push @doc, "This variable I its value from the parent section if nothing is specified here." + if $inherited; + push @doc, "This variable I modifies the grammar based on its value." + if $tree->{$var}{_dyn}; + push @doc, "Default value: $var = $tree->{$var}{_default}" + if ($tree->{$var}{_default}); + push @doc, "Example: $var = $tree->{$var}{_example}" + if ($tree->{$var}{_example}); + return @doc; +} + +sub _genpod($$$); +sub _genpod($$$){ + my $tree = shift; + my $level = shift; + my $doc = shift; + my %dyndoc; + if ($tree->{_vars}){ + push @{$doc}, "The following variables can be set in this section:"; + push @{$doc}, "=over"; + foreach my $var (@{$tree->{_vars}}){ + push @{$doc}, _describevar($tree, $var); + } + push @{$doc}, "=back"; + } + + if ($tree->{_text}){ + push @{$doc}, ($tree->{_text}{_doc} or "Unspecified Text content"); + if ($tree->{_text}{_example}){ + my $ex = $tree->{_text}{_example}; + chomp $ex; + $ex = map {" $_"} split /\n/, $ex; + push @{$doc}, "Example:\n\n$ex\n"; + } + } + + if ($tree->{_table}){ + push @{$doc}, ($tree->{_table}{_doc} or + "This section can contain a table ". + "with the following structure:" ); + push @{$doc}, "=over"; + for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ + push @{$doc}, "=item column $i"; + push @{$doc}, ($tree->{_table}{$i}{_doc} or + "Unspecific Content"); + push @{$doc}, "Example: $tree->{_table}{$i}{_example}" + if ($tree->{_table}{$i}{_example}) + } + push @{$doc}, "=back"; + } + if ($tree->{_sections}){ + if ($level > 0) { + push @{$doc}, "The following sections are valid on level $level:"; + push @{$doc}, "=over"; + } + foreach my $section (@{$tree->{_sections}}){ + my $mandatory = ( $tree->{_mandatory} and + grep {$_ eq $section} @{$tree->{_mandatory}} ) ? + " I<(mandatory section)>" : ""; + push @{$doc}, ($level > 0) ? + "=item B<".("+" x $level)."$section>$mandatory" : + "=head2 *** $section ***$mandatory"; + if ($tree eq $tree->{$section}) { + push @{$doc}, "This subsection has the same syntax as its parent."; + next; + } + push @{$doc}, ($tree->{$section}{_doc}) + if $tree->{$section}{_doc}; + push @{$doc}, "The grammar of this section is I modified based on its name." + if $tree->{$section}{_dyn}; + if ($tree->{_recursive} and + grep {$_ eq $section} @{$tree->{_recursive}}) { + push @{$doc}, "This section is I: it can contain subsection(s) with the same syntax."; + } + _genpod ($tree->{$section},$level+1,$doc); + next unless $tree->{$section}{_dyn} and $tree->{$section}{_dyndoc}; + push @{$doc}, "Dynamical grammar changes for example instances of this section:"; + push @{$doc}, "=over"; + for my $name (sort keys %{$tree->{$section}{_dyndoc}}) { + my $newtree = _deepcopy($tree->{$section}); + push @{$doc}, "=item B<$name>: $tree->{$section}{_dyndoc}{$name}"; + &{$tree->{$section}{_dyn}}($section, $name, $newtree); + my @tdoc = _diffgrammars($tree->{$section}, $newtree); + if (@tdoc) { + push @{$doc}, @tdoc; + } else { + push @{$doc}, "No changes that can be automatically described."; + } + push @{$doc}, "(End of dynamical grammar changes for example instance C<$name>.)"; + } + push @{$doc}, "=back"; + push @{$doc}, "(End of dynamical grammar changes for example instances of section C<$section>.)"; + } + push @{$doc}, "=back" if $level > 0 + } + if ($tree->{_vars}) { + for my $var (@{$tree->{_vars}}) { + next unless $tree->{$var}{_dyn} and $tree->{$var}{_dyndoc}; + push @{$doc}, "Dynamical grammar changes for example values of variable C<$var>:"; + push @{$doc}, "=over"; + for my $val (sort keys %{$tree->{$var}{_dyndoc}}) { + my $newtree = _deepcopy($tree); + push @{$doc}, "=item B<$val>: $tree->{$var}{_dyndoc}{$val}"; + &{$tree->{$var}{_dyn}}($var, $val, $newtree); + my @tdoc = _diffgrammars($tree, $newtree); + if (@tdoc) { + push @{$doc}, @tdoc; + } else { + push @{$doc}, "No changes that can be automatically described."; + } + push @{$doc}, "(End of dynamical grammar changes for variable C<$var> example value C<$val>.)"; + } + push @{$doc}, "=back"; + push @{$doc}, "(End of dynamical grammar changes for example values of variable C<$var>.)"; + } + } +}; + +sub makepod($) { + my $self = shift; + my $tree = $self->{grammar}; + my @doc; + _genpod $tree,0,\@doc; + return join("\n\n", @doc)."\n"; +} + +sub _gentmpl($$$@); +sub _gentmpl($$$@){ + my $tree = shift; + my $level = shift; + my $doc = shift; + my @start = @_; + if (scalar @start ) { + my $section = shift @start; + my $secex =''; + my $prefix = ''; + $prefix = "# " unless $tree->{_mandatory} and + grep {$_ eq $section} @{$tree->{_mandatory}}; + if ($tree->{$section}{_example}) { + $secex = " # ( ex. $tree->{$section}{_example} )"; + } + push @{$doc}, $prefix. + (($level > 0) ? ("+" x $level)."$section" : "*** $section ***").$secex; + my $match; + foreach my $s (@{$tree->{_sections}}){ + if ($s =~ m|^/.+/$| and $section =~ /$s/ or $s eq $section) { + _gentmpl ($tree->{$s},$level+1,$doc,@start) + unless $tree eq $tree->{$s}; + $match = 1; + } + } + push @{$doc}, "# Section $section is not a valid choice" + unless $match; + } else { + if ($tree->{_vars}){ + foreach my $var (@{$tree->{_vars}}){ + push @{$doc}, "# $var = ". + ($tree->{$var}{_example} || ' * no example *'); + next unless $tree->{_mandatory} and + grep {$_ eq $var} @{$tree->{_mandatory}}; + push @{$doc}, "$var="; + } + } + + if ($tree->{_text}){ + if ($tree->{_text}{_example}){ + my $ex = $tree->{_text}{_example}; + chomp $ex; + $ex = map {"# $_"} split /\n/, $ex; + push @{$doc}, "$ex\n"; + } + } + if ($tree->{_table}){ + my $table = "# table\n#"; + for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ + $table .= ' "'.($tree->{_table}{$i}{_example} || "C$i").'"'; + } + push @{$doc}, $table; + } + if ($tree->{_sections}){ + foreach my $section (@{$tree->{_sections}}){ + my $opt = ( $tree->{_mandatory} and + grep {$_ eq $section} @{$tree->{_mandatory}} ) ? + "":"\n# optional section\n"; + my $prefix = ''; + $prefix = "# " unless $tree->{_mandatory} and + grep {$_ eq $section} @{$tree->{_mandatory}}; + my $secex =""; + if ($section =~ m|^/.+/$| && $tree->{$section}{_example}) { + $secex = " # ( ex. $tree->{$section}{_example} )"; + } + push @{$doc}, $prefix. + (($level > 0) ? ("+" x $level)."$section" : "*** $section ***"). + $secex; + _gentmpl ($tree->{$section},$level+1,$doc,@start) + unless $tree eq $tree->{$section}; + } + } + } +}; + +sub maketmpl ($@) { + my $self = shift; + my @start = @_; + my $tree = $self->{grammar}; + my @tmpl; + _gentmpl $tree,0,\@tmpl,@start; + return join("\n", @tmpl)."\n"; +} + +sub parse($$) +{ + my $self = shift; + my $file = shift; + + $self->{cfg} = {}; + $self->{level} = 0; + $self->{cfg_stack} = []; + $self->{grammar_stack} = []; + $self->{file_stack} = []; + $self->{line_stack} = []; + + # we work with a copy of the grammar so the _dyn subs may change it + local $self->{grammar} = _deepcopy($self->{grammar}); + + $self->_parse_file($file) or return undef; + + $self->_goto_level(0, undef) or return undef; + + # fill in the top level values from _default keywords + $self->_fill_defaults; + + $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef) + or return undef; + + return $self->{cfg}; + +} + +1 + +__END__ + +=head1 NAME + +Config::Grammar - A grammar-based, user-friendly config parser + +=head1 SYNOPSIS + + use Config::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 + +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. 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 method you can generate +documentation of the configuration file format. + +The B 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 +template data based in regular expressions. + +=head2 Grammar Definition + +The grammar is a multiple-level hash of hashes, which follows the structure of +the configuration. Each section or variable is represented by a hash with the +same structure. Each hash contains special keys starting with an underscore +such as '_sections', '_vars', '_sub' or '_re' to denote meta data with information +about that section or variable. Other keys are used to structure the hash +according to the same nesting structure of the configuration itself. The +starting hash given as parameter to 'new' contains the "root section". + +=head3 Special Section Keys + +=over 12 + +=item _sections + +Array containing the list of sub-sections of this section. Each sub-section +must then be represented by a sub-hash in this hash with the same name of the +sub-section. + +The sub-section can also be a regular expression denoted by the syntax '/re/', +where re is the regular-expression. In case a regular expression is used, a +sub-hash named with the same '/re/' must be included in this hash. + +=item _recursive + +Array containing the list of those sub-sections that are I, ie. +that can contain a new sub-section with the same syntax as themselves. + +The same effect can be accomplished with circular references in the +grammar tree or a suitable B<_dyn> section subroutine (see below}, +so this facility is included just for convenience. + +=item _vars + +Array containing the list of variables (assignments) in this section. +Analogous to sections, regular expressions can be used. + +=item _mandatory + +Array containing the list of mandatory sections and variables. + +=item _inherited + +Array containing the list of the variables that should be assigned the +same value as in the parent section if nothing is specified here. + +=item _table + +Hash containing the table grammar (see Special Table Keys). If not specified, +no table is allowed in this section. The grammar of the columns if specified +by sub-hashes named with the column number. + +=item _text + +Section contains free-form text. Only sections and @includes statements will +be interpreted, the rest will be added in the returned hash under '_text' as +string. + +B<_text> is a hash reference which can contain a B<_re> and a B<_re_error> key +which will be used to scrutanize the text ... if the hash is empty, all text +will be accepted. + +=item _order + +If defined, a '_order' element will be put in every hash containing the +sections with a number that determines the order in which the sections were +defined. + +=item _varlist + +If defined, a '_varlist' element will be put in the config hash of this +section with a list of the variables defined in the section. This can +be used to find out the order of the variable assignments. + +The '_sub' function (see below) of any variables defined in this section +will also receive a list of those variables already defined in the +same section. This can be used to enforce the order of the variables +during parsing. + +=item _doc + +Describes what this section is about + +=item _sub + +A function pointer. It is called for every instance of this section, +with the real name of the section passed as its first argument. This is +probably only useful for the regexp sections. If the function returns +a defined value it is assumed that the test was not successful and an +error is generated with the returned string as content. + +=item _dyn + +A subroutine reference (function pointer) that will be called when +a new section of this syntax is encountered. The subroutine will get +three arguments: the syntax of the section name (string or regexp), the +actual name encountered (this will be the same as the first argument for +non-regexp sections) and a reference to the grammar tree of the section. +This subroutine can then modify the grammar tree dynamically. + +=item _dyndoc + +A hash reference that lists interesting names for the section that +should be documented. The keys of the hash are the names and the +values in the hash are strings that can contain an explanation +for the name. The _dyn() subroutine is then called for each of +these names and the differences of the resulting grammar and +the original one are documented. This module can currently document +differences in the _vars list, listing new variables and removed +ones, and differences in the _sections list, listing the +new and removed sections. + +=back + +=head3 Special Variable Keys + +=over 12 + +=item _re + +Regular expression upon which the value will be checked. + +=item _re_error + +String containing the returned error in case the regular expression doesn't +match (if not specified, a generic 'syntax error' message will be returned). + +=item _sub + +A function pointer. It called for every value, with the value passed as its +first argument. If the function returns a defined value it is assumed that +the test was not successful and an error is generated with the returned +string as content. + +If the '_varlist' key (see above) is defined in this section, the '_sub' +function will also receive an array reference as the second argument. The +array contains a list of those variables already defined in the same +section. This can be used to enforce the order of the variables. + +=item _default + +A default value that will be assigned to the variable if none is specified or inherited. + +=item _doc + +Description of the variable. + +=item _example + +A one line example for the content of this variable. + +=item _dyn + +A subroutine reference (function pointer) that will be called when the +variable is assigned some value in the config file. The subroutine will +get three arguments: the name of the variable, the value assigned and +a reference to the grammar tree of this section. This subroutine can +then modify the grammar tree dynamically. + +Note that no _dyn() call is made for default and inherited values of +the variable. + +=item _dyndoc + +A hash reference that lists interesting values for the variable that +should be documented. The keys of the hash are the values and the +values in the hash are strings that can contain an explanation +for the value. The _dyn() subroutine is then called for each of +these values and the differences of the resulting grammar and +the original one are documented. This module can currently document +differences in the _vars list, listing new variables and removed +ones, and differences in the _sections list, listing the +new and removed sections. + +=back + +=head3 Special Table Keys + +=over 12 + +=item _columns + +Number of columns. If not specified, it will not be enforced. + +=item _key + +If defined, the specified column number will be used as key in a hash in the +returned hash. If not defined, the returned hash will contain a '_table' +element with the contents of the table as array. The rows of the tables are +stored as arrays. + +=item _sub + +they work analog to the description in the previous section. + +=item _doc + +describes the content of the column. + +=item _example + +example for the content of this column + +=back + +=head3 Special Text Keys + +=over 12 + +=item _re + +Regular expression upon which the text will be checked (everything as a single +line). + +=item _re_error + +String containing the returned error in case the regular expression doesn't +match (if not specified, a generic 'syntax error' message will be returned). + +=item _sub + +they work analog to the description in the previous section. + +=item _doc + +Ditto. + +=item _example + +Potential multi line example for the content of this text section + +=back + +=head2 Configuration Syntax + +=head3 General Syntax + +'#' 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. + +'@include filename' is used to include another file. + +'@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. + +=head3 Sections + +Config::Grammar supports hierarchical configurations through sections, whose +syntax is as follows: + +=over 15 + +=item Level 1 + +*** section name *** + +=item Level 2 + ++ section name + +=item Level 3 + +++ section name + +=item Level n, n>1 + ++..+ section name (number of '+' determines level) + +=back + +=head3 Assignments + +Assignements take the form: 'variable = value', where value can be any string +(can contain whitespaces and special characters). The spaces before and after +the equal sign are optional. + +=head3 Tabular Data + +The data is interpreted as one or more columns separated by spaces. + +=head2 Example + +=head3 Code + + my $parser = Config::Grammar->new({ + _sections => [ 'network', 'hosts' ], + network => { + _vars => [ 'dns' ], + _sections => [ "/$RE_IP/" ], + dns => { + _doc => "address of the dns server", + _example => "ns1.oetiker.xs", + _re => $RE_HOST, + _re_error => + 'dns must be an host name or ip address', + }, + "/$RE_IP/" => { + _doc => "Ip Adress", + _example => '10.2.3.2', + _vars => [ 'netmask', 'gateway' ], + netmask => { + _doc => "Netmask", + _example => "255.255.255.0", + _re => $RE_IP, + _re_error => + 'netmask must be a dotted ip address' + }, + gateway => { + _doc => "Default Gateway address in IP notation", + _example => "10.22.12.1", + _re => $RE_IP, + _re_error => + 'gateway must be a dotted ip address' }, + }, + }, + hosts => { + _doc => "Details about the hosts", + _table => { + _doc => "Description of all the Hosts", + _key => 0, + _columns => 3, + 0 => { + _doc => "Ethernet Address", + _example => "0:3:3:d:a:3:dd:a:cd", + _re => $RE_MAC, + _re_error => + 'first column must be an ethernet mac address', + }, + 1 => { + _doc => "IP Address", + _example => "10.11.23.1", + _re => $RE_IP, + _re_error => + 'second column must be a dotted ip address', + }, + 2 => { + _doc => "Host Name", + _example => "tardis", + }, + }, + }, + }); + + my $cfg = $parser->parse('test.cfg') or + die "ERROR: $parser->{err}\n"; + print Dumper($cfg); + print $praser->makepod; + +=head3 Configuration + + *** network *** + + dns = 129.132.7.87 + + + 129.132.7.64 + + netmask = 255.255.255.192 + gateway = 129.132.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 + +=head3 Result + + { + 'hosts' => { + '00:50:fe:bc:65:11' => [ + '00:50:fe:bc:65:11', + '129.132.7.97', + 'plain.hades' + ], + '00:50:fe:bc:65:12' => [ + '00:50:fe:bc:65:12', + '129.132.7.98', + 'isg.ee.hades' + ], + '00:50:fe:bc:65:14' => [ + '00:50:fe:bc:65:14', + '129.132.7.99', + 'isg.ee.hades' + ] + }, + 'network' => { + '129.132.7.64' => { + 'netmask' => '255.255.255.192', + 'gateway' => '129.132.7.65' + }, + 'dns' => '129.132.7.87' + } + }; + +=head1 COPYRIGHT + +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 same terms as Perl itself. + +=head1 AUTHOR + +David Schweikert Edws_at_ee.ethz.chE, +Tobias Oetiker Eoetiker_at_ee.ethz.chE, +Niko Tyni Entyni_at_iki.fiE + +=head1 HISTORY + + 2001-05-11 ds Initial Version of ISG::ParseConfig + 2005-03-08 ds 1.00 Renamed from ISG::ParseConfig to Config::Grammar + +=cut + +# Emacs Configuration +# +# Local Variables: +# mode: cperl +# eval: (cperl-set-style "PerlStyle") +# mode: flyspell +# mode: flyspell-prog +# End: +# +# vi: sw=4 diff --git a/lib/ISG/ParseConfig.pm b/lib/ISG/ParseConfig.pm deleted file mode 100644 index 824ea79..0000000 --- a/lib/ISG/ParseConfig.pm +++ /dev/null @@ -1,1523 +0,0 @@ -package ISG::ParseConfig; - -# TODO: -# - _order for sections - -use strict; - -use vars qw($VERSION); -$VERSION = 2.0; - -sub new($$) -{ - my $proto = shift; - my $grammar = shift; - my $class = ref($proto) || $proto; - - my $self = {grammar => $grammar}; - bless($self, $class); - return $self; -} - -sub err($) -{ - my $self = shift; - return $self->{'err'}; -} - -sub _make_error($$) -{ - my $self = shift; - my $text = shift; - $self->{'err'} = "$self->{file}, line $self->{line}: $text"; -} - -sub _peek($) -{ - my $a = shift; - return $a->[$#$a]; -} - -sub _quotesplit($) -{ - my $line = shift; - my @items; - while ($line ne "") { - if ($line =~ s/^"((?:\\.|[^"])*)"\s*//) { - my $frag = $1; - $frag =~ s/\\(.)/$1/g; - push @items, $frag; - } elsif ($line =~ s/^'((?:\\.|[^'])*)'\s*//) { - my $frag = $1; - $frag =~ s/\\(.)/$1/g; - push @items, $frag; - } - elsif ($line =~ s/^((?:\\.|[^\s])*)(?:\s+|$)//) { - my $frag = $1; - $frag =~ s/\\(.)/$1/g; - push @items, $frag; - } - else { - die "Internal parser error for '$line'\n"; - } - } - return @items; -} - -sub _deepcopy { - # this handles circular references on consecutive levels, - # but breaks if there are any levels in between - # the makepod() and maketmpl() methods have the same limitation - my $what = shift; - return $what unless ref $what; - for (ref $what) { - /^ARRAY$/ and return [ map { $_ eq $what ? $_ : _deepcopy($_) } @$what ]; - /^HASH$/ and return { map { $_ => $what->{$_} eq $what ? - $what->{$_} : _deepcopy($what->{$_}) } keys %$what }; - /^CODE$/ and return $what; # we don't need to copy the subs - /^Regexp$/ and return $what; # neither Regexp objects - } - die "Cannot _deepcopy reference type @{[ref $what]}"; -} - -sub _check_mandatory($$$$) -{ - my $self = shift; - my $g = shift; - my $c = shift; - my $section = shift; - - # check _mandatory sections, variables and tables - if (defined $g->{_mandatory}) { - for (@{$g->{_mandatory}}) { - if (not defined $g->{$_}) { - $g->{$_} = {}; - -#$self->{'err'} = "ParseConfig internal error: mandatory name $_ not found in grammar"; - #return 0; - } - if (not defined $c->{$_}) { - if (defined $section) { - $self->{'err'} .= "$self->{file} ($section): "; - } - else { - $self->{'err'} = "$self->{file}: "; - } - - if (defined $g->{$_}{_is_section}) { - $self->{'err'} .= "mandatory (sub)section '$_' not defined"; - } - elsif ($_ eq '_table') { - $self->{'err'} .= "mandatory table not defined"; - } - else { - $self->{'err'} .= "mandatory variable '$_' not defined"; - } - return 0; - } - } - } - - for (keys %$c) { - - # do some cleanup - ref $c->{$_} eq 'HASH' or next; - defined $c->{$_}{_is_section} or next; - $self->_check_mandatory($g->{$c->{$_}{_grammar}}, $c->{$_}, - defined $section ? "$section/$_" : "$_") or return 0; - delete $c->{$_}{_is_section}; - delete $c->{$_}{_grammar}; - delete $c->{$_}{_order_count} if exists $c->{$_}{_order_count}; - } - - return 1; -} - -######### SECTIONS ######### - -# search grammar definition of a section -sub _search_section($$) -{ - my $self = shift; - my $name = shift; - - if (not defined $self->{grammar}{_sections}) { - $self->_make_error("no sections are allowed"); - return undef; - } - - # search exact match - for (@{$self->{grammar}{_sections}}) { - if ($name eq $_) { - return $_; - } - } - - # search regular expression - for (@{$self->{grammar}{_sections}}) { - if (m|^/(.*)/$|) { - if ($name =~ /^$1$/) { - return $_; - } - } - } - - # no match - $self->_make_error("unknown section '$name'"); - return undef; -} - -# fill in default values for this section -sub _fill_defaults ($) { - my $self = shift; - my $g = $self->{grammar}; - my $c = $self->{cfg}; - if ($g->{_vars}) { - for my $var (@{$g->{_vars}}) { - next if exists $c->{$var}; - my $value = $g->{$var}{_default} - if exists $g->{$var}{_default}; - next unless defined $value; - $c->{$var} = $value; - } - } - -} - -sub _next_level($$$) -{ - my $self = shift; - my $name = shift; - - # section name - if (defined $self->{section}) { - $self->{section} .= "/$name"; - } - else { - $self->{section} = $name; - } - - # grammar context - 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)"); - return 0; - } - push @{$self->{grammar_stack}}, $self->{grammar}; - if ($s =~ m|^/(.*)/$|) { - # for sections specified by a regexp, we create - # a new branch with a deep copy of the section - # grammar so that any _dyn sub further below will edit - # just this branch - - $self->{grammar}{$name} = _deepcopy($self->{grammar}{$s}); - - # put it at the head of the section list - $self->{grammar}{_sections} ||= []; - unshift @{$self->{grammar}{_sections}}, $name; - } - - # support for recursive sections - # copy the section syntax to the subsection - - if ($self->{grammar}{_recursive} - and grep { $_ eq $s } @{$self->{grammar}{_recursive}}) { - $self->{grammar}{$name}{_sections} ||= []; - $self->{grammar}{$name}{_recursive} ||= []; - push @{$self->{grammar}{$name}{_sections}}, $s; - push @{$self->{grammar}{$name}{_recursive}}, $s; - my $grammarcopy = _deepcopy($self->{grammar}{$name}); - if (exists $self->{grammar}{$name}{$s}) { - # there's syntax for a variable by the same name too - # make sure we don't lose it - %{$self->{grammar}{$name}{$s}} = ( %$grammarcopy, %{$self->{grammar}{$name}{$s}} ); - } else { - $self->{grammar}{$name}{$s} = $grammarcopy; - } - } - - # this uses the copy created above for regexp sections - # and the original for non-regexp sections (where $s == $name) - $self->{grammar} = $self->{grammar}{$name}; - - # support for inherited values - # note that we have to do this on the way down - # and keep track of which values were inherited - # so that we can propagate the values even further - # down if needed - my %inherited; - if ($self->{grammar}{_inherited}) { - for my $var (@{$self->{grammar}{_inherited}}) { - next unless exists $self->{cfg}{$var}; - my $value = $self->{cfg}{$var}; - next unless defined $value; - next if ref $value; # it's a section - $inherited{$var} = $value; - } - } - - # config context - my $order; - if (defined $self->{grammar}{_order}) { - if (defined $self->{cfg}{_order_count}) { - $order = ++$self->{cfg}{_order_count}; - } - else { - $order = $self->{cfg}{_order_count} = 0; - } - } - - if (defined $self->{cfg}{$name}) { - $self->_make_error('section or variable already exists'); - return 0; - } - $self->{cfg}{$name} = { %inherited }; # inherit the values - push @{$self->{cfg_stack}}, $self->{cfg}; - $self->{cfg} = $self->{cfg}{$name}; - - # keep track of the inherited values here; - # we delete it on the way up in _prev_level() - $self->{cfg}{_inherited} = \%inherited; - - # list of already defined variables on this level - if (defined $self->{grammar}{_varlist}) { - $self->{cfg}{_varlist} = []; - } - - # meta data for _mandatory test - $self->{grammar}{_is_section} = 1; - $self->{cfg}{_is_section} = 1; - - # this uses the copy created above for regexp sections - # and the original for non-regexp sections (where $s == $name) - $self->{cfg}{_grammar} = $name; - - $self->{cfg}{_order} = $order if defined $order; - - # increase level - $self->{level}++; - - # if there's a _dyn sub, apply it - if (defined $self->{grammar}{_dyn}) { - &{$self->{grammar}{_dyn}}($s, $name, $self->{grammar}); - } - - return 1; -} - -sub _prev_level($) -{ - my $self = shift; - - # fill in the values from _default keywords when going up - $self->_fill_defaults; - - # section name - if (defined $self->{section}) { - if ($self->{section} =~ /\//) { - $self->{section} =~ s/\/.*?$//; - } - else { - $self->{section} = undef; - } - } - - # clean up the _inherited hash, we won't need it anymore - delete $self->{cfg}{_inherited}; - - # config context - $self->{cfg} = pop @{$self->{cfg_stack}}; - - # grammar context - $self->{grammar} = pop @{$self->{grammar_stack}}; - - # decrease level - $self->{level}--; -} - -sub _goto_level($$$) -{ - my $self = shift; - my $level = shift; - my $name = shift; - - # _text is multi-line. Check when changing level - $self->_check_text($self->{section}) or return 0; - - if ($level > $self->{level}) { - if ($level > $self->{level} + 1) { - $self->_make_error("section nesting error"); - return 0; - } - $self->_next_level($name) or return 0; - } - else { - - while ($self->{level} > $level) { - $self->_prev_level; - } - if ($level != 0) { - $self->_prev_level; - $self->_next_level($name) or return 0; - } - } - - return 1; -} - -######### VARIABLES ######### - -# search grammar definition of a variable -sub _search_variable($$) -{ - my $self = shift; - my $name = shift; - - if (not defined $self->{grammar}{_vars}) { - $self->_make_error("no variables are allowed"); - return undef; - } - - # search exact match - for (@{$self->{grammar}{_vars}}) { - if ($name eq $_) { - return $_; - } - } - - # search regular expression - for (@{$self->{grammar}{_vars}}) { - if (m|^/(.*)/$|) { - if ($name =~ /^$1$/) { - return $_; - } - } - } - - # no match - $self->_make_error("unknown variable '$name'"); - return undef; -} - -sub _set_variable($$$) -{ - my $self = shift; - my $key = shift; - my $value = shift; - - my $gn = $self->_search_variable($key); - defined $gn or return 0; - - my $varlistref; - if (defined $self->{grammar}{_varlist}) { - $varlistref = $self->{cfg}{_varlist}; - } - - if (defined $self->{grammar}{$gn}) { - my $g = $self->{grammar}{$gn}; - - # check regular expression - if (defined $g->{_re}) { - $value =~ /^$g->{_re}$/ or do { - if (defined $g->{_re_error}) { - $self->_make_error($g->{_re_error}); - } - else { - $self->_make_error("syntax error in value of '$key'"); - } - return 0; - } - } - if (defined $g->{_sub}){ - my $error = &{$g->{_sub}}($value, $varlistref); - if (defined $error){ - $self->_make_error($error); - return 0; - } - } - # if there's a _dyn sub, apply it - if (defined $g->{_dyn}) { - &{$g->{_dyn}}($key, $value, $self->{grammar}); - } - } - $self->{cfg}{$key} = $value; - push @{$varlistref}, $key if ref $varlistref; - - return 1; -} - -######### PARSER ######### - -sub _parse_table($$) -{ - my $self = shift; - local $_ = shift; - - my $g = $self->{grammar}{_table}; - defined $g or do { - $self->_make_error("table syntax error"); - return 0; - }; - - my @l = _quotesplit $_; - - # check number of columns - my $columns = $g->{_columns}; - if (defined $columns and $#l + 1 != $columns) { - $self->_make_error("row must have $columns columns (has " . ($#l + 1) - . ")"); - return 0; - } - - # check columns - my $n = 0; - for my $c (@l) { - my $gc = $g->{$n}; - defined $gc or next; - - # regular expression - if (defined $gc->{_re}) { - $c =~ /^$gc->{_re}$/ or do { - if (defined $gc->{_re_error}) { - $self->_make_error($gc->{_re_error}); - } - else { - $self->_make_error("syntax error in column $n"); - } - return 0; - }; - } - if (defined $gc->{_sub}){ - my $error = &{$gc->{_sub}}($c); - if (defined $error) { - $self->_make_error($error); - return 0; - } - } - $n++; - } - - # hash (keyed table) - if (defined $g->{_key}) { - my $kn = $g->{_key}; - if ($kn < 0 or $kn > $#l) { - $self->_make_error("grammar error: key out of bounds"); - } - my $k = $l[$kn]; - - if (defined $self->{cfg}{$k}) { - $self->_make_error("table row $k already defined"); - return 0; - } - $self->{cfg}{$k} = \@l; - } - - # list (unkeyed table) - else { - push @{$self->{cfg}{_table}}, \@l; - } - - return 1; -} - -sub _parse_text($$) -{ - my ($self, $line) = @_; - - $self->{cfg}{_text} .= $line; - - return 1; -} - -sub _check_text($$) -{ - my ($self, $name) = @_; - - my $g = $self->{grammar}{_text}; - defined $g or return 1; - - # chop empty lines at beginning and end - if(defined $self->{cfg}{_text}) { - $self->{cfg}{_text} =~ s/\A([ \t]*[\n\r]+)*//m; - $self->{cfg}{_text} =~ s/^([ \t]*[\n\r]+)*\Z//m; - } - - # TODO: not good for META. Use _mandatory ? - #defined $self->{cfg}{_text} or do { - # $self->_make_error("value of '$name' not defined"); - # return 0; - #}; - - if (defined $g->{_re}) { - $self->{cfg}{_text} =~ /^$g->{_re}$/ or do { - if (defined $g->{_re_error}) { - $self->_make_error($g->{_re_error}); - } - else { - $self->_make_error("syntax error"); - } - return 0; - } - } - if (defined $g->{_sub}){ - my $error = &{$g->{_sub}}($self->{cfg}{_text}); - if (defined $error) { - $self->_make_error($error); - return 0; - } - } - return 1; -} - -sub _parse_file($$); - -sub _parse_line($$$) -{ - my $self = shift; - local $_ = shift; - my $source = shift; - - /^\@include\s+["']?(.*)["']?$/ and do { - push @{$self->{file_stack}}, $self->{file}; - push @{$self->{line_stack}}, $self->{line}; - $self->_parse_file($1) or return 0; - $self->{file} = pop @{$self->{file_stack}}; - $self->{line} = pop @{$self->{line_stack}}; - return 1; - }; - /^\@define\s+(\S+)\s+(.*)$/ and do { - $self->{defines}{$1}=quotemeta $2; - return 1; - }; - - if(defined $self->{defines}) { - for my $d (keys %{$self->{defines}}) { - s/$d/$self->{defines}{$d}/g; - } - } - - /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do { - my $name = $1; - $self->_goto_level(1, $name) or return 0; - $self->_check_section_sub($name) or return 0; - return 1; - }; - /^(\++)\s*(.*)$/ and do { - my $level = length $1; - my $name = $2; - $self->_goto_level($level + 1, $name) or return 0; - $self->_check_section_sub($name) or return 0; - return 1; - }; - - if (defined $self->{grammar}{_text}) { - $self->_parse_text($source) or return 0; - return 1; - } - /^(\S+)\s*=\s*(.*)$/ and do { - if (defined $self->{cfg}{$1}) { - if (exists $self->{cfg}{_inherited}{$1}) { - # it's OK to override any inherited values - delete $self->{cfg}{_inherited}{$1}; - delete $self->{cfg}{$1}; - } else { - $self->_make_error('variable already defined'); - return 0; - } - } - $self->_set_variable($1, $2) or return 0; - return 1; - }; - - $self->_parse_table($_) or return 0; - - return 1; -} - -sub _check_section_sub($$) { - my $self = shift; - my $name = shift; - my $g = $self->{grammar}; - if (defined $g->{_sub}){ - my $error = &{$g->{_sub}}($name); - if (defined $error){ - $self->_make_error($error); - return 0; - } - } - return 1; -} - -sub _parse_file($$) -{ - my $self = shift; - my $file = shift; - - local *File; - unless ($file) { $self->{'err'} = "no filename given" ; - return undef;}; - - open(File, "$file") or do { - $self->{'err'} = "can't open $file: $!"; - return undef; - }; - $self->{file} = $file; - - local $_; - my $source = ''; - while () { - $source .= $_; - chomp; - s/^\s+//; - s/\s+$//; # trim - s/\s*#.*$//; # comments - next if $_ eq ''; # empty lines - while (/\\$/) {# continuation - s/\\$//; - my $n = ; - last if not defined $n; - chomp $n; - $n =~ s/^\s+//; - $n =~ s/\s+$//; # trim - $_ .= ' ' . $n; - } - - $self->{line} = $.; - $self->_parse_line($_, $source) or do{ close File; return 0; }; - $source = ''; - } - close File; - return 1; -} - -# find variables in old grammar list 'listname' -# that aren't in the corresponding list in the new grammar -# and list them as a POD document, possibly with a callback -# function 'docfunc' - -sub _findmissing($$$;$) { - my $old = shift; - my $new = shift; - my $listname = shift; - my $docfunc = shift; - - my @doc; - if ($old->{$listname}) { - my %newlist; - if ($new->{$listname}) { - @newlist{@{$new->{$listname}}} = undef; - } - for my $v (@{$old->{$listname}}) { - next if exists $newlist{$v}; - if ($docfunc) { - push @doc, &$docfunc($old, $v) - } else { - push @doc, "=item $v"; - } - } - } - return @doc; -} - -# find variables in new grammar list 'listname' -# that aren't in the corresponding list in the new grammar -# -# this is just _findmissing with the arguments swapped - -sub _findnew($$$;$) { - my $old = shift; - my $new = shift; - my $listname = shift; - my $docfunc = shift; - return _findmissing($new, $old, $listname, $docfunc); -} - -# compare two lists for element equality - -sub _listseq($$); -sub _listseq($$) { - my ($k, $l) = @_; - my $length = @$k; - return 0 unless @$l == $length; - for (my $i=0; $i<$length; $i++) { - return 0 unless $k->[$i] eq $l->[$i]; - } - return 1; -} - -# diff two grammar trees, documenting the differences - -sub _diffgrammars($$); -sub _diffgrammars($$) { - my $old = shift; - my $new = shift; - my @doc; - - my @vdoc; - @vdoc = _findmissing($old, $new, '_vars'); - push @doc, "The following variables are not valid anymore:", "=over" , @vdoc, "=back" - if @vdoc; - @vdoc = _findnew($old, $new, '_vars', \&_describevar); - push @doc, "The following new variables are valid:", "=over" , @vdoc, "=back" - if @vdoc; - @vdoc = _findmissing($old, $new, '_sections'); - push @doc, "The following subsections are not valid anymore:", "=over" , @vdoc, "=back" - if @vdoc; - @vdoc = _findnew($old, $new, '_sections', sub { - my ($tree, $sec) = @_; - my @tdoc; - _genpod($tree->{$sec}, 0, \@tdoc); - return @tdoc; - }); - push @doc, "The following new subsections are defined:", "=over" , @vdoc, "=back" - if @vdoc; - for (@{$old->{_sections}}) { - next unless exists $new->{$_}; - @vdoc = _diffgrammars($old->{$_}, $new->{$_}); - push @doc, "Syntax changes for subsection B<$_>", "=over", @vdoc, "=back" - if @vdoc; - } - return @doc; -} - -# describe a variable - -sub _describevar { - my $tree = shift; - my $var = shift; - my $mandatory = ( $tree->{_mandatory} and - grep {$_ eq $var} @{$tree->{_mandatory}} ) ? - " I<(mandatory setting)>" : ""; - my @doc; - push @doc, "=item B<$var>".$mandatory; - push @doc, $tree->{$var}{_doc} if $tree->{$var}{_doc} ; - my $inherited = ( $tree->{_inherited} and - grep {$_ eq $var} @{$tree->{_inherited}}); - push @doc, "This variable I its value from the parent section if nothing is specified here." - if $inherited; - push @doc, "This variable I modifies the grammar based on its value." - if $tree->{$var}{_dyn}; - push @doc, "Default value: $var = $tree->{$var}{_default}" - if ($tree->{$var}{_default}); - push @doc, "Example: $var = $tree->{$var}{_example}" - if ($tree->{$var}{_example}); - return @doc; -} - -sub _genpod($$$); -sub _genpod($$$){ - my $tree = shift; - my $level = shift; - my $doc = shift; - my %dyndoc; - if ($tree->{_vars}){ - push @{$doc}, "The following variables can be set in this section:"; - push @{$doc}, "=over"; - foreach my $var (@{$tree->{_vars}}){ - push @{$doc}, _describevar($tree, $var); - } - push @{$doc}, "=back"; - } - - if ($tree->{_text}){ - push @{$doc}, ($tree->{_text}{_doc} or "Unspecified Text content"); - if ($tree->{_text}{_example}){ - my $ex = $tree->{_text}{_example}; - chomp $ex; - $ex = map {" $_"} split /\n/, $ex; - push @{$doc}, "Example:\n\n$ex\n"; - } - } - - if ($tree->{_table}){ - push @{$doc}, ($tree->{_table}{_doc} or - "This section can contain a table ". - "with the following structure:" ); - push @{$doc}, "=over"; - for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ - push @{$doc}, "=item column $i"; - push @{$doc}, ($tree->{_table}{$i}{_doc} or - "Unspecific Content"); - push @{$doc}, "Example: $tree->{_table}{$i}{_example}" - if ($tree->{_table}{$i}{_example}) - } - push @{$doc}, "=back"; - } - if ($tree->{_sections}){ - if ($level > 0) { - push @{$doc}, "The following sections are valid on level $level:"; - push @{$doc}, "=over"; - } - foreach my $section (@{$tree->{_sections}}){ - my $mandatory = ( $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}} ) ? - " I<(mandatory section)>" : ""; - push @{$doc}, ($level > 0) ? - "=item B<".("+" x $level)."$section>$mandatory" : - "=head2 *** $section ***$mandatory"; - if ($tree eq $tree->{$section}) { - push @{$doc}, "This subsection has the same syntax as its parent."; - next; - } - push @{$doc}, ($tree->{$section}{_doc}) - if $tree->{$section}{_doc}; - push @{$doc}, "The grammar of this section is I modified based on its name." - if $tree->{$section}{_dyn}; - if ($tree->{_recursive} and - grep {$_ eq $section} @{$tree->{_recursive}}) { - push @{$doc}, "This section is I: it can contain subsection(s) with the same syntax."; - } - _genpod ($tree->{$section},$level+1,$doc); - next unless $tree->{$section}{_dyn} and $tree->{$section}{_dyndoc}; - push @{$doc}, "Dynamical grammar changes for example instances of this section:"; - push @{$doc}, "=over"; - for my $name (sort keys %{$tree->{$section}{_dyndoc}}) { - my $newtree = _deepcopy($tree->{$section}); - push @{$doc}, "=item B<$name>: $tree->{$section}{_dyndoc}{$name}"; - &{$tree->{$section}{_dyn}}($section, $name, $newtree); - my @tdoc = _diffgrammars($tree->{$section}, $newtree); - if (@tdoc) { - push @{$doc}, @tdoc; - } else { - push @{$doc}, "No changes that can be automatically described."; - } - push @{$doc}, "(End of dynamical grammar changes for example instance C<$name>.)"; - } - push @{$doc}, "=back"; - push @{$doc}, "(End of dynamical grammar changes for example instances of section C<$section>.)"; - } - push @{$doc}, "=back" if $level > 0 - } - if ($tree->{_vars}) { - for my $var (@{$tree->{_vars}}) { - next unless $tree->{$var}{_dyn} and $tree->{$var}{_dyndoc}; - push @{$doc}, "Dynamical grammar changes for example values of variable C<$var>:"; - push @{$doc}, "=over"; - for my $val (sort keys %{$tree->{$var}{_dyndoc}}) { - my $newtree = _deepcopy($tree); - push @{$doc}, "=item B<$val>: $tree->{$var}{_dyndoc}{$val}"; - &{$tree->{$var}{_dyn}}($var, $val, $newtree); - my @tdoc = _diffgrammars($tree, $newtree); - if (@tdoc) { - push @{$doc}, @tdoc; - } else { - push @{$doc}, "No changes that can be automatically described."; - } - push @{$doc}, "(End of dynamical grammar changes for variable C<$var> example value C<$val>.)"; - } - push @{$doc}, "=back"; - push @{$doc}, "(End of dynamical grammar changes for example values of variable C<$var>.)"; - } - } -}; - -sub makepod($) { - my $self = shift; - my $tree = $self->{grammar}; - my @doc; - _genpod $tree,0,\@doc; - return join("\n\n", @doc)."\n"; -} - -sub _gentmpl($$$@); -sub _gentmpl($$$@){ - my $tree = shift; - my $level = shift; - my $doc = shift; - my @start = @_; - if (scalar @start ) { - my $section = shift @start; - my $secex =''; - my $prefix = ''; - $prefix = "# " unless $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}}; - if ($tree->{$section}{_example}) { - $secex = " # ( ex. $tree->{$section}{_example} )"; - } - push @{$doc}, $prefix. - (($level > 0) ? ("+" x $level)."$section" : "*** $section ***").$secex; - my $match; - foreach my $s (@{$tree->{_sections}}){ - if ($s =~ m|^/.+/$| and $section =~ /$s/ or $s eq $section) { - _gentmpl ($tree->{$s},$level+1,$doc,@start) - unless $tree eq $tree->{$s}; - $match = 1; - } - } - push @{$doc}, "# Section $section is not a valid choice" - unless $match; - } else { - if ($tree->{_vars}){ - foreach my $var (@{$tree->{_vars}}){ - push @{$doc}, "# $var = ". - ($tree->{$var}{_example} || ' * no example *'); - next unless $tree->{_mandatory} and - grep {$_ eq $var} @{$tree->{_mandatory}}; - push @{$doc}, "$var="; - } - } - - if ($tree->{_text}){ - if ($tree->{_text}{_example}){ - my $ex = $tree->{_text}{_example}; - chomp $ex; - $ex = map {"# $_"} split /\n/, $ex; - push @{$doc}, "$ex\n"; - } - } - if ($tree->{_table}){ - my $table = "# table\n#"; - for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ - $table .= ' "'.($tree->{_table}{$i}{_example} || "C$i").'"'; - } - push @{$doc}, $table; - } - if ($tree->{_sections}){ - foreach my $section (@{$tree->{_sections}}){ - my $opt = ( $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}} ) ? - "":"\n# optional section\n"; - my $prefix = ''; - $prefix = "# " unless $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}}; - my $secex =""; - if ($section =~ m|^/.+/$| && $tree->{$section}{_example}) { - $secex = " # ( ex. $tree->{$section}{_example} )"; - } - push @{$doc}, $prefix. - (($level > 0) ? ("+" x $level)."$section" : "*** $section ***"). - $secex; - _gentmpl ($tree->{$section},$level+1,$doc,@start) - unless $tree eq $tree->{$section}; - } - } - } -}; - -sub maketmpl ($@) { - my $self = shift; - my @start = @_; - my $tree = $self->{grammar}; - my @tmpl; - _gentmpl $tree,0,\@tmpl,@start; - return join("\n", @tmpl)."\n"; -} - -sub parse($$) -{ - my $self = shift; - my $file = shift; - - $self->{cfg} = {}; - $self->{level} = 0; - $self->{cfg_stack} = []; - $self->{grammar_stack} = []; - $self->{file_stack} = []; - $self->{line_stack} = []; - - # we work with a copy of the grammar so the _dyn subs may change it - local $self->{grammar} = _deepcopy($self->{grammar}); - - $self->_parse_file($file) or return undef; - - $self->_goto_level(0, undef) or return undef; - - # fill in the top level values from _default keywords - $self->_fill_defaults; - - $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef) - or return undef; - - return $self->{cfg}; - -} - -1 - -__END__ - -=head1 NAME - -ISG::ParseConfig - Simple config parser - -=head1 SYNOPSIS - - use ISG::ParseConfig; - - my $parser = ISG::ParseConfig->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 -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 -the configuration file and return helpful error messages in case of -syntax errors. Using the B methode you can generate -documentation of the configuration file format. - -The B 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 -template data based in regular expressions. - -=head2 Grammar Definition - -The grammar is a multiple-level hash of hashes, which follows the structure of -the configuration. Each section or variable is represented by a hash with the -same structure. Each hash contains special keys starting with an underscore -such as '_sections', '_vars', '_sub' or '_re' to denote meta data with information -about that section or variable. Other keys are used to structure the hash -according to the same nesting structure of the configuration itself. The -starting hash given as parameter to 'new' contains the "root section". - -=head3 Special Section Keys - -=over 12 - -=item _sections - -Array containing the list of sub-sections of this section. Each sub-section -must then be represented by a sub-hash in this hash with the same name of the -sub-section. - -The sub-section can also be a regular expression denoted by the syntax '/re/', -where re is the regular-expression. In case a regular expression is used, a -sub-hash named with the same '/re/' must be included in this hash. - -=item _recursive - -Array containing the list of those sub-sections that are I, ie. -that can contain a new sub-section with the same syntax as themselves. - -The same effect can be accomplished with circular references in the -grammar tree or a suitable B<_dyn> section subroutine (see below}, -so this facility is included just for convenience. - -=item _vars - -Array containing the list of variables (assignments) in this section. -Analogous to sections, regular expressions can be used. - -=item _mandatory - -Array containing the list of mandatory sections and variables. - -=item _inherited - -Array containing the list of the variables that should be assigned the -same value as in the parent section if nothing is specified here. - -=item _table - -Hash containing the table grammar (see Special Table Keys). If not specified, -no table is allowed in this section. The grammar of the columns if specified -by sub-hashes named with the column number. - -=item _text - -Section contains free-form text. Only sections and @includes statements will -be interpreted, the rest will be added in the returned hash under '_text' as -string. - -B<_text> is a hash reference which can contain a B<_re> and a B<_re_error> key -which will be used to scrutanize the text ... if the hash is empty, all text -will be accepted. - -=item _order - -If defined, a '_order' element will be put in every hash containing the -sections with a number that determines the order in which the sections were -defined. - -=item _varlist - -If defined, a '_varlist' element will be put in the config hash of this -section with a list of the variables defined in the section. This can -be used to find out the order of the variable assignments. - -The '_sub' function (see below) of any variables defined in this section -will also receive a list of those variables already defined in the -same section. This can be used to enforce the order of the variables -during parsing. - -=item _doc - -Describes what this section is about - -=item _sub - -A function pointer. It is called for every instance of this section, -with the real name of the section passed as its first argument. This is -probably only useful for the regexp sections. If the function returns -a defined value it is assumed that the test was not successful and an -error is generated with the returned string as content. - -=item _dyn - -A subroutine reference (function pointer) that will be called when -a new section of this syntax is encountered. The subroutine will get -three arguments: the syntax of the section name (string or regexp), the -actual name encountered (this will be the same as the first argument for -non-regexp sections) and a reference to the grammar tree of the section. -This subroutine can then modify the grammar tree dynamically. - -=item _dyndoc - -A hash reference that lists interesting names for the section that -should be documented. The keys of the hash are the names and the -values in the hash are strings that can contain an explanation -for the name. The _dyn() subroutine is then called for each of -these names and the differences of the resulting grammar and -the original one are documented. This module can currently document -differences in the _vars list, listing new variables and removed -ones, and differences in the _sections list, listing the -new and removed sections. - -=back - -=head3 Special Variable Keys - -=over 12 - -=item _re - -Regular expression upon which the value will be checked. - -=item _re_error - -String containing the returned error in case the regular expression doesn't -match (if not specified, a generic 'syntax error' message will be returned). - -=item _sub - -A function pointer. It called for every value, with the value passed as its -first argument. If the function returns a defined value it is assumed that -the test was not successful and an error is generated with the returned -string as content. - -If the '_varlist' key (see above) is defined in this section, the '_sub' -function will also receive an array reference as the second argument. The -array contains a list of those variables already defined in the same -section. This can be used to enforce the order of the variables. - -=item _default - -A default value that will be assigned to the variable if none is specified or inherited. - -=item _doc - -Description of the variable. - -=item _example - -A one line example for the content of this variable. - -=item _dyn - -A subroutine reference (function pointer) that will be called when the -variable is assigned some value in the config file. The subroutine will -get three arguments: the name of the variable, the value assigned and -a reference to the grammar tree of this section. This subroutine can -then modify the grammar tree dynamically. - -Note that no _dyn() call is made for default and inherited values of -the variable. - -=item _dyndoc - -A hash reference that lists interesting values for the variable that -should be documented. The keys of the hash are the values and the -values in the hash are strings that can contain an explanation -for the value. The _dyn() subroutine is then called for each of -these values and the differences of the resulting grammar and -the original one are documented. This module can currently document -differences in the _vars list, listing new variables and removed -ones, and differences in the _sections list, listing the -new and removed sections. - -=back - -=head3 Special Table Keys - -=over 12 - -=item _columns - -Number of columns. If not specified, it will not be enforced. - -=item _key - -If defined, the specified column number will be used as key in a hash in the -returned hash. If not defined, the returned hash will contain a '_table' -element with the contents of the table as array. The rows of the tables are -stored as arrays. - -=item _sub - -they work analog to the description in the previous section. - -=item _doc - -describes the content of the column. - -=item _example - -example for the content of this column - -=back - -=head3 Special Text Keys - -=over 12 - -=item _re - -Regular expression upon which the text will be checked (everything as a single -line). - -=item _re_error - -String containing the returned error in case the regular expression doesn't -match (if not specified, a generic 'syntax error' message will be returned). - -=item _sub - -they work analog to the description in the previous section. - -=item _doc - -Ditto. - -=item _example - -Potential multi line example for the content of this text section - -=back - -=head2 Configuration Syntax - -=head3 General Syntax - -'#' 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. - -'@include filename' is used to include another file. - -'@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. - -=head3 Sections - -ISG::ParseConfig supports hierarchical configurations through sections, whose -syntax is as follows: - -=over 15 - -=item Level 1 - -*** section name *** - -=item Level 2 - -+ section name - -=item Level 3 - -++ section name - -=item Level n, n>1 - -+..+ section name (number of '+' determines level) - -=back - -=head3 Assignments - -Assignements take the form: 'variable = value', where value can be any string -(can contain whitespaces and special characters). The spaces before and after -the equal sign are optional. - -=head3 Tabular Data - -The data is interpreted as one or more columns separated by spaces. - -=head2 Example - -=head3 Code - - my $parser = ISG::ParseConfig->new({ - _sections => [ 'network', 'hosts' ], - network => { - _vars => [ 'dns' ], - _sections => [ "/$RE_IP/" ], - dns => { - _doc => "address of the dns server", - _example => "ns1.oetiker.xs", - _re => $RE_HOST, - _re_error => - 'dns must be an host name or ip address', - }, - "/$RE_IP/" => { - _doc => "Ip Adress", - _example => '10.2.3.2', - _vars => [ 'netmask', 'gateway' ], - netmask => { - _doc => "Netmask", - _example => "255.255.255.0", - _re => $RE_IP, - _re_error => - 'netmask must be a dotted ip address' - }, - gateway => { - _doc => "Default Gateway address in IP notation", - _example => "10.22.12.1", - _re => $RE_IP, - _re_error => - 'gateway must be a dotted ip address' }, - }, - }, - hosts => { - _doc => "Details about the hosts", - _table => { - _doc => "Description of all the Hosts", - _key => 0, - _columns => 3, - 0 => { - _doc => "Ethernet Address", - _example => "0:3:3:d:a:3:dd:a:cd", - _re => $RE_MAC, - _re_error => - 'first column must be an ethernet mac address', - }, - 1 => { - _doc => "IP Address", - _example => "10.11.23.1", - _re => $RE_IP, - _re_error => - 'second column must be a dotted ip address', - }, - 2 => { - _doc => "Host Name", - _example => "tardis", - }, - }, - }, - }); - - my $cfg = $parser->parse('test.cfg') or - die "ERROR: $parser->{err}\n"; - print Dumper($cfg); - print $praser->makepod; - -=head3 Configuration - - *** network *** - - dns = 129.132.7.87 - - + 129.132.7.64 - - netmask = 255.255.255.192 - gateway = 129.132.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 - -=head3 Result - - { - 'hosts' => { - '00:50:fe:bc:65:11' => [ - '00:50:fe:bc:65:11', - '129.132.7.97', - 'plain.hades' - ], - '00:50:fe:bc:65:12' => [ - '00:50:fe:bc:65:12', - '129.132.7.98', - 'isg.ee.hades' - ], - '00:50:fe:bc:65:14' => [ - '00:50:fe:bc:65:14', - '129.132.7.99', - 'isg.ee.hades' - ] - }, - 'network' => { - '129.132.7.64' => { - 'netmask' => '255.255.255.192', - 'gateway' => '129.132.7.65' - }, - 'dns' => '129.132.7.87' - } - }; - -=head1 COPYRIGHT - -Copyright (c) 2000, 2001 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. - -=head1 AUTHOR - -David Schweikert Edws@ee.ethz.chE, -Tobias Oetiker Eoetiker@ee.ethz.chE - -=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) - 2005-02-21 ds 2.00 Implemented _dyndoc, _varlist and _sub for sections (Niko Tyni) - -=cut - -# Emacs Configuration -# -# Local Variables: -# mode: cperl -# eval: (cperl-set-style "PerlStyle") -# mode: flyspell -# mode: flyspell-prog -# End: -# -# vi: sw=4 diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 8cd5897..6718f36 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -9,7 +9,7 @@ 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') @@ -1383,7 +1383,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 +1446,7 @@ DOC }, }; # $PROBES - my $parser = ISG::ParseConfig->new + my $parser = Config::Grammar->new ( { _sections => [ qw(General Database Presentation Probes Alerts Targets) ], @@ -2374,7 +2374,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. +Config::Grammar module. Read all about it in L. The Configuration file has a tree-like structure with section headings at various levels. It also contains variable assignments and tables. -- cgit v1.2.3-24-g4f1b From 4d50cc7a6c80ea58ba492a875abcd250d44b1255 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 9 Mar 2005 17:33:33 +0000 Subject: * 2.0/lib/Config/Grammar.pm: + change the last few ParseConfig references to Config::Grammar --- lib/Config/Grammar.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/Config/Grammar.pm b/lib/Config/Grammar.pm index ede1a48..5bc76a3 100644 --- a/lib/Config/Grammar.pm +++ b/lib/Config/Grammar.pm @@ -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}; @@ -1063,7 +1063,7 @@ documentation of the configuration file format. The B 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 -- cgit v1.2.3-24-g4f1b From 021947ad8e963d89bdb00bd9de24dc962a3472bf Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 10 Mar 2005 11:00:44 +0000 Subject: * 2.0/lib/Smokeping/probes/Curl.pm, 2.0/doc/smokeping_upgrade.pod, 2.0/CHANGES: + new variables: extraargs and extrare --- CHANGES | 2 ++ doc/smokeping_upgrade.pod | 2 ++ lib/Smokeping/probes/Curl.pm | 43 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 47 insertions(+) diff --git a/CHANGES b/CHANGES index 8a2e9c2..8fbfad9 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,5 @@ +* Curl now has a new "extraargs" option for any extra arguments, like "--header" + -- niko, requested by Warrick FitzGerald * change ISG::ParseConfig references to its new name, Config::Grammar -- niko * don't create any RRD files if running as a CGI -- niko * Curl timeouts work better now -- niko, reported by Chris Wilson diff --git a/doc/smokeping_upgrade.pod b/doc/smokeping_upgrade.pod index bd3b93a..41e109b 100644 --- a/doc/smokeping_upgrade.pod +++ b/doc/smokeping_upgrade.pod @@ -148,6 +148,8 @@ quotes are not needed anymore around the User-Agent string (the C parameter). Smokeping will complain if it notices quotes around the string. +Any extra arguments for C can now be specified in the C variable. + =item L The default timeout of this probe has been raised to 10 seconds. diff --git a/lib/Smokeping/probes/Curl.pm b/lib/Smokeping/probes/Curl.pm index 56dd338..e00c749 100644 --- a/lib/Smokeping/probes/Curl.pm +++ b/lib/Smokeping/probes/Curl.pm @@ -102,6 +102,38 @@ host to be probed. DOC _example => "http://%host%/", }, + extrare=> { + _doc => < "/ /", + _example => "/ /", + _sub => sub { + my $val = shift; + return "extrare should be specified in the /regexp/ notation" + unless $val =~ m,^/.*/$,; + return undef; + }, + }, + extraargs => { + _doc => <. +DOC + _example => "-6 --head --user user:password", + }, }); } @@ -181,6 +213,16 @@ sub proto_args { 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 +233,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); } -- cgit v1.2.3-24-g4f1b From c1676927af530e87f849df945deaa65182db5835 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Fri, 11 Mar 2005 20:08:19 +0000 Subject: removed extra space --- lib/Smokeping/matchers/Avgratio.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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. -- cgit v1.2.3-24-g4f1b From d9b0e622f870cc151ffe814abde6f62a47cdba58 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Wed, 13 Apr 2005 11:35:52 +0000 Subject: * updated version numbers in branche * propperly deal with branches in the target tree that have no probe propperty set. --- Makefile | 4 ++-- bin/smokeping.dist | 2 +- htdocs/smokeping.cgi.dist | 2 +- lib/Smokeping.pm | 8 +++++--- 4 files changed, 9 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index dca0f23..d4d9b71 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ SHELL = /bin/sh -VERSION = 2.0BRANCHE -NUMVERSION = 1.99003 +VERSION = 2.0rc3 +NUMVERSION = 1.99004 IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp|.svn GROFF = groff .PHONY: man html txt ref examples check-examples patch killdoc doc tar rename-man symlinks remove-symlinks diff --git a/bin/smokeping.dist b/bin/smokeping.dist index 02deda1..a9d4504 100755 --- a/bin/smokeping.dist +++ b/bin/smokeping.dist @@ -4,7 +4,7 @@ use lib qw(/usr/pack/rrdtool-1.0.49-to/lib/perl); use lib qw(lib); -use Smokeping 1.99001; +use Smokeping 1.99004; Smokeping::main("etc/config.dist"); diff --git a/htdocs/smokeping.cgi.dist b/htdocs/smokeping.cgi.dist index f26ad5b..4a1c34c 100755 --- a/htdocs/smokeping.cgi.dist +++ b/htdocs/smokeping.cgi.dist @@ -5,7 +5,7 @@ use lib qw(/usr/pack/rrdtool-1.0.33-to/lib/perl); use lib qw(/home/oetiker/data/projects/AADJ-smokeping/dist/lib); use CGI::Carp qw(fatalsToBrowser); -use Smokeping 1.38; +use Smokeping 1.99004; Smokeping::cgi("/home/oetiker/data/projects/AADJ-smokeping/dist/etc/config"); diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 6718f36..048f795 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -20,7 +20,7 @@ use Smokeping::RRDtools; # globale persistent variables for speedy use vars qw($cfg $probes $VERSION $havegetaddrinfo $cgimode); -$VERSION="1.99001"; +$VERSION="1.99004"; # we want opts everywhere my %opt; @@ -918,13 +918,15 @@ 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 and 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); -- cgit v1.2.3-24-g4f1b From 21df925982b162f18479c9ab8312e3573dcd7f24 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Wed, 13 Apr 2005 19:31:27 +0000 Subject: * added labeling fixes for rrdtool 1.2 compatibility * added navigator mode where it is possible to alter the timerange shown in a graph. This feature is sponsored by BeverlyCorp. * fix fix for matcher cache skipping --- lib/Smokeping.pm | 347 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 218 insertions(+), 129 deletions(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 048f795..963299d 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -542,6 +542,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) { @@ -566,11 +569,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 .= "
"; if (defined $ERROR) { @@ -645,26 +647,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 "
ERROR: ".(join ".", @dirs)." has no probe defined
" unless $tree->{probe}; - die "ERROR: ".(join ".", @dirs)." $tree->{probe} is not known\n" + + return "
ERROR: ".(join ".", @dirs)." $tree->{probe} is not known
" 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 "
ERROR: unknown displaymode $mode
" + unless $mode =~ /^[sn]$/; for (@dirs) { $dir .= "/$_"; @@ -674,142 +696,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 (){ - 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 (){ + 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 { + my $basedir = + mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $imgbase; + # remove old images after one hour + my $pattern = "$cfg->{General}{imgcache}/__navcache/*.png"; + for (<$pattern>){ + unlink $_ if -A $_ > 1/24; + } + $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(); + do_log $ERROR if $ERROR; + my $val = $graphret->[0]; + $val = 1 if $val =~ /nan/i; + $max = { $tasks[0][1] => $val }; + } + 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 %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 = '\\'; + } - 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'], + for (@tasks) { + my ($desc,$start,$end) = @{$_}; + $end ||= 'last'; + $start = exp2seconds($start) if $mode eq 's'; + + my $startstr = POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)); + my $endstr = POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)); + + 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 "$_
"} @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)."/"; 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 "$_
"} @upargs; - }; + $lastup=$uptime; + } + + push @upargs, 'COMMENT:)\l'; + # map {print "$_
"} @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}; + @lazy = ('--lazy') if $mode eq 's' and $lasthight{$start} and $lasthight{$start} == $max->{$start}; + $desc = "Navigator Graph" if $mode eq 'n'; my ($graphret,$xs,$ys) = RRDs::graph - ($cfg->{General}{imgcache}.$dir."/${file}_last_${start}.png", + ("${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 +894,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 +902,34 @@ 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 $ERROR = RRDs::error(); - $page .= "
". - ( $ERROR || - "{General}{imgurl}.$dir."/${file}_last_${start}.png\">" )."
"; + if ($mode eq 'n'){ + $page .= "
"; + $page .= ( $ERROR || qq{} ); + $page .= "
"; + $page .= $q->start_form(-method=>'GET') + . "

Time range: " + . $q->textfield(-name=>'start',-default=>$startstr) + . "  to  ".$q->textfield(-name=>'end',-default=>$endstr) + . $q->hidden(-name=>'target' ) + . $q->hidden(-name=>'displaymode',-default=>$mode ) + . " " + . $q->submit(-name=>'Generate!') + . "

" + . $q->end_form(); + } else { + $startstr =~ s/\s/%20/g; + $endstr =~ s/\s/%20/g; + $page .= "
"; + $page .= ( $ERROR || + qq{' + . qq{}."" ); + $page .= "
"; + + } } return $page; @@ -925,7 +1013,8 @@ sub update_rrds($$$$$) { } # 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 and defined $justthisprobe and $probe ne $justthisprobe; + 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"; -- cgit v1.2.3-24-g4f1b From 1f333688daf8f6dcf6f5a9c0be857dbcf0675dc3 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Fri, 15 Apr 2005 15:03:01 +0000 Subject: make unlink in navcache work --- lib/Smokeping.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 963299d..518f5a1 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -559,9 +559,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", @@ -726,11 +728,10 @@ sub get_detail ($$$$){ close HG; } } else { - my $basedir = - mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $imgbase; + 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 (<$pattern>){ + for (<"$pattern">){ unlink $_ if -A $_ > 1/24; } $imgbase =$cfg->{General}{imgcache}."/__navcache/".time()."$$"; -- cgit v1.2.3-24-g4f1b From e5123e033bdae8ceaf9ba847b929ec56d9dfa1e8 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Fri, 15 Apr 2005 15:25:38 +0000 Subject: make navigator feature more robust for situations where invalid timeranges are provided. --- lib/Smokeping.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 518f5a1..16df63f 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -745,10 +745,10 @@ sub get_detail ($$$$){ "DEF:maxping=${rrd}:median:AVERAGE", 'PRINT:maxping:MAX:%le' ); my $ERROR = RRDs::error(); - do_log $ERROR if $ERROR; + return "
RRDtool did not understand your input: $ERROR.
" if $ERROR; my $val = $graphret->[0]; $val = 1 if $val =~ /nan/i; - $max = { $tasks[0][1] => $val }; + $max = { $tasks[0][1] => $val * 1.5 }; } my $smoke = $pings >= 3 @@ -808,8 +808,8 @@ sub get_detail ($$$$){ $end ||= 'last'; $start = exp2seconds($start) if $mode eq 's'; - my $startstr = POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)); - my $endstr = POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)); + 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}; -- cgit v1.2.3-24-g4f1b From 4036ad2a9afa4417c670fc52eaf67da37b0f8e45 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Mon, 9 May 2005 18:38:03 +0000 Subject: Double check the answer from the dns server and optionally enforce a NOERROR response code -- Christoph.Heine in HaDiKo.DE --- lib/Smokeping/probes/AnotherDNS.pm | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) 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', -- cgit v1.2.3-24-g4f1b From cc63560d93815cac731fefe82f24aee01aba7676 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 10 May 2005 11:45:52 +0000 Subject: * 2.0/lib/Smokeping.pm: + make 'smokeping -static' work again + document '@include' and its friends in smokeping_config in addition to Config::Grammar --- lib/Smokeping.pm | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 16df63f..8015d25 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -50,6 +50,10 @@ sub find_libdir { sub do_log(@); sub load_probe($$$$); +sub dummyCGI::param { + return wantarray ? () : ""; +} + sub load_probes ($){ my $cfg = shift; my %prbs; @@ -2451,6 +2455,7 @@ sub load_cfg ($) { sub makepod ($){ my $parser = shift; my $e='='; + my $a='@'; my $retval = < 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 -- cgit v1.2.3-24-g4f1b From bd0e56f10d34b874a6d115391c4046199e5b330e Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 10 May 2005 17:48:16 +0000 Subject: * branches/2.0/lib/Smokeping/probes/Curl.pm: + added the 'insecure_ssl' (-k) option from Marc Spitzer --- lib/Smokeping/probes/Curl.pm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lib/Smokeping/probes/Curl.pm b/lib/Smokeping/probes/Curl.pm index e00c749..af5be29 100644 --- a/lib/Smokeping/probes/Curl.pm +++ b/lib/Smokeping/probes/Curl.pm @@ -102,6 +102,16 @@ host to be probed. DOC _example => "http://%host%/", }, + insecure_ssl => { + _doc => < 1, + }, extrare=> { _doc => <{vars}{ssl2}; push (@args, "-2") if defined($ssl2); + my $insecure_ssl = $target->{vars}{insecure_ssl}; + push (@args, '-k') if defined $insecure_ssl; + return(@args); } -- cgit v1.2.3-24-g4f1b From 292c6fc1ffce6460bd8fa97d31b912da3a90673b Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 10 May 2005 18:10:14 +0000 Subject: * branches/2.0/doc/smokeping_upgrade.pod; branches/2.0/CHANGES: + changelog updates --- CHANGES | 10 ++++++++++ doc/smokeping_upgrade.pod | 13 ++++++++++++- 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 8fbfad9..c5ac6dc 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,12 @@ +* Curl now has a new 'insecure_ssl' option for those not caring about CA paths + -- niko, original patch by Spitzer +* document '@include' and its friends in smokeping_config in addition to + Config::Grammar -- niko, from Marc Haber (Debian bug #307955) +* AnotherDNS: Double check the answer from the dns server and optionally enforce a + NOERROR response code -- Christoph.Heine in HaDiKo.DE +* NEW Feature: when clicking on the graphs in detail view + you can select different time ranges for the graph. The creation of this + feature has been sponsored by BeverlyCorp.com -- tobi * Curl now has a new "extraargs" option for any extra arguments, like "--header" -- niko, requested by Warrick FitzGerald * change ISG::ParseConfig references to its new name, Config::Grammar -- niko @@ -23,6 +32,7 @@ * new commandline options '--config=X' and '--check' -- niko * FPing: support "-t", "-p" and "-i" fping params -- niko, suggested by Chris Wilson * FPing6: test against ::1 instead of localhost -- Sebastian Wiesinger +* make sure mailsetup works before using it -- tobi * fix for basefork.pm IO::Select property has_exception is very platform dependent by ignoring it altogether things actually work better. Especially on Solaris which does have propper support for has_exception as oposed to linux. -- niko, reported by Jim Morris diff --git a/doc/smokeping_upgrade.pod b/doc/smokeping_upgrade.pod index 41e109b..ad7b595 100644 --- a/doc/smokeping_upgrade.pod +++ b/doc/smokeping_upgrade.pod @@ -23,7 +23,7 @@ An official list of changes with each release can be found in the CHANGES file in the Smokeping distribution. This document tries to complement that with upgrading instructions etc. -=head1 1.38 to 2.0 +=head1 1.40 to 2.0 The biggest change with the 2.0 release is that the configuration file is now parsed much more strictly. This should result in (hopefully @@ -199,6 +199,17 @@ in the C variable, like it is with all the other probes. =back +=head1 1.38 to 1.40 + +=over + +=item The new navigation feature + +The big visible difference between 1.38 and 1.40 is the new browser navigation +feature: when clicking on the graphs in detail view you can select +different time ranges for the graph. The creation of this +feature has been sponsored by BeverlyCorp.com. + =head1 1.34 to 1.37 =over -- cgit v1.2.3-24-g4f1b From 2e6ce403d18425cf4f32dd5fc2cbb6e94eae39ae Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 11 May 2005 10:32:46 +0000 Subject: * branches/2.0/CHANGES: + include Marc Spitzer's first name too :) --- CHANGES | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index c5ac6dc..3f808da 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,5 @@ * Curl now has a new 'insecure_ssl' option for those not caring about CA paths - -- niko, original patch by Spitzer + -- niko, original patch by Marc Spitzer * document '@include' and its friends in smokeping_config in addition to Config::Grammar -- niko, from Marc Haber (Debian bug #307955) * AnotherDNS: Double check the answer from the dns server and optionally enforce a -- cgit v1.2.3-24-g4f1b From ef0a8b6b72eff929a9f6a414e16db33ec3fac07d Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Wed, 11 May 2005 19:48:55 +0000 Subject: fix zooming --- bin/smokeping.dist | 2 +- lib/Smokeping.pm | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/bin/smokeping.dist b/bin/smokeping.dist index a9d4504..8472a9d 100755 --- a/bin/smokeping.dist +++ b/bin/smokeping.dist @@ -42,7 +42,7 @@ B [ B<--email> | B<--makepod> | B<--version> | B<--restart> ] --filter=x Only measure entries which pass the filter x - --logfile Append warnings to this logfile + --logfile=x Append warnings to logfile x. --static[=x] Generates a static website in directory x. If x is left out, pagedir from the config is used. diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 8015d25..caaeab0 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -930,7 +930,7 @@ sub get_detail ($$$$){ $endstr =~ s/\s/%20/g; $page .= "
"; $page .= ( $ERROR || - qq{' + qq{' . qq{}."" ); $page .= "
"; @@ -2132,7 +2132,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 -- cgit v1.2.3-24-g4f1b From 83ab1432a8f085b2139cab8a61227b80e5b319b4 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Wed, 11 May 2005 19:58:21 +0000 Subject: prepare for the release of smokeping-2.0rc4 --- CHANGES | 1 + Makefile | 8 ++++++-- bin/smokeping.dist | 2 +- htdocs/smokeping.cgi.dist | 2 +- lib/Smokeping.pm | 2 +- 5 files changed, 10 insertions(+), 5 deletions(-) diff --git a/CHANGES b/CHANGES index 3f808da..87b7aaf 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,4 @@ +2005/05/11 - publish rc4 (tobi) * Curl now has a new 'insecure_ssl' option for those not caring about CA paths -- niko, original patch by Marc Spitzer * document '@include' and its friends in smokeping_config in addition to diff --git a/Makefile b/Makefile index d4d9b71..af579e4 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ SHELL = /bin/sh -VERSION = 2.0rc3 -NUMVERSION = 1.99004 +VERSION = 2.0rc4 +NUMVERSION = 1.99005 IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp|.svn GROFF = groff .PHONY: man html txt ref examples check-examples patch killdoc doc tar rename-man symlinks remove-symlinks @@ -140,3 +140,7 @@ tar: doc patch dist: tar mv smokeping-$(VERSION).tar.gz /home/oetiker/public_html/webtools/smokeping/pub/ cp CHANGES /home/oetiker/public_html/webtools/smokeping/pub/CHANGES + +tag: dist + svn commit -m "prepare for the release of smokeping-$(VERSION)" + svn copy -m "tagging version $(VERSION)" svn://svn.ee.ethz.ch/smokeping/branches/2.0 svn://svn.ee.ethz.ch/smokeping/tags/$VERSION diff --git a/bin/smokeping.dist b/bin/smokeping.dist index 8472a9d..e6a13ab 100755 --- a/bin/smokeping.dist +++ b/bin/smokeping.dist @@ -4,7 +4,7 @@ use lib qw(/usr/pack/rrdtool-1.0.49-to/lib/perl); use lib qw(lib); -use Smokeping 1.99004; +use Smokeping 1.99005; Smokeping::main("etc/config.dist"); diff --git a/htdocs/smokeping.cgi.dist b/htdocs/smokeping.cgi.dist index 4a1c34c..a5801b4 100755 --- a/htdocs/smokeping.cgi.dist +++ b/htdocs/smokeping.cgi.dist @@ -5,7 +5,7 @@ use lib qw(/usr/pack/rrdtool-1.0.33-to/lib/perl); use lib qw(/home/oetiker/data/projects/AADJ-smokeping/dist/lib); use CGI::Carp qw(fatalsToBrowser); -use Smokeping 1.99004; +use Smokeping 1.99005; Smokeping::cgi("/home/oetiker/data/projects/AADJ-smokeping/dist/etc/config"); diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index caaeab0..7be666d 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -20,7 +20,7 @@ use Smokeping::RRDtools; # globale persistent variables for speedy use vars qw($cfg $probes $VERSION $havegetaddrinfo $cgimode); -$VERSION="1.99004"; +$VERSION="1.99005"; # we want opts everywhere my %opt; -- cgit v1.2.3-24-g4f1b From 6b119de859a72910df1b1bf83ab4e978af019694 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 17 May 2005 13:28:01 +0000 Subject: * CHANGES: + mention 2.0rcX releases --- CHANGES | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/CHANGES b/CHANGES index 87b7aaf..e572131 100644 --- a/CHANGES +++ b/CHANGES @@ -8,9 +8,19 @@ * NEW Feature: when clicking on the graphs in detail view you can select different time ranges for the graph. The creation of this feature has been sponsored by BeverlyCorp.com -- tobi + +2005/03/10 - 2.0rc3 (tobi) + * Curl now has a new "extraargs" option for any extra arguments, like "--header" -- niko, requested by Warrick FitzGerald * change ISG::ParseConfig references to its new name, Config::Grammar -- niko + +2005/02/28 - 2.0rc2 (tobi) + +* SYNOPSYS is really spelled SYNOPSIS. Shame on me. -- niko + +2005/02/22 - 2.0rc1 (tobi) + * don't create any RRD files if running as a CGI -- niko * Curl timeouts work better now -- niko, reported by Chris Wilson * Curl User-Agent string doesn't need quotes anymore -- niko -- cgit v1.2.3-24-g4f1b From bf7247e98dfc9891a5adaaf60cbe392b25cb66ae Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 18 May 2005 11:19:09 +0000 Subject: * branches/2.0/lib/Smokeping/RRDtools.pm, branches/2.0/CHANGES: + RRDtool 1.2.x compatibility fix ("unknown RRD version: 0003" on restart) -- niko, reported by Sam Stickland --- CHANGES | 3 +++ lib/Smokeping/RRDtools.pm | 3 ++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index e572131..580ab3f 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +* RRDtool 1.2.x compatibility fix ("unknown RRD version: 0003" on restart) + -- niko, reported by Sam Stickland + 2005/05/11 - publish rc4 (tobi) * Curl now has a new 'insecure_ssl' option for those not caring about CA paths -- niko, original patch by Marc Spitzer diff --git a/lib/Smokeping/RRDtools.pm b/lib/Smokeping/RRDtools.pm index 2b8e3a4..ac70837 100644 --- a/lib/Smokeping/RRDtools.pm +++ b/lib/Smokeping/RRDtools.pm @@ -97,7 +97,8 @@ sub info2create { 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; -- cgit v1.2.3-24-g4f1b From b83cf0d34b87d51fbdcf60d522b9c87ca4b4ccd2 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 22 May 2005 11:15:46 +0000 Subject: * 2.0/TODO: + wishlist and other entries --- TODO | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/TODO b/TODO index 6915ef5..8e2a76a 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,7 @@ * UPTIME - define update via snmp pointer per device + - define update via snmp pointer per device + - possibility to call an external script + -> generic uptime plugin? * ATTENTION allow to define a thereshold rule by looking at @@ -9,3 +11,27 @@ allow to have atarget which points to a different target only targets with host are considered +* ALERTS + only send alerts when the state changes + - suggested by Marc Haber, + + +* DAEMON + reread config periodically or with SIGHUP so that + no measurement is interrupted + - suggested by Taisuke Yamada, + + - concurrent probe processes need a signal anyway, + they have to exit and new ones started so that + we don't have to compare to the old config + +* REMOTE EXECUTION + generic remote probe + - a possibility for basefork-derived probes to reuse the same + SSH connection with shell for() loops for all the pings to a given + target + +* GENERIC EXEC PROBE + - almost every probe has a different way of calling system(), exec() + or similar. This should be in an inheritable module. + - the module should also support extra commandline arguments -- cgit v1.2.3-24-g4f1b From 205fff014be2afad6cb4430a2fceabea8111c885 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Mon, 23 May 2005 18:02:01 +0000 Subject: * Perl 5.8.0 compatibility fix ("missing max for DS uptime") --- CHANGES | 2 ++ lib/Smokeping/RRDtools.pm | 7 +++++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/CHANGES b/CHANGES index 580ab3f..3098338 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,5 @@ +* Perl 5.8.0 compatibility fix ("missing max for DS uptime") + -- niko, reported by Steve Wickert and Kennedy Clark * RRDtool 1.2.x compatibility fix ("unknown RRD version: 0003" on restart) -- niko, reported by Sam Stickland diff --git a/lib/Smokeping/RRDtools.pm b/lib/Smokeping/RRDtools.pm index ac70837..4a695d1 100644 --- a/lib/Smokeping/RRDtools.pm +++ b/lib/Smokeping/RRDtools.pm @@ -93,6 +93,7 @@ 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; @@ -112,7 +113,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"; } @@ -122,7 +124,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); -- cgit v1.2.3-24-g4f1b From 3d1b4178cd7c5d7d10aca5c48bad8995afc31a58 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 26 May 2005 18:45:05 +0000 Subject: * Officially include tSmoke.pl from the Smokeping contrib directory + add pristine v4 files; they still need modification --- bin/tSmoke.pl.dist | 511 +++++++++++++++++++++++++++++++++++++++++++++++++++++ etc/tmail | 132 ++++++++++++++ tSmoke.v4.README | 20 +++ 3 files changed, 663 insertions(+) create mode 100755 bin/tSmoke.pl.dist create mode 100644 etc/tmail create mode 100644 tSmoke.v4.README diff --git a/bin/tSmoke.pl.dist b/bin/tSmoke.pl.dist new file mode 100755 index 0000000..95a30bb --- /dev/null +++ b/bin/tSmoke.pl.dist @@ -0,0 +1,511 @@ +#!/usr/bin/perl +# +#----------------------------------------------- +# tSmoke.pl +# Dan McGinn-Combs, Sep 2003 +# tSmoke.v 0.4 2004/03 McGinn-Combs +#----------------------------------------------- +# +# 1) This program is run via CRON or the command line +# 2) It extracts RRD information from a smokeping config file +# 3) It pulls data from RRD files to determine if anything is offline, that is returning 0 PINGs +# 4) tSmoke reports status via an SMTP alert +# 5) tSmoke also generates an SMTP mail showing historical view of availability +# +# Many thanks to the following people for their help and guidance: +# Jim Horwath of Agere Systems Inc. for his examples and pointers to Spreadsheet::WriteExcel +# Frank Harper the author of SLAMon, a tool for tracking Service Level Agreements +# Tobias Oeticker, or course, the author of Smokeping, RRDTool and MRTG +# +use strict; + +# We need to use +# -- Smokeping libraries +# -- RRDTool +# -- Getopt::Long +# +# Point the lib variables to your implementation +use lib "/usr/local/smokeping/lib"; +use lib "/usr/local/rrdtool-1.0.39/lib/perl"; +use Smokeping; +use Net::SMTP; +use ISG::ParseConfig; +use Getopt::Long; +use Pod::Usage; +use RRDs; + +# Point to your Smokeping config file +my $cfgfile = "/usr/local/smokeping/etc/config"; + +# global variables +my $cfg; + +#this is designed to work on IPv4 only +my $havegetaddrinfo = 0; + +# we want opts everywhere +my %opt; + +#Hashes for the data +my (%Daily,%Weekly,%Monthly,%Quarterly); # the entries +my (%DailyC,%WeeklyC,%MonthlyC,%QuarterlyC); # a count of the entries + +###################### +### Moving Average ### +###################### +# Just a reminder of how to do a moving average if you ever want to +# PREV,UN,,UN,1,,IF,PREV,IF,,UN,1,,IF,-,,*,A,UN,1,A,IF,+ + +# Change Log: +# DMC - Added Quarterly Status +# DMC - Added HTML mail reporting and consolidated functions +# DMC = Added an external HTML mail template, tMail +my $RCS_VERSION = '$id: tSmoke.v 0.4 2004/03 McGinn-Combs'; + +sub test_mail($) { + my $cfg = shift; + print "Mail will be sent to $cfg->{Alerts}{to}\n"; + print "Mail will be sent from $cfg->{Alerts}{from}\n"; +}; + +sub sendmail ($$$$){ + my $from = shift; + my $to = shift; + my $subject = shift; + my $body = shift; + if ($cfg->{General}{mailhost}){ + my $smtp = Net::SMTP->new($cfg->{General}{mailhost}); + $smtp->mail($from); + $smtp->to($to); + $smtp->data(); + $smtp->datasend("Subject: $subject\n"); + $smtp->datasend("To: $to\n"); + $smtp->datasend($body); + $smtp->dataend(); + $smtp->quit; + } elsif ($cfg->{General}{sendmail} or -f "/usr/lib/sendmail"){ + open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to); + print M "Subject: $subject\n"; + print M $body; + close M; + } +} + +sub morning_update($) { + # Send out a morning summary of devices that are down + my $cfg = shift; + my $Body = ""; + my $TmpBody = ""; + my $To = ""; + if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } + + # Get a list of the existing RRD Files + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + my $Count = $#rrds + 1; + my $Down = 0; + + foreach my $target (@rrds) { + my $Loss = 0; + my ($start,$step,$names,$data) = RRDs::fetch "$target","AVERAGE","--start","-300"; + my $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + foreach my $line (@$data) { + $Loss += $$line[3]; + } + $Down += 1 if $Loss == 0; + $target =~ s/^([a-zA-Z0-9]*\/)*//; + $target =~ s/.rrd//; + $TmpBody .= "$target\n" if $Loss == 0; + } + $Body = "Of $Count Hosts, $Down Down:\n" . $TmpBody; + sendmail $cfg->{Alerts}{from},$To,"Of $Count Hosts, $Down Down",$Body; +} + +sub weekly_update($) { + # Send out a formatted HTML Table of the + # Previous Day, Week, Month and Quarter Availability + # Get a list of the existing RRD Files + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + + my $To = ""; + if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } + + my $Body =''; + +# Calculations Based on the following: +# RRDs::graph "fake.png", +# '--start','-86400', +# '-end','-300', +# "DEF:loss=${rrd}:loss:AVERAGE", +# "CDEF:avail=loss,0,100,IF", or more precisely "CDEF:avail=loss,2,GE,0,100,IF" +# and adding in the check for unknown for systems just coming on line +# "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF" + # Arbitrarily a loss of 10% of Pings means the system was down + my $pings = $cfg->{Database}{pings} * .1; + + foreach my $target (@rrds) { + # Get an average Availability for each RRD file + my $ERR; + + my ($DAverage,$Dxsize,$Dysize) = RRDs::graph "fake.png", + "--start","-86400", + "--end","-600", + "--step","1008", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($WAverage,$Wxsize,$Wysize) = RRDs::graph "fake.png", + "--start","-604800", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($MAverage,$Mxsize,$Mysize) = RRDs::graph "fake.png", + "--start","-2592000", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($QAverage,$Qxsize,$Qysize) = RRDs::graph "fake.png", + "--start","-7776000", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + $target =~ s/$cfg->{General}{datadir}\///; + $target =~ s/.rrd//; + my @Path; + push @Path,split/\//,$target; + update_stats ( \@Path, @$DAverage[0], @$WAverage[0], @$MAverage[0], @$QAverage[0]); + } + + # Prepare the e-mail message + open tSMOKE, $cfg->{General}{tmail} or die "ERROR: can't read $cfg->{General}{tmail}\n"; + while (){ + my $Summary = Summary_Sheet(); + s/<##SUMMARY##>/$Summary/ig; + my $Daily = DetailSheet(86400); + s/<##DAYDETAIL##>/$Daily/ig; + my $Weekly = DetailSheet(604800); + s/<##WEEKDETAIL##>/$Weekly/ig; + my $Monthly = DetailSheet(2592000); + s/<##MONTHDETAIL##>/$Monthly/ig; + my $Quarterly = DetailSheet(7776000); + s/<##QUARTERDETAIL##>/$Quarterly/ig; + $Body .= $_; + } + close tSMOKE; + sendmail ( $cfg->{Alerts}{from}, $To, "IT System Availability", $Body ); +} + +sub update_stats($$$$$); +sub update_stats($$$$$) { + # Update the uptime percentages in the Hash Arrays + my $Path = shift; + my $DAverage = shift; + my $WAverage = shift; + my $MAverage = shift; + my $QAverage = shift; + + #Enter everything once as it exists + #Trim off the rightmost component (hostname) and reenter the code + #If there is only one component, this is the final level + #This is an average of averages + + my $Ticket = join ( ".",@$Path); + $Daily { $Ticket } += $DAverage; + $Weekly { $Ticket } += $WAverage; + $Monthly { $Ticket } += $MAverage; + $Quarterly {$Ticket } += $QAverage; + $DailyC { $Ticket }++; + $WeeklyC { $Ticket }++; + $MonthlyC { $Ticket }++; + $QuarterlyC { $Ticket }++; + my $Length = @$Path; + @$Path = @$Path [ 0 .. $Length - 2 ]; + update_stats(\@$Path,$DAverage,$WAverage,$MAverage,$QAverage) if $Length > 1; +} + +sub Summary_Sheet() { + my $Body = ''; + + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= " + + + + \n"; + foreach (sort { $a cmp $b } keys %Monthly) { + next if ( $_ =~ /\./ ); + # this is a major section heading + $Body .= "\n"; + $Body .= ""; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} >= 99 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} > 95 and $Quarterly{$_}/$QuarterlyC{$_} < 99 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} > 90 and $Quarterly{$_}/$QuarterlyC{$_} < 95 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} < 90 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} >= 99 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} > 95 and $Monthly{$_}/$MonthlyC{$_} < 99 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} > 90 and $Monthly{$_}/$MonthlyC{$_} < 95 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} < 90 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} >= 99; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} > 95 and $Weekly{$_}/$WeeklyC{$_} < 99 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} > 90 and $Weekly{$_}/$WeeklyC{$_} < 95 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} < 90 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} >= 99; + $Body .= "" + if $Daily{$_}/$DailyC{$_} > 95 and $Daily{$_}/$DailyC{$_} < 99 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} > 90 and $Daily{$_}/$DailyC{$_} < 95 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} < 90 ; + $Body .= "\n"; + } + $Body .= "
IT Network Systems Availability Summary
Compiled: ". scalar(localtime) . "
ServicePast QuarterPast MonthPast WeekPast Day
$_" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%
"; + $Body .= "

\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "
Legend:
if uptime > 99% then GREEN
if uptime > 95% but < 99% then BLUE
if uptime > 90% but < 95% then YELLOW
if uptime < 90% then RED
\n"; + return $Body; +} + +sub NumDots($) { + # Count the number of dots in a string + # There's probably a better way to do this + my $DNA = shift; + my $a = 0; + while($DNA =~ /\./ig){$a++} + return $a +} + +sub DetailSheet($) { + # Populate the table with details depending on the value of %opts{detail} + my $Seconds = shift; + my $Body = ''; + + return '' unless $opt{detail}; + + # Monthly/Weekly/Daily + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= " + + \n"; + + my %CornBeef; + my %CornBeefC; + + CASE: { + %CornBeef = %Daily, %CornBeefC = %DailyC, print "Doing Daily\n", last CASE if $Seconds == 86400; + %CornBeef = %Weekly, %CornBeefC = %WeeklyC, print "Doing Weekly\n", last CASE if $Seconds == 604800; + %CornBeef = %Monthly, %CornBeefC = %MonthlyC, print "Doing Monthly\n", last CASE if $Seconds == 2592000; + %CornBeef = %Quarterly, %CornBeefC = %QuarterlyC, print "Doing Quarterly\n", last CASE if $Seconds == 7776000; + } # end of CASE block + + foreach (sort { $a cmp $b } keys %CornBeef ) { + next if NumDots ($_) > $opt{detail}; + if ( $_ =~ /\./ ) { + #this is a sub section + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + } else { + # this is a non-sub section + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= ""; + } + } + $Body .= "
IT Network Systems Availability Previous " . $Seconds/86400 . " Day(s)
Compiled: ". scalar(localtime) . "
ServiceSecondsPercent
$_" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
" . $_ . "" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
\n"; + return $Body; + } + +sub list_rrds($$$); +sub list_rrds($$$) { + # List the RRD's used by this configuration + my $tree = shift; + my $path = shift; + my $print = shift; + my $prline; + foreach my $rrds (keys %{$tree}) { + next if $rrds eq "PROBE_CONF"; + if (ref $tree->{$rrds} eq 'HASH'){ + $prline .= list_rrds( $tree->{$rrds}, $path."/$rrds", $print ); + } + if ($rrds eq 'host') { + $prline .= "$cfg->{General}{datadir}$path".".rrd\n"; + } + } + return $prline; +} + +sub load_cfg ($) { + my $cfgfile = shift; +# my $parser = get_parser; + my $parser = Smokeping::get_parser; + $cfg = Smokeping::get_config $parser, $cfgfile; +} + +########################################################################### +# The Main Program +########################################################################### + +sub main($); +main($cfgfile); + +sub main ($) { + umask 022; + my $cfgfile = shift; + my $sendto; + GetOptions(\%opt, 'quiet','version','testmail','listrrds','to=s','detail=n','morning','weekly','help','man') or pod2usage(2); + if($opt{version}) { print "$RCS_VERSION\n"; exit(0) }; + if($opt{help}) { pod2usage(-verbose => 1); exit 0 }; + if($opt{man}) { pod2usage(-verbose => 2); exit 0 }; + load_cfg $cfgfile; + print "tSmoke for network managed by $cfg->{General}{owner}\nat $cfg->{General}{contact}\n(c) 2003 Dan McGinn-Combs\n" unless $opt{quiet}; + if($opt{testmail}) { test_mail($cfg) }; + if($opt{listrrds}) { print "List of Round Robin Databases used by this implementation\n"; + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + foreach (@rrds) { + print "RRD: $_\n"; }; + } + if($opt{morning}) { morning_update($cfg) }; + if($opt{weekly}) { weekly_update($cfg) }; + exit 0; +} + +=head1 NAME + +tSmoke - Commandline tool for sending SmokePing information + +=head1 SYNOPSIS + +B [ B<--testmail> | B<--morning> | B<--weekly> | B<--version> | B<--help> | B<--man>] + + Options: + + --man Show the manpage + --help Help :-) + --version Show SmokePing Version + --testmail Send a test message + --listrrds List the RRDs used by this Smokeping + --morning Send a morning synopsis + --weekly Send a weekly status report + --to E-mail address to send message (i.e. '--to=xyz@company.com' + --detail How much detail to send in weekly report (i.e. '--detail=1') + --quiet Do not print welcome + +=head1 DESCRIPTION + +The B tool is a commandline tool which iterfaces with the SmokePing system. +Its main function is to send a message indicating the current status of the systems +being monitored by Smokeping or an HTML mail file containing the status over the past day, +past week and past month including an overview. + +Typical crontab used to invoke this are +# Quick morning alert to see what's down +0 6 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mobilephone@att.net --morning +# Weekly report on the percent availability of network systems with no detail +0 8 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mailbox@company.com --weekly --detail=0 + +=head1 SETUP + +When installing tSmoke, some variables must be adjusted to fit your local system. + +We need to use the following B: +# -- Smokeping +# -- RRDTool Perl bindings +# -- Getopt::Long + +# Set up your libraries +use lib "/usr/local/smokeping/lib"; +use lib "/usr/local/rrdtool-1.0.39/lib/perl"; + +# Add the B statements +use Smokeping; +use Net::SMTP; +use ISG::ParseConfig; +use Pod::Usage; +use RRDs; + +# Point to your Smokeping B file +my $cfgfile = "/usr/local/smokeping/etc/config"; + +# Modify the config file to include a path for tmail +tmail = /usr/local/smokeping/etc/tmail + +# Modify the General section of get_parser in Smokeping.pm to find the tmail file +[ qw(owner imgcache imgurl datadir piddir sendmail smokemail cgiurl mailhost contact syslogfacility syslogpriority tmail) ] + +=head1 COPYRIGHT + +Copyright (c) 2003 by Dan McGinn-Combs. All right 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. + +=head1 AUTHOR + +Dan McGinn-Combs Ed.mcginn-combs@mindspring.comE + +=cut diff --git a/etc/tmail b/etc/tmail new file mode 100644 index 0000000..ed90eea --- /dev/null +++ b/etc/tmail @@ -0,0 +1,132 @@ +MIME-Version: 1.0 +Content-Type: text/html + + + +IT System Availability Report + + + + + +
+Put your logo hereXXXX IT System Availability
+

+

+

+

+<##SUMMARY##> +

+

+ + + + + + + +
Quarterly DetailMonthly DetailWeekly DetailDaily Detail
+
+

+

+<##DAYDETAIL##> +
+

+

+<##WEEKDETAIL##> +
+

+

+<##MONTHDETAIL##> +
+

+

+<##QUARTERDETAIL##> +
+ diff --git a/tSmoke.v4.README b/tSmoke.v4.README new file mode 100644 index 0000000..cfc0799 --- /dev/null +++ b/tSmoke.v4.README @@ -0,0 +1,20 @@ +tSmoke.v04.README +- added downtime report (--downtime) +- a few tweaks to the calculations to ensure it's consistent + +tSmoke.v03.README +- Initial Release +- The script, started through cron, will cull through a config file and +determine which hosts are down at a point in time (Morning report) and +send out an smtp message to a mobile phone (for example). + +- It will also cull through the same config file and, using an included html +file (small change to General section of the config file), send an html +message which shows the availability over the past day, week, month +and quarter. + +- It can also show detail data depending on the setting of +command line option "detail". + +tSmoke.v02.README +- Local testing version \ No newline at end of file -- cgit v1.2.3-24-g4f1b From 02b65c3987f68a239c92376cbf24bc066a04d38d Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 26 May 2005 19:24:08 +0000 Subject: * tSmoke stuff; no testing done yet + 2.0/lib/Smokeping.pm: include config file support + 2.0/tSmoke.v4.README: integrate into tSmoke script + 2.0/bin/tSmoke.dist: * renamed from tSmoke.pl to tSmoke * installation instructions updated + 2.0/etc/tmail.dist: * renamed from 2.0/etc/tmail + 2.0/Makefile: * doc file generation --- Makefile | 6 +- bin/tSmoke.dist | 541 +++++++++++++++++++++++++++++++++++++++++++++++++++++ bin/tSmoke.pl.dist | 511 -------------------------------------------------- etc/tmail | 132 ------------- etc/tmail.dist | 132 +++++++++++++ lib/Smokeping.pm | 9 +- tSmoke.v4.README | 20 -- 7 files changed, 686 insertions(+), 665 deletions(-) create mode 100755 bin/tSmoke.dist delete mode 100755 bin/tSmoke.pl.dist delete mode 100644 etc/tmail create mode 100644 etc/tmail.dist delete mode 100644 tSmoke.v4.README diff --git a/Makefile b/Makefile index af579e4..c2584ed 100644 --- a/Makefile +++ b/Makefile @@ -17,7 +17,7 @@ DOCSBASE = $(subst .pod,,$(DOCS)) MODBASE = $(subst .pm,,$(subst lib/,doc/,$(PM))) \ $(subst .pm,,$(subst lib/,doc/,$(PODPROBE))) \ $(subst .pm,,$(subst lib/,doc/,$(PODMATCH))) -PROGBASE = doc/smokeping doc/smokeping.cgi +PROGBASE = doc/smokeping doc/smokeping.cgi doc/tSmoke DOCSCONFIGBASE = doc/smokeping_config BASE = $(DOCSBASE) $(MODBASE) $(PROGBASE) $(DOCSCONFIGBASE) @@ -59,6 +59,8 @@ doc/smokeping.1: bin/smokeping.dist $(POD2MAN) --section 1 > $@ doc/smokeping.cgi.1: htdocs/smokeping.cgi.dist $(POD2MAN) --section 1 > $@ +doc/tSmoke.1: bin/tSmoke.dist + $(POD2MAN) --section 1 > $@ doc/%.html: doc/%.pod $(POD2HTML) @@ -77,6 +79,8 @@ doc/smokeping.html: bin/smokeping.dist $(POD2HTML) doc/smokeping.cgi.html: htdocs/smokeping.cgi.dist $(POD2HTML) +doc/tSmoke.html: bin/tSmoke.dist + $(POD2HTML) doc/%.txt: doc/%.1 $(MAN2TXT) diff --git a/bin/tSmoke.dist b/bin/tSmoke.dist new file mode 100755 index 0000000..64e7658 --- /dev/null +++ b/bin/tSmoke.dist @@ -0,0 +1,541 @@ +#!/usr/bin/perl +# +#----------------------------------------------- +# tSmoke.pl +# Dan McGinn-Combs, Sep 2003 +# tSmoke.v 0.4 2004/03 McGinn-Combs +#----------------------------------------------- +# +# Modified for Smokeping official distribution since 20050526 +# Original README follows +# +# tSmoke.v04.README +# - added downtime report (--downtime) +# - a few tweaks to the calculations to ensure it's consistent +# +# tSmoke.v03.README +# - Initial Release +# - The script, started through cron, will cull through a config file and +# determine which hosts are down at a point in time (Morning report) and +# send out an smtp message to a mobile phone (for example). +# +# - It will also cull through the same config file and, using an included html +# file (small change to General section of the config file), send an html +# message which shows the availability over the past day, week, month +# and quarter. +# +# - It can also show detail data depending on the setting of +# command line option "detail". +# +# tSmoke.v02.README +# - Local testing version +#----------------------------------------------- +# +# 1) This program is run via CRON or the command line +# 2) It extracts RRD information from a smokeping config file +# 3) It pulls data from RRD files to determine if anything is offline, that is returning 0 PINGs +# 4) tSmoke reports status via an SMTP alert +# 5) tSmoke also generates an SMTP mail showing historical view of availability +# +# Many thanks to the following people for their help and guidance: +# Jim Horwath of Agere Systems Inc. for his examples and pointers to Spreadsheet::WriteExcel +# Frank Harper the author of SLAMon, a tool for tracking Service Level Agreements +# Tobias Oeticker, or course, the author of Smokeping, RRDTool and MRTG +# +use strict; + +# We need to use +# -- Smokeping libraries +# -- RRDTool +# -- Getopt::Long +# +# Point the lib variables to your implementation +use lib qw(lib); +use lib "/usr/local/rrdtool-1.0.39/lib/perl"; + +use Smokeping; +use Net::SMTP; +use Getopt::Long; +use Pod::Usage; +use RRDs; + +# Point to your Smokeping config file +my $cfgfile = "etc/config.dist"; + +# global variables +my $cfg; + +#this is designed to work on IPv4 only +my $havegetaddrinfo = 0; + +# we want opts everywhere +my %opt; + +#Hashes for the data +my (%Daily,%Weekly,%Monthly,%Quarterly); # the entries +my (%DailyC,%WeeklyC,%MonthlyC,%QuarterlyC); # a count of the entries + +###################### +### Moving Average ### +###################### +# Just a reminder of how to do a moving average if you ever want to +# PREV,UN,,UN,1,,IF,PREV,IF,,UN,1,,IF,-,,*,A,UN,1,A,IF,+ + +# Change Log: +# DMC - Added Quarterly Status +# DMC - Added HTML mail reporting and consolidated functions +# DMC = Added an external HTML mail template, tMail +my $RCS_VERSION = '$id: tSmoke.v 0.4 2004/03 McGinn-Combs'; + +sub test_mail($) { + my $cfg = shift; + print "Mail will be sent to $cfg->{Alerts}{to}\n"; + print "Mail will be sent from $cfg->{Alerts}{from}\n"; +}; + +sub sendmail ($$$$){ + my $from = shift; + my $to = shift; + my $subject = shift; + my $body = shift; + if ($cfg->{General}{mailhost}){ + my $smtp = Net::SMTP->new($cfg->{General}{mailhost}); + $smtp->mail($from); + $smtp->to($to); + $smtp->data(); + $smtp->datasend("Subject: $subject\n"); + $smtp->datasend("To: $to\n"); + $smtp->datasend($body); + $smtp->dataend(); + $smtp->quit; + } elsif ($cfg->{General}{sendmail} or -f "/usr/lib/sendmail"){ + open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to); + print M "Subject: $subject\n"; + print M $body; + close M; + } +} + +sub morning_update($) { + # Send out a morning summary of devices that are down + my $cfg = shift; + my $Body = ""; + my $TmpBody = ""; + my $To = ""; + if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } + + # Get a list of the existing RRD Files + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + my $Count = $#rrds + 1; + my $Down = 0; + + foreach my $target (@rrds) { + my $Loss = 0; + my ($start,$step,$names,$data) = RRDs::fetch "$target","AVERAGE","--start","-300"; + my $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + foreach my $line (@$data) { + $Loss += $$line[3]; + } + $Down += 1 if $Loss == 0; + $target =~ s/^([a-zA-Z0-9]*\/)*//; + $target =~ s/.rrd//; + $TmpBody .= "$target\n" if $Loss == 0; + } + $Body = "Of $Count Hosts, $Down Down:\n" . $TmpBody; + sendmail $cfg->{Alerts}{from},$To,"Of $Count Hosts, $Down Down",$Body; +} + +sub weekly_update($) { + # Send out a formatted HTML Table of the + # Previous Day, Week, Month and Quarter Availability + # Get a list of the existing RRD Files + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + + my $To = ""; + if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } + + my $Body =''; + +# Calculations Based on the following: +# RRDs::graph "fake.png", +# '--start','-86400', +# '-end','-300', +# "DEF:loss=${rrd}:loss:AVERAGE", +# "CDEF:avail=loss,0,100,IF", or more precisely "CDEF:avail=loss,2,GE,0,100,IF" +# and adding in the check for unknown for systems just coming on line +# "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF" + # Arbitrarily a loss of 10% of Pings means the system was down + my $pings = $cfg->{Database}{pings} * .1; + + foreach my $target (@rrds) { + # Get an average Availability for each RRD file + my $ERR; + + my ($DAverage,$Dxsize,$Dysize) = RRDs::graph "fake.png", + "--start","-86400", + "--end","-600", + "--step","1008", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($WAverage,$Wxsize,$Wysize) = RRDs::graph "fake.png", + "--start","-604800", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($MAverage,$Mxsize,$Mysize) = RRDs::graph "fake.png", + "--start","-2592000", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($QAverage,$Qxsize,$Qysize) = RRDs::graph "fake.png", + "--start","-7776000", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + $target =~ s/$cfg->{General}{datadir}\///; + $target =~ s/.rrd//; + my @Path; + push @Path,split/\//,$target; + update_stats ( \@Path, @$DAverage[0], @$WAverage[0], @$MAverage[0], @$QAverage[0]); + } + + # Prepare the e-mail message + open tSMOKE, $cfg->{General}{tmail} or die "ERROR: can't read $cfg->{General}{tmail}\n"; + while (){ + my $Summary = Summary_Sheet(); + s/<##SUMMARY##>/$Summary/ig; + my $Daily = DetailSheet(86400); + s/<##DAYDETAIL##>/$Daily/ig; + my $Weekly = DetailSheet(604800); + s/<##WEEKDETAIL##>/$Weekly/ig; + my $Monthly = DetailSheet(2592000); + s/<##MONTHDETAIL##>/$Monthly/ig; + my $Quarterly = DetailSheet(7776000); + s/<##QUARTERDETAIL##>/$Quarterly/ig; + $Body .= $_; + } + close tSMOKE; + sendmail ( $cfg->{Alerts}{from}, $To, "IT System Availability", $Body ); +} + +sub update_stats($$$$$); +sub update_stats($$$$$) { + # Update the uptime percentages in the Hash Arrays + my $Path = shift; + my $DAverage = shift; + my $WAverage = shift; + my $MAverage = shift; + my $QAverage = shift; + + #Enter everything once as it exists + #Trim off the rightmost component (hostname) and reenter the code + #If there is only one component, this is the final level + #This is an average of averages + + my $Ticket = join ( ".",@$Path); + $Daily { $Ticket } += $DAverage; + $Weekly { $Ticket } += $WAverage; + $Monthly { $Ticket } += $MAverage; + $Quarterly {$Ticket } += $QAverage; + $DailyC { $Ticket }++; + $WeeklyC { $Ticket }++; + $MonthlyC { $Ticket }++; + $QuarterlyC { $Ticket }++; + my $Length = @$Path; + @$Path = @$Path [ 0 .. $Length - 2 ]; + update_stats(\@$Path,$DAverage,$WAverage,$MAverage,$QAverage) if $Length > 1; +} + +sub Summary_Sheet() { + my $Body = ''; + + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= " + + + + \n"; + foreach (sort { $a cmp $b } keys %Monthly) { + next if ( $_ =~ /\./ ); + # this is a major section heading + $Body .= "\n"; + $Body .= ""; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} >= 99 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} > 95 and $Quarterly{$_}/$QuarterlyC{$_} < 99 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} > 90 and $Quarterly{$_}/$QuarterlyC{$_} < 95 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} < 90 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} >= 99 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} > 95 and $Monthly{$_}/$MonthlyC{$_} < 99 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} > 90 and $Monthly{$_}/$MonthlyC{$_} < 95 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} < 90 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} >= 99; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} > 95 and $Weekly{$_}/$WeeklyC{$_} < 99 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} > 90 and $Weekly{$_}/$WeeklyC{$_} < 95 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} < 90 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} >= 99; + $Body .= "" + if $Daily{$_}/$DailyC{$_} > 95 and $Daily{$_}/$DailyC{$_} < 99 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} > 90 and $Daily{$_}/$DailyC{$_} < 95 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} < 90 ; + $Body .= "\n"; + } + $Body .= "
IT Network Systems Availability Summary
Compiled: ". scalar(localtime) . "
ServicePast QuarterPast MonthPast WeekPast Day
$_" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%
"; + $Body .= "

\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "
Legend:
if uptime > 99% then GREEN
if uptime > 95% but < 99% then BLUE
if uptime > 90% but < 95% then YELLOW
if uptime < 90% then RED
\n"; + return $Body; +} + +sub NumDots($) { + # Count the number of dots in a string + # There's probably a better way to do this + my $DNA = shift; + my $a = 0; + while($DNA =~ /\./ig){$a++} + return $a +} + +sub DetailSheet($) { + # Populate the table with details depending on the value of %opts{detail} + my $Seconds = shift; + my $Body = ''; + + return '' unless $opt{detail}; + + # Monthly/Weekly/Daily + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= " + + \n"; + + my %CornBeef; + my %CornBeefC; + + CASE: { + %CornBeef = %Daily, %CornBeefC = %DailyC, print "Doing Daily\n", last CASE if $Seconds == 86400; + %CornBeef = %Weekly, %CornBeefC = %WeeklyC, print "Doing Weekly\n", last CASE if $Seconds == 604800; + %CornBeef = %Monthly, %CornBeefC = %MonthlyC, print "Doing Monthly\n", last CASE if $Seconds == 2592000; + %CornBeef = %Quarterly, %CornBeefC = %QuarterlyC, print "Doing Quarterly\n", last CASE if $Seconds == 7776000; + } # end of CASE block + + foreach (sort { $a cmp $b } keys %CornBeef ) { + next if NumDots ($_) > $opt{detail}; + if ( $_ =~ /\./ ) { + #this is a sub section + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + } else { + # this is a non-sub section + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= ""; + } + } + $Body .= "
IT Network Systems Availability Previous " . $Seconds/86400 . " Day(s)
Compiled: ". scalar(localtime) . "
ServiceSecondsPercent
$_" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
" . $_ . "" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
\n"; + return $Body; + } + +sub list_rrds($$$); +sub list_rrds($$$) { + # List the RRD's used by this configuration + my $tree = shift; + my $path = shift; + my $print = shift; + my $prline; + foreach my $rrds (keys %{$tree}) { + next if $rrds eq "PROBE_CONF"; + if (ref $tree->{$rrds} eq 'HASH'){ + $prline .= list_rrds( $tree->{$rrds}, $path."/$rrds", $print ); + } + if ($rrds eq 'host') { + $prline .= "$cfg->{General}{datadir}$path".".rrd\n"; + } + } + return $prline; +} + +sub load_cfg ($) { + my $cfgfile = shift; +# my $parser = get_parser; + my $parser = Smokeping::get_parser; + $cfg = Smokeping::get_config $parser, $cfgfile; +} + +########################################################################### +# The Main Program +########################################################################### + +sub main($); +main($cfgfile); + +sub main ($) { + umask 022; + my $cfgfile = shift; + my $sendto; + GetOptions(\%opt, 'quiet','version','testmail','listrrds','to=s','detail=n','morning','weekly','help','man') or pod2usage(2); + if($opt{version}) { print "$RCS_VERSION\n"; exit(0) }; + if($opt{help}) { pod2usage(-verbose => 1); exit 0 }; + if($opt{man}) { pod2usage(-verbose => 2); exit 0 }; + load_cfg $cfgfile; + print "tSmoke for network managed by $cfg->{General}{owner}\nat $cfg->{General}{contact}\n(c) 2003 Dan McGinn-Combs\n" unless $opt{quiet}; + if($opt{testmail}) { test_mail($cfg) }; + if($opt{listrrds}) { print "List of Round Robin Databases used by this implementation\n"; + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + foreach (@rrds) { + print "RRD: $_\n"; }; + } + if($opt{morning}) { morning_update($cfg) }; + if($opt{weekly}) { weekly_update($cfg) }; + exit 0; +} + +=head1 NAME + +tSmoke - Commandline tool for sending SmokePing information + +=head1 SYNOPSIS + +B [ B<--testmail> | B<--morning> | B<--weekly> | B<--version> | B<--help> | B<--man>] + + Options: + + --man Show the manpage + --help Help :-) + --version Show SmokePing Version + --testmail Send a test message + --listrrds List the RRDs used by this Smokeping + --morning Send a morning synopsis + --weekly Send a weekly status report + --to E-mail address to send message (i.e. '--to=xyz@company.com.invalid' + --detail How much detail to send in weekly report (i.e. '--detail=1') + --quiet Do not print welcome + +=head1 DESCRIPTION + +The B tool is a commandline tool which interfaces with the SmokePing system. +Its main function is to send a message indicating the current status of the systems +being monitored by Smokeping or an HTML mail file containing the status over the past day, +past week and past month including an overview. + +Typical crontab used to invoke this are + + # Quick morning alert to see what's down + 0 6 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mobilephone@att.net.invalid --morning + # Weekly report on the percent availability of network systems with no detail + 0 8 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mailbox@company.com.invalid --weekly --detail=0 + +=head1 SETUP + +When installing tSmoke, some variables must be adjusted to fit your local system. + +We need to use the following B: + +=over + +=item Smokeping + +=item RRDTool Perl bindings + +=item Getopt::Long + +=back + +Set up your libraries: + + use lib "/usr/local/smokeping/lib"; + use lib "/usr/local/rrdtool-1.0.39/lib/perl"; + +Point to your Smokeping B file + + my $cfgfile = "/usr/local/smokeping/etc/config"; + +Modify the Smokeping config file to include a path for tmail in the +General section: + + tmail = /usr/local/smokeping/etc/tmail + +=head1 COPYRIGHT + +Copyright (c) 2003 by Dan McGinn-Combs. All right 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. + +=head1 AUTHOR + +Dan McGinn-Combs Ed.mcginn-combs@mindspring.comE + +Modified for Smokeping official distribution by Niko Tyni Entyni@iki.fiE + +=cut + diff --git a/bin/tSmoke.pl.dist b/bin/tSmoke.pl.dist deleted file mode 100755 index 95a30bb..0000000 --- a/bin/tSmoke.pl.dist +++ /dev/null @@ -1,511 +0,0 @@ -#!/usr/bin/perl -# -#----------------------------------------------- -# tSmoke.pl -# Dan McGinn-Combs, Sep 2003 -# tSmoke.v 0.4 2004/03 McGinn-Combs -#----------------------------------------------- -# -# 1) This program is run via CRON or the command line -# 2) It extracts RRD information from a smokeping config file -# 3) It pulls data from RRD files to determine if anything is offline, that is returning 0 PINGs -# 4) tSmoke reports status via an SMTP alert -# 5) tSmoke also generates an SMTP mail showing historical view of availability -# -# Many thanks to the following people for their help and guidance: -# Jim Horwath of Agere Systems Inc. for his examples and pointers to Spreadsheet::WriteExcel -# Frank Harper the author of SLAMon, a tool for tracking Service Level Agreements -# Tobias Oeticker, or course, the author of Smokeping, RRDTool and MRTG -# -use strict; - -# We need to use -# -- Smokeping libraries -# -- RRDTool -# -- Getopt::Long -# -# Point the lib variables to your implementation -use lib "/usr/local/smokeping/lib"; -use lib "/usr/local/rrdtool-1.0.39/lib/perl"; -use Smokeping; -use Net::SMTP; -use ISG::ParseConfig; -use Getopt::Long; -use Pod::Usage; -use RRDs; - -# Point to your Smokeping config file -my $cfgfile = "/usr/local/smokeping/etc/config"; - -# global variables -my $cfg; - -#this is designed to work on IPv4 only -my $havegetaddrinfo = 0; - -# we want opts everywhere -my %opt; - -#Hashes for the data -my (%Daily,%Weekly,%Monthly,%Quarterly); # the entries -my (%DailyC,%WeeklyC,%MonthlyC,%QuarterlyC); # a count of the entries - -###################### -### Moving Average ### -###################### -# Just a reminder of how to do a moving average if you ever want to -# PREV,UN,,UN,1,,IF,PREV,IF,,UN,1,,IF,-,,*,A,UN,1,A,IF,+ - -# Change Log: -# DMC - Added Quarterly Status -# DMC - Added HTML mail reporting and consolidated functions -# DMC = Added an external HTML mail template, tMail -my $RCS_VERSION = '$id: tSmoke.v 0.4 2004/03 McGinn-Combs'; - -sub test_mail($) { - my $cfg = shift; - print "Mail will be sent to $cfg->{Alerts}{to}\n"; - print "Mail will be sent from $cfg->{Alerts}{from}\n"; -}; - -sub sendmail ($$$$){ - my $from = shift; - my $to = shift; - my $subject = shift; - my $body = shift; - if ($cfg->{General}{mailhost}){ - my $smtp = Net::SMTP->new($cfg->{General}{mailhost}); - $smtp->mail($from); - $smtp->to($to); - $smtp->data(); - $smtp->datasend("Subject: $subject\n"); - $smtp->datasend("To: $to\n"); - $smtp->datasend($body); - $smtp->dataend(); - $smtp->quit; - } elsif ($cfg->{General}{sendmail} or -f "/usr/lib/sendmail"){ - open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to); - print M "Subject: $subject\n"; - print M $body; - close M; - } -} - -sub morning_update($) { - # Send out a morning summary of devices that are down - my $cfg = shift; - my $Body = ""; - my $TmpBody = ""; - my $To = ""; - if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } - - # Get a list of the existing RRD Files - my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); - my $Count = $#rrds + 1; - my $Down = 0; - - foreach my $target (@rrds) { - my $Loss = 0; - my ($start,$step,$names,$data) = RRDs::fetch "$target","AVERAGE","--start","-300"; - my $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - foreach my $line (@$data) { - $Loss += $$line[3]; - } - $Down += 1 if $Loss == 0; - $target =~ s/^([a-zA-Z0-9]*\/)*//; - $target =~ s/.rrd//; - $TmpBody .= "$target\n" if $Loss == 0; - } - $Body = "Of $Count Hosts, $Down Down:\n" . $TmpBody; - sendmail $cfg->{Alerts}{from},$To,"Of $Count Hosts, $Down Down",$Body; -} - -sub weekly_update($) { - # Send out a formatted HTML Table of the - # Previous Day, Week, Month and Quarter Availability - # Get a list of the existing RRD Files - my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); - - my $To = ""; - if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } - - my $Body =''; - -# Calculations Based on the following: -# RRDs::graph "fake.png", -# '--start','-86400', -# '-end','-300', -# "DEF:loss=${rrd}:loss:AVERAGE", -# "CDEF:avail=loss,0,100,IF", or more precisely "CDEF:avail=loss,2,GE,0,100,IF" -# and adding in the check for unknown for systems just coming on line -# "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF" - # Arbitrarily a loss of 10% of Pings means the system was down - my $pings = $cfg->{Database}{pings} * .1; - - foreach my $target (@rrds) { - # Get an average Availability for each RRD file - my $ERR; - - my ($DAverage,$Dxsize,$Dysize) = RRDs::graph "fake.png", - "--start","-86400", - "--end","-600", - "--step","1008", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - my ($WAverage,$Wxsize,$Wysize) = RRDs::graph "fake.png", - "--start","-604800", - "--end","-600", - "--step","4320", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - my ($MAverage,$Mxsize,$Mysize) = RRDs::graph "fake.png", - "--start","-2592000", - "--end","-600", - "--step","4320", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - my ($QAverage,$Qxsize,$Qysize) = RRDs::graph "fake.png", - "--start","-7776000", - "--end","-600", - "--step","4320", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - $target =~ s/$cfg->{General}{datadir}\///; - $target =~ s/.rrd//; - my @Path; - push @Path,split/\//,$target; - update_stats ( \@Path, @$DAverage[0], @$WAverage[0], @$MAverage[0], @$QAverage[0]); - } - - # Prepare the e-mail message - open tSMOKE, $cfg->{General}{tmail} or die "ERROR: can't read $cfg->{General}{tmail}\n"; - while (){ - my $Summary = Summary_Sheet(); - s/<##SUMMARY##>/$Summary/ig; - my $Daily = DetailSheet(86400); - s/<##DAYDETAIL##>/$Daily/ig; - my $Weekly = DetailSheet(604800); - s/<##WEEKDETAIL##>/$Weekly/ig; - my $Monthly = DetailSheet(2592000); - s/<##MONTHDETAIL##>/$Monthly/ig; - my $Quarterly = DetailSheet(7776000); - s/<##QUARTERDETAIL##>/$Quarterly/ig; - $Body .= $_; - } - close tSMOKE; - sendmail ( $cfg->{Alerts}{from}, $To, "IT System Availability", $Body ); -} - -sub update_stats($$$$$); -sub update_stats($$$$$) { - # Update the uptime percentages in the Hash Arrays - my $Path = shift; - my $DAverage = shift; - my $WAverage = shift; - my $MAverage = shift; - my $QAverage = shift; - - #Enter everything once as it exists - #Trim off the rightmost component (hostname) and reenter the code - #If there is only one component, this is the final level - #This is an average of averages - - my $Ticket = join ( ".",@$Path); - $Daily { $Ticket } += $DAverage; - $Weekly { $Ticket } += $WAverage; - $Monthly { $Ticket } += $MAverage; - $Quarterly {$Ticket } += $QAverage; - $DailyC { $Ticket }++; - $WeeklyC { $Ticket }++; - $MonthlyC { $Ticket }++; - $QuarterlyC { $Ticket }++; - my $Length = @$Path; - @$Path = @$Path [ 0 .. $Length - 2 ]; - update_stats(\@$Path,$DAverage,$WAverage,$MAverage,$QAverage) if $Length > 1; -} - -sub Summary_Sheet() { - my $Body = ''; - - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= " - - - - \n"; - foreach (sort { $a cmp $b } keys %Monthly) { - next if ( $_ =~ /\./ ); - # this is a major section heading - $Body .= "\n"; - $Body .= ""; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} >= 99 ; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} > 95 and $Quarterly{$_}/$QuarterlyC{$_} < 99 ; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} > 90 and $Quarterly{$_}/$QuarterlyC{$_} < 95 ; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} < 90 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} >= 99 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} > 95 and $Monthly{$_}/$MonthlyC{$_} < 99 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} > 90 and $Monthly{$_}/$MonthlyC{$_} < 95 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} < 90 ; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} >= 99; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} > 95 and $Weekly{$_}/$WeeklyC{$_} < 99 ; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} > 90 and $Weekly{$_}/$WeeklyC{$_} < 95 ; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} < 90 ; - $Body .= "" - if $Daily{$_}/$DailyC{$_} >= 99; - $Body .= "" - if $Daily{$_}/$DailyC{$_} > 95 and $Daily{$_}/$DailyC{$_} < 99 ; - $Body .= "" - if $Daily{$_}/$DailyC{$_} > 90 and $Daily{$_}/$DailyC{$_} < 95 ; - $Body .= "" - if $Daily{$_}/$DailyC{$_} < 90 ; - $Body .= "\n"; - } - $Body .= "
IT Network Systems Availability Summary
Compiled: ". scalar(localtime) . "
ServicePast QuarterPast MonthPast WeekPast Day
$_" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%
"; - $Body .= "

\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "
Legend:
if uptime > 99% then GREEN
if uptime > 95% but < 99% then BLUE
if uptime > 90% but < 95% then YELLOW
if uptime < 90% then RED
\n"; - return $Body; -} - -sub NumDots($) { - # Count the number of dots in a string - # There's probably a better way to do this - my $DNA = shift; - my $a = 0; - while($DNA =~ /\./ig){$a++} - return $a -} - -sub DetailSheet($) { - # Populate the table with details depending on the value of %opts{detail} - my $Seconds = shift; - my $Body = ''; - - return '' unless $opt{detail}; - - # Monthly/Weekly/Daily - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= " - - \n"; - - my %CornBeef; - my %CornBeefC; - - CASE: { - %CornBeef = %Daily, %CornBeefC = %DailyC, print "Doing Daily\n", last CASE if $Seconds == 86400; - %CornBeef = %Weekly, %CornBeefC = %WeeklyC, print "Doing Weekly\n", last CASE if $Seconds == 604800; - %CornBeef = %Monthly, %CornBeefC = %MonthlyC, print "Doing Monthly\n", last CASE if $Seconds == 2592000; - %CornBeef = %Quarterly, %CornBeefC = %QuarterlyC, print "Doing Quarterly\n", last CASE if $Seconds == 7776000; - } # end of CASE block - - foreach (sort { $a cmp $b } keys %CornBeef ) { - next if NumDots ($_) > $opt{detail}; - if ( $_ =~ /\./ ) { - #this is a sub section - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - } else { - # this is a non-sub section - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= ""; - } - } - $Body .= "
IT Network Systems Availability Previous " . $Seconds/86400 . " Day(s)
Compiled: ". scalar(localtime) . "
ServiceSecondsPercent
$_" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
" . $_ . "" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
\n"; - return $Body; - } - -sub list_rrds($$$); -sub list_rrds($$$) { - # List the RRD's used by this configuration - my $tree = shift; - my $path = shift; - my $print = shift; - my $prline; - foreach my $rrds (keys %{$tree}) { - next if $rrds eq "PROBE_CONF"; - if (ref $tree->{$rrds} eq 'HASH'){ - $prline .= list_rrds( $tree->{$rrds}, $path."/$rrds", $print ); - } - if ($rrds eq 'host') { - $prline .= "$cfg->{General}{datadir}$path".".rrd\n"; - } - } - return $prline; -} - -sub load_cfg ($) { - my $cfgfile = shift; -# my $parser = get_parser; - my $parser = Smokeping::get_parser; - $cfg = Smokeping::get_config $parser, $cfgfile; -} - -########################################################################### -# The Main Program -########################################################################### - -sub main($); -main($cfgfile); - -sub main ($) { - umask 022; - my $cfgfile = shift; - my $sendto; - GetOptions(\%opt, 'quiet','version','testmail','listrrds','to=s','detail=n','morning','weekly','help','man') or pod2usage(2); - if($opt{version}) { print "$RCS_VERSION\n"; exit(0) }; - if($opt{help}) { pod2usage(-verbose => 1); exit 0 }; - if($opt{man}) { pod2usage(-verbose => 2); exit 0 }; - load_cfg $cfgfile; - print "tSmoke for network managed by $cfg->{General}{owner}\nat $cfg->{General}{contact}\n(c) 2003 Dan McGinn-Combs\n" unless $opt{quiet}; - if($opt{testmail}) { test_mail($cfg) }; - if($opt{listrrds}) { print "List of Round Robin Databases used by this implementation\n"; - my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); - foreach (@rrds) { - print "RRD: $_\n"; }; - } - if($opt{morning}) { morning_update($cfg) }; - if($opt{weekly}) { weekly_update($cfg) }; - exit 0; -} - -=head1 NAME - -tSmoke - Commandline tool for sending SmokePing information - -=head1 SYNOPSIS - -B [ B<--testmail> | B<--morning> | B<--weekly> | B<--version> | B<--help> | B<--man>] - - Options: - - --man Show the manpage - --help Help :-) - --version Show SmokePing Version - --testmail Send a test message - --listrrds List the RRDs used by this Smokeping - --morning Send a morning synopsis - --weekly Send a weekly status report - --to E-mail address to send message (i.e. '--to=xyz@company.com' - --detail How much detail to send in weekly report (i.e. '--detail=1') - --quiet Do not print welcome - -=head1 DESCRIPTION - -The B tool is a commandline tool which iterfaces with the SmokePing system. -Its main function is to send a message indicating the current status of the systems -being monitored by Smokeping or an HTML mail file containing the status over the past day, -past week and past month including an overview. - -Typical crontab used to invoke this are -# Quick morning alert to see what's down -0 6 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mobilephone@att.net --morning -# Weekly report on the percent availability of network systems with no detail -0 8 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mailbox@company.com --weekly --detail=0 - -=head1 SETUP - -When installing tSmoke, some variables must be adjusted to fit your local system. - -We need to use the following B: -# -- Smokeping -# -- RRDTool Perl bindings -# -- Getopt::Long - -# Set up your libraries -use lib "/usr/local/smokeping/lib"; -use lib "/usr/local/rrdtool-1.0.39/lib/perl"; - -# Add the B statements -use Smokeping; -use Net::SMTP; -use ISG::ParseConfig; -use Pod::Usage; -use RRDs; - -# Point to your Smokeping B file -my $cfgfile = "/usr/local/smokeping/etc/config"; - -# Modify the config file to include a path for tmail -tmail = /usr/local/smokeping/etc/tmail - -# Modify the General section of get_parser in Smokeping.pm to find the tmail file -[ qw(owner imgcache imgurl datadir piddir sendmail smokemail cgiurl mailhost contact syslogfacility syslogpriority tmail) ] - -=head1 COPYRIGHT - -Copyright (c) 2003 by Dan McGinn-Combs. All right 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. - -=head1 AUTHOR - -Dan McGinn-Combs Ed.mcginn-combs@mindspring.comE - -=cut diff --git a/etc/tmail b/etc/tmail deleted file mode 100644 index ed90eea..0000000 --- a/etc/tmail +++ /dev/null @@ -1,132 +0,0 @@ -MIME-Version: 1.0 -Content-Type: text/html - - - -IT System Availability Report - - - - - -
-Put your logo hereXXXX IT System Availability
-

-

-

-

-<##SUMMARY##> -

-

- - - - - - - -
Quarterly DetailMonthly DetailWeekly DetailDaily Detail
-
-

-

-<##DAYDETAIL##> -
-

-

-<##WEEKDETAIL##> -
-

-

-<##MONTHDETAIL##> -
-

-

-<##QUARTERDETAIL##> -
- diff --git a/etc/tmail.dist b/etc/tmail.dist new file mode 100644 index 0000000..ed90eea --- /dev/null +++ b/etc/tmail.dist @@ -0,0 +1,132 @@ +MIME-Version: 1.0 +Content-Type: text/html + + + +IT System Availability Report + + + + + +
+Put your logo hereXXXX IT System Availability
+

+

+

+

+<##SUMMARY##> +

+

+ + + + + + + +
Quarterly DetailMonthly DetailWeekly DetailDaily Detail
+
+

+

+<##DAYDETAIL##> +
+

+

+<##WEEKDETAIL##> +
+

+

+<##MONTHDETAIL##> +
+

+

+<##QUARTERDETAIL##> +
+ diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 7be666d..46545a0 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -1555,7 +1555,7 @@ DOC _vars => [ qw(owner imgcache imgurl datadir 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) ], @@ -1714,6 +1714,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 => < { diff --git a/tSmoke.v4.README b/tSmoke.v4.README deleted file mode 100644 index cfc0799..0000000 --- a/tSmoke.v4.README +++ /dev/null @@ -1,20 +0,0 @@ -tSmoke.v04.README -- added downtime report (--downtime) -- a few tweaks to the calculations to ensure it's consistent - -tSmoke.v03.README -- Initial Release -- The script, started through cron, will cull through a config file and -determine which hosts are down at a point in time (Morning report) and -send out an smtp message to a mobile phone (for example). - -- It will also cull through the same config file and, using an included html -file (small change to General section of the config file), send an html -message which shows the availability over the past day, week, month -and quarter. - -- It can also show detail data depending on the setting of -command line option "detail". - -tSmoke.v02.README -- Local testing version \ No newline at end of file -- cgit v1.2.3-24-g4f1b From 8a4ec2a4345c457fca47a1a7e2b4f40d2cf6fea5 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 31 May 2005 19:18:17 +0000 Subject: Delete trailing DOS newlines from tSmoke files. --- bin/tSmoke.dist | 1082 +++++++++++++++++++++++++++---------------------------- etc/tmail.dist | 264 +++++++------- 2 files changed, 673 insertions(+), 673 deletions(-) diff --git a/bin/tSmoke.dist b/bin/tSmoke.dist index 64e7658..487ce30 100755 --- a/bin/tSmoke.dist +++ b/bin/tSmoke.dist @@ -1,541 +1,541 @@ -#!/usr/bin/perl -# -#----------------------------------------------- -# tSmoke.pl -# Dan McGinn-Combs, Sep 2003 -# tSmoke.v 0.4 2004/03 McGinn-Combs -#----------------------------------------------- -# -# Modified for Smokeping official distribution since 20050526 -# Original README follows -# -# tSmoke.v04.README -# - added downtime report (--downtime) -# - a few tweaks to the calculations to ensure it's consistent -# -# tSmoke.v03.README -# - Initial Release -# - The script, started through cron, will cull through a config file and -# determine which hosts are down at a point in time (Morning report) and -# send out an smtp message to a mobile phone (for example). -# -# - It will also cull through the same config file and, using an included html -# file (small change to General section of the config file), send an html -# message which shows the availability over the past day, week, month -# and quarter. -# -# - It can also show detail data depending on the setting of -# command line option "detail". -# -# tSmoke.v02.README -# - Local testing version -#----------------------------------------------- -# -# 1) This program is run via CRON or the command line -# 2) It extracts RRD information from a smokeping config file -# 3) It pulls data from RRD files to determine if anything is offline, that is returning 0 PINGs -# 4) tSmoke reports status via an SMTP alert -# 5) tSmoke also generates an SMTP mail showing historical view of availability -# -# Many thanks to the following people for their help and guidance: -# Jim Horwath of Agere Systems Inc. for his examples and pointers to Spreadsheet::WriteExcel -# Frank Harper the author of SLAMon, a tool for tracking Service Level Agreements -# Tobias Oeticker, or course, the author of Smokeping, RRDTool and MRTG -# -use strict; - -# We need to use -# -- Smokeping libraries -# -- RRDTool -# -- Getopt::Long -# -# Point the lib variables to your implementation -use lib qw(lib); -use lib "/usr/local/rrdtool-1.0.39/lib/perl"; - -use Smokeping; -use Net::SMTP; -use Getopt::Long; -use Pod::Usage; -use RRDs; - -# Point to your Smokeping config file -my $cfgfile = "etc/config.dist"; - -# global variables -my $cfg; - -#this is designed to work on IPv4 only -my $havegetaddrinfo = 0; - -# we want opts everywhere -my %opt; - -#Hashes for the data -my (%Daily,%Weekly,%Monthly,%Quarterly); # the entries -my (%DailyC,%WeeklyC,%MonthlyC,%QuarterlyC); # a count of the entries - -###################### -### Moving Average ### -###################### -# Just a reminder of how to do a moving average if you ever want to -# PREV,UN,,UN,1,,IF,PREV,IF,,UN,1,,IF,-,,*,A,UN,1,A,IF,+ - -# Change Log: -# DMC - Added Quarterly Status -# DMC - Added HTML mail reporting and consolidated functions -# DMC = Added an external HTML mail template, tMail -my $RCS_VERSION = '$id: tSmoke.v 0.4 2004/03 McGinn-Combs'; - -sub test_mail($) { - my $cfg = shift; - print "Mail will be sent to $cfg->{Alerts}{to}\n"; - print "Mail will be sent from $cfg->{Alerts}{from}\n"; -}; - -sub sendmail ($$$$){ - my $from = shift; - my $to = shift; - my $subject = shift; - my $body = shift; - if ($cfg->{General}{mailhost}){ - my $smtp = Net::SMTP->new($cfg->{General}{mailhost}); - $smtp->mail($from); - $smtp->to($to); - $smtp->data(); - $smtp->datasend("Subject: $subject\n"); - $smtp->datasend("To: $to\n"); - $smtp->datasend($body); - $smtp->dataend(); - $smtp->quit; - } elsif ($cfg->{General}{sendmail} or -f "/usr/lib/sendmail"){ - open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to); - print M "Subject: $subject\n"; - print M $body; - close M; - } -} - -sub morning_update($) { - # Send out a morning summary of devices that are down - my $cfg = shift; - my $Body = ""; - my $TmpBody = ""; - my $To = ""; - if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } - - # Get a list of the existing RRD Files - my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); - my $Count = $#rrds + 1; - my $Down = 0; - - foreach my $target (@rrds) { - my $Loss = 0; - my ($start,$step,$names,$data) = RRDs::fetch "$target","AVERAGE","--start","-300"; - my $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - foreach my $line (@$data) { - $Loss += $$line[3]; - } - $Down += 1 if $Loss == 0; - $target =~ s/^([a-zA-Z0-9]*\/)*//; - $target =~ s/.rrd//; - $TmpBody .= "$target\n" if $Loss == 0; - } - $Body = "Of $Count Hosts, $Down Down:\n" . $TmpBody; - sendmail $cfg->{Alerts}{from},$To,"Of $Count Hosts, $Down Down",$Body; -} - -sub weekly_update($) { - # Send out a formatted HTML Table of the - # Previous Day, Week, Month and Quarter Availability - # Get a list of the existing RRD Files - my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); - - my $To = ""; - if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } - - my $Body =''; - -# Calculations Based on the following: -# RRDs::graph "fake.png", -# '--start','-86400', -# '-end','-300', -# "DEF:loss=${rrd}:loss:AVERAGE", -# "CDEF:avail=loss,0,100,IF", or more precisely "CDEF:avail=loss,2,GE,0,100,IF" -# and adding in the check for unknown for systems just coming on line -# "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF" - # Arbitrarily a loss of 10% of Pings means the system was down - my $pings = $cfg->{Database}{pings} * .1; - - foreach my $target (@rrds) { - # Get an average Availability for each RRD file - my $ERR; - - my ($DAverage,$Dxsize,$Dysize) = RRDs::graph "fake.png", - "--start","-86400", - "--end","-600", - "--step","1008", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - my ($WAverage,$Wxsize,$Wysize) = RRDs::graph "fake.png", - "--start","-604800", - "--end","-600", - "--step","4320", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - my ($MAverage,$Mxsize,$Mysize) = RRDs::graph "fake.png", - "--start","-2592000", - "--end","-600", - "--step","4320", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - my ($QAverage,$Qxsize,$Qysize) = RRDs::graph "fake.png", - "--start","-7776000", - "--end","-600", - "--step","4320", - "DEF:loss=$target:loss:AVERAGE", - "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", - "PRINT:avail:AVERAGE:%.2lf"; - $ERR=RRDs::error; - die "ERROR while reading $_: $ERR\n" if $ERR; - - $target =~ s/$cfg->{General}{datadir}\///; - $target =~ s/.rrd//; - my @Path; - push @Path,split/\//,$target; - update_stats ( \@Path, @$DAverage[0], @$WAverage[0], @$MAverage[0], @$QAverage[0]); - } - - # Prepare the e-mail message - open tSMOKE, $cfg->{General}{tmail} or die "ERROR: can't read $cfg->{General}{tmail}\n"; - while (){ - my $Summary = Summary_Sheet(); - s/<##SUMMARY##>/$Summary/ig; - my $Daily = DetailSheet(86400); - s/<##DAYDETAIL##>/$Daily/ig; - my $Weekly = DetailSheet(604800); - s/<##WEEKDETAIL##>/$Weekly/ig; - my $Monthly = DetailSheet(2592000); - s/<##MONTHDETAIL##>/$Monthly/ig; - my $Quarterly = DetailSheet(7776000); - s/<##QUARTERDETAIL##>/$Quarterly/ig; - $Body .= $_; - } - close tSMOKE; - sendmail ( $cfg->{Alerts}{from}, $To, "IT System Availability", $Body ); -} - -sub update_stats($$$$$); -sub update_stats($$$$$) { - # Update the uptime percentages in the Hash Arrays - my $Path = shift; - my $DAverage = shift; - my $WAverage = shift; - my $MAverage = shift; - my $QAverage = shift; - - #Enter everything once as it exists - #Trim off the rightmost component (hostname) and reenter the code - #If there is only one component, this is the final level - #This is an average of averages - - my $Ticket = join ( ".",@$Path); - $Daily { $Ticket } += $DAverage; - $Weekly { $Ticket } += $WAverage; - $Monthly { $Ticket } += $MAverage; - $Quarterly {$Ticket } += $QAverage; - $DailyC { $Ticket }++; - $WeeklyC { $Ticket }++; - $MonthlyC { $Ticket }++; - $QuarterlyC { $Ticket }++; - my $Length = @$Path; - @$Path = @$Path [ 0 .. $Length - 2 ]; - update_stats(\@$Path,$DAverage,$WAverage,$MAverage,$QAverage) if $Length > 1; -} - -sub Summary_Sheet() { - my $Body = ''; - - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= " - - - - \n"; - foreach (sort { $a cmp $b } keys %Monthly) { - next if ( $_ =~ /\./ ); - # this is a major section heading - $Body .= "\n"; - $Body .= ""; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} >= 99 ; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} > 95 and $Quarterly{$_}/$QuarterlyC{$_} < 99 ; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} > 90 and $Quarterly{$_}/$QuarterlyC{$_} < 95 ; - $Body .= "" - if $Quarterly{$_}/$QuarterlyC{$_} < 90 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} >= 99 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} > 95 and $Monthly{$_}/$MonthlyC{$_} < 99 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} > 90 and $Monthly{$_}/$MonthlyC{$_} < 95 ; - $Body .= "" - if $Monthly{$_}/$MonthlyC{$_} < 90 ; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} >= 99; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} > 95 and $Weekly{$_}/$WeeklyC{$_} < 99 ; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} > 90 and $Weekly{$_}/$WeeklyC{$_} < 95 ; - $Body .= "" - if $Weekly{$_}/$WeeklyC{$_} < 90 ; - $Body .= "" - if $Daily{$_}/$DailyC{$_} >= 99; - $Body .= "" - if $Daily{$_}/$DailyC{$_} > 95 and $Daily{$_}/$DailyC{$_} < 99 ; - $Body .= "" - if $Daily{$_}/$DailyC{$_} > 90 and $Daily{$_}/$DailyC{$_} < 95 ; - $Body .= "" - if $Daily{$_}/$DailyC{$_} < 90 ; - $Body .= "\n"; - } - $Body .= "
IT Network Systems Availability Summary
Compiled: ". scalar(localtime) . "
ServicePast QuarterPast MonthPast WeekPast Day
$_" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%
"; - $Body .= "

\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "
Legend:
if uptime > 99% then GREEN
if uptime > 95% but < 99% then BLUE
if uptime > 90% but < 95% then YELLOW
if uptime < 90% then RED
\n"; - return $Body; -} - -sub NumDots($) { - # Count the number of dots in a string - # There's probably a better way to do this - my $DNA = shift; - my $a = 0; - while($DNA =~ /\./ig){$a++} - return $a -} - -sub DetailSheet($) { - # Populate the table with details depending on the value of %opts{detail} - my $Seconds = shift; - my $Body = ''; - - return '' unless $opt{detail}; - - # Monthly/Weekly/Daily - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= " - - \n"; - - my %CornBeef; - my %CornBeefC; - - CASE: { - %CornBeef = %Daily, %CornBeefC = %DailyC, print "Doing Daily\n", last CASE if $Seconds == 86400; - %CornBeef = %Weekly, %CornBeefC = %WeeklyC, print "Doing Weekly\n", last CASE if $Seconds == 604800; - %CornBeef = %Monthly, %CornBeefC = %MonthlyC, print "Doing Monthly\n", last CASE if $Seconds == 2592000; - %CornBeef = %Quarterly, %CornBeefC = %QuarterlyC, print "Doing Quarterly\n", last CASE if $Seconds == 7776000; - } # end of CASE block - - foreach (sort { $a cmp $b } keys %CornBeef ) { - next if NumDots ($_) > $opt{detail}; - if ( $_ =~ /\./ ) { - #this is a sub section - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - } else { - # this is a non-sub section - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= "\n"; - $Body .= ""; - } - } - $Body .= "
IT Network Systems Availability Previous " . $Seconds/86400 . " Day(s)
Compiled: ". scalar(localtime) . "
ServiceSecondsPercent
$_" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
" . $_ . "" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
\n"; - return $Body; - } - -sub list_rrds($$$); -sub list_rrds($$$) { - # List the RRD's used by this configuration - my $tree = shift; - my $path = shift; - my $print = shift; - my $prline; - foreach my $rrds (keys %{$tree}) { - next if $rrds eq "PROBE_CONF"; - if (ref $tree->{$rrds} eq 'HASH'){ - $prline .= list_rrds( $tree->{$rrds}, $path."/$rrds", $print ); - } - if ($rrds eq 'host') { - $prline .= "$cfg->{General}{datadir}$path".".rrd\n"; - } - } - return $prline; -} - -sub load_cfg ($) { - my $cfgfile = shift; -# my $parser = get_parser; - my $parser = Smokeping::get_parser; - $cfg = Smokeping::get_config $parser, $cfgfile; -} - -########################################################################### -# The Main Program -########################################################################### - -sub main($); -main($cfgfile); - -sub main ($) { - umask 022; - my $cfgfile = shift; - my $sendto; - GetOptions(\%opt, 'quiet','version','testmail','listrrds','to=s','detail=n','morning','weekly','help','man') or pod2usage(2); - if($opt{version}) { print "$RCS_VERSION\n"; exit(0) }; - if($opt{help}) { pod2usage(-verbose => 1); exit 0 }; - if($opt{man}) { pod2usage(-verbose => 2); exit 0 }; - load_cfg $cfgfile; - print "tSmoke for network managed by $cfg->{General}{owner}\nat $cfg->{General}{contact}\n(c) 2003 Dan McGinn-Combs\n" unless $opt{quiet}; - if($opt{testmail}) { test_mail($cfg) }; - if($opt{listrrds}) { print "List of Round Robin Databases used by this implementation\n"; - my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); - foreach (@rrds) { - print "RRD: $_\n"; }; - } - if($opt{morning}) { morning_update($cfg) }; - if($opt{weekly}) { weekly_update($cfg) }; - exit 0; -} - -=head1 NAME - -tSmoke - Commandline tool for sending SmokePing information - -=head1 SYNOPSIS - -B [ B<--testmail> | B<--morning> | B<--weekly> | B<--version> | B<--help> | B<--man>] - - Options: - - --man Show the manpage - --help Help :-) - --version Show SmokePing Version - --testmail Send a test message - --listrrds List the RRDs used by this Smokeping - --morning Send a morning synopsis - --weekly Send a weekly status report - --to E-mail address to send message (i.e. '--to=xyz@company.com.invalid' - --detail How much detail to send in weekly report (i.e. '--detail=1') - --quiet Do not print welcome - -=head1 DESCRIPTION - -The B tool is a commandline tool which interfaces with the SmokePing system. -Its main function is to send a message indicating the current status of the systems -being monitored by Smokeping or an HTML mail file containing the status over the past day, -past week and past month including an overview. - -Typical crontab used to invoke this are - - # Quick morning alert to see what's down - 0 6 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mobilephone@att.net.invalid --morning - # Weekly report on the percent availability of network systems with no detail - 0 8 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mailbox@company.com.invalid --weekly --detail=0 - -=head1 SETUP - -When installing tSmoke, some variables must be adjusted to fit your local system. - -We need to use the following B: - -=over - -=item Smokeping - -=item RRDTool Perl bindings - -=item Getopt::Long - -=back - -Set up your libraries: - - use lib "/usr/local/smokeping/lib"; - use lib "/usr/local/rrdtool-1.0.39/lib/perl"; - -Point to your Smokeping B file - - my $cfgfile = "/usr/local/smokeping/etc/config"; - -Modify the Smokeping config file to include a path for tmail in the -General section: - - tmail = /usr/local/smokeping/etc/tmail - -=head1 COPYRIGHT - -Copyright (c) 2003 by Dan McGinn-Combs. All right 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. - -=head1 AUTHOR - -Dan McGinn-Combs Ed.mcginn-combs@mindspring.comE - -Modified for Smokeping official distribution by Niko Tyni Entyni@iki.fiE - -=cut - +#!/usr/bin/perl +# +#----------------------------------------------- +# tSmoke.pl +# Dan McGinn-Combs, Sep 2003 +# tSmoke.v 0.4 2004/03 McGinn-Combs +#----------------------------------------------- +# +# Modified for Smokeping official distribution since 20050526 +# Original README follows +# +# tSmoke.v04.README +# - added downtime report (--downtime) +# - a few tweaks to the calculations to ensure it's consistent +# +# tSmoke.v03.README +# - Initial Release +# - The script, started through cron, will cull through a config file and +# determine which hosts are down at a point in time (Morning report) and +# send out an smtp message to a mobile phone (for example). +# +# - It will also cull through the same config file and, using an included html +# file (small change to General section of the config file), send an html +# message which shows the availability over the past day, week, month +# and quarter. +# +# - It can also show detail data depending on the setting of +# command line option "detail". +# +# tSmoke.v02.README +# - Local testing version +#----------------------------------------------- +# +# 1) This program is run via CRON or the command line +# 2) It extracts RRD information from a smokeping config file +# 3) It pulls data from RRD files to determine if anything is offline, that is returning 0 PINGs +# 4) tSmoke reports status via an SMTP alert +# 5) tSmoke also generates an SMTP mail showing historical view of availability +# +# Many thanks to the following people for their help and guidance: +# Jim Horwath of Agere Systems Inc. for his examples and pointers to Spreadsheet::WriteExcel +# Frank Harper the author of SLAMon, a tool for tracking Service Level Agreements +# Tobias Oeticker, or course, the author of Smokeping, RRDTool and MRTG +# +use strict; + +# We need to use +# -- Smokeping libraries +# -- RRDTool +# -- Getopt::Long +# +# Point the lib variables to your implementation +use lib qw(lib); +use lib "/usr/local/rrdtool-1.0.39/lib/perl"; + +use Smokeping; +use Net::SMTP; +use Getopt::Long; +use Pod::Usage; +use RRDs; + +# Point to your Smokeping config file +my $cfgfile = "etc/config.dist"; + +# global variables +my $cfg; + +#this is designed to work on IPv4 only +my $havegetaddrinfo = 0; + +# we want opts everywhere +my %opt; + +#Hashes for the data +my (%Daily,%Weekly,%Monthly,%Quarterly); # the entries +my (%DailyC,%WeeklyC,%MonthlyC,%QuarterlyC); # a count of the entries + +###################### +### Moving Average ### +###################### +# Just a reminder of how to do a moving average if you ever want to +# PREV,UN,,UN,1,,IF,PREV,IF,,UN,1,,IF,-,,*,A,UN,1,A,IF,+ + +# Change Log: +# DMC - Added Quarterly Status +# DMC - Added HTML mail reporting and consolidated functions +# DMC = Added an external HTML mail template, tMail +my $RCS_VERSION = '$id: tSmoke.v 0.4 2004/03 McGinn-Combs'; + +sub test_mail($) { + my $cfg = shift; + print "Mail will be sent to $cfg->{Alerts}{to}\n"; + print "Mail will be sent from $cfg->{Alerts}{from}\n"; +}; + +sub sendmail ($$$$){ + my $from = shift; + my $to = shift; + my $subject = shift; + my $body = shift; + if ($cfg->{General}{mailhost}){ + my $smtp = Net::SMTP->new($cfg->{General}{mailhost}); + $smtp->mail($from); + $smtp->to($to); + $smtp->data(); + $smtp->datasend("Subject: $subject\n"); + $smtp->datasend("To: $to\n"); + $smtp->datasend($body); + $smtp->dataend(); + $smtp->quit; + } elsif ($cfg->{General}{sendmail} or -f "/usr/lib/sendmail"){ + open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to); + print M "Subject: $subject\n"; + print M $body; + close M; + } +} + +sub morning_update($) { + # Send out a morning summary of devices that are down + my $cfg = shift; + my $Body = ""; + my $TmpBody = ""; + my $To = ""; + if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } + + # Get a list of the existing RRD Files + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + my $Count = $#rrds + 1; + my $Down = 0; + + foreach my $target (@rrds) { + my $Loss = 0; + my ($start,$step,$names,$data) = RRDs::fetch "$target","AVERAGE","--start","-300"; + my $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + foreach my $line (@$data) { + $Loss += $$line[3]; + } + $Down += 1 if $Loss == 0; + $target =~ s/^([a-zA-Z0-9]*\/)*//; + $target =~ s/.rrd//; + $TmpBody .= "$target\n" if $Loss == 0; + } + $Body = "Of $Count Hosts, $Down Down:\n" . $TmpBody; + sendmail $cfg->{Alerts}{from},$To,"Of $Count Hosts, $Down Down",$Body; +} + +sub weekly_update($) { + # Send out a formatted HTML Table of the + # Previous Day, Week, Month and Quarter Availability + # Get a list of the existing RRD Files + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + + my $To = ""; + if ( $opt{to} ) { $To = $opt{to}; } else { $To = $cfg->{Alerts}{to}; } + + my $Body =''; + +# Calculations Based on the following: +# RRDs::graph "fake.png", +# '--start','-86400', +# '-end','-300', +# "DEF:loss=${rrd}:loss:AVERAGE", +# "CDEF:avail=loss,0,100,IF", or more precisely "CDEF:avail=loss,2,GE,0,100,IF" +# and adding in the check for unknown for systems just coming on line +# "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF" + # Arbitrarily a loss of 10% of Pings means the system was down + my $pings = $cfg->{Database}{pings} * .1; + + foreach my $target (@rrds) { + # Get an average Availability for each RRD file + my $ERR; + + my ($DAverage,$Dxsize,$Dysize) = RRDs::graph "fake.png", + "--start","-86400", + "--end","-600", + "--step","1008", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($WAverage,$Wxsize,$Wysize) = RRDs::graph "fake.png", + "--start","-604800", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($MAverage,$Mxsize,$Mysize) = RRDs::graph "fake.png", + "--start","-2592000", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + my ($QAverage,$Qxsize,$Qysize) = RRDs::graph "fake.png", + "--start","-7776000", + "--end","-600", + "--step","4320", + "DEF:loss=$target:loss:AVERAGE", + "CDEF:avail=loss,UN,0,loss,IF,$pings,GE,0,100,IF", + "PRINT:avail:AVERAGE:%.2lf"; + $ERR=RRDs::error; + die "ERROR while reading $_: $ERR\n" if $ERR; + + $target =~ s/$cfg->{General}{datadir}\///; + $target =~ s/.rrd//; + my @Path; + push @Path,split/\//,$target; + update_stats ( \@Path, @$DAverage[0], @$WAverage[0], @$MAverage[0], @$QAverage[0]); + } + + # Prepare the e-mail message + open tSMOKE, $cfg->{General}{tmail} or die "ERROR: can't read $cfg->{General}{tmail}\n"; + while (){ + my $Summary = Summary_Sheet(); + s/<##SUMMARY##>/$Summary/ig; + my $Daily = DetailSheet(86400); + s/<##DAYDETAIL##>/$Daily/ig; + my $Weekly = DetailSheet(604800); + s/<##WEEKDETAIL##>/$Weekly/ig; + my $Monthly = DetailSheet(2592000); + s/<##MONTHDETAIL##>/$Monthly/ig; + my $Quarterly = DetailSheet(7776000); + s/<##QUARTERDETAIL##>/$Quarterly/ig; + $Body .= $_; + } + close tSMOKE; + sendmail ( $cfg->{Alerts}{from}, $To, "IT System Availability", $Body ); +} + +sub update_stats($$$$$); +sub update_stats($$$$$) { + # Update the uptime percentages in the Hash Arrays + my $Path = shift; + my $DAverage = shift; + my $WAverage = shift; + my $MAverage = shift; + my $QAverage = shift; + + #Enter everything once as it exists + #Trim off the rightmost component (hostname) and reenter the code + #If there is only one component, this is the final level + #This is an average of averages + + my $Ticket = join ( ".",@$Path); + $Daily { $Ticket } += $DAverage; + $Weekly { $Ticket } += $WAverage; + $Monthly { $Ticket } += $MAverage; + $Quarterly {$Ticket } += $QAverage; + $DailyC { $Ticket }++; + $WeeklyC { $Ticket }++; + $MonthlyC { $Ticket }++; + $QuarterlyC { $Ticket }++; + my $Length = @$Path; + @$Path = @$Path [ 0 .. $Length - 2 ]; + update_stats(\@$Path,$DAverage,$WAverage,$MAverage,$QAverage) if $Length > 1; +} + +sub Summary_Sheet() { + my $Body = ''; + + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= " + + + + \n"; + foreach (sort { $a cmp $b } keys %Monthly) { + next if ( $_ =~ /\./ ); + # this is a major section heading + $Body .= "\n"; + $Body .= ""; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} >= 99 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} > 95 and $Quarterly{$_}/$QuarterlyC{$_} < 99 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} > 90 and $Quarterly{$_}/$QuarterlyC{$_} < 95 ; + $Body .= "" + if $Quarterly{$_}/$QuarterlyC{$_} < 90 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} >= 99 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} > 95 and $Monthly{$_}/$MonthlyC{$_} < 99 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} > 90 and $Monthly{$_}/$MonthlyC{$_} < 95 ; + $Body .= "" + if $Monthly{$_}/$MonthlyC{$_} < 90 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} >= 99; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} > 95 and $Weekly{$_}/$WeeklyC{$_} < 99 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} > 90 and $Weekly{$_}/$WeeklyC{$_} < 95 ; + $Body .= "" + if $Weekly{$_}/$WeeklyC{$_} < 90 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} >= 99; + $Body .= "" + if $Daily{$_}/$DailyC{$_} > 95 and $Daily{$_}/$DailyC{$_} < 99 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} > 90 and $Daily{$_}/$DailyC{$_} < 95 ; + $Body .= "" + if $Daily{$_}/$DailyC{$_} < 90 ; + $Body .= "\n"; + } + $Body .= "
IT Network Systems Availability Summary
Compiled: ". scalar(localtime) . "
ServicePast QuarterPast MonthPast WeekPast Day
$_" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Quarterly{$_}/$QuarterlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Monthly{$_}/$MonthlyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Weekly{$_}/$WeeklyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%" . sprintf('%.2f',$Daily{$_}/$DailyC{$_}) . "%
"; + $Body .= "

\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "
Legend:
if uptime > 99% then GREEN
if uptime > 95% but < 99% then BLUE
if uptime > 90% but < 95% then YELLOW
if uptime < 90% then RED
\n"; + return $Body; +} + +sub NumDots($) { + # Count the number of dots in a string + # There's probably a better way to do this + my $DNA = shift; + my $a = 0; + while($DNA =~ /\./ig){$a++} + return $a +} + +sub DetailSheet($) { + # Populate the table with details depending on the value of %opts{detail} + my $Seconds = shift; + my $Body = ''; + + return '' unless $opt{detail}; + + # Monthly/Weekly/Daily + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= " + + \n"; + + my %CornBeef; + my %CornBeefC; + + CASE: { + %CornBeef = %Daily, %CornBeefC = %DailyC, print "Doing Daily\n", last CASE if $Seconds == 86400; + %CornBeef = %Weekly, %CornBeefC = %WeeklyC, print "Doing Weekly\n", last CASE if $Seconds == 604800; + %CornBeef = %Monthly, %CornBeefC = %MonthlyC, print "Doing Monthly\n", last CASE if $Seconds == 2592000; + %CornBeef = %Quarterly, %CornBeefC = %QuarterlyC, print "Doing Quarterly\n", last CASE if $Seconds == 7776000; + } # end of CASE block + + foreach (sort { $a cmp $b } keys %CornBeef ) { + next if NumDots ($_) > $opt{detail}; + if ( $_ =~ /\./ ) { + #this is a sub section + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + } else { + # this is a non-sub section + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= "\n"; + $Body .= ""; + } + } + $Body .= "
IT Network Systems Availability Previous " . $Seconds/86400 . " Day(s)
Compiled: ". scalar(localtime) . "
ServiceSecondsPercent
$_" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
" . $_ . "" . sprintf('%.0f',(100 - $CornBeef{$_} / $CornBeefC{$_}) * ($Seconds/100)) . "" . sprintf('%.2f',$CornBeef{$_} / $CornBeefC{$_}) . "%
\n"; + return $Body; + } + +sub list_rrds($$$); +sub list_rrds($$$) { + # List the RRD's used by this configuration + my $tree = shift; + my $path = shift; + my $print = shift; + my $prline; + foreach my $rrds (keys %{$tree}) { + next if $rrds eq "PROBE_CONF"; + if (ref $tree->{$rrds} eq 'HASH'){ + $prline .= list_rrds( $tree->{$rrds}, $path."/$rrds", $print ); + } + if ($rrds eq 'host') { + $prline .= "$cfg->{General}{datadir}$path".".rrd\n"; + } + } + return $prline; +} + +sub load_cfg ($) { + my $cfgfile = shift; +# my $parser = get_parser; + my $parser = Smokeping::get_parser; + $cfg = Smokeping::get_config $parser, $cfgfile; +} + +########################################################################### +# The Main Program +########################################################################### + +sub main($); +main($cfgfile); + +sub main ($) { + umask 022; + my $cfgfile = shift; + my $sendto; + GetOptions(\%opt, 'quiet','version','testmail','listrrds','to=s','detail=n','morning','weekly','help','man') or pod2usage(2); + if($opt{version}) { print "$RCS_VERSION\n"; exit(0) }; + if($opt{help}) { pod2usage(-verbose => 1); exit 0 }; + if($opt{man}) { pod2usage(-verbose => 2); exit 0 }; + load_cfg $cfgfile; + print "tSmoke for network managed by $cfg->{General}{owner}\nat $cfg->{General}{contact}\n(c) 2003 Dan McGinn-Combs\n" unless $opt{quiet}; + if($opt{testmail}) { test_mail($cfg) }; + if($opt{listrrds}) { print "List of Round Robin Databases used by this implementation\n"; + my @rrds = split ( /\n/,list_rrds($cfg->{Targets},"","") ); + foreach (@rrds) { + print "RRD: $_\n"; }; + } + if($opt{morning}) { morning_update($cfg) }; + if($opt{weekly}) { weekly_update($cfg) }; + exit 0; +} + +=head1 NAME + +tSmoke - Commandline tool for sending SmokePing information + +=head1 SYNOPSIS + +B [ B<--testmail> | B<--morning> | B<--weekly> | B<--version> | B<--help> | B<--man>] + + Options: + + --man Show the manpage + --help Help :-) + --version Show SmokePing Version + --testmail Send a test message + --listrrds List the RRDs used by this Smokeping + --morning Send a morning synopsis + --weekly Send a weekly status report + --to E-mail address to send message (i.e. '--to=xyz@company.com.invalid' + --detail How much detail to send in weekly report (i.e. '--detail=1') + --quiet Do not print welcome + +=head1 DESCRIPTION + +The B tool is a commandline tool which interfaces with the SmokePing system. +Its main function is to send a message indicating the current status of the systems +being monitored by Smokeping or an HTML mail file containing the status over the past day, +past week and past month including an overview. + +Typical crontab used to invoke this are + + # Quick morning alert to see what's down + 0 6 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mobilephone@att.net.invalid --morning + # Weekly report on the percent availability of network systems with no detail + 0 8 * * * /usr/local/smokeping/bin/tSmoke.pl --q --to=mailbox@company.com.invalid --weekly --detail=0 + +=head1 SETUP + +When installing tSmoke, some variables must be adjusted to fit your local system. + +We need to use the following B: + +=over + +=item Smokeping + +=item RRDTool Perl bindings + +=item Getopt::Long + +=back + +Set up your libraries: + + use lib "/usr/local/smokeping/lib"; + use lib "/usr/local/rrdtool-1.0.39/lib/perl"; + +Point to your Smokeping B file + + my $cfgfile = "/usr/local/smokeping/etc/config"; + +Modify the Smokeping config file to include a path for tmail in the +General section: + + tmail = /usr/local/smokeping/etc/tmail + +=head1 COPYRIGHT + +Copyright (c) 2003 by Dan McGinn-Combs. All right 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. + +=head1 AUTHOR + +Dan McGinn-Combs Ed.mcginn-combs@mindspring.comE + +Modified for Smokeping official distribution by Niko Tyni Entyni@iki.fiE + +=cut + diff --git a/etc/tmail.dist b/etc/tmail.dist index ed90eea..a9d7bbf 100644 --- a/etc/tmail.dist +++ b/etc/tmail.dist @@ -1,132 +1,132 @@ -MIME-Version: 1.0 -Content-Type: text/html - - - -IT System Availability Report - - - - - -
-Put your logo hereXXXX IT System Availability
-

-

-

-

-<##SUMMARY##> -

-

- - - - - - - -
Quarterly DetailMonthly DetailWeekly DetailDaily Detail
-
-

-

-<##DAYDETAIL##> -
-

-

-<##WEEKDETAIL##> -
-

-

-<##MONTHDETAIL##> -
-

-

-<##QUARTERDETAIL##> -
- +MIME-Version: 1.0 +Content-Type: text/html + + + +IT System Availability Report + + + + + +
+Put your logo hereXXXX IT System Availability
+

+

+

+

+<##SUMMARY##> +

+

+ + + + + + + +
Quarterly DetailMonthly DetailWeekly DetailDaily Detail
+
+

+

+<##DAYDETAIL##> +
+

+

+<##WEEKDETAIL##> +
+

+

+<##MONTHDETAIL##> +
+

+

+<##QUARTERDETAIL##> +
+ -- cgit v1.2.3-24-g4f1b From a596fb2a0d96b7300048c27591cb3502c2b41950 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 31 May 2005 19:27:33 +0000 Subject: * 2.0/bin/tSmoke.dist: + Remove the PROBE_CONF reference; this version of tSmoke is now for 2.x only. --- bin/tSmoke.dist | 1 - 1 file changed, 1 deletion(-) diff --git a/bin/tSmoke.dist b/bin/tSmoke.dist index 487ce30..e749978 100755 --- a/bin/tSmoke.dist +++ b/bin/tSmoke.dist @@ -397,7 +397,6 @@ sub list_rrds($$$) { my $print = shift; my $prline; foreach my $rrds (keys %{$tree}) { - next if $rrds eq "PROBE_CONF"; if (ref $tree->{$rrds} eq 'HASH'){ $prline .= list_rrds( $tree->{$rrds}, $path."/$rrds", $print ); } -- cgit v1.2.3-24-g4f1b From dbad531025c7f6ffe665c1514af416658fc6d3f4 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 31 May 2005 19:50:03 +0000 Subject: * 2.0/CHANGES: + Officially include the tSmoke script from the contrib download directory. --- CHANGES | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES b/CHANGES index 3098338..5cab654 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +* Officially include the tSmoke script from the contrib download directory. + Notice that this needs the new 'tmail' variable to be defined in the config file. + -- niko * Perl 5.8.0 compatibility fix ("missing max for DS uptime") -- niko, reported by Steve Wickert and Kennedy Clark * RRDtool 1.2.x compatibility fix ("unknown RRD version: 0003" on restart) -- cgit v1.2.3-24-g4f1b From 9791370bdbea2be98b9f715a4cea7bbfc5ec9880 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Tue, 31 May 2005 20:14:23 +0000 Subject: prepare for the release of smokeping-2.0rc5 --- Makefile | 6 +++--- bin/smokeping.dist | 2 +- htdocs/smokeping.cgi.dist | 2 +- lib/Smokeping.pm | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Makefile b/Makefile index c2584ed..80c2b81 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ SHELL = /bin/sh -VERSION = 2.0rc4 -NUMVERSION = 1.99005 +VERSION = 2.0rc5 +NUMVERSION = 1.99006 IGNORE = ~|CVS|var/|smokeping-$(VERSION)/smokeping-$(VERSION)|cvsignore|rej|orig|DEAD|pod2htm[di]\.tmp|.svn GROFF = groff .PHONY: man html txt ref examples check-examples patch killdoc doc tar rename-man symlinks remove-symlinks @@ -147,4 +147,4 @@ dist: tar tag: dist svn commit -m "prepare for the release of smokeping-$(VERSION)" - svn copy -m "tagging version $(VERSION)" svn://svn.ee.ethz.ch/smokeping/branches/2.0 svn://svn.ee.ethz.ch/smokeping/tags/$VERSION + svn copy -m "tagging version $(VERSION)" svn://svn.ee.ethz.ch/smokeping/branches/2.0 svn://svn.ee.ethz.ch/smokeping/tags/$(VERSION) diff --git a/bin/smokeping.dist b/bin/smokeping.dist index e6a13ab..8d15a28 100755 --- a/bin/smokeping.dist +++ b/bin/smokeping.dist @@ -4,7 +4,7 @@ use lib qw(/usr/pack/rrdtool-1.0.49-to/lib/perl); use lib qw(lib); -use Smokeping 1.99005; +use Smokeping 1.99006; Smokeping::main("etc/config.dist"); diff --git a/htdocs/smokeping.cgi.dist b/htdocs/smokeping.cgi.dist index a5801b4..6a391b5 100755 --- a/htdocs/smokeping.cgi.dist +++ b/htdocs/smokeping.cgi.dist @@ -5,7 +5,7 @@ use lib qw(/usr/pack/rrdtool-1.0.33-to/lib/perl); use lib qw(/home/oetiker/data/projects/AADJ-smokeping/dist/lib); use CGI::Carp qw(fatalsToBrowser); -use Smokeping 1.99005; +use Smokeping 1.99006; Smokeping::cgi("/home/oetiker/data/projects/AADJ-smokeping/dist/etc/config"); diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 46545a0..a7f00a9 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -20,7 +20,7 @@ use Smokeping::RRDtools; # globale persistent variables for speedy use vars qw($cfg $probes $VERSION $havegetaddrinfo $cgimode); -$VERSION="1.99005"; +$VERSION="1.99006"; # we want opts everywhere my %opt; -- cgit v1.2.3-24-g4f1b From 54b0cfd69a5ea9dd38b27bb1b6880b97bf9bc27d Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 1 Jun 2005 11:29:44 +0000 Subject: * 2.0/doc/smokeping_upgrade.pod: + mention tSmoke inclusion * 2.0/bin/tSmoke.dist, 2.0/Makefile: + make tSmoke require the current Smokeping.pm version + add tSmoke to the 'patch' Makefile target to keep it up to date * 2.0/etc/config.dist: + add the 'tmail' variable * 2.0/CHANGES: + mention Dan as the original tSmoke author --- CHANGES | 5 +++-- Makefile | 2 +- bin/tSmoke.dist | 2 +- doc/smokeping_upgrade.pod | 7 +++++++ etc/config.dist | 1 + 5 files changed, 13 insertions(+), 4 deletions(-) diff --git a/CHANGES b/CHANGES index 5cab654..8c2deac 100644 --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,7 @@ +2005/05/31 - publish rc5 (tobi) * Officially include the tSmoke script from the contrib download directory. - Notice that this needs the new 'tmail' variable to be defined in the config file. - -- niko + Note that this needs the new 'tmail' variable to be defined in the config file. + -- niko, original script by Dan McGinn-Combs * Perl 5.8.0 compatibility fix ("missing max for DS uptime") -- niko, reported by Steve Wickert and Kennedy Clark * RRDtool 1.2.x compatibility fix ("unknown RRD version: 0003" on restart) diff --git a/Makefile b/Makefile index 80c2b81..02c1dd4 100644 --- a/Makefile +++ b/Makefile @@ -129,7 +129,7 @@ doc/smokeping_examples.pod: lib/Smokeping/Examples.pm etc/config.dist $(GENEX) patch: perl -i~ -p -e 's/VERSION="\d.*?"/VERSION="$(NUMVERSION)"/' lib/Smokeping.pm - perl -i~ -p -e 's/Smokeping \d.*?;/Smokeping $(NUMVERSION);/' bin/smokeping.dist htdocs/smokeping.cgi.dist + perl -i~ -p -e 's/Smokeping \d.*?;/Smokeping $(NUMVERSION);/' bin/smokeping.dist htdocs/smokeping.cgi.dist bin/tSmoke.dist killdoc: -rm doc/*.[1357] doc/*.txt doc/*.html doc/Smokeping/* doc/Smokeping/probes/* doc/Smokeping/matchers/* doc/Config/* doc/examples/* doc/smokeping_examples.pod doc/smokeping_config.pod doc/smokeping.pod doc/smokeping.cgi.pod diff --git a/bin/tSmoke.dist b/bin/tSmoke.dist index e749978..d8a8089 100755 --- a/bin/tSmoke.dist +++ b/bin/tSmoke.dist @@ -53,7 +53,7 @@ use strict; use lib qw(lib); use lib "/usr/local/rrdtool-1.0.39/lib/perl"; -use Smokeping; +use Smokeping 1.99006; use Net::SMTP; use Getopt::Long; use Pod::Usage; diff --git a/doc/smokeping_upgrade.pod b/doc/smokeping_upgrade.pod index ad7b595..046afdf 100644 --- a/doc/smokeping_upgrade.pod +++ b/doc/smokeping_upgrade.pod @@ -32,6 +32,13 @@ trial-and-error variety than it used to be. It also automates the generation of the configuration documentation from the source code, so the docs are now more accurate. +A smaller change worth mentioning is the inclusion of the tSmoke script +(contributed by Dan McGinn-Combs) for sending summary emails on daily +and weekly system status. Note that it needs the new 'tmail' variable +to be defined in the config file. + +=head2 CONFIGURATION + The configuration syntax has stayed mostly the same, except for the issues below. diff --git a/etc/config.dist b/etc/config.dist index 71560ba..71c77ff 100644 --- a/etc/config.dist +++ b/etc/config.dist @@ -14,6 +14,7 @@ datadir = /home/oetiker/data/projects/AADJ-smokeping/dist/var piddir = /home/oetiker/data/projects/AADJ-smokeping/dist/var cgiurl = http://people.ee.ethz.ch/~oetiker/smokeping/smokeping.cgi smokemail = /home/oetiker/data/projects/AADJ-smokeping/dist/etc/smokemail.dist +tmail = /home/oetiker/data/projects/AADJ-smokeping/dist/etc/tmail.dist # specify this to get syslog logging syslogfacility = local0 # each probe is now run in its own process -- cgit v1.2.3-24-g4f1b From 395461bfc00f6b3c98540c870fd24959d2c1466f Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 2 Jun 2005 10:58:17 +0000 Subject: * 2.0/Makefile: + new target 'increment-CHANGES-version intended for automatically updating CHANGES when releasing a new version. --- Makefile | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Makefile b/Makefile index 02c1dd4..ae2eb17 100644 --- a/Makefile +++ b/Makefile @@ -148,3 +148,7 @@ dist: tar tag: dist svn commit -m "prepare for the release of smokeping-$(VERSION)" svn copy -m "tagging version $(VERSION)" svn://svn.ee.ethz.ch/smokeping/branches/2.0 svn://svn.ee.ethz.ch/smokeping/tags/$(VERSION) + +increment-CHANGES-version: + perl -i~ -p -e 'do { my @d = localtime; my $$d = (1900+$$d[5])."/".(1+$$d[4])."/".$$d[3]; print "$$d -- released version $(VERSION)\n\n" } unless $$done++ ' CHANGES + -- cgit v1.2.3-24-g4f1b From b5a21fd2221f92bf7db544bc265a76d41912a633 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Thu, 2 Jun 2005 13:55:58 +0000 Subject: updated release tags so that they should protect against duplicate execution --- Makefile | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index ae2eb17..ce8099a 100644 --- a/Makefile +++ b/Makefile @@ -130,6 +130,8 @@ doc/smokeping_examples.pod: lib/Smokeping/Examples.pm etc/config.dist patch: perl -i~ -p -e 's/VERSION="\d.*?"/VERSION="$(NUMVERSION)"/' lib/Smokeping.pm perl -i~ -p -e 's/Smokeping \d.*?;/Smokeping $(NUMVERSION);/' bin/smokeping.dist htdocs/smokeping.cgi.dist bin/tSmoke.dist + perl -i~ -p -e 'do { my @d = localtime; my $$d = (1900+$$d[5])."/".(1+$$d[4])."/".$$d[3]; print "$$d -- released version $(VERSION)\n\n" } unless $$done++ || /version $(VERSION)/' CHANGES + svn commit -m "prepare for the release of smokeping-$(VERSION)" killdoc: -rm doc/*.[1357] doc/*.txt doc/*.html doc/Smokeping/* doc/Smokeping/probes/* doc/Smokeping/matchers/* doc/Config/* doc/examples/* doc/smokeping_examples.pod doc/smokeping_config.pod doc/smokeping.pod doc/smokeping.cgi.pod @@ -146,9 +148,5 @@ dist: tar cp CHANGES /home/oetiker/public_html/webtools/smokeping/pub/CHANGES tag: dist - svn commit -m "prepare for the release of smokeping-$(VERSION)" + svn ls svn://svn.ee.ethz.ch/smokeping/tags/$(VERSION) || \ svn copy -m "tagging version $(VERSION)" svn://svn.ee.ethz.ch/smokeping/branches/2.0 svn://svn.ee.ethz.ch/smokeping/tags/$(VERSION) - -increment-CHANGES-version: - perl -i~ -p -e 'do { my @d = localtime; my $$d = (1900+$$d[5])."/".(1+$$d[4])."/".$$d[3]; print "$$d -- released version $(VERSION)\n\n" } unless $$done++ ' CHANGES - -- cgit v1.2.3-24-g4f1b From 66c8d49cbe278316114a6eef8ccb509c9e67d0ba Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Sun, 3 Jul 2005 22:15:20 +0000 Subject: tune the rrd files for min/max/heartbeat --- lib/Smokeping.pm | 1 + lib/Smokeping/RRDtools.pm | 57 +++++++++++++++++++++++++++++++++++++---------- 2 files changed, 46 insertions(+), 12 deletions(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index a7f00a9..15eb126 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -385,6 +385,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); } } } diff --git a/lib/Smokeping/RRDtools.pm b/lib/Smokeping/RRDtools.pm index 4a695d1..2b7ad2b 100644 --- a/lib/Smokeping/RRDtools.pm +++ b/lib/Smokeping/RRDtools.pm @@ -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 and C. -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, C and +C. 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 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. Note that this list will never contain the C parameter, but it B contain the C parameter. -The function C 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. The function will then simply compare -the result of C with this argument list. It will return -C if the arguments matched, and a string indicating the difference -if a discrepancy was found. Note that if there is a C parameter in -the argument list, C disregards it. If C isn't specified, -C will use the C default of 300 seconds. +The function C 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. The function will then simply compare the result of +C with this argument list. It will return C if the +arguments matched, and a string indicating the difference if a discrepancy +was found. Note that if there is a C parameter in the argument list, +C disregards it. If C isn't specified, C will use +the C default of 300 seconds. C ignores non-matching DS +parameters since C will fix them. + +C talks on stderr about the parameters it fixes. =head1 NOTES @@ -168,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; -- cgit v1.2.3-24-g4f1b From f3a0711e88ccf8e43773dc41518b3dbbc2b87a32 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Sun, 3 Jul 2005 22:17:00 +0000 Subject: tune datasources --- CHANGES | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES b/CHANGES index 8c2deac..ca0f99c 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +* tune DS properties min/max/heartbeat instead of just complaing about + them not matching (tobi) + 2005/05/31 - publish rc5 (tobi) * Officially include the tSmoke script from the contrib download directory. Note that this needs the new 'tmail' variable to be defined in the config file. -- cgit v1.2.3-24-g4f1b From 6c3d9be08286f6bf6b21bfb7e4f8ee77900025df Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Sun, 3 Jul 2005 22:22:05 +0000 Subject: backslash after LinuUp --- lib/Smokeping.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 15eb126..6df240b 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -848,7 +848,7 @@ sub get_detail ($$$$){ my $cdir=$cfg->{General}{datadir}."/".(join "/", @dirs)."/"; if (-f "$cdir/${file}.adr") { @upsmoke = (); - @upargs = ('COMMENT:Link Up${BS}: ', + @upargs = ("COMMENT:Link Up${BS}: ", "DEF:uptime=${rrd}:uptime:AVERAGE", "CDEF:duptime=uptime,86400,/", 'GPRINT:duptime:LAST: %0.1lf days ('); -- cgit v1.2.3-24-g4f1b From 3ca78feffa42b2863dcc23c2143d96bead1e107f Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Mon, 4 Jul 2005 05:58:11 +0000 Subject: the old pngs in __navcache did not get removed properly ... --- lib/Smokeping.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 6df240b..641c651 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -735,9 +735,9 @@ sub get_detail ($$$$){ } 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 (<"$pattern">){ - unlink $_ if -A $_ > 1/24; + 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()."$$"; -- cgit v1.2.3-24-g4f1b From 7c05e52c7486b782ea8fe83f61eda56f05fd2613 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 27 Jul 2005 11:45:20 +0000 Subject: * 2.0/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm, 2.0/CHANGES: + bugfix for CiscoRTTMonEchoICMP packetsize variable -- niko, from Sam Stickland --- CHANGES | 2 ++ lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm | 41 ++++++++++++----------------- 2 files changed, 19 insertions(+), 24 deletions(-) diff --git a/CHANGES b/CHANGES index ca0f99c..465da61 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,5 @@ +* bugfix for CiscoRTTMonEchoICMP packetsize variable + -- niko, from Sam Stickland * tune DS properties min/max/heartbeat instead of just complaing about them not matching (tobi) 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 => < 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 => < 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; + }, + }, }); } -- cgit v1.2.3-24-g4f1b From caea6ae36aaacadab7029f172821899d237108f4 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Fri, 29 Jul 2005 08:14:17 +0000 Subject: set LC_NUMERIC to C to help people that would otherwhise get , as decimal separator --- CHANGES | 4 ++++ lib/Smokeping.pm | 17 +++++++++++++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/CHANGES b/CHANGES index 465da61..de0fd06 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,7 @@ +* set LC_NUMERIC to C so that users who work with a locale like french that + would use , as a decimal separator do not trip over failing regexp-matches + (tobi) + * bugfix for CiscoRTTMonEchoICMP packetsize variable -- niko, from Sam Stickland * tune DS properties min/max/heartbeat instead of just complaing about diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 641c651..5d28b78 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -12,8 +12,15 @@ use POSIX; 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; @@ -877,7 +884,8 @@ sub get_detail ($$$$){ my @lazy =(); @lazy = ('--lazy') if $mode eq 's' and $lasthight{$start} and $lasthight{$start} == $max->{$start}; $desc = "Navigator Graph" if $mode eq 'n'; - my ($graphret,$xs,$ys) = RRDs::graph + my $timer_start = time(); + my @task = ("${imgbase}_${end}_${start}.png", @lazy, '--start',( $mode eq 's' ? '-'.$start : $start), @@ -910,11 +918,13 @@ sub get_detail ($$$$){ 'COMMENT:\s', "COMMENT:Probe${BS}: $pings $ProbeDesc every $step seconds", 'COMMENT:created on '.$date.'\j' ); + + my ($graphret,$xs,$ys) = RRDs::graph @task; my $ERROR = RRDs::error(); if ($mode eq 'n'){ $page .= "
"; - $page .= ( $ERROR || qq{} ); + $page .= ( $ERROR || qq|| ); $page .= "
"; $page .= $q->start_form(-method=>'GET') . "

Time range: " @@ -930,6 +940,9 @@ sub get_detail ($$$$){ $startstr =~ s/\s/%20/g; $endstr =~ s/\s/%20/g; $page .= "

"; +# $page .= (time-$timer_start)."
"; +# $page .= join " ",map {"'$_'"} @task; + $page .= "
"; $page .= ( $ERROR || qq{' . qq{}."" ); -- cgit v1.2.3-24-g4f1b From 237c2131e3f216eccd4b472e456d16f4dbe20456 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Fri, 5 Aug 2005 20:43:55 +0000 Subject: * remove a quotemeta() call in Config::Grammar to allow metacharacters at the right side of '@define' -- niko, reported by Warrick FitzGerald --- CHANGES | 4 +++- lib/Config/Grammar.pm | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGES b/CHANGES index de0fd06..d84524a 100644 --- a/CHANGES +++ b/CHANGES @@ -1,7 +1,9 @@ +* remove a quotemeta() call in Config::Grammar to allow metacharacters + at the right side of '@define' + -- niko, reported by Warrick FitzGerald * set LC_NUMERIC to C so that users who work with a locale like french that would use , as a decimal separator do not trip over failing regexp-matches (tobi) - * bugfix for CiscoRTTMonEchoICMP packetsize variable -- niko, from Sam Stickland * tune DS properties min/max/heartbeat instead of just complaing about diff --git a/lib/Config/Grammar.pm b/lib/Config/Grammar.pm index 5bc76a3..7cd71f1 100644 --- a/lib/Config/Grammar.pm +++ b/lib/Config/Grammar.pm @@ -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; }; -- cgit v1.2.3-24-g4f1b From cfe62bb62be56069c1507c18e2ab842fe2ef06a9 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 18 Aug 2005 18:38:44 +0000 Subject: * TODO: + configurable RRD parameters per target? --- TODO | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/TODO b/TODO index 8e2a76a..282052e 100644 --- a/TODO +++ b/TODO @@ -35,3 +35,8 @@ - almost every probe has a different way of calling system(), exec() or similar. This should be in an inheritable module. - the module should also support extra commandline arguments + +* RRD + configurable RRD parameters per target? + - suggested by Leos Bitto, + -- cgit v1.2.3-24-g4f1b From a23d80aaccf4392e8e703eea13440d3c19ca7c55 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 18 Aug 2005 18:44:26 +0000 Subject: * 2.0/lib/Config/Grammar.pm: + update to official version 1.02 --- lib/Config/Grammar.pm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lib/Config/Grammar.pm b/lib/Config/Grammar.pm index 7cd71f1..bd3deea 100644 --- a/lib/Config/Grammar.pm +++ b/lib/Config/Grammar.pm @@ -6,7 +6,7 @@ package Config::Grammar; use strict; use vars qw($VERSION); -$VERSION = '1.01'; +$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; @@ -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,26 +1445,26 @@ 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' } }; -- cgit v1.2.3-24-g4f1b From 2f01fa7db139ec0141bf5e7f8d8e2223069d3c68 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 18 Aug 2005 20:20:00 +0000 Subject: * branches/2.0/doc/smokeping_upgrade.pod: + document the tuning of RRD DS parameters --- doc/smokeping_upgrade.pod | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/smokeping_upgrade.pod b/doc/smokeping_upgrade.pod index 046afdf..61277fc 100644 --- a/doc/smokeping_upgrade.pod +++ b/doc/smokeping_upgrade.pod @@ -112,10 +112,10 @@ and measuring and visualizing the variation between them. Smokeping now checks at startup that the parameters of any existing RRD files match those specified in the configuration file. If there is a discrepancy, -it will give an error message and refuse to start. +it will try to fix the situation and refuse to start if it can't. -This situation is most likely to happen if you have modified the C -or C variables in your configuration file. You'll then have to +This situation is most likely to happen if you have modified the +C variable in your configuration file. You'll then have to delete the old RRD file or somehow convert it to use the new parameters. The C command might be helpful here. -- cgit v1.2.3-24-g4f1b From 69064fb816bd54a08ffd92760f125a5d83793250 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 23 Aug 2005 12:43:37 +0000 Subject: * 2.0/lib/Smokeping.pm, 2.0/CHANGES: + make errors in DYNAMIC updates appear in the web server error log * 2.0/TODO: + replace the __WARN__ and __DIE__ handlers with CGI::Carp? --- CHANGES | 2 ++ TODO | 4 ++++ lib/Smokeping.pm | 3 ++- 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index d84524a..4d19be9 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,5 @@ +* make errors in DYNAMIC updates appear in the web server error log + -- niko * remove a quotemeta() call in Config::Grammar to allow metacharacters at the right side of '@define' -- niko, reported by Warrick FitzGerald diff --git a/TODO b/TODO index 282052e..5189180 100644 --- a/TODO +++ b/TODO @@ -40,3 +40,7 @@ configurable RRD parameters per target? - suggested by Leos Bitto, + +* CGI LOGGING + replace the __WARN__ and __DIE__ handlers with CGI::Carp? + Problems with speedy? diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 5d28b78..8f98341 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -2572,7 +2572,8 @@ sub cgi ($) { -charset=> ( $cfg->{Presentation}{charset} || 'iso-8859-15') ); if ($q->param(-name=>'secret') && $q->param(-name=>'target') ) { - update_dynaddr $cfg,$q; + my $ret = update_dynaddr $cfg,$q; + do_cgilog($ret) if defined $ret and $ret ne ""; } else { display_webpage $cfg,$q; } -- cgit v1.2.3-24-g4f1b From 097c0c8590821246ac6630e7f2d72c0db62ea69d Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 23 Aug 2005 19:13:31 +0000 Subject: * 2.0/TODO: + CGI: return something else than 200 OK in error situations + config: make .adr dir configurable --- TODO | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/TODO b/TODO index 5189180..9ecd2ef 100644 --- a/TODO +++ b/TODO @@ -44,3 +44,15 @@ * CGI LOGGING replace the __WARN__ and __DIE__ handlers with CGI::Carp? Problems with speedy? + +* CGI RETURN VALUE + return something else than 200 OK in error situations at least + when updating DYNAMIC addresses + - suggested by Marc Haber, + + +* CONFIG + make the .adr (and .snmp) directory configurable + - suggested by Marc Haber, + + -- cgit v1.2.3-24-g4f1b From b845e8f36b17287858130cac979914b3851189d3 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Thu, 25 Aug 2005 11:36:30 +0000 Subject: * 2.0/Makefile: + made the 'rename-man' target idempotent --- Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index ce8099a..6998998 100644 --- a/Makefile +++ b/Makefile @@ -100,7 +100,9 @@ txt: $(TXT) rename-man: $(MAN) for j in probes matchers; do \ for i in doc/Smokeping/$$j/*.3; do \ - mv $$i `echo $$i | sed s,$$j/,$$j/Smokeping::$$j::,`; \ + if ! echo $$i | grep -q Smokeping::$$j; then \ + mv $$i `echo $$i | sed s,$$j/,$$j/Smokeping::$$j::,`; \ + fi; \ done; \ done mv doc/Config/Grammar.3 doc/Config/Config::Grammar.3 -- cgit v1.2.3-24-g4f1b From fcaa98c7edf28d8d16ff3f970460d2a0bcbd409d Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Mon, 29 Aug 2005 12:04:26 +0000 Subject: * 2.0/lib/Smokeping.pm: + use CGI::Carp and warn() for do_cgilog() to get timestamps there as well --- lib/Smokeping.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 8f98341..9134612 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -2422,7 +2422,7 @@ sub daemonize_me ($) { sub do_cgilog ($){ my $str = shift; print "

" , $str, "

\n"; - print STDERR $str,"\n"; # for the webserver log + warn $str, "\n"; # for the webserver log } sub do_debuglog ($){ -- cgit v1.2.3-24-g4f1b From 04e1ef4cd80ad08455452d56aa4b953ed3a53057 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 30 Aug 2005 12:38:35 +0000 Subject: * 2.0/lib/Smokeping.pm: + make the address of the remote client appear in the web server's error log --- lib/Smokeping.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 9134612..050cb34 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -2395,6 +2395,7 @@ sub daemonize_me ($) { sub initialize_cgilog (){ $use_cgilog = 1; + CGI::Carp::set_progname($0 . " [client " . ($ENV{REMOTE_ADDR}||"(unknown)") . "]"); $logging=1; } @@ -2571,11 +2572,12 @@ sub cgi ($) { -expires=>'+'.($cfg->{Database}{step}).'s', -charset=> ( $cfg->{Presentation}{charset} || 'iso-8859-15') ); + initialize_cgilog(); if ($q->param(-name=>'secret') && $q->param(-name=>'target') ) { - my $ret = update_dynaddr $cfg,$q; + my $ret = update_dynaddr $cfg,$q; do_cgilog($ret) if defined $ret and $ret ne ""; } else { - display_webpage $cfg,$q; + display_webpage $cfg,$q; } } -- cgit v1.2.3-24-g4f1b From b24bc862beab1ac7bc8467d83321e56569e4138f Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Thu, 1 Sep 2005 10:29:44 +0000 Subject: fixed spelling --- etc/smokemail.dist | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/smokemail.dist b/etc/smokemail.dist index 5b4d4da..5caa4c5 100644 --- a/etc/smokemail.dist +++ b/etc/smokemail.dist @@ -4,7 +4,7 @@ Subject: SmokePing Agent Hi, -Please execute the attache Perl Script on your computer. It will register +Please execute the attached Perl Script on your computer. It will register your IP with SmokePing. You have to rerun this script at least everytime your IP changes. You can run the script as often as you want. -- cgit v1.2.3-24-g4f1b From 08a913068ea426a7bd7c520ef140f3a2f50b8939 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 4 Sep 2005 07:40:37 +0000 Subject: * TODO: + CGI::Carp is already implemented --- TODO | 4 ---- 1 file changed, 4 deletions(-) diff --git a/TODO b/TODO index 9ecd2ef..5a8f386 100644 --- a/TODO +++ b/TODO @@ -41,10 +41,6 @@ - suggested by Leos Bitto, -* CGI LOGGING - replace the __WARN__ and __DIE__ handlers with CGI::Carp? - Problems with speedy? - * CGI RETURN VALUE return something else than 200 OK in error situations at least when updating DYNAMIC addresses -- cgit v1.2.3-24-g4f1b From 733f5ee3d4aad0c1a21d796d5a36baa82389e199 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 4 Sep 2005 09:20:48 +0000 Subject: * 2.0/lib/Smokeping.pm, 2.0/TODO, 2.0/CHANGES: + return '404 not found' when DYNAMIC updates fail --- CHANGES | 2 ++ TODO | 6 ------ lib/Smokeping.pm | 19 ++++++++++++------- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/CHANGES b/CHANGES index 4d19be9..bb48678 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,5 @@ +* return '404 not found' when DYNAMIC updates fail + - niko, suggested by Marc Haber * make errors in DYNAMIC updates appear in the web server error log -- niko * remove a quotemeta() call in Config::Grammar to allow metacharacters diff --git a/TODO b/TODO index 5a8f386..625350f 100644 --- a/TODO +++ b/TODO @@ -41,12 +41,6 @@ - suggested by Leos Bitto, -* CGI RETURN VALUE - return something else than 200 OK in error situations at least - when updating DYNAMIC addresses - - suggested by Marc Haber, - - * CONFIG make the .adr (and .snmp) directory configurable - suggested by Marc Haber, diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 050cb34..18415f4 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -118,11 +118,11 @@ 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); @@ -2568,15 +2568,20 @@ sub cgi ($) { umask 022; load_cfg shift; my $q=new CGI; - print $q->header(-type=>'text/html', - -expires=>'+'.($cfg->{Database}{step}).'s', - -charset=> ( $cfg->{Presentation}{charset} || 'iso-8859-15') - ); initialize_cgilog(); if ($q->param(-name=>'secret') && $q->param(-name=>'target') ) { my $ret = update_dynaddr $cfg,$q; - do_cgilog($ret) if defined $ret and $ret ne ""; + 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') + ); display_webpage $cfg,$q; } } -- cgit v1.2.3-24-g4f1b From 3946df708ae20686c8453eb55be934103daf2f7e Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 4 Sep 2005 11:34:08 +0000 Subject: * lib/Smokeping.pm, lib/Smokeping/probes/base.pm, doc/smokeping_upgrade.pod, TODO, CHANGES: + the DYNAMIC-related files (.adr and .snmp) can now be located outside "datadir" by specifying the new configuration variable "dyndir" --- CHANGES | 5 ++++- TODO | 5 ----- doc/smokeping_upgrade.pod | 11 +++++++++++ lib/Smokeping.pm | 25 ++++++++++++++++++++++--- lib/Smokeping/probes/base.pm | 33 ++++++++++++++++++++++++++------- 5 files changed, 63 insertions(+), 16 deletions(-) diff --git a/CHANGES b/CHANGES index bb48678..cf9ca75 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,8 @@ +* the DYNAMIC-related files (.adr and .snmp) can now be located outside "datadir" + by specifying the new configuration variable "dyndir" + -- niko, suggested by Marc Haber * return '404 not found' when DYNAMIC updates fail - - niko, suggested by Marc Haber + -- niko, suggested by Marc Haber * make errors in DYNAMIC updates appear in the web server error log -- niko * remove a quotemeta() call in Config::Grammar to allow metacharacters diff --git a/TODO b/TODO index 625350f..9c13ca2 100644 --- a/TODO +++ b/TODO @@ -41,8 +41,3 @@ - suggested by Leos Bitto, -* CONFIG - make the .adr (and .snmp) directory configurable - - suggested by Marc Haber, - - diff --git a/doc/smokeping_upgrade.pod b/doc/smokeping_upgrade.pod index 61277fc..df5013b 100644 --- a/doc/smokeping_upgrade.pod +++ b/doc/smokeping_upgrade.pod @@ -119,6 +119,17 @@ C variable in your configuration file. You'll then have to delete the old RRD file or somehow convert it to use the new parameters. The C command might be helpful here. +=item Configurable location for DYNAMIC-related files + +There is now a new configuration variable, C, that can be used +to specify the location of the DYNAMIC-related files (.adr and .snmp). +These files used to be kept under C along with the RRD files, +but since they need to be writable by the web server, it may be useful +to separate these. + +If C is not specified, Smokeping will use the C value +as the default. This should ensure that no existing setups will break. + =back In addition to this, some probes have had minor incompatible changes to diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 18415f4..a14699f 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -110,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; @@ -125,7 +130,12 @@ sub update_dynaddr ($$){ 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"){ @@ -852,7 +862,7 @@ sub get_detail ($$$$){ ); # 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${BS}: ", @@ -1567,7 +1577,7 @@ 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 tmail) ], _mandatory => @@ -1637,7 +1647,16 @@ DOC The directory where SmokePing can keep its rrd files. DOC }, + dyndir => + { + %$DIRCHECK_SUB, + _doc => < will be used instead. +DOC + }, piddir => { %$DIRCHECK_SUB, diff --git a/lib/Smokeping/probes/base.pm b/lib/Smokeping/probes/base.pm index a322a21..c0525b6 100644 --- a/lib/Smokeping/probes/base.pm +++ b/lib/Smokeping/probes/base.pm @@ -90,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 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; @@ -107,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); @@ -131,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 = ); close D; - if ( open D, "<$target.snmp" ) { + if ( open D, "<$dynbase.snmp" ) { my $snmp = ; chomp($snmp); if ($snmp ne Smokeping::snmpget_ident $ip) { -- cgit v1.2.3-24-g4f1b From 0fb4bc74b24ea96e80d4e27428b8c2451fbf0eb5 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 4 Sep 2005 11:40:42 +0000 Subject: * lib/Smokeping.pm, CHANGES: + don't create directories in "datadir" when running as a CGI --- CHANGES | 2 ++ lib/Smokeping.pm | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index cf9ca75..4d2d4f9 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,5 @@ +* don't create directories in "datadir" when running as a CGI + -- niko * the DYNAMIC-related files (.adr and .snmp) can now be located outside "datadir" by specifying the new configuration variable "dyndir" -- niko, suggested by Marc Haber diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index a14699f..28923e7 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -363,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"; -- cgit v1.2.3-24-g4f1b