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(fmod 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; 24use Time::HiRes; 25use Data::Dumper; 26# optional dependencies 27# will be imported in case InfluxDB host is configured 28# InfluxDB::HTTP 29# InfluxDB::LineProtocol 30 31setlogsock('unix') 32 if grep /^ $^O $/xo, ("linux", "openbsd", "freebsd", "netbsd"); 33 34# make sure we do not end up with , in odd places where one would expect a '.' 35# we set the environment variable so that our 'kids' get the benefit too 36 37my $xssBadRx = qr/[<>%&'";]/; 38 39$ENV{'LC_NUMERIC'}='C'; 40if (setlocale(LC_NUMERIC,"") ne "C") { 41 if ($ENV{'LC_ALL'} eq 'C') { 42 # This has got to be a bug in perl/mod_perl, apache or libc 43 die("Your internationalization implementation on your operating system is " 44 . "not responding to your setup of LC_ALL to \"C\" as LC_NUMERIC is " 45 . "coming up as \"" . setlocale(LC_NUMERIC, "") . "\" leaving " 46 . "smokeping unable to compare numbers..."); 47 } 48 elsif ($ENV{'LC_ALL'} ne "") { 49 # This error is most likely setup related and easy to fix with proper 50 # setup of the operating system or multilanguage locale setup. Hint, 51 # setting LANG is better than setting LC_ALL... 52 die("Resetting LC_NUMERIC failed probably because your international " 53 . "setup of the LC_ALL to \"". $ENV{'LC_ALL'} . "\" is overriding " 54 . "LC_NUMERIC. Setting LC_ALL is not compatible with smokeping..."); 55 } 56 else { 57 # This is pretty nasty to figure out. Seems there are still lots 58 # of bugs in LOCALE behavior and if you get this error, you are 59 # affected by it. The worst is when "setlocale" is reading the 60 # environment variables of your webserver and not reading the PERL 61 # %ENV array like it should. 62 die("Something is wrong with the internationalization setup of your " 63 . "operating system, webserver, or the perl plugin to your webserver " 64 . "(like mod_perl) and smokeping can not compare numbers correctly. " 65 . "On unix, check your /etc/locale.gen and run sudo locale-gen, set " 66 . "LC_NUMERIC in your perl plugin config or even your webserver " 67 . "startup script to potentially fix or work around the problem..."); 68 } 69} 70 71 72use File::Basename; 73use Smokeping::Examples; 74use Smokeping::RRDtools; 75 76# global persistent variables for speedy 77use vars qw($cfg $probes $VERSION $havegetaddrinfo $cgimode); 78 79$VERSION="2.006000"; 80 81# we want opts everywhere 82my %opt; 83 84BEGIN { 85 $havegetaddrinfo = 0; 86 eval 'use Socket6'; 87 $havegetaddrinfo = 1 unless $@; 88} 89 90my $DEFAULTPRIORITY = 'info'; # default syslog priority 91 92my $logging = 0; # keeps track of whether we have a logging method enabled 93my $influx = undef; # a handle to the InfluxDB::HTTP object (if any) 94 95sub find_libdir { 96 # find the directory where the probe and matcher modules are located 97 # by looking for 'Smokeping/probes/FPing.pm' in @INC 98 # 99 # yes, this is ugly. Suggestions welcome. 100 for (@INC) { 101 -f "$_/Smokeping/probes/FPing.pm" or next; 102 return $_; 103 } 104 return undef; 105} 106 107sub do_log(@); 108sub load_probe($$$$); 109 110sub dummyCGI::param { 111 return wantarray ? () : ""; 112} 113 114sub dummyCGI::script_name { 115 return "sorry_no_script_name_when_running_offline"; 116} 117 118sub load_probes ($){ 119 my $cfg = shift; 120 my %prbs; 121 foreach my $probe (keys %{$cfg->{Probes}}) { 122 my @subprobes = grep { ref $cfg->{Probes}{$probe}{$_} eq 'HASH' } keys %{$cfg->{Probes}{$probe}}; 123 if (@subprobes) { 124 my $modname = $probe; 125 for my $subprobe (@subprobes) { 126 $prbs{$subprobe} = load_probe($modname, $cfg->{Probes}{$probe}{$subprobe},$cfg, $subprobe); 127 } 128 } else { 129 $prbs{$probe} = load_probe($probe, $cfg->{Probes}{$probe},$cfg, $probe); 130 } 131 } 132 return \%prbs; 133}; 134 135sub load_probe ($$$$) { 136 my $modname = shift; 137 my $properties = shift; 138 my $cfg = shift; 139 my $name = shift; 140 $name = $modname unless defined $name; 141 # just in case, make sure we have the module loaded. unless 142 # we are running as slave, this will already be the case 143 # after reading the config file 144 eval 'require Smokeping::probes::'.$modname; 145 die "$@\n" if $@; 146 my $rv; 147 eval '$rv = Smokeping::probes::'.$modname.'->new( $properties,$cfg,$name);'; 148 die "$@\n" if $@; 149 die "Failed to load Probe $name (module $modname)\n" unless defined $rv; 150 return $rv; 151} 152 153sub snmpget_ident ($) { 154 my $host = shift; 155 $SNMP_Session::suppress_warnings = 10; # be silent 156 my @get = snmpget("${host}::1:1:1", qw(sysContact sysName sysLocation)); 157 return undef unless @get; 158 my $answer = join "/", grep { defined } @get; 159 $answer =~ s/\s+//g; 160 return $answer; 161} 162 163sub cgiurl { 164 my ($q, $cfg) = @_; 165 my %url_of = ( 166 absolute => $cfg->{General}{cgiurl}, 167 relative => q{}, 168 original => $q->script_name, 169 ); 170 my $linkstyle = $cfg->{General}->{linkstyle}; 171 die('unknown value for $cfg->{General}->{linkstyle}: ' 172 . $linkstyle 173 ) unless exists $url_of{$linkstyle}; 174 return $url_of{$linkstyle}; 175} 176 177sub hierarchy ($){ 178 my $q = shift; 179 my $hierarchy = ''; 180 my $h = $q->param('hierarchy'); 181 if ($q->param('hierarchy')){ 182 $h =~ s/$xssBadRx/_/g; 183 $hierarchy = 'hierarchy='.$h.';'; 184 }; 185 return $hierarchy; 186} 187sub lnk ($$) { 188 my ($q, $path) = @_; 189 if ($q->isa('dummyCGI')) { 190 return $path . ".html"; 191 } else { 192 return cgiurl($q, $cfg) . "?".hierarchy($q)."target=" . $path; 193 } 194} 195 196sub dyndir ($) { 197 my $cfg = shift; 198 return $cfg->{General}{dyndir} || $cfg->{General}{datadir}; 199} 200 201sub make_cgi_directories { 202 my $targets = shift; 203 my $dir = shift; 204 my $perms = shift; 205 while (my ($k, $v) = each %$targets) { 206 next if ref $v ne "HASH"; 207 if ( ! -d "$dir/$k" ) { 208 my $saved = umask 0; 209 mkdir "$dir/$k", oct($perms); 210 umask $saved; 211 } 212 make_cgi_directories($targets->{$k}, "$dir/$k", $perms); 213 } 214} 215 216sub update_dynaddr ($$){ 217 my $cfg = shift; 218 my $q = shift; 219 my @target = split /\./, $q->param('target'); 220 my $secret = md5_base64($q->param('secret')); 221 my $address = $ENV{REMOTE_ADDR}; 222 my $targetptr = $cfg->{Targets}; 223 foreach my $step (@target){ 224 $step =~ s/$xssBadRx/_/g; 225 return "Error: Unknown target $step" 226 unless defined $targetptr->{$step}; 227 $targetptr = $targetptr->{$step}; 228 }; 229 return "Error: Invalid target or secret" 230 unless defined $targetptr->{host} and 231 $targetptr->{host} eq "DYNAMIC/${secret}"; 232 my $file = dyndir($cfg); 233 for (0..$#target-1) { 234 $file .= "/" . $target[$_]; 235 ( -d $file ) || mkdir $file, 0755; 236 } 237 $file.= "/" . $target[-1]; 238 my $prevaddress = "?"; 239 my $snmp = snmpget_ident $address; 240 if (-r "$file.adr" and not -z "$file.adr"){ 241 open(D, "<$file.adr") 242 or return "Error opening $file.adr: $!\n"; 243 chomp($prevaddress = <D>); 244 close D; 245 } 246 247 if ( $prevaddress ne $address){ 248 open(D, ">$file.adr.new") 249 or return "Error writing $file.adr.new: $!"; 250 print D $address,"\n"; 251 close D; 252 rename "$file.adr.new","$file.adr"; 253 } 254 if ( $snmp ) { 255 open (D, ">$file.snmp.new") 256 or return "Error writing $file.snmp.new: $!"; 257 print D $snmp,"\n"; 258 close D; 259 rename "$file.snmp.new", "$file.snmp"; 260 } elsif ( -f "$file.snmp") { unlink "$file.snmp" }; 261 262} 263sub sendmail ($$$){ 264 my $from = shift; 265 my $to = shift; 266 $to = $1 if $to =~ /<(.*?)>/; 267 my $body = shift; 268 if ($cfg->{General}{mailhost} and 269 my $smtp = Net::SMTP->new([split /\s*,\s*/, $cfg->{General}{mailhost}],Timeout=>5) ){ 270 $smtp->auth($cfg->{General}{mailuser}, $cfg->{General}{mailpass}) 271 if ($cfg->{General}{mailuser} and $cfg->{General}{mailpass}); 272 $smtp->mail($from); 273 $smtp->to(split(/\s*,\s*/, $to)); 274 $smtp->data(); 275 $smtp->datasend($body); 276 $smtp->dataend(); 277 $smtp->quit; 278 } elsif ($cfg->{General}{sendmail} or -x "/usr/lib/sendmail"){ 279 open (M, "|-") || exec (($cfg->{General}{sendmail} || "/usr/lib/sendmail"),"-f",$from,$to); 280 print M $body; 281 close M; 282 } else { 283 warn "ERROR: not sending mail to $to, as all methods failed\n"; 284 } 285} 286 287sub sendsnpp ($$){ 288 my $to = shift; 289 my $msg = shift; 290 if ($cfg->{General}{snpphost} and 291 my $snpp = Net::SNPP->new($cfg->{General}{snpphost}, Timeout => 60)){ 292 $snpp->send( Pager => $to, 293 Message => $msg) || do_debuglog("ERROR - ". $snpp->message); 294 $snpp->quit; 295 } else { 296 warn "ERROR: not sending page to $to, as all SNPP setup failed\n"; 297 } 298} 299 300sub min ($$) { 301 my ($a, $b) = @_; 302 return $a < $b ? $a : $b; 303} 304 305sub max ($$) { 306 my ($a, $b) = @_; 307 return $a < $b ? $b : $a; 308} 309 310sub display_range ($$) { 311 # Turn inputs into range, i.e. (10,19) is turned into "10-19" 312 my $lower = shift; 313 my $upper = shift; 314 my $ret; 315 316 # Only return actual range when there is a difference, otherwise return just lower bound 317 if ($upper < $lower) { 318 # Edgecase: Happens when $pings is less than 6 since there is no minimum value imposed on it 319 $ret = $upper; 320 } elsif ($upper > $lower) { 321 $ret = "$lower-$upper"; 322 } else { 323 $ret = $lower; 324 } 325 return $ret; 326} 327 328sub init_alerts ($){ 329 my $cfg = shift; 330 foreach my $al (keys %{$cfg->{Alerts}}) { 331 my $x = $cfg->{Alerts}{$al}; 332 next unless ref $x eq 'HASH'; 333 if ($x->{type} eq 'matcher'){ 334 $x->{pattern} =~ /(\S+)\((.+)\)/ 335 or die "ERROR: Alert $al pattern entry '$_' is invalid\n"; 336 my $matcher = $1; 337 my $arg = $2; 338 die "ERROR: matcher $matcher: all matchers start with a capital letter since version 2.0\n" 339 unless $matcher =~ /^[A-Z]/; 340 eval 'require Smokeping::matchers::'.$matcher; 341 die "Matcher '$matcher' could not be loaded: $@\n" if $@; 342 my $hand; 343 eval "\$hand = Smokeping::matchers::$matcher->new($arg)"; 344 die "ERROR: Matcher '$matcher' could not be instantiated\nwith arguments $arg:\n$@\n" if $@; 345 $x->{minlength} = $hand->Length; 346 $x->{maxlength} = $x->{minlength}; 347 $x->{sub} = sub { $hand->Test(shift) } ; 348 } else { 349 my $sub_front = <<SUB; 350sub { 351 my \$d = shift; 352 my \$y = \$d->{$x->{type}}; 353 for(1){ 354SUB 355 my $sub; 356 my $sub_back = " return 1;\n }\n return 0;\n}\n"; 357 my @ops = split /\s*,\s*/, $x->{pattern}; 358 $x->{minlength} = scalar grep /^[!=><]/, @ops; 359 $x->{maxlength} = $x->{minlength}; 360 my $multis = scalar grep /^[*]/, @ops; 361 my $it = ""; 362 for(1..$multis){ 363 my $ind = " " x ($_-1); 364 my $extra = ""; 365 for (1..$_-1) { 366 $extra .= "-\$i$_"; 367 } 368 $sub .= <<FOR; 369$ind my \$i$_; 370$ind for(\$i$_=0; \$i$_ < min(\$maxlength$extra,\$imax$_); \$i$_++){ 371FOR 372 }; 373 my $i = - $x->{maxlength}; 374 my $incr = 0; 375 for (@ops) { 376 my $extra = ""; 377 $it = " " x $multis; 378 for(1..$multis){ 379 $extra .= "-\$i$_"; 380 }; 381 /^(==|!=|<|>|<=|>=|\*)(\d+(?:\.\d*)?|U|S|\d*\*)(%?)(?:(<|>|<=|>=)(\d+(?:\.\d*)?)(%?))?$/ 382 or die "ERROR: Alert $al pattern entry '$_' is invalid\n"; 383 my $op = $1; 384 my $value = $2; 385 my $perc = $3; 386 my $op2 = $4; 387 my $value2 = $5; 388 my $perc2 = $6; 389 if ($op eq '*') { 390 if ($value =~ /^([1-9]\d*)\*$/) { 391 $value = $1; 392 $x->{maxlength} += $value; 393 $sub_front .= " my \$imax$multis = min(\@\$y - $x->{minlength}, $value);\n"; 394 $sub_back .= "\n"; 395 $sub .= <<FOR; 396$it last; 397$it } 398$it return 0 if \$i$multis >= min(\$maxlength$extra,\$imax$multis); 399FOR 400 401 $multis--; 402 next; 403 } else { 404 die "ERROR: multi-match operator * must be followed by Number* in Alert $al definition\n"; 405 } 406 } elsif ($value eq 'U') { 407 if ($op eq '==') { 408 $sub .= "$it next if defined \$y->[$i$extra];\n"; 409 } elsif ($op eq '!=') { 410 $sub .= "$it next unless defined \$y->[$i$extra];\n"; 411 } else { 412 die "ERROR: invalid operator $op in connection U in Alert $al definition\n"; 413 } 414 } elsif ($value eq 'S') { 415 if ($op eq '==') { 416 $sub .= "$it next unless defined \$y->[$i$extra] and \$y->[$i$extra] eq 'S';\n"; 417 } else { 418 die "ERROR: S is only valid with == operator in Alert $al definition\n"; 419 } 420 } elsif ($value eq '*') { 421 if ($op ne '==') { 422 die "ERROR: operator $op makes no sense with * in Alert $al definition\n"; 423 } # do nothing else ... 424 } else { 425 if ( $x->{type} eq 'loss') { 426 die "ERROR: loss should be specified in % (alert $al pattern)\n" unless $perc eq "%"; 427 } elsif ( $x->{type} eq 'rtt' ) { 428 $value /= 1000; 429 } else { 430 die "ERROR: unknown alert type $x->{type}\n"; 431 } 432 $sub .= <<IF; 433$it next unless defined \$y->[$i$extra] 434$it and \$y->[$i$extra] =~ /^\\d/ 435$it and \$y->[$i$extra] $op $value 436IF 437 if ($op2){ 438 if ( $x->{type} eq 'loss') { 439 die "ERROR: loss should be specified in % (alert $al pattern)\n" unless $perc2 eq "%"; 440 } elsif ( $x->{type} eq 'rtt' ) { 441 $value2 /= 1000; 442 } 443 $sub .= <<IF; 444$it and \$y->[$i$extra] $op2 $value2 445IF 446 } 447 $sub .= "$it ;"; 448 } 449 $i++; 450 } 451 $sub_front .= "$it my \$minlength = $x->{minlength};\n"; 452 $sub_front .= "$it my \$maxlength = $x->{maxlength};\n"; 453 $sub_front .= "$it next if scalar \@\$y < \$minlength ;\n"; 454 do_debuglog(<<COMP); 455### Compiling alert detector pattern '$al' 456### $x->{pattern} 457$sub_front$sub$sub_back 458COMP 459 $x->{sub} = eval ( $sub_front.$sub.$sub_back ); 460 die "ERROR: compiling alert pattern $al ($x->{pattern}): $@\n" if $@; 461 } 462 } 463} 464 465 466sub check_filter ($$) { 467 my $cfg = shift; 468 my $name = shift; 469 # remove the path prefix when filtering and make sure the path again starts with / 470 my $prefix = $cfg->{General}{datadir}; 471 $name =~ s|^${prefix}/*|/|; 472 # if there is a filter do neither schedule these nor make rrds 473 if ($opt{filter} && scalar @{$opt{filter}}){ 474 my $ok = 0; 475 for (@{$opt{filter}}){ 476 /^\!(.+)$/ && do { 477 my $rx = $1; 478 $name !~ /^$rx/ && do{ $ok = 1}; 479 next; 480 }; 481 /^(.+)$/ && do { 482 my $rx = $1; 483 $name =~ /^$rx/ && do {$ok = 1}; 484 next; 485 }; 486 } 487 return $ok; 488 }; 489 return 1; 490} 491 492sub add_targets ($$$$); 493sub add_targets ($$$$){ 494 my $cfg = shift; 495 my $probes = shift; 496 my $tree = shift; 497 my $name = shift; 498 die "Error: Invalid Probe: $tree->{probe}" unless defined $probes->{$tree->{probe}}; 499 my $probeobj = $probes->{$tree->{probe}}; 500 foreach my $prop (keys %{$tree}) { 501 if (ref $tree->{$prop} eq 'HASH'){ 502 add_targets $cfg, $probes, $tree->{$prop}, "$name/$prop"; 503 } 504 if ($prop eq 'host' and ( check_filter($cfg,$name) and $tree->{$prop} !~ m|^/| )) { 505 if($tree->{host} =~ /^DYNAMIC/) { 506 $probeobj->add($tree,$name); 507 } else { 508 $probeobj->add($tree,$tree->{host}); 509 } 510 } 511 } 512} 513 514 515sub init_target_tree ($$$$); # predeclare recursive subs 516sub init_target_tree ($$$$) { 517 my $cfg = shift; 518 my $probes = shift; 519 my $tree = shift; 520 my $name = shift; 521 my $hierarchies = $cfg->{__hierarchies}; 522 die "Error: Invalid Probe: $tree->{probe}" unless defined $probes->{$tree->{probe}}; 523 my $probeobj = $probes->{$tree->{probe}}; 524 525 if ($tree->{alerts}){ 526 die "ERROR: no Alerts section\n" 527 unless exists $cfg->{Alerts}; 528 $tree->{alerts} = [ split(/\s*,\s*/, $tree->{alerts}) ] unless ref $tree->{alerts} eq 'ARRAY'; 529 $tree->{fetchlength} = 0; 530 foreach my $al (@{$tree->{alerts}}) { 531 die "ERROR: alert $al ($name) is not defined\n" 532 unless defined $cfg->{Alerts}{$al}; 533 $tree->{fetchlength} = $cfg->{Alerts}{$al}{maxlength} 534 if $tree->{fetchlength} < $cfg->{Alerts}{$al}{maxlength}; 535 } 536 }; 537 # fill in menu and title if missing 538 $tree->{menu} ||= $tree->{host} || "unknown"; 539 $tree->{title} ||= $tree->{host} || "unknown"; 540 my $real_path = $name; 541 my $dataroot = $cfg->{General}{datadir}; 542 $real_path =~ s/^$dataroot\/*//; 543 my @real_path = split /\//, $real_path; 544 545 foreach my $prop (keys %{$tree}) { 546 if (ref $tree->{$prop} eq 'HASH'){ 547 if (not -d $name and not $cgimode) { 548 mkdir $name, 0755 or die "ERROR: mkdir $name: $!\n"; 549 }; 550 551 if (defined $tree->{$prop}{parents}){ 552 for my $parent (split /\s/, $tree->{$prop}{parents}){ 553 my($hierarchy,$path)=split /:/,$parent,2; 554 die "ERROR: unknown hierarchy $hierarchy in $name. Make sure it is listed in Presentation->hierarchies.\n" 555 unless $cfg->{Presentation}{hierarchies} and $cfg->{Presentation}{hierarchies}{$hierarchy}; 556 my @path = split /\/+/, $path; 557 shift @path; # drop empty root element; 558 if ( not exists $hierarchies->{$hierarchy} ){ 559 $hierarchies->{$hierarchy} = {}; 560 }; 561 my $point = $hierarchies->{$hierarchy}; 562 for my $item (@path){ 563 if (not exists $point->{$item}){ 564 $point->{$item} = {}; 565 } 566 $point = $point->{$item}; 567 }; 568 $point->{$prop}{__tree_link} = $tree->{$prop}; 569 $point->{$prop}{__real_path} = [ @real_path,$prop ]; 570 } 571 } 572 init_target_tree $cfg, $probes, $tree->{$prop}, "$name/$prop"; 573 } 574 if ($prop eq 'host' and check_filter($cfg,$name) and $tree->{$prop} !~ m|^/|) { 575 # print "init $name\n"; 576 my $step = $probeobj->step(); 577 # we have to do the add before calling the _pings method, it won't work otherwise 578 my $pings = $probeobj->_pings($tree); 579 my @slaves = (""); 580 581 if ($tree->{slaves}){ 582 push @slaves, split /\s+/, $tree->{slaves}; 583 }; 584 for my $slave (@slaves){ 585 die "ERROR: slave '$slave' is not defined in the '*** Slaves ***' section!\n" 586 unless $slave eq '' or defined $cfg->{Slaves}{$slave}; 587 my $s = $slave ? "~".$slave : ""; 588 my @create = 589 ($name.$s.".rrd", "--start",(time-1),"--step",$step, 590 "DS:uptime:GAUGE:".(2*$step).":0:U", 591 "DS:loss:GAUGE:".(2*$step).":0:".$pings, 592 "DS:median:GAUGE:".(2*$step).":0:U", 593 (map { "DS:ping${_}:GAUGE:".(2*$step).":0:U" } 594 1..$pings), 595 (map { "RRA:".(join ":", @{$_}) } @{$cfg->{Database}{_table}} )); 596 if (not -f $name.$s.".rrd"){ 597 unless ($cgimode) { 598 do_debuglog("Calling RRDs::create(@create)"); 599 RRDs::create(@create); 600 my $ERROR = RRDs::error(); 601 do_log "RRDs::create ERROR: $ERROR\n" if $ERROR; 602 } 603 } else { 604 shift @create; # remove the filename 605 my ($fatal, $comparison) = Smokeping::RRDtools::compare($name.$s.".rrd", \@create); 606 die("Error: RRD parameter mismatch ('$comparison'). You must delete $name$s.rrd or fix the configuration parameters.\n") 607 if $fatal; 608 warn("Warning: RRD parameter mismatch('$comparison'). Continuing anyway.\n") if $comparison and not $fatal; 609 Smokeping::RRDtools::tuneds($name.$s.".rrd", \@create); 610 } 611 } 612 } 613 } 614}; 615 616sub enable_dynamic($$$$); 617sub enable_dynamic($$$$){ 618 my $cfg = shift; 619 my $cfgfile = $cfg->{__cfgfile}; 620 my $tree = shift; 621 my $path = shift; 622 my $email = ($tree->{email} || shift); 623 my $print; 624 die "ERROR: smokemail property in $cfgfile not specified\n" unless defined $cfg->{General}{smokemail}; 625 die "ERROR: cgiurl property in $cfgfile not specified\n" unless defined $cfg->{General}{cgiurl}; 626 if (defined $tree->{host} and $tree->{host} eq 'DYNAMIC' ) { 627 if ( not defined $email ) { 628 warn "WARNING: No email address defined for $path\n"; 629 } else { 630 my $usepath = $path; 631 $usepath =~ s/\.$//; 632 my $secret = int(rand 1000000); 633 my $md5 = md5_base64($secret); 634 open C, "<$cfgfile" or die "ERROR: Reading $cfgfile: $!\n"; 635 open G, ">$cfgfile.new" or die "ERROR: Writing $cfgfile.new: $!\n"; 636 my $section ; 637 my @goal = split /\./, $usepath; 638 my $indent = "+"; 639 my $done; 640 while (<C>){ 641 $done && do { print G; next }; 642 /^\s*\Q*** Targets ***\E\s*$/ && do{$section = 'match'}; 643 @goal && $section && /^\s*\Q${indent}\E\s*\Q$goal[0]\E/ && do { 644 $indent .= "+"; 645 shift @goal; 646 }; 647 (not @goal) && /^\s*host\s*=\s*DYNAMIC$/ && do { 648 print G "host = DYNAMIC/$md5\n"; 649 $done = 1; 650 next; 651 }; 652 print G; 653 } 654 close G; 655 rename "$cfgfile.new", $cfgfile; 656 close C; 657 my $body; 658 open SMOKE, $cfg->{General}{smokemail} or die "ERROR: can't read $cfg->{General}{smokemail}: $!\n"; 659 while (<SMOKE>){ 660 s/<##PATH##>/$usepath/ig; 661 s/<##SECRET##>/$secret/ig; 662 s/<##URL##>/$cfg->{General}{cgiurl}/; 663 s/<##FROM##>/$cfg->{General}{contact}/; 664 s/<##OWNER##>/$cfg->{General}{owner}/; 665 s/<##TO##>/$email/; 666 $body .= $_; 667 } 668 close SMOKE; 669 670 671 my $mail; 672 print STDERR "Sending smoke-agent for $usepath to $email ... "; 673 sendmail $cfg->{General}{contact},$email,$body; 674 print STDERR "DONE\n"; 675 } 676 } 677 foreach my $prop ( keys %{$tree}) { 678 enable_dynamic $cfg, $tree->{$prop},"$path$prop.",$email if ref $tree->{$prop} eq 'HASH'; 679 } 680}; 681 682sub get_tree($$){ 683 my $cfg = shift; 684 my $open = shift; 685 my $tree = $cfg->{Targets}; 686 for (@{$open}){ 687 $tree = $tree->{$_}; 688 } 689 return $tree; 690} 691 692sub target_menu($$$$;$); 693sub target_menu($$$$;$){ 694 my $tree = shift; 695 my $open = shift; 696 $open = [@$open]; # make a copy 697 my $path = shift; 698 my $filter = shift; 699 my $suffix = shift || ''; 700 my $print; 701 my $current = shift @{$open} || ""; 702 my @hashes; 703 foreach my $prop (sort {exists $tree->{$a}{_order} ? ($tree->{$a}{_order} <=> $tree->{$b}{_order}) : ($a cmp $b)} 704 grep { ref $tree->{$_} eq 'HASH' and not /^__/ } 705 keys %$tree) { 706 push @hashes, $prop; 707 } 708 return wantarray ? () : "" unless @hashes; 709 710 $print .= qq{<ul class="menu">\n} 711 unless $filter; 712 713 my @matches; 714 for my $key (@hashes) { 715 716 my $menu = $key; 717 my $title = $key; 718 my $hide; 719 my $host; 720 my $menuextra; 721 if ($tree->{$key}{__tree_link} and $tree->{$key}{__tree_link}{menu}){ 722 $menu = $tree->{$key}{__tree_link}{menu}; 723 $title = $tree->{$key}{__tree_link}{title}; 724 $host = $tree->{$key}{__tree_link}{host}; 725 $menuextra = $tree->{$key}{__tree_link}{menuextra}; 726 next if $tree->{$key}{__tree_link}{hide} and $tree->{$key}{__tree_link}{hide} eq 'yes'; 727 } elsif ($tree->{$key}{menu}) { 728 $menu = $tree->{$key}{menu}; 729 $title = $tree->{$key}{title}; 730 $host = $tree->{$key}{host}; 731 $menuextra = $tree->{$key}{menuextra}; 732 next if $tree->{$key}{hide} and $tree->{$key}{hide} eq 'yes'; 733 } 734 735 # no menuextra for multihost 736 if (not $host or $host =~ m|^/|){ 737 $menuextra = undef; 738 } 739 740 my $class = 'menuitem'; 741 my $menuclass = "menulink"; 742 if ($key eq $current ){ 743 if ( @$open ) { 744 $class = 'menuopen'; 745 } else { 746 $class = 'menuactive'; 747 $menuclass = "menulinkactive"; 748 } 749 }; 750 if ($filter){ 751 if (($menu and $menu =~ /$filter/i) or ($title and $title =~ /$filter/i)){ 752 push @matches, ["$path$key$suffix",$menu,$class,$menuclass]; 753 }; 754 push @matches, target_menu($tree->{$key}, $open, "$path$key.",$filter, $suffix); 755 } 756 else { 757 if ($menuextra){ 758 $menuextra =~ s/{HOST}/#$host/g; 759 $menuextra =~ s/{CLASS}/$menuclass/g; 760 $menuextra =~ s/{HASH}/#/g; 761 $menuextra =~ s/{HOSTNAME}/$host/g; 762 $menuextra = ' '.$menuextra; 763 } else { 764 $menuextra = ''; 765 } 766 767 $print .= qq{<li class="$class"><a class="$menuclass" href="$path$key$suffix">$menu</a>\n}; 768 if ($key eq $current){ 769 my $prline = target_menu $tree->{$key}, $open, "$path$key.",$filter, $suffix; 770 $print .= $prline 771 if $prline; 772 } 773 $print .= "</li>"; 774 } 775 } 776 $print .= "</ul>\n" unless $filter; 777 if ($filter){ 778 if (wantarray()){ 779 return @matches; 780 } 781 else { 782 $print .= qq{<ul class="menu">\n}; 783 for my $entry (sort {$a->[1] cmp $b->[1] } grep {ref $_ eq 'ARRAY'} @matches) { 784 my ($href,$menu,$class,$menuclass) = @{$entry}; 785 $print .= qq{<li class="$class"><a class="$menuclass" href="$href">$menu</a></li>\n}; 786 } 787 $print .= "</ul>\n"; 788 } 789 } 790 return $print; 791}; 792 793 794sub fill_template ($$;$){ 795 my $template = shift; 796 my $subst = shift; 797 my $data = shift; 798 if ($template){ 799 my $line = $/; 800 undef $/; 801 open I, $template or return undef; 802 $data = <I>; 803 close I; 804 $/ = $line; 805 } 806 foreach my $tag (keys %{$subst}) { 807 my $replace = $subst->{$tag} || ''; 808 $data =~ s/<##${tag}##>/$replace/g; 809 } 810 return $data; 811} 812 813sub exp2seconds ($) { 814 my $x = shift; 815 $x =~/(\d+)s/ && return $1; 816 $x =~/(\d+)m/ && return $1*60; 817 $x =~/(\d+)h/ && return $1*60*60; 818 $x =~/(\d+)d/ && return $1*60*60*24; 819 $x =~/(\d+)w/ && return $1*60*60*24*7; 820 $x =~/(\d+)y/ && return $1*60*60*24*365; 821 return $x; 822} 823 824sub calc_stddev { 825 my $rrd = shift; 826 my $id = shift; 827 my $pings = shift; 828 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; 829 push @G, "CDEF:pings${id}="."$pings,p${id}p1,UN,".join(",",map {"p${id}p$_,UN,+"} 2..$pings).",-"; 830 push @G, "CDEF:m${id}="."p${id}p1,".join(",",map {"p${id}p$_,+"} 2..$pings).",pings${id},/"; 831 push @G, "CDEF:sdev${id}=p${id}p1,m${id},-,DUP,*,".join(",",map {"p${id}p$_,m${id},-,DUP,*,+"} 2..$pings).",pings${id},/,SQRT"; 832 return @G; 833} 834 835sub brighten_webcolor { 836 my $web = shift; 837 my @rgb = Smokeping::Colorspace::web_to_rgb($web); 838 my @hsl = Smokeping::Colorspace::rgb_to_hsl(@rgb); 839 $hsl[2] = (1 - $hsl[2]) * (2/3) + $hsl[2]; 840 @rgb = Smokeping::Colorspace::hsl_to_rgb(@hsl); 841 return Smokeping::Colorspace::rgb_to_web(@rgb); 842} 843 844sub get_overview ($$$$){ 845 my $cfg = shift; 846 my $q = shift; 847 my $tree = shift; 848 my $open = shift; 849 850 my $page =""; 851 852 my $date = $cfg->{Presentation}{overview}{strftime} ? 853 POSIX::strftime($cfg->{Presentation}{overview}{strftime}, 854 localtime(time)) : scalar localtime(time); 855 856 if ( $RRDs::VERSION >= 1.199908 ){ 857 $date =~ s|:|\\:|g; 858 } 859 foreach my $prop (sort {exists $tree->{$a}{_order} ? ($tree->{$a}{_order} <=> $tree->{$b}{_order}) : ($a cmp $b)} 860 grep { ref $tree->{$_} eq 'HASH' and not /^__/ } 861 keys %$tree) { 862 my @slaves; 863 864 my $phys_tree = $tree->{$prop}; 865 my $phys_open = $open; 866 my $dir = ""; 867 if ($tree->{$prop}{__tree_link}){ 868 $phys_tree = $tree->{$prop}{__tree_link}; 869 $phys_open = [ @{$tree->{$prop}{__real_path}} ]; 870 pop @$phys_open; 871 } 872 873 next unless $phys_tree->{host}; 874 next if $phys_tree->{hide} and $phys_tree->{hide} eq 'yes'; 875 876 if (not $phys_tree->{nomasterpoll} or $phys_tree->{nomasterpoll} eq 'no'){ 877 @slaves = (""); 878 }; 879 880 if ($phys_tree->{host} =~ m|^/|){ # multi host syntax 881 @slaves = split /\s+/, $phys_tree->{host}; 882 } 883 elsif ($phys_tree->{slaves}){ 884 push @slaves, split /\s+/,$phys_tree->{slaves}; 885 } 886 887 next if 0 == @slaves; 888 889 for (@$phys_open) { 890 $dir .= "/$_"; 891 mkdir $cfg->{General}{imgcache}.$dir, 0755 892 unless -d $cfg->{General}{imgcache}.$dir; 893 die "ERROR: creating $cfg->{General}{imgcache}$dir: $!\n" 894 unless -d $cfg->{General}{imgcache}.$dir; 895 } 896 897 my @G; #Graph 'script' 898 my $max = $cfg->{Presentation}{overview}{max_rtt} || "100000"; 899 my $probe = $probes->{$phys_tree->{probe}}; 900 my $pings = $probe->_pings($phys_tree); 901 my $i = 0; 902 my @colors = split /\s+/, $cfg->{Presentation}{multihost}{colors}; 903 my $ProbeUnit = $probe->ProbeUnit(); 904 my $ProbeDesc = $probe->ProbeDesc(); 905 for my $slave (@slaves){ 906 $i++; 907 my $rrd; 908 my $medc; 909 my $label; 910 if ($slave =~ m|^/|){ # multihost entry 911 $rrd = $cfg->{General}{datadir}.'/'.$slave.".rrd"; 912 $medc = shift @colors; 913 my @tree_path = split /\//,$slave; 914 shift @tree_path; 915 my ($host,$real_slave) = split /~/, $tree_path[-1]; #/ 916 $tree_path[-1]= $host; 917 my $tree = get_tree($cfg,\@tree_path); 918 # not all multihost entries must have the same number of pings 919 $probe = $probes->{$tree->{probe}}; 920 $pings = $probe->_pings($tree); 921 $label = $tree->{menu}; 922 923 # if there are multiple probes ... lets say so ... 924 my $XProbeDesc = $probe->ProbeDesc(); 925 if (not $ProbeDesc or $ProbeDesc eq $XProbeDesc){ 926 $ProbeDesc = $XProbeDesc; 927 } 928 else { 929 $ProbeDesc = "various probes"; 930 } 931 my $XProbeUnit = $probe->ProbeUnit(); 932 if (not $ProbeUnit or $ProbeUnit eq $XProbeUnit){ 933 $ProbeUnit = $XProbeUnit; 934 } 935 else { 936 $ProbeUnit = "various units"; 937 } 938 939 if ($real_slave){ 940 $label .= "<". $cfg->{Slaves}{$real_slave}{display_name}; 941 } 942 $label = sprintf("%-20s",$label); 943 push @colors, $medc; 944 } 945 else { 946 my $s = $slave ? "~".$slave : ""; 947 $rrd = $cfg->{General}{datadir}.$dir.'/'.$prop.$s.'.rrd'; 948 $medc = $slave ? $cfg->{Slaves}{$slave}{color} : ($cfg->{Presentation}{overview}{median_color} || shift @colors); 949 if ($#slaves > 0){ 950 $label = sprintf("%-25s","median RTT from ".($slave ? $cfg->{Slaves}{$slave}{display_name} : $cfg->{General}{display_name} || hostname)); 951 } 952 else { 953 $label = "med RTT" 954 } 955 }; 956 $label =~ s/:/\\:/g; 957 958 my $sdc = $medc; 959 $sdc =~ s/^(......).*/${1}30/; 960 push @G, 961 "DEF:median$i=${rrd}:median:AVERAGE", 962 "DEF:loss$i=${rrd}:loss:AVERAGE", 963 "CDEF:ploss$i=loss$i,$pings,/,100,*", 964 "CDEF:dm$i=median$i,0,$max,LIMIT", 965 calc_stddev($rrd,$i,$pings), 966 "CDEF:dmlow$i=dm$i,sdev$i,2,/,-", 967 "CDEF:s2d$i=sdev$i", 968# "CDEF:dm2=median,1.5,*,0,$max,LIMIT", 969# "LINE1:dm2", # this is for kicking things down a bit 970 "AREA:dmlow$i", 971 "AREA:s2d${i}#${sdc}::STACK", 972 "LINE1:dm$i#${medc}:${label}", 973 "VDEF:avmed$i=median$i,AVERAGE", 974 "VDEF:avsd$i=sdev$i,AVERAGE", 975 "CDEF:msr$i=median$i,POP,avmed$i,avsd$i,/", 976 "VDEF:avmsr$i=msr$i,AVERAGE", 977 "GPRINT:avmed$i:%5.1lf %ss av md ", 978 "GPRINT:ploss$i:AVERAGE:%5.1lf %% av ls", 979 "GPRINT:avsd$i:%5.1lf %ss av sd", 980 "GPRINT:avmsr$i:%5.1lf %s am/as\\l"; 981 982 } 983 my ($graphret,$xs,$ys) = RRDs::graph 984 ($cfg->{General}{imgcache}.$dir."/${prop}_mini.png", 985 # '--lazy', 986 '--start','-'.exp2seconds($cfg->{Presentation}{overview}{range}), 987 '--title',$cfg->{Presentation}{htmltitle} ne 'yes' ? $phys_tree->{title} : '', 988 '--height',$cfg->{Presentation}{overview}{height}, 989 '--width',$cfg->{Presentation}{overview}{width}, 990 '--vertical-label', $ProbeUnit, 991 '--imgformat','PNG', 992 Smokeping::Graphs::get_colors($cfg), 993 '--alt-autoscale-max', 994 '--alt-y-grid', 995 '--rigid', 996 '--lower-limit','0', 997 @G, 998 "COMMENT:$ProbeDesc", 999 "COMMENT:$date\\j"); 1000 my $ERROR = RRDs::error(); 1001 $page .= "<div class=\"panel\">"; 1002 $page .= "<div class=\"panel-heading\"><h2>".$phys_tree->{title}."</h2></div>" 1003 if $cfg->{Presentation}{htmltitle} eq 'yes'; 1004 $page .= "<div class=\"panel-body\">"; 1005 if (defined $ERROR) { 1006 $page .= "ERROR: $ERROR<br>".join("<br>", map {"'$_'"} @G); 1007 } else { 1008 $page.="<A HREF=\"".lnk($q, (join ".", @$open, ${prop}))."\">". 1009 "<IMG ALT=\"\" WIDTH=\"$xs\" HEIGHT=\"$ys\" ". 1010 "SRC=\"".$cfg->{General}{imgurl}.$dir."/${prop}_mini.png\"></A>"; 1011 } 1012 $page .="</div></div>\n"; 1013 } 1014 return $page; 1015} 1016 1017sub findmax ($$) { 1018 my $cfg = shift; 1019 my $rrd = shift; 1020# my $pings = "ping".int($cfg->{Database}{pings}/1.1); 1021 my %maxmedian; 1022 my @maxmedian; 1023 for (@{$cfg->{Presentation}{detail}{_table}}) { 1024 my ($desc,$start) = @{$_}; 1025 $start = exp2seconds($start); 1026 my ($graphret,$xs,$ys) = RRDs::graph 1027 ("dummy", '--start', -$start, 1028 '--width',$cfg->{Presentation}{overview}{width}, 1029 '--end','-'.int($start / $cfg->{Presentation}{detail}{width}), 1030 "DEF:maxping=${rrd}:median:AVERAGE", 1031 'PRINT:maxping:MAX:%le' ); 1032 my $ERROR = RRDs::error(); 1033 do_log $ERROR if $ERROR; 1034 my $val = $graphret->[0]; 1035 $val = 0 if $val =~ /nan/i; 1036 $maxmedian{$start} = $val; 1037 push @maxmedian, $val; 1038 } 1039 my $med = (sort @maxmedian)[int(($#maxmedian) / 2 )]; 1040 my $max = 0.000001; 1041 foreach my $x ( keys %maxmedian ){ 1042 if ( not defined $cfg->{Presentation}{detail}{unison_tolerance} or ( 1043 $maxmedian{$x} <= $cfg->{Presentation}{detail}{unison_tolerance} * $med 1044 and $maxmedian{$x} >= $med / $cfg->{Presentation}{detail}{unison_tolerance}) ){ 1045 $max = $maxmedian{$x} unless $maxmedian{$x} < $max; 1046 $maxmedian{$x} = undef; 1047 }; 1048 } 1049 foreach my $x ( keys %maxmedian ){ 1050 if (defined $maxmedian{$x}) { 1051 $maxmedian{$x} *= 1.2; 1052 } else { 1053 $maxmedian{$x} = $max * 1.2; 1054 } 1055 1056 $maxmedian{$x} = $cfg->{Presentation}{detail}{max_rtt} 1057 if $cfg->{Presentation}{detail}{max_rtt} 1058 and $maxmedian{$x} > $cfg->{Presentation}{detail}{max_rtt} 1059 }; 1060 return \%maxmedian; 1061} 1062 1063sub smokecol ($) { 1064 my $count = shift; 1065 return [] unless $count > 2; 1066 my $half = $count/2; 1067 my @items; 1068 my $itop=$count; 1069 my $ibot=1; 1070 for (; $itop > $ibot; $itop--,$ibot++){ 1071 my $color = int(190/$half * ($half-$ibot))+50; 1072 push @items, "CDEF:smoke${ibot}=cp${ibot},UN,UNKN,cp${itop},cp${ibot},-,IF"; 1073 push @items, "AREA:cp${ibot}"; 1074 push @items, "STACK:smoke${ibot}#".(sprintf("%02x",$color) x 3); 1075 }; 1076 return \@items; 1077} 1078 1079sub parse_datetime($){ 1080 my $in = shift; 1081 for ($in){ 1082 $in =~ s/$xssBadRx/_/g; 1083 /^(\d+)$/ && do { my $value = $1; $value = time if $value > 2**32; return $value}; 1084 /^\s*(\d{4})-(\d{1,2})-(\d{1,2})(?:\s+(\d{1,2}):(\d{2})(?::(\d{2}))?)?\s*$/ && 1085 return POSIX::mktime($6||0,$5||0,$4||0,$3,$2-1,$1-1900,0,0,-1); 1086 /^now$/ && return time; 1087 /([ -:a-z0-9]+)/ && return $1; 1088 }; 1089 return time; 1090} 1091 1092sub get_detail ($$$$;$){ 1093 # when drawing the detail page there are three modes for doing it 1094 1095 # a) 's' classic with several static graphs on the page 1096 # b) 'n' navigator mode with one graph. below the graph one can specify the end time 1097 # and the length of the graph. 1098 # c) 'c' chart mode, one graph with a link to it's full page 1099 # d) 'a' ajax mode, generate image based on given url and dump in on stdout 1100 # 1101 my $cfg = shift; 1102 my $q = shift; 1103 my $tree = shift; 1104 my $open = shift; 1105 my $mode = shift || $q->param('displaymode') || 's'; 1106 $mode =~ s/$xssBadRx/_/g; 1107 my $phys_tree = $tree; 1108 my $phys_open = $open; 1109 if ($tree->{__tree_link}){ 1110 $phys_tree=$tree->{__tree_link}; 1111 $phys_open = $tree->{__real_path}; 1112 } 1113 1114 if ($phys_tree->{host} and $phys_tree->{host} =~ m|^/|){ 1115 return Smokeping::Graphs::get_multi_detail($cfg,$q,$tree,$open,$mode); 1116 } 1117 1118 # don't distinguish anymore ... tree is now phys_tree 1119 $tree = $phys_tree; 1120 1121 my @slaves; 1122 if (not $tree->{nomasterpoll} or $tree->{nomasterpoll} eq 'no' or $mode eq 'a' or $mode eq 'n'){ 1123 @slaves = (""); 1124 }; 1125 1126 if ($tree->{slaves} and $mode eq 's'){ 1127 push @slaves, split /\s+/,$tree->{slaves}; 1128 }; 1129 1130 return "" if not defined $tree->{host} or 0 == @slaves; 1131 1132 my $file = $mode eq 'c' ? (split(/~/, $open->[-1]))[0] : $open->[-1]; 1133 my @dirs = @{$phys_open}; 1134 pop @dirs; 1135 my $dir = ""; 1136 1137 return "<div>ERROR: ".(join ".", @dirs)." has no probe defined</div>" 1138 unless $tree->{probe}; 1139 1140 return "<div>ERROR: ".(join ".", @dirs)." $tree->{probe} is not known</div>" 1141 unless $cfg->{__probes}{$tree->{probe}}; 1142 1143 my $probe = $cfg->{__probes}{$tree->{probe}}; 1144 my $ProbeDesc = $probe->ProbeDesc(); 1145 my $ProbeUnit = $probe->ProbeUnit(); 1146 my $pings = $probe->_pings($tree); 1147 my $step = $probe->step(); 1148 my $page; 1149 1150 return "<div>ERROR: unknown displaymode $mode</div>" 1151 unless $mode =~ /^[snca]$/; 1152 1153 for (@dirs) { 1154 $dir .= "/$_"; 1155 mkdir $cfg->{General}{imgcache}.$dir, 0755 1156 unless -d $cfg->{General}{imgcache}.$dir; 1157 die "ERROR: creating $cfg->{General}{imgcache}$dir: $!\n" 1158 unless -d $cfg->{General}{imgcache}.$dir; 1159 1160 } 1161 my $base_rrd = $cfg->{General}{datadir}.$dir."/${file}"; 1162 1163 my $imgbase; 1164 my $imghref; 1165 my $max = {}; 1166 my @tasks; 1167 my %lastheight; 1168 1169 if ($mode eq 's'){ 1170 # in nav mode there is only one graph, so the height calculation 1171 # is not necessary. 1172 $imgbase = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}"; 1173 $imghref = $cfg->{General}{imgurl}."/".(join "/", @dirs)."/${file}"; 1174 @tasks = @{$cfg->{Presentation}{detail}{_table}}; 1175 for my $slave (@slaves){ 1176 my $s = $slave ? "~$slave" : ""; 1177 if (open (HG,"<${imgbase}.maxheight$s")){ 1178 while (<HG>){ 1179 chomp; 1180 my @l = split / /; 1181 $lastheight{$s}{$l[0]} = $l[1]; 1182 } 1183 close HG; 1184 } 1185 $max->{$s} = findmax $cfg, $base_rrd.$s.".rrd"; 1186 if (open (HG,">${imgbase}.maxheight$s")){ 1187 foreach my $size (keys %{$max->{$s}}){ 1188 print HG "$s $max->{$s}{$size}\n"; 1189 } 1190 close HG; 1191 } 1192 } 1193 } 1194 elsif ($mode eq 'n' or $mode eq 'a') { 1195 my $slave = (split(/~/, $open->[-1]))[1]; 1196 my $name = $slave ? " as seen from ". $cfg->{Slaves}{$slave}{display_name} : ""; 1197 mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $cfg->{General}{imgcache}."/__navcache"; 1198 # remove old images after one hour 1199 my $pattern = $cfg->{General}{imgcache}."/__navcache/*.png"; 1200 for (glob $pattern){ 1201 unlink $_ if time - (stat $_)[9] > 3600; 1202 } 1203 if ($mode eq 'n') { 1204 $imgbase =$cfg->{General}{imgcache}."/__navcache/".time()."$$"; 1205 $imghref =$cfg->{General}{imgurl}."/__navcache/".time()."$$"; 1206 } else { 1207 my $serial = int(rand(2000)); 1208 $imgbase =$cfg->{General}{imgcache}."/__navcache/".$serial; 1209 $imghref =$cfg->{General}{imgurl}."/__navcache/".$serial; 1210 } 1211 1212 $q->param('epoch_start',parse_datetime($q->param('start'))); 1213 $q->param('epoch_end',parse_datetime($q->param('end'))); 1214 my $title = $q->param('title') || ("Navigator Graph".$name); 1215 @tasks = ([$title, parse_datetime($q->param('start')),parse_datetime($q->param('end'))]); 1216 my ($graphret,$xs,$ys) = RRDs::graph 1217 ("dummy", 1218 '--start', $tasks[0][1], 1219 '--end',$tasks[0][2], 1220 "DEF:maxping=${base_rrd}.rrd:median:AVERAGE", 1221 'PRINT:maxping:MAX:%le' ); 1222 my $ERROR = RRDs::error(); 1223 return "<div>RRDtool did not understand your input: $ERROR.</div>" if $ERROR; 1224 my $val = $graphret->[0]; 1225 $val = 1 if $val =~ /nan/i; 1226 $max->{''} = { $tasks[0][1] => $val * 1.5 }; 1227 } else { 1228 # chart mode 1229 mkdir $cfg->{General}{imgcache}."/__chartscache",0755 unless -d $cfg->{General}{imgcache}."/__chartscache"; 1230 # remove old images after one hour 1231 my $pattern = $cfg->{General}{imgcache}."/__chartscache/*.png"; 1232 for (glob $pattern){ 1233 unlink $_ if time - (stat $_)[9] > 3600; 1234 } 1235 my $desc = join "/",@{$open}; 1236 @tasks = ([$desc , 3600]); 1237 $imgbase = $cfg->{General}{imgcache}."/__chartscache/".(join ".", @dirs).".${file}"; 1238 $imghref = $cfg->{General}{imgurl}."/__chartscache/".(join ".", @dirs).".${file}"; 1239 1240 my ($graphret,$xs,$ys) = RRDs::graph 1241 ("dummy", 1242 '--start', time()-3600, 1243 '--end', time(), 1244 "DEF:maxping=${base_rrd}.rrd:median:AVERAGE", 1245 'PRINT:maxping:MAX:%le' ); 1246 my $ERROR = RRDs::error(); 1247 return "<div>RRDtool did not understand your input: $ERROR.</div>" if $ERROR; 1248 my $val = $graphret->[0]; 1249 $val = 1 if $val =~ /nan/i; 1250 $max->{''} = { $tasks[0][1] => $val * 1.5 }; 1251 } 1252 1253 my $smoke = $pings >= 3 1254 ? smokecol $pings : 1255 [ 'COMMENT:(Not enough pings to draw any smoke.)\s', 'COMMENT:\s' ]; 1256 # one \s doesn't seem to be enough 1257 my @upargs; 1258 my @upsmoke; 1259 1260 my %lc; 1261 my %lcback; 1262 if ( defined $cfg->{Presentation}{detail}{loss_colors}{_table} ) { 1263 for (@{$cfg->{Presentation}{detail}{loss_colors}{_table}}) { 1264 my ($num,$col,$txt) = @{$_}; 1265 $lc{$num} = [ $txt, "#".$col ]; 1266 } 1267 } else { 1268 1269 my $p = $pings; 1270 # Return either approximate percentage or impose a minimum value 1271 my $per01 = max(int(0.01 * $p), 1); 1272 my $per05 = max(int(0.05 * $p), 2); 1273 my $per10 = max(int(0.10 * $p), 3); 1274 my $per25 = max(int(0.25 * $p), 4); 1275 my $per50 = max(int(0.50 * $p), 5); 1276 1277 %lc = (0 => ['0', '#26ff00'], 1278 $per01 => [display_range(1 , $per01), '#00b8ff'], 1279 $per05 => [display_range($per01 + 1, $per05), '#0059ff'], 1280 $per10 => [display_range($per05 + 1, $per10), '#7e00ff'], 1281 $per25 => [display_range($per10 + 1, $per25), '#ff00ff'], 1282 $per50 => [display_range($per25 + 1, $per50), '#ff5500'], 1283 $p-1 => [display_range($per50 + 1, ($p-1)), '#ff0000'], 1284 $p => ["$p/$p", '#a00000'] 1285 ); 1286 }; 1287 # determine a more 'pastel' version of the ping colours; this is 1288 # used for the optional loss background colouring 1289 foreach my $key (keys %lc) { 1290 if ($key == 0) { 1291 $lcback{$key} = ""; 1292 next; 1293 } 1294 my $web = $lc{$key}[1]; 1295 my @rgb = Smokeping::Colorspace::web_to_rgb($web); 1296 my @hsl = Smokeping::Colorspace::rgb_to_hsl(@rgb); 1297 $hsl[2] = (1 - $hsl[2]) * (2/3) + $hsl[2]; 1298 @rgb = Smokeping::Colorspace::hsl_to_rgb(@hsl); 1299 $web = Smokeping::Colorspace::rgb_to_web(@rgb); 1300 $lcback{$key} = $web; 1301 } 1302 1303 my %upt; 1304 if ( defined $cfg->{Presentation}{detail}{uptime_colors}{_table} ) { 1305 for (@{$cfg->{Presentation}{detail}{uptime_colors}{_table}}) { 1306 my ($num,$col,$txt) = @{$_}; 1307 $upt{$num} = [ $txt, "#".$col]; 1308 } 1309 } else { 1310 %upt = (3600 => ['<1h', '#FFD3D3'], 1311 2*3600 => ['<2h', '#FFE4C7'], 1312 6*3600 => ['<6h', '#FFF9BA'], 1313 12*3600 => ['<12h','#F3FFC0'], 1314 24*3600 => ['<1d', '#E1FFCC'], 1315 7*24*3600 => ['<1w', '#BBFFCB'], 1316 30*24*3600 => ['<1m', '#BAFFF5'], 1317 '1e100' => ['>1m', '#DAECFF'] 1318 ); 1319 } 1320 1321 my $BS = ''; 1322 if ( $RRDs::VERSION >= 1.199908 ){ 1323 $ProbeDesc =~ s|:|\\:|g; 1324 $BS = '\\'; 1325 } 1326 1327 for (@tasks) { 1328 my ($desc,$start,$end) = @{$_}; 1329 my %xs; 1330 my %ys; 1331 my $sigtime = ($end and $end =~ /^\d+$/) ? $end : time; 1332 my $date = $cfg->{Presentation}{detail}{strftime} ? 1333 POSIX::strftime($cfg->{Presentation}{detail}{strftime}, localtime($sigtime)) : scalar localtime($sigtime); 1334 if ( $RRDs::VERSION >= 1.199908 ){ 1335 $date =~ s|:|\\:|g; 1336 } 1337 $end ||= 'last'; 1338 $start = exp2seconds($start) if $mode =~ /[s]/; 1339 1340 my $startstr = $start =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)) : $start; 1341 my $endstr = $end =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)) : $end; 1342 1343 my $realstart = ( $mode =~ /[sc]/ ? '-'.$start : $start); 1344 1345 for my $slave (@slaves){ 1346 my $s = $slave ? "~$slave" : ""; 1347 my $swidth = $max->{$s}{$start} / $cfg->{Presentation}{detail}{height}; 1348 my $rrd = $base_rrd.$s.".rrd"; 1349 my $stddev = Smokeping::RRDhelpers::get_stddev($rrd,'median','AVERAGE',$realstart,$sigtime) || 0; 1350 my @median = ("DEF:median=${rrd}:median:AVERAGE", 1351 "CDEF:ploss=loss,$pings,/,100,*", 1352 "VDEF:avmed=median,AVERAGE", 1353 "CDEF:mesd=median,POP,avmed,$stddev,/", 1354 'GPRINT:avmed:median rtt\: %.1lf %ss avg', 1355 'GPRINT:median:MAX:%.1lf %ss max', 1356 'GPRINT:median:MIN:%.1lf %ss min', 1357 'GPRINT:median:LAST:%.1lf %ss now', 1358 sprintf('COMMENT:%.1f ms sd',$stddev*1000.0), 1359 'GPRINT:mesd:AVERAGE:%.1lf %s am/s\l', 1360 "LINE1:median#202020" 1361 ); 1362 push @median, ( "GPRINT:ploss:AVERAGE:packet loss\\: %.2lf %% avg", 1363 "GPRINT:ploss:MAX:%.2lf %% max", 1364 "GPRINT:ploss:MIN:%.2lf %% min", 1365 'GPRINT:ploss:LAST:%.2lf %% now\l', 1366 'COMMENT:loss color\:' 1367 ); 1368 my @lossargs = (); 1369 my @losssmoke = (); 1370 my $last = -1; 1371 foreach my $loss (sort {$a <=> $b} keys %lc){ 1372 next if $loss > $pings; 1373 my $lvar = $loss; $lvar =~ s/\./d/g ; 1374 push @median, 1375 ( 1376 "CDEF:me$lvar=loss,$last,GT,loss,$loss,LE,*,1,UNKN,IF,median,*", 1377 "CDEF:meL$lvar=me$lvar,$swidth,-", 1378 "CDEF:meH$lvar=me$lvar,0,*,$swidth,2,*,+", 1379 "AREA:meL$lvar", 1380 "STACK:meH$lvar$lc{$loss}[1]:$lc{$loss}[0]" 1381 # "LINE2:me$lvar$lc{$loss}[1]:$lc{$loss}[0]" 1382 ); 1383 if ($cfg->{Presentation}{detail}{loss_background} and $cfg->{Presentation}{detail}{loss_background} eq 'yes') { 1384 push @lossargs, 1385 ( 1386 "CDEF:lossbg$lvar=loss,$last,GT,loss,$loss,LE,*,INF,UNKN,IF", 1387 "AREA:lossbg$lvar$lcback{$loss}", 1388 ); 1389 push @losssmoke, 1390 ( 1391 "CDEF:lossbgs$lvar=loss,$last,GT,loss,$loss,LE,*,cp2,UNKN,IF", 1392 "AREA:lossbgs$lvar$lcback{$loss}", 1393 ); 1394 } 1395 $last = $loss; 1396 } 1397 1398 # if we have uptime draw a colorful background or the graph showing the uptime 1399 1400 my $cdir=dyndir($cfg)."/".(join "/", @dirs)."/"; 1401 if ((not defined $cfg->{Presentation}{detail}{loss_background} or $cfg->{Presentation}{detail}{loss_background} ne 'yes') && 1402 (-f "$cdir/${file}.adr")) { 1403 @upsmoke = (); 1404 @upargs = ("COMMENT:Link Up${BS}: ", 1405 "DEF:uptime=${base_rrd}.rrd:uptime:AVERAGE", 1406 "CDEF:duptime=uptime,86400,/", 1407 'GPRINT:duptime:LAST: %0.1lf days ('); 1408 my $lastup = 0; 1409 foreach my $uptime (sort {$a <=> $b} keys %upt){ 1410 push @upargs, 1411 ( 1412 "CDEF:up$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,INF,UNKN,IF", 1413 "AREA:up$uptime$upt{$uptime}[1]:$upt{$uptime}[0]" 1414 ); 1415 push @upsmoke, 1416 ( 1417 "CDEF:ups$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,cp2,UNKN,IF", 1418 "AREA:ups$uptime$upt{$uptime}[1]" 1419 ); 1420 $lastup=$uptime; 1421 } 1422 1423 push @upargs, 'COMMENT:)\l'; 1424 # map {print "$_<br/>"} @upargs; 1425 }; 1426 my @log = (); 1427 push @log, "--logarithmic" if $cfg->{Presentation}{detail}{logarithmic} and 1428 $cfg->{Presentation}{detail}{logarithmic} eq 'yes'; 1429 1430 my @lazy =(); 1431 @lazy = ('--lazy') if $mode eq 's' and $lastheight{$s} and $lastheight{$s}{$start} and $lastheight{$s}{$start} == $max->{$s}{$start}; 1432 my $timer_start = time(); 1433 my $title = ""; 1434 if ($cfg->{Presentation}{htmltitle} ne 'yes') { 1435 $title = "$desc from " . ($s ? $cfg->{Slaves}{$slave}{display_name}: $cfg->{General}{display_name} || hostname) . " to $phys_tree->{title}"; 1436 } 1437 my @task = 1438 ("${imgbase}${s}_${end}_${start}.png", 1439 @lazy, 1440 '--start',$realstart, 1441 ($end ne 'last' ? ('--end',$end) : ()), 1442 '--height',$cfg->{Presentation}{detail}{height}, 1443 '--width',$cfg->{Presentation}{detail}{width}, 1444 '--title',$title, 1445 '--rigid', 1446 '--upper-limit', $max->{$s}{$start}, 1447 @log, 1448 '--lower-limit',(@log ? ($max->{$s}{$start} > 0.01) ? '0.001' : '0.0001' : '0'), 1449 '--vertical-label',$ProbeUnit, 1450 '--imgformat','PNG', 1451 Smokeping::Graphs::get_colors($cfg), 1452 (map {"DEF:ping${_}=${rrd}:ping${_}:AVERAGE"} 1..$pings), 1453 (map {"CDEF:cp${_}=ping${_},$max->{$s}{$start},LT,ping${_},INF,IF"} 1..$pings), 1454 ("DEF:loss=${rrd}:loss:AVERAGE"), 1455 @upargs,# draw the uptime bg color 1456 @lossargs, # draw the loss bg color 1457 @$smoke, 1458 @upsmoke, # draw the rest of the uptime bg color 1459 @losssmoke, # draw the rest of the loss bg color 1460 @median,'COMMENT: \l', 1461 # Gray background for times when no data was collected, so they can 1462 # be distinguished from network being down. 1463 ( $cfg->{Presentation}{detail}{nodata_color} ? ( 1464 'CDEF:nodata=loss,UN,INF,UNKN,IF', 1465 "AREA:nodata#$cfg->{Presentation}{detail}{nodata_color}" ): 1466 ()), 1467 'HRULE:0#000000', 1468 "COMMENT:probe${BS}: $pings $ProbeDesc every ${step}s", 1469 "COMMENT:$date\\j"); 1470# do_log ("***** begin task ***** <br />"); 1471# do_log (@task); 1472# do_log ("***** end task ***** <br />"); 1473 1474 my $graphret; 1475 ($graphret,$xs{$s},$ys{$s}) = RRDs::graph @task; 1476 # die "<div>INFO:".join("<br/>",@task)."</div>"; 1477 my $ERROR = RRDs::error(); 1478 if ($ERROR) { 1479 return "<div>ERROR: $ERROR</div><div>".join("<br/>",@task)."</div>"; 1480 }; 1481 } 1482 1483 if ($mode eq 'a'){ # ajax mode 1484 open my $img, "${imgbase}_${end}_${start}.png" or die "${imgbase}_${end}_${start}.png: $!"; 1485 binmode $img; 1486 print "Content-Type: image/png\n"; 1487 my $data; 1488 read($img,$data,(stat($img))[7]); 1489 close $img; 1490 print "Content-Length: ".length($data)."\n\n"; 1491 print $data; 1492 unlink "${imgbase}_${end}_${start}.png"; 1493 return undef; 1494 } 1495 elsif ($mode eq 'n'){ # navigator mode 1496 $page .= "<div class=\"panel\">"; 1497 if ($cfg->{Presentation}{htmltitle} eq 'yes') { 1498 # TODO we generate this above to, maybe share code or store variable ? 1499 $page .= "<div class=\"panel-heading\"><h2>$desc</h2></div>"; 1500 } 1501 $page .= "<div class=\"panel-body\">"; 1502 $page .= qq|<IMG alt="" id="zoom" width="$xs{''}" height="$ys{''}" SRC="${imghref}_${end}_${start}.png">| ; 1503 $page .= $q->start_form(-method=>'POST', -id=>'range_form') 1504 . "<p>Time range: " 1505 . $q->hidden(-name=>'epoch_start',-id=>'epoch_start') 1506 . $q->hidden(-name=>'hierarchy',-id=>'hierarchy') 1507 . $q->hidden(-name=>'epoch_end',-id=>'epoch_end') 1508 . $q->hidden(-name=>'target',-id=>'target' ) 1509 . $q->hidden(-name=>'displaymode',-default=>$mode ) 1510 . $q->textfield(-name=>'start',-default=>$startstr) 1511 . " to ".$q->textfield(-name=>'end',-default=>$endstr) 1512 . " " 1513 . $q->submit(-name=>'Generate!') 1514 . "</p>" 1515 . $q->end_form(); 1516 $page .= "</div></div>\n"; 1517 } elsif ($mode eq 's') { # classic mode 1518 $startstr =~ s/\s/%20/g; 1519 $endstr =~ s/\s/%20/g; 1520 my $t = $q->param('target'); 1521 $t =~ s/$xssBadRx/_/g; 1522 for my $slave (@slaves){ 1523 my $s = $slave ? "~$slave" : ""; 1524 $page .= "<div class=\"panel\">"; 1525# $page .= (time-$timer_start)."<br/>"; 1526# $page .= join " ",map {"'$_'"} @task; 1527 if ($cfg->{Presentation}{htmltitle} eq 'yes') { 1528 # TODO we generate this above to, maybe share code or store variable ? 1529 my $title = "$desc from " . ($s ? $cfg->{Slaves}{$slave}{display_name}: $cfg->{General}{display_name} || hostname); 1530 $page .= "<div class=\"panel-heading\"><h2>$title</h2></div>"; 1531 } 1532 $page .= "<div class=\"panel-body\">"; 1533 $page .= ( qq{<a href="}.cgiurl($q,$cfg)."?".hierarchy($q).qq{displaymode=n;start=$startstr;end=now;}."target=".$t.$s.'">' 1534 . qq{<IMG ALT="" SRC="${imghref}${s}_${end}_${start}.png">}."</a>" ); #" 1535 $page .= "</div></div>\n"; 1536 } 1537 } else { # chart mode 1538 $page .= qq{<div class="panel-body">}; 1539 my $href= (split /~/, (join ".", @$open))[0]; #/ # the link is 'slave free' 1540 $page .= ( qq{<a href="}.lnk($q, $href).qq{">} 1541 . qq{<IMG ALT="" SRC="${imghref}_${end}_${start}.png">}."</a>" ); #" 1542 $page .= "</div>"; 1543 1544 } 1545 1546 } 1547 return $page; 1548} 1549 1550sub get_charts ($$$){ 1551 my $cfg = shift; 1552 my $q = shift; 1553 my $open = shift; 1554 my $cache = $cfg->{__sortercache}; 1555 1556 my $page = "<h1>$cfg->{Presentation}{charts}{title}</h1>"; 1557 return $page."<p>Waiting for initial data ...</p>" unless $cache; 1558 1559 my %charts; 1560 for my $chart ( keys %{$cfg->{Presentation}{charts}} ) { 1561 next unless ref $cfg->{Presentation}{charts}{$chart} eq 'HASH'; 1562 $charts{$chart} = $cfg->{Presentation}{charts}{$chart}{__obj}->SortTree($cache->{$chart}); 1563 } 1564 if (not defined $open->[1]){ 1565 for my $chart ( keys %charts ){ 1566 $page .= "<div class=\"panel\">"; 1567 $page .= "<div class=\"panel-heading\"><h2>$cfg->{Presentation}{charts}{$chart}{title}</h2></div>\n"; 1568 if (not defined $charts{$chart}[0]){ 1569 $page .= "<p>No targets returned by the sorter.</p>" 1570 } else { 1571 my $tree = $cfg->{Targets}; 1572 my $chartentry = $charts{$chart}[0]; 1573 for (@{$chartentry->{open}}) { 1574 my ($host,$slave) = split(/~/, $_); 1575 die "ERROR: Section '$host' does not exist.\n" 1576 unless exists $tree->{$host}; 1577 last unless ref $tree->{$host} eq 'HASH'; 1578 $tree = $tree->{$host}; 1579 } 1580 $page .= get_detail($cfg,$q,$tree,$chartentry->{open},'c'); 1581 } 1582 $page .= "</div>\n"; 1583 } 1584 } else { 1585 my $chart = $open->[1]; 1586 $page = "<h1>$cfg->{Presentation}{charts}{$chart}{title}</h1>\n"; 1587 if (not defined $charts{$chart}[0]){ 1588 $page .= "<p>No targets returned by the sorter.</p>" 1589 } else { 1590 my $rank =1; 1591 for my $chartentry (@{$charts{$chart}}){ 1592 my $tree = $cfg->{Targets}; 1593 for (@{$chartentry->{open}}) { 1594 my ($host,$slave) = split(/~/, $_); 1595 die "ERROR: Section '$_' does not exist.\n" 1596 unless exists $tree->{$host}; 1597 last unless ref $tree->{$host} eq 'HASH'; 1598 $tree = $tree->{$host}; 1599 } 1600 $page .= "<div class=\"panel\">"; 1601 $page .= "<div class=\"panel-heading\"><h2>$rank."; 1602 $page .= " ".sprintf($cfg->{Presentation}{charts}{$chart}{format},$chartentry->{value}) 1603 if ($cfg->{Presentation}{charts}{$chart}{format}); 1604 $page .= "</h2></div>"; 1605 $rank++; 1606 $page .= get_detail($cfg,$q,$tree,$chartentry->{open},'c'); 1607 $page .= "</div>\n"; 1608 } 1609 } 1610 } 1611 return $page; 1612} 1613 1614sub load_sortercache($){ 1615 my $cfg = shift; 1616 my %cache; 1617 my $found; 1618 for (glob "$cfg->{General}{datadir}/__sortercache/data*.storable"){ 1619 # kill old caches ... 1620 if ((time - (stat "$_")[9]) > $cfg->{Database}{step}*2){ 1621 unlink $_; 1622 next; 1623 } 1624 my $data = Storable::retrieve("$_"); 1625 for my $chart (keys %$data){ 1626 PATH: 1627 for my $path (keys %{$data->{$chart}}){ 1628 warn "Warning: Duplicate entry $chart/$path in sortercache\n" if defined $cache{$chart}{$path}; 1629 my $root = $cfg->{Targets}; 1630 for my $element (split /\//, $path){ 1631 if (ref $root eq 'HASH' and defined $root->{$element}){ 1632 $root = $root->{$element} 1633 } 1634 else { 1635 warn "Warning: Dropping $chart/$path from sortercache\n"; 1636 next PATH; 1637 } 1638 } 1639 $cache{$chart}{$path} = $data->{$chart}{$path} 1640 } 1641 } 1642 $found = 1; 1643 } 1644 return ( $found ? \%cache : undef ) 1645} 1646 1647sub hierarchy_switcher($$){ 1648 my $q = shift; 1649 my $cfg = shift; 1650 my $print =$q->start_form(-name=>'hswitch',-method=>'get',-action=>$cfg->{General}{cgiurl}); 1651 if ($cfg->{Presentation}{hierarchies}){ 1652 $print .= "<div class=\"hierarchy\">"; 1653 $print .= "<label for=\"hierarchy\" class=\"hierarchy-label\">Hierarchy:</label>"; 1654 $print .= "<div class=\"hierarchy-popup\">"; 1655 $print .= $q->popup_menu(-name=>'hierarchy', 1656 -onChange=>'hswitch.submit()', 1657 -id=>'hierarchy', 1658 -values=>[0, sort map {ref $cfg->{Presentation}{hierarchies}{$_} eq 'HASH' 1659 ? $_ : () } keys %{$cfg->{Presentation}{hierarchies}}], 1660 -labels=>{0=>'Default Hierarchy', 1661 map {ref $cfg->{Presentation}{hierarchies}{$_} eq 'HASH' 1662 ? ($_ => $cfg->{Presentation}{hierarchies}{$_}{title} ) 1663 : () } keys %{$cfg->{Presentation}{hierarchies}} 1664 } 1665 ); 1666 $print .= "</div></div>"; 1667 } 1668 $print .= "<div class=\"filter\">"; 1669 $print .= "<label for=\"filter\" class=\"filter-label\">Filter:</label>"; 1670 $print .= "<div class=\"filter-text\">"; 1671 $print .= $q->textfield (-name=>'filter', 1672 -id=>'filter', 1673 -placeholder=>'Filter menu...', 1674 -onChange=>'hswitch.submit()', 1675 -size=>15, 1676 ); 1677 $print .= '</div></div>'.$q->end_form(); 1678 return $print; 1679} 1680 1681sub display_webpage($$){ 1682 my $cfg = shift; 1683 my $q = shift; 1684 my $targ = ''; 1685 my $t = $q->param('target'); 1686 if ( $t and $t !~ /\.\./ and $t =~ /(\S+)/){ 1687 $targ = $1; 1688 $targ =~ s/$xssBadRx/_/g; 1689 } 1690 my ($path,$slave) = split(/~/,$targ); 1691 if ($slave and $slave =~ /(\S+)/){ 1692 die "ERROR: slave '$slave' is not defined in the '*** Slaves ***' section!\n" 1693 unless defined $cfg->{Slaves}{$slave}; 1694 $slave = $1; 1695 } 1696 my $hierarchy = $q->param('hierarchy'); 1697 $hierarchy =~ s/$xssBadRx/_/g; 1698 die "ERROR: unknown hierarchy $hierarchy\n" 1699 if $hierarchy and not $cfg->{Presentation}{hierarchies}{$hierarchy}; 1700 my $open = [ (split /\./,$path||'') ]; 1701 my $open_orig = [@$open]; 1702 $open_orig->[-1] .= '~'.$slave if $slave; 1703 1704 my($filter) = ($q->param('filter') and $q->param('filter') =~ m{([- _0-9a-zA-Z\+\*\(\)\|\^\[\]\.\$]+)}); 1705 1706 my $tree = $cfg->{Targets}; 1707 if ($hierarchy){ 1708 $tree = $cfg->{__hierarchies}{$hierarchy}; 1709 }; 1710 my $menu_root = $tree; 1711 my $targets = $cfg->{Targets}; 1712 my $step = $cfg->{__probes}{$targets->{probe}}->step(); 1713 # lets see if the charts are opened 1714 my $charts = 0; 1715 $charts = 1 if defined $cfg->{Presentation}{charts} and $open->[0] and $open->[0] eq '_charts'; 1716 if ($charts and ( not defined $cfg->{__sortercache} 1717 or $cfg->{__sortercachekeeptime} < time )){ 1718 # die "ERROR: Chart $open->[1] does not exit.\n" 1719 # unless $cfg->{Presentation}{charts}{$open->[1]}; 1720 $cfg->{__sortercache} = load_sortercache $cfg; 1721 $cfg->{__sortercachekeeptime} = time + 60; 1722 }; 1723 if (not $charts){ 1724 for (@$open) { 1725 die "ERROR: Section '$_' does not exist (display webpage)." # .(join "", map {"$_=$ENV{$_}"} keys %ENV)."\n" 1726 unless exists $tree->{$_}; 1727 last unless ref $tree->{$_} eq 'HASH'; 1728 $tree = $tree->{$_}; 1729 } 1730 } 1731 gen_imgs($cfg); # create logos in imgcache 1732 my $readversion = "?"; 1733 $VERSION =~ /(\d+)\.(\d{3})(\d{3})/ and $readversion = sprintf("%d.%d.%d",$1,$2,$3); 1734 my $menu = $targets; 1735 1736 1737 if (defined $cfg->{Presentation}{charts} and not $hierarchy){ 1738 my $order = 1; 1739 $menu_root = { %{$menu_root}, 1740 _charts => { 1741 _order => -99, 1742 menu => $cfg->{Presentation}{charts}{menu}, 1743 map { $_ => { menu => $cfg->{Presentation}{charts}{$_}{menu}, _order => $order++ } } 1744 sort 1745 grep { ref $cfg->{Presentation}{charts}{$_} eq 'HASH' } keys %{$cfg->{Presentation}{charts}} 1746 } 1747 }; 1748 } 1749 1750 my $hierarchy_arg = ''; 1751 if ($hierarchy){ 1752 $hierarchy_arg = 'hierarchy='.uri_escape($hierarchy).';'; 1753 1754 }; 1755 my $filter_arg =''; 1756 if ($filter){ 1757 $filter_arg = 'filter='.uri_escape($filter).';'; 1758 1759 }; 1760 # if we are in a hierarchy, recover the original path 1761 1762 my $display_tree = $tree->{__tree_link} ? $tree->{__tree_link} : $tree; 1763 1764 my $authuser = $ENV{REMOTE_USER} || 'Guest'; 1765 my $getdetailoutput = get_detail( $cfg,$q,$tree,$open_orig ); 1766 return if not defined $getdetailoutput; 1767 my $page = fill_template 1768 ($cfg->{Presentation}{template}, 1769 { 1770 menu => hierarchy_switcher($q,$cfg). 1771 target_menu( $menu_root, 1772 [@$open], #copy this because it gets changed 1773 cgiurl($q, $cfg) ."?${hierarchy_arg}${filter_arg}target=", 1774 $filter 1775 ), 1776 title => $charts ? "" : $display_tree->{title}, 1777 remark => $charts ? "" : ($display_tree->{remark} || ''), 1778 overview => $charts ? get_charts($cfg,$q,$open) : get_overview( $cfg,$q,$tree,$open), 1779 body => $charts ? "" : $getdetailoutput, 1780 target_ip => $charts ? "" : ($display_tree->{host} || ''), 1781 owner => $cfg->{General}{owner}, 1782 contact => $cfg->{General}{contact}, 1783 1784 author => '<A HREF="https://tobi.oetiker.ch/">Tobi Oetiker</A> and Niko Tyni', 1785 smokeping => '<A HREF="https://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'">SmokePing-'.$readversion.'</A>', 1786 1787 step => $step, 1788 rrdlogo => '<A HREF="https://oss.oetiker.ch/rrdtool/"><img alt="RRDtool" src="'.$cfg->{General}{imgurl}.'/rrdtool.png"></a>', 1789 smokelogo => '<A HREF="https://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'"><img alt="Smokeping" src="'.$cfg->{General}{imgurl}.'/smokeping.png"></a>', 1790 authuser => $authuser, 1791 } 1792 ); 1793 my $expi = $cfg->{Database}{step} > 120 ? $cfg->{Database}{step} : 120; 1794 print $q->header(-type=>'text/html', 1795 -expires=>'+'.$expi.'s', 1796 -charset=> ( $cfg->{Presentation}{charset} || 'utf-8'), 1797 -Content_length => length($page), 1798 ); 1799 print $page || "<HTML><BODY>ERROR: Reading page template".$cfg->{Presentation}{template}."</BODY></HTML>"; 1800 1801} 1802 1803# fetch all data. 1804sub run_probes($$) { 1805 my $probes = shift; 1806 my $justthisprobe = shift; 1807 if (defined $justthisprobe) { 1808 $probes->{$justthisprobe}->ping(); 1809 } else { 1810 foreach my $probe (keys %{$probes}) { 1811 $probes->{$probe}->ping(); 1812 } 1813 } 1814} 1815 1816# report probe status 1817sub report_probes($$) { 1818 my $probes = shift; 1819 my $justthisprobe = shift; 1820 if (defined $justthisprobe) { 1821 $probes->{$justthisprobe}->report(); 1822 } else { 1823 foreach my $probe (keys %{$probes}){ 1824 $probes->{$probe}->report(); 1825 } 1826 } 1827} 1828 1829sub load_sorters($){ 1830 my $subcfg = shift; 1831 foreach my $key ( keys %{$subcfg} ) { 1832 my $x = $subcfg->{$key}; 1833 next unless ref $x eq 'HASH'; 1834 $x->{sorter} =~ /(\S+)\((.+)\)/; 1835 my $sorter = $1; 1836 my $arg = $2; 1837 die "ERROR: sorter $sorter: all sorters start with a capital letter\n" 1838 unless $sorter =~ /^[A-Z]/; 1839 eval 'require Smokeping::sorters::'.$sorter; 1840 die "Sorter '$sorter' could not be loaded: $@\n" if $@; 1841 $x->{__obj} = eval "Smokeping::sorters::$sorter->new($arg)"; 1842 die "ERROR: sorter $sorter: instantiation with Smokeping::sorters::$sorter->new($arg): $@\n" 1843 if $@; 1844 } 1845} 1846 1847 1848 1849sub update_sortercache($$$$$){ 1850 my $cfg = shift; 1851 return unless $cfg->{Presentation}{charts}; 1852 my $cache = shift; 1853 my $path = shift; 1854 my $base = $cfg->{General}{datadir}; 1855 $path =~ s/^$base\/?//; 1856 my @updates = map {/U/ ? undef : 0.0+$_ } split /:/, shift; 1857 my $alert = shift; 1858 my %info; 1859 $info{uptime} = shift @updates; 1860 $info{loss} = shift @updates; 1861 $info{median} = shift @updates; 1862 $info{alert} = $alert; 1863 $info{pings} = \@updates; 1864 foreach my $chart ( keys %{$cfg->{Presentation}{charts}} ) { 1865 next unless ref $cfg->{Presentation}{charts}{$chart} eq 'HASH'; 1866 $cache->{$chart}{$path} = $cfg->{Presentation}{charts}{$chart}{__obj}->CalcValue(\%info); 1867 } 1868} 1869 1870sub save_sortercache($$$){ 1871 my $cfg = shift; 1872 my $cache = shift; 1873 my $probe = shift; 1874 return unless $cfg->{Presentation}{charts}; 1875 my $dir = $cfg->{General}{datadir}."/__sortercache"; 1876 my $ext = ''; 1877 $ext .= $probe if $probe; 1878 $ext .= join "",@{$opt{filter}} if @{$opt{filter}}; 1879 $ext =~ s/[^-_=0-9a-z]/_/gi; 1880 $ext = ".$ext" if $ext; 1881 mkdir $dir,0755 unless -d $dir; 1882 Storable::store ($cache, "$dir/new$ext"); 1883 rename "$dir/new$ext","$dir/data$ext.storable" 1884} 1885 1886sub rfc2822timedate($) { 1887 my $time = shift; 1888 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time); 1889 my @rfc2822_months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", 1890 "Aug", "Sep", "Oct", "Nov", "Dec"); 1891 my @rfc2822_wdays = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"); 1892 return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $rfc2822_wdays[$wday], 1893 $mday, $rfc2822_months[$mon], $year + 1900, $hour, $min, $sec); 1894} 1895 1896sub check_alerts { 1897 my $cfg = shift; 1898 my $tree = shift; 1899 my $pings = shift; 1900 my $name = shift; 1901 my $prop = shift; 1902 my $loss = shift; 1903 my $rtt = shift; 1904 my $slave = shift; 1905 my $gotalert; 1906 my $s = ""; 1907 if ($slave) { 1908 $s = '~'.$slave 1909 } 1910 if ( $tree->{alerts} ) { 1911 my $priority_done; 1912 $tree->{'stack'.$s} = {loss=>['S'],rtt=>['S']} unless defined $tree->{'stack'.$s}; 1913 my $x = $tree->{'stack'.$s}; 1914 $loss = undef if $loss eq 'U'; 1915 my $lossprct = $loss * 100 / $pings; 1916 $rtt = undef if $rtt eq 'U'; 1917 push @{$x->{loss}}, $lossprct; 1918 push @{$x->{rtt}}, $rtt; 1919 if (scalar @{$x->{loss}} > $tree->{fetchlength}){ 1920 shift @{$x->{loss}}; 1921 shift @{$x->{rtt}}; 1922 } 1923 for (sort { ($cfg->{Alerts}{$a}{priority}||0) 1924 <=> ($cfg->{Alerts}{$b}{priority}||0)} @{$tree->{alerts}}) { 1925 my $alert = $cfg->{Alerts}{$_}; 1926 if ( not $alert ) { 1927 do_log "WARNING: Empty alert in ".(join ",", @{$tree->{alerts}})." ($name)\n"; 1928 next; 1929 }; 1930 if ( ref $alert->{sub} ne 'CODE' ) { 1931 do_log "WARNING: Alert '$_' did not resolve to a Sub Ref. Skipping\n"; 1932 next; 1933 }; 1934 my $prevmatch = $tree->{'prevmatch'.$s}{$_} || 0; 1935 1936 # add the current state of an edge triggered alert to the 1937 # data passed into a matcher, which allows for somewhat 1938 # more intelligent alerting due to state awareness. 1939 $x->{prevmatch} = $prevmatch; 1940 my $priority = $alert->{priority}; 1941 my $match = &{$alert->{sub}}($x) || 0; # Avgratio returns undef 1942 $gotalert = $match unless $gotalert; 1943 my $edgetrigger = $alert->{edgetrigger} eq 'yes'; 1944 my $what; 1945 if ($edgetrigger and ($prevmatch ? 0 : 1 ) != ($match ? 0 : 1)) { 1946 $what = ($prevmatch == 0 ? "was raised" : "was cleared"); 1947 } 1948 if (not $edgetrigger and $match) { 1949 $what = "is active"; 1950 } 1951 if ($what and (not defined $priority or not defined $priority_done )) { 1952 $priority_done = $priority if $priority and not $priority_done; 1953 # send something 1954 my $from; 1955 my $line = "$name/$prop"; 1956 my $base = $cfg->{General}{datadir}; 1957 $line =~ s|^$base/||; 1958 $line =~ s|/host$||; 1959 $line =~ s|/|.|g; 1960 my $urlline = $cfg->{General}{cgiurl}."?target=".$line; 1961 $line .= " [from $slave]" if $slave; 1962 my $lossratio = "$loss/$pings"; 1963 my $loss = "loss: ".join ", ",map {defined $_ ? (/^\d/ ? sprintf "%.0f%%", $_ :$_):"U" } @{$x->{loss}}; 1964 my $rtt = "rtt: ".join ", ",map {defined $_ ? (/^\d/ ? sprintf "%.0fms", $_*1000 :$_):"U" } @{$x->{rtt}}; 1965 my $time = time; 1966 do_log("Alert $_ $what for $line $loss(${lossratio}) $rtt prevmatch: $prevmatch comment: $alert->{comment}"); 1967 my @stamp = localtime($time); 1968 my $stamp = localtime($time); 1969 my @to; 1970 foreach my $addr (map {$_ ? (split /\s*,\s*/,$_) : ()} $cfg->{Alerts}{to},$tree->{alertee},$alert->{to}){ 1971 next unless $addr; 1972 if ( $addr =~ /^\|(.+)/) { 1973 my $cmd = $1; 1974 # fork them in case they take a long time 1975 my $pid; 1976 unless ($pid = fork) { 1977 unless (fork) { 1978 $SIG{CHLD} = 'DEFAULT'; 1979 if ($edgetrigger) { 1980 exec $cmd,$_,$line,$loss,$rtt,$tree->{host}, (($what =~/raise/)? 1 : 0); 1981 } else { 1982 exec $cmd,$_,$line,$loss,$rtt,$tree->{host}; 1983 } 1984 die "exec failed!"; 1985 } 1986 exit 0; 1987 } 1988 waitpid($pid, 0); 1989 } 1990 elsif ( $addr =~ /^snpp:(.+)/ ) { 1991 sendsnpp $1, <<SNPPALERT; 1992$alert->{comment} 1993$_ $what on $line 1994$loss 1995$rtt 1996SNPPALERT 1997 } 1998 elsif ( $addr =~ /^xmpp:(.+)/ ) { 1999 my $xmpparg = "$1 -s '[Smokeping] Alert'"; 2000 my $xmppalert = <<XMPPALERT; 2001$stamp 2002$_ $what on $line 2003$urlline 2004 2005Pattern: $alert->{pattern} 2006 2007Data (old --> now) 2008$loss 2009$rtt 2010 2011Comment: $alert->{comment} 2012 2013************************************************** 2014 2015 2016 2017 2018 2019XMPPALERT 2020 if (-x "/usr/bin/sendxmpp"){ 2021 open (M, "|-") || exec ("/usr/bin/sendxmpp $xmpparg"); 2022 print M $xmppalert; 2023 close M; 2024 } 2025 else { 2026 warn "Command sendxmpp not found. Try 'apt-get install sendxmpp' to install it. xmpp message with arg line $xmpparg could not be sent"; 2027 } 2028 } 2029 else { 2030 push @to, $addr; 2031 } 2032 }; 2033 if (@to){ 2034 my $default_mail = <<DOC; 2035Subject: [SmokeAlert] <##ALERT##> <##WHAT##> on <##LINE##> 2036 2037<##STAMP##> 2038 2039Alert "<##ALERT##>" <##WHAT##> for <##URL##> 2040 2041Pattern 2042------- 2043<##PAT##> 2044 2045Data (old --> now) 2046------------------ 2047<##LOSS##> 2048<##RTT##> 2049 2050Comment 2051------- 2052<##COMMENT##> 2053 2054DOC 2055 2056 my $mail = fill_template($alert->{mailtemplate}, 2057 { 2058 ALERT => $_, 2059 WHAT => $what, 2060 LINE => $line, 2061 URL => $urlline, 2062 STAMP => $stamp, 2063 PAT => $alert->{pattern}, 2064 LOSS => $loss, 2065 RTT => $rtt, 2066 COMMENT => $alert->{comment} 2067 },$default_mail) || "Subject: smokeping failed to open mailtemplate '$alert->{mailtemplate}'\n\nsee subject\n"; 2068 my $rfc2822stamp = rfc2822timedate($time); 2069 my $to = join ",",@to; 2070 sendmail $cfg->{Alerts}{from},$to, <<ALERT; 2071To: $to 2072From: $cfg->{Alerts}{from} 2073Date: $rfc2822stamp 2074$mail 2075ALERT 2076 } 2077 } else { 2078 do_debuglog("Alert \"$_\": no match for target $name\n"); 2079 } 2080 if ($match == 0) { 2081 $tree->{'prevmatch'.$s}{$_} = $match; 2082 } else { 2083 $tree->{'prevmatch'.$s}{$_} += $match; 2084 } 2085 } 2086 } # end alerts 2087 return $gotalert; 2088} 2089 2090 2091sub update_rrds($$$$$$); 2092sub update_rrds($$$$$$) { 2093 my $cfg = shift; 2094 my $probes = shift; 2095 my $tree = shift; 2096 my $name = shift; 2097 my $justthisprobe = shift; # if defined, update only the targets probed by this probe 2098 my $sortercache = shift; 2099 2100 my $probe = $tree->{probe}; 2101 foreach my $prop (keys %{$tree}) { 2102 if (ref $tree->{$prop} eq 'HASH'){ 2103 update_rrds $cfg, $probes, $tree->{$prop}, $name."/$prop", $justthisprobe, $sortercache; 2104 } 2105 # if we are looking down a branch where no probe property is set there is no sense 2106 # in further exploring it 2107 next unless defined $probe; 2108 next if defined $justthisprobe and $probe ne $justthisprobe; 2109 my $probeobj = $probes->{$probe}; 2110 my $pings = $probeobj->_pings($tree); 2111 if ($prop eq 'host' and check_filter($cfg,$name) and $tree->{$prop} !~ m|^/|) { # skip multihost 2112 my @updates; 2113 if (not $tree->{nomasterpoll} or $tree->{nomasterpoll} eq 'no'){ 2114 @updates = ([ "", time, $probeobj->rrdupdate_string($tree) ]); 2115 } 2116 if ($tree->{slaves}){ 2117 my @slaves = split(/\s+/, $tree->{slaves}); 2118 foreach my $slave (@slaves) { 2119 my $lines = Smokeping::Master::get_slaveupdates($cfg, $name, $slave); 2120 push @updates, @$lines; 2121 } #foreach my $checkslave 2122 } 2123 for my $update (sort {$a->[1] <=> $b->[1]} @updates){ # make sure we put the updates in chronological order in 2124 my $s = $update->[0] ? "~".$update->[0] : ""; 2125 if ( $tree->{rawlog} ){ 2126 my $file = POSIX::strftime $tree->{rawlog},localtime($update->[1]); 2127 if (open LOG,">>$name$s.$file.csv"){ 2128 print LOG time,"\t",join("\t",split /:/,$update->[2]),"\n"; 2129 close LOG; 2130 } else { 2131 do_log "Warning: failed to open $name$s.$file for logging: $!\n"; 2132 } 2133 } 2134 my @rrdupdate = ( 2135 $name.$s.".rrd", 2136 '--template', ( 2137 join ":", "uptime", "loss", "median", 2138 map { "ping${_}" } 1..$pings 2139 ), 2140 $update->[1].":".$update->[2] 2141 ); 2142 do_debuglog("Calling RRDs::update(@rrdupdate)"); 2143 RRDs::update ( @rrdupdate ); 2144 my $ERROR = RRDs::error(); 2145 do_log "RRDs::update ERROR: $ERROR\n" if $ERROR; 2146 2147 # insert in influxdb if needed 2148 update_influxdb($name, $s, $pings, $tree, $update) if (defined $influx); 2149 2150 # check alerts 2151 my ($loss,$rtt) = (split /:/, $update->[2])[1,2]; 2152 my $gotalert = check_alerts $cfg,$tree,$pings,$name,$prop,$loss,$rtt,$update->[0]; 2153 update_sortercache $cfg,$sortercache,$name.$s,$update->[2],$gotalert; 2154 } 2155 } 2156 } 2157} 2158 2159sub update_influxdb($$$$$); 2160sub update_influxdb($$$$$) { 2161 my $name = shift; 2162 my $s = shift; 2163 my $pings = shift; 2164 my $tree = shift; 2165 my $update = shift; 2166 2167 #for a slave cut out the first tilda 2168 $s=~s/^~//; 2169 2170 my @influx_data; 2171 my %idata; 2172 my %itags; 2173 #measurements are stored in $update->[2] 2174 #do_log("DBG: update->[2]: ".Dumper(\$update->[2])); 2175 #do_log("DBG: update: ".Dumper(\$update)); 2176 #timestamp is $update->[1] in unix timestamp format 2177 my $unixtimestamp = $update->[1]; 2178 my @measurements = split(/:/, $update->[2]); 2179 my $i = 1; 2180 2181 #Note, we force all measurement data to be float (scientific notation), 2182 #because the data type is derived from the first ever data point, which might be wrong. 2183 #in case of measurements with no value (e.g. 'U'), we skip the data point so that influx 2184 #knows it's lacking a datapoint and can act accordingly 2185 2186 #first 3 data points are as follows 2187 $idata{uptime} = sprintf('%e', $measurements[0]) if($measurements[0] ne "U"); 2188 2189 #if loss is indexed, it's easily searchable, but doesn't show up in Grafana graphs 2190 #so save it both ways (loss is an integer, no need to make it float) 2191 #loss is always a number, even when all other are unreachable, so no special treatment 2192 my $loss = $measurements[1]; 2193 $itags{loss} = $loss; 2194 $idata{loss} = $loss; 2195 #calculate loss as a percentage as well 2196 my $loss_percent = int($loss/$pings*100); 2197 $itags{loss_percent} = $loss_percent; 2198 $idata{loss_percent} = $loss_percent; 2199 2200 $idata{median} = sprintf('%e', $measurements[2]) if($measurements[2] ne "U"); 2201 2202 #skip the first 3 items, since they were processed 2203 splice(@measurements, 0, 3); 2204 2205 my $min = $measurements[1]; #first value 2206 my $max = undef; 2207 2208 for (0..$pings-1){ 2209 if ($measurements[$_] ne "U"){ 2210 $idata{'ping'.(${_}+1)} = sprintf('%e', $measurements[$_]); 2211 $min = $measurements[$_] if($measurements[$_] < $min); 2212 $max = $measurements[$_] if($measurements[$_] > $max); 2213 } 2214 } 2215 if ($min ne 'U'){ 2216 $idata{min} = sprintf('%e', $min); 2217 } 2218 if (defined $max && $max ne 'U' ){ 2219 $idata{"max"} = sprintf('%e', $max); 2220 } 2221 2222 2223 $itags{host} = $tree->{host}; 2224 $itags{title} = $tree->{title}; 2225 # remove datadir as a prefix 2226 $itags{path} = $name; 2227 $itags{path} =~ s/$cfg->{General}{datadir}//; 2228 if ($s ne ""){ 2229 #this is a slave 2230 $itags{slave} = $s; 2231 } 2232 else{ 2233 #to improve filtering in grafana, mark the master 2234 $itags{slave} = "master"; 2235 } 2236 2237 #send also probe configuration parameters that are prefixed with influx_. 2238 for my $parameter (sort keys %$tree){ 2239 if($parameter=~/^influx_(.+)/){ 2240 my $tag = "tag_".$1; 2241 #only non-empty parameters get sent 2242 if($tree->{$parameter} ne ""){ 2243 #tags will be in the form "tag_location", based on what the user supplied 2244 $itags{$tag} = $tree->{$parameter}; 2245 } 2246 } 2247 } 2248 2249 #for some reason, InfluxDB::HTTP has a bug and stores 0.000000e+00 as a string, not a float. 2250 #this will cause measurement loss in InfluxDB 2251 #so, we'll do a dirty hack and convert it to a very small non-zero value 2252 # 'U' values are not affected by this (not inserted) 2253 2254 for my $key (sort keys %idata){ 2255 if($idata{$key} == 0){ 2256 next if ($key eq "loss" or $key eq "loss_percent"); #loss was not a float, so no need for this 2257 $idata{$key} = "0.1e-100"; #an arbitrary small number 2258 } 2259 } 2260 2261 #do_debuglog("DBG: idata:".Dumper(\%idata).", itags:".Dumper(\%itags)); 2262 #convert unixtimestamp from seconds to ms (since rrd have only second precision) 2263 $unixtimestamp = $unixtimestamp."000"; #avoid a multiply 2264 2265 push @influx_data, data2line( $tree->{probe}, \%idata, \%itags, $unixtimestamp); 2266 2267 if(defined $influx){ 2268 #do_debuglog("DBG: About to insert to influxdb: ".Dumper(\@influx_data)); 2269 my $insert = $influx->write( 2270 \@influx_data, 2271 database => $cfg->{InfluxDB}{'database'}, 2272 precision => 'ms' 2273 ); 2274 if(! $insert){ 2275 do_log("Error inserting measurement into influxdb: $insert for ".Dumper(\@influx_data)) 2276 } 2277 } 2278} 2279 2280sub _deepcopy { 2281 # this handles circular references on consecutive levels, 2282 # but breaks if there are any levels in between 2283 my $what = shift; 2284 return $what unless ref $what; 2285 for (ref $what) { 2286 /^ARRAY$/ and return [ map { $_ eq $what ? $_ : _deepcopy($_) } @$what ]; 2287 /^HASH$/ and return { map { $_ => $what->{$_} eq $what ? 2288 $what->{$_} : _deepcopy($what->{$_}) } keys %$what }; 2289 /^CODE$/ and return $what; # we don't need to copy the subs 2290 } 2291 die "Cannot _deepcopy reference type @{[ref $what]}"; 2292} 2293 2294sub get_parser () { 2295 # The _dyn() stuff here is quite confusing, so here's a walkthrough: 2296 # 1 Probe is defined in the Probes section 2297 # 1.1 _dyn is called for the section to add the probe- and target-specific 2298 # vars into the grammar for this section and its subsections (subprobes) 2299 # 1.2 A _dyn sub is installed for all mandatory target-specific variables so 2300 # that they are made non-mandatory in the Targets section if they are 2301 # specified here. The %storedtargetvars hash holds this information. 2302 # 1.3 If a probe section has any subsections (subprobes) defined, the main 2303 # section turns into a template that just offers default values for 2304 # the subprobes. Because of this a _dyn sub is installed for subprobe 2305 # sections that makes any mandatory variables in the main section non-mandatory. 2306 # 1.4 A similar _dyn sub as in 1.2 is installed for the subprobe target-specific 2307 # variables as well. 2308 # 2 Probe is selected in the Targets section top 2309 # 2.1 _dyn is called for the section to add the probe- and target-specific 2310 # vars into the grammar for this section and its subsections. Any _default 2311 # values for the vars are removed, as they will be propagated from the Probes 2312 # section. 2313 # 2.2 Another _dyn sub is installed for the 'probe' variable in target subsections 2314 # that behaves as 2.1 2315 # 2.3 A _dyn sub is installed for the 'host' variable that makes the mandatory 2316 # variables mandatory only in those sections that have a 'host' setting. 2317 # 2.4 A _sub sub is installed for the 'probe' variable in target subsections that 2318 # bombs out if 'probe' is defined after any variables that depend on the 2319 # current 'probe' setting. 2320 2321 2322 my $KEYD_RE = '[-_0-9a-zA-Z]+'; 2323 my $KEYDD_RE = '[-_0-9a-zA-Z.]+'; 2324 my $PROBE_RE = '[A-Z][a-zA-Z]+'; 2325 my $e = "="; 2326 my %knownprobes; # the probes encountered so far 2327 2328 # get a list of available probes for _dyndoc sections 2329 my $libdir = find_libdir(); 2330 my $probedir = $libdir . "/Smokeping/probes"; 2331 my $matcherdir = $libdir . "/Smokeping/matchers"; 2332 my $sorterdir = $libdir . "/Smokeping/sorters"; 2333 2334 my $probelist; 2335 my @matcherlist; 2336 my @sorterlist; 2337 2338 die("Can't find probe module directory") unless defined $probedir; 2339 opendir(D, $probedir) or die("opendir $probedir: $!"); 2340 for (readdir D) { 2341 next unless s/\.pm$//; 2342 next unless /^$PROBE_RE/; 2343 $probelist->{$_} = "(See the L<separate module documentation|Smokeping::probes::$_> for details about each variable.)"; 2344 } 2345 closedir D; 2346 2347 die("Can't find matcher module directory") unless defined $matcherdir; 2348 opendir(D, $matcherdir) or die("opendir $matcherdir: $!"); 2349 for (sort readdir D) { 2350 next unless /[A-Z]/; 2351 next unless s/\.pm$//; 2352 push @matcherlist, $_; 2353 } 2354 2355 die("Can't find sorter module directory") unless defined $sorterdir; 2356 opendir(D, $sorterdir) or die("opendir $sorterdir: $!"); 2357 for (sort readdir D) { 2358 next unless /[A-Z]/; 2359 next unless s/\.pm$//; 2360 push @sorterlist, $_; 2361 } 2362 2363 # The target-specific vars of each probe 2364 # We need to store them to relay information from Probes section to Target section 2365 # see 1.2 above 2366 my %storedtargetvars; 2367 2368 # the part of target section syntax that doesn't depend on the selected probe 2369 my $TARGETCOMMON; # predeclare self-referencing structures 2370 # the common variables 2371 my $TARGETCOMMONVARS = [ qw (probe menu title alerts note email host remark rawlog alertee slaves menuextra parents hide nomasterpoll) ]; 2372 $TARGETCOMMON = 2373 { 2374 _vars => $TARGETCOMMONVARS, 2375 _inherited=> [ qw (probe alerts alertee slaves menuextra nomasterpoll) ], 2376 _sections => [ "/$KEYD_RE/" ], 2377 _recursive=> [ "/$KEYD_RE/" ], 2378 _sub => sub { 2379 my $val = shift; 2380 return "PROBE_CONF sections are neither needed nor supported any longer. Please see the smokeping_upgrade document." 2381 if $val eq 'PROBE_CONF'; 2382 return undef; 2383 }, 2384 "/$KEYD_RE/" => {}, 2385 _order => 1, 2386 _varlist => 1, 2387 _doc => <<DOC, 2388Each target section can contain information about a host to monitor as 2389well as further target sections. Most variables have already been 2390described above. The expression above defines legal names for target 2391sections. 2392DOC 2393 alerts => { 2394 _doc => 'Comma separated list of alert names', 2395 _re => '([^\s,]+(,[^\s,]+)*)?', 2396 _re_error => 'Comma separated list of alert names', 2397 }, 2398 hide => { 2399 _doc => <<DOC, 2400Set the hide property to 'yes' to hide this host from the navigation menu 2401and from search results. Note that if you set the hide property on a non 2402leaf entry all subordinate entries will also disappear in the menu structure. 2403If you know a direct link to a page it is still accessible. Pages which are 2404hidden from the menu due to a parent being hidden will still show up in 2405search results and in alternate hierarchies where they are below a non 2406hidden parent. 2407DOC 2408 _re => '(yes|no)', 2409 _default => 'no', 2410 }, 2411 2412 nomasterpoll=> { 2413 _doc => <<DOC, 2414Use this in a master/slave setup where the master must not poll a particular 2415target. The master will now skip this entry in its polling cycle. 2416Note that if you set the hide property on a non leaf entry 2417all subordinate entries will also disappear in the menu structure. You can 2418still access them via direct link or via an alternate hierarchy. 2419 2420If you have no master/slave setup this will have a similar effect to the 2421hide property, except that the menu entry will still show up, but will not 2422contain any graphs. 2423 2424DOC 2425 _re => '(yes|no)', 2426 _default => 'no', 2427 }, 2428 2429 host => 2430 { 2431 _doc => <<DOC, 2432There are three types of "hosts" in smokeping. 2433 2434${e}over 2435 2436${e}item 1 2437 2438The 'hostname' is a name of a host you want to target from smokeping 2439 2440${e}item 2 2441 2442The string B<DYNAMIC>. Is for machines that have a dynamic IP address. These boxes 2443are required to regularly contact the SmokePing server to confirm their IP address. 2444 When starting SmokePing with the commandline argument 2445B<--email> it will add a secret password to each of the B<DYNAMIC> 2446host lines and send a script to the owner of each host. This script 2447must be started periodically (cron) on the host in question to let smokeping know 2448where the host is currently located. If the target machine supports 2449SNMP SmokePing will also query the hosts 2450sysContact, sysName and sysLocation properties to make sure it is 2451still the same host. 2452 2453${e}item 3 2454 2455A space separated list of 'target-path' entries (multihost target). All 2456targets mentioned in this list will be displayed in one graph. Note that the 2457graph will look different from the normal smokeping graphs. The syntax for 2458multihost targets is as follows: 2459 2460 host = /world/town/host1 /world/town2/host33 /world/town2/host1~slave 2461 2462${e}back 2463 2464DOC 2465 2466 _sub => sub { 2467 for ( shift ) { 2468 m|^DYNAMIC| && return undef; 2469 /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ && return undef; 2470 /^[0-9a-f]{0,4}(\:[0-9a-f]{0,4}){0,6}\:[0-9a-f]{0,4}$/i && return undef; 2471 m|(?:/$KEYD_RE)+(?:~$KEYD_RE)?(?: (?:/$KEYD_RE)+(?:~$KEYD_RE))*| && return undef; 2472 my $addressfound = 0; 2473 my @tried; 2474 if ($havegetaddrinfo) { 2475 my @ai; 2476 @ai = getaddrinfo( $_, "" ); 2477 unless ($addressfound = scalar(@ai) > 5) { 2478 do_debuglog("WARNING: Hostname '$_' does currently not resolve to an IPv6 address\n"); 2479 @tried = qw{IPv6}; 2480 } 2481 } 2482 unless ($addressfound) { 2483 unless ($addressfound = gethostbyname( $_ )) { 2484 do_debuglog("WARNING: Hostname '$_' does currently not resolve to an IPv4 address\n"); 2485 push @tried, qw{IPv4}; 2486 } 2487 } 2488 unless ($addressfound) { 2489 # do not bomb, as this could be temporary 2490 my $tried = join " or ", @tried; 2491 warn "WARNING: Hostname '$_' does currently not resolve to an $tried address\n" unless $cgimode; 2492 } 2493 return undef; 2494 } 2495 return undef; 2496 }, 2497 }, 2498 email => { _re => '.+\s<\S+@\S+>', 2499 _re_error => 2500 "use an email address of the form 'First Last <em\@ail.kg>'", 2501 _doc => <<DOC, 2502This is the contact address for the owner of the current host. In connection with the B<DYNAMIC> hosts, 2503the address will be used for sending the belowmentioned script. 2504DOC 2505 }, 2506 note => { _doc => <<DOC }, 2507Some information about this entry which does NOT get displayed on the web. 2508DOC 2509 rawlog => { _doc => <<DOC, 2510Log the raw data, gathered for this target, in tab separated format, to a file with the 2511same basename as the corresponding RRD file. Use posix strftime to format the timestamp to be 2512put into the file name. The filename is built like this: 2513 2514 basename.strftime.csv 2515 2516Example: 2517 2518 rawlog=%Y-%m-%d 2519 2520this would create a new logfile every day with a name like this: 2521 2522 targethost.2004-05-03.csv 2523 2524DOC 2525 _sub => sub { 2526 eval ( "POSIX::strftime('$_[0]', localtime(time))"); 2527 return $@ if $@; 2528 return undef; 2529 }, 2530 }, 2531 parents => { 2532 _re => "${KEYD_RE}:/(?:${KEYD_RE}(?:/${KEYD_RE})*)?(?: ${KEYD_RE}:/(?:${KEYD_RE}(?:/${KEYD_RE})*)?)*", 2533 _re_error => "Use hierarchy:/parent/path syntax", 2534 _doc => <<DOC 2535After setting up a hierarchy in the Presentation section of the 2536configuration file you can use this property to assign an entry to alternate 2537hierarchies. The format for parent entries is. 2538 2539 hierarchyA:/Node1/Node2 hierarchyB:/Node3 2540 2541The entries from all parent properties together will build a new tree for 2542each hierarchy. With this method it is possible to make a single target show 2543up multiple times in a tree. If you think this is a good thing, go ahead, 2544nothing is stopping you. Since you do not only define the parent but the full path 2545of the parent node, circular dependencies are not possible. 2546 2547DOC 2548 }, 2549 2550 alertee => { _re => '^(?:\|.+|.+@\S+|snpp:.+|xmpp:.+)(?:\s*,\s*(?:\|.+|.+@\S+|snpp:.+|xmpp:.+))*$', 2551 _re_error => 'the alertee must be an email address here', 2552 _doc => <<DOC }, 2553If you want to have alerts for this target and all targets below it go to a particular address 2554on top of the address already specified in the alert, you can add it here. This can be a comma separated list of items. 2555DOC 2556 slaves => { _re => "(${KEYDD_RE}(?:\\s+${KEYDD_RE})*)?", 2557 _re_error => 'Use the format: slaves='.${KEYDD_RE}.' [slave2]', 2558 _doc => <<DOC }, 2559The slave names must match the slaves you have setup in the slaves section. 2560DOC 2561 menuextra => { 2562 _doc => <<'DOC' }, 2563HTML String to be added to the end of each menu entry. The following tags will be replaced: 2564 2565 {HOST} -> #$hostname 2566 {HOSTNAME} -> $hostname 2567 {CLASS} -> same class as the other tags in the menu line 2568 {HASH} -> # 2569 2570DOC 2571 probe => { 2572 _sub => sub { 2573 my $val = shift; 2574 my $varlist = shift; 2575 return "probe $val missing from the Probes section" 2576 unless $knownprobes{$val}; 2577 my %commonvars; 2578 $commonvars{$_} = 1 for @{$TARGETCOMMONVARS}; 2579 delete $commonvars{host}; 2580 # see 2.4 above 2581 return "probe must be defined before the host or any probe variables" 2582 if grep { not exists $commonvars{$_} } @$varlist; 2583 2584 return undef; 2585 }, 2586 _dyn => sub { 2587 # this generates the new syntax whenever a new probe is selected 2588 # see 2.2 above 2589 my ($name, $val, $grammar) = @_; 2590 2591 my $targetvars = _deepcopy($storedtargetvars{$val}); 2592 my @mandatory = @{$targetvars->{_mandatory}}; 2593 delete $targetvars->{_mandatory}; 2594 my @targetvars = sort keys %$targetvars; 2595 2596 # the default values for targetvars are only used in the Probes section 2597 delete $targetvars->{$_}{_default} for @targetvars; 2598 2599 # we replace the current grammar altogether 2600 %$grammar = ( %{_deepcopy($TARGETCOMMON)}, %$targetvars ); 2601 $grammar->{_vars} = [ @{$grammar->{_vars}}, @targetvars ]; 2602 2603 # the subsections differ only in that they inherit their vars from here 2604 my $g = _deepcopy($grammar); 2605 $grammar->{"/$KEYD_RE/"} = $g; 2606 push @{$g->{_inherited}}, @targetvars; 2607 2608 # this makes the variables mandatory only in those sections 2609 # where 'host' is defined. (We must generate this dynamically 2610 # as the mandatory list isn't visible earlier.) 2611 # see 2.3 above 2612 2613 my $mandatorysub = sub { 2614 my ($name, $val, $grammar) = @_; 2615 $grammar->{_mandatory} = [ @mandatory ]; 2616 }; 2617 $grammar->{host} = _deepcopy($grammar->{host}); 2618 $grammar->{host}{_dyn} = $mandatorysub; 2619 $g->{host}{_dyn} = $mandatorysub; 2620 }, 2621 }, 2622 }; 2623 2624 my $INTEGER_SUB = { 2625 _sub => sub { 2626 return "must be an integer >= 1" 2627 unless $_[ 0 ] == int( $_[ 0 ] ) and $_[ 0 ] >= 1; 2628 return undef; 2629 } 2630 }; 2631 my $DIRCHECK_SUB = { 2632 _sub => sub { 2633 return "Directory '$_[0]' does not exist" unless -d $_[ 0 ]; 2634 return undef; 2635 } 2636 }; 2637 2638 my $FILECHECK_SUB = { 2639 _sub => sub { 2640 return "File '$_[0]' does not exist" unless -f $_[ 0 ]; 2641 return undef; 2642 } 2643 }; 2644 2645 # grammar for the ***Probes*** section 2646 my $PROBES = { 2647 _doc => <<DOC, 2648Each module can take specific configuration information from this 2649area. The jumble of letters above is a regular expression defining legal 2650module names. 2651 2652See the documentation of each module for details about its variables. 2653DOC 2654 _sections => [ "/$PROBE_RE/" ], 2655 2656 # this adds the probe-specific variables to the grammar 2657 # see 1.1 above 2658 _dyn => sub { 2659 my ($re, $name, $grammar) = @_; 2660 2661 # load the probe module 2662 my $class = "Smokeping::probes::$name"; 2663 Smokeping::maybe_require $class; 2664 2665 # modify the grammar 2666 my $probevars = $class->probevars; 2667 my $targetvars = $class->targetvars; 2668 $storedtargetvars{$name} = $targetvars; 2669 2670 my @mandatory = @{$probevars->{_mandatory}}; 2671 my @targetvars = sort grep { $_ ne '_mandatory' } keys %$targetvars; 2672 for (@targetvars) { 2673 next if $_ eq '_mandatory'; 2674 delete $probevars->{$_}; 2675 } 2676 my @probevars = sort grep { $_ ne '_mandatory' } keys %$probevars; 2677 2678 $grammar->{_vars} = [ @probevars , @targetvars ]; 2679 $grammar->{_mandatory} = [ @mandatory ]; 2680 2681 # do it for probe instances in subsections too 2682 my $g = $grammar->{"/$KEYD_RE/"}; 2683 for (@probevars) { 2684 $grammar->{$_} = $probevars->{$_}; 2685 %{$g->{$_}} = %{$probevars->{$_}}; 2686 # this makes the reference manual a bit less cluttered 2687 $g->{$_}{_doc} = 'see above'; 2688 delete $g->{$_}{_example}; 2689 $grammar->{$_}{_doc} = 'see above'; 2690 delete $grammar->{$_}{_example}; 2691 } 2692 # make any mandatory variable specified here non-mandatory in the Targets section 2693 # see 1.2 above 2694 my $sub = sub { 2695 my ($name, $val, $grammar) = shift; 2696 $targetvars->{_mandatory} = [ grep { $_ ne $name } @{$targetvars->{_mandatory}} ]; 2697 }; 2698 for my $var (@targetvars) { 2699 %{$grammar->{$var}} = %{$targetvars->{$var}}; 2700 %{$g->{$var}} = %{$targetvars->{$var}}; 2701 # this makes the reference manual a bit less cluttered 2702 delete $grammar->{$var}{_example}; 2703 delete $g->{$var}{_doc}; 2704 delete $g->{$var}{_example}; 2705 # (note: intentionally overwrite _doc) 2706 $grammar->{$var}{_doc} = "(This variable can be overridden target-specifically in the Targets section.)"; 2707 $grammar->{$var}{_dyn} = $sub 2708 if grep { $_ eq $var } @{$targetvars->{_mandatory}}; 2709 } 2710 $g->{_vars} = [ @probevars, @targetvars ]; 2711 $g->{_inherited} = $g->{_vars}; 2712 $g->{_mandatory} = [ @mandatory ]; 2713 2714 # the special value "_template" means we don't know yet if 2715 # there will be any instances of this probe 2716 $knownprobes{$name} = "_template"; 2717 2718 $g->{_dyn} = sub { 2719 # if there is a subprobe, the top-level section 2720 # of this probe turns into a template, and we 2721 # need to delete its _mandatory list. 2722 # Note that Config::Grammar does mandatory checking 2723 # after the whole config tree is read, so we can fiddle 2724 # here with "_mandatory" all we want. 2725 # see 1.3 above 2726 2727 my ($re, $subprobename, $subprobegrammar) = @_; 2728 delete $grammar->{_mandatory}; 2729 # the parent section doesn't define a valid probe anymore 2730 delete $knownprobes{$name} 2731 if exists $knownprobes{$name} 2732 and $knownprobes{$name} eq '_template'; 2733 # this also keeps track of the real module name for each subprobe, 2734 # should we ever need it 2735 $knownprobes{$subprobename} = $name; 2736 my $subtargetvars = _deepcopy($targetvars); 2737 $storedtargetvars{$subprobename} = $subtargetvars; 2738 # make any mandatory variable specified here non-mandatory in the Targets section 2739 # see 1.4 above 2740 my $sub = sub { 2741 my ($name, $val, $grammar) = shift; 2742 $subtargetvars->{_mandatory} = [ grep { $_ ne $name } @{$subtargetvars->{_mandatory}} ]; 2743 }; 2744 for my $var (@targetvars) { 2745 $subprobegrammar->{$var}{_dyn} = $sub 2746 if grep { $_ eq $var } @{$subtargetvars->{_mandatory}}; 2747 } 2748 } 2749 }, 2750 _dyndoc => $probelist, # all available probes 2751 _sections => [ "/$KEYD_RE/" ], 2752 "/$KEYD_RE/" => { 2753 _doc => <<DOC, 2754You can define multiple instances of the same probe with subsections. 2755These instances can have different values for their variables, so you 2756can eg. have one instance of the FPing probe with packet size 1000 and 2757step 300 and another instance with packet size 64 and step 30. 2758The name of the subsection determines what the probe will be called, so 2759you can write descriptive names for the probes. 2760 2761If there are any subsections defined, the main section for this probe 2762will just provide default parameter values for the probe instances, ie. 2763it will not become a probe instance itself. 2764 2765The example above would be written like this: 2766 2767 *** Probes *** 2768 2769 + FPing 2770 # this value is common for the two subprobes 2771 binary = /usr/bin/fping 2772 2773 ++ FPingLarge 2774 packetsize = 1000 2775 step = 300 2776 2777 ++ FPingSmall 2778 packetsize = 64 2779 step = 30 2780 2781DOC 2782 }, 2783 }; # $PROBES 2784 2785 my $parser = Smokeping::Config->new 2786 ( 2787 { 2788 _sections => [ qw(General Database Presentation Probes Targets Alerts Slaves InfluxDB) ], 2789 _mandatory => [ qw(General Database Presentation Probes Targets) ], 2790 General => 2791 { 2792 _doc => <<DOC, 2793General configuration values valid for the whole SmokePing setup. 2794DOC 2795 _vars => 2796 [ qw(owner imgcache imgurl datadir dyndir pagedir piddir sendmail offset 2797 smokemail cgiurl mailhost mailuser mailpass snpphost contact display_name 2798 syslogfacility syslogpriority concurrentprobes changeprocessnames tmail 2799 changecgiprogramname linkstyle precreateperms ) ], 2800 2801 _mandatory => 2802 [ qw(owner imgcache imgurl datadir piddir 2803 smokemail cgiurl contact) ], 2804 imgcache => 2805 { %$DIRCHECK_SUB, 2806 _doc => <<DOC, 2807A directory which is visible on your webserver where SmokePing can cache graphs. 2808DOC 2809 }, 2810 2811 imgurl => 2812 { 2813 _doc => <<DOC, 2814Either an absolute URL to the B<imgcache> directory or one relative to the directory where you keep the 2815SmokePing cgi. 2816DOC 2817 }, 2818 2819 display_name => 2820 { 2821 _doc => <<DOC, 2822What should the master host be called when working in master/slave mode. This is used in the overview 2823graph for example. 2824DOC 2825 }, 2826 pagedir => 2827 { 2828 %$DIRCHECK_SUB, 2829 _doc => <<DOC, 2830Directory to store static representations of pages. 2831DOC 2832 }, 2833 owner => 2834 { 2835 _doc => <<DOC, 2836Name of the person responsible for this smokeping installation. 2837DOC 2838 }, 2839 2840 mailhost => 2841 { 2842 _doc => <<DOC, 2843 2844Instead of using sendmail, you can specify the name of an smtp server and 2845use perl's Net::SMTP module to send mail (for alerts and DYNAMIC client 2846script). Several comma separated mailhosts can be specified. SmokePing will 2847try one after the other if one does not answer for 5 seconds. 2848DOC 2849 _sub => sub { require Net::SMTP ||return "ERROR: loading Net::SMTP"; return undef; } 2850 }, 2851 2852 mailuser => 2853 { 2854 _doc => <<DOC, 2855username on mailhost, SmokePing will use this user to send mail (Net::SMTP). 2856DOC 2857 }, 2858 2859 mailpass => 2860 { 2861 _doc => <<DOC, 2862password of username on mailhost, SmokePing will use this password to send mail (Net::SMTP). 2863DOC 2864 }, 2865 2866 snpphost => 2867 { 2868 _doc => <<DOC, 2869If you have a SNPP (Simple Network Pager Protocol) server at hand, you can have alerts 2870sent there too. Use the syntax B<snpp:someaddress> to use a snpp address in any place where you can use a mail address otherwise. 2871DOC 2872 _sub => sub { require Net::SNPP ||return "ERROR: loading Net::SNPP"; return undef; } 2873 }, 2874 2875 contact => 2876 { _re => '\S+@\S+', 2877 _re_error => 2878 "use an email address of the form 'name\@place.dom'", 2879 2880 _doc => <<DOC, 2881Mail address of the person responsible for this smokeping installation. 2882DOC 2883 }, 2884 2885 datadir => 2886 { 2887 %$DIRCHECK_SUB, 2888 _doc => <<DOC, 2889The directory where SmokePing can keep its rrd files. 2890DOC 2891 }, 2892 dyndir => 2893 { 2894 %$DIRCHECK_SUB, 2895 _doc => <<DOC, 2896The base directory where SmokePing keeps the files related to the DYNAMIC function. 2897This directory must be writeable by the WWW server. It is also used for temporary 2898storage of slave polling results by the master in 2899L<the masterE<sol>slave mode|smokeping_master_slave>. 2900 2901If this variable is not specified, the value of C<datadir> will be used instead. 2902DOC 2903 }, 2904 piddir => 2905 { 2906 %$DIRCHECK_SUB, 2907 _doc => <<DOC, 2908The directory where SmokePing keeps its pid when daemonized. 2909DOC 2910 }, 2911 sendmail => 2912 { 2913 %$FILECHECK_SUB, 2914 _doc => <<DOC, 2915Path to your sendmail binary. It will be used for sending mails in connection with the support of DYNAMIC addresses. 2916DOC 2917 }, 2918 smokemail => 2919 { 2920 %$FILECHECK_SUB, 2921 _doc => <<DOC, 2922Path to the mail template for DYNAMIC hosts. This mail template 2923must contain keywords of the form B<E<lt>##>I<keyword>B<##E<gt>>. There is a sample 2924template included with SmokePing. 2925DOC 2926 }, 2927 cgiurl => 2928 { 2929 _re => 'https?://\S+', 2930 _re_error => 2931 "cgiurl must be a http(s)://.... url", 2932 _doc => <<DOC, 2933Complete URL path of the SmokePing.cgi 2934DOC 2935 2936 }, 2937 precreateperms => 2938 { 2939 _re => '[0-7]+', 2940 _re_error => 'please specify the permissions in octal', 2941 _example => '2755', 2942 _doc => <<DOC, 2943If this variable is set, the Smokeping daemon will create its directory 2944hierarchy under 'dyndir' (the CGI-writable tree) at startup with the 2945specified directory permission bits. The value is interpreted as an 2946octal value, eg. 775 for rwxrwxr-x etc. 2947 2948If unset, the directories will be created dynamically with umask 022. 2949DOC 2950 }, 2951 linkstyle => 2952 { 2953 _re => '(?:absolute|relative|original)', 2954 _default => 'relative', 2955 _re_error => 2956 'linkstyle must be one of "absolute", "relative" or "original"', 2957 _doc => <<DOC, 2958How the CGI self-referring links are created. The possible values are 2959 2960${e}over 2961 2962${e}item absolute 2963 2964Full hostname and path derived from the 'cgiurl' variable 2965 2966S<\<a href="http://hostname/path/smokeping.cgi?foo=bar"\>> 2967 2968${e}item relative 2969 2970Only the parameter part is specified 2971 2972S<\<a href="?foo=bar"\>> 2973 2974${e}item original 2975 2976The way the links were generated before Smokeping version 2.0.4: 2977no hostname, only the path 2978 2979S<\<a href="/path/smokeping.cgi?foo=bar"\>> 2980 2981${e}back 2982 2983The default is "relative", which hopefully works for everybody. 2984DOC 2985 }, 2986 syslogfacility => 2987 { 2988 _re => '\w+', 2989 _re_error => 2990 "syslogfacility must be alphanumeric", 2991 _doc => <<DOC, 2992The syslog facility to use, eg. local0...local7. 2993Note: syslog logging is only used if you specify this. 2994DOC 2995 }, 2996 syslogpriority => 2997 { 2998 _re => '\w+', 2999 _re_error => 3000 "syslogpriority must be alphanumeric", 3001 _doc => <<DOC, 3002The syslog priority to use, eg. debug, notice or info. 3003Default is $DEFAULTPRIORITY. 3004DOC 3005 }, 3006 offset => { 3007 _re => '(\d+%|random)', 3008 _re_error => 3009 "Use offset either in % of operation interval or 'random'", 3010 _doc => <<DOC, 3011If you run many instances of smokeping you may want to prevent them from 3012hitting your network all at the same time. Using the offset parameter you 3013can change the point in time when the probes are run. Offset is specified 3014in % of total interval, or alternatively as 'random'. I recommend to use 3015'random'. Note that this does NOT influence the rrds itself, it is just a 3016matter of when data acquisition is initiated. The default offset is 'random'. 3017DOC 3018 }, 3019 concurrentprobes => { 3020 _re => '(yes|no)', 3021 _re_error =>"this must either be 'yes' or 'no'", 3022 _doc => <<DOC, 3023If you use multiple probes or multiple instances of the same probe and you 3024want them to run concurrently in separate processes, set this to 'yes'. This 3025gives you the possibility to specify probe-specific step and offset parameters 3026(see the 'Probes' section) for each probe and makes the probes unable to block 3027each other in cases of service outages. The default is 'yes', but if you for 3028some reason want the old behaviour you can set this to 'no'. 3029DOC 3030 }, 3031 changeprocessnames => { 3032 _re => '(yes|no)', 3033 _re_error =>"this must either be 'yes' or 'no'", 3034 _doc => <<DOC, 3035When using 'concurrentprobes' (see above), this controls whether the probe 3036subprocesses should change their argv string to indicate their probe in 3037the process name. If set to 'yes' (the default), the probe name will 3038be appended to the process name as '[probe]', eg. '/usr/bin/smokeping 3039[FPing]'. If you don't like this behaviour, set this variable to 'no'. 3040If 'concurrentprobes' is not set to 'yes', this variable has no effect. 3041DOC 3042 _default => 'yes', 3043 }, 3044 changecgiprogramname => { 3045 _re => '(yes|no)', 3046 _re_error =>"this must either be 'yes' or 'no'", 3047 _doc => <<DOC, 3048Usually the Smokeping CGI tries to log any possible errors with an extended 3049program name that includes the IP address of the remote client for easier 3050debugging. If this variable is set to 'no', the program name will not be 3051modified. The only reason you would want this is if you have a very old 3052version of the CGI::Carp module. See 3053L<the installation document|smokeping_install> for details. 3054DOC 3055 _default => 'yes', 3056 }, 3057 tmail => 3058 { 3059 %$FILECHECK_SUB, 3060 _doc => <<DOC, 3061Path to your tSmoke HTML mail template file. See the tSmoke documentation for details. 3062DOC 3063 } 3064 }, 3065 3066 Database => 3067 { 3068 _vars => [ qw(step pings) ], 3069 _mandatory => [ qw(step pings) ], 3070 _doc => <<DOC, 3071Describes the properties of the round robin database for storing the 3072SmokePing data. Note that it is not possible to edit existing RRDs 3073by changing the entries in the cfg file. 3074DOC 3075 3076 step => 3077 { 3078 %$INTEGER_SUB, 3079 _doc => <<DOC, 3080Duration of the base operation interval of SmokePing in seconds. 3081SmokePing will venture out every B<step> seconds to ping your target hosts. 3082If 'concurrentprobes' is set to 'yes' (see above), this variable can be 3083overridden by each probe. Note that the step in the RRD files is fixed when 3084they are originally generated, and if you change the step parameter afterwards, 3085you'll have to delete the old RRD files or somehow convert them. 3086DOC 3087 }, 3088 pings => 3089 { 3090 _re => '\d+', 3091 _sub => sub { 3092 my $val = shift; 3093 return "ERROR: The pings value must be at least 3." 3094 if $val < 3; 3095 return undef; 3096 }, 3097 _doc => <<DOC, 3098How many pings should be sent to each target. Suggested: 20 pings. Minimum value: 3 pings. 3099This can be overridden by each probe. Some probes (those derived from 3100basefork.pm, ie. most except the FPing variants) will even let this 3101be overridden target-specifically. Note that the number of pings in 3102the RRD files is fixed when they are originally generated, and if you 3103change this parameter afterwards, you'll have to delete the old RRD 3104files or somehow convert them. 3105DOC 3106 }, 3107 3108 _table => 3109 { 3110 _doc => <<DOC, 3111This section also contains a table describing the setup of the 3112SmokePing database. Below are reasonable defaults. Only change them if 3113you know rrdtool and its workings. Each row in the table describes one RRA. 3114 3115 # cons xff steps rows 3116 AVERAGE 0.5 1 1008 3117 AVERAGE 0.5 12 4320 3118 MIN 0.5 12 4320 3119 MAX 0.5 12 4320 3120 AVERAGE 0.5 144 720 3121 MAX 0.5 144 720 3122 MIN 0.5 144 720 3123 3124DOC 3125 _columns => 4, 3126 0 => 3127 { 3128 _doc => <<DOC, 3129Consolidation method. 3130DOC 3131 _re => '(AVERAGE|MIN|MAX)', 3132 _re_error => "Choose a valid consolidation function", 3133 }, 3134 1 => 3135 { 3136 _doc => <<DOC, 3137What part of the consolidated intervals must be known to warrant a known entry. 3138DOC 3139 _sub => sub { 3140 return "Xff must be between 0 and 1" 3141 unless $_[ 0 ] > 0 and $_[ 0 ] <= 1; 3142 return undef; 3143 } 3144 }, 3145 2 => {%$INTEGER_SUB, 3146 _doc => <<DOC, 3147How many B<steps> to consolidate into for each RRA entry. 3148DOC 3149 }, 3150 3151 3 => {%$INTEGER_SUB, 3152 _doc => <<DOC, 3153How many B<rows> this RRA should have. 3154DOC 3155 } 3156 } 3157 }, 3158 3159 InfluxDB => 3160 { 3161 _vars => [ qw(host port timeout database username password) ], 3162 _mandatory => [ qw(host database) ], 3163 _doc => <<DOC, 3164If you want to export data to an InfluxDB database, fill in this section. 3165DOC 3166 3167 host => 3168 { 3169 _re => '\S+', 3170 _doc => <<DOC, 3171The FQDN or IP address of your InfluxDB server. 3172For example 'localhost', 'influx.example.org' or '127.0.0.1' 3173DOC 3174 }, 3175 port => 3176 { 3177 _re => '\d+', 3178 _default => '8086', 3179 _sub => sub { 3180 return "Invalid InfluxDB port (needs to be between 1-65535)" unless $_[ 0 ] > 0 and $_[ 0 ] < 65536; 3181 return undef; 3182 }, 3183 _doc => <<DOC, 3184The port of your InfluxDB server. Default is 8086 3185DOC 3186 }, 3187 timeout => 3188 {%$INTEGER_SUB, 3189 _default => '15', 3190 _doc => <<DOC, 3191Connection timeout to InfluxDB in seconds. Default is 15s. 3192Too big of a timeout will cause polling errors when InfluxDB is down. 3193DOC 3194 }, 3195 database => 3196 { 3197 _re => '\S+', 3198 _doc => <<DOC, 3199Database name (where to write the data) within InfluxDB. 3200If it doesn't exist, it will be created when writing data. 3201DOC 3202 }, 3203 username => 3204 { 3205 _re => '\S+', 3206 _doc => <<DOC, 3207Username for authentication to InfluxDB. 3208If not supplied, no authentication is attempted. 3209DOC 3210 }, 3211 password => 3212 { 3213 _re => '\S+', 3214 _doc => <<DOC, 3215Password for authentication to InfluxDB. 3216If not supplied, no authentication is attempted. 3217DOC 3218 } 3219 }, 3220 3221 3222 Presentation => 3223 { 3224 _doc => <<DOC, 3225Defines how the SmokePing data should be presented. 3226DOC 3227 _sections => [ qw(overview detail charts multihost hierarchies) ], 3228 _mandatory => [ qw(overview template detail) ], 3229 _vars => [ qw (template charset htmltitle graphborders) ], 3230 template => 3231 { 3232 _doc => <<DOC, 3233The webpage template must contain keywords of the form 3234B<E<lt>##>I<keyword>B<##E<gt>>. There is a sample 3235template included with SmokePing; use it as the basis for your 3236experiments. Default template contains a pointer to the SmokePing 3237counter and homepage. I would be glad if you would not remove this as 3238it gives me an indication as to how widely used the tool is. 3239DOC 3240 3241 _sub => sub { 3242 return "template '$_[0]' not readable" unless -r $_[ 0 ]; 3243 return undef; 3244 } 3245 }, 3246 charset => { 3247 _doc => <<DOC, 3248By default, SmokePing assumes the 'utf-8' character set. If you use 3249something else, this is the place to speak up. 3250DOC 3251 }, 3252 htmltitle => { 3253 _doc => <<DOC, 3254By default, SmokePing will render the title of the graph in the image, 3255when set to 'yes' the title is inserted in the html page. 3256DOC 3257 _re => '(yes|no)', 3258 _re_error =>"this must either be 'yes' or 'no'", 3259 }, 3260 graphborders => { 3261 _doc => <<DOC, 3262By default, SmokePing will render gray border on a light gray background, 3263if set to 'no' borders will be hidden and the background and canvas 3264will be transparent. 3265DOC 3266 _re => '(yes|no)', 3267 _re_error =>"this must either be 'yes' or 'no'", 3268 }, 3269 charts => { 3270 _doc => <<DOC, 3271The SmokePing Charts feature allow you to have Top X lists created according 3272to various criteria. 3273 3274Each type of Chart must live in its own subsection. 3275 3276 + charts 3277 menu = Charts 3278 title = The most interesting destinations 3279 ++ median 3280 sorter = Median(entries=>10) 3281 title = Sorted by Median Roundtrip Time 3282 menu = Top Median RTT 3283 format = Median RTT %e s 3284 3285DOC 3286 _vars => [ qw(menu title) ], 3287 _sections => [ "/$KEYD_RE/" ], 3288 _mandatory => [ qw(menu title) ], 3289 3290 menu => { _doc => 'Menu entry for the Charts Section.' }, 3291 title => { _doc => 'Page title for the Charts Section.' }, 3292 "/$KEYD_RE/" => 3293 { 3294 _vars => [ qw(menu title sorter format) ], 3295 _mandatory => [ qw(menu title sorter) ], 3296 menu => { _doc => 'Menu entry' }, 3297 title => { _doc => 'Page title' }, 3298 format => { _doc => 'sprintf format string to format current value' }, 3299 sorter => { _re => '\S+\(\S+\)', 3300 _re_error => 'use a sorter call here: Sorter(arg1=>val1,arg2=>val2)', 3301 _doc => 'sorter for this charts sections', 3302 } 3303 } 3304 }, 3305 3306 overview => 3307 { _vars => [ qw(width height range max_rtt median_color strftime) ], 3308 _mandatory => [ qw(width height) ], 3309 _doc => <<DOC, 3310The Overview section defines how the Overview graphs should look. 3311DOC 3312 max_rtt => { _doc => <<DOC }, 3313Any roundtrip time larger than this value will be cropped in the overview graph. 3314Units is seconds (for example, 0.800). 3315DOC 3316 median_color => { _doc => <<DOC, 3317By default the median line is drawn in red. Override it here with a hex color 3318in the format I<rrggbb>. Note that if you work with slaves, the slaves medians will 3319be drawn in the slave color in the overview graph. 3320DOC 3321 _re => '[0-9a-f]{6}', 3322 _re_error => 'use rrggbb for color', 3323 }, 3324 strftime => { _doc => <<DOC, 3325Use posix strftime to format the timestamp in the left hand 3326lower corner of the overview graph 3327DOC 3328 _sub => sub { 3329 eval ( "POSIX::strftime( '$_[0]', localtime(time))" ); 3330 return $@ if $@; 3331 return undef; 3332 }, 3333 }, 3334 3335 3336 width => 3337 { 3338 _sub => sub { 3339 return "width must be be an integer >= 10" 3340 unless $_[ 0 ] >= 10 3341 and int( $_[ 0 ] ) == $_[ 0 ]; 3342 return undef; 3343 }, 3344 _doc => <<DOC, 3345Width of the Overview Graphs. 3346DOC 3347 }, 3348 height => 3349 { 3350 _doc => <<DOC, 3351Height of the Overview Graphs. 3352DOC 3353 _sub => sub { 3354 return "height must be an integer >= 10" 3355 unless $_[ 0 ] >= 10 3356 and int( $_[ 0 ] ) == $_[ 0 ]; 3357 return undef; 3358 }, 3359 }, 3360 range => { _re => '\d+[smhdwy]', 3361 _re_error => 3362 "graph range must be a number followed by [smhdwy]", 3363 _doc => <<DOC, 3364How much time should be depicted in the Overview graph. Time must be specified 3365as a number followed by a letter which specifies the unit of time. Known units are: 3366B<s>econds, B<m>inutes, B<h>ours, B<d>days, B<w>eeks, B<y>ears. 3367DOC 3368 }, 3369 }, 3370 detail => 3371 { 3372 _vars => [ qw(width height loss_background logarithmic unison_tolerance max_rtt strftime nodata_color) ], 3373 _sections => [ qw(loss_colors uptime_colors) ], 3374 _mandatory => [ qw(width height) ], 3375 _table => { _columns => 2, 3376 _doc => <<DOC, 3377The detailed display can contain several graphs of different resolution. In this 3378table you can specify the resolution of each graph. 3379 3380Example: 3381 3382 "Last 3 Hours" 3h 3383 "Last 30 Hours" 30h 3384 "Last 10 Days" 10d 3385 "Last 400 Days" 400d 3386 3387DOC 3388 1 => 3389 { 3390 _doc => <<DOC, 3391How much time should be depicted. The format is the same as for the B<age> parameter of the Overview section. 3392DOC 3393 _re => '\d+[smhdwy]', 3394 _re_error => 3395 "graph age must be a number followed by [smhdwy]", 3396 }, 3397 0 => 3398 { 3399 _doc => <<DOC, 3400Description of the particular resolution. 3401DOC 3402 } 3403 }, 3404 strftime => { _doc => <<DOC, 3405Use posix strftime to format the timestamp in the left hand 3406lower corner of the detail graph 3407DOC 3408 _sub => sub { 3409 eval ( " 3410 POSIX::strftime('$_[0]', localtime(time)) " ); 3411 return $@ if $@; 3412 return undef; 3413 }, 3414 }, 3415 nodata_color => { 3416 _re => '[0-9a-f]{6}', 3417 _re_error => "color must be defined with in rrggbb syntax", 3418 _doc => "Paint the graph background in a special color when there is no data for this period because smokeping has not been running (#rrggbb)", 3419 }, 3420 loss_background => { _doc => <<EOF, 3421Should the graphs be shown with a background showing loss data for emphasis (yes/no)? 3422 3423If this option is enabled, uptime data is no longer displayed in the graph background. 3424EOF 3425 _re => '(yes|no)', 3426 _re_error =>"this must either be 'yes' or 'no'", 3427 }, 3428 logarithmic => { _doc => 'should the graphs be shown in a logarithmic scale (yes/no)', 3429 _re => '(yes|no)', 3430 _re_error =>"this must either be 'yes' or 'no'", 3431 }, 3432 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", 3433 _sub => sub { return "tolerance must be larger than 1" if $_[0] <= 1; return undef}, 3434 }, 3435 max_rtt => { _doc => <<DOC }, 3436Any roundtrip time larger than this value will be cropped in the detail graph. 3437Units is seconds (for example, 0.800). 3438DOC 3439 width => { _doc => 'How many pixels wide should detail graphs be', 3440 _sub => sub { 3441 return "width must be be an integer >= 10" 3442 unless $_[ 0 ] >= 10 3443 and int( $_[ 0 ] ) == $_[ 0 ]; 3444 return undef; 3445 }, 3446 }, 3447 height => { _doc => 'How many pixels high should detail graphs be', 3448 _sub => sub { 3449 return "height must be an integer >= 10" 3450 unless $_[ 0 ] >= 10 3451 and int( $_[ 0 ] ) == $_[ 0 ]; 3452 return undef; 3453 }, 3454 }, 3455 3456 loss_colors => { 3457 _table => { _columns => 3, 3458 _doc => <<DOC, 3459In the Detail view, the color of the median line depends 3460the amount of lost packets. SmokePing comes with a reasonable default setting, 3461but you may choose to disagree. The table below 3462lets you specify your own coloring. 3463 3464Example: 3465 3466 Loss Color Legend 3467 1 00ff00 "<1" 3468 3 0000ff "<3" 3469 1000 ff0000 ">=3" 3470 3471DOC 3472 0 => 3473 { 3474 _doc => <<DOC, 3475Activate when the number of lost pings is larger or equal to this number 3476DOC 3477 _re => '\d+.?\d*', 3478 _re_error => 3479 "I was expecting a number", 3480 }, 3481 1 => 3482 { 3483 _doc => <<DOC, 3484Color for this range. 3485DOC 3486 _re => '[0-9a-f]+', 3487 _re_error => 3488 "I was expecting a color of the form rrggbb", 3489 }, 3490 3491 2 => 3492 { 3493 _doc => <<DOC, 3494Description for this range. 3495DOC 3496 } 3497 3498 }, # table 3499 }, #loss_colors 3500 uptime_colors => { 3501 _table => { _columns => 3, 3502 _doc => <<DOC, 3503When monitoring a host with DYNAMIC addressing, SmokePing will keep 3504track of how long the machine is able to keep the same IP 3505address. This time is plotted as a color in the graphs 3506background. SmokePing comes with a reasonable default setting, but you 3507may choose to disagree. The table below lets you specify your own 3508coloring 3509 3510Example: 3511 3512 # Uptime Color Legend 3513 3600 00ff00 "<1h" 3514 86400 0000ff "<1d" 3515 604800 ff0000 "<1w" 3516 1000000000000 ffff00 ">1w" 3517 3518Uptime is in days! 3519 3520DOC 3521 0 => 3522 { 3523 _doc => <<DOC, 3524Activate when uptime in days is larger of equal to this number 3525DOC 3526 _re => '\d+.?\d*', 3527 _re_error => 3528 "I was expecting a number", 3529 }, 3530 1 => 3531 { 3532 _doc => <<DOC, 3533Color for this uptime range. 3534DOC 3535 _re => '[0-9a-f]{6}', 3536 _re_error => 3537 "I was expecting a color of the form rrggbb", 3538 }, 3539 3540 2 => 3541 { 3542 _doc => <<DOC, 3543Description for this range. 3544DOC 3545 } 3546 3547 },#table 3548 }, #uptime_colors 3549 3550 }, #detail 3551 multihost => { 3552 _vars => [ qw(colors) ], 3553 _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.", 3554 colors => { 3555 _doc => "Space separated list of colors for multihost graphs", 3556 _example => "ff0000 00ff00 0000ff", 3557 _re => '[0-9a-z]{6}(?: [0-9a-z]{6})*', 3558 3559 } 3560 }, #multi host 3561 hierarchies => { 3562 _doc => <<DOC, 3563Provide an alternative presentation hierarchy for your smokeping data. After setting up a hierarchy in this 3564section. You can use it in each target's parent property. A drop-down menu in the smokeping website lets 3565the user switch presentation hierarchy. 3566DOC 3567 _sections => [ "/$KEYD_RE/" ], 3568 "/$KEYD_RE/" => { 3569 _doc => "Identifier of the hierarchies. Use this as prefix in the targets parent property", 3570 _vars => [ qw(title) ], 3571 _mandatory => [ qw(title) ], 3572 title => { 3573 _doc => "Title for this hierarchy", 3574 } 3575 } 3576 }, #hierarchies 3577 }, #present 3578 Probes => { _sections => [ "/$KEYD_RE/" ], 3579 _doc => <<DOC, 3580The Probes Section configures Probe modules. Probe modules integrate 3581an external ping command into SmokePing. Check the documentation of each 3582module for more information about it. 3583DOC 3584 "/$KEYD_RE/" => $PROBES, 3585 }, 3586 Alerts => { 3587 _doc => <<DOC, 3588The Alert section lets you setup loss and RTT pattern detectors. After each 3589round of polling, SmokePing will examine its data and determine which 3590detectors match. Detectors are enabled per target and get inherited by 3591the targets children. 3592 3593Detectors are not just simple thresholds which go off at first sight 3594of a problem. They are configurable to detect special loss or RTT 3595patterns. They let you look at a number of past readings to make a 3596more educated decision on what kind of alert should be sent, or if an 3597alert should be sent at all. 3598 3599The patterns are numbers prefixed with an operator indicating the type 3600of comparison required for a match. 3601 3602The following RTT pattern detects if a target's RTT goes from constantly 3603below 10ms to constantly 100ms and more: 3604 3605 old ------------------------------> new 3606 <10,<10,<10,<10,<10,>10,>100,>100,>100 3607 3608Loss patterns work in a similar way, except that the loss is defined as the 3609percentage the total number of received packets is of the total number of packets sent. 3610 3611 old ------------------------------> new 3612 ==0%,==0%,==0%,==0%,>20%,>20%,>=20% 3613 3614Apart from normal numbers, patterns can also contain the values B<*> 3615which is true for all values regardless of the operator. And B<U> 3616which is true for B<unknown> data together with the B<==> and B<=!> operators. 3617 3618Detectors normally act on state changes. This has the disadvantage, that 3619they will fail to find conditions which were already present when launching 3620smokeping. For this it is possible to write detectors that begin with the 3621special value B<==S> it is inserted whenever smokeping is started up. 3622 3623You can write 3624 3625 ==S,>20%,>20% 3626 3627to detect lines that have been losing more than 20% of the packets for two 3628periods after startup. 3629 3630If you want to make sure a value within a certain range you can use two conditions 3631in one element 3632 3633 >45%<=55% 3634 3635Sometimes it may be that conditions occur at irregular intervals. But still 3636you only want to throw an alert if they occur several times within a certain 3637time period. The operator B<*X*> will ignore up to I<X> values and still let 3638the pattern match: 3639 3640 >10%,*10*,>10% 3641 3642will fire if more than 10% of the packets have been lost at least twice over the 3643last 10 samples. 3644 3645A complete example 3646 3647 *** Alerts *** 3648 to = admin\@company.xy,peter\@home.xy 3649 from = smokealert\@company.xy 3650 3651 +lossdetect 3652 type = loss 3653 # in percent 3654 pattern = ==0%,==0%,==0%,==0%,>20%,>20%,>20% 3655 comment = suddenly there is packet loss 3656 3657 +miniloss 3658 type = loss 3659 # in percent 3660 pattern = >0%,*12*,>0%,*12*,>0% 3661 comment = detected loss 3 times over the last two hours 3662 3663 +rttdetect 3664 type = rtt 3665 # in milliseconds 3666 pattern = <10,<10,<10,<10,<10,<100,>100,>100,>100 3667 comment = routing messed up again ? 3668 3669 +rttbadstart 3670 type = rtt 3671 # in milliseconds 3672 pattern = ==S,==U 3673 comment = offline at startup 3674 3675DOC 3676 3677 _sections => [ '/[^\s,]+/' ], 3678 _vars => [ qw(to from edgetrigger mailtemplate) ], 3679 _mandatory => [ qw(to from)], 3680 to => { _doc => <<DOC, 3681Either an email address to send alerts to, or the name of a program to 3682execute when an alert matches. To call a program, the first character of the 3683B<to> value must be a pipe symbol "|". The program will the be called 3684whenever an alert matches, using the following 5 arguments 3685(except if B<edgetrigger> is 'yes'; see below): 3686B<name-of-alert>, B<target>, B<loss-pattern>, B<rtt-pattern>, B<hostname>. 3687You can also provide a comma separated list of addresses and programs. 3688DOC 3689 _re => '(\|.+|.+@\S+|snpp:|xmpp:)', 3690 _re_error => 'put an email address or the name of a program here', 3691 }, 3692 from => { _doc => 'who should alerts appear to be coming from ?', 3693 _re => '.+@\S+', 3694 _re_error => 'put an email address here', 3695 }, 3696 edgetrigger => { _doc => <<DOC, 3697The alert notifications and/or the programs executed are normally triggered every 3698time the alert matches. If this variable is set to 'yes', they will be triggered 3699only when the alert's state is changed, ie. when it's raised and when it's cleared. 3700Subsequent matches of the same alert will thus not trigger a notification. 3701 3702When this variable is set to 'yes', a notification program (see the B<to> variable 3703documentation above) will get a sixth argument, B<raise>, which has the value 1 if the alert 3704was just raised and 0 if it was cleared. 3705DOC 3706 _re => '(yes|no)', 3707 _re_error =>"this must either be 'yes' or 'no'", 3708 _default => 'no', 3709 }, 3710 mailtemplate => { 3711 _doc => <<DOC, 3712When sending out mails for alerts, smokeping normally uses an internally 3713generated message. With the mailtemplate you can specify a filename for 3714a custom template. The file should contain a 'Subject: ...' line. The 3715rest of the file should contain text. The all B<E<lt>##>I<keyword>B<##E<gt>> type 3716strings will get replaced in the template before it is sent out. the 3717following keywords are supported: 3718 3719 <##ALERT##> - target name 3720 <##WHAT##> - status (is active, was raised, was cleared) 3721 <##LINE##> - path in the config tree 3722 <##URL##> - webpage for graph 3723 <##STAMP##> - date and time 3724 <##PAT##> - pattern that matched the alert 3725 <##LOSS##> - loss history 3726 <##RTT##> - rtt history 3727 <##COMMENT##> - comment 3728 3729 3730DOC 3731 3732 _sub => sub { 3733 open (my $tmpl, $_[0]) or 3734 return "mailtemplate '$_[0]' not readable"; 3735 my $subj; 3736 while (<$tmpl>){ 3737 $subj =1 if /^Subject: /; 3738 next if /^\S+: /; 3739 last if /^$/; 3740 return "mailtemplate '$_[0]' should start with mail header lines"; 3741 } 3742 return "mailtemplate '$_[0]' has no Subject: line" unless $subj; 3743 return undef; 3744 }, 3745 }, 3746 '/[^\s,]+/' => { 3747 _vars => [ qw(type pattern comment to edgetrigger mailtemplate priority) ], 3748 _inherited => [ qw(edgetrigger mailtemplate) ], 3749 _mandatory => [ qw(type pattern comment) ], 3750 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.', 3751 _re => '(\|.+|.+@\S+|snpp:|xmpp:)', 3752 _re_error => 'put an email address or the name of a program here', 3753 }, 3754 3755 type => { 3756 _doc => <<DOC, 3757Currently the pattern types B<rtt> and B<loss> and B<matcher> are known. 3758 3759Matchers are plugin modules that extend the alert conditions. Known 3760matchers are @{[join (", ", map { "L<$_|Smokeping::matchers::$_>" } 3761@matcherlist)]}. 3762 3763See the documentation of the corresponding matcher module 3764(eg. L<Smokeping::matchers::$matcherlist[0]>) for instructions on 3765configuring it. 3766DOC 3767 _re => '(rtt|loss|matcher)', 3768 _re_error => 'Use loss, rtt or matcher' 3769 }, 3770 pattern => { 3771 _doc => "a comma separated list of comparison operators and numbers. rtt patterns are in milliseconds, loss patterns are in percents", 3772 _re => '(?:([^,]+)(,[^,]+)*|\S+\(.+\s)', 3773 _re_error => 'Could not parse pattern or matcher', 3774 }, 3775 edgetrigger => { 3776 _re => '(yes|no)', 3777 _re_error =>"this must either be 'yes' or 'no'", 3778 _default => 'no', 3779 }, 3780 priority => { 3781 _re => '[1-9]\d*', 3782 _re_error =>"priority must be between 1 and oo", 3783 _doc => <<DOC, 3784if multiple alerts 'match' only the one with the highest priority (lowest number) will cause and 3785alert to be sent. Alerts without priority will be sent in any case. 3786DOC 3787 }, 3788 mailtemplate => { 3789 _sub => sub { 3790 open (my $tmpl, $_[0]) or 3791 return "mailtemplate '$_[0]' not readable"; 3792 my $subj; 3793 while (<$tmpl>){ 3794 $subj =1 if /^Subject: /; 3795 next if /^\S+: /; 3796 last if /^$/; 3797 return "mailtemplate '$_[0]' should start with mail header lines"; 3798 } 3799 return "mailtemplate '$_[0]' has no Subject: line" unless $subj; 3800 return undef; 3801 }, 3802 }, 3803 }, 3804 }, 3805 Slaves => {_doc => <<END_DOC, 3806Your smokeping can remote control other somkeping instances running in slave 3807mode on different hosts. Use this section to tell your master smokeping about the 3808slaves you are going to use. 3809END_DOC 3810 _vars => [ qw(secrets) ], 3811 _mandatory => [ qw(secrets) ], 3812 _sections => [ "/$KEYDD_RE/" ], 3813 secrets => { 3814 _sub => sub { 3815 return "File '$_[0]' does not exist" unless -f $_[ 0 ]; 3816 return "File '$_[0]' is world-readable or writable, refusing it" 3817 if ((stat(_))[2] & 6); 3818 return undef; 3819 }, 3820 _doc => <<END_DOC, 3821The slave secrets file contains one line per slave with the name of the slave followed by a colon 3822and the secret: 3823 3824 slave1:secret1 3825 slave2:secret2 3826 ... 3827 3828Note that these secrets combined with a man-in-the-middle attack 3829effectively give shell access to the corresponding slaves (see 3830L<smokeping_master_slave>), so the file should be appropriately protected 3831and the secrets should not be easily crackable. 3832END_DOC 3833 3834 }, 3835 timeout => { 3836 %$INTEGER_SUB, 3837 _doc => <<END_DOC, 3838How long should the master wait for its slave to answer? 3839END_DOC 3840 }, 3841 "/$KEYDD_RE/" => { 3842 _vars => [ qw(display_name location color) ], 3843 _mandatory => [ qw(display_name color) ], 3844 _sections => [ qw(override) ], 3845 _doc => <<END_DOC, 3846Define some basic properties for the slave. 3847END_DOC 3848 display_name => { 3849 _doc => <<END_DOC, 3850Name of the Slave host. 3851END_DOC 3852 }, 3853 location => { 3854 _doc => <<END_DOC, 3855Where is the slave located. 3856END_DOC 3857 }, 3858 color => { 3859 _doc => <<END_DOC, 3860Color for the slave in graphs where input from multiple hosts is presented. 3861END_DOC 3862 _re => '[0-9a-f]{6}', 3863 _re_error => "I was expecting a color of the form rrggbb", 3864 }, 3865 override => { 3866 _doc => <<END_DOC, 3867If part of the configuration information must be overwritten to match the 3868settings of the you can specify this in this section. A setting is 3869overwritten by giving the full path of the configuration variable. If you 3870have this configuration in the Probes section: 3871 3872 *** Probes *** 3873 +FPing 3874 binary = /usr/sepp/bin/fping 3875 3876You can override it for a particular slave like this: 3877 3878 ++override 3879 Probes.FPing.binary = /usr/bin/fping 3880END_DOC 3881 _vars => [ '/\S+/' ], 3882 } 3883 } 3884 }, 3885 Targets => {_doc => <<DOC, 3886The Target Section defines the actual work of SmokePing. It contains a 3887hierarchical list of hosts which mark the endpoints of the network 3888connections the system should monitor. Each section can contain one host as 3889well as other sections. By adding slaves you can measure the connection to 3890an endpoint from multiple locations. 3891DOC 3892 _vars => [ qw(probe menu title remark alerts slaves menuextra parents) ], 3893 _mandatory => [ qw(probe menu title) ], 3894 _order => 1, 3895 _sections => [ "/$KEYD_RE/" ], 3896 _recursive => [ "/$KEYD_RE/" ], 3897 "/$KEYD_RE/" => $TARGETCOMMON, # this is just for documentation, _dyn() below replaces it 3898 probe => { 3899 _doc => <<DOC, 3900The name of the probe module to be used for this host. The value of 3901this variable gets propagated 3902DOC 3903 _sub => sub { 3904 my $val = shift; 3905 return "probe $val missing from the Probes section" 3906 unless $knownprobes{$val}; 3907 return undef; 3908 }, 3909 # create the syntax based on the selected probe. 3910 # see 2.1 above 3911 _dyn => sub { 3912 my ($name, $val, $grammar) = @_; 3913 3914 my $targetvars = _deepcopy($storedtargetvars{$val}); 3915 my @mandatory = @{$targetvars->{_mandatory}}; 3916 delete $targetvars->{_mandatory}; 3917 my @targetvars = sort keys %$targetvars; 3918 for (@targetvars) { 3919 # the default values for targetvars are only used in the Probes section 3920 delete $targetvars->{$_}{_default}; 3921 $grammar->{$_} = $targetvars->{$_}; 3922 } 3923 push @{$grammar->{_vars}}, @targetvars; 3924 my $g = { %{_deepcopy($TARGETCOMMON)}, %{_deepcopy($targetvars)} }; 3925 $grammar->{"/$KEYD_RE/"} = $g; 3926 $g->{_vars} = [ @{$g->{_vars}}, @targetvars ]; 3927 $g->{_inherited} = [ @{$g->{_inherited}}, @targetvars ]; 3928 # this makes the reference manual a bit less cluttered 3929 for (@targetvars){ 3930 $g->{$_}{_doc} = 'see above'; 3931 $grammar->{$_}{_doc} = 'see above'; 3932 delete $grammar->{$_}{_example}; 3933 delete $g->{$_}{_example}; 3934 } 3935 # make the mandatory variables mandatory only in sections 3936 # with 'host' defined 3937 # see 2.3 above 3938 $g->{host}{_dyn} = sub { 3939 my ($name, $val, $grammar) = @_; 3940 $grammar->{_mandatory} = [ @mandatory ]; 3941 }; 3942 }, # _dyn 3943 _dyndoc => $probelist, # all available probes 3944 }, #probe 3945 menu => { _doc => <<DOC }, 3946Menu entry for this section. If not set this will be set to the hostname. 3947DOC 3948 alerts => { _doc => <<DOC }, 3949A comma separated list of alerts to check for this target. The alerts have 3950to be setup in the Alerts section. Alerts are inherited by child nodes. Use 3951an empty alerts definition to remove inherited alerts from the current target 3952and its children. 3953 3954DOC 3955 title => { _doc => <<DOC }, 3956Title of the page when it is displayed. This will be set to the hostname if 3957left empty. 3958DOC 3959 3960 remark => { _doc => <<DOC }, 3961An optional remark on the current section. It gets displayed on the webpage. 3962DOC 3963 slaves => { _doc => <<DOC }, 3964List of slave servers. It gets inherited by all targets. 3965DOC 3966 menuextra => { _doc => <<DOC }, 3967HTML String to be added to the end of each menu entry. The C<{HOST}> entry will be replaced by the 3968host property of the relevant section. The C<{CLASS}> entry will be replaced by the same 3969class as the other tags in the manu line. 3970DOC 3971 3972 } 3973 3974 } 3975 ); 3976 return $parser; 3977} 3978 3979sub get_config ($$){ 3980 my $parser = shift; 3981 my $cfgfile = shift; 3982 3983 my $cfg = $parser->parse( $cfgfile ) or die "ERROR: $parser->{err}\n"; 3984 # lets have defaults for multihost colors 3985 if (not $cfg->{Presentation}{multihost} or not $cfg->{Presentation}{multihost}{colors}){ 3986 $cfg->{Presentation}{multihost}{colors} = "004586 ff420e ffde20 579d1c 7e0021 83caff 314004 aecf00 4b1f6f ff950e c5000b 0084d1"; 3987 } 3988 return $cfg; 3989 3990 3991} 3992 3993sub kill_smoke ($$) { 3994 my $pidfile = shift; 3995 my $signal = shift; 3996 if (defined $pidfile){ 3997 if ( -f $pidfile && open PIDFILE, "<$pidfile" ) { 3998 <PIDFILE> =~ /(\d+)/; 3999 my $pid = $1; 4000 if ($signal == SIGINT || $signal == SIGTERM) { 4001 kill $signal, $pid if kill 0, $pid; 4002 sleep 3; # let it die 4003 die "ERROR: Can not stop running instance of SmokePing ($pid)\n" 4004 if kill 0, $pid; 4005 } else { 4006 die "ERROR: no instance of SmokePing running (pid $pid)?\n" 4007 unless kill 0, $pid; 4008 kill $signal, $pid; 4009 } 4010 close PIDFILE; 4011 } else { 4012 die "ERROR: Can not read pid from $pidfile: $!\n"; 4013 }; 4014 } 4015} 4016 4017sub daemonize_me ($) { 4018 my $pidfile = shift; 4019 if (defined $pidfile){ 4020 if (-f $pidfile ) { 4021 open PIDFILE, "<$pidfile"; 4022 <PIDFILE> =~ /(\d+)/; 4023 close PIDFILE; 4024 my $pid = $1; 4025 die "ERROR: I Quit! Another copy of $0 ($pid) seems to be running.\n". 4026 " Check $pidfile\n" 4027 if kill 0, $pid; 4028 } 4029 } 4030 print "Warning: no logging method specified. Messages will be lost.\n" 4031 unless $logging; 4032 print "Daemonizing $0 ...\n"; 4033 defined (my $pid = fork) or die "Can't fork: $!"; 4034 if ($pid) { 4035 exit; 4036 } else { 4037 if(open(PIDFILE,">$pidfile")){ 4038 print PIDFILE "$$\n"; 4039 close PIDFILE; 4040 } else { 4041 warn "creating $pidfile: $!\n"; 4042 }; 4043 require POSIX; 4044 &POSIX::setsid or die "Can't start a new session: $!"; 4045 open STDOUT,'>/dev/null' or die "ERROR: Redirecting STDOUT to /dev/null: $!"; 4046 open STDIN, '</dev/null' or die "ERROR: Redirecting STDIN from /dev/null: $!"; 4047 open STDERR, '>/dev/null' or die "ERROR: Redirecting STDERR to /dev/null: $!"; 4048 # send warnings and die messages to log 4049 $SIG{__WARN__} = sub { do_log ((shift)."\n") }; 4050 $SIG{__DIE__} = sub { return if $^S; do_log ((shift)."\n"); exit 1 }; 4051 } 4052} 4053 4054# pseudo log system object 4055{ 4056 my $use_syslog; 4057 my $use_cgilog; 4058 my $use_debuglog; 4059 my $use_filelog; 4060 4061 my $syslog_facility; 4062 my $syslog_priority = $DEFAULTPRIORITY; 4063 4064 sub initialize_debuglog (){ 4065 $use_debuglog = 1; 4066 } 4067 4068 sub initialize_cgilog (){ 4069 $use_cgilog = 1; 4070 $logging=1; 4071 return if $cfg->{General}{changecgiprogramname} eq 'no'; 4072 # set_progname() is available starting with CGI.pm-2.82 / Perl 5.8.1 4073 # so trap this inside 'eval' 4074 # even this apparently isn't enough for older versions that try to 4075 # find out whether they are inside an eval...oh well. 4076 eval 'CGI::Carp::set_progname($0 . " [client " . ($ENV{REMOTE_ADDR}||"(unknown)") . "]")'; 4077 } 4078 4079 sub initialize_filelog ($){ 4080 $use_filelog = shift; 4081 $logging=1; 4082 } 4083 4084 sub initialize_syslog ($$) { 4085 my $fac = shift; 4086 my $pri = shift; 4087 $use_syslog = 1; 4088 $logging=1; 4089 die "missing facility?" unless defined $fac; 4090 $syslog_facility = $fac if defined $fac; 4091 $syslog_priority = $pri if defined $pri; 4092 print "Note: logging to syslog as $syslog_facility/$syslog_priority.\n"; 4093 openlog(basename($0), 'pid', $syslog_facility); 4094 eval { 4095 syslog($syslog_priority, 'Starting syslog logging'); 4096 }; 4097 if ($@) { 4098 print "Warning: can't connect to syslog. Messages will be lost.\n"; 4099 print "Error message was: $@"; 4100 } 4101 } 4102 4103 sub do_syslog ($){ 4104 my $str = shift; 4105 $str =~ s,%,%%,g; 4106 eval { 4107 syslog("$syslog_facility|$syslog_priority", $str); 4108 }; 4109 # syslogd is probably dead if that failed 4110 # this message is most probably lost too, if we have daemonized 4111 # let's try anyway, it shouldn't hurt 4112 print STDERR qq(Can't log "$str" to syslog: $@) if $@; 4113 } 4114 4115 sub do_cgilog ($){ 4116 my $str = shift; 4117 print "<p>" , $str, "</p>\n"; 4118 warn $str, "\n"; # for the webserver log 4119 } 4120 4121 sub do_debuglog ($){ 4122 do_log(shift) if $use_debuglog; 4123 } 4124 4125 sub do_filelog ($){ 4126 open X,">>$use_filelog" or return; 4127 print X scalar localtime(time)," - ",shift,"\n"; 4128 close X; 4129 } 4130 4131 sub do_log (@){ 4132 my $string = join(" ", @_); 4133 chomp $string; 4134 do_syslog($string) if $use_syslog; 4135 do_cgilog($string) if $use_cgilog; 4136 do_filelog($string) if $use_filelog; 4137 print STDERR $string,"\n" unless $logging; 4138 } 4139 4140} 4141 4142########################################################################### 4143# The Main Program 4144########################################################################### 4145 4146sub load_cfg ($;$) { 4147 my $cfgfile = shift; 4148 my $noinit = shift; 4149 my $cfmod = (stat $cfgfile)[9] || die "ERROR: loading smokeping configuration file $cfgfile: $!\n"; 4150 # when running under speedy this will prevent reloading on every run 4151 # if cfgfile has been modified we will still run. 4152 if (not defined $cfg or not defined $probes # or $cfg->{__last} < $cfmod 4153 ){ 4154 $cfg = undef; 4155 my $parser = get_parser; 4156 $cfg = get_config $parser, $cfgfile; 4157 4158 if (defined $cfg->{Presentation}{charts}){ 4159 require Storable; 4160 die "ERROR: Could not load Storable Support. This is required for the Charts feature - $@\n" if $@; 4161 load_sorters $cfg->{Presentation}{charts}; 4162 } 4163 #initiate a connection to InfluxDB (if needed) 4164 if(! defined $influx && defined $cfg->{'InfluxDB'}{'host'}) { 4165 do_log("DBG: Setting up a new InfluxDB connection"); 4166 my $rc = eval 4167 { 4168 require InfluxDB::HTTP; 4169 InfluxDB::HTTP->import(); 4170 require InfluxDB::LineProtocol; 4171 InfluxDB::LineProtocol->import(qw(data2line precision=ms)); 4172 1; 4173 }; 4174 die "ERROR: Could not import InfluxDB modules, but InfluxDB host was configured: $@\n" if ! $rc; 4175 4176 $influx = InfluxDB::HTTP->new( 4177 host => $cfg->{'InfluxDB'}{'host'}, 4178 port => $cfg->{'InfluxDB'}{'port'}, 4179 timeout => $cfg->{'InfluxDB'}{'timeout'} 4180 ); 4181 if (defined $cfg->{'InfluxDB'}{'username'} && defined $cfg->{'InfluxDB'}{'password'}) { 4182 do_log("DBG: Setting credentials for InfluxDB connection"); 4183 my $ua = $influx->get_lwp_useragent(); 4184 $ua->credentials( 4185 $cfg->{'InfluxDB'}{'host'} . ':' . $cfg->{'InfluxDB'}{'port'}, 4186 'InfluxDB', 4187 $cfg->{'InfluxDB'}{'username'}, 4188 $cfg->{'InfluxDB'}{'password'} 4189 ); 4190 } 4191 } 4192 $cfg->{__parser} = $parser; 4193 $cfg->{__last} = $cfmod; 4194 $cfg->{__cfgfile} = $cfgfile; 4195 $probes = undef; 4196 $probes = load_probes $cfg; 4197 $cfg->{__probes} = $probes; 4198 $cfg->{__hierarchies} = {}; 4199 return if $noinit; 4200 init_alerts $cfg if $cfg->{Alerts}; 4201 add_targets $cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir}; 4202 init_target_tree $cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir}; 4203 if (defined $cfg->{General}{precreateperms} && !$cgimode) { 4204 make_cgi_directories($cfg->{Targets}, dyndir($cfg), 4205 $cfg->{General}{precreateperms}); 4206 } 4207 #use Data::Dumper; 4208 #die Dumper $cfg->{__hierarchies}; 4209 } else { 4210 do_log("Config file unmodified, skipping reload") unless $cgimode; 4211 } 4212} 4213 4214 4215sub makepod ($){ 4216 my $parser = shift; 4217 my $e='='; 4218 my $a='@'; 4219 my $retval = <<POD; 4220 4221${e}head1 NAME 4222 4223smokeping_config - Reference for the SmokePing Config File 4224 4225${e}head1 OVERVIEW 4226 4227SmokePing takes its configuration from a single central configuration file. 4228Its location must be hardcoded in the smokeping script and smokeping.cgi. 4229 4230The contents of this manual is generated directly from the configuration 4231file parser. 4232 4233The Parser for the Configuration file is written using David Schweikert 4234Config::Grammar module. Read all about it in L<Config::Grammar>. 4235 4236The Configuration file has a tree-like structure with section headings at 4237various levels. It also contains variable assignments and tables. 4238 4239Warning: this manual is rather long. See L<smokeping_examples> 4240for simple configuration examples. 4241 4242${e}head1 REFERENCE 4243 4244${e}head2 GENERAL SYNTAX 4245 4246The text below describes the general syntax of the SmokePing configuration file. 4247It was copied from the Config::Grammar documentation. 4248 4249'#' denotes a comment up to the end-of-line, empty lines are allowed and space 4250at the beginning and end of lines is trimmed. 4251 4252'\\' at the end of the line marks a continued line on the next line. A single 4253space will be inserted between the concatenated lines. 4254 4255'${a}include filename' is used to include another file. 4256 4257'${a}define a some value' will replace all occurrences of 'a' in the following text 4258with 'some value'. 4259 4260Fields in tables that contain white space can be enclosed in either C<'> or C<">. 4261Whitespace can also be escaped with C<\\>. Quotes inside quotes are allowed but must 4262be escaped with a backslash as well. 4263 4264${e}head2 SPECIFIC SYNTAX 4265 4266The text below describes the specific syntax of the SmokePing configuration file. 4267 4268POD 4269 4270 $retval .= $parser->makepod; 4271 $retval .= <<POD; 4272 4273${e}head1 SEE ALSO 4274 4275L<smokeping(1)>,L<smokeping_master_slave(7)>,L<smokeping_cgi(1)> 4276 4277Matchers: 4278 4279L<Smokeping_matchers_Avgratio(3)>, L<Smokeping_matchers_CheckLatency(3)>, 4280L<Smokeping_matchers_CheckLoss(3)>, L<Smokeping_matchers_ExpLoss(3)>, 4281L<Smokeping_matchers_Median(3)>, L<Smokeping_matchers_Medratio(3)>, 4282L<Smokeping_matchers_base(3)> 4283 4284Probes: 4285 4286L<Smokeping_probes_CiscoRTTMonDNS(3)>, 4287L<Smokeping_probes_CiscoRTTMonEchoICMP(3)>, 4288L<Smokeping_probes_CiscoRTTMonTcpConnect(3)>, L<Smokeping_probes_Curl(3)>, 4289L<Smokeping_probes_DNS(3)>, L<Smokeping_probes_DismanPing(3)>, 4290L<Smokeping_probes_EchoPing(3)>, L<Smokeping_probes_EchoPingChargen(3)>, 4291L<Smokeping_probes_EchoPingDNS(3)>, L<Smokeping_probes_EchoPingDiscard(3)>, 4292L<Smokeping_probes_EchoPingHttp(3)>, L<Smokeping_probes_EchoPingHttps(3)>, 4293L<Smokeping_probes_EchoPingIcp(3)>, L<Smokeping_probes_EchoPingLDAP(3)>, 4294L<Smokeping_probes_EchoPingPlugin(3)>, L<Smokeping_probes_EchoPingSmtp(3)>, 4295L<Smokeping_probes_EchoPingWhois(3)>, L<Smokeping_probes_FPing(3)>, 4296L<Smokeping_probes_FPing6(3)>, L<Smokeping_probes_FPingContinuous(3)>, 4297L<Smokeping_probes_FTPtransfer(3)>, L<Smokeping_probes_IOSPing(3)>, 4298L<Smokeping_probes_IRTT(3)>, L<Smokeping_probes_LDAP(3)>, 4299L<Smokeping_probes_NFSping(3)>, L<Smokeping_probes_OpenSSHEOSPing(3)>, 4300L<Smokeping_probes_OpenSSHJunOSPing(3)>, L<Smokeping_probes_Qstat(3)>, 4301L<Smokeping_probes_Radius(3)>, L<Smokeping_probes_RemoteFPing(3)>, 4302L<Smokeping_probes_SSH(3)>, L<Smokeping_probes_SendEmail(3)>, 4303L<Smokeping_probes_SipSak(3)>, L<Smokeping_probes_TCPPing(3)>, 4304L<Smokeping_probes_TacacsPlus(3)>, L<Smokeping_probes_TelnetIOSPing(3)>, 4305L<Smokeping_probes_TelnetJunOSPing(3)>, L<Smokeping_probes_TraceroutePing(3)>, 4306L<Smokeping_probes_WebProxyFilter(3)>, L<Smokeping_probes_base(3)>, 4307L<Smokeping_probes_basefork(3)>, L<Smokeping_probes_basevars(3)>, 4308L<Smokeping_probes_passwordchecker(3)>, L<Smokeping_probes_skel(3)> 4309 4310Sorters: 4311 4312L<Smokeping_sorters_Loss(3)>, L<Smokeping_sorters_Max(3)>, 4313L<Smokeping_sorters_Median(3)>, L<Smokeping_sorters_StdDev(3)>, 4314L<Smokeping_sorters_base(3)> 4315 4316${e}head1 COPYRIGHT 4317 4318Copyright (c) 2001-2007 by Tobias Oetiker. All right reserved. 4319 4320${e}head1 LICENSE 4321 4322This program is free software; you can redistribute it 4323and/or modify it under the terms of the GNU General Public 4324License as published by the Free Software Foundation; either 4325version 2 of the License, or (at your option) any later 4326version. 4327 4328This program is distributed in the hope that it will be 4329useful, but WITHOUT ANY WARRANTY; without even the implied 4330warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 4331PURPOSE. See the GNU General Public License for more 4332details. 4333 4334You should have received a copy of the GNU General Public 4335License along with this program; if not, write to the Free 4336Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 433702139, USA. 4338 4339${e}head1 AUTHOR 4340 4341Tobias Oetiker E<lt>tobi\@oetiker.chE<gt> 4342 4343${e}cut 4344POD 4345 4346} 4347sub cgi ($$) { 4348 my $cfgfile = shift; 4349 my $q = shift; 4350 $cgimode = 'yes'; 4351 umask 022; 4352 load_cfg $cfgfile; 4353 initialize_cgilog(); 4354 if ($q->param(-name=>'slave')) { # a slave is calling in 4355 Smokeping::Master::answer_slave($cfg,$q); 4356 } elsif ($q->param(-name=>'secret') && $q->param(-name=>'target') ) { 4357 my $ret = update_dynaddr $cfg,$q; 4358 if (defined $ret and $ret ne "") { 4359 print $q->header(-status => "404 Not Found"); 4360 do_cgilog("Updating DYNAMIC address failed: $ret"); 4361 } else { 4362 print $q->header; # no HTML output on success 4363 } 4364 } else { 4365 if (not $q->param('displaymode') or $q->param('displaymode') ne 'a'){ #in ayax mode we do not issue a header YET 4366 } 4367 display_webpage $cfg,$q; 4368 } 4369 if ((stat $cfgfile)[9] > $cfg->{__last}){ 4370 # we die if the cfgfile is newer than our in memory copy 4371 kill -9, $$; 4372 } 4373} 4374 4375 4376sub gen_page ($$$); 4377sub gen_page ($$$) { 4378 my ($cfg, $tree, $open) = @_; 4379 my ($q, $name, $page); 4380 4381 $q = bless \$q, 'dummyCGI'; 4382 4383 $name = @$open ? join('.', @$open) . ".html" : "index.html"; 4384 4385 die "Can not open $cfg-{General}{pagedir}/$name for writing: $!" unless 4386 open PAGEFILE, ">$cfg->{General}{pagedir}/$name"; 4387 4388 my $step = $probes->{$tree->{probe}}->step(); 4389 my $readversion = "?"; 4390 $VERSION =~ /(\d+)\.(\d{3})(\d{3})/ and $readversion = sprintf("%d.%d.%d",$1,$2,$3); 4391 my $authuser = $ENV{REMOTE_USER} || 'Guest'; 4392 $page = fill_template 4393 ($cfg->{Presentation}{template}, 4394 { 4395 menu => target_menu($cfg->{Targets}, 4396 [@$open], #copy this because it gets changed 4397 "", '',".html"), 4398 title => $tree->{title}, 4399 remark => ($tree->{remark} || ''), 4400 overview => get_overview( $cfg,$q,$tree,$open ), 4401 body => get_detail( $cfg,$q,$tree,$open ), 4402 target_ip => ($tree->{host} || ''), 4403 owner => $cfg->{General}{owner}, 4404 contact => $cfg->{General}{contact}, 4405 author => '<A HREF="http://tobi.oetiker.ch/">Tobi Oetiker</A> and Niko Tyni', 4406 smokeping => '<A HREF="http://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'">SmokePing-'.$readversion.'</A>', 4407 step => $step, 4408 rrdlogo => '<A HREF="http://oss.oetiker.ch/rrdtool/"><img alt="RRDtool" src="'.$cfg->{General}{imgurl}.'/rrdtool.png"></a>', 4409 smokelogo => '<A HREF="http://oss.oetiker.ch/smokeping/counter.cgi/'.$VERSION.'"><img alt="Smokeping" src="'.$cfg->{General}{imgurl}.'/smokeping.png"></a>', 4410 authuser => $authuser, 4411 }); 4412 4413 print PAGEFILE $page || "<HTML><BODY>ERROR: Reading page template ".$cfg->{Presentation}{template}."</BODY></HTML>"; 4414 close PAGEFILE; 4415 4416 foreach my $key (keys %$tree) { 4417 my $value = $tree->{$key}; 4418 next unless ref($value) eq 'HASH'; 4419 gen_page($cfg, $value, [ @$open, $key ]); 4420 } 4421} 4422 4423sub makestaticpages ($$) { 4424 my $cfg = shift; 4425 my $dir = shift; 4426 4427 # If directory is given, override current values (pagedir and and 4428 # imgurl) so that all generated data is in $dir. If $dir is undef, 4429 # use values from config file. 4430 if ($dir) { 4431 mkdir $dir, 0755 unless -d $dir; 4432 $cfg->{General}{pagedir} = $dir; 4433 $cfg->{General}{imgurl} = '.'; 4434 } 4435 4436 die "ERROR: No pagedir defined for static pages\n" 4437 unless $cfg->{General}{pagedir}; 4438 # Logos. 4439 gen_imgs($cfg); 4440 4441 # Iterate over all targets. 4442 my $tree = $cfg->{Targets}; 4443 gen_page($cfg, $tree, []); 4444} 4445 4446sub pages ($) { 4447 my ($config) = @_; 4448 umask 022; 4449 load_cfg($config); 4450 makestaticpages($cfg, undef); 4451} 4452 4453sub pod2man { 4454 my $string = shift; 4455 my $pid = open(P, "-|"); 4456 if ($pid) { 4457 pod2usage(-verbose => 2, -input => \*P); 4458 exit 0; 4459 } else { 4460 print $string; 4461 exit 0; 4462 } 4463} 4464 4465sub maybe_require { 4466 # like eval "require $class", but tries to 4467 # fake missing classes by adding them to %INC. 4468 # This rocks when we're building the documentation 4469 # so we don't need to have the external modules 4470 # installed. 4471 4472 my $class = shift; 4473 4474 # don't do the kludge unless we're building documentation 4475 unless (exists $opt{makepod} or exists $opt{man}) { 4476 eval "require $class"; 4477 die "require $class failed: $@" if $@; 4478 return; 4479 } 4480 4481 my %faked; 4482 4483 my $file = $class; 4484 $file =~ s,::,/,g; 4485 $file .= ".pm"; 4486 4487 eval "require $class"; 4488 4489 while ($@ =~ /Can't locate (\S+)\.pm/) { 4490 my $missing = $1; 4491 die("Can't fake missing class $missing, giving up. This shouldn't happen.") 4492 if $faked{$missing}++; 4493 $INC{"$missing.pm"} = "foobar"; 4494 $missing =~ s,/,::,; 4495 4496 delete $INC{"$file"}; # so we can redo the require() 4497 eval "require $class"; 4498 last unless $@; 4499 } 4500 die "require $class failed: $@" if $@; 4501 my $libpath = find_libdir; 4502 $INC{$file} = "$libpath/$file"; 4503} 4504 4505sub probedoc { 4506 my $class = shift; 4507 my $do_man = shift; 4508 maybe_require($class); 4509 if ($do_man) { 4510 pod2man($class->pod); 4511 } else { 4512 print $class->pod; 4513 } 4514 exit 0; 4515} 4516 4517sub verify_cfg { 4518 my $cfgfile = shift; 4519 get_config(get_parser, $cfgfile); 4520 print "Configuration file '$cfgfile' syntax OK.\n"; 4521} 4522 4523sub make_kid { 4524 my $sleep_count = 0; 4525 my $pid; 4526 do { 4527 $pid = fork; 4528 unless (defined $pid) { 4529 do_log("Fatal: cannot fork: $!"); 4530 die "bailing out" 4531 if $sleep_count++ > 6; 4532 sleep 10; 4533 } 4534 } until defined $pid; 4535 srand(); 4536 return $pid; 4537} 4538 4539sub start_probes { 4540 my $pids = shift; 4541 my $pid; 4542 my $myprobe; 4543 for my $p (keys %$probes) { 4544 if ($probes->{$p}->target_count == 0) { 4545 do_log("No targets defined for probe $p, skipping."); 4546 next; 4547 } 4548 $pid = make_kid(); 4549 $myprobe = $p; 4550 $pids->{$pid} = $p; 4551 last unless $pid; 4552 do_log("Child process $pid started for probe $p."); 4553 } 4554 return $pid; 4555} 4556 4557sub load_cfg_slave { 4558 my %opt = %{$_[0]}; 4559 die "ERROR: no shared-secret defined along with master-url\n" unless $opt{'shared-secret'}; 4560 die "ERROR: no cache-dir defined along with master-url\n" unless $opt{'cache-dir'}; 4561 die "ERROR: no cache-dir ($opt{'cache-dir'}): $!\n" unless -d $opt{'cache-dir'}; 4562 die "ERROR: the shared secret file ($opt{'shared-secret'}) is world-readable or writable" 4563 if ((stat($opt{'shared-secret'}))[2] & 6); 4564 open my $fd, "<$opt{'shared-secret'}" or die "ERROR: opening $opt{'shared-secret'} $!\n"; 4565 chomp(my $secret = <$fd>); 4566 close $fd; 4567 my $slave_cfg = { 4568 master_url => $opt{'master-url'}, 4569 cache_dir => $opt{'cache-dir'}, 4570 pid_dir => $opt{'pid-dir'} || $opt{'cache-dir'}, 4571 shared_secret => $secret, 4572 slave_name => $opt{'slave-name'} || hostname(), 4573 }; 4574 # this should get us an initial config set from the server 4575 my $new_conf = Smokeping::Slave::submit_results($slave_cfg,{}); 4576 if ($new_conf){ 4577 $cfg=$new_conf; 4578 $probes = undef; 4579 $probes = load_probes $cfg; 4580 $cfg->{__probes} = $probes; 4581 add_targets($cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir}); 4582 } else { 4583 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"; 4584 } 4585 return $slave_cfg; 4586} 4587 4588sub main (;$) { 4589 $cgimode = 0; 4590 umask 022; 4591 my $defaultcfg = shift; 4592 $opt{filter}=[]; 4593 GetOptions(\%opt, 'version', 'email', 'man:s','help','logfile=s','static-pages:s', 'debug-daemon', 4594 'nosleep', 'makepod:s','debug','restart', 'filter=s', 'nodaemon|nodemon', 4595 'config=s', 'check', 'gen-examples', 'reload', 4596 'master-url=s','cache-dir=s','shared-secret=s', 4597 'slave-name=s','pid-dir=s') or pod2usage(2); 4598 if($opt{version}) { print "$VERSION\n"; exit(0) }; 4599 if(exists $opt{man}) { 4600 if ($opt{man}) { 4601 if ($opt{man} eq 'smokeping_config') { 4602 pod2man(makepod(get_parser)); 4603 } else { 4604 probedoc($opt{man}, 'do_man'); 4605 } 4606 } else { 4607 pod2usage(-verbose => 2); 4608 } 4609 exit 0; 4610 } 4611 if($opt{help}) { pod2usage(-verbose => 1); exit 0 }; 4612 if(exists $opt{makepod}) { 4613 if ($opt{makepod} and $opt{makepod} ne 'smokeping_config') { 4614 probedoc($opt{makepod}); 4615 } else { 4616 print makepod(get_parser); 4617 } 4618 exit 0; 4619 } 4620 if (exists $opt{'gen-examples'}) { 4621 Smokeping::Examples::make($opt{check}); 4622 exit 0; 4623 } 4624 initialize_debuglog if $opt{debug} or $opt{'debug-daemon'}; 4625 my $slave_cfg; 4626 my $cfgfile = $opt{config} || $defaultcfg; 4627 my $slave_mode = exists $opt{'master-url'}; 4628 if ($slave_mode){ # ok we go slave-mode 4629 $slave_cfg = load_cfg_slave(\%opt); 4630 } else { 4631 if(defined $opt{'check'}) { verify_cfg($cfgfile); exit 0; } 4632 if($opt{reload}) { 4633 load_cfg $cfgfile, 'noinit'; # we need just the piddir 4634 kill_smoke $cfg->{General}{piddir}."/pid", SIGHUP; 4635 print "HUP signal sent to the running SmokePing process, exiting.\n"; 4636 exit 0; 4637 }; 4638 load_cfg $cfgfile; 4639 4640 if(defined $opt{'static-pages'}) { makestaticpages $cfg, $opt{'static-pages'}; exit 0 }; 4641 if($opt{email}) { enable_dynamic $cfg, $cfg->{Targets},"",""; exit 0 }; 4642 } 4643 if($opt{restart}) { kill_smoke $cfg->{General}{piddir}."/pid", SIGINT;}; 4644 4645 if($opt{logfile}) { initialize_filelog($opt{logfile}) }; 4646 4647 if (not keys %$probes) { 4648 do_log("No probes defined, exiting."); 4649 exit 1; 4650 } 4651 unless ($opt{debug} or $opt{nodaemon}) { 4652 if (defined $cfg->{General}{syslogfacility}) { 4653 initialize_syslog($cfg->{General}{syslogfacility}, 4654 $cfg->{General}{syslogpriority}); 4655 } 4656 daemonize_me $cfg->{General}{piddir}."/pid"; 4657 } 4658 do_log "Smokeping version $VERSION successfully launched."; 4659 4660RESTART: 4661 my $myprobe; 4662 my $multiprocessmode; 4663 my $forkprobes = $cfg->{General}{concurrentprobes} || 'yes'; 4664 if ($forkprobes eq "yes" and keys %$probes > 1 and not $opt{debug}) { 4665 $multiprocessmode = 1; 4666 my %probepids; 4667 my $pid; 4668 do_log("Entering multiprocess mode."); 4669 $pid = start_probes(\%probepids); 4670 $myprobe = $probepids{$pid}; 4671 goto KID unless $pid; # child skips rest of loop 4672 # parent 4673 do_log("All probe processes started successfully."); 4674 my $exiting = 0; 4675 my $reloading = 0; 4676 for my $sig (qw(INT TERM)) { 4677 $SIG{$sig} = sub { 4678 do_log("Got $sig signal, terminating child processes."); 4679 $exiting = 1; 4680 kill $sig, $_ for keys %probepids; 4681 my $now = time; 4682 while(keys %probepids) { # SIGCHLD handler below removes the keys 4683 if (time - $now > 2) { 4684 do_log("Fatal: can't terminate all child processes, giving up."); 4685 exit 1; 4686 } 4687 sleep 1; 4688 } 4689 do_log("All child processes successfully terminated, exiting."); 4690 exit 0; 4691 } 4692 }; 4693 $SIG{CHLD} = sub { 4694 while ((my $dead = waitpid(-1, WNOHANG)) > 0) { 4695 my $p = $probepids{$dead}; 4696 $p = 'unknown' unless defined $p; 4697 do_log("Child process $dead (probe $p) exited unexpectedly with status $?.") 4698 unless $exiting or $reloading; 4699 delete $probepids{$dead}; 4700 } 4701 }; 4702 my $gothup = 0; 4703 $SIG{HUP} = sub { 4704 do_debuglog("Got HUP signal."); 4705 $gothup = 1; 4706 }; 4707 while (1) { # just wait for the signals 4708 sleep; #sleep until we get a signal 4709 next unless $gothup; 4710 $reloading = 1; 4711 $gothup = 0; 4712 my $oldprobes = $probes; 4713 if ($slave_mode) { 4714 load_cfg_slave(\%opt); 4715 } else { 4716 $reloading = 0, next unless reload_cfg($cfgfile); 4717 } 4718 do_debuglog("Restarting probe processes " . join(",", keys %probepids) . "."); 4719 kill SIGHUP, $_ for (keys %probepids); 4720 my $i=0; 4721 while (keys %probepids) { 4722 sleep 1; 4723 if ($i % 10 == 0) { 4724 do_log("Waiting for child processes to terminate."); 4725 } 4726 $i++; 4727 my %termsent; 4728 for (keys %probepids) { 4729 my $step = $oldprobes->{$probepids{$_}}->step; 4730 if ($i > $step) { 4731 do_log("Child process $_ took over its step value to terminate, killing it with SIGTERM"); 4732 if (kill SIGTERM, $_ == 0 and exists $probepids{$_}) { 4733 do_log("Fatal: Child process $_ has disappeared? This shouldn't happen. Giving up."); 4734 exit 1; 4735 } else { 4736 $termsent{$_} = time; 4737 } 4738 } 4739 for (keys %termsent) { 4740 if (exists $probepids{$_}) { 4741 if (time() - $termsent{$_} > 2) { 4742 do_log("Fatal: Child process $_ took over 2 seconds to exit on TERM signal. Giving up."); 4743 exit 1; 4744 } 4745 } else { 4746 delete $termsent{$_}; 4747 } 4748 } 4749 } 4750 } 4751 $reloading = 0; 4752 do_log("Child processes terminated, restarting with new configuration."); 4753 $SIG{CHLD} = 'DEFAULT'; # restore 4754 goto RESTART; 4755 } 4756 do_log("Exiting abnormally - this should not happen."); 4757 exit 1; # not reached 4758 } else { 4759 $multiprocessmode = 0; 4760 if ($forkprobes ne "yes") { 4761 do_log("Not entering multiprocess mode because the 'concurrentprobes' variable is not set."); 4762 for my $p (keys %$probes) { 4763 for my $what (qw(offset step)) { 4764 do_log("Warning: probe-specific parameter '$what' ignored for probe $p in single-process mode." ) 4765 if defined $cfg->{Probes}{$p}{$what}; 4766 } 4767 } 4768 } elsif ($opt{debug}) { 4769 do_debuglog("Not entering multiprocess mode with '--debug'. Use '--debug-daemon' for that.") 4770 } elsif (keys %$probes == 1) { 4771 do_log("Not entering multiprocess mode for just a single probe."); 4772 $myprobe = (keys %$probes)[0]; # this way we won't ignore a probe-specific step parameter 4773 } 4774 } 4775KID: 4776 my $offset; 4777 my $step; 4778 my $gothup = 0; 4779 my $changeprocessnames = $cfg->{General}{changeprocessnames} ne "no"; 4780 $SIG{HUP} = sub { 4781 do_log("Got HUP signal, " . ($multiprocessmode ? "exiting" : "restarting") . " gracefully."); 4782 $gothup = 1; 4783 }; 4784 for my $sig (qw(INT TERM)) { 4785 $SIG{$sig} = sub { 4786 do_log("got $sig signal, terminating."); 4787 exit 1; 4788 } 4789 } 4790 if (defined $myprobe) { 4791 $offset = $probes->{$myprobe}->offset() || 'random'; 4792 $step = $probes->{$myprobe}->step(); 4793 $0 .= " [$myprobe]" if $changeprocessnames; 4794 } else { 4795 $offset = $cfg->{General}{offset} || 'random'; 4796 $step = $cfg->{Database}{step}; 4797 } 4798 if ($offset eq 'random'){ 4799 $offset = int(rand($step)); 4800 } else { 4801 $offset =~ s/%$//; 4802 $offset = $offset / 100 * $step; 4803 } 4804 for (keys %$probes) { 4805 next if defined $myprobe and $_ ne $myprobe; 4806 # fill this in for report_probes() below 4807 $probes->{$_}->offset_in_seconds($offset); # this is just for humans 4808 if ($opt{debug} or $opt{'debug-daemon'}) { 4809 $probes->{$_}->debug(1) if $probes->{$_}->can('debug'); 4810 } 4811 } 4812 4813 report_probes($probes, $myprobe); 4814 4815 my $now = Time::HiRes::time(); 4816 my $longprobe = 0; 4817 while (1) { 4818 unless ($opt{nosleep} or $opt{debug}) { 4819 my $sleeptime = $step - fmod($now-$offset, $step); 4820 my $logmsg = "Sleeping $sleeptime seconds."; 4821 if ($longprobe && $step-$sleeptime < 0.3) { 4822 $logmsg = "NOT sleeping $sleeptime seconds, running probes immediately."; 4823 $sleeptime = 0; 4824 } 4825 if (defined $myprobe) { 4826 $probes->{$myprobe}->do_debug($logmsg); 4827 } else { 4828 do_debuglog($logmsg); 4829 } 4830 if ($sleeptime > 0) { 4831 Time::HiRes::sleep($sleeptime); 4832 } 4833 last if checkhup($multiprocessmode, $gothup) && reload_cfg($cfgfile); 4834 } 4835 my $startts = Time::HiRes::time(); 4836 run_probes $probes, $myprobe; # $myprobe is undef if running without 'concurrentprobes' 4837 my %sortercache; 4838 if ($opt{'master-url'}){ 4839 my $new_conf = Smokeping::Slave::submit_results $slave_cfg,$cfg,$myprobe,$probes; 4840 if ($new_conf && !$gothup){ 4841 do_log('server has new config for me ... HUPing the parent'); 4842 kill_smoke $cfg->{General}{piddir}."/pid", SIGHUP; 4843 # wait until the parent signals back if it didn't already 4844 sleep if (!$gothup); 4845 if (!$gothup) { 4846 do_log("Got an unexpected signal while waiting for SIGHUP, exiting"); 4847 exit 1; 4848 } 4849 if (!$multiprocessmode) { 4850 load_cfg_slave(\%opt); 4851 last; 4852 } 4853 } 4854 } else { 4855 update_rrds $cfg, $probes, $cfg->{Targets}, $cfg->{General}{datadir}, $myprobe, \%sortercache; 4856 save_sortercache($cfg,\%sortercache,$myprobe); 4857 } 4858 exit 0 if $opt{debug}; 4859 $now = Time::HiRes::time(); 4860 my $runtime = $now - $startts; 4861 $longprobe = 0; 4862 if ($runtime > $step) { 4863 $longprobe = 1; 4864 my $warn = "WARNING: smokeping took $runtime seconds to complete 1 round of polling. ". 4865 "It should complete polling in $step seconds. ". 4866 "You may have unresponsive devices in your setup.\n"; 4867 if (defined $myprobe) { 4868 $probes->{$myprobe}->do_log($warn); 4869 } else { 4870 do_log($warn); 4871 } 4872 } 4873 elsif ($runtime > $step * 0.8) { 4874 $longprobe = 1; 4875 my $warn = "NOTE: smokeping took $runtime seconds to complete 1 round of polling. ". 4876 "This is over 80% of the max time available for a polling cycle ($step seconds).\n"; 4877 if (defined $myprobe) { 4878 $probes->{$myprobe}->do_log($warn); 4879 } else { 4880 do_log($warn); 4881 } 4882 } 4883 last if checkhup($multiprocessmode, $gothup) && reload_cfg($cfgfile); 4884 } 4885 $0 =~ s/ \[$myprobe\]$// if $changeprocessnames; 4886 goto RESTART; 4887} 4888 4889sub checkhup ($$) { 4890 my $multiprocessmode = shift; 4891 my $gothup = shift; 4892 if ($gothup) { 4893 if ($multiprocessmode) { 4894 do_log("Exiting due to HUP signal."); 4895 exit 0; 4896 } else { 4897 do_log("Restarting due to HUP signal."); 4898 return 1; 4899 } 4900 } 4901 return 0; 4902} 4903 4904sub reload_cfg ($) { 4905 my $cfgfile = shift; 4906 return 1 if exists $opt{'master-url'}; 4907 my ($oldcfg, $oldprobes) = ($cfg, $probes); 4908 do_log("Reloading configuration."); 4909 $cfg = undef; 4910 $probes = undef; 4911 eval { load_cfg($cfgfile) }; 4912 if ($@) { 4913 do_log("Reloading configuration from $cfgfile failed: $@"); 4914 ($cfg, $probes) = ($oldcfg, $oldprobes); 4915 return 0; 4916 } 4917 return 1; 4918} 4919 4920 4921sub gen_imgs ($){ 4922 4923 my $cfg = shift; 4924 my $modulemodtime; 4925 for (@INC) { 4926 ( -f "$_/Smokeping.pm" ) or next; 4927 $modulemodtime = (stat _)[9]; 4928 last; 4929 } 4930 if (not -r $cfg->{General}{imgcache}."/rrdtool.png" or 4931 (defined $modulemodtime and $modulemodtime > (stat _)[9])){ 4932open W, ">".$cfg->{General}{imgcache}."/rrdtool.png" 4933 or do { warn "WARNING: creating $cfg->{General}{imgcache}/rrdtool.png: $!\n"; return 0 }; 4934binmode W; 4935print W unpack ('u', <<'UUENC'); 4936&B5!.1PT* 4937"&@H` 4938M````#4E(1%(```!D````'@@#````[85+P0```;Q03%1%3$Q,;8_U;I#X2TM+ 4939M2TI'34U-;Y/_;I'[145%3$M)1T=';8_W<)7_;I+]34U/6F^N2DI*;I#Z24E) 4940M/S\_:(3<6&F=5%QVX.#@9X+3;([S;(WQ5%142TI%7GK.R<G)6&:-4EIP4E)2 4941M4%!02DE$1T4\:8KLGY^?66>13D]02DA`L;&Q4&&3:(;@9X/9Q<7%;&QL7EY> 4942M0T-#2DA"M+2TF9F9AX>'9F9F4%1A8&!@/#P\K*RLJ:FII*2DG)R<46*6>WM[ 4943M='1T248]2$0W-#0T:(?DVMK:U-349(#1E965BHJ*@8&!?GY^=W=W45=J:6EI 4944M8V-C3U)=65E93E!62TQ0M[>W7W.Q6VR@.3DY<9C_ZNKJ:8CG8'C`O;V]7G*L 4945MDI*2C8V-<7%Q;FYN7%Q<35!:;I+^\/#P9H;G9X7>W=W=U]?79'_.@X.#4%5D 4946M3$Y5]?7UXN+B6VZH56FE6VN;5V>5CX^/5%^!351GY^?G8GS+87K&87>Z7G2U 4947MK:VM5V2,3UV)3%!?5E965555_?W]Y.3DS\_/56*&3UM^3UEW:8OTR\O+56.0 4948M5F!^1T9"87[89X+5S<W-1T$P1T$N56ZV4V&-Q*CET```!GE)1$%42,><U,V+ 4949<VD`4`/"9,68(F;A-<665E`;<H%)SR<7;@B)X"@`` 4950MA$B"*)X4A47!#RRK8GO:#_:+;?L/]ST'=5NEAPY(,L_)_-Z;IR$PSAB5@PUB 4951MDB`D>6[L`S,%%J0^JW+JQ'Z28&#ST.9G3?+O<7G!*?L$-P=$U^'#A+U',$!9 4952MRSX@.#TO(E)0J?@/Q*G7<W@5(2(RD-T&)`(),`:L^J)`&A+1Y/.)A);`ZV%V 4953I&M';FW%ODH--^OX68>W'\;B;P^1M;8MDZ^DASKFOA:,9(.M1!:NR@@H` 4954MC-"2>VD?<!8TE1,(*]N6]A8#PK]())W):S\F64!^6HB8KO^6C[)8"XF'=08- 4955M<LN^1A+VTDVGW6A4Q+KRP9WK#MW&/$B=1*I>J4MU:OQ*2`0"7H3(%!%4%:U9 4956M9E"2O18,2^3"UI2",$Q598(6B$84?]DRN3"X&&;R)XZK6RC,AAQ:$,A*MH&V 4957J"8D'9(>06H?".)^@`9II7\X%W*Q6*N7.)DGR90[AJ,ZIZOK*4>.9*H0* 4958MF(C&B+P+=,<'Q)IA5P:C^8I3XV9>"'WD7KS4JTG5QM?2'+K*-M7;-J.B>XSH 4959M')*&_-<I(A'=Q(#N1(0<(35E`XV??/2\=18RO[=2!0$[9*I#-&LDO#:IL>H= 4960M'5?N^J(/2+I")`(!%Q16#]\C5=R4GGF[_TFI`_-<D6B+%J6M)\L%Q"F1H&%2 4961M-KBO_=WX^F+4X="`L2815KZM+#'0?(\\I[>-U_;(D@(2D@\+L4<&GD0>%D=( 4962M.5.-8:%Q'4H$]JQ%*J5F(R41T[5+M3BG;]T=XJVPDB1)S1%9Y'>5X'%U@LL3 4963MR.,#+.$'I'KE,&"3$F'.U;<&=D2?*EN$-RI5;XH]F9:*,63QZE>Q4`8]*3/: 4964M[Q9/()8205?$W1ZQO(X!ZE0BD#$08/1!101RSMJU`5[O%U!A*U:TG@.5-I[Q 49658G/OGW@E$\2;X>S**.T0I13H&%(G(83@* 4966MOCR>!$Y46^EQ6,,89'?S72/6%)_@^%6W1/Y$?G=2]B]+0U$<OWF]>;T1K2U8 4967ML!AMUM`5<V,OZ#;3,LV7Y1`DD<2WBC1+^T%Z^D'JL:<7BB#ZC[LKS>JIH`[[ 4968MX9SO[OE^[AF[-Q&+(/&+YTZ?BIU\'$%B9Q]2X?;5Q*E8XG$$B45Q]O[-.RD0 4969M0>[=/4GMZ(D']YXGHOD2=^]%],R;$S%:GKW\Y@:@$.JW@SR[=N7*"[J/U#N: 4970M7'NR%S)O:7*%)E2@;UZ\O'0]ONW)W#OS_.XSAF:IS/-;MYY^S'S3X8VWYQ\] 4971M^O`Y&5V=+ZY=N?9LVY",Q^/)71+_DT`EJNWC0NK"MDZE4A?V>I*6R1^-_S4@ 4972M^/\@QXT@9(X[X@U@_N;#PJ^M[._V!>L_4`P91(':0?A]\1;(9)7!9.\(T*][ 4973M:+:C=<)Q.QKD51X0C`E"F,5-CR$$M&NM^AC3#-->@G(K0E'DM2<6Y&\$0L)A 4974M#F,68<)B"%B,,9.?EG#4ZQ%(C5C:R>#`WT$><'+@NF,NWUC91SY;4D;>,%?2 4975M2Y.Y6Y?A7"GUF]%4N+_2;(2C%F=85!5]/AR2@6]90GI<\UVG_,DIN$4HU/&D 4976M/EJ7(*[;`[[V'9+7-451LV/-SBX%@P^<CCTQBY9F#9826=9"U\8`<=G*`S,- 4977MAW2F0]743=L0.S96[$;?!@71[GM86P\LWL@=T)79OI;+B8V`S^TAK5F742U' 4978MK)<6NC%M!-7F1"W6-+W<DXBHC%0+`Q)JA4*?`4<L@+*E.9T5%AN0Z/6YYI." 4979;5VYVVN*`=%]Q.9[+5O-ZO]BF=@_T'R#5,O(* 498000&D$8T368=-A'+58J,E="@`` 4981M>9]MZ!L(N,)1%KM*M04II%$;.4):'!%=;.N*SUI>?FX>OL\RW<57R.NRX#:0 4982M8@=C9@]Q^#91!W,W%(!A''!MA@TI9!!!<$]H0P0`5^L5.7Q0X0!@<J^+<AHC 4983,<81K6M>H*D11RTT* 4984M&<'OD,VZV>JT!,CN_RY87$P+K*,M>7Y67E9XWFQUFKXEEQ>2,:5E!P/(K@^F 4985MO4EEFJ:3#*G6'W\J,91:G4RY6F766Y5G)4@_5]CCQI7RH3G7-9Y?*F`;`@1H 49866(Z0YLX%D;F$.&9050X32,H`24_0Q"@`` 4987M9P8`,"T)&R@)=!)'[**16D((T%J"DF2Y4$!0HK4`D10]0,Z++2+GCWX]L!.Q 4988MX\]:K:KJN4UCI^)JQU.#GR^%0[/JJRL![FK)\HSC]T,P,_UJCF9?`'&L38BX 4989/N=]>`````$E%3D2N0F"" 4990UUENC 4991close W; 4992} 4993 4994 if (not -r $cfg->{General}{imgcache}."/smokeping.png" or 4995 (defined $modulemodtime and $modulemodtime > (stat _)[9])){ 4996open W, ">".$cfg->{General}{imgcache}."/smokeping.png" 4997 or do { warn "WARNING: creating $cfg->{General}{imgcache}/smokeping.png: $!\n"; return 0}; 4998binmode W; 4999print W unpack ('u', <<'UUENC'); 5000&B5!.1PT* 5001"&@H` 5002M````#4E(1%(```!D````'@@#````[85+P0```A-03%1%3$Q,____3DY._W\` 5003M2TM+2DI*CHZ.5555R<G)BHJ*^_O[<G)R2$A(_X``V=G9Y^?GU=75G)R<AH:' 5004M34U-GY^?_?W]24M-HJ*B='1T_WT`^/CXSL[.M[>W@H*"8F)B54Y(T='1?W]_ 5005M<'!O:VML4U-34%!0NKJZM;6UJZRLD)"0>WQ\75U=6%A81DI.\GL&\O+RPL+" 5006M>7EY7EY>6EI:0DE0]/3TX.#@O[^_W=W=Q,3$IZ>HEY>7E)24DI*2=G9V_X$` 5007MXN+BFIJ:B8F)?7U];FYN965E<5<\BEXRS7(7Y>7EO+R\L+"PJ:FIGZ"AEI:6 5008M:6EI:&AH]O;V[^_O[N[NZ>GIYN;GU]?7T]/3R\O+QL;&KZ^OK:VMA86%A(2$ 5009M4E)2E6$MX7<-_X,)^7T#]_?WZ^OKT-#0N;FYL[*RBXR->'AX65E92TY09U1" 5010M?%HXJV<DNVP=U7,2[7H(]GT&_]VYKJZNI*2D4$U)IF8GIF4FQ6X9]804_'\" 5011M__OURM'8C(>#N)1O9E]8\:!.K'U-E&D_=ED]A%TUW8,J_(\DLFHB_XP8W'4/ 5012MZ7H,^OKZXN3EZ.+<U-?;T\W'WLJU]-.RT<"O_]:N\L.4_\B0=7R#I)*`RZ5_ 5013M_[ETXJITCGYN8VAL\ZQFAW9FVYU@KH%4BV]2O(9/85=,@&9+B&='G'!$_Z!" 5014MM7I`S8$VHF4HQW8FUWXEZ84BL&DAOVT<R=ODT0``!-I)1$%42,?MU&>3TD`8 5015M!_!L-H%`@API$.K1.X(@13C@:'K5.\MU3SU[[[WWWGOOO7]$-X&[L8VCHX[C 50161C/\7S.9)YOGMSBZ+_1M9%0H` 5017MK>*P/QJ"SHWX2S2)_<G@[&`R:581V)\,KFH"8)+B/_*;$1(/Q6WQ!%D_+@S# 5018M2",FT:@PX7@<QR;"<*%X/,217R,$@R(7Y8>PU),9U]T%!;_5P,^<(K>R65FK 5019)DR.4E9Q!KG@* 5020/>8..#8W/1SE%H<MNU2D* 5021M2N(+!.^ULFQ0V?BP9FWAN_F9;,TC/RI76)HFQ7R^855<$LL==HKO<8_Z4K,S 5022*(P62JPQ/FJT="@`` 5023MN#$YU;RW23M[MK;)DG=]@?1T4W:J5)7M^96M%.7SCWAC759<>F9CR6@Z,*5B 5024M%0F)U/4!M=T0Z&H'`&1XFBYET&"6I4!*ZW#Q`R9@6C+'!!;;>1?Y*4($[$!8 5025MVJ*49:M/V]XYZA1S@^W>,BJ$N^>"E"Y!DC@R)$0+0+0CQW>D!&"REQP!2T8- 5026M!/.H]#;<,J`66M-=7>EV06W/K_H4$9='0<I07Y[8N40]S>KF\-[LW*@OR&&) 5027M;%)&T+L)I#5;L#E\<P#0&D2;Z$>5?A6.%K+2:P+:X4JMYNB<"TP6FIA`.&5+ 50284/YBS?*6\\9[\)!#U53D.53,@50H` 5029M8\J\71V-!6@E/H&H*2N#D>@]:$)3]*RP"Z@->LVL:`("Q<['<;?*+`![N;FY 5030MCK0:G*/>66JJ+.\<T>./@L4QMF:S.0V9Y!Q_#T949WH'^@<MW2H:'T<Z1!(C 5031%RW8`J`H` 5032M:FT=5-<1=ZX5S/+2.(J8-H'4#>/NM3*R>(CO[`-)+TW*B--B`L`<H%TN<45V 5033:Q*]:A6KA@LH0:U\RL,7!-)!E-$+F+05@:`H` 5034MAI$.ZFND("'[-7`!)R&S8OQP*S#%'/@$DNRP)L+A<`@ES,F'G[`I4".MH?<3 5035MA)AG!F#:9PBC&@#"8%FIYY2*O0`L91>\WX:KS@-PMMOEL$1!7_8NJ=?KB9ZN 5036MV6!)EPW[,E7TS>).U_<14D13G+O\U9M'#W<=WYQ<?G_]^NFK'Q^\MN?@IK8# 5037!"@`` 5038MNW#E^*[#1]:?B)"!?A`=[OWT\NEUN4F<C9U!*ZE]'\$2>;3?Y\:,NXQ&:+P= 5039M>*J!,U8?@R_&C!!.=OKOH2)<""=/Q:I^K7JHS!!,C[C2*1T&U\PMND#).Q?, 5040MZ;"2""GU"29+'1&$<43HEQ'2IC,G]XS!DYLWCT'C@>EUQ'CKXCL(M^TSPI.7 5041M;D()\3@Z4WW>O%613?L4O1+"QZ9-,V=:S5M8I72ML#YJ6LY&8(28I2B^BCK3 5042MAB'*'ZQ?>[:`[\*8\6K[T@<0KI$0_5MHW.L_!#7-SS3P,H5&",$\4_@TE;:D 5043MS=0(FY"N%9IMX0W=,UEG_6C45@:#+FD8IH-!)X<&N#,8%.>/_UGI?;N-^W/L 5044MRP82:8.;KHN'-9KFM45XIQ)\CA!YS4&%SL"WC#H]C5W!/1X/CF,_F.9%\'3H 5045MR60T]P:R<2IVM*AIGEJ$D]<<V2TC*!R._TS7KY')Q2+4K-/+R,YQ1+].`XM% 5046M>>-_.0C1;-^Y\?0Z/;9F0]M:_?:VG1%L^H:V;5ADQX8-"];_-F0'%HE(0[U> 5047M^FF,(MO7O5Z-;X0+([\+^4;T)R#<M`EJ%F"_`SFU\-M]N!EM"T]]6!O!_DX^ 50485`F@QYX#.PQY?`````$E%3D2N0F"" 5049UUENC 5050close W; 5051} 5052} 5053 5054 5055=head1 NAME 5056 5057Smokeping.pm - SmokePing Perl Module 5058 5059=head1 OVERVIEW 5060 5061Almost all SmokePing functionality sits in this Module. 5062The programs L<smokeping|smokeping> and L<smokeping.cgi|smokeping.cgi> are merely 5063figure heads allowing to hardcode some pathnames. 5064 5065If you feel like documenting what is happening within this library you are 5066most welcome todo so. 5067 5068=head1 SEE ALSO 5069 5070L<smokeping_extend(7)>, L<smokeping(1)>, L<smokeping_config(5)> 5071 5072=head1 COPYRIGHT 5073 5074Copyright (c) 2001 by Tobias Oetiker. All right reserved. 5075 5076=head1 LICENSE 5077 5078This program is free software; you can redistribute it 5079and/or modify it under the terms of the GNU General Public 5080License as published by the Free Software Foundation; either 5081version 2 of the License, or (at your option) any later 5082version. 5083 5084This program is distributed in the hope that it will be 5085useful, but WITHOUT ANY WARRANTY; without even the implied 5086warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 5087PURPOSE. See the GNU General Public License for more 5088details. 5089 5090You should have received a copy of the GNU General Public 5091License along with this program; if not, write to the Free 5092Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 509302139, USA. 5094 5095=head1 AUTHOR 5096 5097Tobias Oetiker E<lt>tobi@oetiker.chE<gt> 5098 5099Niko Tyni E<lt>ntyni@iki.fiE<gt> 5100 5101=cut 5102 5103# Emacs Configuration 5104# 5105# Local Variables: 5106# mode: cperl 5107# eval: (cperl-set-style "PerlStyle") 5108# mode: flyspell 5109# mode: flyspell-prog 5110# End: 5111# 5112# vi: sw=4 5113