· 9 years ago · Oct 30, 2016, 07:44 PM
1# -*- perl -*-
2package Smokeping;
3
4use strict;
5use CGI;
6use Getopt::Long;
7use Pod::Usage;
8use Digest::MD5 qw(md5_base64);
9use SNMP_util;
10use SNMP_Session;
11# enable locale??
12#use locale;
13use POSIX qw(locale_h signal_h sys_wait_h);
14use Smokeping::Config;
15use RRDs;
16use Sys::Syslog qw(:DEFAULT setlogsock);
17use Sys::Hostname;
18use Smokeping::Colorspace;
19use Smokeping::Master;
20use Smokeping::Slave;
21use Smokeping::RRDhelpers;
22use Smokeping::Graphs;
23use URI::Escape;
24
25setlogsock('unix')
26 if grep /^ $^O $/xo, ("linux", "openbsd", "freebsd", "netbsd");
27
28# make sure we do not end up with , in odd places where one would expect a '.'
29# we set the environment variable so that our 'kids' get the benefit too
30
31my $xssBadRx = qr/[<>%&'";]/;
32
33$ENV{'LC_NUMERIC'}='C';
34if (setlocale(LC_NUMERIC,"") ne "C") {
35 if ($ENV{'LC_ALL'} eq 'C') {
36 # This has got to be a bug in perl/mod_perl, apache or libc
37 die("Your internalization implementation on your operating system is "
38 . "not responding to your setup of LC_ALL to \"C\" as LC_NUMERIC is "
39 . "coming up as \"" . setlocale(LC_NUMERIC, "") . "\" leaving "
40 . "smokeping unable to compare numbers...");
41 }
42 elsif ($ENV{'LC_ALL'} ne "") {
43 # This error is most likely setup related and easy to fix with proper
44 # setup of the operating system or multilanguage locale setup. Hint,
45 # setting LANG is better than setting LC_ALL...
46 die("Resetting LC_NUMERIC failed probably because your international "
47 . "setup of the LC_ALL to \"". $ENV{'LC_ALL'} . "\" is overridding "
48 . "LC_NUMERIC. Setting LC_ALL is not compatible with smokeping...");
49 }
50 else {
51 # This is pretty nasty to figure out. Seems there are still lots
52 # of bugs in LOCALE behavior and if you get this error, you are
53 # affected by it. The worst is when "setlocale" is reading the
54 # environment variables of your webserver and not reading the PERL
55 # %ENV array like it should.
56 die("Something is wrong with the internalization setup of your "
57 . "operating system, webserver, or the perl plugin to your webserver "
58 . "(like mod_perl) and smokeping can not compare numbers correctly. "
59 . "On unix, check your /etc/locale.gen and run sudo locale-gen, set "
60 . "LC_NUMERIC in your perl plugin config or even your webserver "
61 . "startup script to potentially fix or work around the problem...");
62 }
63}
64
65
66use File::Basename;
67use Smokeping::Examples;
68use Smokeping::RRDtools;
69
70# globale persistent variables for speedy
71use vars qw($cfg $probes $VERSION $havegetaddrinfo $cgimode);
72
73$VERSION = "2.006009";
74
75# we want opts everywhere
76my %opt;
77
78BEGIN {
79 $havegetaddrinfo = 0;
80 eval 'use Socket6';
81 $havegetaddrinfo = 1 unless $@;
82}
83
84my $DEFAULTPRIORITY = 'info'; # default syslog priority
85
86my $logging = 0; # keeps track of whether we have a logging method enabled
87
88sub find_libdir {
89 # find the directory where the probe and matcher modules are located
90 # by looking for 'Smokeping/probes/FPing.pm' in @INC
91 #
92 # yes, this is ugly. Suggestions welcome.
93 for (@INC) {
94 -f "$_/Smokeping/probes/FPing.pm" or next;
95 return $_;
96 }
97 return undef;
98}
99
100sub do_log(@);
101sub load_probe($$$$);
102
103sub dummyCGI::param {
104 return wantarray ? () : "";
105}
106
107sub dummyCGI::script_name {
108 return "sorry_no_script_name_when_running_offline";
109}
110
111sub load_probes ($){
112 my $cfg = shift;
113 my %prbs;
114 foreach my $probe (keys %{$cfg->{Probes}}) {
115 my @subprobes = grep { ref $cfg->{Probes}{$probe}{$_} eq 'HASH' } keys %{$cfg->{Probes}{$probe}};
116 if (@subprobes) {
117 my $modname = $probe;
118 for my $subprobe (@subprobes) {
119 $prbs{$subprobe} = load_probe($modname, $cfg->{Probes}{$probe}{$subprobe},$cfg, $subprobe);
120 }
121 } else {
122 $prbs{$probe} = load_probe($probe, $cfg->{Probes}{$probe},$cfg, $probe);
123 }
124 }
125 return \%prbs;
126};
127
128sub load_probe ($$$$) {
129 my $modname = shift;
130 my $properties = shift;
131 my $cfg = shift;
132 my $name = shift;
133 $name = $modname unless defined $name;
134 # just in case, make sure we have the module loaded. unless
135 # we are running as slave, this will already be the case
136 # after reading the config file
137 eval 'require Smokeping::probes::'.$modname;
138 die "$@\n" if $@;
139 my $rv;
140 eval '$rv = Smokeping::probes::'.$modname.'->new( $properties,$cfg,$name);';
141 die "$@\n" if $@;
142 die "Failed to load Probe $name (module $modname)\n" unless defined $rv;
143 return $rv;
144}
145
146sub snmpget_ident ($) {
147 my $host = shift;
148 $SNMP_Session::suppress_warnings = 10; # be silent
149 my @get = snmpget("${host}::1:1:1", qw(sysContact sysName sysLocation));
150 return undef unless @get;
151 my $answer = join "/", grep { defined } @get;
152 $answer =~ s/\s+//g;
153 return $answer;
154}
155
156sub cgiurl {
157 my ($q, $cfg) = @_;
158 my %url_of = (
159 absolute => $cfg->{General}{cgiurl},
160 relative => q{},
161 original => $q->script_name,
162 );
163 my $linkstyle = $cfg->{General}->{linkstyle};
164 die('unknown value for $cfg->{General}->{linkstyle}: '
165 . $linkstyle
166 ) unless exists $url_of{$linkstyle};
167 return $url_of{$linkstyle};
168}
169
170sub hierarchy ($){
171 my $q = shift;
172 my $hierarchy = '';
173 my $h = $q->param('hierarchy');
174 if ($q->param('hierarchy')){
175 $h =~ s/$xssBadRx/_/g;
176 $hierarchy = 'hierarchy='.$h.';';
177 };
178 return $hierarchy;
179}
180sub lnk ($$) {
181 my ($q, $path) = @_;
182 if ($q->isa('dummyCGI')) {
183 return $path . ".html";
184 } else {
185 return cgiurl($q, $cfg) . "?".hierarchy($q)."target=" . $path;
186 }
187}
188
189sub dyndir ($) {
190 my $cfg = shift;
191 return $cfg->{General}{dyndir} || $cfg->{General}{datadir};
192}
193
194sub make_cgi_directories {
195 my $targets = shift;
196 my $dir = shift;
197 my $perms = shift;
198 while (my ($k, $v) = each %$targets) {
199 next if ref $v ne "HASH";
200 if ( ! -d "$dir/$k" ) {
201 my $saved = umask 0;
202 mkdir "$dir/$k", oct($perms);
203 umask $saved;
204 }
205 make_cgi_directories($targets->{$k}, "$dir/$k", $perms);
206 }
207}
208
209sub update_dynaddr ($$){
210 my $cfg = shift;
211 my $q = shift;
212 my @target = split /\./, $q->param('target');
213 my $secret = md5_base64($q->param('secret'));
214 my $address = $ENV{REMOTE_ADDR};
215 my $targetptr = $cfg->{Targets};
216 foreach my $step (@target){
217 $step =~ s/$xssBadRx/_/g;
218 return "Error: Unknown target $step"
219 unless defined $targetptr->{$step};
220 $targetptr = $targetptr->{$step};
221 };
222 return "Error: Invalid target or secret"
223 unless defined $targetptr->{host} and
224 $targetptr->{host} eq "DYNAMIC/${secret}";
225 my $file = dyndir($cfg);
226 for (0..$#target-1) {
227 $file .= "/" . $target[$_];
228 ( -d $file ) || mkdir $file, 0755;
229 }
230 $file.= "/" . $target[-1];
231 my $prevaddress = "?";
232 my $snmp = snmpget_ident $address;
233 if (-r "$file.adr" and not -z "$file.adr"){
234 open(D, "<$file.adr")
235 or return "Error opening $file.adr: $!\n";
236 chomp($prevaddress = <D>);
237 close D;
238 }
239
240 if ( $prevaddress ne $address){
241 open(D, ">$file.adr.new")
242 or return "Error writing $file.adr.new: $!";
243 print D $address,"\n";
244 close D;
245 rename "$file.adr.new","$file.adr";
246 }
247 if ( $snmp ) {
248 open (D, ">$file.snmp.new")
249 or return "Error writing $file.snmp.new: $!";
250 print D $snmp,"\n";
251 close D;
252 rename "$file.snmp.new", "$file.snmp";
253 } elsif ( -f "$file.snmp") { unlink "$file.snmp" };
254
255}
256sub sendmail ($$$){
257 my $from = shift;
258 my $to = shift;
259 $to = $1 if $to =~ /<(.*?)>/;
260 my $body = shift;
261 if ($cfg->{General}{mailhost} and
262 my $smtp = Net::SMTP->new([split /\s*,\s*/, $cfg->{General}{mailhost}],Timeout=>5) ){
263 $smtp->mail($from);
264 $smtp->to(split(/\s*,\s*/, $to));
265 $smtp->data();
266 $smtp->datasend($body);
267 $smtp->dataend();
268 $smtp->quit;
269 } elsif ($cfg->{General}{sendmail} or -x "/usr/lib/sendmail"){
270 open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to);
271 print M $body;
272 close M;
273 } else {
274 warn "ERROR: not sending mail to $to, as all methodes failed\n";
275 }
276}
277
278sub sendsnpp ($$){
279 my $to = shift;
280 my $msg = shift;
281 if ($cfg->{General}{snpphost} and
282 my $snpp = Net::SNPP->new($cfg->{General}{snpphost}, Timeout => 60)){
283 $snpp->send( Pager => $to,
284 Message => $msg) || do_debuglog("ERROR - ". $snpp->message);
285 $snpp->quit;
286 } else {
287 warn "ERROR: not sending page to $to, as all SNPP setup failed\n";
288 }
289}
290
291sub min ($$) {
292 my ($a, $b) = @_;
293 return $a < $b ? $a : $b;
294}
295
296sub init_alerts ($){
297 my $cfg = shift;
298 foreach my $al (keys %{$cfg->{Alerts}}) {
299 my $x = $cfg->{Alerts}{$al};
300 next unless ref $x eq 'HASH';
301 if ($x->{type} eq 'matcher'){
302 $x->{pattern} =~ /(\S+)\((.+)\)/
303 or die "ERROR: Alert $al pattern entry '$_' is invalid\n";
304 my $matcher = $1;
305 my $arg = $2;
306 die "ERROR: matcher $matcher: all matchers start with a capital letter since version 2.0\n"
307 unless $matcher =~ /^[A-Z]/;
308 eval 'require Smokeping::matchers::'.$matcher;
309 die "Matcher '$matcher' could not be loaded: $@\n" if $@;
310 my $hand;
311 eval "\$hand = Smokeping::matchers::$matcher->new($arg)";
312 die "ERROR: Matcher '$matcher' could not be instantiated\nwith arguments $arg:\n$@\n" if $@;
313 $x->{minlength} = $hand->Length;
314 $x->{maxlength} = $x->{minlength};
315 $x->{sub} = sub { $hand->Test(shift) } ;
316 } else {
317 my $sub_front = <<SUB;
318sub {
319 my \$d = shift;
320 my \$y = \$d->{$x->{type}};
321 for(1){
322SUB
323 my $sub;
324 my $sub_back = " return 1;\n }\n return 0;\n}\n";
325 my @ops = split /\s*,\s*/, $x->{pattern};
326 $x->{minlength} = scalar grep /^[!=><]/, @ops;
327 $x->{maxlength} = $x->{minlength};
328 my $multis = scalar grep /^[*]/, @ops;
329 my $it = "";
330 for(1..$multis){
331 my $ind = " " x ($_-1);
332 my $extra = "";
333 for (1..$_-1) {
334 $extra .= "-\$i$_";
335 }
336 $sub .= <<FOR;
337$ind my \$i$_;
338$ind for(\$i$_=0; \$i$_ < min(\$maxlength$extra,\$imax$_); \$i$_++){
339FOR
340 };
341 my $i = - $x->{maxlength};
342 my $incr = 0;
343 for (@ops) {
344 my $extra = "";
345 $it = " " x $multis;
346 for(1..$multis){
347 $extra .= "-\$i$_";
348 };
349 /^(==|!=|<|>|<=|>=|\*)(\d+(?:\.\d*)?|U|S|\d*\*)(%?)(?:(<|>|<=|>=)(\d+(?:\.\d*)?)(%?))?$/
350 or die "ERROR: Alert $al pattern entry '$_' is invalid\n";
351 my $op = $1;
352 my $value = $2;
353 my $perc = $3;
354 my $op2 = $4;
355 my $value2 = $5;
356 my $perc2 = $6;
357 if ($op eq '*') {
358 if ($value =~ /^([1-9]\d*)\*$/) {
359 $value = $1;
360 $x->{maxlength} += $value;
361 $sub_front .= " my \$imax$multis = min(\@\$y - $x->{minlength}, $value);\n";
362 $sub_back .= "\n";
363 $sub .= <<FOR;
364$it last;
365$it }
366$it return 0 if \$i$multis >= min(\$maxlength$extra,\$imax$multis);
367FOR
368
369 $multis--;
370 next;
371 } else {
372 die "ERROR: multi-match operator * must be followed by Number* in Alert $al definition\n";
373 }
374 } elsif ($value eq 'U') {
375 if ($op eq '==') {
376 $sub .= "$it next if defined \$y->[$i$extra];\n";
377 } elsif ($op eq '!=') {
378 $sub .= "$it next unless defined \$y->[$i$extra];\n";
379 } else {
380 die "ERROR: invalid operator $op in connection U in Alert $al definition\n";
381 }
382 } elsif ($value eq 'S') {
383 if ($op eq '==') {
384 $sub .= "$it next unless defined \$y->[$i$extra] and \$y->[$i$extra] eq 'S';\n";
385 } else {
386 die "ERROR: S is only valid with == operator in Alert $al definition\n";
387 }
388 } elsif ($value eq '*') {
389 if ($op ne '==') {
390 die "ERROR: operator $op makes no sense with * in Alert $al definition\n";
391 } # do nothing else ...
392 } else {
393 if ( $x->{type} eq 'loss') {
394 die "ERROR: loss should be specified in % (alert $al pattern)\n" unless $perc eq "%";
395 } elsif ( $x->{type} eq 'rtt' ) {
396 $value /= 1000;
397 } else {
398 die "ERROR: unknown alert type $x->{type}\n";
399 }
400 $sub .= <<IF;
401$it next unless defined \$y->[$i$extra]
402$it and \$y->[$i$extra] =~ /^\\d/
403$it and \$y->[$i$extra] $op $value
404IF
405 if ($op2){
406 if ( $x->{type} eq 'loss') {
407 die "ERROR: loss should be specified in % (alert $al pattern)\n" unless $perc2 eq "%";
408 } elsif ( $x->{type} eq 'rtt' ) {
409 $value2 /= 1000;
410 }
411 $sub .= <<IF;
412$it and \$y->[$i$extra] $op2 $value2
413IF
414 }
415 $sub .= "$it ;";
416 }
417 $i++;
418 }
419 $sub_front .= "$it my \$minlength = $x->{minlength};\n";
420 $sub_front .= "$it my \$maxlength = $x->{maxlength};\n";
421 $sub_front .= "$it next if scalar \@\$y < \$minlength ;\n";
422 do_debuglog(<<COMP);
423### Compiling alert detector pattern '$al'
424### $x->{pattern}
425$sub_front$sub$sub_back
426COMP
427 $x->{sub} = eval ( $sub_front.$sub.$sub_back );
428 die "ERROR: compiling alert pattern $al ($x->{pattern}): $@\n" if $@;
429 }
430 }
431}
432
433
434sub check_filter ($$) {
435 my $cfg = shift;
436 my $name = shift;
437 # remove the path prefix when filtering and make sure the path again starts with /
438 my $prefix = $cfg->{General}{datadir};
439 $name =~ s|^${prefix}/*|/|;
440 # if there is a filter do neither schedule these nor make rrds
441 if ($opt{filter} && scalar @{$opt{filter}}){
442 my $ok = 0;
443 for (@{$opt{filter}}){
444 /^\!(.+)$/ && do {
445 my $rx = $1;
446 $name !~ /^$rx/ && do{ $ok = 1};
447 next;
448 };
449 /^(.+)$/ && do {
450 my $rx = $1;
451 $name =~ /^$rx/ && do {$ok = 1};
452 next;
453 };
454 }
455 return $ok;
456 };
457 return 1;
458}
459
460sub add_targets ($$$$);
461sub add_targets ($$$$){
462 my $cfg = shift;
463 my $probes = shift;
464 my $tree = shift;
465 my $name = shift;
466 die "Error: Invalid Probe: $tree->{probe}" unless defined $probes->{$tree->{probe}};
467 my $probeobj = $probes->{$tree->{probe}};
468 foreach my $prop (keys %{$tree}) {
469 if (ref $tree->{$prop} eq 'HASH'){
470 add_targets $cfg, $probes, $tree->{$prop}, "$name/$prop";
471 }
472 if ($prop eq 'host' and ( check_filter($cfg,$name) and $tree->{$prop} !~ m|^/| )) {
473 if($tree->{host} =~ /^DYNAMIC/) {
474 $probeobj->add($tree,$name);
475 } else {
476 $probeobj->add($tree,$tree->{host});
477 }
478 }
479 }
480}
481
482
483sub init_target_tree ($$$$); # predeclare recursive subs
484sub init_target_tree ($$$$) {
485 my $cfg = shift;
486 my $probes = shift;
487 my $tree = shift;
488 my $name = shift;
489 my $hierarchies = $cfg->{__hierarchies};
490 die "Error: Invalid Probe: $tree->{probe}" unless defined $probes->{$tree->{probe}};
491 my $probeobj = $probes->{$tree->{probe}};
492
493 if ($tree->{alerts}){
494 die "ERROR: no Alerts section\n"
495 unless exists $cfg->{Alerts};
496 $tree->{alerts} = [ split(/\s*,\s*/, $tree->{alerts}) ] unless ref $tree->{alerts} eq 'ARRAY';
497 $tree->{fetchlength} = 0;
498 foreach my $al (@{$tree->{alerts}}) {
499 die "ERROR: alert $al ($name) is not defined\n"
500 unless defined $cfg->{Alerts}{$al};
501 $tree->{fetchlength} = $cfg->{Alerts}{$al}{maxlength}
502 if $tree->{fetchlength} < $cfg->{Alerts}{$al}{maxlength};
503 }
504 };
505 # fill in menu and title if missing
506 $tree->{menu} ||= $tree->{host} || "unknown";
507 $tree->{title} ||= $tree->{host} || "unknown";
508 my $real_path = $name;
509 my $dataroot = $cfg->{General}{datadir};
510 $real_path =~ s/^$dataroot\/*//;
511 my @real_path = split /\//, $real_path;
512
513 foreach my $prop (keys %{$tree}) {
514 if (ref $tree->{$prop} eq 'HASH'){
515 if (not -d $name and not $cgimode) {
516 mkdir $name, 0755 or die "ERROR: mkdir $name: $!\n";
517 };
518
519 if (defined $tree->{$prop}{parents}){
520 for my $parent (split /\s/, $tree->{$prop}{parents}){
521 my($hierarchy,$path)=split /:/,$parent,2;
522 die "ERROR: unknown hierarchy $hierarchy in $name. Make sure it is listed in Presentation->hierarchies.\n"
523 unless $cfg->{Presentation}{hierarchies} and $cfg->{Presentation}{hierarchies}{$hierarchy};
524 my @path = split /\/+/, $path;
525 shift @path; # drop empty root element;
526 if ( not exists $hierarchies->{$hierarchy} ){
527 $hierarchies->{$hierarchy} = {};
528 };
529 my $point = $hierarchies->{$hierarchy};
530 for my $item (@path){
531 if (not exists $point->{$item}){
532 $point->{$item} = {};
533 }
534 $point = $point->{$item};
535 };
536 $point->{$prop}{__tree_link} = $tree->{$prop};
537 $point->{$prop}{__real_path} = [ @real_path,$prop ];
538 }
539 }
540 init_target_tree $cfg, $probes, $tree->{$prop}, "$name/$prop";
541 }
542 if ($prop eq 'host' and check_filter($cfg,$name) and $tree->{$prop} !~ m|^/|) {
543 # print "init $name\n";
544 my $step = $probeobj->step();
545 # we have to do the add before calling the _pings method, it won't work otherwise
546 my $pings = $probeobj->_pings($tree);
547 my @slaves = ("");
548
549 if ($tree->{slaves}){
550 push @slaves, split /\s+/, $tree->{slaves};
551 };
552 for my $slave (@slaves){
553 die "ERROR: slave '$slave' is not defined in the '*** Slaves ***' section!\n"
554 unless $slave eq '' or defined $cfg->{Slaves}{$slave};
555 my $s = $slave ? "~".$slave : "";
556 my @create =
557 ($name.$s.".rrd", "--start",(time-1),"--step",$step,
558 "DS:uptime:GAUGE:".(2*$step).":0:U",
559 "DS:loss:GAUGE:".(2*$step).":0:".$pings,
560 "DS:median:GAUGE:".(2*$step).":0:180",
561 (map { "DS:ping${_}:GAUGE:".(2*$step).":0:180" }
562 1..$pings),
563 (map { "RRA:".(join ":", @{$_}) } @{$cfg->{Database}{_table}} ));
564 if (not -f $name.$s.".rrd"){
565 unless ($cgimode) {
566 do_debuglog("Calling RRDs::create(@create)");
567 RRDs::create(@create);
568 my $ERROR = RRDs::error();
569 do_log "RRDs::create ERROR: $ERROR\n" if $ERROR;
570 }
571 } else {
572 shift @create; # remove the filename
573 my ($fatal, $comparison) = Smokeping::RRDtools::compare($name.$s.".rrd", \@create);
574 die("Error: RRD parameter mismatch ('$comparison'). You must delete $name$s.rrd or fix the configuration parameters.\n")
575 if $fatal;
576 warn("Warning: RRD parameter mismatch('$comparison'). Continuing anyway.\n") if $comparison and not $fatal;
577 Smokeping::RRDtools::tuneds($name.$s.".rrd", \@create);
578 }
579 }
580 }
581 }
582};
583
584sub enable_dynamic($$$$);
585sub enable_dynamic($$$$){
586 my $cfg = shift;
587 my $cfgfile = $cfg->{__cfgfile};
588 my $tree = shift;
589 my $path = shift;
590 my $email = ($tree->{email} || shift);
591 my $print;
592 die "ERROR: smokemail property in $cfgfile not specified\n" unless defined $cfg->{General}{smokemail};
593 die "ERROR: cgiurl property in $cfgfile not specified\n" unless defined $cfg->{General}{cgiurl};
594 if (defined $tree->{host} and $tree->{host} eq 'DYNAMIC' ) {
595 if ( not defined $email ) {
596 warn "WARNING: No email address defined for $path\n";
597 } else {
598 my $usepath = $path;
599 $usepath =~ s/\.$//;
600 my $secret = int(rand 1000000);
601 my $md5 = md5_base64($secret);
602 open C, "<$cfgfile" or die "ERROR: Reading $cfgfile: $!\n";
603 open G, ">$cfgfile.new" or die "ERROR: Writing $cfgfile.new: $!\n";
604 my $section ;
605 my @goal = split /\./, $usepath;
606 my $indent = "+";
607 my $done;
608 while (<C>){
609 $done && do { print G; next };
610 /^\s*\Q*** Targets ***\E\s*$/ && do{$section = 'match'};
611 @goal && $section && /^\s*\Q${indent}\E\s*\Q$goal[0]\E/ && do {
612 $indent .= "+";
613 shift @goal;
614 };
615 (not @goal) && /^\s*host\s*=\s*DYNAMIC$/ && do {
616 print G "host = DYNAMIC/$md5\n";
617 $done = 1;
618 next;
619 };
620 print G;
621 }
622 close G;
623 rename "$cfgfile.new", $cfgfile;
624 close C;
625 my $body;
626 open SMOKE, $cfg->{General}{smokemail} or die "ERROR: can't read $cfg->{General}{smokemail}: $!\n";
627 while (<SMOKE>){
628 s/<##PATH##>/$usepath/ig;
629 s/<##SECRET##>/$secret/ig;
630 s/<##URL##>/$cfg->{General}{cgiurl}/;
631 s/<##FROM##>/$cfg->{General}{contact}/;
632 s/<##OWNER##>/$cfg->{General}{owner}/;
633 s/<##TO##>/$email/;
634 $body .= $_;
635 }
636 close SMOKE;
637
638
639 my $mail;
640 print STDERR "Sending smoke-agent for $usepath to $email ... ";
641 sendmail $cfg->{General}{contact},$email,$body;
642 print STDERR "DONE\n";
643 }
644 }
645 foreach my $prop ( keys %{$tree}) {
646 enable_dynamic $cfg, $tree->{$prop},"$path$prop.",$email if ref $tree->{$prop} eq 'HASH';
647 }
648};
649
650sub get_tree($$){
651 my $cfg = shift;
652 my $open = shift;
653 my $tree = $cfg->{Targets};
654 for (@{$open}){
655 $tree = $tree->{$_};
656 }
657 return $tree;
658}
659
660sub target_menu($$$$;$);
661sub target_menu($$$$;$){
662 my $tree = shift;
663 my $open = shift;
664 $open = [@$open]; # make a copy
665 my $path = shift;
666 my $filter = shift;
667 my $suffix = shift || '';
668 my $print;
669 my $current = shift @{$open} || "";
670 my @hashes;
671 foreach my $prop (sort {exists $tree->{$a}{_order} ? ($tree->{$a}{_order} <=> $tree->{$b}{_order}) : ($a cmp $b)}
672 grep { ref $tree->{$_} eq 'HASH' and not /^__/ }
673 keys %$tree) {
674 push @hashes, $prop;
675 }
676 return wantarray ? () : "" unless @hashes;
677
678 $print .= qq{<table width="100%" class="menu" border="0" cellpadding="0" cellspacing="0">\n}
679 unless $filter;
680
681 my @matches;
682 for my $key (@hashes) {
683
684 my $menu = $key;
685 my $title = $key;
686 my $hide;
687 my $host;
688 my $menuextra;
689 if ($tree->{$key}{__tree_link} and $tree->{$key}{__tree_link}{menu}){
690 $menu = $tree->{$key}{__tree_link}{menu};
691 $title = $tree->{$key}{__tree_link}{title};
692 $host = $tree->{$key}{__tree_link}{host};
693 $menuextra = $tree->{$key}{__tree_link}{menuextra};
694 next if $tree->{$key}{__tree_link}{hide} and $tree->{$key}{__tree_link}{hide} eq 'yes';
695 } elsif ($tree->{$key}{menu}) {
696 $menu = $tree->{$key}{menu};
697 $title = $tree->{$key}{title};
698 $host = $tree->{$key}{host};
699 $menuextra = $tree->{$key}{menuextra};
700 next if $tree->{$key}{hide} and $tree->{$key}{hide} eq 'yes';
701 }
702
703 # no menuextra for multihost
704 if (not $host or $host =~ m|^/|){
705 $menuextra = undef;
706 }
707
708 my $class = 'menuitem';
709 if ($key eq $current ){
710 if ( @$open ) {
711 $class = 'menuopen';
712 } else {
713 $class = 'menuactive';
714 }
715 };
716 if ($filter){
717 if (($menu and $menu =~ /$filter/i) or ($title and $title =~ /$filter/i)){
718 push @matches, ["$path$key$suffix",$menu,$class];
719 };
720 push @matches, target_menu($tree->{$key}, $open, "$path$key.",$filter, $suffix);
721 }
722 else {
723 $menu =~ s/ / /g;
724 my $menuclass = "menulink";
725 if ($key eq $current and !@$open) {
726 $menuclass = "menulinkactive";
727 }
728 if ($menuextra){
729 $menuextra =~ s/{HOST}/#$host/g;
730 $menuextra =~ s/{CLASS}/$menuclass/g;
731 $menuextra =~ s/{HASH}/#/g;
732 $menuextra =~ s/{HOSTNAME}/$host/g;
733 $menuextra = ' '.$menuextra;
734 } else {
735 $menuextra = '';
736 }
737
738 my $menuadd ="";
739 $menuadd = " " x (20 - length($menu.$menuextra)) if length($menu.$menuextra) < 20;
740 $print .= qq{<tr><td class="$class" colspan="2"> - <a class="$menuclass" HREF="$path$key$suffix">$menu</a>$menuextra$menuadd</td></tr>\n};
741 if ($key eq $current){
742 my $prline = target_menu $tree->{$key}, $open, "$path$key.",$filter, $suffix;
743 $print .= qq{<tr><td class="$class"> </td><td align="left">$prline</td></tr>}
744 if $prline;
745 }
746 }
747 }
748 $print .= "</table>\n" unless $filter;
749 if ($filter){
750 if (wantarray()){
751 return @matches;
752 }
753 else {
754 for my $entry (sort {$a->[1] cmp $b->[1] } grep {ref $_ eq 'ARRAY'} @matches) {
755 my ($href,$menu,$class) = @{$entry};
756 $print .= qq{<div class="$class">- <a class="menulink" href="$href">$menu</a></div>\n};
757 }
758 }
759 }
760 return $print;
761};
762
763
764sub fill_template ($$;$){
765 my $template = shift;
766 my $subst = shift;
767 my $data = shift;
768 if ($template){
769 my $line = $/;
770 undef $/;
771 open I, $template or return undef;
772 $data = <I>;
773 close I;
774 $/ = $line;
775 }
776 foreach my $tag (keys %{$subst}) {
777 my $replace = $subst->{$tag} || '';
778 $data =~ s/<##${tag}##>/$replace/g;
779 }
780 return $data;
781}
782
783sub exp2seconds ($) {
784 my $x = shift;
785 $x =~/(\d+)m/ && return $1*60;
786 $x =~/(\d+)h/ && return $1*60*60;
787 $x =~/(\d+)d/ && return $1*60*60*24;
788 $x =~/(\d+)w/ && return $1*60*60*24*7;
789 $x =~/(\d+)y/ && return $1*60*60*24*365;
790 return $x;
791}
792
793sub calc_stddev {
794 my $rrd = shift;
795 my $id = shift;
796 my $pings = shift;
797 my @G = map {("DEF:pin${id}p${_}=${rrd}:ping${_}:AVERAGE","CDEF:p${id}p${_}=pin${id}p${_},UN,0,pin${id}p${_},IF")} 1..$pings;
798 push @G, "CDEF:pings${id}="."$pings,p${id}p1,UN,".join(",",map {"p${id}p$_,UN,+"} 2..$pings).",-";
799 push @G, "CDEF:m${id}="."p${id}p1,".join(",",map {"p${id}p$_,+"} 2..$pings).",pings${id},/";
800 push @G, "CDEF:sdev${id}=p${id}p1,m${id},-,DUP,*,".join(",",map {"p${id}p$_,m${id},-,DUP,*,+"} 2..$pings).",pings${id},/,SQRT";
801 return @G;
802}
803
804sub brighten_webcolor {
805 my $web = shift;
806 my @rgb = Smokeping::Colorspace::web_to_rgb($web);
807 my @hsl = Smokeping::Colorspace::rgb_to_hsl(@rgb);
808 $hsl[2] = (1 - $hsl[2]) * (2/3) + $hsl[2];
809 @rgb = Smokeping::Colorspace::hsl_to_rgb(@hsl);
810 return Smokeping::Colorspace::rgb_to_web(@rgb);
811}
812
813sub get_overview ($$$$){
814 my $cfg = shift;
815 my $q = shift;
816 my $tree = shift;
817 my $open = shift;
818
819 my $page ="";
820
821 my $date = $cfg->{Presentation}{overview}{strftime} ?
822 POSIX::strftime($cfg->{Presentation}{overview}{strftime},
823 localtime(time)) : scalar localtime(time);
824
825 if ( $RRDs::VERSION >= 1.199908 ){
826 $date =~ s|:|\\:|g;
827 }
828 foreach my $prop (sort {exists $tree->{$a}{_order} ? ($tree->{$a}{_order} <=> $tree->{$b}{_order}) : ($a cmp $b)}
829 grep { ref $tree->{$_} eq 'HASH' and not /^__/ }
830 keys %$tree) {
831 my @slaves;
832
833 my $phys_tree = $tree->{$prop};
834 my $phys_open = $open;
835 my $dir = "";
836 if ($tree->{$prop}{__tree_link}){
837 $phys_tree = $tree->{$prop}{__tree_link};
838 $phys_open = [ @{$tree->{$prop}{__real_path}} ];
839 pop @$phys_open;
840 }
841
842 next unless $phys_tree->{host};
843 next if $phys_tree->{hide} and $phys_tree->{hide} eq 'yes';
844
845 if (not $phys_tree->{nomasterpoll} or $phys_tree->{nomasterpoll} eq 'no'){
846 @slaves = ("");
847 };
848
849 if ($phys_tree->{host} =~ m|^/|){ # multi host syntax
850 @slaves = split /\s+/, $phys_tree->{host};
851 }
852 elsif ($phys_tree->{slaves}){
853 push @slaves, split /\s+/,$phys_tree->{slaves};
854 }
855
856 next if 0 == @slaves;
857
858 for (@$phys_open) {
859 $dir .= "/$_";
860 mkdir $cfg->{General}{imgcache}.$dir, 0755
861 unless -d $cfg->{General}{imgcache}.$dir;
862 die "ERROR: creating $cfg->{General}{imgcache}$dir: $!\n"
863 unless -d $cfg->{General}{imgcache}.$dir;
864 }
865
866 my @G; #Graph 'script'
867 my $max = $cfg->{Presentation}{overview}{max_rtt} || "100000";
868 my $probe = $probes->{$phys_tree->{probe}};
869 my $pings = $probe->_pings($phys_tree);
870 my $i = 0;
871 my @colors = split /\s+/, $cfg->{Presentation}{multihost}{colors};
872 my $ProbeUnit = $probe->ProbeUnit();
873 for my $slave (@slaves){
874 $i++;
875 my $rrd;
876 my $medc;
877 my $label;
878 if ($slave =~ m|^/|){ # multihost entry
879 $rrd = $cfg->{General}{datadir}.'/'.$slave.".rrd";
880 $medc = shift @colors;
881 my @tree_path = split /\//,$slave;
882 shift @tree_path;
883 my ($host,$real_slave) = split /~/, $tree_path[-1]; #/
884 $tree_path[-1]= $host;
885 my $tree = get_tree($cfg,\@tree_path);
886 # not all multihost entries must have the same number of pings
887 $probe = $probes->{$tree->{probe}};
888 $pings = $probe->_pings($tree);
889 $label = $tree->{menu};
890 # if there are multiple units ... lets say so ...
891 if ($ProbeUnit ne $probe->ProbeUnit()){
892 $ProbeUnit = 'var units';
893 }
894
895 if ($real_slave){
896 $label .= "<". $cfg->{Slaves}{$real_slave}{display_name};
897 }
898 $label = sprintf("%-20s",$label);
899 push @colors, $medc;
900 }
901 else {
902 my $s = $slave ? "~".$slave : "";
903 $rrd = $cfg->{General}{datadir}.$dir.'/'.$prop.$s.'.rrd';
904 $medc = $slave ? $cfg->{Slaves}{$slave}{color} : ($cfg->{Presentation}{overview}{median_color} || shift @colors);
905 if ($#slaves > 0){
906 $label = sprintf("%-25s","median RTT from ".($slave ? $cfg->{Slaves}{$slave}{display_name} : $cfg->{General}{display_name} || hostname));
907 }
908 else {
909 $label = "med RTT"
910 }
911 };
912
913 my $sdc = $medc;
914 $sdc =~ s/^(......).*/${1}30/;
915 push @G,
916 "DEF:median$i=${rrd}:median:AVERAGE",
917 "DEF:loss$i=${rrd}:loss:AVERAGE",
918 "CDEF:ploss$i=loss$i,$pings,/,100,*",
919 "CDEF:dm$i=median$i,0,$max,LIMIT",
920 calc_stddev($rrd,$i,$pings),
921 "CDEF:dmlow$i=dm$i,sdev$i,2,/,-",
922 "CDEF:s2d$i=sdev$i",
923# "CDEF:dm2=median,1.5,*,0,$max,LIMIT",
924# "LINE1:dm2", # this is for kicking things down a bit
925 "AREA:dmlow$i",
926 "AREA:s2d${i}#${sdc}::STACK",
927 "LINE1:dm$i#${medc}:${label}",
928 "VDEF:avmed$i=median$i,AVERAGE",
929 "VDEF:avsd$i=sdev$i,AVERAGE",
930 "CDEF:msr$i=median$i,POP,avmed$i,avsd$i,/",
931 "VDEF:avmsr$i=msr$i,AVERAGE",
932 "GPRINT:avmed$i:%5.1lf %ss av md ",
933 "GPRINT:ploss$i:AVERAGE:%5.1lf %% av ls",
934 "GPRINT:avsd$i:%5.1lf %ss av sd",
935 "GPRINT:avmsr$i:%5.1lf %s am/as\\l";
936
937 }
938 my ($graphret,$xs,$ys) = RRDs::graph
939 ($cfg->{General}{imgcache}.$dir."/${prop}_mini.png",
940 # '--lazy',
941 '--start','-'.exp2seconds($cfg->{Presentation}{overview}{range}),
942 '--title',$phys_tree->{title},
943 '--height',$cfg->{Presentation}{overview}{height},
944 '--width',$cfg->{Presentation}{overview}{width},
945 '--vertical-label', $ProbeUnit,
946 '--imgformat','PNG',
947 '--alt-autoscale-max',
948 '--alt-y-grid',
949 '--rigid',
950 '--lower-limit','0',
951 @G,
952 "COMMENT:$date\\r");
953 my $ERROR = RRDs::error();
954 $page .= "<div>";
955 if (defined $ERROR) {
956 $page .= "ERROR: $ERROR<br>".join("<br>", map {"'$_'"} @G);
957 } else {
958 $page.="<A HREF=\"".lnk($q, (join ".", @$open, ${prop}))."\">".
959 "<IMG BORDER=\"0\" WIDTH=\"$xs\" HEIGHT=\"$ys\" ".
960 "SRC=\"".$cfg->{General}{imgurl}.$dir."/${prop}_mini.png\"></A>";
961 }
962 $page .="</div>"
963 }
964 return $page;
965}
966
967sub findmax ($$) {
968 my $cfg = shift;
969 my $rrd = shift;
970# my $pings = "ping".int($cfg->{Database}{pings}/1.1);
971 my %maxmedian;
972 my @maxmedian;
973 for (@{$cfg->{Presentation}{detail}{_table}}) {
974 my ($desc,$start) = @{$_};
975 $start = exp2seconds($start);
976 my ($graphret,$xs,$ys) = RRDs::graph
977 ("dummy", '--start', -$start,
978 '--width',$cfg->{Presentation}{overview}{width},
979 '--end','-'.int($start / $cfg->{Presentation}{detail}{width}),
980 "DEF:maxping=${rrd}:median:AVERAGE",
981 'PRINT:maxping:MAX:%le' );
982 my $ERROR = RRDs::error();
983 do_log $ERROR if $ERROR;
984 my $val = $graphret->[0];
985 $val = 0 if $val =~ /nan/i;
986 $maxmedian{$start} = $val;
987 push @maxmedian, $val;
988 }
989 my $med = (sort @maxmedian)[int(($#maxmedian) / 2 )];
990 my $max = 0.000001;
991 foreach my $x ( keys %maxmedian ){
992 if ( not defined $cfg->{Presentation}{detail}{unison_tolerance} or (
993 $maxmedian{$x} <= $cfg->{Presentation}{detail}{unison_tolerance} * $med
994 and $maxmedian{$x} >= $med / $cfg->{Presentation}{detail}{unison_tolerance}) ){
995 $max = $maxmedian{$x} unless $maxmedian{$x} < $max;
996 $maxmedian{$x} = undef;
997 };
998 }
999 foreach my $x ( keys %maxmedian ){
1000 if (defined $maxmedian{$x}) {
1001 $maxmedian{$x} *= 1.2;
1002 } else {
1003 $maxmedian{$x} = $max * 1.2;
1004 }
1005
1006 $maxmedian{$x} = $cfg->{Presentation}{detail}{max_rtt}
1007 if $cfg->{Presentation}{detail}{max_rtt}
1008 and $maxmedian{$x} > $cfg->{Presentation}{detail}{max_rtt}
1009 };
1010 return \%maxmedian;
1011}
1012
1013sub smokecol ($) {
1014 my $count = shift;
1015 return [] unless $count > 2;
1016 my $half = $count/2;
1017 my @items;
1018 my $itop=$count;
1019 my $ibot=1;
1020 for (; $itop > $ibot; $itop--,$ibot++){
1021 my $color = int(190/$half * ($half-$ibot))+50;
1022 push @items, "CDEF:smoke${ibot}=cp${ibot},UN,UNKN,cp${itop},cp${ibot},-,IF";
1023 push @items, "AREA:cp${ibot}";
1024 push @items, "STACK:smoke${ibot}#".(sprintf("%02x",$color) x 3);
1025 };
1026 return \@items;
1027}
1028
1029sub parse_datetime($){
1030 my $in = shift;
1031 for ($in){
1032 /^(\d+)$/ && do { my $value = $1; $value = time if $value > 2**32; return $value};
1033 /^\s*(\d{4})-(\d{1,2})-(\d{1,2})(?:\s+(\d{1,2}):(\d{2})(?::(\d{2}))?)?\s*$/ &&
1034 return POSIX::mktime($6||0,$5||0,$4||0,$3,$2-1,$1-1900,0,0,-1);
1035 /^now$/ && return time;
1036 /([ -:a-z0-9]+)/ && return $1;
1037 };
1038 return time;
1039}
1040
1041sub get_detail ($$$$;$){
1042 # when drawing the detail page there are three modes for doing it
1043
1044 # a) 's' classic with several static graphs on the page
1045 # b) 'n' navigator mode with one graph. below the graph one can specify the end time
1046 # and the length of the graph.
1047 # c) 'c' chart mode, one graph with a link to it's full page
1048 # d) 'a' ajax mode, generate image based on given url and dump in on stdout
1049 #
1050 my $cfg = shift;
1051 my $q = shift;
1052 my $tree = shift;
1053 my $open = shift;
1054 my $mode = shift || $q->param('displaymode') || 's';
1055 $mode =~ s/$xssBadRx/_/g;
1056 my $phys_tree = $tree;
1057 my $phys_open = $open;
1058 if ($tree->{__tree_link}){
1059 $phys_tree=$tree->{__tree_link};
1060 $phys_open = $tree->{__real_path};
1061 }
1062
1063 if ($phys_tree->{host} and $phys_tree->{host} =~ m|^/|){
1064 return Smokeping::Graphs::get_multi_detail($cfg,$q,$tree,$open,$mode);
1065 }
1066
1067 # don't distinguish anymore ... tree is now phys_tree
1068 $tree = $phys_tree;
1069
1070 my @slaves;
1071 if (not $tree->{nomasterpoll} or $tree->{nomasterpoll} eq 'no' or $mode eq 'a' or $mode eq 'n'){
1072 @slaves = ("");
1073 };
1074
1075 if ($tree->{slaves} and $mode eq 's'){
1076 push @slaves, split /\s+/,$tree->{slaves};
1077 };
1078
1079 return "" if not defined $tree->{host} or 0 == @slaves;
1080
1081 my $file = $mode eq 'c' ? (split(/~/, $open->[-1]))[0] : $open->[-1];
1082 my @dirs = @{$phys_open};
1083 pop @dirs;
1084 my $dir = "";
1085
1086 return "<div>ERROR: ".(join ".", @dirs)." has no probe defined</div>"
1087 unless $tree->{probe};
1088
1089 return "<div>ERROR: ".(join ".", @dirs)." $tree->{probe} is not known</div>"
1090 unless $cfg->{__probes}{$tree->{probe}};
1091
1092 my $probe = $cfg->{__probes}{$tree->{probe}};
1093 my $ProbeDesc = $probe->ProbeDesc();
1094 my $ProbeUnit = $probe->ProbeUnit();
1095 my $pings = $probe->_pings($tree);
1096 my $step = $probe->step();
1097 my $page;
1098
1099 return "<div>ERROR: unknown displaymode $mode</div>"
1100 unless $mode =~ /^[snca]$/;
1101
1102 for (@dirs) {
1103 $dir .= "/$_";
1104 mkdir $cfg->{General}{imgcache}.$dir, 0755
1105 unless -d $cfg->{General}{imgcache}.$dir;
1106 die "ERROR: creating $cfg->{General}{imgcache}$dir: $!\n"
1107 unless -d $cfg->{General}{imgcache}.$dir;
1108
1109 }
1110 my $base_rrd = $cfg->{General}{datadir}.$dir."/${file}";
1111
1112 my $imgbase;
1113 my $imghref;
1114 my $max = {};
1115 my @tasks;
1116 my %lastheight;
1117
1118 if ($mode eq 's'){
1119 # in nav mode there is only one graph, so the height calculation
1120 # is not necessary.
1121 $imgbase = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}";
1122 $imghref = $cfg->{General}{imgurl}."/".(join "/", @dirs)."/${file}";
1123 @tasks = @{$cfg->{Presentation}{detail}{_table}};
1124 for my $slave (@slaves){
1125 my $s = $slave ? "~$slave" : "";
1126 if (open (HG,"<${imgbase}.maxheight$s")){
1127 while (<HG>){
1128 chomp;
1129 my @l = split / /;
1130 $lastheight{$s}{$l[0]} = $l[1];
1131 }
1132 close HG;
1133 }
1134 $max->{$s} = findmax $cfg, $base_rrd.$s.".rrd";
1135 if (open (HG,">${imgbase}.maxheight$s")){
1136 foreach my $size (keys %{$max->{$s}}){
1137 print HG "$s $max->{$s}{$size}\n";
1138 }
1139 close HG;
1140 }
1141 }
1142 }
1143 elsif ($mode eq 'n' or $mode eq 'a') {
1144 my $slave = (split(/~/, $open->[-1]))[1];
1145 my $name = $slave ? " as seen from ". $cfg->{Slaves}{$slave}{display_name} : "";
1146 mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $cfg->{General}{imgcache}."/__navcache";
1147 # remove old images after one hour
1148 my $pattern = $cfg->{General}{imgcache}."/__navcache/*.png";
1149 for (glob $pattern){
1150 unlink $_ if time - (stat $_)[9] > 3600;
1151 }
1152 if ($mode eq 'n') {
1153 $imgbase =$cfg->{General}{imgcache}."/__navcache/".time()."$$";
1154 $imghref =$cfg->{General}{imgurl}."/__navcache/".time()."$$";
1155 } else {
1156 my $serial = int(rand(2000));
1157 $imgbase =$cfg->{General}{imgcache}."/__navcache/".$serial;
1158 $imghref =$cfg->{General}{imgurl}."/__navcache/".$serial;
1159 }
1160
1161 $q->param('epoch_start',parse_datetime($q->param('start')));
1162 $q->param('epoch_end',parse_datetime($q->param('end')));
1163 my $title = $q->param('title') || ("Navigator Graph".$name);
1164 @tasks = ([$title, parse_datetime($q->param('start')),parse_datetime($q->param('end'))]);
1165 my ($graphret,$xs,$ys) = RRDs::graph
1166 ("dummy",
1167 '--start', $tasks[0][1],
1168 '--end',$tasks[0][2],
1169 "DEF:maxping=${base_rrd}.rrd:median:AVERAGE",
1170 'PRINT:maxping:MAX:%le' );
1171 my $ERROR = RRDs::error();
1172 return "<div>RRDtool did not understand your input: $ERROR.</div>" if $ERROR;
1173 my $val = $graphret->[0];
1174 $val = 1 if $val =~ /nan/i;
1175 $max->{''} = { $tasks[0][1] => $val * 1.5 };
1176 } else {
1177 # chart mode
1178 mkdir $cfg->{General}{imgcache}."/__chartscache",0755 unless -d $cfg->{General}{imgcache}."/__chartscache";
1179 # remove old images after one hour
1180 my $pattern = $cfg->{General}{imgcache}."/__chartscache/*.png";
1181 for (glob $pattern){
1182 unlink $_ if time - (stat $_)[9] > 3600;
1183 }
1184 my $desc = join "/",@{$open};
1185 @tasks = ([$desc , 3600]);
1186 $imgbase = $cfg->{General}{imgcache}."/__chartscache/".(join ".", @dirs).".${file}";
1187 $imghref = $cfg->{General}{imgurl}."/__chartscache/".(join ".", @dirs).".${file}";
1188
1189 my ($graphret,$xs,$ys) = RRDs::graph
1190 ("dummy",
1191 '--start', time()-3600,
1192 '--end', time(),
1193 "DEF:maxping=${base_rrd}.rrd:median:AVERAGE",
1194 'PRINT:maxping:MAX:%le' );
1195 my $ERROR = RRDs::error();
1196 return "<div>RRDtool did not understand your input: $ERROR.</div>" if $ERROR;
1197 my $val = $graphret->[0];
1198 $val = 1 if $val =~ /nan/i;
1199 $max->{''} = { $tasks[0][1] => $val * 1.5 };
1200 }
1201
1202 my $smoke = $pings >= 3
1203 ? smokecol $pings :
1204 [ 'COMMENT:(Not enough pings to draw any smoke.)\s', 'COMMENT:\s' ];
1205 # one \s doesn't seem to be enough
1206 my @upargs;
1207 my @upsmoke;
1208
1209 my %lc;
1210 my %lcback;
1211 if ( defined $cfg->{Presentation}{detail}{loss_colors}{_table} ) {
1212 for (@{$cfg->{Presentation}{detail}{loss_colors}{_table}}) {
1213 my ($num,$col,$txt) = @{$_};
1214 $lc{$num} = [ $txt, "#".$col ];
1215 }
1216 } else {
1217 my $p = $pings;
1218 %lc = (0 => ['0', '#26ff00'],
1219 1 => ["1/$p", '#00b8ff'],
1220 2 => ["2/$p", '#0059ff'],
1221 3 => ["3/$p", '#5e00ff'],
1222 4 => ["4/$p", '#7e00ff'],
1223 int($p/2) => [int($p/2)."/$p", '#dd00ff'],
1224 $p-1 => [($p-1)."/$p", '#ff0000'],
1225 );
1226 };
1227 # determine a more 'pastel' version of the ping colours; this is
1228 # used for the optional loss background colouring
1229 foreach my $key (keys %lc) {
1230 if ($key == 0) {
1231 $lcback{$key} = "";
1232 next;
1233 }
1234 my $web = $lc{$key}[1];
1235 my @rgb = Smokeping::Colorspace::web_to_rgb($web);
1236 my @hsl = Smokeping::Colorspace::rgb_to_hsl(@rgb);
1237 $hsl[2] = (1 - $hsl[2]) * (2/3) + $hsl[2];
1238 @rgb = Smokeping::Colorspace::hsl_to_rgb(@hsl);
1239 $web = Smokeping::Colorspace::rgb_to_web(@rgb);
1240 $lcback{$key} = $web;
1241 }
1242
1243 my %upt;
1244 if ( defined $cfg->{Presentation}{detail}{uptime_colors}{_table} ) {
1245 for (@{$cfg->{Presentation}{detail}{uptime_colors}{_table}}) {
1246 my ($num,$col,$txt) = @{$_};
1247 $upt{$num} = [ $txt, "#".$col];
1248 }
1249 } else {
1250 %upt = (3600 => ['<1h', '#FFD3D3'],
1251 2*3600 => ['<2h', '#FFE4C7'],
1252 6*3600 => ['<6h', '#FFF9BA'],
1253 12*3600 => ['<12h','#F3FFC0'],
1254 24*3600 => ['<1d', '#E1FFCC'],
1255 7*24*3600 => ['<1w', '#BBFFCB'],
1256 30*24*3600 => ['<1m', '#BAFFF5'],
1257 '1e100' => ['>1m', '#DAECFF']
1258 );
1259 }
1260
1261 my $BS = '';
1262 if ( $RRDs::VERSION >= 1.199908 ){
1263 $ProbeDesc =~ s|:|\\:|g;
1264 $BS = '\\';
1265 }
1266
1267 for (@tasks) {
1268 my ($desc,$start,$end) = @{$_};
1269 my %xs;
1270 my %ys;
1271 my $sigtime = ($end and $end =~ /^\d+$/) ? $end : time;
1272 my $date = $cfg->{Presentation}{detail}{strftime} ?
1273 POSIX::strftime($cfg->{Presentation}{detail}{strftime}, localtime($sigtime)) : scalar localtime($sigtime);
1274 if ( $RRDs::VERSION >= 1.199908 ){
1275 $date =~ s|:|\\:|g;
1276 }
1277 $end ||= 'last';
1278 $start = exp2seconds($start) if $mode =~ /[s]/;
1279
1280 my $startstr = $start =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)) : $start;
1281 my $endstr = $end =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)) : $end;
1282
1283 my $realstart = ( $mode =~ /[sc]/ ? '-'.$start : $start);
1284
1285 for my $slave (@slaves){
1286 my $s = $slave ? "~$slave" : "";
1287 my $swidth = $max->{$s}{$start} / $cfg->{Presentation}{detail}{height};
1288 my $rrd = $base_rrd.$s.".rrd";
1289 my $stddev = Smokeping::RRDhelpers::get_stddev($rrd,'median','AVERAGE',$realstart,$sigtime) || 0;
1290 my @median = ("DEF:median=${rrd}:median:AVERAGE",
1291 "CDEF:ploss=loss,$pings,/,100,*",
1292 "VDEF:avmed=median,AVERAGE",
1293 "CDEF:mesd=median,POP,avmed,$stddev,/",
1294 'GPRINT:avmed:median rtt\: %.1lf %ss avg',
1295 'GPRINT:median:MAX:%.1lf %ss max',
1296 'GPRINT:median:MIN:%.1lf %ss min',
1297 'GPRINT:median:LAST:%.1lf %ss now',
1298 sprintf('COMMENT:%.1f ms sd',$stddev*1000.0),
1299 'GPRINT:mesd:AVERAGE:%.1lf %s am/s\l',
1300 "LINE1:median#202020"
1301 );
1302 push @median, ( "GPRINT:ploss:AVERAGE:packet loss\\: %.2lf %% avg",
1303 "GPRINT:ploss:MAX:%.2lf %% max",
1304 "GPRINT:ploss:MIN:%.2lf %% min",
1305 'GPRINT:ploss:LAST:%.2lf %% now\l',
1306 'COMMENT:loss color\:'
1307 );
1308 my @lossargs = ();
1309 my @losssmoke = ();
1310 my $last = -1;
1311 foreach my $loss (sort {$a <=> $b} keys %lc){
1312 next if $loss >= $pings;
1313 my $lvar = $loss; $lvar =~ s/\./d/g ;
1314 push @median,
1315 (
1316 "CDEF:me$lvar=loss,$last,GT,loss,$loss,LE,*,1,UNKN,IF,median,*",
1317 "CDEF:meL$lvar=me$lvar,$swidth,-",
1318 "CDEF:meH$lvar=me$lvar,0,*,$swidth,2,*,+",
1319 "AREA:meL$lvar",
1320 "STACK:meH$lvar$lc{$loss}[1]:$lc{$loss}[0]"
1321 # "LINE2:me$lvar$lc{$loss}[1]:$lc{$loss}[0]"
1322 );
1323 if ($cfg->{Presentation}{detail}{loss_background} and $cfg->{Presentation}{detail}{loss_background} eq 'yes') {
1324 push @lossargs,
1325 (
1326 "CDEF:lossbg$lvar=loss,$last,GT,loss,$loss,LE,*,INF,UNKN,IF",
1327 "AREA:lossbg$lvar$lcback{$loss}",
1328 );
1329 push @losssmoke,
1330 (
1331 "CDEF:lossbgs$lvar=loss,$last,GT,loss,$loss,LE,*,cp2,UNKN,IF",
1332 "AREA:lossbgs$lvar$lcback{$loss}",
1333 );
1334 }
1335 $last = $loss;
1336 }
1337
1338 # if we have uptime draw a colorful background or the graph showing the uptime
1339
1340 my $cdir=dyndir($cfg)."/".(join "/", @dirs)."/";
1341 if ((not defined $cfg->{Presentation}{detail}{loss_background} or $cfg->{Presentation}{detail}{loss_background} ne 'yes') &&
1342 (-f "$cdir/${file}.adr")) {
1343 @upsmoke = ();
1344 @upargs = ("COMMENT:Link Up${BS}: ",
1345 "DEF:uptime=${base_rrd}.rrd:uptime:AVERAGE",
1346 "CDEF:duptime=uptime,86400,/",
1347 'GPRINT:duptime:LAST: %0.1lf days (');
1348 my $lastup = 0;
1349 foreach my $uptime (sort {$a <=> $b} keys %upt){
1350 push @upargs,
1351 (
1352 "CDEF:up$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,INF,UNKN,IF",
1353 "AREA:up$uptime$upt{$uptime}[1]:$upt{$uptime}[0]"
1354 );
1355 push @upsmoke,
1356 (
1357 "CDEF:ups$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,cp2,UNKN,IF",
1358 "AREA:ups$uptime$upt{$uptime}[1]"
1359 );
1360 $lastup=$uptime;
1361 }
1362
1363 push @upargs, 'COMMENT:)\l';
1364 # map {print "$_<br/>"} @upargs;
1365 };
1366 my @log = ();
1367 push @log, "--logarithmic" if $cfg->{Presentation}{detail}{logarithmic} and
1368 $cfg->{Presentation}{detail}{logarithmic} eq 'yes';
1369
1370 my @lazy =();
1371 @lazy = ('--lazy') if $mode eq 's' and $lastheight{$s} and $lastheight{$s}{$start} and $lastheight{$s}{$start} == $max->{$s}{$start};
1372 my $timer_start = time();
1373 my $from = $s ? " from $cfg->{Slaves}{$slave}{display_name}": "";
1374 my @task =
1375 ("${imgbase}${s}_${end}_${start}.png",
1376 @lazy,
1377 '--start',$realstart,
1378 ($end ne 'last' ? ('--end',$end) : ()),
1379 '--height',$cfg->{Presentation}{detail}{height},
1380 '--width',$cfg->{Presentation}{detail}{width},
1381 '--title',$desc.$from,
1382 '--rigid',
1383 '--upper-limit', $max->{$s}{$start},
1384 @log,
1385 '--lower-limit',(@log ? ($max->{$s}{$start} > 0.01) ? '0.001' : '0.0001' : '0'),
1386 '--vertical-label',$ProbeUnit,
1387 '--imgformat','PNG',
1388 '--color', 'SHADEA#ffffff',
1389 '--color', 'SHADEB#ffffff',
1390 '--color', 'BACK#ffffff',
1391 '--color', 'CANVAS#ffffff',
1392 (map {"DEF:ping${_}=${rrd}:ping${_}:AVERAGE"} 1..$pings),
1393 (map {"CDEF:cp${_}=ping${_},$max->{$s}{$start},LT,ping${_},INF,IF"} 1..$pings),
1394 ("DEF:loss=${rrd}:loss:AVERAGE"),
1395 @upargs,# draw the uptime bg color
1396 @lossargs, # draw the loss bg color
1397 @$smoke,
1398 @upsmoke, # draw the rest of the uptime bg color
1399 @losssmoke, # draw the rest of the loss bg color
1400 @median,'COMMENT: \l',
1401 # Gray background for times when no data was collected, so they can
1402 # be distinguished from network being down.
1403 ( $cfg->{Presentation}{detail}{nodata_color} ? (
1404 'CDEF:nodata=loss,UN,INF,UNKN,IF',
1405 "AREA:nodata#$cfg->{Presentation}{detail}{nodata_color}" ):
1406 ()),
1407 'HRULE:0#000000',
1408 "COMMENT:probe${BS}: $pings $ProbeDesc every ${step}s",
1409 'COMMENT:end\: '.$date.'\j' );
1410# do_log ("***** begin task ***** <br />");
1411# do_log (@task);
1412# do_log ("***** end task ***** <br />");
1413
1414 my $graphret;
1415 ($graphret,$xs{$s},$ys{$s}) = RRDs::graph @task;
1416 # die "<div>INFO:".join("<br/>",@task)."</div>";
1417 my $ERROR = RRDs::error();
1418 if ($ERROR) {
1419 return "<div>ERROR: $ERROR</div><div>".join("<br/>",@task)."</div>";
1420 };
1421 }
1422
1423 if ($mode eq 'a'){ # ajax mode
1424 open my $img, "${imgbase}_${end}_${start}.png" or die "${imgbase}_${end}_${start}.png: $!";
1425 binmode $img;
1426 print "Content-Type: image/png\n";
1427 my $data;
1428 read($img,$data,(stat($img))[7]);
1429 close $img;
1430 print "Content-Length: ".length($data)."\n\n";
1431 print $data;
1432 unlink "${imgbase}_${end}_${start}.png";
1433 return undef;
1434 }
1435 elsif ($mode eq 'n'){ # navigator mode
1436# $page .= qq|<div class="zoom" style="cursor: crosshair;">|;
1437 $page .= qq|<IMG id="zoom" BORDER="0" width="$xs{''}" height="$ys{''}" SRC="${imghref}_${end}_${start}.png">| ;
1438# $page .= "</div>";
1439 $page .= $q->start_form(-method=>'POST', -id=>'range_form')
1440 . "<p>Time range: "
1441 . $q->hidden(-name=>'epoch_start',-id=>'epoch_start')
1442 . $q->hidden(-name=>'hierarchy',-id=>'hierarchy')
1443 . $q->hidden(-name=>'epoch_end',-id=>'epoch_end')
1444 . $q->hidden(-name=>'target',-id=>'target' )
1445 . $q->hidden(-name=>'displaymode',-default=>$mode )
1446 . $q->textfield(-name=>'start',-default=>$startstr)
1447 . " to ".$q->textfield(-name=>'end',-default=>$endstr)
1448 . " "
1449 . $q->submit(-name=>'Generate!')
1450 . "</p>"
1451 . $q->end_form();
1452 } elsif ($mode eq 's') { # classic mode
1453 $startstr =~ s/\s/%20/g;
1454 $endstr =~ s/\s/%20/g;
1455 my $t = $q->param('target');
1456 $t =~ s/$xssBadRx/_/g;
1457 for my $slave (@slaves){
1458 my $s = $slave ? "~$slave" : "";
1459 $page .= "<div>";
1460# $page .= (time-$timer_start)."<br/>";
1461# $page .= join " ",map {"'$_'"} @task;
1462 $page .= "<br/>";
1463 $page .= ( qq{<a href="}.cgiurl($q,$cfg)."?".hierarchy($q).qq{displaymode=n;start=$startstr;end=now;}."target=".$t.$s.'">'
1464 . qq{<IMG BORDER="0" SRC="${imghref}${s}_${end}_${start}.png">}."</a>" ); #"
1465 $page .= "</div>";
1466 }
1467 } else { # chart mode
1468 $page .= "<div>";
1469 my $href= (split /~/, (join ".", @$open))[0]; #/ # the link is 'slave free'
1470 $page .= ( qq{<a href="}.lnk($q, $href).qq{">}
1471 . qq{<IMG BORDER="0" SRC="${imghref}_${end}_${start}.png">}."</a>" ); #"
1472 $page .= "</div>";
1473
1474 }
1475
1476 }
1477 return $page;
1478}
1479
1480sub get_charts ($$$){
1481 my $cfg = shift;
1482 my $q = shift;
1483 my $open = shift;
1484 my $cache = $cfg->{__sortercache};
1485
1486 my $page = "<h1>$cfg->{Presentation}{charts}{title}</h1>";
1487 return $page."<p>Waiting for initial data ...</p>" unless $cache;
1488
1489 my %charts;
1490 for my $chart ( keys %{$cfg->{Presentation}{charts}} ) {
1491 next unless ref $cfg->{Presentation}{charts}{$chart} eq 'HASH';
1492 $charts{$chart} = $cfg->{Presentation}{charts}{$chart}{__obj}->SortTree($cache->{$chart});
1493 }
1494 if (not defined $open->[1]){
1495 for my $chart ( keys %charts ){
1496 $page .= "<h2>$cfg->{Presentation}{charts}{$chart}{title}</h2>\n";
1497 if (not defined $charts{$chart}[0]){
1498 $page .= "<p>No targets returned by the sorter.</p>"
1499 } else {
1500 my $tree = $cfg->{Targets};
1501 my $chartentry = $charts{$chart}[0];
1502 for (@{$chartentry->{open}}) {
1503 my ($host,$slave) = split(/~/, $_);
1504 die "ERROR: Section '$host' does not exist.\n"
1505 unless exists $tree->{$host};
1506 last unless ref $tree->{$host} eq 'HASH';
1507 $tree = $tree->{$host};
1508 }
1509 $page .= get_detail($cfg,$q,$tree,$chartentry->{open},'c');
1510 }
1511 }
1512 } else {
1513 my $chart = $open->[1];
1514 $page = "<h1>$cfg->{Presentation}{charts}{$chart}{title}</h1>\n";
1515 if (not defined $charts{$chart}[0]){
1516 $page .= "<p>No targets returned by the sorter.</p>"
1517 } else {
1518 my $rank =1;
1519 for my $chartentry (@{$charts{$chart}}){
1520 my $tree = $cfg->{Targets};
1521 for (@{$chartentry->{open}}) {
1522 my ($host,$slave) = split(/~/, $_);
1523 die "ERROR: Section '$_' does not exist.\n"
1524 unless exists $tree->{$host};
1525 last unless ref $tree->{$host} eq 'HASH';
1526 $tree = $tree->{$host};
1527 }
1528 $page .= "<h2>$rank.";
1529 $page .= " ".sprintf($cfg->{Presentation}{charts}{$chart}{format},$chartentry->{value})
1530 if ($cfg->{Presentation}{charts}{$chart}{format});
1531 $page .= "</h2>";
1532 $rank++;
1533 $page .= get_detail($cfg,$q,$tree,$chartentry->{open},'c');
1534 }
1535 }
1536 }
1537 return $page;
1538}
1539
1540sub load_sortercache($){
1541 my $cfg = shift;
1542 my %cache;
1543 my $found;
1544 for (glob "$cfg->{General}{datadir}/__sortercache/data*.storable"){
1545 # kill old caches ...
1546 if ((time - (stat "$_")[9]) > $cfg->{Database}{step}*2){
1547 unlink $_;
1548 next;
1549 }
1550 my $data = Storable::retrieve("$_");
1551 for my $chart (keys %$data){
1552 PATH:
1553 for my $path (keys %{$data->{$chart}}){
1554 warn "Warning: Duplicate entry $chart/$path in sortercache\n" if defined $cache{$chart}{$path};
1555 my $root = $cfg->{Targets};
1556 for my $element (split /\//, $path){
1557 if (ref $root eq 'HASH' and defined $root->{$element}){
1558 $root = $root->{$element}
1559 }
1560 else {
1561 warn "Warning: Dropping $chart/$path from sortercache\n";
1562 next PATH;
1563 }
1564 }
1565 $cache{$chart}{$path} = $data->{$chart}{$path}
1566 }
1567 }
1568 $found = 1;
1569 }
1570 return ( $found ? \%cache : undef )
1571}
1572
1573sub hierarchy_switcher($$){
1574 my $q = shift;
1575 my $cfg = shift;
1576 my $print =$q->start_form(-name=>'hswitch',-method=>'get',-action=>$q->url(-relative=>1));
1577 if ($cfg->{Presentation}{hierarchies}){
1578 $print .= "<div id='hierarchy_title'><small>Hierarchy:</small></div>";
1579 $print .= "<div id='hierarchy_popup'>";
1580 $print .= $q->popup_menu(-name=>'hierarchy',
1581 -onChange=>'hswitch.submit()',
1582 -values=>[0, sort map {ref $cfg->{Presentation}{hierarchies}{$_} eq 'HASH'
1583 ? $_ : () } keys %{$cfg->{Presentation}{hierarchies}}],
1584 -labels=>{0=>'Default Hierarchy',
1585 map {ref $cfg->{Presentation}{hierarchies}{$_} eq 'HASH'
1586 ? ($_ => $cfg->{Presentation}{hierarchies}{$_}{title} )
1587 : () } keys %{$cfg->{Presentation}{hierarchies}}
1588 }
1589 );
1590 $print .= "</div>";
1591 }
1592 $print .= "<div id='filter_title'><small>Filter:</small></div>";
1593 $print .= "<div id='filter_text'>";
1594 $print .= $q->textfield (-name=>'filter',
1595 -onChange=>'hswitch.submit()',
1596 -size=>15,
1597 );
1598 $print .= '</div>'.$q->end_form();
1599 $print .= "<br/><br/>";
1600 return $print;
1601}
1602
1603sub display_webpage($$){
1604 my $cfg = shift;
1605 my $q = shift;
1606 my $targ = '';
1607 my $t = $q->param('target');
1608 if ( $t and $t !~ /\.\./ and $t =~ /(\S+)/){
1609 $targ = $1;
1610 $targ =~ s/$xssBadRx/_/g;
1611 }
1612 my ($path,$slave) = split(/~/,$targ);
1613 if ($slave and $slave =~ /(\S+)/){
1614 die "ERROR: slave '$slave' is not defined in the '*** Slaves ***' section!\n"
1615 unless defined $cfg->{Slaves}{$slave};
1616 $slave = $1;
1617 }
1618 my $hierarchy = $q->param('hierarchy');
1619 $hierarchy =~ s/$xssBadRx/_/g;
1620 die "ERROR: unknown hierarchy $hierarchy\n"
1621 if $hierarchy and not $cfg->{Presentation}{hierarchies}{$hierarchy};
1622 my $open = [ (split /\./,$path||'') ];
1623 my $open_orig = [@$open];
1624 $open_orig->[-1] .= '~'.$slave if $slave;
1625
1626 my($filter) = ($q->param('filter') and $q->param('filter') =~ m{([- _0-9a-zA-Z\+\*\(\)\|\^\[\]\.\$]+)});
1627
1628 my $tree = $cfg->{Targets};
1629 if ($hierarchy){
1630 $tree = $cfg->{__hierarchies}{$hierarchy};
1631 };
1632 my $menu_root = $tree;
1633 my $targets = $cfg->{Targets};
1634 my $step = $cfg->{__probes}{$targets->{probe}}->step();
1635 # lets see if the charts are opened
1636 my $charts = 0;
1637 $charts = 1 if defined $cfg->{Presentation}{charts} and $open->[0] and $open->[0] eq '_charts';
1638 if ($charts and ( not defined $cfg->{__sortercache}
1639 or $cfg->{__sortercachekeeptime} < time )){
1640 # die "ERROR: Chart $open->[1] does not exit.\n"
1641 # unless $cfg->{Presentation}{charts}{$open->[1]};
1642 $cfg->{__sortercache} = load_sortercache $cfg;
1643 $cfg->{__sortercachekeeptime} = time + 60;
1644 };
1645 if (not $charts){
1646 for (@$open) {
1647 die "ERROR: Section '$_' does not exist (display webpage)." # .(join "", map {"$_=$ENV{$_}"} keys %ENV)."\n"
1648 unless exists $tree->{$_};
1649 last unless ref $tree->{$_} eq 'HASH';
1650 $tree = $tree->{$_};
1651 }
1652 }
1653 gen_imgs($cfg); # create logos in imgcache
1654 my $readversion = "?";
1655 $VERSION =~ /(\d+)\.(\d{3})(\d{3})/ and $readversion = sprintf("%d.%d.%d",$1,$2,$3);
1656 my $menu = $targets;
1657
1658
1659 if (defined $cfg->{Presentation}{charts} and not $hierarchy){
1660 my $order = 1;
1661 $menu_root = { %{$menu_root},
1662 _charts => {
1663 _order => -99,
1664 menu => $cfg->{Presentation}{charts}{menu},
1665 map { $_ => { menu => $cfg->{Presentation}{charts}{$_}{menu}, _order => $order++ } }
1666 sort
1667 grep { ref $cfg->{Presentation}{charts}{$_} eq 'HASH' } keys %{$cfg->{Presentation}{charts}}
1668 }
1669 };
1670 }
1671
1672 my $hierarchy_arg = '';
1673 if ($hierarchy){
1674 $hierarchy_arg = 'hierarchy='.uri_escape($hierarchy).';';
1675
1676 };
1677 my $filter_arg ='';
1678 if ($filter){
1679 $filter_arg = 'filter='.uri_escape($filter).';';
1680
1681 };
1682 # if we are in a hierarchy, recover the original path
1683
1684 my $display_tree = $tree->{__tree_link} ? $tree->{__tree_link} : $tree;
1685
1686 my $authuser = $ENV{REMOTE_USER} || 'Guest';
1687 my $page = fill_template
1688 ($cfg->{Presentation}{template},
1689 {
1690 menu => hierarchy_switcher($q,$cfg).
1691 target_menu( $menu_root,
1692 [@$open], #copy this because it gets changed
1693 cgiurl($q, $cfg) ."?${hierarchy_arg}${filter_arg}target=",
1694 $filter
1695 ),
1696 title => $charts ? "" : $display_tree->{title},
1697 remark => $charts ? "" : ($display_tree->{remark} || ''),
1698 overview => $charts ? get_charts($cfg,$q,$open) : get_overview( $cfg,$q,$tree,$open),
1699 body => $charts ? "" : get_detail( $cfg,$q,$tree,$open_orig ),
1700 target_ip => $charts ? "" : ($display_tree->{host} || ''),
1701 owner => $cfg->{General}{owner},
1702 contact => $cfg->{General}{contact},
1703
1704 author => '<A HREF="http://tobi.oetiker.ch/">Tobi Oetiker</A> and Niko Tyni',
1705 smokeping => '<A HREF="http://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'">SmokePing-'.$readversion.'</A>',
1706
1707 step => $step,
1708 rrdlogo => '<A HREF="http://oss.oetiker.ch/rrdtool/"><img border="0" src="'.$cfg->{General}{imgurl}.'/rrdtool.png"></a>',
1709 smokelogo => '<A HREF="http://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'"><img border="0" src="'.$cfg->{General}{imgurl}.'/smokeping.png"></a>',
1710 authuser => $authuser,
1711 }
1712 );
1713 my $expi = $cfg->{Database}{step} > 120 ? $cfg->{Database}{step} : 120;
1714 print $q->header(-type=>'text/html',
1715 -expires=>'+'.$expi.'s',
1716 -charset=> ( $cfg->{Presentation}{charset} || 'iso-8859-15'),
1717 -Content_length => length($page),
1718 );
1719 print $page || "<HTML><BODY>ERROR: Reading page template".$cfg->{Presentation}{template}."</BODY></HTML>";
1720
1721}
1722
1723# fetch all data.
1724sub run_probes($$) {
1725 my $probes = shift;
1726 my $justthisprobe = shift;
1727 if (defined $justthisprobe) {
1728 $probes->{$justthisprobe}->ping();
1729 } else {
1730 foreach my $probe (keys %{$probes}) {
1731 $probes->{$probe}->ping();
1732 }
1733 }
1734}
1735
1736# report probe status
1737sub report_probes($$) {
1738 my $probes = shift;
1739 my $justthisprobe = shift;
1740 if (defined $justthisprobe) {
1741 $probes->{$justthisprobe}->report();
1742 } else {
1743 foreach my $probe (keys %{$probes}){
1744 $probes->{$probe}->report();
1745 }
1746 }
1747}
1748
1749sub load_sorters($){
1750 my $subcfg = shift;
1751 foreach my $key ( keys %{$subcfg} ) {
1752 my $x = $subcfg->{$key};
1753 next unless ref $x eq 'HASH';
1754 $x->{sorter} =~ /(\S+)\((.+)\)/;
1755 my $sorter = $1;
1756 my $arg = $2;
1757 die "ERROR: sorter $sorter: all sorters start with a capital letter\n"
1758 unless $sorter =~ /^[A-Z]/;
1759 eval 'require Smokeping::sorters::'.$sorter;
1760 die "Sorter '$sorter' could not be loaded: $@\n" if $@;
1761 $x->{__obj} = eval "Smokeping::sorters::$sorter->new($arg)";
1762 die "ERROR: sorter $sorter: instantiation with Smokeping::sorters::$sorter->new($arg): $@\n"
1763 if $@;
1764 }
1765}
1766
1767
1768
1769sub update_sortercache($$$$$){
1770 my $cfg = shift;
1771 return unless $cfg->{Presentation}{charts};
1772 my $cache = shift;
1773 my $path = shift;
1774 my $base = $cfg->{General}{datadir};
1775 $path =~ s/^$base\/?//;
1776 my @updates = map {/U/ ? undef : 0.0+$_ } split /:/, shift;
1777 my $alert = shift;
1778 my %info;
1779 $info{uptime} = shift @updates;
1780 $info{loss} = shift @updates;
1781 $info{median} = shift @updates;
1782 $info{alert} = $alert;
1783 $info{pings} = \@updates;
1784 foreach my $chart ( keys %{$cfg->{Presentation}{charts}} ) {
1785 next unless ref $cfg->{Presentation}{charts}{$chart} eq 'HASH';
1786 $cache->{$chart}{$path} = $cfg->{Presentation}{charts}{$chart}{__obj}->CalcValue(\%info);
1787 }
1788}
1789
1790sub save_sortercache($$$){
1791 my $cfg = shift;
1792 my $cache = shift;
1793 my $probe = shift;
1794 return unless $cfg->{Presentation}{charts};
1795 my $dir = $cfg->{General}{datadir}."/__sortercache";
1796 my $ext = '';
1797 $ext .= $probe if $probe;
1798 $ext .= join "",@{$opt{filter}} if @{$opt{filter}};
1799 $ext =~ s/[^-_=0-9a-z]/_/gi;
1800 $ext = ".$ext" if $ext;
1801 mkdir $dir,0755 unless -d $dir;
1802 Storable::store ($cache, "$dir/new$ext");
1803 rename "$dir/new$ext","$dir/data$ext.storable"
1804}
1805
1806sub check_alerts {
1807 my $cfg = shift;
1808 my $tree = shift;
1809 my $pings = shift;
1810 my $name = shift;
1811 my $prop = shift;
1812 my $loss = shift;
1813 my $rtt = shift;
1814 my $slave = shift;
1815 my $gotalert;
1816 my $s = "";
1817 if ($slave) {
1818 $s = '~'.$slave
1819 }
1820 if ( $tree->{alerts} ) {
1821 my $priority_done;
1822 $tree->{'stack'.$s} = {loss=>['S'],rtt=>['S']} unless defined $tree->{'stack'.$s};
1823 my $x = $tree->{'stack'.$s};
1824 $loss = undef if $loss eq 'U';
1825 my $lossprct = $loss * 100 / $pings;
1826 $rtt = undef if $rtt eq 'U';
1827 push @{$x->{loss}}, $lossprct;
1828 push @{$x->{rtt}}, $rtt;
1829 if (scalar @{$x->{loss}} > $tree->{fetchlength}){
1830 shift @{$x->{loss}};
1831 shift @{$x->{rtt}};
1832 }
1833 for (sort { ($cfg->{Alerts}{$a}{priority}||0)
1834 <=> ($cfg->{Alerts}{$b}{priority}||0)} @{$tree->{alerts}}) {
1835 my $alert = $cfg->{Alerts}{$_};
1836 if ( not $alert ) {
1837 do_log "WARNING: Empty alert in ".(join ",", @{$tree->{alerts}})." ($name)\n";
1838 next;
1839 };
1840 if ( ref $alert->{sub} ne 'CODE' ) {
1841 do_log "WARNING: Alert '$_' did not resolve to a Sub Ref. Skipping\n";
1842 next;
1843 };
1844 my $prevmatch = $tree->{'prevmatch'.$s}{$_} || 0;
1845
1846 # add the current state of an edge triggered alert to the
1847 # data passed into a matcher, which allows for somewhat
1848 # more intelligent alerting due to state awareness.
1849 $x->{prevmatch} = $prevmatch;
1850 my $priority = $alert->{priority};
1851 my $match = &{$alert->{sub}}($x) || 0; # Avgratio returns undef
1852 $gotalert = $match unless $gotalert;
1853 my $edgetrigger = $alert->{edgetrigger} eq 'yes';
1854 my $what;
1855 if ($edgetrigger and $prevmatch != $match) {
1856 $what = ($prevmatch == 0 ? "was raised" : "was cleared");
1857 }
1858 if (not $edgetrigger and $match) {
1859 $what = "is active";
1860 }
1861 if ($what and (not defined $priority or not defined $priority_done )) {
1862 $priority_done = $priority if $priority and not $priority_done;
1863 # send something
1864 my $from;
1865 my $line = "$name/$prop";
1866 my $base = $cfg->{General}{datadir};
1867 $line =~ s|^$base/||;
1868 $line =~ s|/host$||;
1869 $line =~ s|/|.|g;
1870 my $urlline = $cfg->{General}{cgiurl}."?target=".$line;
1871 $line .= " [from $slave]" if $slave;
1872 do_log("Alert $_ $what for $line");
1873 my $loss = "loss: ".join ", ",map {defined $_ ? (/^\d/ ? sprintf "%.0f%%", $_ :$_):"U" } @{$x->{loss}};
1874 my $rtt = "rtt: ".join ", ",map {defined $_ ? (/^\d/ ? sprintf "%.0fms", $_*1000 :$_):"U" } @{$x->{rtt}};
1875 my $time = time;
1876 my @stamp = localtime($time);
1877 my $stamp = localtime($time);
1878 my @to;
1879 foreach my $addr (map {$_ ? (split /\s*,\s*/,$_) : ()} $cfg->{Alerts}{to},$tree->{alertee},$alert->{to}){
1880 next unless $addr;
1881 if ( $addr =~ /^\|(.+)/) {
1882 my $cmd = $1;
1883 # fork them in case they take a long time
1884 my $pid;
1885 unless ($pid = fork) {
1886 unless (fork) {
1887 $SIG{CHLD} = 'DEFAULT';
1888 if ($edgetrigger) {
1889 exec $cmd,$_,$line,$loss,$rtt,$tree->{host}, ($what =~/raise/);
1890 } else {
1891 exec $cmd,$_,$line,$loss,$rtt,$tree->{host};
1892 }
1893 die "exec failed!";
1894 }
1895 exit 0;
1896 }
1897 waitpid($pid, 0);
1898 }
1899 elsif ( $addr =~ /^snpp:(.+)/ ) {
1900 sendsnpp $1, <<SNPPALERT;
1901$alert->{comment}
1902$_ $what on $line
1903$loss
1904$rtt
1905SNPPALERT
1906 }
1907 else {
1908 push @to, $addr;
1909 }
1910 };
1911 if (@to){
1912 my $default_mail = <<DOC;
1913Subject: [SmokeAlert] <##ALERT##> <##WHAT##> on <##LINE##>
1914
1915<##STAMP##>
1916
1917Alert "<##ALERT##>" <##WHAT##> for <##URL##>
1918
1919Pattern
1920-------
1921<##PAT##>
1922
1923Data (old --> now)
1924------------------
1925<##LOSS##>
1926<##RTT##>
1927
1928Comment
1929-------
1930<##COMMENT##>
1931
1932DOC
1933
1934 my $mail = fill_template($alert->{mailtemplate},
1935 {
1936 ALERT => $_,
1937 WHAT => $what,
1938 LINE => $line,
1939 URL => $urlline,
1940 STAMP => $stamp,
1941 PAT => $alert->{pattern},
1942 LOSS => $loss,
1943 RTT => $rtt,
1944 COMMENT => $alert->{comment}
1945 },$default_mail) || "Subject: smokeping failed to open mailtemplate '$alert->{mailtemplate}'\n\nsee subject\n";
1946 my $rfc2822stamp = POSIX::strftime("%a, %e %b %Y %H:%M:%S %z", @stamp);
1947 my $to = join ",",@to;
1948 sendmail $cfg->{Alerts}{from},$to, <<ALERT;
1949To: $to
1950From: $cfg->{Alerts}{from}
1951Date: $rfc2822stamp
1952$mail
1953ALERT
1954 }
1955 } else {
1956 do_debuglog("Alert \"$_\": no match for target $name\n");
1957 }
1958 $tree->{'prevmatch'.$s}{$_} = $match;
1959 }
1960 } # end alerts
1961 return $gotalert;
1962}
1963
1964
1965sub update_rrds($$$$$$);
1966sub update_rrds($$$$$$) {
1967 my $cfg = shift;
1968 my $probes = shift;
1969 my $tree = shift;
1970 my $name = shift;
1971 my $justthisprobe = shift; # if defined, update only the targets probed by this probe
1972 my $sortercache = shift;
1973
1974 my $probe = $tree->{probe};
1975 foreach my $prop (keys %{$tree}) {
1976 if (ref $tree->{$prop} eq 'HASH'){
1977 update_rrds $cfg, $probes, $tree->{$prop}, $name."/$prop", $justthisprobe, $sortercache;
1978 }
1979 # if we are looking down a branche where no probe property is set there is no sense
1980 # in further exploring it
1981 next unless defined $probe;
1982 next if defined $justthisprobe and $probe ne $justthisprobe;
1983 my $probeobj = $probes->{$probe};
1984 my $pings = $probeobj->_pings($tree);
1985 if ($prop eq 'host' and check_filter($cfg,$name) and $tree->{$prop} !~ m|^/|) { # skip multihost
1986 my @updates;
1987 if (not $tree->{nomasterpoll} or $tree->{nomasterpoll} eq 'no'){
1988 @updates = ([ "", time, $probeobj->rrdupdate_string($tree) ]);
1989 }
1990 if ($tree->{slaves}){
1991 my @slaves = split(/\s+/, $tree->{slaves});
1992 foreach my $slave (@slaves) {
1993 my $lines = Smokeping::Master::get_slaveupdates($cfg, $name, $slave);
1994 push @updates, @$lines;
1995 } #foreach my $checkslave
1996 }
1997 for my $update (sort {$a->[1] <=> $b->[1]} @updates){ # make sure we put the updates in chronological order in
1998 my $s = $update->[0] ? "~".$update->[0] : "";
1999 if ( $tree->{rawlog} ){
2000 my $file = POSIX::strftime $tree->{rawlog},localtime($update->[1]);
2001 if (open LOG,">>$name$s.$file.csv"){
2002 print LOG time,"\t",join("\t",split /:/,$update->[2]),"\n";
2003 close LOG;
2004 } else {
2005 do_log "Warning: failed to open $name$s.$file for logging: $!\n";
2006 }
2007 }
2008 my @rrdupdate = (
2009 $name.$s.".rrd",
2010 '--template', (
2011 join ":", "uptime", "loss", "median",
2012 map { "ping${_}" } 1..$pings
2013 ),
2014 $update->[1].":".$update->[2]
2015 );
2016 do_debuglog("Calling RRDs::update(@rrdupdate)");
2017 RRDs::update ( @rrdupdate );
2018 my $ERROR = RRDs::error();
2019 do_log "RRDs::update ERROR: $ERROR\n" if $ERROR;
2020 # check alerts
2021 my ($loss,$rtt) = (split /:/, $update->[2])[1,2];
2022 my $gotalert = check_alerts $cfg,$tree,$pings,$name,$prop,$loss,$rtt,$update->[0];
2023 update_sortercache $cfg,$sortercache,$name.$s,$update->[2],$gotalert;
2024 }
2025 }
2026 }
2027}
2028
2029sub _deepcopy {
2030 # this handles circular references on consecutive levels,
2031 # but breaks if there are any levels in between
2032 my $what = shift;
2033 return $what unless ref $what;
2034 for (ref $what) {
2035 /^ARRAY$/ and return [ map { $_ eq $what ? $_ : _deepcopy($_) } @$what ];
2036 /^HASH$/ and return { map { $_ => $what->{$_} eq $what ?
2037 $what->{$_} : _deepcopy($what->{$_}) } keys %$what };
2038 /^CODE$/ and return $what; # we don't need to copy the subs
2039 }
2040 die "Cannot _deepcopy reference type @{[ref $what]}";
2041}
2042
2043sub get_parser () {
2044 # The _dyn() stuff here is quite confusing, so here's a walkthrough:
2045 # 1 Probe is defined in the Probes section
2046 # 1.1 _dyn is called for the section to add the probe- and target-specific
2047 # vars into the grammar for this section and its subsections (subprobes)
2048 # 1.2 A _dyn sub is installed for all mandatory target-specific variables so
2049 # that they are made non-mandatory in the Targets section if they are
2050 # specified here. The %storedtargetvars hash holds this information.
2051 # 1.3 If a probe section has any subsections (subprobes) defined, the main
2052 # section turns into a template that just offers default values for
2053 # the subprobes. Because of this a _dyn sub is installed for subprobe
2054 # sections that makes any mandatory variables in the main section non-mandatory.
2055 # 1.4 A similar _dyn sub as in 1.2 is installed for the subprobe target-specific
2056 # variables as well.
2057 # 2 Probe is selected in the Targets section top
2058 # 2.1 _dyn is called for the section to add the probe- and target-specific
2059 # vars into the grammar for this section and its subsections. Any _default
2060 # values for the vars are removed, as they will be propagated from the Probes
2061 # section.
2062 # 2.2 Another _dyn sub is installed for the 'probe' variable in target subsections
2063 # that behaves as 2.1
2064 # 2.3 A _dyn sub is installed for the 'host' variable that makes the mandatory
2065 # variables mandatory only in those sections that have a 'host' setting.
2066 # 2.4 A _sub sub is installed for the 'probe' variable in target subsections that
2067 # bombs out if 'probe' is defined after any variables that depend on the
2068 # current 'probe' setting.
2069
2070
2071 my $KEYD_RE = '[-_0-9a-zA-Z]+';
2072 my $KEYDD_RE = '[-_0-9a-zA-Z.]+';
2073 my $PROBE_RE = '[A-Z][a-zA-Z]+';
2074 my $e = "=";
2075 my %knownprobes; # the probes encountered so far
2076
2077 # get a list of available probes for _dyndoc sections
2078 my $libdir = find_libdir();
2079 my $probedir = $libdir . "/Smokeping/probes";
2080 my $matcherdir = $libdir . "/Smokeping/matchers";
2081 my $sorterdir = $libdir . "/Smokeping/sorters";
2082
2083 my $probelist;
2084 my @matcherlist;
2085 my @sorterlist;
2086
2087 die("Can't find probe module directory") unless defined $probedir;
2088 opendir(D, $probedir) or die("opendir $probedir: $!");
2089 for (readdir D) {
2090 next unless s/\.pm$//;
2091 next unless /^$PROBE_RE/;
2092 $probelist->{$_} = "(See the L<separate module documentation|Smokeping::probes::$_> for details about each variable.)";
2093 }
2094 closedir D;
2095
2096 die("Can't find matcher module directory") unless defined $matcherdir;
2097 opendir(D, $matcherdir) or die("opendir $matcherdir: $!");
2098 for (sort readdir D) {
2099 next unless /[A-Z]/;
2100 next unless s/\.pm$//;
2101 push @matcherlist, $_;
2102 }
2103
2104 die("Can't find sorter module directory") unless defined $sorterdir;
2105 opendir(D, $sorterdir) or die("opendir $sorterdir: $!");
2106 for (sort readdir D) {
2107 next unless /[A-Z]/;
2108 next unless s/\.pm$//;
2109 push @sorterlist, $_;
2110 }
2111
2112 # The target-specific vars of each probe
2113 # We need to store them to relay information from Probes section to Target section
2114 # see 1.2 above
2115 my %storedtargetvars;
2116
2117 # the part of target section syntax that doesn't depend on the selected probe
2118 my $TARGETCOMMON; # predeclare self-referencing structures
2119 # the common variables
2120 my $TARGETCOMMONVARS = [ qw (probe menu title alerts note email host remark rawlog alertee slaves menuextra parents hide nomasterpoll) ];
2121 $TARGETCOMMON =
2122 {
2123 _vars => $TARGETCOMMONVARS,
2124 _inherited=> [ qw (probe alerts alertee slaves menuextra nomasterpoll) ],
2125 _sections => [ "/$KEYD_RE/" ],
2126 _recursive=> [ "/$KEYD_RE/" ],
2127 _sub => sub {
2128 my $val = shift;
2129 return "PROBE_CONF sections are neither needed nor supported any longer. Please see the smokeping_upgrade document."
2130 if $val eq 'PROBE_CONF';
2131 return undef;
2132 },
2133 "/$KEYD_RE/" => {},
2134 _order => 1,
2135 _varlist => 1,
2136 _doc => <<DOC,
2137Each target section can contain information about a host to monitor as
2138well as further target sections. Most variables have already been
2139described above. The expression above defines legal names for target
2140sections.
2141DOC
2142 alerts => {
2143 _doc => 'Comma separated list of alert names',
2144 _re => '([^\s,]+(,[^\s,]+)*)?',
2145 _re_error => 'Comma separated list of alert names',
2146 },
2147 hide => {
2148 _doc => <<DOC,
2149Set the hide property to 'yes' to hide this host from the navigation menu
2150and from search results. Note that if you set the hide property on a non
2151leaf entry all subordinate entries will also disapear in the menu structure.
2152If you know a direct link to a page it is still accessible. Pages which are
2153hidden from the menu due to a parent being hidden will still show up in
2154search results and in alternate hierarchies where they are below a non
2155hidden parent.
2156DOC
2157 _re => '(yes|no)',
2158 _default => 'no',
2159 },
2160
2161 nomasterpoll=> {
2162 _doc => <<DOC,
2163Use this in a master/slave setup where the master must not poll a particular
2164target. The master will now skip this entry in its polling cycle.
2165Note that if you set the hide property on a non leaf entry
2166all subordinate entries will also disapear in the menu structure. You can
2167still access them via direct link or via an alternate hierarchy.
2168
2169If you have no master/slave setup this will have a similar effect to the
2170hide property, except that the menu entry will still show up, but will not
2171contain any graphs.
2172
2173DOC
2174 _re => '(yes|no)',
2175 _default => 'no',
2176 },
2177
2178 host =>
2179 {
2180 _doc => <<DOC,
2181There are three types of "hosts" in smokeping.
2182
2183${e}over
2184
2185${e}item 1
2186
2187The 'hostname' is a name of a host you want to target from smokeping
2188
2189${e}item 2
2190
2191The string B<DYNAMIC>. Is for machines that have a dynamic IP address. These boxes
2192are required to regularly contact the SmokePing server to confirm their IP address.
2193 When starting SmokePing with the commandline argument
2194B<--email> it will add a secret password to each of the B<DYNAMIC>
2195host lines and send a script to the owner of each host. This script
2196must be started periodically (cron) on the host in question to let smokeping know
2197where the host is curently located. If the target machine supports
2198SNMP SmokePing will also query the hosts
2199sysContact, sysName and sysLocation properties to make sure it is
2200still the same host.
2201
2202${e}item 3
2203
2204A space separated list of 'target-path' entries (multihost target). All
2205targets mentioned in this list will be displayed in one graph. Note that the
2206graph will look different from the normal smokeping graphs. The syntax for
2207multihost targets is as follows:
2208
2209 host = /world/town/host1 /world/town2/host33 /world/town2/host1~slave
2210
2211${e}back
2212
2213DOC
2214
2215 _sub => sub {
2216 for ( shift ) {
2217 m|^DYNAMIC| && return undef;
2218 /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ && return undef;
2219 /^[0-9a-f]{0,4}(\:[0-9a-f]{0,4}){0,6}\:[0-9a-f]{0,4}$/i && return undef;
2220 m|(?:/$KEYD_RE)+(?:~$KEYD_RE)?(?: (?:/$KEYD_RE)+(?:~$KEYD_RE))*| && return undef;
2221 my $addressfound = 0;
2222 my @tried;
2223 if ($havegetaddrinfo) {
2224 my @ai;
2225 @ai = getaddrinfo( $_, "" );
2226 unless ($addressfound = scalar(@ai) > 5) {
2227 do_debuglog("WARNING: Hostname '$_' does currently not resolve to an IPv6 address\n");
2228 @tried = qw{IPv6};
2229 }
2230 }
2231 unless ($addressfound) {
2232 unless ($addressfound = gethostbyname( $_ )) {
2233 do_debuglog("WARNING: Hostname '$_' does currently not resolve to an IPv4 address\n");
2234 push @tried, qw{IPv4};
2235 }
2236 }
2237 unless ($addressfound) {
2238 # do not bomb, as this could be temporary
2239 my $tried = join " or ", @tried;
2240 warn "WARNING: Hostname '$_' does currently not resolve to an $tried address\n" unless $cgimode;
2241 }
2242 return undef;
2243 }
2244 return undef;
2245 },
2246 },
2247 email => { _re => '.+\s<\S+@\S+>',
2248 _re_error =>
2249 "use an email address of the form 'First Last <em\@ail.kg>'",
2250 _doc => <<DOC,
2251This is the contact address for the owner of the current host. In connection with the B<DYNAMIC> hosts,
2252the address will be used for sending the belowmentioned script.
2253DOC
2254 },
2255 note => { _doc => <<DOC },
2256Some information about this entry which does NOT get displayed on the web.
2257DOC
2258 rawlog => { _doc => <<DOC,
2259Log the raw data, gathered for this target, in tab separated format, to a file with the
2260same basename as the corresponding RRD file. Use posix strftime to format the timestamp to be
2261put into the file name. The filename is built like this:
2262
2263 basename.strftime.csv
2264
2265Example:
2266
2267 rawlog=%Y-%m-%d
2268
2269this would create a new logfile every day with a name like this:
2270
2271 targethost.2004-05-03.csv
2272
2273DOC
2274 _sub => sub {
2275 eval ( "POSIX::strftime('$_[0]', localtime(time))");
2276 return $@ if $@;
2277 return undef;
2278 },
2279 },
2280 parents => {
2281 _re => "${KEYD_RE}:/(?:${KEYD_RE}(?:/${KEYD_RE})*)?(?: ${KEYD_RE}:/(?:${KEYD_RE}(?:/${KEYD_RE})*)?)*",
2282 _re_error => "Use hierarcy:/parent/path syntax",
2283 _doc => <<DOC
2284After setting up a hierarchy in the Presentation section of the
2285configuration file you can use this property to assign an entry to alternate
2286hierarchies. The format for parent entries is.
2287
2288 hierarchyA:/Node1/Node2 hierarchyB:/Node3
2289
2290The entries from all parent properties together will build a new tree for
2291each hierarchy. With this method it is possible to make a single target show
2292up multiple times in a tree. If you think this is a good thing, go ahead,
2293nothing is stopping you. Since you do not only define the parent but the full path
2294of the parent node, circular dependencies are not possible.
2295
2296DOC
2297 },
2298
2299 alertee => { _re => '(\|.+|.+@\S+|snpp:)',
2300 _re_error => 'the alertee must be an email address here',
2301 _doc => <<DOC },
2302If you want to have alerts for this target and all targets below it go to a particular address
2303on top of the address already specified in the alert, you can add it here. This can be a comma separated list of items.
2304DOC
2305 slaves => { _re => "(${KEYDD_RE}(?:\\s+${KEYDD_RE})*)?",
2306 _re_error => 'Use the format: slaves='.${KEYDD_RE}.' [slave2]',
2307 _doc => <<DOC },
2308The slave names must match the slaves you have setup in the slaves section.
2309DOC
2310 menuextra => {
2311 _doc => <<'DOC' },
2312HTML String to be added to the end of each menu entry. The following tags will be replaced:
2313
2314 {HOST} -> #$hostname
2315 {HOSTNAME} -> $hostname
2316 {CLASS} -> same class as the other tags in the menu line
2317 {HASH} -> #
2318
2319DOC
2320 probe => {
2321 _sub => sub {
2322 my $val = shift;
2323 my $varlist = shift;
2324 return "probe $val missing from the Probes section"
2325 unless $knownprobes{$val};
2326 my %commonvars;
2327 $commonvars{$_} = 1 for @{$TARGETCOMMONVARS};
2328 delete $commonvars{host};
2329 # see 2.4 above
2330 return "probe must be defined before the host or any probe variables"
2331 if grep { not exists $commonvars{$_} } @$varlist;
2332
2333 return undef;
2334 },
2335 _dyn => sub {
2336 # this generates the new syntax whenever a new probe is selected
2337 # see 2.2 above
2338 my ($name, $val, $grammar) = @_;
2339
2340 my $targetvars = _deepcopy($storedtargetvars{$val});
2341 my @mandatory = @{$targetvars->{_mandatory}};
2342 delete $targetvars->{_mandatory};
2343 my @targetvars = sort keys %$targetvars;
2344
2345 # the default values for targetvars are only used in the Probes section
2346 delete $targetvars->{$_}{_default} for @targetvars;
2347
2348 # we replace the current grammar altogether
2349 %$grammar = ( %{_deepcopy($TARGETCOMMON)}, %$targetvars );
2350 $grammar->{_vars} = [ @{$grammar->{_vars}}, @targetvars ];
2351
2352 # the subsections differ only in that they inherit their vars from here
2353 my $g = _deepcopy($grammar);
2354 $grammar->{"/$KEYD_RE/"} = $g;
2355 push @{$g->{_inherited}}, @targetvars;
2356
2357 # this makes the variables mandatory only in those sections
2358 # where 'host' is defined. (We must generate this dynamically
2359 # as the mandatory list isn't visible earlier.)
2360 # see 2.3 above
2361
2362 my $mandatorysub = sub {
2363 my ($name, $val, $grammar) = @_;
2364 $grammar->{_mandatory} = [ @mandatory ];
2365 };
2366 $grammar->{host} = _deepcopy($grammar->{host});
2367 $grammar->{host}{_dyn} = $mandatorysub;
2368 $g->{host}{_dyn} = $mandatorysub;
2369 },
2370 },
2371 };
2372
2373 my $INTEGER_SUB = {
2374 _sub => sub {
2375 return "must be an integer >= 1"
2376 unless $_[ 0 ] == int( $_[ 0 ] ) and $_[ 0 ] >= 1;
2377 return undef;
2378 }
2379 };
2380 my $DIRCHECK_SUB = {
2381 _sub => sub {
2382 return "Directory '$_[0]' does not exist" unless -d $_[ 0 ];
2383 return undef;
2384 }
2385 };
2386
2387 my $FILECHECK_SUB = {
2388 _sub => sub {
2389 return "File '$_[0]' does not exist" unless -f $_[ 0 ];
2390 return undef;
2391 }
2392 };
2393
2394 # grammar for the ***Probes*** section
2395 my $PROBES = {
2396 _doc => <<DOC,
2397Each module can take specific configuration information from this
2398area. The jumble of letters above is a regular expression defining legal
2399module names.
2400
2401See the documentation of each module for details about its variables.
2402DOC
2403 _sections => [ "/$PROBE_RE/" ],
2404
2405 # this adds the probe-specific variables to the grammar
2406 # see 1.1 above
2407 _dyn => sub {
2408 my ($re, $name, $grammar) = @_;
2409
2410 # load the probe module
2411 my $class = "Smokeping::probes::$name";
2412 Smokeping::maybe_require $class;
2413
2414 # modify the grammar
2415 my $probevars = $class->probevars;
2416 my $targetvars = $class->targetvars;
2417 $storedtargetvars{$name} = $targetvars;
2418
2419 my @mandatory = @{$probevars->{_mandatory}};
2420 my @targetvars = sort grep { $_ ne '_mandatory' } keys %$targetvars;
2421 for (@targetvars) {
2422 next if $_ eq '_mandatory';
2423 delete $probevars->{$_};
2424 }
2425 my @probevars = sort grep { $_ ne '_mandatory' } keys %$probevars;
2426
2427 $grammar->{_vars} = [ @probevars , @targetvars ];
2428 $grammar->{_mandatory} = [ @mandatory ];
2429
2430 # do it for probe instances in subsections too
2431 my $g = $grammar->{"/$KEYD_RE/"};
2432 for (@probevars) {
2433 $grammar->{$_} = $probevars->{$_};
2434 %{$g->{$_}} = %{$probevars->{$_}};
2435 # this makes the reference manual a bit less cluttered
2436 $g->{$_}{_doc} = 'see above';
2437 delete $g->{$_}{_example};
2438 $grammar->{$_}{_doc} = 'see above';
2439 delete $grammar->{$_}{_example};
2440 }
2441 # make any mandatory variable specified here non-mandatory in the Targets section
2442 # see 1.2 above
2443 my $sub = sub {
2444 my ($name, $val, $grammar) = shift;
2445 $targetvars->{_mandatory} = [ grep { $_ ne $name } @{$targetvars->{_mandatory}} ];
2446 };
2447 for my $var (@targetvars) {
2448 %{$grammar->{$var}} = %{$targetvars->{$var}};
2449 %{$g->{$var}} = %{$targetvars->{$var}};
2450 # this makes the reference manual a bit less cluttered
2451 delete $grammar->{$var}{_example};
2452 delete $g->{$var}{_doc};
2453 delete $g->{$var}{_example};
2454 # (note: intentionally overwrite _doc)
2455 $grammar->{$var}{_doc} = "(This variable can be overridden target-specifically in the Targets section.)";
2456 $grammar->{$var}{_dyn} = $sub
2457 if grep { $_ eq $var } @{$targetvars->{_mandatory}};
2458 }
2459 $g->{_vars} = [ @probevars, @targetvars ];
2460 $g->{_inherited} = $g->{_vars};
2461 $g->{_mandatory} = [ @mandatory ];
2462
2463 # the special value "_template" means we don't know yet if
2464 # there will be any instances of this probe
2465 $knownprobes{$name} = "_template";
2466
2467 $g->{_dyn} = sub {
2468 # if there is a subprobe, the top-level section
2469 # of this probe turns into a template, and we
2470 # need to delete its _mandatory list.
2471 # Note that Config::Grammar does mandatory checking
2472 # after the whole config tree is read, so we can fiddle
2473 # here with "_mandatory" all we want.
2474 # see 1.3 above
2475
2476 my ($re, $subprobename, $subprobegrammar) = @_;
2477 delete $grammar->{_mandatory};
2478 # the parent section doesn't define a valid probe anymore
2479 delete $knownprobes{$name}
2480 if exists $knownprobes{$name}
2481 and $knownprobes{$name} eq '_template';
2482 # this also keeps track of the real module name for each subprobe,
2483 # should we ever need it
2484 $knownprobes{$subprobename} = $name;
2485 my $subtargetvars = _deepcopy($targetvars);
2486 $storedtargetvars{$subprobename} = $subtargetvars;
2487 # make any mandatory variable specified here non-mandatory in the Targets section
2488 # see 1.4 above
2489 my $sub = sub {
2490 my ($name, $val, $grammar) = shift;
2491 $subtargetvars->{_mandatory} = [ grep { $_ ne $name } @{$subtargetvars->{_mandatory}} ];
2492 };
2493 for my $var (@targetvars) {
2494 $subprobegrammar->{$var}{_dyn} = $sub
2495 if grep { $_ eq $var } @{$subtargetvars->{_mandatory}};
2496 }
2497 }
2498 },
2499 _dyndoc => $probelist, # all available probes
2500 _sections => [ "/$KEYD_RE/" ],
2501 "/$KEYD_RE/" => {
2502 _doc => <<DOC,
2503You can define multiple instances of the same probe with subsections.
2504These instances can have different values for their variables, so you
2505can eg. have one instance of the FPing probe with packet size 1000 and
2506step 300 and another instance with packet size 64 and step 30.
2507The name of the subsection determines what the probe will be called, so
2508you can write descriptive names for the probes.
2509
2510If there are any subsections defined, the main section for this probe
2511will just provide default parameter values for the probe instances, ie.
2512it will not become a probe instance itself.
2513
2514The example above would be written like this:
2515
2516 *** Probes ***
2517
2518 + FPing
2519 # this value is common for the two subprobes
2520 binary = /usr/bin/fping
2521
2522 ++ FPingLarge
2523 packetsize = 1000
2524 step = 300
2525
2526 ++ FPingSmall
2527 packetsize = 64
2528 step = 30
2529
2530DOC
2531 },
2532 }; # $PROBES
2533
2534 my $parser = Smokeping::Config->new
2535 (
2536 {
2537 _sections => [ qw(General Database Presentation Probes Targets Alerts Slaves) ],
2538 _mandatory => [ qw(General Database Presentation Probes Targets) ],
2539 General =>
2540 {
2541 _doc => <<DOC,
2542General configuration values valid for the whole SmokePing setup.
2543DOC
2544 _vars =>
2545 [ qw(owner imgcache imgurl datadir dyndir pagedir piddir sendmail offset
2546 smokemail cgiurl mailhost snpphost contact display_name
2547 syslogfacility syslogpriority concurrentprobes changeprocessnames tmail
2548 changecgiprogramname linkstyle precreateperms ) ],
2549
2550 _mandatory =>
2551 [ qw(owner imgcache imgurl datadir piddir
2552 smokemail cgiurl contact) ],
2553 imgcache =>
2554 { %$DIRCHECK_SUB,
2555 _doc => <<DOC,
2556A directory which is visible on your webserver where SmokePing can cache graphs.
2557DOC
2558 },
2559
2560 imgurl =>
2561 {
2562 _doc => <<DOC,
2563Either an absolute URL to the B<imgcache> directory or one relative to the directory where you keep the
2564SmokePing cgi.
2565DOC
2566 },
2567
2568 display_name =>
2569 {
2570 _doc => <<DOC,
2571What should the master host be called when working in master/slave mode. This is used in the overview
2572graph for example.
2573DOC
2574 },
2575 pagedir =>
2576 {
2577 %$DIRCHECK_SUB,
2578 _doc => <<DOC,
2579Directory to store static representations of pages.
2580DOC
2581 },
2582 owner =>
2583 {
2584 _doc => <<DOC,
2585Name of the person responsible for this smokeping installation.
2586DOC
2587 },
2588
2589 mailhost =>
2590 {
2591 _doc => <<DOC,
2592
2593Instead of using sendmail, you can specify the name of an smtp server and
2594use perl's Net::SMTP module to send mail (for alerts and DYNAMIC client
2595script). Several comma separated mailhosts can be specified. SmokePing will
2596try one after the other if one does not answer for 5 seconds.
2597DOC
2598 _sub => sub { require Net::SMTP ||return "ERROR: loading Net::SMTP"; return undef; }
2599 },
2600
2601 snpphost =>
2602 {
2603 _doc => <<DOC,
2604If you have a SNPP (Simple Network Pager Protocol) server at hand, you can have alerts
2605sent there too. Use the syntax B<snpp:someaddress> to use a snpp address in any place where you can use a mail address otherwhise.
2606DOC
2607 _sub => sub { require Net::SNPP ||return "ERROR: loading Net::SNPP"; return undef; }
2608 },
2609
2610 contact =>
2611 { _re => '\S+@\S+',
2612 _re_error =>
2613 "use an email address of the form 'name\@place.dom'",
2614
2615 _doc => <<DOC,
2616Mail address of the person responsible for this smokeping installation.
2617DOC
2618 },
2619
2620 datadir =>
2621 {
2622 %$DIRCHECK_SUB,
2623 _doc => <<DOC,
2624The directory where SmokePing can keep its rrd files.
2625DOC
2626 },
2627 dyndir =>
2628 {
2629 %$DIRCHECK_SUB,
2630 _doc => <<DOC,
2631The base directory where SmokePing keeps the files related to the DYNAMIC function.
2632This directory must be writeable by the WWW server. It is also used for temporary
2633storage of slave polling results by the master in
2634L<the masterE<sol>slave mode|smokeping_master_slave>.
2635
2636If this variable is not specified, the value of C<datadir> will be used instead.
2637DOC
2638 },
2639 piddir =>
2640 {
2641 %$DIRCHECK_SUB,
2642 _doc => <<DOC,
2643The directory where SmokePing keeps its pid when daemonised.
2644DOC
2645 },
2646 sendmail =>
2647 {
2648 %$FILECHECK_SUB,
2649 _doc => <<DOC,
2650Path to your sendmail binary. It will be used for sending mails in connection with the support of DYNAMIC addresses.
2651DOC
2652 },
2653 smokemail =>
2654 {
2655 %$FILECHECK_SUB,
2656 _doc => <<DOC,
2657Path to the mail template for DYNAMIC hosts. This mail template
2658must contain keywords of the form B<E<lt>##>I<keyword>B<##E<gt>>. There is a sample
2659template included with SmokePing.
2660DOC
2661 },
2662 cgiurl =>
2663 {
2664 _re => 'https?://\S+',
2665 _re_error =>
2666 "cgiurl must be a http(s)://.... url",
2667 _doc => <<DOC,
2668Complete URL path of the SmokePing.cgi
2669DOC
2670
2671 },
2672 precreateperms =>
2673 {
2674 _re => '[0-7]+',
2675 _re_error => 'please specify the permissions in octal',
2676 _example => '2755',
2677 _doc => <<DOC,
2678If this variable is set, the Smokeping daemon will create its directory
2679hierarchy under 'dyndir' (the CGI-writable tree) at startup with the
2680specified directory permission bits. The value is interpreted as an
2681octal value, eg. 775 for rwxrwxr-x etc.
2682
2683If unset, the directories will be created dynamically with umask 022.
2684DOC
2685 },
2686 linkstyle =>
2687 {
2688 _re => '(?:absolute|relative|original)',
2689 _default => 'relative',
2690 _re_error =>
2691 'linkstyle must be one of "absolute", "relative" or "original"',
2692 _doc => <<DOC,
2693How the CGI self-referring links are created. The possible values are
2694
2695${e}over
2696
2697${e}item absolute
2698
2699Full hostname and path derived from the 'cgiurl' variable
2700
2701S<\<a href="http://hostname/path/smokeping.cgi?foo=bar"\>>
2702
2703${e}item relative
2704
2705Only the parameter part is specified
2706
2707S<\<a href="?foo=bar"\>>
2708
2709${e}item original
2710
2711The way the links were generated before Smokeping version 2.0.4:
2712no hostname, only the path
2713
2714S<\<a href="/path/smokeping.cgi?foo=bar"\>>
2715
2716${e}back
2717
2718The default is "relative", which hopefully works for everybody.
2719DOC
2720 },
2721 syslogfacility =>
2722 {
2723 _re => '\w+',
2724 _re_error =>
2725 "syslogfacility must be alphanumeric",
2726 _doc => <<DOC,
2727The syslog facility to use, eg. local0...local7.
2728Note: syslog logging is only used if you specify this.
2729DOC
2730 },
2731 syslogpriority =>
2732 {
2733 _re => '\w+',
2734 _re_error =>
2735 "syslogpriority must be alphanumeric",
2736 _doc => <<DOC,
2737The syslog priority to use, eg. debug, notice or info.
2738Default is $DEFAULTPRIORITY.
2739DOC
2740 },
2741 offset => {
2742 _re => '(\d+%|random)',
2743 _re_error =>
2744 "Use offset either in % of operation interval or 'random'",
2745 _doc => <<DOC,
2746If you run many instances of smokeping you may want to prevent them from
2747hitting your network all at the same time. Using the offset parameter you
2748can change the point in time when the probes are run. Offset is specified
2749in % of total interval, or alternatively as 'random'. I recommend to use
2750'random'. Note that this does NOT influence the rrds itself, it is just a
2751matter of when data acqusition is initiated. The default offset is 'random'.
2752DOC
2753 },
2754 concurrentprobes => {
2755 _re => '(yes|no)',
2756 _re_error =>"this must either be 'yes' or 'no'",
2757 _doc => <<DOC,
2758If you use multiple probes or multiple instances of the same probe and you
2759want them to run concurrently in separate processes, set this to 'yes'. This
2760gives you the possibility to specify probe-specific step and offset parameters
2761(see the 'Probes' section) for each probe and makes the probes unable to block
2762each other in cases of service outages. The default is 'yes', but if you for
2763some reason want the old behaviour you can set this to 'no'.
2764DOC
2765 },
2766 changeprocessnames => {
2767 _re => '(yes|no)',
2768 _re_error =>"this must either be 'yes' or 'no'",
2769 _doc => <<DOC,
2770When using 'concurrentprobes' (see above), this controls whether the probe
2771subprocesses should change their argv string to indicate their probe in
2772the process name. If set to 'yes' (the default), the probe name will
2773be appended to the process name as '[probe]', eg. '/usr/bin/smokeping
2774[FPing]'. If you don't like this behaviour, set this variable to 'no'.
2775If 'concurrentprobes' is not set to 'yes', this variable has no effect.
2776DOC
2777 _default => 'yes',
2778 },
2779 changecgiprogramname => {
2780 _re => '(yes|no)',
2781 _re_error =>"this must either be 'yes' or 'no'",
2782 _doc => <<DOC,
2783Usually the Smokeping CGI tries to log any possible errors with an extended
2784program name that includes the IP address of the remote client for easier
2785debugging. If this variable is set to 'no', the program name will not be
2786modified. The only reason you would want this is if you have a very old
2787version of the CGI::Carp module. See
2788L<the installation document|smokeping_install> for details.
2789DOC
2790 _default => 'yes',
2791 },
2792 tmail =>
2793 {
2794 %$FILECHECK_SUB,
2795 _doc => <<DOC,
2796Path to your tSmoke HTML mail template file. See the tSmoke documentation for details.
2797DOC
2798 }
2799 },
2800
2801 Database =>
2802 {
2803 _vars => [ qw(step pings) ],
2804 _mandatory => [ qw(step pings) ],
2805 _doc => <<DOC,
2806Describes the properties of the round robin database for storing the
2807SmokePing data. Note that it is not possible to edit existing RRDs
2808by changing the entries in the cfg file.
2809DOC
2810
2811 step =>
2812 {
2813 %$INTEGER_SUB,
2814 _doc => <<DOC,
2815Duration of the base operation interval of SmokePing in seconds.
2816SmokePing will venture out every B<step> seconds to ping your target hosts.
2817If 'concurrent_probes' is set to 'yes' (see above), this variable can be
2818overridden by each probe. Note that the step in the RRD files is fixed when
2819they are originally generated, and if you change the step parameter afterwards,
2820you'll have to delete the old RRD files or somehow convert them.
2821DOC
2822 },
2823 pings =>
2824 {
2825 _re => '\d+',
2826 _sub => sub {
2827 my $val = shift;
2828 return "ERROR: The pings value must be at least 3."
2829 if $val < 3;
2830 return undef;
2831 },
2832 _doc => <<DOC,
2833How many pings should be sent to each target. Suggested: 20 pings. Minimum value: 3 pings.
2834This can be overridden by each probe. Some probes (those derived from
2835basefork.pm, ie. most except the FPing variants) will even let this
2836be overridden target-specifically. Note that the number of pings in
2837the RRD files is fixed when they are originally generated, and if you
2838change this parameter afterwards, you'll have to delete the old RRD
2839files or somehow convert them.
2840DOC
2841 },
2842
2843 _table =>
2844 {
2845 _doc => <<DOC,
2846This section also contains a table describing the setup of the
2847SmokePing database. Below are reasonable defaults. Only change them if
2848you know rrdtool and its workings. Each row in the table describes one RRA.
2849
2850 # cons xff steps rows
2851 AVERAGE 0.5 1 1008
2852 AVERAGE 0.5 12 4320
2853 MIN 0.5 12 4320
2854 MAX 0.5 12 4320
2855 AVERAGE 0.5 144 720
2856 MAX 0.5 144 720
2857 MIN 0.5 144 720
2858
2859DOC
2860 _columns => 4,
2861 0 =>
2862 {
2863 _doc => <<DOC,
2864Consolidation method.
2865DOC
2866 _re => '(AVERAGE|MIN|MAX)',
2867 _re_error => "Choose a valid consolidation function",
2868 },
2869 1 =>
2870 {
2871 _doc => <<DOC,
2872What part of the consolidated intervals must be known to warrant a known entry.
2873DOC
2874 _sub => sub {
2875 return "Xff must be between 0 and 1"
2876 unless $_[ 0 ] > 0 and $_[ 0 ] <= 1;
2877 return undef;
2878 }
2879 },
2880 2 => {%$INTEGER_SUB,
2881 _doc => <<DOC,
2882How many B<steps> to consolidate into for each RRA entry.
2883DOC
2884 },
2885
2886 3 => {%$INTEGER_SUB,
2887 _doc => <<DOC,
2888How many B<rows> this RRA should have.
2889DOC
2890 }
2891 }
2892 },
2893 Presentation =>
2894 {
2895 _doc => <<DOC,
2896Defines how the SmokePing data should be presented.
2897DOC
2898 _sections => [ qw(overview detail charts multihost hierarchies) ],
2899 _mandatory => [ qw(overview template detail) ],
2900 _vars => [ qw (template charset) ],
2901 template =>
2902 {
2903 _doc => <<DOC,
2904The webpage template must contain keywords of the form
2905B<E<lt>##>I<keyword>B<##E<gt>>. There is a sample
2906template included with SmokePing; use it as the basis for your
2907experiments. Default template contains a pointer to the SmokePing
2908counter and homepage. I would be glad if you would not remove this as
2909it gives me an indication as to how widely used the tool is.
2910DOC
2911
2912 _sub => sub {
2913 return "template '$_[0]' not readable" unless -r $_[ 0 ];
2914 return undef;
2915 }
2916 },
2917 charset => {
2918 _doc => <<DOC,
2919By default, SmokePing assumes the 'iso-8859-15' character set. If you use
2920something else, this is the place to speak up.
2921DOC
2922 },
2923 charts => {
2924 _doc => <<DOC,
2925The SmokePing Charts feature allow you to have Top X lists created according
2926to various criteria.
2927
2928Each type of Chart must live in its own subsection.
2929
2930 + charts
2931 menu = Charts
2932 title = The most interesting destinations
2933 ++ median
2934 sorter = Median(entries=>10)
2935 title = Sorted by Median Roundtrip Time
2936 menu = Top Median RTT
2937 format = Median RTT %e s
2938
2939DOC
2940 _vars => [ qw(menu title) ],
2941 _sections => [ "/$KEYD_RE/" ],
2942 _mandatory => [ qw(menu title) ],
2943
2944 menu => { _doc => 'Menu entry for the Charts Section.' },
2945 title => { _doc => 'Page title for the Charts Section.' },
2946 "/$KEYD_RE/" =>
2947 {
2948 _vars => [ qw(menu title sorter format) ],
2949 _mandatory => [ qw(menu title sorter) ],
2950 menu => { _doc => 'Menu entry' },
2951 title => { _doc => 'Page title' },
2952 format => { _doc => 'sprintf format string to format curent value' },
2953 sorter => { _re => '\S+\(\S+\)',
2954 _re_error => 'use a sorter call here: Sorter(arg1=>val1,arg2=>val2)',
2955 _doc => 'sorter for this charts sections',
2956 }
2957 }
2958 },
2959
2960 overview =>
2961 { _vars => [ qw(width height range max_rtt median_color strftime) ],
2962 _mandatory => [ qw(width height) ],
2963 _doc => <<DOC,
2964The Overview section defines how the Overview graphs should look.
2965DOC
2966 max_rtt => { _doc => <<DOC },
2967Any roundtrip time larger than this value will cropped in the overview graph
2968DOC
2969 median_color => { _doc => <<DOC,
2970By default the median line is drawn in red. Override it here with a hex color
2971in the format I<rrggbb>. Note that if you work with slaves, the slaves medians will
2972be drawn in the slave color in the overview graph.
2973DOC
2974 _re => '[0-9a-f]{6}',
2975 _re_error => 'use rrggbb for color',
2976 },
2977 strftime => { _doc => <<DOC,
2978Use posix strftime to format the timestamp in the left hand
2979lower corner of the overview graph
2980DOC
2981 _sub => sub {
2982 eval ( "POSIX::strftime( '$_[0]', localtime(time))" );
2983 return $@ if $@;
2984 return undef;
2985 },
2986 },
2987
2988
2989 width =>
2990 {
2991 _sub => sub {
2992 return "width must be be an integer >= 10"
2993 unless $_[ 0 ] >= 10
2994 and int( $_[ 0 ] ) == $_[ 0 ];
2995 return undef;
2996 },
2997 _doc => <<DOC,
2998Width of the Overview Graphs.
2999DOC
3000 },
3001 height =>
3002 {
3003 _doc => <<DOC,
3004Height of the Overview Graphs.
3005DOC
3006 _sub => sub {
3007 return "height must be an integer >= 10"
3008 unless $_[ 0 ] >= 10
3009 and int( $_[ 0 ] ) == $_[ 0 ];
3010 return undef;
3011 },
3012 },
3013 range => { _re => '\d+[smhdwy]',
3014 _re_error =>
3015 "graph range must be a number followed by [smhdwy]",
3016 _doc => <<DOC,
3017How much time should be depicted in the Overview graph. Time must be specified
3018as a number followed by a letter which specifies the unit of time. Known units are:
3019B<s>econds, B<m>inutes, B<h>ours, B<d>days, B<w>eeks, B<y>ears.
3020DOC
3021 },
3022 },
3023 detail =>
3024 {
3025 _vars => [ qw(width height loss_background logarithmic unison_tolerance max_rtt strftime nodata_color) ],
3026 _sections => [ qw(loss_colors uptime_colors) ],
3027 _mandatory => [ qw(width height) ],
3028 _table => { _columns => 2,
3029 _doc => <<DOC,
3030The detailed display can contain several graphs of different resolution. In this
3031table you can specify the resolution of each graph.
3032
3033Example:
3034
3035 "Last 3 Hours" 3h
3036 "Last 30 Hours" 30h
3037 "Last 10 Days" 10d
3038 "Last 400 Days" 400d
3039
3040DOC
3041 1 =>
3042 {
3043 _doc => <<DOC,
3044How much time should be depicted. The format is the same as for the B<age> parameter of the Overview section.
3045DOC
3046 _re => '\d+[smhdwy]',
3047 _re_error =>
3048 "graph age must be a number followed by [smhdwy]",
3049 },
3050 0 =>
3051 {
3052 _doc => <<DOC,
3053Description of the particular resolution.
3054DOC
3055 }
3056 },
3057 strftime => { _doc => <<DOC,
3058Use posix strftime to format the timestamp in the left hand
3059lower corner of the detail graph
3060DOC
3061 _sub => sub {
3062 eval ( "
3063 POSIX::strftime('$_[0]', localtime(time)) " );
3064 return $@ if $@;
3065 return undef;
3066 },
3067 },
3068 nodata_color => {
3069 _re => '[0-9a-f]{6}',
3070 _re_error => "color must be defined with in rrggbb syntax",
3071 _doc => "Paint the graph background in a special color when there is no data for this period because smokeping has not been running (#rrggbb)",
3072 },
3073 loss_background => { _doc => <<EOF,
3074Should the graphs be shown with a background showing loss data for emphasis (yes/no)?
3075
3076If this option is enabled, uptime data is no longer displayed in the graph background.
3077EOF
3078 _re => '(yes|no)',
3079 _re_error =>"this must either be 'yes' or 'no'",
3080 },
3081 logarithmic => { _doc => 'should the graphs be shown in a logarithmic scale (yes/no)',
3082 _re => '(yes|no)',
3083 _re_error =>"this must either be 'yes' or 'no'",
3084 },
3085 unison_tolerance => { _doc => "if a graph is more than this factor of the median 'max' it drops out of the unison scaling algorithm. A factor of two would mean that any graph with a max either less than half or more than twice the median 'max' will be dropped from unison scaling",
3086 _sub => sub { return "tolerance must be larger than 1" if $_[0] <= 1; return undef},
3087 },
3088 max_rtt => { _doc => <<DOC },
3089Any roundtrip time larger than this value will cropped in the detail graph
3090DOC
3091 width => { _doc => 'How many pixels wide should detail graphs be',
3092 _sub => sub {
3093 return "width must be be an integer >= 10"
3094 unless $_[ 0 ] >= 10
3095 and int( $_[ 0 ] ) == $_[ 0 ];
3096 return undef;
3097 },
3098 },
3099 height => { _doc => 'How many pixels high should detail graphs be',
3100 _sub => sub {
3101 return "height must be an integer >= 10"
3102 unless $_[ 0 ] >= 10
3103 and int( $_[ 0 ] ) == $_[ 0 ];
3104 return undef;
3105 },
3106 },
3107
3108 loss_colors => {
3109 _table => { _columns => 3,
3110 _doc => <<DOC,
3111In the Detail view, the color of the median line depends
3112the amount of lost packets. SmokePing comes with a reasonable default setting,
3113but you may choose to disagree. The table below
3114lets you specify your own coloring.
3115
3116Example:
3117
3118 Loss Color Legend
3119 1 00ff00 "<1"
3120 3 0000ff "<3"
3121 1000 ff0000 ">=3"
3122
3123DOC
3124 0 =>
3125 {
3126 _doc => <<DOC,
3127Activate when the number of losst pings is larger or equal to this number
3128DOC
3129 _re => '\d+.?\d*',
3130 _re_error =>
3131 "I was expecting a number",
3132 },
3133 1 =>
3134 {
3135 _doc => <<DOC,
3136Color for this range.
3137DOC
3138 _re => '[0-9a-f]+',
3139 _re_error =>
3140 "I was expecting a color of the form rrggbb",
3141 },
3142
3143 2 =>
3144 {
3145 _doc => <<DOC,
3146Description for this range.
3147DOC
3148 }
3149
3150 }, # table
3151 }, #loss_colors
3152 uptime_colors => {
3153 _table => { _columns => 3,
3154 _doc => <<DOC,
3155When monitoring a host with DYNAMIC addressing, SmokePing will keep
3156track of how long the machine is able to keep the same IP
3157address. This time is plotted as a color in the graphs
3158background. SmokePing comes with a reasonable default setting, but you
3159may choose to disagree. The table below lets you specify your own
3160coloring
3161
3162Example:
3163
3164 # Uptime Color Legend
3165 3600 00ff00 "<1h"
3166 86400 0000ff "<1d"
3167 604800 ff0000 "<1w"
3168 1000000000000 ffff00 ">1w"
3169
3170Uptime is in days!
3171
3172DOC
3173 0 =>
3174 {
3175 _doc => <<DOC,
3176Activate when uptime in days is larger of equal to this number
3177DOC
3178 _re => '\d+.?\d*',
3179 _re_error =>
3180 "I was expecting a number",
3181 },
3182 1 =>
3183 {
3184 _doc => <<DOC,
3185Color for this uptime range.
3186DOC
3187 _re => '[0-9a-f]{6}',
3188 _re_error =>
3189 "I was expecting a color of the form rrggbb",
3190 },
3191
3192 2 =>
3193 {
3194 _doc => <<DOC,
3195Description for this range.
3196DOC
3197 }
3198
3199 },#table
3200 }, #uptime_colors
3201
3202 }, #detail
3203 multihost => {
3204 _vars => [ qw(colors) ],
3205 _doc => "Settings for the multihost graphs. At the moment this is only used for the color setting. Check the documentation on the host property of the target section for more.",
3206 colors => {
3207 _doc => "Space separated list of colors for multihost graphs",
3208 _example => "ff0000 00ff00 0000ff",
3209 _re => '[0-9a-z]{6}(?: [0-9a-z]{6})*',
3210
3211 }
3212 }, #multi host
3213 hierarchies => {
3214 _doc => <<DOC,
3215Provide an alternative presentation hierarchy for your smokeping data. After setting up a hierarchy in this
3216section. You can use it in each tagets parent property. A drop-down menu in the smokeping website lets
3217the user switch presentation hierarchy.
3218DOC
3219 _sections => [ "/$KEYD_RE/" ],
3220 "/$KEYD_RE/" => {
3221 _doc => "Identifier of the hierarchie. Use this as prefix in the targets parent property",
3222 _vars => [ qw(title) ],
3223 _mandatory => [ qw(title) ],
3224 title => {
3225 _doc => "Title for this hierarchy",
3226 }
3227 }
3228 }, #hierarchies
3229 }, #present
3230 Probes => { _sections => [ "/$KEYD_RE/" ],
3231 _doc => <<DOC,
3232The Probes Section configures Probe modules. Probe modules integrate
3233an external ping command into SmokePing. Check the documentation of each
3234module for more information about it.
3235DOC
3236 "/$KEYD_RE/" => $PROBES,
3237 },
3238 Alerts => {
3239 _doc => <<DOC,
3240The Alert section lets you setup loss and RTT pattern detectors. After each
3241round of polling, SmokePing will examine its data and determine which
3242detectors match. Detectors are enabled per target and get inherited by
3243the targets children.
3244
3245Detectors are not just simple thresholds which go off at first sight
3246of a problem. They are configurable to detect special loss or RTT
3247patterns. They let you look at a number of past readings to make a
3248more educated decision on what kind of alert should be sent, or if an
3249alert should be sent at all.
3250
3251The patterns are numbers prefixed with an operator indicating the type
3252of comparison required for a match.
3253
3254The following RTT pattern detects if a target's RTT goes from constantly
3255below 10ms to constantly 100ms and more:
3256
3257 old ------------------------------> new
3258 <10,<10,<10,<10,<10,>10,>100,>100,>100
3259
3260Loss patterns work in a similar way, except that the loss is defined as the
3261percentage the total number of received packets is of the total number of packets sent.
3262
3263 old ------------------------------> new
3264 ==0%,==0%,==0%,==0%,>20%,>20%,>=20%
3265
3266Apart from normal numbers, patterns can also contain the values B<*>
3267which is true for all values regardless of the operator. And B<U>
3268which is true for B<unknown> data together with the B<==> and B<=!> operators.
3269
3270Detectors normally act on state changes. This has the disadvantage, that
3271they will fail to find conditions which were already present when launching
3272smokeping. For this it is possible to write detectors that begin with the
3273special value B<==S> it is inserted whenever smokeping is started up.
3274
3275You can write
3276
3277 ==S,>20%,>20%
3278
3279to detect lines that have been losing more than 20% of the packets for two
3280periods after startup.
3281
3282If you want to make sure a value within a certain range you can use two conditions
3283in one element
3284
3285 >45%<=55%
3286
3287Sometimes it may be that conditions occur at irregular intervals. But still
3288you only want to throw an alert if they occur several times within a certain
3289amount of times. The operator B<*X*> will ignore up to I<X> values and still
3290let the pattern match:
3291
3292 >10%,*10*,>10%
3293
3294will fire if more than 10% of the packets have been lost at least twice over the
3295last 10 samples.
3296
3297A complete example
3298
3299 *** Alerts ***
3300 to = admin\@company.xy,peter\@home.xy
3301 from = smokealert\@company.xy
3302
3303 +lossdetect
3304 type = loss
3305 # in percent
3306 pattern = ==0%,==0%,==0%,==0%,>20%,>20%,>20%
3307 comment = suddenly there is packet loss
3308
3309 +miniloss
3310 type = loss
3311 # in percent
3312 pattern = >0%,*12*,>0%,*12*,>0%
3313 comment = detected loss 3 times over the last two hours
3314
3315 +rttdetect
3316 type = rtt
3317 # in milliseconds
3318 pattern = <10,<10,<10,<10,<10,<100,>100,>100,>100
3319 comment = routing messed up again ?
3320
3321 +rttbadstart
3322 type = rtt
3323 # in milliseconds
3324 pattern = ==S,==U
3325 comment = offline at startup
3326
3327DOC
3328
3329 _sections => [ '/[^\s,]+/' ],
3330 _vars => [ qw(to from edgetrigger mailtemplate) ],
3331 _mandatory => [ qw(to from)],
3332 to => { _doc => <<DOC,
3333Either an email address to send alerts to, or the name of a program to
3334execute when an alert matches. To call a program, the first character of the
3335B<to> value must be a pipe symbol "|". The program will the be called
3336whenever an alert matches, using the following 5 arguments
3337(except if B<edgetrigger> is 'yes'; see below):
3338B<name-of-alert>, B<target>, B<loss-pattern>, B<rtt-pattern>, B<hostname>.
3339You can also provide a comma separated list of addresses and programs.
3340DOC
3341 _re => '(\|.+|.+@\S+|snpp:)',
3342 _re_error => 'put an email address or the name of a program here',
3343 },
3344 from => { _doc => 'who should alerts appear to be coming from ?',
3345 _re => '.+@\S+',
3346 _re_error => 'put an email address here',
3347 },
3348 edgetrigger => { _doc => <<DOC,
3349The alert notifications and/or the programs executed are normally triggered every
3350time the alert matches. If this variable is set to 'yes', they will be triggered
3351only when the alert's state is changed, ie. when it's raised and when it's cleared.
3352Subsequent matches of the same alert will thus not trigger a notification.
3353
3354When this variable is set to 'yes', a notification program (see the B<to> variable
3355documentation above) will get a sixth argument, B<raise>, which has the value 1 if the alert
3356was just raised and 0 if it was cleared.
3357DOC
3358 _re => '(yes|no)',
3359 _re_error =>"this must either be 'yes' or 'no'",
3360 _default => 'no',
3361 },
3362 mailtemplate => {
3363 _doc => <<DOC,
3364When sending out mails for alerts, smokeping normally uses an internally
3365generated message. With the mailtemplate you can customize the alert mails
3366to look they way you like them. The all B<E<lt>##>I<keyword>B<##E<gt>> type
3367strings will get replaced in the template before it is sent out. the
3368following keywords are supported:
3369
3370 <##ALERT##> - target name
3371 <##WHAT##> - status (is active, was raised, was celared)
3372 <##LINE##> - path in the config tree
3373 <##URL##> - webpage for graph
3374 <##STAMP##> - date and time
3375 <##PAT##> - pattern that matched the alert
3376 <##LOSS##> - loss history
3377 <##RTT##> - rtt history
3378 <##COMMENT##> - comment
3379
3380
3381DOC
3382
3383 _sub => sub {
3384 open (my $tmpl, $_[0]) or
3385 return "mailtemplate '$_[0]' not readable";
3386 my $subj;
3387 while (<$tmpl>){
3388 $subj =1 if /^Subject: /;
3389 next if /^\S+: /;
3390 last if /^$/;
3391 return "mailtemplate '$_[0]' should start with mail header lines";
3392 }
3393 return "mailtemplate '$_[0]' has no Subject: line" unless $subj;
3394 return undef;
3395 },
3396 },
3397 '/[^\s,]+/' => {
3398 _vars => [ qw(type pattern comment to edgetrigger mailtemplate priority) ],
3399 _inherited => [ qw(edgetrigger mailtemplate) ],
3400 _mandatory => [ qw(type pattern comment) ],
3401 to => { _doc => 'Similar to the "to" parameter on the top-level except that it will only be used IN ADDITION to the value of the toplevel parameter. Same rules apply.',
3402 _re => '(\|.+|.+@\S+|snpp:)',
3403 _re_error => 'put an email address or the name of a program here',
3404 },
3405
3406 type => {
3407 _doc => <<DOC,
3408Currently the pattern types B<rtt> and B<loss> and B<matcher> are known.
3409
3410Matchers are plugin modules that extend the alert conditions. Known
3411matchers are @{[join (", ", map { "L<$_|Smokeping::matchers::$_>" }
3412@matcherlist)]}.
3413
3414See the documentation of the corresponding matcher module
3415(eg. L<Smokeping::matchers::$matcherlist[0]>) for instructions on
3416configuring it.
3417DOC
3418 _re => '(rtt|loss|matcher)',
3419 _re_error => 'Use loss, rtt or matcher'
3420 },
3421 pattern => {
3422 _doc => "a comma separated list of comparison operators and numbers. rtt patterns are in milliseconds, loss patterns are in percents",
3423 _re => '(?:([^,]+)(,[^,]+)*|\S+\(.+\s)',
3424 _re_error => 'Could not parse pattern or matcher',
3425 },
3426 edgetrigger => {
3427 _re => '(yes|no)',
3428 _re_error =>"this must either be 'yes' or 'no'",
3429 _default => 'no',
3430 },
3431 priority => {
3432 _re => '[1-9]\d*',
3433 _re_error =>"priority must be between 1 and oo",
3434 _doc => <<DOC,
3435if multiple alerts 'match' only the one with the highest priority (lowest number) will cause and
3436alert to be sent. Alerts without priority will be sent in any case.
3437DOC
3438 },
3439 mailtemplate => {
3440 _sub => sub {
3441 open (my $tmpl, $_[0]) or
3442 return "mailtemplate '$_[0]' not readable";
3443 my $subj;
3444 while (<$tmpl>){
3445 $subj =1 if /^Subject: /;
3446 next if /^\S+: /;
3447 last if /^$/;
3448 return "mailtemplate '$_[0]' should start with mail header lines";
3449 }
3450 return "mailtemplate '$_[0]' has no Subject: line" unless $subj;
3451 return undef;
3452 },
3453 },
3454 },
3455 },
3456 Slaves => {_doc => <<END_DOC,
3457Your smokeping can remote control other somkeping instances running in slave
3458mode on different hosts. Use this section to tell your master smokeping about the
3459slaves you are going to use.
3460END_DOC
3461 _vars => [ qw(secrets) ],
3462 _mandatory => [ qw(secrets) ],
3463 _sections => [ "/$KEYDD_RE/" ],
3464 secrets => {
3465 _sub => sub {
3466 return "File '$_[0]' does not exist" unless -f $_[ 0 ];
3467 return "File '$_[0]' is world-readable or writable, refusing it"
3468 if ((stat(_))[2] & 6);
3469 return undef;
3470 },
3471 _doc => <<END_DOC,
3472The slave secrets file contines one line per slave with the name of the slave followed by a colon
3473and the secret:
3474
3475 slave1:secret1
3476 slave2:secret2
3477 ...
3478
3479Note that these secrets combined with a man-in-the-middle attack
3480effectively give shell access to the corresponding slaves (see
3481L<smokeping_master_slave>), so the file should be appropriately protected
3482and the secrets should not be easily crackable.
3483END_DOC
3484
3485 },
3486 timeout => {
3487 %$INTEGER_SUB,
3488 _doc => <<END_DOC,
3489How long should the master wait for its slave to answer?
3490END_DOC
3491 },
3492 "/$KEYDD_RE/" => {
3493 _vars => [ qw(display_name location color) ],
3494 _mandatory => [ qw(display_name color) ],
3495 _sections => [ qw(override) ],
3496 _doc => <<END_DOC,
3497Define some basic properties for the slave.
3498END_DOC
3499 display_name => {
3500 _doc => <<END_DOC,
3501Name of the Slave host.
3502END_DOC
3503 },
3504 location => {
3505 _doc => <<END_DOC,
3506Where is the slave located.
3507END_DOC
3508 },
3509 color => {
3510 _doc => <<END_DOC,
3511Color for the slave in graphs where input from multiple hosts is presented.
3512END_DOC
3513 _re => '[0-9a-f]{6}',
3514 _re_error => "I was expecting a color of the form rrggbb",
3515 },
3516 override => {
3517 _doc => <<END_DOC,
3518If part of the configuration information must be overwritten to match the
3519settings of the you can specify this in this section. A setting is
3520overwritten by giveing the full path of the configuration variable. If you
3521have this configuration in the Probes section:
3522
3523 *** Probes ***
3524 +FPing
3525 binary = /usr/sepp/bin/fping
3526
3527You can override it for a particular slave like this:
3528
3529 ++override
3530 Probes.FPing.binary = /usr/bin/fping
3531END_DOC
3532 _vars => [ '/\S+/' ],
3533 }
3534 }
3535 },
3536 Targets => {_doc => <<DOC,
3537The Target Section defines the actual work of SmokePing. It contains a
3538hierarchical list of hosts which mark the endpoints of the network
3539connections the system should monitor. Each section can contain one host as
3540well as other sections. By adding slaves you can measure the connection to
3541an endpoint from multiple locations.
3542DOC
3543 _vars => [ qw(probe menu title remark alerts slaves menuextra parents) ],
3544 _mandatory => [ qw(probe menu title) ],
3545 _order => 1,
3546 _sections => [ "/$KEYD_RE/" ],
3547 _recursive => [ "/$KEYD_RE/" ],
3548 "/$KEYD_RE/" => $TARGETCOMMON, # this is just for documentation, _dyn() below replaces it
3549 probe => {
3550 _doc => <<DOC,
3551The name of the probe module to be used for this host. The value of
3552this variable gets propagated
3553DOC
3554 _sub => sub {
3555 my $val = shift;
3556 return "probe $val missing from the Probes section"
3557 unless $knownprobes{$val};
3558 return undef;
3559 },
3560 # create the syntax based on the selected probe.
3561 # see 2.1 above
3562 _dyn => sub {
3563 my ($name, $val, $grammar) = @_;
3564
3565 my $targetvars = _deepcopy($storedtargetvars{$val});
3566 my @mandatory = @{$targetvars->{_mandatory}};
3567 delete $targetvars->{_mandatory};
3568 my @targetvars = sort keys %$targetvars;
3569 for (@targetvars) {
3570 # the default values for targetvars are only used in the Probes section
3571 delete $targetvars->{$_}{_default};
3572 $grammar->{$_} = $targetvars->{$_};
3573 }
3574 push @{$grammar->{_vars}}, @targetvars;
3575 my $g = { %{_deepcopy($TARGETCOMMON)}, %{_deepcopy($targetvars)} };
3576 $grammar->{"/$KEYD_RE/"} = $g;
3577 $g->{_vars} = [ @{$g->{_vars}}, @targetvars ];
3578 $g->{_inherited} = [ @{$g->{_inherited}}, @targetvars ];
3579 # this makes the reference manual a bit less cluttered
3580 for (@targetvars){
3581 $g->{$_}{_doc} = 'see above';
3582 $grammar->{$_}{_doc} = 'see above';
3583 delete $grammar->{$_}{_example};
3584 delete $g->{$_}{_example};
3585 }
3586 # make the mandatory variables mandatory only in sections
3587 # with 'host' defined
3588 # see 2.3 above
3589 $g->{host}{_dyn} = sub {
3590 my ($name, $val, $grammar) = @_;
3591 $grammar->{_mandatory} = [ @mandatory ];
3592 };
3593 }, # _dyn
3594 _dyndoc => $probelist, # all available probes
3595 }, #probe
3596 menu => { _doc => <<DOC },
3597Menu entry for this section. If not set this will be set to the hostname.
3598DOC
3599 alerts => { _doc => <<DOC },
3600A comma separated list of alerts to check for this target. The alerts have
3601to be setup in the Alerts section. Alerts are inherited by child nodes. Use
3602an empty alerts definition to remove inherited alerts from the current target
3603and its children.
3604
3605DOC
3606 title => { _doc => <<DOC },
3607Title of the page when it is displayed. This will be set to the hostname if
3608left empty.
3609DOC
3610
3611 remark => { _doc => <<DOC },
3612An optional remark on the current section. It gets displayed on the webpage.
3613DOC
3614 slaves => { _doc => <<DOC },
3615List of slave servers. It gets inherited by all targets.
3616DOC
3617 menuextra => { _doc => <<DOC },
3618HTML String to be added to the end of each menu entry. The C<{HOST}> entry will be replaced by the
3619host property of the relevant section. The C<{CLASS}> entry will be replaced by the same
3620class as the other tags in the manu line.
3621DOC
3622
3623 }
3624
3625 }
3626 );
3627 return $parser;
3628}
3629
3630sub get_config ($$){
3631 my $parser = shift;
3632 my $cfgfile = shift;
3633
3634 my $cfg = $parser->parse( $cfgfile ) or die "ERROR: $parser->{err}\n";
3635 # lets have defaults for multihost colors
3636 if (not $cfg->{Presentation}{multihost} or not $cfg->{Presentation}{multihost}{colors}){
3637 $cfg->{Presentation}{multihost}{colors} = "004586 ff420e ffde20 579d1c 7e0021 83caff 314004 aecf00 4b1f6f ff950e c5000b 0084d1";
3638 }
3639 return $cfg;
3640
3641
3642}
3643
3644sub kill_smoke ($$) {
3645 my $pidfile = shift;
3646 my $signal = shift;
3647 if (defined $pidfile){
3648 if ( -f $pidfile && open PIDFILE, "<$pidfile" ) {
3649 <PIDFILE> =~ /(\d+)/;
3650 my $pid = $1;
3651 if ($signal == SIGINT || $signal == SIGTERM) {
3652 kill $signal, $pid if kill 0, $pid;
3653 sleep 3; # let it die
3654 die "ERROR: Can not stop running instance of SmokePing ($pid)\n"
3655 if kill 0, $pid;
3656 } else {
3657 die "ERROR: no instance of SmokePing running (pid $pid)?\n"
3658 unless kill 0, $pid;
3659 kill $signal, $pid;
3660 }
3661 close PIDFILE;
3662 } else {
3663 die "ERROR: Can not read pid from $pidfile: $!\n";
3664 };
3665 }
3666}
3667
3668sub daemonize_me ($) {
3669 my $pidfile = shift;
3670 if (defined $pidfile){
3671 if (-f $pidfile ) {
3672 open PIDFILE, "<$pidfile";
3673 <PIDFILE> =~ /(\d+)/;
3674 close PIDFILE;
3675 my $pid = $1;
3676 die "ERROR: I Quit! Another copy of $0 ($pid) seems to be running.\n".
3677 " Check $pidfile\n"
3678 if kill 0, $pid;
3679 }
3680 }
3681 print "Warning: no logging method specified. Messages will be lost.\n"
3682 unless $logging;
3683 print "Daemonizing $0 ...\n";
3684 defined (my $pid = fork) or die "Can't fork: $!";
3685 if ($pid) {
3686 exit;
3687 } else {
3688 if(open(PIDFILE,">$pidfile")){
3689 print PIDFILE "$$\n";
3690 close PIDFILE;
3691 } else {
3692 warn "creating $pidfile: $!\n";
3693 };
3694 require POSIX;
3695 &POSIX::setsid or die "Can't start a new session: $!";
3696 open STDOUT,'>/dev/null' or die "ERROR: Redirecting STDOUT to /dev/null: $!";
3697 open STDIN, '</dev/null' or die "ERROR: Redirecting STDIN from /dev/null: $!";
3698 open STDERR, '>/dev/null' or die "ERROR: Redirecting STDERR to /dev/null: $!";
3699 # send warnings and die messages to log
3700 $SIG{__WARN__} = sub { do_log ((shift)."\n") };
3701 $SIG{__DIE__} = sub { return if $^S; do_log ((shift)."\n"); exit 1 };
3702 }
3703}
3704
3705# pseudo log system object
3706{
3707 my $use_syslog;
3708 my $use_cgilog;
3709 my $use_debuglog;
3710 my $use_filelog;
3711
3712 my $syslog_facility;
3713 my $syslog_priority = $DEFAULTPRIORITY;
3714
3715 sub initialize_debuglog (){
3716 $use_debuglog = 1;
3717 }
3718
3719 sub initialize_cgilog (){
3720 $use_cgilog = 1;
3721 $logging=1;
3722 return if $cfg->{General}{changecgiprogramname} eq 'no';
3723 # set_progname() is available starting with CGI.pm-2.82 / Perl 5.8.1
3724 # so trap this inside 'eval'
3725 # even this apparently isn't enough for older versions that try to
3726 # find out whether they are inside an eval...oh well.
3727 eval 'CGI::Carp::set_progname($0 . " [client " . ($ENV{REMOTE_ADDR}||"(unknown)") . "]")';
3728 }
3729
3730 sub initialize_filelog ($){
3731 $use_filelog = shift;
3732 $logging=1;
3733 }
3734
3735 sub initialize_syslog ($$) {
3736 my $fac = shift;
3737 my $pri = shift;
3738 $use_syslog = 1;
3739 $logging=1;
3740 die "missing facility?" unless defined $fac;
3741 $syslog_facility = $fac if defined $fac;
3742 $syslog_priority = $pri if defined $pri;
3743 print "Note: logging to syslog as $syslog_facility/$syslog_priority.\n";
3744 openlog(basename($0), 'pid', $syslog_facility);
3745 eval {
3746 syslog($syslog_priority, 'Starting syslog logging');
3747 };
3748 if ($@) {
3749 print "Warning: can't connect to syslog. Messages will be lost.\n";
3750 print "Error message was: $@";
3751 }
3752 }
3753
3754 sub do_syslog ($){
3755 my $str = shift;
3756 $str =~ s,%,%%,g;
3757 eval {
3758 syslog("$syslog_facility|$syslog_priority", $str);
3759 };
3760 # syslogd is probably dead if that failed
3761 # this message is most probably lost too, if we have daemonized
3762 # let's try anyway, it shouldn't hurt
3763 print STDERR qq(Can't log "$str" to syslog: $@) if $@;
3764 }
3765
3766 sub do_cgilog ($){
3767 my $str = shift;
3768 print "<p>" , $str, "</p>\n";
3769 warn $str, "\n"; # for the webserver log
3770 }
3771
3772 sub do_debuglog ($){
3773 do_log(shift) if $use_debuglog;
3774 }
3775
3776 sub do_filelog ($){
3777 open X,">>$use_filelog" or return;
3778 print X scalar localtime(time)," - ",shift,"\n";
3779 close X;
3780 }
3781
3782 sub do_log (@){
3783 my $string = join(" ", @_);
3784 chomp $string;
3785 do_syslog($string) if $use_syslog;
3786 do_cgilog($string) if $use_cgilog;
3787 do_filelog($string) if $use_filelog;
3788 print STDERR $string,"\n" unless $logging;
3789 }
3790
3791}
3792
3793###########################################################################
3794# The Main Program
3795###########################################################################
3796
3797sub load_cfg ($;$) {
3798 my $cfgfile = shift;
3799 my $noinit = shift;
3800 my $cfmod = (stat $cfgfile)[9] || die "ERROR: loading smokeping configuration file $cfgfile: $!\n";
3801 # when running under speedy this will prevent reloading on every run
3802 # if cfgfile has been modified we will still run.
3803 if (not defined $cfg or not defined $probes # or $cfg->{__last} < $cfmod
3804 ){
3805 $cfg = undef;
3806 my $parser = get_parser;
3807 $cfg = get_config $parser, $cfgfile;
3808
3809 if (defined $cfg->{Presentation}{charts}){
3810 require Storable;
3811 die "ERROR: Could not load Storable Support. This is required for the Charts feature - $@\n" if $@;
3812 load_sorters $cfg->{Presentation}{charts};
3813 }
3814 $cfg->{__parser} = $parser;
3815 $cfg->{__last} = $cfmod;
3816 $cfg->{__cfgfile} = $cfgfile;
3817 $probes = undef;
3818 $probes = load_probes $cfg;
3819 $cfg->{__probes} = $probes;
3820 $cfg->{__hierarchies} = {};
3821 return if $noinit;
3822 init_alerts $cfg if $cfg->{Alerts};
3823 add_targets $cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir};
3824 init_target_tree $cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir};
3825 if (defined $cfg->{General}{precreateperms} && !$cgimode) {
3826 make_cgi_directories($cfg->{Targets}, dyndir($cfg),
3827 $cfg->{General}{precreateperms});
3828 }
3829 #use Data::Dumper;
3830 #die Dumper $cfg->{__hierarchies};
3831 } else {
3832 do_log("Config file unmodified, skipping reload") unless $cgimode;
3833 }
3834}
3835
3836
3837sub makepod ($){
3838 my $parser = shift;
3839 my $e='=';
3840 my $a='@';
3841 my $retval = <<POD;
3842
3843${e}head1 NAME
3844
3845smokeping_config - Reference for the SmokePing Config File
3846
3847${e}head1 OVERVIEW
3848
3849SmokePing takes its configuration from a single central configuration file.
3850Its location must be hardcoded in the smokeping script and smokeping.cgi.
3851
3852The contents of this manual is generated directly from the configuration
3853file parser.
3854
3855The Parser for the Configuration file is written using David Schweikers
3856Config::Grammar module. Read all about it in L<Config::Grammar>.
3857
3858The Configuration file has a tree-like structure with section headings at
3859various levels. It also contains variable assignments and tables.
3860
3861Warning: this manual is rather long. See L<smokeping_examples>
3862for simple configuration examples.
3863
3864${e}head1 REFERENCE
3865
3866${e}head2 GENERAL SYNTAX
3867
3868The text below describes the general syntax of the SmokePing configuration file.
3869It was copied from the Config::Grammar documentation.
3870
3871'#' denotes a comment up to the end-of-line, empty lines are allowed and space
3872at the beginning and end of lines is trimmed.
3873
3874'\\' at the end of the line marks a continued line on the next line. A single
3875space will be inserted between the concatenated lines.
3876
3877'${a}include filename' is used to include another file.
3878
3879'${a}define a some value' will replace all occurences of 'a' in the following text
3880with 'some value'.
3881
3882Fields in tables that contain white space can be enclosed in either C<'> or C<">.
3883Whitespace can also be escaped with C<\\>. Quotes inside quotes are allowed but must
3884be escaped with a backslash as well.
3885
3886${e}head2 SPECIFIC SYNTAX
3887
3888The text below describes the specific syntax of the SmokePing configuration file.
3889
3890POD
3891
3892 $retval .= $parser->makepod;
3893 $retval .= <<POD;
3894
3895${e}head1 COPYRIGHT
3896
3897Copyright (c) 2001-2007 by Tobias Oetiker. All right reserved.
3898
3899${e}head1 LICENSE
3900
3901This program is free software; you can redistribute it
3902and/or modify it under the terms of the GNU General Public
3903License as published by the Free Software Foundation; either
3904version 2 of the License, or (at your option) any later
3905version.
3906
3907This program is distributed in the hope that it will be
3908useful, but WITHOUT ANY WARRANTY; without even the implied
3909warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
3910PURPOSE. See the GNU General Public License for more
3911details.
3912
3913You should have received a copy of the GNU General Public
3914License along with this program; if not, write to the Free
3915Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
391602139, USA.
3917
3918${e}head1 AUTHOR
3919
3920Tobias Oetiker E<lt>tobi\@oetiker.chE<gt>
3921
3922${e}cut
3923POD
3924
3925}
3926sub cgi ($$) {
3927 my $cfgfile = shift;
3928 my $q = shift;
3929 $cgimode = 'yes';
3930 umask 022;
3931 load_cfg $cfgfile;
3932 initialize_cgilog();
3933 if ($q->param(-name=>'slave')) { # a slave is calling in
3934 Smokeping::Master::answer_slave($cfg,$q);
3935 } elsif ($q->param(-name=>'secret') && $q->param(-name=>'target') ) {
3936 my $ret = update_dynaddr $cfg,$q;
3937 if (defined $ret and $ret ne "") {
3938 print $q->header(-status => "404 Not Found");
3939 do_cgilog("Updating DYNAMIC address failed: $ret");
3940 } else {
3941 print $q->header; # no HTML output on success
3942 }
3943 } else {
3944 if (not $q->param('displaymode') or $q->param('displaymode') ne 'a'){ #in ayax mode we do not issue a header YET
3945 }
3946 display_webpage $cfg,$q;
3947 }
3948 if ((stat $cfgfile)[9] > $cfg->{__last}){
3949 # we die if the cfgfile is newer than our in memory copy
3950 kill -9, $$;
3951 }
3952}
3953
3954
3955sub gen_page ($$$);
3956sub gen_page ($$$) {
3957 my ($cfg, $tree, $open) = @_;
3958 my ($q, $name, $page);
3959
3960 $q = bless \$q, 'dummyCGI';
3961
3962 $name = @$open ? join('.', @$open) . ".html" : "index.html";
3963
3964 die "Can not open $cfg-{General}{pagedir}/$name for writing: $!" unless
3965 open PAGEFILE, ">$cfg->{General}{pagedir}/$name";
3966
3967 my $step = $probes->{$tree->{probe}}->step();
3968 my $readversion = "?";
3969 $VERSION =~ /(\d+)\.(\d{3})(\d{3})/ and $readversion = sprintf("%d.%d.%d",$1,$2,$3);
3970 my $authuser = $ENV{REMOTE_USER} || 'Guest';
3971 $page = fill_template
3972 ($cfg->{Presentation}{template},
3973 {
3974 menu => target_menu($cfg->{Targets},
3975 [@$open], #copy this because it gets changed
3976 "", '',".html"),
3977 title => $tree->{title},
3978 remark => ($tree->{remark} || ''),
3979 overview => get_overview( $cfg,$q,$tree,$open ),
3980 body => get_detail( $cfg,$q,$tree,$open ),
3981 target_ip => ($tree->{host} || ''),
3982 owner => $cfg->{General}{owner},
3983 contact => $cfg->{General}{contact},
3984 author => '<A HREF="http://tobi.oetiker.ch/">Tobi Oetiker</A> and Niko Tyni',
3985 smokeping => '<A HREF="http://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'">SmokePing-'.$readversion.'</A>',
3986 step => $step,
3987 rrdlogo => '<A HREF="http://oss.oetiker.ch/rrdtool/"><img border="0" src="'.$cfg->{General}{imgurl}.'/rrdtool.png"></a>',
3988 smokelogo => '<A HREF="http://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'"><img border="0" src="'.$cfg->{General}{imgurl}.'/smokeping.png"></a>',
3989 authuser => $authuser,
3990 });
3991
3992 print PAGEFILE $page || "<HTML><BODY>ERROR: Reading page template ".$cfg->{Presentation}{template}."</BODY></HTML>";
3993 close PAGEFILE;
3994
3995 foreach my $key (keys %$tree) {
3996 my $value = $tree->{$key};
3997 next unless ref($value) eq 'HASH';
3998 gen_page($cfg, $value, [ @$open, $key ]);
3999 }
4000}
4001
4002sub makestaticpages ($$) {
4003 my $cfg = shift;
4004 my $dir = shift;
4005
4006 # If directory is given, override current values (pagedir and and
4007 # imgurl) so that all generated data is in $dir. If $dir is undef,
4008 # use values from config file.
4009 if ($dir) {
4010 mkdir $dir, 0755 unless -d $dir;
4011 $cfg->{General}{pagedir} = $dir;
4012 $cfg->{General}{imgurl} = '.';
4013 }
4014
4015 die "ERROR: No pagedir defined for static pages\n"
4016 unless $cfg->{General}{pagedir};
4017 # Logos.
4018 gen_imgs($cfg);
4019
4020 # Iterate over all targets.
4021 my $tree = $cfg->{Targets};
4022 gen_page($cfg, $tree, []);
4023}
4024
4025sub pages ($) {
4026 my ($config) = @_;
4027 umask 022;
4028 load_cfg($config);
4029 makestaticpages($cfg, undef);
4030}
4031
4032sub pod2man {
4033 my $string = shift;
4034 my $pid = open(P, "-|");
4035 if ($pid) {
4036 pod2usage(-verbose => 2, -input => \*P);
4037 exit 0;
4038 } else {
4039 print $string;
4040 exit 0;
4041 }
4042}
4043
4044sub maybe_require {
4045 # like eval "require $class", but tries to
4046 # fake missing classes by adding them to %INC.
4047 # This rocks when we're building the documentation
4048 # so we don't need to have the external modules
4049 # installed.
4050
4051 my $class = shift;
4052
4053 # don't do the kludge unless we're building documentation
4054 unless (exists $opt{makepod} or exists $opt{man}) {
4055 eval "require $class";
4056 die "require $class failed: $@" if $@;
4057 return;
4058 }
4059
4060 my %faked;
4061
4062 my $file = $class;
4063 $file =~ s,::,/,g;
4064 $file .= ".pm";
4065
4066 eval "require $class";
4067
4068 while ($@ =~ /Can't locate (\S+)\.pm/) {
4069 my $missing = $1;
4070 die("Can't fake missing class $missing, giving up. This shouldn't happen.")
4071 if $faked{$missing}++;
4072 $INC{"$missing.pm"} = "foobar";
4073 $missing =~ s,/,::,;
4074
4075 delete $INC{"$file"}; # so we can redo the require()
4076 eval "require $class";
4077 last unless $@;
4078 }
4079 die "require $class failed: $@" if $@;
4080 my $libpath = find_libdir;
4081 $INC{$file} = "$libpath/$file";
4082}
4083
4084sub probedoc {
4085 my $class = shift;
4086 my $do_man = shift;
4087 maybe_require($class);
4088 if ($do_man) {
4089 pod2man($class->pod);
4090 } else {
4091 print $class->pod;
4092 }
4093 exit 0;
4094}
4095
4096sub verify_cfg {
4097 my $cfgfile = shift;
4098 get_config(get_parser, $cfgfile);
4099 print "Configuration file '$cfgfile' syntax OK.\n";
4100}
4101
4102sub make_kid {
4103 my $sleep_count = 0;
4104 my $pid;
4105 do {
4106 $pid = fork;
4107 unless (defined $pid) {
4108 do_log("Fatal: cannot fork: $!");
4109 die "bailing out"
4110 if $sleep_count++ > 6;
4111 sleep 10;
4112 }
4113 } until defined $pid;
4114 srand();
4115 return $pid;
4116}
4117
4118sub start_probes {
4119 my $pids = shift;
4120 my $pid;
4121 my $myprobe;
4122 for my $p (keys %$probes) {
4123 if ($probes->{$p}->target_count == 0) {
4124 do_log("No targets defined for probe $p, skipping.");
4125 next;
4126 }
4127 $pid = make_kid();
4128 $myprobe = $p;
4129 $pids->{$pid} = $p;
4130 last unless $pid;
4131 do_log("Child process $pid started for probe $p.");
4132 }
4133 return $pid;
4134}
4135
4136sub load_cfg_slave {
4137 my %opt = %{$_[0]};
4138 die "ERROR: no shared-secret defined along with master-url\n" unless $opt{'shared-secret'};
4139 die "ERROR: no cache-dir defined along with master-url\n" unless $opt{'cache-dir'};
4140 die "ERROR: no cache-dir ($opt{'cache-dir'}): $!\n" unless -d $opt{'cache-dir'};
4141 die "ERROR: the shared secret file ($opt{'shared-secret'}) is world-readable or writable"
4142 if ((stat($opt{'shared-secret'}))[2] & 6);
4143 open my $fd, "<$opt{'shared-secret'}" or die "ERROR: opening $opt{'shared-secret'} $!\n";
4144 chomp(my $secret = <$fd>);
4145 close $fd;
4146 my $slave_cfg = {
4147 master_url => $opt{'master-url'},
4148 cache_dir => $opt{'cache-dir'},
4149 pid_dir => $opt{'pid-dir'} || $opt{'cache-dir'},
4150 shared_secret => $secret,
4151 slave_name => $opt{'slave-name'} || hostname(),
4152 };
4153 # this should get us an initial config set from the server
4154 my $new_conf = Smokeping::Slave::submit_results($slave_cfg,{});
4155 if ($new_conf){
4156 $cfg=$new_conf;
4157 $probes = undef;
4158 $probes = load_probes $cfg;
4159 $cfg->{__probes} = $probes;
4160 add_targets($cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir});
4161 } else {
4162 die "ERROR: we did not get config from the master. Maybe we are not configured as a slave for any of the targets on the master ?\n";
4163 }
4164 return $slave_cfg;
4165}
4166
4167sub main (;$) {
4168 $cgimode = 0;
4169 umask 022;
4170 my $defaultcfg = shift;
4171 $opt{filter}=[];
4172 GetOptions(\%opt, 'version', 'email', 'man:s','help','logfile=s','static-pages:s', 'debug-daemon',
4173 'nosleep', 'makepod:s','debug','restart', 'filter=s', 'nodaemon|nodemon',
4174 'config=s', 'check', 'gen-examples', 'reload',
4175 'master-url=s','cache-dir=s','shared-secret=s',
4176 'slave-name=s','pid-dir=s') or pod2usage(2);
4177 if($opt{version}) { print "$VERSION\n"; exit(0) };
4178 if(exists $opt{man}) {
4179 if ($opt{man}) {
4180 if ($opt{man} eq 'smokeping_config') {
4181 pod2man(makepod(get_parser));
4182 } else {
4183 probedoc($opt{man}, 'do_man');
4184 }
4185 } else {
4186 pod2usage(-verbose => 2);
4187 }
4188 exit 0;
4189 }
4190 if($opt{help}) { pod2usage(-verbose => 1); exit 0 };
4191 if(exists $opt{makepod}) {
4192 if ($opt{makepod} and $opt{makepod} ne 'smokeping_config') {
4193 probedoc($opt{makepod});
4194 } else {
4195 print makepod(get_parser);
4196 }
4197 exit 0;
4198 }
4199 if (exists $opt{'gen-examples'}) {
4200 Smokeping::Examples::make($opt{check});
4201 exit 0;
4202 }
4203 initialize_debuglog if $opt{debug} or $opt{'debug-daemon'};
4204 my $slave_cfg;
4205 my $cfgfile = $opt{config} || $defaultcfg;
4206 my $slave_mode = exists $opt{'master-url'};
4207 if ($slave_mode){ # ok we go slave-mode
4208 $slave_cfg = load_cfg_slave(\%opt);
4209 } else {
4210 if(defined $opt{'check'}) { verify_cfg($cfgfile); exit 0; }
4211 if($opt{reload}) {
4212 load_cfg $cfgfile, 'noinit'; # we need just the piddir
4213 kill_smoke $cfg->{General}{piddir}."/smokeping.pid", SIGHUP;
4214 print "HUP signal sent to the running SmokePing process, exiting.\n";
4215 exit 0;
4216 };
4217 load_cfg $cfgfile;
4218
4219 if(defined $opt{'static-pages'}) { makestaticpages $cfg, $opt{'static-pages'}; exit 0 };
4220 if($opt{email}) { enable_dynamic $cfg, $cfg->{Targets},"",""; exit 0 };
4221 }
4222 if($opt{restart}) { kill_smoke $cfg->{General}{piddir}."/smokeping.pid", SIGINT;};
4223
4224 if($opt{logfile}) { initialize_filelog($opt{logfile}) };
4225
4226 if (not keys %$probes) {
4227 do_log("No probes defined, exiting.");
4228 exit 1;
4229 }
4230 unless ($opt{debug} or $opt{nodaemon}) {
4231 if (defined $cfg->{General}{syslogfacility}) {
4232 initialize_syslog($cfg->{General}{syslogfacility},
4233 $cfg->{General}{syslogpriority});
4234 }
4235 daemonize_me $cfg->{General}{piddir}."/smokeping.pid";
4236 }
4237 do_log "Smokeping version $VERSION successfully launched.";
4238
4239RESTART:
4240 my $myprobe;
4241 my $multiprocessmode;
4242 my $forkprobes = $cfg->{General}{concurrentprobes} || 'yes';
4243 if ($forkprobes eq "yes" and keys %$probes > 1 and not $opt{debug}) {
4244 $multiprocessmode = 1;
4245 my %probepids;
4246 my $pid;
4247 do_log("Entering multiprocess mode.");
4248 $pid = start_probes(\%probepids);
4249 $myprobe = $probepids{$pid};
4250 goto KID unless $pid; # child skips rest of loop
4251 # parent
4252 do_log("All probe processes started successfully.");
4253 my $exiting = 0;
4254 my $reloading = 0;
4255 for my $sig (qw(INT TERM)) {
4256 $SIG{$sig} = sub {
4257 do_log("Got $sig signal, terminating child processes.");
4258 $exiting = 1;
4259 kill $sig, $_ for keys %probepids;
4260 my $now = time;
4261 while(keys %probepids) { # SIGCHLD handler below removes the keys
4262 if (time - $now > 2) {
4263 do_log("Fatal: can't terminate all child processes, giving up.");
4264 exit 1;
4265 }
4266 sleep 1;
4267 }
4268 do_log("All child processes successfully terminated, exiting.");
4269 exit 0;
4270 }
4271 };
4272 $SIG{CHLD} = sub {
4273 while ((my $dead = waitpid(-1, WNOHANG)) > 0) {
4274 my $p = $probepids{$dead};
4275 $p = 'unknown' unless defined $p;
4276 do_log("Child process $dead (probe $p) exited unexpectedly with status $?.")
4277 unless $exiting or $reloading;
4278 delete $probepids{$dead};
4279 }
4280 };
4281 my $gothup = 0;
4282 $SIG{HUP} = sub {
4283 do_debuglog("Got HUP signal.");
4284 $gothup = 1;
4285 };
4286 while (1) { # just wait for the signals
4287 sleep; #sleep until we get a signal
4288 next unless $gothup;
4289 $reloading = 1;
4290 $gothup = 0;
4291 my $oldprobes = $probes;
4292 if ($slave_mode) {
4293 load_cfg_slave(\%opt);
4294 } else {
4295 $reloading = 0, next unless reload_cfg($cfgfile);
4296 }
4297 do_debuglog("Restarting probe processes " . join(",", keys %probepids) . ".");
4298 kill SIGHUP, $_ for (keys %probepids);
4299 my $i=0;
4300 while (keys %probepids) {
4301 sleep 1;
4302 if ($i % 10 == 0) {
4303 do_log("Waiting for child processes to terminate.");
4304 }
4305 $i++;
4306 my %termsent;
4307 for (keys %probepids) {
4308 my $step = $oldprobes->{$probepids{$_}}->step;
4309 if ($i > $step) {
4310 do_log("Child process $_ took over its step value to terminate, killing it with SIGTERM");
4311 if (kill SIGTERM, $_ == 0 and exists $probepids{$_}) {
4312 do_log("Fatal: Child process $_ has disappeared? This shouldn't happen. Giving up.");
4313 exit 1;
4314 } else {
4315 $termsent{$_} = time;
4316 }
4317 }
4318 for (keys %termsent) {
4319 if (exists $probepids{$_}) {
4320 if (time() - $termsent{$_} > 2) {
4321 do_log("Fatal: Child process $_ took over 2 seconds to exit on TERM signal. Giving up.");
4322 exit 1;
4323 }
4324 } else {
4325 delete $termsent{$_};
4326 }
4327 }
4328 }
4329 }
4330 $reloading = 0;
4331 do_log("Child processes terminated, restarting with new configuration.");
4332 $SIG{CHLD} = 'DEFAULT'; # restore
4333 goto RESTART;
4334 }
4335 do_log("Exiting abnormally - this should not happen.");
4336 exit 1; # not reached
4337 } else {
4338 $multiprocessmode = 0;
4339 if ($forkprobes ne "yes") {
4340 do_log("Not entering multiprocess mode because the 'concurrentprobes' variable is not set.");
4341 for my $p (keys %$probes) {
4342 for my $what (qw(offset step)) {
4343 do_log("Warning: probe-specific parameter '$what' ignored for probe $p in single-process mode." )
4344 if defined $cfg->{Probes}{$p}{$what};
4345 }
4346 }
4347 } elsif ($opt{debug}) {
4348 do_debuglog("Not entering multiprocess mode with '--debug'. Use '--debug-daemon' for that.")
4349 } elsif (keys %$probes == 1) {
4350 do_log("Not entering multiprocess mode for just a single probe.");
4351 $myprobe = (keys %$probes)[0]; # this way we won't ignore a probe-specific step parameter
4352 }
4353 }
4354KID:
4355 my $offset;
4356 my $step;
4357 my $gothup = 0;
4358 my $changeprocessnames = $cfg->{General}{changeprocessnames} ne "no";
4359 $SIG{HUP} = sub {
4360 do_log("Got HUP signal, " . ($multiprocessmode ? "exiting" : "restarting") . " gracefully.");
4361 $gothup = 1;
4362 };
4363 for my $sig (qw(INT TERM)) {
4364 $SIG{$sig} = sub {
4365 do_log("got $sig signal, terminating.");
4366 exit 1;
4367 }
4368 }
4369 if (defined $myprobe) {
4370 $offset = $probes->{$myprobe}->offset() || 'random';
4371 $step = $probes->{$myprobe}->step();
4372 $0 .= " [$myprobe]" if $changeprocessnames;
4373 } else {
4374 $offset = $cfg->{General}{offset} || 'random';
4375 $step = $cfg->{Database}{step};
4376 }
4377 if ($offset eq 'random'){
4378 $offset = int(rand($step));
4379 } else {
4380 $offset =~ s/%$//;
4381 $offset = $offset / 100 * $step;
4382 }
4383 for (keys %$probes) {
4384 next if defined $myprobe and $_ ne $myprobe;
4385 # fill this in for report_probes() below
4386 $probes->{$_}->offset_in_seconds($offset); # this is just for humans
4387 if ($opt{debug} or $opt{'debug-daemon'}) {
4388 $probes->{$_}->debug(1) if $probes->{$_}->can('debug');
4389 }
4390 }
4391
4392 report_probes($probes, $myprobe);
4393
4394 while (1) {
4395 unless ($opt{nosleep} or $opt{debug}) {
4396 my $sleeptime = $step - (time-$offset) % $step;
4397 if (defined $myprobe) {
4398 $probes->{$myprobe}->do_debug("Sleeping $sleeptime seconds.");
4399 } else {
4400 do_debuglog("Sleeping $sleeptime seconds.");
4401 }
4402 sleep $sleeptime;
4403 last if checkhup($multiprocessmode, $gothup) && reload_cfg($cfgfile);
4404 }
4405 my $now = time;
4406 run_probes $probes, $myprobe; # $myprobe is undef if running without 'concurrentprobes'
4407 my %sortercache;
4408 if ($opt{'master-url'}){
4409 my $new_conf = Smokeping::Slave::submit_results $slave_cfg,$cfg,$myprobe,$probes;
4410 if ($new_conf && !$gothup){
4411 do_log('server has new config for me ... HUPing the parent');
4412 kill_smoke $cfg->{General}{piddir}."/smokeping.pid", SIGHUP;
4413 # wait until the parent signals back if it didn't already
4414 sleep if (!$gothup);
4415 if (!$gothup) {
4416 do_log("Got an unexpected signal while waiting for SIGHUP, exiting");
4417 exit 1;
4418 }
4419 if (!$multiprocessmode) {
4420 load_cfg_slave(\%opt);
4421 last;
4422 }
4423 }
4424 } else {
4425 update_rrds $cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir}, $myprobe, \%sortercache;
4426 save_sortercache($cfg,\%sortercache,$myprobe);
4427 }
4428 exit 0 if $opt{debug};
4429 my $runtime = time - $now;
4430 if ($runtime > $step) {
4431 my $warn = "WARNING: smokeping took $runtime seconds to complete 1 round of polling. ".
4432 "It should complete polling in $step seconds. ".
4433 "You may have unresponsive devices in your setup.\n";
4434 if (defined $myprobe) {
4435 $probes->{$myprobe}->do_log($warn);
4436 } else {
4437 do_log($warn);
4438 }
4439 }
4440 elsif ($runtime > $step * 0.8) {
4441 my $warn = "NOTE: smokeping took $runtime seconds to complete 1 round of polling. ".
4442 "This is over 80% of the max time available for a polling cycle ($step seconds).\n";
4443 if (defined $myprobe) {
4444 $probes->{$myprobe}->do_log($warn);
4445 } else {
4446 do_log($warn);
4447 }
4448 }
4449 last if checkhup($multiprocessmode, $gothup) && reload_cfg($cfgfile);
4450 }
4451 $0 =~ s/ \[$myprobe\]$// if $changeprocessnames;
4452 goto RESTART;
4453}
4454
4455sub checkhup ($$) {
4456 my $multiprocessmode = shift;
4457 my $gothup = shift;
4458 if ($gothup) {
4459 if ($multiprocessmode) {
4460 do_log("Exiting due to HUP signal.");
4461 exit 0;
4462 } else {
4463 do_log("Restarting due to HUP signal.");
4464 return 1;
4465 }
4466 }
4467 return 0;
4468}
4469
4470sub reload_cfg ($) {
4471 my $cfgfile = shift;
4472 return 1 if exists $opt{'master-url'};
4473 my ($oldcfg, $oldprobes) = ($cfg, $probes);
4474 do_log("Reloading configuration.");
4475 $cfg = undef;
4476 $probes = undef;
4477 eval { load_cfg($cfgfile) };
4478 if ($@) {
4479 do_log("Reloading configuration from $cfgfile failed: $@");
4480 ($cfg, $probes) = ($oldcfg, $oldprobes);
4481 return 0;
4482 }
4483 return 1;
4484}
4485
4486
4487sub gen_imgs ($){
4488
4489 my $cfg = shift;
4490 my $modulemodtime;
4491 for (@INC) {
4492 ( -f "$_/Smokeping.pm" ) or next;
4493 $modulemodtime = (stat _)[9];
4494 last;
4495 }
4496 if (not -r $cfg->{General}{imgcache}."/rrdtool.png" or
4497 (defined $modulemodtime and $modulemodtime > (stat _)[9])){
4498open W, ">".$cfg->{General}{imgcache}."/rrdtool.png"
4499 or do { warn "WARNING: creating $cfg->{General}{imgcache}/rrdtool.png: $!\n"; return 0 };
4500binmode W;
4501print W unpack ('u', <<'UUENC');
4502MB5!.1PT*&@H -24A$4@ 'D P" 8 UK=7M "7!(67, YG
4503M .9P&/B8)Q .]DE$051XG.V<"71.9QK''X14FMJ"JHHEDUJJC)-2M11I
4504MAEK'4OM6,[744E7&F58QMJ/6*:JTJ&,=Y*B=:C%$::GE9"2DUE!#$;%5$T*8
4505M^WO-_=Q\WWOS+8FV^/[GY'S)?=_[O,_[[,][[Y<<8N#2I4N54E-3.]Z^?;O0
4506MG3MWQ(^''X8>4Z]>O;HR(B(B)D=24E(Y0[D';MRXD<?X_*UY\R.;D)Z>+LG)
4507MR7+TZ-&F 88'MTY+2\MC*%G\2GYT@"[/G#DC\?'Q'0-NW;H5S 4T[U?RHP-#
4508MKV*$:[EX\6+^G/X<_&CB[MV[CM]S_H9\^/$KP:_DQP !=@/)EU/D0G**QX3"
4509M2A:0P#RVY.3(B61)OW/7=MR*X"?S2.@S^6S'/>$M,#"7A(46]&@]9]PQ^+SZ
4510M\TTIF/\)G^Y_D+AF\'7F_,\NU\-+%Y+< 7J?M=7*VBU'9/J"/5XQ4+G\T]*I
4511M>26)JE7&9:SGD'5R/27-8UKYG@J4AG7"I5OK/TK1D"=]XBTX*(]$O/",M&M:
4512M4:I7>=9V7ONWOY!CIRYEN/9>[UK2NM'S'O/[:^';_:=EZ.2M+M?7?=Y!BA4)
4513MUMZ3K>'ZP _GY>_C-\O(J3'*&[("+#9Z_4%IW_\+.7@DR2<:&-7V[T])W^$;
4514MI/^(C9)RXU:6>'I8\4!R,IZV8,5_LH46RA[\X:8L*P@/Z&5$$QV=1UWY7BN9
4515M7%DAO+#CQPX+5AYPZ\WD<"LMY[!LXD+R+[)AZU%O675!PK&+,N7S72[7LQIU
4516M?N^PKY1L,*A'#:E=M:3C;P3WQM]6N0@*#SS]TS4I]6Q^6UH8S,)_MG3\#8VA
4517MD_\M7W]SPF7NG@-GW>;(,8,BI6'=<&44<Y;NEQ5?_> RAVLM7ZN@C,H<UWER
4518M[*'SDC/G/1^H^U))"2D8E&&<5+!CSX^R/_XGN7@Y56[?OF/DQ">E?'@1B7RY
4519MM$=%&WQNVW52CIV\I&1%P1E2($C5$;6KA4K0$[G=TO $7BO9&0@+99TZ<]5E
4520M+"75NS"8,V<.J?=R&:V2;]Y,]Y@.$6%(WU?D\K4;LO6[DR[CBU?'*8,8^\DW
4521MMC0VQAQ3/R LM%D&)2]>%2>S#2/2%I*&X4R>_9UT^/,+TJ=S5;4GE[VDW9;I
4522M\_?(\B\/R:W;KH=17*?P?*=;=6E>OYS[#;M!EG,R5>E934D/BH8$::]G!@JE
4523M[*+5HUV$]CKYV=<0/?RC;?+1W%V9=@HH<=[R6'E[Q)<N2F2,3F/)VGBM@DT0
4524M"4=_O%VFS=OM$Y]6>.W)T>L.R?;=]Q1QXO0555'K!%8V+,0EQ#GCPJ5?'-Z$
4525MT [\<$'.)5W7SJT1$>HMJXH'PN;EJS<R7$> )\]<\9K>@A4'M+4!D2QW0"Y#
4526M'I<S7-\=>\9H];Z7=__ZLN,:G8>N6X#7Z[^DN3@,:Y;_0Q%I\$J8U_R:\%K)
4527M>($GL/,B*Q"V+F\Z P'4KE;2[3P=BC_]E(N20;*11\UZ8,#HK]0!BQ7=6E>1
4528MJ)KW^OU2)?(K7LGSSJ#__F148_4["J2SL")ZW4%IUZ2BX@.'T*4BUNK7M9KR
4529M;.H;#HZLF&)$CC_5*J,-_9X@VULHBH51[]:3R!JELX4>1<C'_VAH>YKC#KER
4530MZN\C^IA5O8XV190YSIXP;EV!UB3R.<?OND,@%!?S_Q2T8>LQ+2_-HLJJ3_B@
4531M:',&!1H&XBNR7'A9@:4MG]G&MA7R%JU>*Z\*J*P >E0,)]W1Y94VSJ4L!R_
4532M%BVDW[?IF0G']8<Z>+D)NU.KA.,7I<KSQ3SBU1E>NT=;(_0@>%UKA'?04G@*
4533MLPKNVJJR=IRV*2L]+/E=E^,QQA+%[<_&=; KM(+RWF]S G+KQ6FF"W*N#M9(
4534M8A>Q2!>^PFLEUWRQA/*P5D:OJ</R+Q,\II4O.%#1ZM?U)6U?2>^X*_:_WK+H
4535MEA?.V+WM00/SY-)>M[9V=FT>[1"P&H055D-.N:%_<8-S>%_A<TYN;.0BG=7%
4536M'CKG4CBX9<+PK,:6W&;%\@V>&XT55,%V1ZN>])[."K,[W4N^<K]@2[JD3PUA
4537MH0749\7GBFK'+UJ*/KONHF+9(O;,NH'/2L;S["I>FGEO818?SMBQ]T?;C3MC
4538MQJ*]TF7@2FG9:YGJ9W6AGC33Q,:@K/AZQW%5;'&80N5-0:0SZGV6](2!.P,#
4539MCJIUK_W1%69@KY&63,1I"BS2&M''5V2INK93S,:8XUX]5@3AI0IIK15%>=)F
4540M 7I,CED)\SH0HB<.J>_2BN@*17I9GESQ< 1Z]/R=6KC6#IQ^<6C!*=>2-?$N
4541MXQS%FL_&JU4NKGZ<,6[F3O7HE"=X>RP*-]&]?83/[1/(DI(YP]8=>-!J^/)
4542MP<YH5GZ5D.GID"> SYECFFA?)*A=U;.#EEX=7U0MG3-6;SJL/<'"^][YRTL9
4543MKHT='.5202,O3LBV[$QTH4UJH6[)"K*D9*RK262X=FS9NH->T^/A@N[M$JK3
4544M+3M=#Q$\ 2$6;_K7E):V>:U3BTJ9/E&STOIX1$-;8[0"Y<P<T]AE/Z2Y^9.:
4545M:XW%"N[C['O8VW7<KN4.MGTRITPZ"W*V0I[HV+4&]*AF*$0PG-M:4<0I3%)!
4546M]GNCFB3^F/%X$%C#OQUO5I1ZMH"$&FU252,\NJND$>C<"<UETS?'5;@TWQ*A
4547M?^6ID/55).;^XYVZTJ'9"[+YVT253V_=OE>DY376>=%07OU7PC)]]8BH,FML
4548M4W7L&;/[E,0=OI^'"^;+:QA ,<-(RFL[CM!G\FOWGMD><QP]>O3#]/3T]V[>
4549MO*G>U?7CT4!:6IH</'A0=N[<N=[_MN9C +^2'P/XE?P8(%,ESY@Q0X8,&?+
4550M%I\W;YX,&# @V^F2BUJV;"E5JU:5UU]_7?W]6V/+EBW2I4L7]4U#9YP^?5J-
4551MQ<;&/I"U,U7RV;-GY<0)[UN7"Q<N2-^^?942G0&]GCU[RMJU:Z58L6(2'JYO
4552MP3(#W]\:.7*DK0%.G3I5 @,#9>'"A1(6%B;3IT_WBOZ$"1,4C]F)RY<O2T)"
4553M@K:XA=<*%2I(<+#^"51FV+Y]NUL#\>I1(TRN7+E2*;%Z]>K2KET[Q\MN++9C
4554MQPZ^12=7KER1LF7+2E14E!I#H?OW[Y>4E!0Y=>J4U*Y=6VK6K"E[]MQ_01YO
4555M6[UZM73OWEWFS)FCA 'S* D<.7)$5JU:)>?.G9-<N7+)]>O7I5>O7EH^$1;S
4556M"A8LJ#PG)"0DTWWA2='1T>J3>_GLTZ>/VB>\M&_?7N;.G:O6*UJTJ"Q;MDSQ
4557M@^*00X<.'21W[MRR=>M6M8\Z=>K(XL6+U?H]>O3(L#[CPX</%[H9Z"$'9TR>
4558M/%DB(R/EY,F3LGOW;K5&JU:MU!CW+5FR1.DB*"A(C??NW3M39_$X)[-Q%( G
4559MXH%XQZ1)D]08RAHX<* 4*5)$NG;MJA2 @$)#0V7#A@W*ZRI5JB2M6[=6@D'9
4560M;!SKV[AQHX/^BA4K9.S8L>IKM#$Q,3)X\& U=NW:->59* ZA 8P%Z]>A08,&
4561M*@HU;=I4^-[UH$&#U'64X!PN$1K[.GSXL**-LJ!=IDP9M2X\C1DS1ADP0$'P
4562M'!$1H80_<^9,1\1"@1@+2F)_&/?0H4,SK+=@P0*I6[>NH@U=<W^LP_X ]\V>
4563M/5LV;=JD^$4FID- &QK-FC53Z^-4&'UF4<!C3\:2"2ML"D&P"1AYZZVWE%!
4564M\^;-E:57K%A161C &KD/IKBO7+ERF>9(O)^YI4J5DFG3IBD!L!$,IV'#ADJQ
4565M6#D*,PW)"GCZ[+//E!*('G@*1HD ,9J)$R>J^TU %T%VZ]9-\<UW>A%R4E*2
4566MXAL0K1 X_+_YYIM*H'GSYE4T,6)S_P #1GGPQ3SD9BH/$"%0#H;,_C R': S
4567M?_Y\]5FO7CV)BXN3:M6J*7F6+EU:14/2UKAQXY17-V[<V%:F'BOYV+%CBC@;
4568M!811%F%1/ ?KZM^_OPH;6+WI/7CO\N7+E;<@[/CX>!DQ8H3M.I4KWWL(0"@R
4569M-\M:*(8-[=V[5RF8\.6L8#:+@C&V8<.&*0\CXG _$2A?OGPNX1%C93[WL4>,
4570MTS0FLQXQ#100<<CY)J]$)BO@V^3+#*$8HPF,U[H_NP,HG,&<QP]R $0;PC.1
4571M,S4U5>VI;=NVMO($'BN9_,*_)S!A;@YKW;QYLQ0N7%@50C"-@ID/R.%8(!Z
4572M]2+\S$*+Z3U6(/Q]^_;)IY]^JFC@=<6+NS[-00' S./,PXM&CQZM_L:3G>D3
4573MUO%2C %%DFY,13CSA->___[[TJ)%"T?1U[%CQPQSV3_&C_>C!%-&WB*GS;MI
4574M&"[1H$:-&NIOC,%NK@F/E8QUDX_P2HHJ\Q.!(B1R&L6&:?&,X6U8,=Z1/__]
4575MUX4(I=#S%!@489M0;!H/'MBI4Z<, JQ2I8JR>J(*1L!<!(#@^62N<R%&SN:'
4576M HM( YA'T><,JP(!81TCL484YL GX9,"#3Z(@*2.[ !&NW[]^@PI@$A$JK&#
4577M5THF'-)>L%'"V?CQX]480L&B\"1R#*&%0L(<8RY&P'WD/,9T'FL'# =C@C8\
4578M #X)IR8/@'I@RI0I*JR;11LADQQ)GXKW]>O73WFX"?Y/"DH(" APT"9R\+N9
4579M<DQ@-%3$A':,G%1$&F%O)LSJG#X=@Z-H<N=IG@(#PD!9P^0596-L=";L7P>?
4580M'E PUZJD^O7K*Z^R"H]#" H&BH=1HT8Y"@,4_>JKKZK\;;8%[H#"6)-"Q03"
4581MHQZ8-6N6]AZKQYG ^*A$K;QC$+1#>+(YGW7(^Z0:.]K F3XA'^5OV[;-14;9
4582M 2(BYP]KUJQQI"MX)V4L7;HT0QME?4#ATRNYSLP3+M@@E6:! @542,2*.W?N
4583M+.?/GU=A?M&B18[^E=#B3;C&0/!"6B(V1ZXC#5 IVT'G/6:Q8P75/'PW:M1(
4584MY6*3]@<??. 5;6=DMX(!<D.1;=JT49&-"C\Q,5'UZ9GUR=GVJ!'!T'80CLEM
4585M9O$#R%N,0Y^0XES8> **'L*@F5/9E)G_LPKV3NB'?WI]>/=%2>S1/ AZD""=
4586ML!9U#OSJPK35D_W/DQ]1:)\G6__ODQ^/!J@=*"SYMXN)>+%YJN17]L,/=$A;
4587MR,%37%Q<8H[HZ.A@(Q=];;AV#?*=7\D//] A!:11>2<:CEO/\3*OT?Y4,I3M
4588F^W<Q_/C=@-J*'Z,-Y/EC^O\ 2S'2(P:7,"@ 245.1*Y"8(*O
4589UUENC
4590close W;
4591}
4592
4593 if (not -r $cfg->{General}{imgcache}."/smokeping.png" or
4594 (defined $modulemodtime and $modulemodtime > (stat _)[9])){
4595open W, ">".$cfg->{General}{imgcache}."/smokeping.png"
4596 or do { warn "WARNING: creating $cfg->{General}{imgcache}/smokeping.png: $!\n"; return 0};
4597binmode W;
4598print W unpack ('u', <<'UUENC');
4599MB5!.1PT*&@H -24A$4@ '@ B" ( ;$XH4 "7!(67, [#
4600M .PP'';ZAD 0T$E$051HWNU:2XQDUUG^S[FONO?6^]'555U=W5V>GA[W
4601M>#RT;0T$$@,!(1:.!$B(#;!B$6416!*06("4!6$5@8B04((,64 DE,064BP4
4602M$A3%P=8(VSUN3_?TLUY=5;>>]]9]G@>+,UU3Z>F9\0-F9)E_U75UZM1_OO/_
4603MW__]_VWTTDLOP2? $$(8X_DGC#'.^6-S0'[2"#P.0PC%8K%X/!Z+Q1!"G'//
4604M\QS'\7W_L?GPB0!:EN54*E6I5$JE4BP6FTZGK5:KU6I%440I?4P^/&D0'H=A
4605MC%.I5*U6>_[YY[/9[.GIZ9MOOCD>CX?#X?\#_;]LDB2ET^E*I9),)B5)VMO;
4606MDR3I<7(T_NA;?(Q,(,LY?YP0"_MD 8T0>E(__<D"^@G:Q1Q]869]B'"8W^?"
4607MKW/.A=[Z0/O/UL_V?U*A>C]0#_+D J E25(4199EH? YYY120@@AA#%V_[[S
4608M6\\OP!AKFB;+,N<\BJ(P#,^Y)4F2IFFB*!%"@B!X)'4BA&;NB=\5OD51=+]O
4609M']3.G>7<<2X$2CXSP?O"$T+((X"6)"EQ9H9A2)+$&*.44DH=Q^GW^[9MS^LA
4610M15%,TS1-4X#E^[YMVZ(+4%4UF\UF,AG#,!ACCN,,!H/1:"2^CA#2=3V;S:;3
4611MZ5@LQAB;3J=B011%#SJ8JJJ)1"*93)JF&8O%Q/'",/0\S[9MV[:GT^F'EFN:
4612MIL7C<5W717@10AS'<5WW0M0D23)-,YE,)A()3=-$;@F@7=>=3":V;8=A>#'0
4613MBJ+D\_E2J;2TM)3/YSGGCN,(UQECDB0%0>#[_NPD""'#,!87%RN52CJ=]GV_
4614MV^TVF\U.IX,Q+I5*U6JU6JT6BT5"2*/1.#P\9(P-AT, ,$US:6FI6JTN+R]G
4615M,AE*:;O=/CP\/#HZLBSKPKQ))!(+"PO%8K%8+.;S^60RJ6D:8\QUW=%HU.ET
4616M.IU.M]NU+"L(@@^*LCA[N5PN% J&8411U&PV14=S/]"Q6"R7RPE/=%T7L!!"
4617M$$*JJF*,;=L6_CB.,\M1>79%V6QV;6WMRI4K5ZY<88P='!PXCC,:C02-"HC%
4618MO<WR2]?U<KG\P@LOK*VM3:?3G9T=004 L+2TM+FY^?SSS^?S>4KIX>$AQMCW
4619M_2 (**6Y7*Y2J3SWW'////.,:9J,L5:K)<NRZ[K3Z70ZG9Y#6?1U:VMKZ^OK
4620MM5HMF\W."!IC' 1!J]7:W]^_<^>.JJKM=ON#]M;Q>+Q2J5R[=FUS<],PC(.#
4621M ]=U+<NZ?V4L%BN52JNKJY<N7<ID,I9E-9O-\7@<!(&F:=ELME H5*O57"X7
4622MB\7J]?ID,A%^RK/$R>?SM5KMQHT;V6SVYLV;^_O[>WM[(@!5504 S_.B*)IG
4623M,8RQ:9KE<KE<+G/.%44)PS"*(M=U5555% 5CC#%6%*56JTTF$\_S""'C\5@4
4624M ,&SBJ( 0+5:M2RK7J^WVVW7=>?)VC",<KE\^?+EK:VMC8T-15':[;:(EUD;
4625M<O7JU6*Q:)HFQI@0TFZW+TSY^Q.%<ZYI6BZ7$Y&QOKYN6=9X/!;I?^["9%DN
4626M% IK:VO7KU]?7U\74;^WM]?M=@DAJJJ62B7#,%975\OELJJJC#%"B(B;NT"K
4627MJII,)JO5:JE4&@P&_7Z_V^V>GI[ZOB]*!,;X?ITOGH@Q&$(HE\LE$@E)DJ(H
4628M&@Z'>WM[A)!GGWVV4JEHFG;Y\N7Q>&Q9ENNZGN?U>KWM[6W?]Z]?OY[)9 1D
4629M\7A<5=5Y.2%2K5JM7KMV[>K5JP#P[KOO[NSLM%HM 70VFUU=7;UV[=K2TM+6
4630MUE88AH[C.(XS' X1P,-KJW!;D-+*RDJE4G%==WM[>W=WMUZO#X=#QMA\8"63
4631MR=F5BRP\.3EIM5JNZR*$7-=EC"42B965E:VM+820\"0(@BB*Y%EL"C0QQJ*8
4632M*HHB(E0LN+#^SIP0?XQ&H]%H)!@J#,-^OQ^&82*1R.5RAF$DD\E4*J6J*J5T
4633M,ID()SCG@G"%EE 413#/S'1=S^?S*RLKERY=4A1E?W]_>WM[9V>GV6RZKBM)
4634M4B:3<1Q'EF73-'.YW/KZ>JO5ZG8[CFW[$941YW"! A,GY9RKJBK"N5:KJ:JZ
4635MO;V]M[=7K]?[_3ZE='9 L3*52I5*I8V-C4PF<WQ\['F>YWEA&,X&L&$8"LI6
4636M%&5C8^/T]+3;[0Z'0T*(/%OA.$Z]7B^52MELME@L+B\OB_HF]B*$/%Q[$4)$
4637M$K3;[<%@P!@3*/=Z/<=Q#,,0D\DP#*?3J2 '@7*OUUM;6S--$^X3H4*<9#(9
4638M46\]SVLVF_5Z70 A_/$\3Y*D7"ZWLK*23J>+Q>)BL7@GD<)*/\Z&-M4PL'/2
4639M5MQ*,IE,)I.&82PM+:VNKI9*)<NR]O?WCX^/.YU.$ 3GG%$4)9%(+"XN%HM%
4640MP0&ZKINFJ>OZ+!R%:!&X)9/)6"P6B\4T37,<YR[0ON_W>KW=W=TP#*O5JBS+
4641MI5))4912J30<#@5A.8[C>=Z#I*4@(]NV/<_CG NN%,5-R( @"&S;GDPF@O@0
4642M0@)TS_,>I,E$'3=-,Y5*"4QG23.KR5$4B8>3R812:NAZ,I4V-/6+RV]\.K[_
4643MG>Y3?U??!(!YS$S3+)5*I5*)$&(81JU66U]?US1M,!@,A\-^O^\XSOV>*(JB
4644MZ[K0HP @A)TLR[%8;.:_)$FNZYZ<G$11)$F2$*Q"D,@SF$2R#(?#HZ.C;#8K
4645MU'2Y7&:,]?O]3J<CHG4\'E^(M>A*HBB:02 ZG=G,5VC><YDA%CRD+Q U4Y9E
4646M..M-1-^$YGY7;")VEB3,Y=B*VGLQL0\(?J-T\$IWI<?T^>A4534>-V.:9AB&
4647MKNN"T^8PO=@303B2) FB"() >#+O?! $ ME&HR$<$Y''&+NGH\,PM"QK,IF<
4648MGI[JNBX46#J=OGKU*L;X^/CXUJU; JQS\FMVX NKY;F/YS!]9"M(*0V"0.2$
4649MHB@B$V59(E&( %PA+BJJEI,UQ09(R"$1+[;"<UVE"B9]NUA>A!ILLH #@#
4650MS@# <YW!8#B93L>C$8F"3J?3:K4N7;J4S:1SF50NEQ^-QHX] 83@KGN(GUVS
4651MD*>2)(DTFK4:(K8((6$8CD:CF?^BXX-SG2%CS/=]W_<GD\EH- J"()E,KJZN
4652M"NE**>WU>MUN]YS\>I_V(;["&!.$T^_W!8_G<KE\/G_:6W [%B61!%0QTX5"
4653M8;&0RRPN8TD>CD:3D=5R\)_4/[LBM6Y-\RY5DHA'7":2SJ48 #A$ZG0MJW6R
4654M>]34M)@DR:ETNI#/+2R6:E=?Z _'WM2Y'?+(FP+"E",)@0PDBB+1OCJ.D\UF
4655MHRCR/$\0XSR;/VB\(Y][*M:)CDLTM:(-%?I/2.-Y^?5_:N+EWG X/#DY65U=
4656M+1:+RY6E^MKES>D/BJG_FA+YN_XO?"IU\J+YFG8$*O]9\MF_J%MJO=%6W,[O
4657M+=SDP&^D>__0V C ^*STPQM[W]/=R_#25XV;?__IM[[Z&6G2J*C_W'WZH&%D
4658MLP?ERLHUF5[9^7*M^RK-A#MR^A]/5GXU<UC5[2,O^8W&E2@BD\FDW6XW&HU,
4659M)B,*G:[K8E QPW V(#H'^EV@95D6PXT@",3T1PP6!(O)LNS[OF59HF?YZ..;
4660M]VFB([4LZ^3D9&=GQS#T<KET?4N)M_^ZY+=H4EME/RI[)V #* C>_C8__E%[
4661M^4]/3B>1;?UBK2XI, [4;S8O^8!6T4G>.F'N"7SW\^;KWS(-Q!6>3L.:^?J?
4662MG:0/ZIFEO7<V?_"7:OVFJF).V,\95NVIMHII6O=SMO]R\TI$R&0R;K5:[[WW
4663M7B:322:3A4(AE\L)L< Y%Q@*N(0T$*WY/: QQLED4HQXQ'R'4AJ/QX6Z7%A8
4664M"()@=W?WX.!@,!B<:Y8$Y0. &(E<&)7B^8->[\]8[,(%C+'1:%2OUS5-0P";
4665MFU=6JXN\L,"/ .&HI ZB3WU!TG3TUC>X.\"!M;C[]5;G1</U(B9)$244,T
4666MB'$,&O"P#WNOC7[E2T?U]D;KFQJ+3(4\+1_^6W?CUW?^20UN,AUCU;!7/W?<
4667M#RN#[Z?Y "(@% NWILZTW6[KNJXHRN;F9JE4JM5JG'/1&<;C<2$B$$*]7J_3
4668MZ; S P"9<RY)DF"&Q<5%H0HQQH9A+"PL% J%;K?;:#3NW+ES<'#0[7;G1S:$
4669MD.%P>/OV;='L-1J-<_1-*>WW^^^]]YYMVX/!H-/I"%DRNX,@"-KM]JU;MU*I
4670M5+/9[/?[][?.ON^?GIX"0!B&@X&ULO$SEP-?Q8 8LW_I*][6YT>C<>06-F_^
4671M,2BP1(ZB82T"D! '!!CN,B%P"@BDD'8N__8[A=]_??_UD+YQ0[D%".(X&/?[
4672MA85MT '[K+[Y!R>7O_#..V^[I[G/XZ\;:C3KRBB[J\K$;*]8+&8RF5JMELOE
4673M**6B*8O%8N/Q>#P>BXGFO:$20HA2*GC=<1Q*J2S+DB112@>#@6C\+<OJ]7J]
4674M7F\V(A'FNFZSV8RBZ/;MVY32T6@T& SFYYR.XS2;S3 ,=W9VPC \MX/XRN'A
4675MX60R$>S4[7:GT^G]<3V=3IO-IN>ZPWYOK]&/AZW+$D2*_I-3=?#*OXR'?6_D
4676MK6 ]SCT#^1+SYUL4A( 00@D%#J# CQOPSM&WVQVK)V%0 3@@A(COJ-0&#B##
4677MOQ\K5N-5Y@V/1FHSD5[7>F?>< 0HBJ)>KQ>&X60R*10*J51*"%#19XK67^!F
4678MV_;\A%T6%RX0&8U&9_KI+M91%/F^+R9JYR;WHE()[&9I+L9&\PLZG<Y,[HC=
4679M9@PC9&8419U.1SP)P]#W_0L9QO?]3K=KVV/4'G]FH0\Z*-Q[]XWOO^TM^]ZT
4680MPHZ-)1\ 0H8I1^K9&SH. ( ((7=["@R[^T?ONL0-2%3P11N#$0\)V!$6"Z:'
4681M/_F/T=,J(FDTRJ5MX/>:'7[F]G X%.,]T1D*F<\8$P,U8><&Z_+LS&+X(#3Y
4682M[%V#&&;/QD;G#D\I%9O" ^R1"T2/ ^_/**539^K:9!J?@@E X7/PJC5Z-J+L
4683M=XNW,.: X-A/#",M(8>,WX,& -C9Y=F./1@-"4<T>Z^BA%RZXZ9?R'0YA=])
4684MOQ&YDUX8^ZWB05;S@0%"9R_,SC84;SE\WQ^/Q^*E#YS5F',MS'F@9S8K37.I
4685MA^")OC_^*4/ *.., P+"<3%F__E3/^ ,$ ;@ A>[:P2CC%P"0$@D! @$/P
4686M@ '8O?#$" !($ ,4R^UUO^M?QQ-A;D).^/GOIOP# -%2^2=84\1,J*&?U\
4687MK#P(J O>@J.?MB<-[0.,@XS8R_4K>TY*H.P1^6N'S_SGL&Q*4<0E*XQ- K4?
4688MQA@@0'P2*5-?&05:R"0$' $X1'8"Q?5EFR@:I@T__J7;/__V,#\.-"^2WQGD
4689M_FI_*^08'@7 ^X3KX_R?2ACVI\GO=%^\GK PX@T_WO#BAD0XP"C2_G#G10#@
4690M #Z58YC^S<FS7T,< (F*9C)P/ZU\]0KO34$$#&L89I1 LK1WYX\DU+"8S>Q
4691M[R6O)ZR4$@('C\F$HT=.MQ]N'TN@S^0A:!+SJ/SF>(%QI&!FRA'C@BK (<K=
4692MZT < #PJSW]$ "&7 B(!@(1XQ/&*;G_YZ1\S@L9$>[FUL6I,?K-X(*YSSTV[
4693M5$G(H=C\$P3T7<(5P $WI8@!XAS- R&AV75<\!$ $'!\MCR&Z5MV_OO=RB\O
4694M--)R\,5+;P$ YP <]B>I;YU>BF'"/P+*\/$#FH.$>,.+[XXRA".;*!AQRA&_
4695MCTKY0S^>>RBRX"N'6V].%FZD.BDY!( )47:<[&O]98<H*J;\D6S]4/L?<4+#
46961JW)7%&T 245.1*Y"8(*D
4697UUENC
4698close W;
4699}
4700}
4701
4702
4703=head1 NAME
4704
4705Smokeping.pm - SmokePing Perl Module
4706
4707=head1 OVERVIEW
4708
4709Almost all SmokePing functionality sits in this Module.
4710The programs L<smokeping|smokeping> and L<smokeping.cgi|smokeping.cgi> are merely
4711figure heads allowing to hardcode some pathnames.
4712
4713If you feel like documenting what is happening within this library you are
4714most welcome todo so.
4715
4716=head1 COPYRIGHT
4717
4718Copyright (c) 2001 by Tobias Oetiker. All right reserved.
4719
4720=head1 LICENSE
4721
4722This program is free software; you can redistribute it
4723and/or modify it under the terms of the GNU General Public
4724License as published by the Free Software Foundation; either
4725version 2 of the License, or (at your option) any later
4726version.
4727
4728This program is distributed in the hope that it will be
4729useful, but WITHOUT ANY WARRANTY; without even the implied
4730warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
4731PURPOSE. See the GNU General Public License for more
4732details.
4733
4734You should have received a copy of the GNU General Public
4735License along with this program; if not, write to the Free
4736Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
473702139, USA.
4738
4739=head1 AUTHOR
4740
4741Tobias Oetiker E<lt>tobi@oetiker.chE<gt>
4742
4743Niko Tyni E<lt>ntyni@iki.fiE<gt>
4744
4745=cut
4746
4747# Emacs Configuration
4748#
4749# Local Variables:
4750# mode: cperl
4751# eval: (cperl-set-style "PerlStyle")
4752# mode: flyspell
4753# mode: flyspell-prog
4754# End:
4755#
4756# vi: sw=4