1#!/usr/bin/perl 2# $Id$ 3# License: OSI Artistic License 4# Author: (c) Soren Dossing, 2005 5# Author: (c) Alan Brenner, Ithaka Harbors, 2008 6# Author: (c) Matthew Wall, 2010 7 8# FIXME: get rid of the global variables 9 10## no critic (RegularExpressions) 11## no critic (ProhibitCascadingIfElse) 12## no critic (ProhibitExcessComplexity) 13## no critic (ProhibitDeepNests) 14## no critic (ProhibitMagicNumbers) 15## no critic (ProhibitConstantPragma) 16## no critic (ProhibitPostfixControls) 17 18package ngshared; ## no critic (Capitalization) 19 20use strict; 21use warnings; 22use Carp; 23use CGI qw(escape unescape -nosticky); 24use Data::Dumper; 25use English qw(-no_match_vars); 26use Fcntl qw(:DEFAULT :flock); 27use File::Find; 28use File::Basename; 29use File::Path qw(mkpath); 30use RRDs; 31use POSIX; 32use Time::HiRes qw(gettimeofday); 33use MIME::Base64; 34use Digest::MD5 qw(md5); 35 36use Exporter qw(import); 37 38use vars qw($VERSION %Config %Labels %i18n %authhosts %authz %hsdata $colorsub $LOG $CFGNAME); ## no critic (ProhibitPackageVars) 39 40# FIXME: for now we export pretty much everything. this should be pruned so 41# that we export only what we must for the cgi and data collection, but still 42# permit tests to have access. 43# FIXME: this should be done as EXPORT_OK or EXPORT_TAGS 44## no critic (Modules::ProhibitAutomaticExportation) 45our @EXPORT = qw($VERSION $CFGNAME %Config DBCRT DBERR DBWRN DBINF DBDEB cfgparams checkrrddir convertdeprecated dbfilelist debug dumper getdebug getimg getlabel getparams getperiodctrls getperiodlabel getrules getstyle gettimestamp graphsizes hashcolor havepermission htmlerror imgerror init initperiods loadperms printfooter printgraphlinks printheader printinitscript printperiodlinks processdata readconfig readdatasetdb readgroupdb readhostdb readi18nfile readlabelsfile readperfdata readrrdoptsfile readservdb rrdline $LOG %authz %authhosts %hsdata %Labels %i18n addopt arrayorstring buildurl checkdatasources checkdirempty checkdsname checkminmax checkuserlist cleanline createminmax createrrd filterdb formatelapsedtime formattime getcfgfn getdataitems getdatalabel getdbs gethsdd gethsddvalue gethsdvalue gethsdvalue2 getlineattr getperms getrefresh getrras getserverlist graphinfo hsddmatch initlog listtodict mergeopts mkfilename mki18nfilename mklegend mkvname parsedb printcontrols printdefaultscript printi18nscript printincludescript printmenudatascript printsummary readfile readnagiosperms readpermsfile rrdupdate runcreate runupdate scandirectory scanhierarchy scanhsdata scrubuserlist setdata setlabels sortnaturally stacktrace str2list evalrules); 46 47$VERSION = '1.5.2'; 48$CFGNAME = 'nagiosgraph.conf'; 49 50use constant PROG => basename($PROGRAM_NAME); 51 52use constant { 53 DBCRT => 1, 54 DBERR => 2, 55 DBWRN => 3, 56 DBINF => 4, 57 DBDEB => 5, 58}; 59 60use constant { 61 NAGIOSGRAPHURL => 'http://nagiosgraph.sourceforge.net/', 62 ERRSTYLE => 'font-family: sans-serif; font-size: 0.8em; padding: 0.5em; background-color: #fff6f3; border: solid 1px #cc3333; margin-bottom: 1.5em;', 63 DBLISTROWS => 10, 64 PERIODLISTROWS => 6, 65 RRDEXT => '.rrd', 66 DEFAULT => 'default', 67 DSNAME_MAXLEN => 19, 68 NCONFIG_VERSION => 35, # required version of Nagios::Config 69}; 70 71# the javascript version number here must match the version number in the 72# nagiosgraph.js file. change this number when the javascript is not 73# backward compatible with previous versions. 74use constant { 75 JSVERSION => 1.7, 76 JSMISSING => 'nagiosgraph.js is not installed or wrong version.', 77 JSDISABLED => 'JavaScript is disabled.', 78}; 79 80# default values for configuration options 81use constant { 82 GEOMETRIES => '500x80,650x150,1000x200', 83 GRAPHTOP => 21, 84 GRAPHLEFT => 50, 85 GRAPHWIDTH => 600, 86 GRAPHHEIGHT => 100, 87 COLORMAX => '888888', 88 COLORMIN => 'BBBBBB', 89 COLORS => 'D05050,D08050,D0D050,50D050,50D0D0,5050D0,D050D0', 90 COLORSCHEME => 1, 91 COLORSATURATION => 0.8, 92 COLORVALUE => 0.95, 93 STEPSIZE => 300, 94 HEARTBEAT => 600, 95 RESOLUTIONS => '600 700 775 797', 96 STEPS => '1 6 24 288', 97 XFF => 0.5, 98 PERIODS => 'day week month year', 99 FIXED_SCALE_FORMAT => '%7.2lf', 100 DEFAULT_FORMAT => '%7.2lf%s', 101}; 102 103# 5x5 clear image 104use constant IMG => 'iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAYAAACNbyblAAAAIXRFWHRTb2Z0d2FyZQBHcmFwaGljQ29udmVydGVyIChJbnRlbCl3h/oZAAAAGUlEQVR4nGL4//8/AzrGEKCCIAAAAP//AwB4w0q2n+syHQAAAABJRU5ErkJggg=='; 105# 8x8 plus sign 106use constant IMG_PLUS => 'data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAICAQAAABuBnYAAAAAGUlEQVQImWNggIANQIgC8AlsQIOYAiQbCgAUMxNBUqWR0wAAAABJRU5ErkJggg=='; 107# 8x8 minus sign 108use constant IMG_MINUS => 'data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAICAQAAABuBnYAAAAAEklEQVQIW2NgIANsQIOYAiQDAOcmCwGcy16yAAAAAElFTkSuQmCC'; 109 110$colorsub = -1; 111 112# Pre-defined available graph periods 113# Hourly = 1h = 3600s 114# Daily = 33h = 118800s 115# Weekly = 9d = 777600s 116# Monthly = 5w = 3024000s 117# Quarterly = 14w = 8467200s 118# Yearly = 400d = 34560000s 119# Period data tuples are [name, period (seconds), offset (seconds)] 120my @PERIOD_KEYS = qw(hour day week month quarter year); 121my %PERIOD_DATA = ('hour' => ['hour', 5_400, 3_600], 122 'day' => ['day', 118_800, 86_400], 123 'week' => ['week', 777_600, 604_800], 124 'month' => ['month', 3_024_000, 2_592_000], 125 'quarter' => ['quarter', 8_467_200, 7_776_000], 126 'year' => ['year', 34_560_000, 31_536_000],); 127my %PERIOD_LABELS =qw(hour Hour day Day week Week month Month quarter Quarter year Year); 128 129# keys for string literals in the javascript 130my @JSLABELS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); 131push @JSLABELS, qw(Mon Tue Wed Thu Fri Sat Sun); 132push @JSLABELS, qw(OK Now Cancel); 133push @JSLABELS, 'now', 'graph data'; 134 135# image parameters 136my @IMG_FG_COLOR = (255,20,20); 137 138# Debug/logging support ####################################################### 139# Write information to STDERR 140sub stacktrace { 141 my $msg = shift; 142 warn "$msg\n"; 143 my $max_depth = 30; 144 my $ii = 1; 145 warn "--- Begin stack trace ---\n"; 146 while ((my @call_details = (caller $ii++)) && ($ii < $max_depth)) { 147 warn "$call_details[1] line $call_details[2] in function $call_details[3]\n"; 148 } 149 warn "--- End stack trace ---\n"; 150 return; 151} 152 153# Write debug information to log file 154sub debug { 155 my ($level, $text) = @_; 156 if (not defined $Config{debug}) { $Config{debug} = 0; } 157 return if ($level > $Config{debug}); 158 $level = qw(none critical error warn info debug)[$level]; 159 my $message = join q( ), scalar (localtime), PROG, $PID, $level, $text; 160 if (not fileno $LOG) { 161 stacktrace($message); 162 return; 163 } 164 # Get a lock on the LOG file (blocking call) 165 my $rval = eval { 166 flock $LOG, LOCK_EX; 167 print ${LOG} "$message\n" or carp("cannot write to LOG: $OS_ERROR"); 168 flock $LOG, LOCK_UN; 169 return 0; 170 }; 171 if ($EVAL_ERROR or $rval) { 172 stacktrace($message); 173 } 174 return; 175} 176 177sub dumper { 178 my ($level, $label, $vals) = @_; 179 return if ! defined $Config{debug} || $level > $Config{debug}; 180 my $dd = Data::Dumper->new([$vals], [$label]); 181 $dd->Indent(1); 182 my $out = $dd->Dump(); 183 chomp $out; 184 debug($level, substr $out, 1); 185 return; 186} 187 188sub gettimestamp { 189 my @tod = gettimeofday; 190 return $tod[0] * 1_000_000 + $tod[1]; 191} 192 193# if a filename is relative, we look for it in the configuration directory. 194# otherwise use the complete filename. 195sub getcfgfn { 196 my ($fn) = @_; 197 if ( substr($fn, 0, 1) ne q(/) ) { 198 $fn = $INC[0] . q(/) . $fn; 199 } 200 return $fn; 201} 202 203sub formatelapsedtime { 204 my ($s,$e) = @_; 205 my $ms = $e - $s; 206 my $hh = int $ms / 3_600_000_000; 207 $ms -= $hh * 3_600_000_000; 208 my $mm = int $ms / 60_000_000; 209 $ms -= $mm * 60_000_000; 210 my $ss = int $ms / 1_000_000; 211 $ms -= $ss * 1_000_000; 212 $ms = int $ms / 1_000; 213 if ($hh < 10) { $hh = '0' . $hh; } 214 if ($mm < 10) { $mm = '0' . $mm; } 215 if ($ss < 10) { $ss = '0' . $ss; } 216 if ($ms < 1) { $ms = '000'; } 217 elsif ($ms < 10) { $ms = '00' . $ms; } 218 elsif ($ms < 100) { $ms = '0' . $ms; } 219 return $hh . q(:) . $mm . q(:) . $ss . q(.) . $ms; 220} 221 222sub init { 223 my ($app) = @_; 224 225 my $errmsg = readconfig($app, 'cgilogfile'); 226 if ($errmsg ne q()) { 227 htmlerror($errmsg); 228 croak($errmsg); 229 } 230 231 my ($cgi, $params) = getparams(); 232 getdebug($app, $params->{host}, $params->{service}); 233 234 $errmsg = readi18nfile($cgi->multi_param('language')); 235 if ($errmsg ne q()) { 236 debug(DBWRN, $errmsg); 237 } 238 $errmsg = readlabelsfile(); 239 if ($errmsg ne q()) { 240 debug(DBWRN, $errmsg); 241 } 242 $errmsg = checkrrddir('read'); 243 if ($errmsg ne q()) { 244 htmlerror($errmsg); 245 croak($errmsg); 246 } 247 $errmsg = readrrdoptsfile(); 248 if ($errmsg ne q()) { 249 htmlerror($errmsg); 250 croak($errmsg); 251 } 252 $errmsg = loadperms( $cgi->remote_user() ); 253 if ($errmsg ne q()) { 254 htmlerror($errmsg); 255 croak($errmsg); 256 } 257 258 dumper(DBDEB, 'config', \%Config); 259 dumper(DBDEB, 'params', $params); 260 dumper(DBDEB, 'i18n', \%i18n); 261 dumper(DBDEB, 'labels', \%Labels); 262 263 scanhsdata(); 264 #dumper(DBDEB, 'all host/service data', \%hsdata); 265 %authhosts = getserverlist( $cgi->remote_user() ); 266 #dumper(DBDEB, 'data for ' . $cgi->remote_user(), \%authhosts); 267 268 return $cgi, $params; 269} 270 271# If logging is enabled, make sure we can write to the log file. 272# Attempt to write to the log file. If that fails, write to STDERR. 273# CGI scripts will typically fail to write to the log file (unless 274# the web server user has write permissions on it), so output will 275# go to the web server logs. 276sub initlog { 277 my ($app, $logfn) = @_; 278 if (defined $Config{'debug_' . $app}) { 279 $Config{debug} = $Config{'debug_' . $app}; 280 } 281 if (! $logfn) { 282 $logfn = defined $Config{logfile} ? $Config{logfile} : q(); 283 } 284 if ($Config{debug} > 0) { 285 if (not open $LOG, '>>', $logfn) { ## no critic (RequireBriefOpen) 286 open $LOG, '>&=STDERR' or ## no critic (RequireBriefOpen) 287 croak('Cannot log to file or STDERR'); 288 debug(DBCRT, "Cannot write to '$logfn', using STDERR instead"); 289 } 290 } 291 return; 292} 293 294# we must have a type (the CGI script that is being invoked). we may or may 295# not have a host and/or service. 296sub getdebug { 297 my ($type, $host, $service) = @_; 298 if (not defined $type) { 299 debug(DBWRN, 'no type defined, enabling debug'); 300 $Config{debug} = DBDEB; 301 return; 302 } 303 304 if (not $host) { $host = q(); } 305 if (not $service) { $service = q(); } 306 307 # All this allows debugging one service, or one host, 308 # or one service on one host, for each line of input. 309 my $key = 'debug_' . $type; 310 my $hkey = 'debug_' . $type . '_host'; 311 my $skey = 'debug_' . $type . '_service'; 312 if (defined $Config{$key}) { 313 if (defined $Config{$hkey}) { 314 if ($Config{$hkey} eq $host) { 315 if (defined $Config{$skey}) { 316 if ($Config{$skey} eq $service) { 317 $Config{debug} = $Config{$key}; 318 } else { 319 $Config{debug} = 0; 320 } 321 } else { 322 $Config{debug} = $Config{$key}; 323 } 324 } else { 325 $Config{debug} = 0; 326 } 327 } elsif (defined $Config{$skey}) { 328 if ($Config{$skey} eq $service) { 329 $Config{debug} = $Config{$key}; 330 } else { 331 $Config{debug} = 0; 332 } 333 } else { 334 $Config{debug} = $Config{$key}; 335 } 336 } 337 338 if (defined $Config{$key}) { 339 debug(DBDEB, "getdebug $key = $Config{$key}"); 340 } 341 if (defined $Config{$hkey}) { 342 debug(DBDEB, "getdebug $hkey = $Config{$hkey}"); 343 } 344 if (defined $Config{$skey}) { 345 debug(DBDEB, "getdebug $skey = $Config{$skey}"); 346 } 347 348 return; 349} 350 351# HTTP support ################################################################ 352# get parameters from CGI 353# 354# these are the CGI arguments that we understand: 355# 356# host=host_name (from nagios configuration) 357# service=service_description (from nagios configuration) 358# db=db[,ds[,ds[...]]] (may be comma-delimited or specified multiple times) 359# geom=WxH 360# rrdopts= 361# offset=seconds 362# period=(hour,day,week,month,quarter,year) 363# graphonly 364# showgraphtitle 365# hidelegend 366# fixedscale 367# showtitle 368# showdesc 369# expand_controls 370# expand_period=(hour,day,week,month,quarter,year) 371# 372sub getparams { 373 my $cgi = new CGI; ## no critic (ProhibitIndirectSyntax) 374 $cgi->autoEscape(0); 375 my %rval; 376 377 # these flags are either string or array 378 for my $ii (qw(host service db label group geom rrdopts offset period expand_period)) { 379 if ($cgi->param($ii)) { 380 if (ref($cgi->param($ii)) eq 'ARRAY') { 381 my @rval = $cgi->param($ii); 382 $rval{$ii} = \@rval; 383 } elsif ($ii eq 'db' || $ii eq 'label') { 384 $rval{$ii} = [$cgi->multi_param($ii),]; 385 } else { 386 $rval{$ii} = $cgi->param($ii); 387 } 388 } else { 389 $rval{$ii} = q(); 390 } 391 } 392 393 # these flags are boolean. if they exist, then consider it true. 394 for my $ii (qw(expand_controls fixedscale showgraphtitle showtitle showdesc graphonly hidelegend)) { 395 $rval{$ii} = q(); 396 for my $jj ($cgi->param()) { 397 if ($jj eq $ii) { 398 $rval{$ii} = 1; 399 last; 400 } 401 } 402 } 403 404 if (not $rval{host}) { $rval{host} = q(); } 405 if (not $rval{service}) { $rval{service} = q(); } 406 if (not $rval{group}) { $rval{group} = q(); } 407 if (not $rval{db}) { $rval{db} = []; } 408 if (not $rval{label}) { $rval{label} = []; } 409 410 if ($rval{offset}) { $rval{offset} = int $rval{offset}; } 411 if (not $rval{offset} or $rval{offset} <= 0) { $rval{offset} = 0; } 412 413 return $cgi, \%rval; 414} 415 416# return two strings: period and expand_period. each is a comma-delimited 417# list of day, week, month, quarter, year. first try to get the value from 418# the parameters. if that fails, use whatever is defined in config. 419# 420# CGI uses comma-delimited, old configs used space-delimited, so we deal with 421# either. we ensure the result is comma-delimited. 422sub initperiods { 423 my ($context, $opts) = @_; 424 if ($context eq 'both') { 425 $context = 'all'; 426 } 427 428 my $s = $opts->{period}; 429 my $c = $Config{'time' . $context}; 430 my $p = q(); 431 if (defined $c && $c ne q()) { $p = $c; } 432 if (defined $s && $s ne q()) { $p = $s; } 433 $p =~ s/ /,/g; ## no critic (RegularExpressions) 434 435 $s = $opts->{expand_period}; 436 $c = $Config{'expand_time' . $context}; 437 my $ep = q(); 438 if (defined $c && $c ne q()) { $ep = $c; } 439 if (defined $s && $s ne q()) { $ep = $s; } 440 $ep =~ s/ /,/g; ## no critic (RegularExpressions) 441 442 return ($p, $ep); 443} 444 445sub getstyle { 446 my @style; 447 if ($Config{stylesheet}) { 448 @style = (-style => {-src => "$Config{stylesheet}"}); 449 } 450 return @style; 451} 452 453sub getrefresh { 454 my @refresh; 455 if ($Config{refresh}) { 456 @refresh = (-http_equiv => 'Refresh', -content => "$Config{refresh}"); 457 } 458 return @refresh; 459} 460 461# configure parameters with something that we are sure will work. grab values 462# from the supplied default object. if there are any gaps, use values from the 463# configuration. 464sub cfgparams { 465 my($p, $dflt) = @_; 466 467 foreach my $ii (qw(expand_controls fixedscale showgraphtitle showtitle showdesc hidelegend graphonly)) { 468 if ($dflt->{$ii} ne q()) { 469 $p->{$ii} = $dflt->{$ii}; 470 } elsif(defined $Config{$ii}) { 471 $p->{$ii} = $Config{$ii} eq 'true' ? 1 : 0; 472 } else { 473 $p->{$ii} = 0; 474 } 475 } 476 477 if ($dflt->{period} ne q()) { 478 $p->{period} = $dflt->{period}; 479 } 480 if ($dflt->{expand_period} ne q()) { 481 $p->{expand_period} = $dflt->{expand_period}; 482 } 483 if ($dflt->{geom} ne q()) { 484 $p->{geom} = $dflt->{geom}; 485 } 486 $p->{offset} = $dflt->{offset} ne q() ? $dflt->{offset} : 0; 487 488 return; 489} 490 491sub arrayorstring { 492 my ($opts, $param) = @_; 493 #dumper(DBDEB, "arrayorstring param=$param opts", $opts); 494 my $rval = q(); 495 if (exists $opts->{$param} and $opts->{$param}) { 496 if (ref($opts->{$param}) eq 'ARRAY') { 497 for my $ii (@{$opts->{$param}}) { 498 next if not defined $ii; 499 $rval .= "&$param=" . escape($ii); 500 } 501 } else { 502 $rval .= "&$param=" . escape($opts->{$param}); 503 } 504 } 505 return $rval; 506} 507 508sub buildurl { 509 my ($host, $service, $opts) = @_; 510 if (not $host or not $service) { 511 return q(); 512 } 513 debug(DBDEB, "buildurl($host, $service)"); 514 dumper(DBDEB, 'buildurl: opts', $opts); 515 my $url = join q(&), 'host=' . $host, 'service=' . $service; 516 $url .= arrayorstring($opts, 'db'); 517 $url .= arrayorstring($opts, 'geom'); 518 if (exists $opts->{fixedscale} and $opts->{fixedscale}) { 519 $url .= '&fixedscale'; 520 } 521 $url .= arrayorstring($opts, 'rrdopts'); 522 debug(DBDEB, "buildurl: returning $url"); 523 return $url; 524} 525 526# construct the filename to RRD data file. this requires at least a valid 527# host and service to work. 528sub mkfilename { 529 my ($host, $service, $db) = @_; 530 if (not $host or not $service) { 531 debug(DBWRN, 'cannot construct filename: missing host or service'); 532 return 'BOGUSDIR', 'BOGUSFILE'; 533 } 534 $db ||= q(); 535 my $directory = $Config{rrddir}; 536 my $filename = q(); 537 if (defined $Config{dbseparator} && $Config{dbseparator} eq 'subdir') { 538 $directory .= q(/) . $host; 539 if ($db) { 540 $filename = escape("${service}___${db}") . RRDEXT; 541 } else { 542 $filename = escape("${service}___"); 543 } 544 } else { 545 # Build filename for traditional separation 546 if ($db) { 547 $filename = escape("${host}_${service}_${db}") . RRDEXT; 548 } else { 549 $filename = escape("${host}_${service}_"); 550 } 551 } 552 return $directory, $filename; 553} 554 555# this is completely self-contained so that it can be called no matter what 556# error we encounter. stylesheet is hard-coded so no dependencies. 557sub htmlerror { 558 my ($msg) = @_; 559 my $cgi = new CGI; ## no critic (ProhibitIndirectSyntax) 560 print $cgi->header(-type => 'text/html', -expires => 0) . 561 $cgi->start_html(-id => 'nagiosgraph', 562 -title => 'NagiosGraph Error', 563 -head => $cgi->style({-type=>'text/css'}, 564 '.error {' . ERRSTYLE . '}')) . 565 $cgi->div( { -class => 'error' }, $msg ) . "\n" . 566 $cgi->end_html() or 567 debug(DBCRT, "could not write to STDOUT: $OS_ERROR"); 568 return; 569} 570 571sub imgerror { 572 my ($cgi, $msg) = @_; 573 $OUTPUT_AUTOFLUSH = 1; 574 print $cgi->header(-type => 'image/png', -charset => 'ISO-8859-1') . 575 ( defined $msg && $msg ne q() ? getimg($msg) : decode_base64(IMG)) 576 or debug(DBCRT, "could not write to STDOUT: $OS_ERROR"); 577 return; 578} 579 580# emit a png image with the message in it. only works if GD is available. 581# if no GD, just return a small blank image. 582sub getimg { 583 my ($msg) = @_; 584 debug(DBDEB, "getimg($msg)"); 585 my $rval = eval { require GD; }; 586 if (defined $rval && $rval == 1) { 587 my @lines = split /\n/, $msg; 588 my $pad = 4; 589 my $maxw = 600; 590 my $maxh = 15; 591 my $width = 2 * $pad + $maxw; 592 my $height = 2 * $pad + $maxh * scalar @lines; 593 my $img = GD::Image->new($width, $height); 594 my $wht = $img->colorAllocate(255, 255, 255); 595 my $fg = $img->colorAllocate($IMG_FG_COLOR[0], 596 $IMG_FG_COLOR[1], 597 $IMG_FG_COLOR[2]); 598 $img->transparent($wht); 599 $img->rectangle(2,2,$width-3,$height-3,$wht); 600 my $y = $pad; 601 foreach my $line (@lines) { 602 $img->string(GD->gdSmallFont,$pad,$y,"$line",$fg); 603 $y += $maxh; 604 } 605 return $img->png; 606 } 607 return decode_base64(IMG); 608} 609 610# Color subroutines ########################################################### 611# Choose a color for service 612sub hashcolor { 613 my $label = shift; 614 my $color = shift; 615 $color ||= $Config{colorscheme}; 616 debug(DBDEB, "hashcolor($color)"); 617 618 # color 9 is user defined (or the default rainbow if nothing userdefined). 619 if ($color == 9) { 620 # Wrap around, if we have more values than given colors 621 $colorsub++; 622 if ($colorsub >= scalar @{$Config{colors}}) { $colorsub = 0; } 623 debug(DBDEB, 'hashcolor: returning color = ' . $Config{colors}[$colorsub]); 624 return $Config{colors}[$colorsub]; 625 } 626 627 my $h = vec md5($label), $color-1, 8; 628 my $s = $Config{colorsaturation} || COLORSATURATION; 629 my $v = $Config{colorvalue} || COLORVALUE; 630 $h = $h/255; 631 my ($r, $g, $b) = hsv2rgb($h, $s, $v); 632 # generate the hex color value 633 $color = sprintf '%02X%02X%02X', $r, $g, $b; 634 debug(DBDEB, "hashcolor: returning color = $color"); 635 return $color; 636} 637 638# Accepts a list of HSV values from 0 to 1 and returns RGB values from 0 to 255 639# Based on algorithm from http://www.cs.rit.edu/~ncs/color/t_convert.html 640sub hsv2rgb { 641 my ($h, $s, $v) = @_; 642 my ($r, $g, $bb) = $v; # achromatic (grey) 643 644 if ($s != 0) { 645 my $h_i = int $h * 6; 646 my $f = ($h * 6) - $h_i; 647 648 my $x = $v * (1 - $s); 649 my $y = $v * (1 - $s * $f); 650 my $z = $v * (1 - $s * (1 - $f)); 651 652 ($r, $g, $bb) = ($v, $z, $x) if $h_i == 0; 653 ($r, $g, $bb) = ($y, $v, $x) if $h_i == 1; 654 ($r, $g, $bb) = ($x, $v, $z) if $h_i == 2; 655 ($r, $g, $bb) = ($x, $y, $v) if $h_i == 3; 656 ($r, $g, $bb) = ($z, $x, $v) if $h_i == 4; 657 ($r, $g, $bb) = ($v, $x, $y) if $h_i == 5; 658 } 659 660 return int $r*256, int $g*256, int $bb*256; 661} 662 663# Configuration subroutines ################################################### 664# parse string values and store them as a data structure 665sub listtodict { 666 my ($val, $sep, $commasplit) = @_; 667 $sep ||= q(,); 668 $commasplit ||= 0; 669 #debug(DBDEB, "listtodict($val, $sep, $commasplit)"); 670 my (%rval); 671 $Config{$val} ||= q(); 672 if (ref $Config{$val} eq 'HASH') { 673 #debug(DBDEB, 'listtodict: returning existing hash'); 674 return $Config{$val}; 675 } 676 $Config{$val . 'sep'} ||= $sep; 677 #debug(DBDEB, 'listtodict: splitting "' . $Config{$val} . '" on "' . $Config{$val . 'sep'} . q(")); # " 678 foreach my $ii (split $Config{$val . 'sep'}, $Config{$val}) { 679 if ($val eq 'hostservvar') { 680 my @data = split /,/, $ii; 681 #dumper(DBDEB, 'listtodict: hostservvar data', \@data); 682 if (defined $rval{$data[0]}) { 683 if (defined $rval{$data[0]}->{$data[1]}) { 684 $rval{$data[0]}->{$data[1]}->{$data[2]} = 1; 685 } else { 686 $rval{$data[0]}->{$data[1]} = {$data[2] => 1}; 687 } 688 } else { 689 $rval{$data[0]} = {$data[1] => {$data[2] => 1}}; 690 } 691 } elsif ($commasplit) { 692 my @data = split /,/, $ii; 693 #dumper(DBDEB, 'listtodict: commasplit data', \@data); 694 $rval{$data[0]} = $data[1]; 695 } else { 696 $rval{$ii} = 1; 697 } 698 } 699 $Config{$val} = \%rval; 700 #dumper(DBDEB, 'listtodict: rval', $Config{$val}); 701 return $Config{$val}; 702} 703 704# FIXME: ensure no regexp breakage (do this when reading/validated conf) 705# return a list from the indicated string. 706# strip any leading and trailing spaces from each element. 707sub str2list { 708 my ($str, $delim) = @_; 709 $str ||= q(); 710 $delim ||= q(;); 711 my @rval; 712 foreach my $i (split /$delim/, $str) { 713 $i =~ s/^\s+//g; 714 $i =~ s/\s+$//g; 715 if ($i ne q()) { 716 push @rval, $i; 717 } 718 } 719 return \@rval; 720} 721 722# Subroutine for checking that the directory with RRD file is not empty 723sub checkdirempty { 724 my $directory = shift; 725 if (not opendir DIR, $directory) { 726 debug(DBCRT, "cannot open directory $directory: $OS_ERROR"); 727 return 0; 728 } 729 my @files = readdir DIR; 730 closedir DIR or debug(DBERR, "cannot close $directory: $OS_ERROR"); 731 return (scalar @files > 2) ? 0 : 1; 732} 733 734# pass a debug value if you want to debug the initial config file parsing. 735# otherwise the debug level will be set by whatever is found in the config. 736sub readfile { 737 my ($filename, $hashref, $debug) = @_; 738 $debug ||= 0; 739 debug(DBDEB, "readfile($filename, $debug)"); 740 if ($debug) { $Config{debug} = $debug; } 741 open my $FH, '<', $filename or ## no critic (RequireBriefOpen) 742 return "cannot open $filename: $OS_ERROR"; 743 my $cfgdebug; 744 my ($key, $val); 745 while (<$FH>) { 746 next if /^\s*#/; # skip commented lines 747 s/^\s+//; # removes leading whitespace 748 /^([^=]+)\s*=\s*(.*)$/x and do { # splits into key=val pairs 749 $key = $1; 750 $val = $2; 751 $key =~ s/\s+$//; # removes trailing whitespace 752 $val =~ s/\s+$//; # removes trailing whitespace 753 if ($key eq 'debug') { 754 $cfgdebug = $val; 755 } else { 756 $hashref->{$key} = $val; 757 } 758 }; 759 } 760 close $FH or return "close failed for $filename: $OS_ERROR"; 761 if (defined $cfgdebug) { 762 $hashref->{debug} = $cfgdebug; 763 } 764 return q(); 765} 766 767# check status of the rrd directory. this expects either 'write' or 'read'. 768sub checkrrddir { 769 my ($rrdstate) = @_; 770 my $errmsg = q(); 771 if ($rrdstate eq 'write') { 772 # Make sure rrddir exists and is writable 773 if (not -d $Config{rrddir}) { 774 debug(DBINF, "creating directory $Config{rrddir}"); 775 my $err; 776 mkpath($Config{rrddir}, {error => \$err}); 777 if ($err && @{$err}) { 778 $errmsg = 779 "Cannot create rrd directory $Config{rrddir}: $OS_ERROR"; 780 } 781 } elsif (not -w $Config{rrddir}) { 782 $errmsg = "Cannot write to rrd directory $Config{rrddir}"; 783 } 784 } else { 785 # Make sure rrddir is readable and not empty 786 if (! -r $Config{rrddir} ) { 787 $errmsg = "Cannot read rrd directory $Config{rrddir}"; 788 } elsif (checkdirempty($Config{rrddir})) { 789 $errmsg = "No data in rrd directory $Config{rrddir}"; 790 } 791 } 792 if ($errmsg ne q()) { debug(DBCRT, $errmsg); } 793 return $errmsg; 794} 795 796# read the config file. get the log initialized as soon as possible. 797# convert any deprecated variables to new variables and/or syntax. 798# ensure sane default values for everything, even if not specified. 799sub readconfig { 800 my ($app, $logid, $cfgfn) = @_; 801 if (! $logid) { $logid = 'logfile'; } 802 if (! $cfgfn) { $cfgfn = $INC[0] . q(/) . $CFGNAME; } 803 804 my $debug = 0; # set this higher to debug config file parsing 805 my $errstr = readfile($cfgfn, \%Config, $debug); 806 if ($errstr ne q()) { return $errstr; } 807 808 initlog($app, $Config{$logid}); 809 810 convertdeprecated(\%Config); 811 812 # now initialize structures and configure defaults 813 814 $Config{rrdoptshash}{global} = 815 defined $Config{rrdopts} ? $Config{rrdopts} : q(); 816 817 foreach my $ii ('withmaximums', 'withminimums', 818 'altautoscale', 'nogridfit', 'logarithmic') { 819 listtodict($ii, q(,)); 820 } 821 foreach my $ii ('hostservvar') { 822 listtodict($ii, q(;)); 823 } 824 foreach my $ii ('altautoscalemax', 'altautoscalemin') { 825 listtodict($ii, q(;), 1); 826 } 827 foreach my $ii ('plotasLINE1', 'plotasLINE2', 'plotasLINE3', 'plotasAREA', 828 'plotasTICK', 'stack', 'negate', 'lineformat', 829 'maximums', 'minimums', 'lasts', 'fixedscale') { 830 if ($Config{$ii}) { 831 $Config{$ii . 'list'} = 832 str2list($Config{$ii}, $Config{$ii} =~ /;/ ? q(;) : q(,)); 833 } 834 } 835 foreach my $ii ('heartbeats', 'stepsizes', 'resolutions', 'steps', 'xffs'){ 836 if (defined $Config{$ii}) { 837 my $key = $ii; 838 chop $key; 839 $Config{$key . 'list'} = str2list($Config{$ii}); 840 } 841 } 842 843 # set these only if they have not been specified in the config file 844 foreach my $ii (['timeall', 'day week month'], 845 ['timehost', 'day'], 846 ['timeservice', 'day'], 847 ['timegroup', 'day'], 848 ['expand_timeall', 'day week month'], 849 ['expand_timehost', 'day'], 850 ['expand_timeservice', 'day'], 851 ['expand_timegroup', 'day'], 852 ['geometries', GEOMETRIES], 853 ['colorscheme', COLORSCHEME], 854 ['colors', COLORS], 855 ['colormax', COLORMAX], 856 ['colormin', COLORMIN], 857 ['resolution', RESOLUTIONS], 858 ['step', STEPS], 859 ['xff', XFF], 860 ['heartbeat', HEARTBEAT], 861 ['stepsize', STEPSIZE],) { 862 if (not $Config{$ii->[0]}) { $Config{$ii->[0]} = $ii->[1]; } 863 } 864 $Config{colors} = [split /\s*,\s*/, $Config{colors}]; 865 866 return q(); 867} 868 869# process the configuration variables and convert anything in old format to 870# the newest format. this is to maintain backward compatibility with older 871# configuration files. 872sub convertdeprecated { 873 my ($cfg) = @_; 874 875 # lineformat=warn,LINE1,FFFFFF -> lineformat=warn=LINE1,FFFFFF 876 if ( defined $cfg->{lineformat} && $cfg->{lineformat} !~ /=/ ) { 877 my $v = q(); 878 foreach my $tuple (split /;/, $cfg->{lineformat}) { 879 my $lhs = q(); 880 my $rhs = q(); 881 foreach my $x (split /,/, $tuple) { 882 if ($x eq 'LINE1' || $x eq 'LINE2' || 883 $x eq 'LINE3' || $x eq 'AREA' || 884 $x eq 'TICK' || $x eq 'STACK' || 885 $x =~ /[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]+/) { 886 if ($rhs ne q()) { 887 $rhs .= q(,); 888 } 889 $rhs .= $x; 890 } else { 891 if ($lhs ne q()) { 892 $lhs .= q(,); 893 } 894 $lhs .= $x; 895 } 896 } 897 if ($v ne q()) { 898 $v .= q(;); 899 } 900 $v .= $lhs . q(=) . $rhs; 901 } 902 $cfg->{lineformat} = $v; 903 } 904 905 return; 906} 907 908sub readrrdoptsfile { 909 if ( defined $Config{rrdoptsfile} ) { 910 my $errstr = readfile(getcfgfn($Config{rrdoptsfile}), 911 $Config{rrdoptshash}); 912 if ($errstr ne q()) { 913 return $errstr; 914 } 915 } 916 return q(); 917} 918 919sub loadperms { 920 my ($user) = @_; 921 922 if ( defined $Config{authzmethod} ) { 923 if ( $Config{authzmethod} eq 'nagios3' ) { 924 return readnagiosperms( $user ); 925 } elsif ( $Config{authzmethod} eq 'nagiosgraph' ) { 926 return readpermsfile( $user ); 927 } else { 928 return "unknown authzmethod '$Config{authzmethod}'"; 929 } 930 } 931 return q(); 932} 933 934# TODO: respect contacts, not just all host/services 935# read the nagios permissions configuration. this would be a lot easier if 936# there were an api. instead we have to read the config files and basically 937# reverse engineer the nagios behavior. 938sub readnagiosperms { 939 my ($user) = @_; 940 941 undef %authz; 942 $authz{default_host_access}{default_service_access} = 0; 943 if ( not defined $Config{authzfile} or $Config{authzfile} eq q() ) { 944 return 'authzfile is not defined'; 945 } 946 my $fn = $Config{authzfile}; 947 my $authenabled = 1; # nagios defaults to use authentication 948 my $host_users = q(); 949 my $serv_users = q(); 950 my $default_user = q(); 951 open my $FH, '<', $fn or ## no critic (RequireBriefOpen) 952 return "cannot open nagios config $fn: $OS_ERROR"; 953 while (<$FH>) { 954 my $line = $_; 955 $line =~ s/\s//g; 956 if ( $line =~ /^authorized_for_all_hosts\s*=\s*(.*)/ ) { 957 $host_users = $1; 958 } elsif ( $line =~ /^authorized_for_all_services\s*=\s*(.*)/ ) { 959 $serv_users = $1; 960 } elsif ( $line =~ /^default_user_name\s*=\s*(.*)/ ) { 961 $default_user = $1; 962 } elsif ( $line =~ /^use_authentication\s*=\s*([\d])/ ) { 963 $authenabled = $1; 964 } 965 } 966 close $FH or return "close failed for $fn: $OS_ERROR"; 967 968 if ( $authenabled == 0 ) { 969 undef %authz; 970 debug(DBINF, 'nagios authorization is disabled, full access granted'); 971 return q(); 972 } 973 974 # if there is no user but there is a nagios default user, use the default 975 if ( (! defined $user || $user eq q()) && $default_user ne q() ) { 976 $user = $default_user; 977 } 978 979 if ( not defined $user or $user eq q() ) { 980 debug(DBWRN, 'no discernable user, defaulting to no permissions'); 981 return q(); 982 } 983 984 foreach my $i (split /,/, $host_users) { 985 if ( $user eq $i ) { 986 $authz{default_host_access}{default_service_access} = 1; 987 last; 988 } 989 } 990 foreach my $i (split /,/, $serv_users) { 991 if ( $user eq $i ) { 992 $authz{default_host_access}{default_service_access} = 1; 993 last; 994 } 995 } 996 997 return q(); 998} 999 1000# read the authz file. we load permissions only for the indicated user (no 1001# need to know permissions for anyone else). if no authzfile is specified, 1002# do not apply access control rules. if no user is specified, then lockdown. 1003sub readpermsfile { 1004 my ($user) = @_; 1005 1006 # defining authz enables enforcement of access controls. 1007 # default to no permissions. 1008 undef %authz; 1009 $authz{default_host_access}{default_service_access} = 0; 1010 if ( not defined $user or $user eq q() ) { 1011 debug(DBWRN, 'no discernable user, defaulting to no permissions'); 1012 return q(); 1013 } 1014 if ( not defined $Config{authzfile} or $Config{authzfile} eq q() ) { 1015 return 'authzfile is not defined'; 1016 } 1017 my $fn = getcfgfn($Config{authzfile}); 1018 open my $FH, '<', $fn or ## no critic (RequireBriefOpen) 1019 return "cannot open access control file $fn: $OS_ERROR"; 1020 my $lineno = 0; 1021 while (<$FH>) { 1022 $lineno += 1; 1023 next if /^\s*#/; # skip commented lines 1024 s/^\s+//; # removes leading whitespace 1025 if ( /^([^=]+)\s*=\s*(.*)$/x ) { 1026 my $n = $1; 1027 my $v = $2; 1028 $n =~ s/\s+$//; 1029 $v = scrubuserlist($v); 1030 if (checkuserlist($v)) { 1031 debug(DBWRN, "authzfile: bad userlist '$v' (line $lineno)"); 1032 next; 1033 } 1034 my ($h,$s) = split /,/, $n; 1035 $h =~ s/\s+//g; 1036 if (not $h or $h eq q() or $h eq q(*)) { 1037 $h = 'default_host_access'; 1038 } 1039 if (not $s or $s eq q() or $s eq q(*)) { 1040 $s = 'default_service_access'; 1041 } 1042 my $p = getperms($user, $v); 1043 if (defined $p) { 1044 $authz{$h}{$s} = $p; 1045 } 1046 } else { 1047 debug(DBWRN, "authzfile: bad format (line $lineno)"); 1048 } 1049 } 1050 close $FH or return "close failed for $fn: $OS_ERROR"; 1051 return q(); 1052} 1053 1054sub scrubuserlist { 1055 my ($v) = @_; 1056 $v =~ s/\s+//g; # remove all spaces from userlist 1057 return $v; 1058} 1059 1060sub checkuserlist { 1061 my ($v) = @_; 1062 if ( $v =~ /[^!a-zA-Z0-9_\.\*-,]/ ) { 1063 return 1; 1064 } 1065 return 0; 1066} 1067 1068# do glob matching. wrap it in an eval to ensure no failures. 1069# return 1 if user matches positive, 0 if matches negative, undef if no match. 1070# consider bad pattern a rejection. 1071sub getperms { 1072 my ($user, $str) = @_; 1073 if ($str eq q()) { return 0; } 1074 my $match; 1075 foreach my $pattern (split /,/, $str) { 1076 $pattern =~ s/\./\\./g; 1077 $pattern =~ s/\*/\.\*/g; 1078 my $rval = eval { 1079 my $m = 1; 1080 if (substr($pattern, 0, 1) eq q(!)) { 1081 $pattern = substr $pattern, 1; 1082 $m = 0; 1083 } 1084 if ( $user =~ /^${pattern}$/ ) { 1085 return $m; 1086 } 1087 return; 1088 }; 1089 if ($EVAL_ERROR) { 1090 debug(DBCRT, "bad regex pattern '$pattern'"); 1091 return 0; 1092 } 1093 if (defined $rval) { 1094 $match = $rval; 1095 } 1096 } 1097 return $match; 1098} 1099 1100# determine whether the user can view the indicated host and service. 1101# the format for the authz structure is: 1102# 1103# authz = { * => { * => 0, service9 => 1 }, 1104# host0 => { * => 1, service1 => 0 }, 1105# host1 => { service0 => 0, service3 => 0 }, 1106# host2 => { service0 => 1, service1 => 0 }, 1107# }; 1108# 1109sub havepermission { 1110 my ($host, $service) = @_; 1111 if ( not %authz ) { 1112 return 1; 1113 } 1114 my $ok = 0; 1115 if ( defined $authz{default_host_access}{default_service_access} ) { 1116 $ok = $authz{default_host_access}{default_service_access}; 1117 if ( defined $service 1118 and defined $authz{default_host_access}{$service} ) { 1119 $ok = $authz{default_host_access}{$service}; 1120 } 1121 } 1122 if ( defined $host and defined $authz{$host} ) { 1123 if ( defined $authz{$host}{default_service_access} ) { 1124 $ok = $authz{$host}{default_service_access}; 1125 } 1126 if ( defined $service and defined $authz{$host}{$service} ) { 1127 $ok = $authz{$host}{$service}; 1128 } 1129 } 1130 return $ok; 1131} 1132 1133sub readlabelsfile { 1134 if ( defined $Config{labelfile} ) { 1135 undef %Labels; 1136 my $errstr = readfile(getcfgfn($Config{labelfile}), \%Labels); 1137 if ($errstr ne q()) { 1138 return $errstr; 1139 } 1140 } 1141 return q(); 1142} 1143 1144# get the i18n strings. use the language we are given. if there is none, use 1145# the language from the config file. if there is none, use the environment. 1146# if that fails, warn. if there is no file corresponding to the language, 1147# warn about it so someone can create a translation. if someone defines a 1148# specialized en file, use it, but do not complain if we do not find en since 1149# that is what we fall back to. 1150sub readi18nfile { 1151 my ($lang) = @_; 1152 if ( ! $lang ) { 1153 $lang = $Config{language}; 1154 } 1155 if ( ! $lang ) { 1156 ($lang) = ($ENV{HTTP_ACCEPT_LANGUAGE} 1157 ? split /,/, $ENV{HTTP_ACCEPT_LANGUAGE} : q()); 1158 } 1159 if ( $lang && $lang ne q()) { 1160 $lang =~ tr/-/_/; 1161 my $fn = getcfgfn( mki18nfilename( $lang )); 1162 if ( ! -f $fn && $lang =~ /(..)_/ ) { 1163 $lang = $1; 1164 $fn = getcfgfn( mki18nfilename( $lang )); 1165 } 1166 if ( -f $fn ) { 1167 my $errstr = readfile( $fn, \%i18n ); 1168 if ( $errstr ne q() ) { 1169 return $errstr; 1170 } 1171 } elsif ( substr($lang, 0, 2) ne q(en)) { 1172 return "No translations for '$lang' ($fn)"; 1173 } 1174 } else { 1175 return 'Cannot determine language'; 1176 } 1177 return q(); 1178} 1179 1180sub mki18nfilename { 1181 my ($key) = @_; 1182 return 'nagiosgraph_' . $key . '.conf'; 1183} 1184 1185sub parsedb { 1186 my ($line) = @_; 1187 $line =~ s/^&db=//; 1188 my @db = split /&db=/, $line; 1189 my %labels; 1190 for my $i (0 .. @db - 1) { 1191 if ($db[$i] =~ /([^&]+)&label=(.*)/) { 1192 $db[$i] = $1; 1193 $labels{$db[$i]} = $2; 1194 } 1195 } 1196 return \@db, \%labels; 1197} 1198 1199# return all databases for the indiated host-service pair 1200sub getdbs { 1201 my ($host, $service, $data) = @_; 1202 my @db; 1203 if ($data->{$host}{$service}) { 1204 @db = @{$data->{$host}{$service}}; 1205 } 1206 return \@db; 1207} 1208 1209# return the subset of the specified databases for which we actually have data. 1210sub filterdb { 1211 my ($host, $service, $dblist, $data) = @_; 1212 my @actualdb; 1213 if ($data->{$host}{$service} && $dblist) { 1214 my @dbs = @{$data->{$host}{$service}}; 1215 foreach my $x (@{$dblist}) { 1216 my $found = 0; 1217 my ($db,$ds) = split /,/, $x; 1218 for my $i (0 .. @dbs-1) { 1219 my @known = @{$dbs[$i]}; 1220 if ($db eq $known[0]) { 1221 if ($ds) { 1222 for my $i (1 .. @known-1) { 1223 if ($ds eq $known[$i]) { 1224 push @actualdb, $x; 1225 last; 1226 } 1227 } 1228 } else { 1229 push @actualdb, $x; 1230 } 1231 } 1232 } 1233 } 1234 } 1235 return \@actualdb; 1236} 1237 1238# remove leading and trailing spaces. there is no need to escape the strings 1239# in the config files, but we unescape just in case someone has done this. 1240# older distributions included escaped labels in the sample configs. 1241sub cleanline { 1242 my ($line) = @_; 1243 $line = unescape($line); 1244 $line =~ tr/+/ /; 1245 $line =~ s/^\s+//g; 1246 $line =~ s/\s+$//g; 1247 return $line; 1248} 1249 1250# Read hostdb file 1251# 1252# This returns a list of graph infos for the specified host based on the 1253# contents of the hostdb file. 1254# 1255# If there is no file defined or if the file contains no service lines, 1256# return all services for which data exist for the indicated host. 1257# 1258# Services are defined with this format: 1259# 1260# service=name[&db=db[,ds][&label=text][&db=db[,ds][&label=text][...]]] 1261# 1262sub readhostdb { 1263 my ($host) = @_; 1264 $host ||= q(); 1265 if ($host eq q() || $host eq q(-)) { return (); } 1266 1267 debug(DBDEB, "readhostdb($host)"); 1268 1269 my $usedefaults = 1; 1270 my @ginfo; 1271 if (defined $Config{hostdb}) { 1272 my $fn = getcfgfn($Config{hostdb}); 1273 if (open my $DB, '<', $fn) { ## no critic (RequireBriefOpen) 1274 my $lineno = 0; 1275 while (my $line = <$DB>) { 1276 chomp $line; 1277 $lineno += 1; 1278 next if $line =~ /^\s*#/; # skip commented lines 1279 $line = cleanline($line); 1280 my $service = q(); 1281 my $label = q(); 1282 if ( $line =~ s/^service\s*=\s*([^&]+)// ) { 1283 $service = $1; 1284 if ($line =~ s/^&label=([^&]+)//) { 1285 $label = $1; 1286 } 1287 } 1288 if ( ! $service ) { 1289 if ( $line =~ /\S+/ ) { 1290 debug(DBWRN, "hostdb: bad format (line $lineno)"); 1291 } 1292 next; 1293 } 1294 $usedefaults = 0; 1295 my ($db, $dblabel); 1296 if ($line ne q()) { 1297 ($db, $dblabel) = parsedb($line); 1298 $db = filterdb($host, $service, $db, $authhosts{hostserv}); 1299 next if scalar @{$db} == 0; 1300 } else { 1301 # find out if there are data for this host-service, but 1302 # do not specify the databases explicitly. 1303 my $x = getdbs($host, $service, \%hsdata); 1304 next if scalar @{$x} == 0; 1305 $db = []; 1306 $dblabel = []; 1307 } 1308 my %info; 1309 $info{host} = $host; 1310 $info{service} = $service; 1311 if ($label ne q()) { $info{service_label} = $label; } 1312 $info{db} = $db; 1313 $info{db_label} = $dblabel; 1314 push @ginfo, \%info; 1315 debug(DBDEB, "readhostdb: match for $host $service $line"); 1316 } 1317 close $DB or debug(DBERR, "close failed for $fn: $OS_ERROR"); 1318 } else { 1319 my $msg = "cannot open hostdb $fn: $OS_ERROR"; 1320 debug(DBERR, $msg); 1321 htmlerror($msg); 1322 die $msg; ## no critic (RequireCarping) 1323 } 1324 } else { 1325 debug(DBINF, 'no hostdb file has been specified'); 1326 } 1327 1328 if ($usedefaults) { 1329 debug(DBDEB, 'readhostdb: using defaults'); 1330 my $defaultds = readdatasetdb(); 1331 my @services = sortnaturally(keys %{$hsdata{$host}}); 1332 foreach my $service (@services) { 1333 my %info; 1334 $info{host} = $host; 1335 $info{service} = $service; 1336 if ($defaultds && $defaultds->{$service}) { 1337 $info{db} = $defaultds->{$service}; 1338 } else { 1339 $info{db} = \@{$hsdata{$host}{$service}}; 1340 } 1341 push @ginfo, \%info; 1342 } 1343 } 1344 1345 dumper(DBDEB, 'readhostdb: graphinfos', \@ginfo); 1346 return \@ginfo; 1347} 1348 1349# Read the servdb file 1350# 1351# This returns a list of hosts that have data for the specified service and db. 1352# 1353# If there is no file defined or if the file contains no hosts, 1354# return all hosts for which data exist for the indicated service and db. 1355# 1356# Hosts are defined with this format: 1357# 1358# host=name[,name1[,name2[...]]] 1359# 1360sub readservdb { 1361 my ($service, $dblist) = @_; 1362 $service ||= q(); 1363 if ($service eq q() || $service eq q(-)) { return (); } 1364 1365 debug(DBDEB, "readservdb($service, " . 1366 ($dblist ? join ', ', @{$dblist} : q()) . ')'); 1367 1368 my $usedefaults = 1; 1369 my @allhosts; 1370 my @validhosts; 1371 if (defined $Config{servdb}) { 1372 my $fn = getcfgfn($Config{servdb}); 1373 if (open my $DB, '<', $fn) { ## no critic (RequireBriefOpen) 1374 my $lineno = 0; 1375 while (my $line = <$DB>) { 1376 chomp $line; 1377 $lineno += 1; 1378 next if $line =~ /^\s*#/; # skip commented lines 1379 $line = cleanline($line); 1380 if ( $line =~ /^host\s*=\s*(.+)/ ) { 1381 $usedefaults = 0; 1382 push @allhosts, split /\s*,\s*/, $1; 1383 } elsif ( $line =~ /\S+/ ) { 1384 debug(DBWRN, "servdb: bad format (line $lineno)"); 1385 } 1386 } 1387 close $DB or debug(DBERR, "close failed for $fn: $OS_ERROR"); 1388 } else { 1389 my $msg = "cannot open servdb $fn: $OS_ERROR"; 1390 debug(DBERR, $msg); 1391 htmlerror($msg); 1392 die $msg; ## no critic (RequireCarping) 1393 } 1394 1395 # check to see if there is a valid database for the host/service 1396 foreach my $host (@allhosts) { 1397 if ($dblist) { 1398 my $db = filterdb($host,$service,$dblist,$authhosts{hostserv}); 1399 if ($db && scalar @{$db} > 0) { 1400 push @validhosts, $host; 1401 } 1402 } else { 1403 my $x = getdbs($host, $service, \%hsdata); 1404 if (scalar @{$x} > 0) { 1405 push @validhosts, $host; 1406 } 1407 } 1408 } 1409 } else { 1410 debug(DBINF, 'no servdb file has been specified'); 1411 } 1412 1413 if ($usedefaults) { 1414 debug(DBDEB, 'readservdb: using defaults'); 1415 @allhosts = sortnaturally(keys %hsdata); 1416 foreach my $host (@allhosts) { 1417 if ($hsdata{$host}{$service} 1418 && scalar @{$hsdata{$host}{$service}} > 0) { 1419 push @validhosts, $host; 1420 } 1421 } 1422 } 1423 1424 dumper(DBDEB, 'readservdb: all hosts', \@allhosts); 1425 dumper(DBDEB, 'readservdb: validated hosts', \@validhosts); 1426 return \@validhosts; 1427} 1428 1429# Read the groupdb file 1430# 1431# This returns a list of graph infos for the specified group and a list 1432# of all group names. 1433# 1434# If there is a group configuration file, then use the contents of that file. 1435# If there is a nagios configuration file, the list of groups will be 1436# automatically generated from the service groups defined in the Nagios 1437# configuration. Automatic generation of groups requires a sufficiently 1438# recent Nagios::Config perl module. 1439# 1440# Groups are defined with this format: 1441# 1442# groupname=host,service[&label=text][&db=db[,ds][&label=text][...]] 1443# 1444sub readgroupdb { 1445 my ($g) = @_; 1446 $g ||= q(); 1447 debug(DBDEB, "readgroupdb($g)"); 1448 1449 if ( ! defined $Config{groupcfgfile} && 1450 ! defined $Config{groupdb} ) { 1451 my $msg = 'No group configuration file(s) specified. To display Nagios service groups, specify the Nagios configuration file using the \'groupcfgfile\' directive. To explicitly enumerate groups, specify them in a file referred to by the \'groupdb\' directive.'; 1452 debug(DBERR, $msg); 1453 htmlerror($msg); 1454 die $msg; ## no critic (RequireCarping) 1455 } 1456 1457 my %gnames; 1458 my @ginfo; 1459 if (defined $Config{groupdb}) { 1460 my $fn = getcfgfn($Config{groupdb}); 1461 if (open my $DB, '<', $fn) { ## no critic (RequireBriefOpen) 1462 my $lineno = 0; 1463 while (my $line = <$DB>) { 1464 chomp $line; 1465 $lineno += 1; 1466 next if $line =~ /^\s*#/; # skip commented lines 1467 $line = cleanline($line); 1468 my $group = q(); 1469 my $host = q(); 1470 my $service = q(); 1471 my $label = q(); 1472 if ( $line =~ s/^([^=]+)\s*=\s*([^,]+)\s*,\s*([^&]+)// ) { 1473 $group = $1; 1474 $host = $2; 1475 $service = $3; 1476 if ($line =~ s/^&label=([^&]+)//) { 1477 $label = $1; 1478 } 1479 } 1480 if ( ! $group || ! $host || ! $service ) { 1481 if ( $line =~ /\S+/ ) { 1482 debug(DBWRN, "groupdb: bad format (line $lineno)"); 1483 } 1484 next; 1485 } 1486 $gnames{$group} = 1; 1487 next if $group ne $g; 1488 my ($db, $dblabel); 1489 if ($line ne q()) { 1490 ($db, $dblabel) = parsedb($line); 1491 $db = filterdb($host, $service, $db, $authhosts{hostserv}); 1492 next if scalar @{$db} == 0; 1493 } else { 1494 # find out if there are data for this host-service, but 1495 # do not specify the databases explicitly. 1496 my $x = getdbs($host, $service, \%hsdata); 1497 next if scalar @{$x} == 0; 1498 $db = []; 1499 $dblabel = []; 1500 } 1501 my %info; 1502 $info{host} = $host; 1503 $info{service} = $service; 1504 if ($label ne q()) { $info{service_label} = $label; } 1505 $info{db} = $db; 1506 $info{db_label} = $dblabel; 1507 push @ginfo, \%info; 1508 debug(DBDEB, "readgroupdb: match for $host $service $line"); 1509 } 1510 close $DB or debug(DBERR, "close failed for $fn: $OS_ERROR"); 1511 } else { 1512 my $msg = "cannot open groupdb $fn: $OS_ERROR"; 1513 debug(DBERR, $msg); 1514 htmlerror($msg); 1515 die $msg; ## no critic (RequireCarping) 1516 } 1517 } else { 1518 debug(DBINF, 'no groupdb file has been specified'); 1519 } 1520 1521 if (defined $Config{groupcfgfile}) { 1522 my $fn = $Config{groupcfgfile}; 1523 if ( ! -f $fn ) { 1524 my $msg = "Cannot read nagios configuration file $fn"; 1525 debug(DBERR, $msg); 1526 htmlerror($msg); 1527 die $msg; ## no critic (RequireCarping) 1528 } 1529 my $rval = eval { require Nagios::Config; }; 1530 if (defined $rval && $rval == 1) { 1531 if ( Nagios::Config->VERSION >= NCONFIG_VERSION ) { 1532 debug(DBDEB, 'readgroupdb: using nagios service groups'); 1533 my $cfg = Nagios::Config->new( Filename => $fn ); 1534 my $objs = $cfg->all_objects_for_type('Nagios::ServiceGroup'); 1535 foreach my $o (@{$objs}) { 1536 my $n = $o->name ? $o->name : q(); 1537 my $a = $o->alias ? $o->alias : q(); 1538 debug(DBDEB, 'readgroupdb: ' . $n . ' (' . $a . ')'); 1539 my $group = $a ne q() ? $a : $n; 1540 $gnames{$group} = 1; 1541 next if $group ne $g; 1542 1543 my $members = $o->members(); 1544 foreach my $m (@{$members}) { 1545 my $h = $m->[0]; 1546 my $s = $m->[1]; 1547 my $hostn = $m->[0]->{host_name}; 1548 my $hosta = $m->[0]->{alias}; 1549 my $servn = $m->[1]->{service_description}; 1550 my $serva = $m->[1]->{display_name}; 1551 1552 my %info; 1553 $info{host} = $hostn; 1554 $info{service} = $servn; 1555 $info{service_label} = $serva; 1556 $info{db} = q(); 1557 $info{db_label} = q(); 1558 push @ginfo, \%info; 1559 debug(DBDEB, "readgroupdb: match for $hostn $servn"); 1560 } 1561 } 1562 } else { 1563 my $msg = 'Incompatible version of Nagios::Object: found version ' . Nagios::Config->VERSION . ' but version ' . NCONFIG_VERSION . ' or higher is required.'; 1564 debug(DBERR, $msg); 1565 htmlerror($msg); 1566 die $msg; ## no critic (RequireCarping) 1567 } 1568 } else { 1569 my $msg = 'Please install the perl module Nagios::Object to obtain groups from the Nagios configuration, or specify groups manually in the groupdb file.'; 1570 debug(DBERR, $msg); 1571 htmlerror($msg); 1572 die $msg; ## no critic (RequireCarping) 1573 } 1574 } 1575 1576 my @gnames = sortnaturally(keys %gnames); 1577 dumper(DBDEB, 'groups', \@gnames); 1578 dumper(DBDEB, 'graphinfos', \@ginfo); 1579 return \@gnames, \@ginfo; 1580} 1581 1582# Default data for services are defined using lines with this format: 1583# 1584# service=name&db=database[,ds-name][&db=database[,ds-name][...]] 1585# 1586# Data sets from the db file are used only if no data sets are specified as 1587# an argument to this subroutine. 1588sub readdatasetdb { 1589 if (! defined $Config{datasetdb} || $Config{datasetdb} eq q()) { 1590 my $msg = 'no datasetdb file has been specified'; 1591 debug(DBDEB, $msg); 1592 my %rval; 1593 return \%rval; 1594 } 1595 1596 my %data; 1597 my $fn = getcfgfn($Config{datasetdb}); 1598 if (open my $DB, '<', $fn) { ## no critic (RequireBriefOpen) 1599 my $lineno = 0; 1600 while (my $line = <$DB>) { 1601 chomp $line; 1602 $lineno += 1; 1603 next if $line =~ /^\s*#/; # skip commented lines 1604 $line = cleanline($line); 1605 if ( $line =~ /^service\s*=\s*([^&]+)(.+)/ ) { 1606 my $service = $1; 1607 my $dbstr = $2; 1608 my ($db, $dblabel) = parsedb($dbstr); 1609 $data{$service} = $db; 1610 debug(DBDEB, 'readdatasetdb: match for ' . $line); 1611 } elsif ( $line =~ /\S+/ ) { 1612 debug(DBWRN, "datasetdb: bad format (line $lineno)"); 1613 } 1614 } 1615 close $DB or debug(DBERR, "close failed for $fn: $OS_ERROR"); 1616 } else { 1617 my $msg = "cannot open datasetdb $fn: $OS_ERROR"; 1618 debug(DBERR, $msg); 1619 htmlerror($msg); 1620 die $msg; ## no critic (RequireCarping) 1621 } 1622 1623 dumper(DBDEB, 'readdatasetdb: data sets', \%data); 1624 return \%data; 1625} 1626 1627# Get list of matching rrd files 1628# unescape the filenames as we read in since they should be escaped on disk 1629sub dbfilelist { 1630 my ($host, $serv) = @_; 1631 my @files; 1632 debug(DBDEB, "dbfilelist($host, $serv)"); 1633 if ($host ne q() && $host ne q(-) && $serv ne q() && $serv ne q(-)) { 1634 my ($directory, $filename) = mkfilename($host, $serv); 1635 debug(DBDEB, "dbfilelist: scanning $directory for $filename"); 1636 if (opendir DH, $directory) { 1637 while (my $entry=readdir DH) { 1638 next if $entry =~ /^\./; 1639 if ($entry =~ /^${filename}(.+)\.rrd$/) { 1640 push @files, unescape($1); 1641 } 1642 } 1643 closedir DH or debug(DBERR, "cannot close $directory: $OS_ERROR"); 1644 } else { 1645 debug(DBERR, "cannot open directory $directory: $OS_ERROR"); 1646 } 1647 } 1648 dumper(DBDEB, 'dbfilelist: files', \@files); 1649 return \@files; 1650} 1651 1652# Graphing routines ########################################################### 1653# Return a list of the data 'lines' in an rrd file 1654sub getdataitems { 1655 my ($file) = @_; 1656 my ($ds, # return value from RRDs::info 1657 %dupes); # temporary hash to filter duplicate values with 1658 if (-f $file) { 1659 $ds = RRDs::info($file); 1660 } else { 1661 $ds = RRDs::info("$Config{rrddir}/$file"); 1662 } 1663 my $ERR = RRDs::error(); 1664 if ($ERR) { 1665 debug(DBERR, 'RRDs::info ERR ' . $ERR); 1666 dumper(DBERR, 'ds', $ds); 1667 } 1668 return grep { ! $dupes{$_}++ } # filters duplicate data set names 1669 map { /ds\[(.*)\]/ and $1 } # returns just the data set names 1670 grep { /ds\[(.*)\]/ } keys %{$ds}; # gets just the data set fields 1671} 1672 1673# Find graphs and values 1674sub graphinfo { 1675 my ($host, $service, $db) = @_; 1676 debug(DBDEB, "graphinfo: host=$host service=$service"); 1677 dumper(DBDEB, 'graphinfo: db', $db); 1678 1679 my ($hs, # host/service 1680 @rrd, # the returned list of hashes 1681 $ds); 1682 1683 if (defined $Config{dbseparator} && $Config{dbseparator} eq 'subdir') { 1684 $hs = $host . q(/) . escape("$service") . q(___); 1685 } else { 1686 $hs = escape("${host}_${service}") . q(_); 1687 } 1688 1689 # Determine which files to read lines from 1690 if ($db && scalar @{$db} > 0) { 1691 my $nn = 0; 1692 for my $dd (@{$db}) { 1693 my ($dbname, @lines) = split /,/, $dd; # db filename, data sources 1694 $rrd[$nn]{file} = $hs . escape("$dbname") . RRDEXT; 1695 $rrd[$nn]{dbname} = $dbname; 1696 for my $ll (@lines) { 1697 my ($line, $unit) = split /~/, $ll; 1698 if ($unit) { 1699 $rrd[$nn]{line}{$line}{unit} = $unit; 1700 } else { 1701 $rrd[$nn]{line}{$line} = 1; 1702 } 1703 } 1704 $nn++; 1705 } 1706 debug(DBDEB, "graphinfo: Specified $hs db files in $Config{rrddir}: " 1707 . join ', ', map { $_->{file} } @rrd); 1708 } else { 1709 @rrd = map {{ file=>$_ }} 1710 map { "${hs}${_}.rrd" } 1711 @{dbfilelist($host, $service)}; 1712 debug(DBDEB, "graphinfo: Listing $hs db files in $Config{rrddir}: " 1713 . join ', ', map { $_->{file} } @rrd); 1714 } 1715 1716 foreach my $rrd ( @rrd ) { 1717 if (not $rrd->{line}) { 1718 foreach my $ii (getdataitems($rrd->{file})) { 1719 $rrd->{line}{$ii} = 1; 1720 } 1721 debug(DBDEB, "graphinfo: DS $rrd->{file} lines: " 1722 . join ', ', keys %{$rrd->{line}}); 1723 } 1724 if (not $rrd->{dbname}) { 1725 if ($rrd->{file} =~ /___(.*).rrd/) { 1726 $rrd->{dbname} = unescape($1); 1727 } elsif ($rrd->{file} =~ /_(.*).rrd/) { 1728 $rrd->{dbname} = unescape($1); 1729 } 1730 debug(DBDEB, "graphinfo: DS $rrd->{file} dbname: " 1731 . $rrd->{dbname}); 1732 } 1733 } 1734 1735 dumper(DBDEB, 'graphinfo: rrd', \@rrd); 1736 return \@rrd; 1737} 1738 1739# return the first instance of a match for host, service, db, datasource 1740sub gethsddvalue { ## no critic (ProhibitManyArgs) 1741 my ($key, $dflt, $host, $service, $db, $ds) = @_; 1742 return gethsdd('DS', $key, $dflt, $host, $service, $db, $ds); 1743} 1744 1745# return the first instance of a match for the host, service, and database. 1746sub gethsdvalue { 1747 my ($key, $dflt, $host, $service, $db) = @_; 1748 return gethsdd('S', $key, $dflt, $host, $service, $db); 1749} 1750 1751# similar to gethsdvalue, but use the non-list key first if one is defined. 1752sub gethsdvalue2 { 1753 my ($key, $val, $host, $service, $db) = @_; 1754 my $x = $val; 1755 if ( defined $Config{$key} ) { 1756 $x = $Config{$key}; 1757 } 1758 return gethsdd('S', $key, $x, $host, $service, $db); 1759} 1760 1761# return the first instance of a match for the host, service, database, and 1762# datasource. 1763sub gethsdd { ## no critic (ProhibitManyArgs) 1764 my ($pri, $key, $dflt, $host, $service, $db, $ds) = @_; 1765 my $value = $dflt; 1766 if ( defined $Config{$key . 'list'} ) { 1767 foreach my $item (@{$Config{$key . 'list'}}) { 1768 my ($p, $v); 1769 if ($item =~ /=/) { 1770 ($p,$v) = split /=/, $item; 1771 } else { 1772 ($p,$v) = ($item, 1); 1773 } 1774 if (hsddmatch($key, $p, $pri, $host, $service, $db, $ds)) { 1775 $value = $v; 1776 last; 1777 } 1778 } 1779 } 1780 return $value; 1781} 1782 1783# return 1 if we have a match, 0 otherwise. 1784# there are different matching patterns, depending on whether the priority is 1785# the datasource (ds) or the service (s). the pattern matching expects four 1786# fields, so format the components depending on how many fields are in the 1787# match string. 1788# 1789# datasource 1790# datasource 1791# database,datasource 1792# service,database,datasource 1793# host,service,database,datasource 1794# 1795# service 1796# service 1797# service,database 1798# host,service,database 1799# 1800sub hsddmatch { ## no critic (ProhibitManyArgs) 1801 my ($key, $str, $priority, $host, $service, $db, $ds) = @_; 1802 $host ||= q(); 1803 $service ||= q(); 1804 $db ||= q(); 1805 $ds ||= q(); 1806 my $count = $str =~ s/(,)/$1/g; 1807 my $tuple = 'BOGUS_PATTERN'; 1808 if ($priority eq 'DS') { 1809 if ($count == 0) { 1810 $tuple = $ds; 1811 } elsif ($count == 1) { 1812 $tuple = "$db,$ds"; 1813 } elsif ($count == 2) { 1814 $tuple = "$service,$db,$ds"; 1815 } elsif ($count == 3) { 1816 $tuple = "$host,$service,$db,$ds"; 1817 } else { 1818 debug(DBDEB, "in config '$key', bad pattern '$str': expecting 1 to 4 parts, found " . ($count+1)); 1819 } 1820 } else { 1821 if ($count == 0) { 1822 $tuple = $service; 1823 } elsif ($count == 1) { 1824 $tuple = "$service,$db"; 1825 } elsif ($count == 2) { 1826 $tuple = "$host,$service,$db"; 1827 } else { 1828 debug(DBDEB, "in config '$key', bad pattern '$str': expecting 1 to 3 parts, found " . ($count+1)); 1829 } 1830 } 1831 1832 return $tuple =~ /^${str}$/ ? 1 : 0; 1833} 1834 1835# FIXME: support old-style formatting of linestyle 1836sub getlineattr { 1837 my ($host,$service,$db,$ds) = @_; 1838 my $stack = gethsddvalue('stack', 0, $host, $service, $db, $ds) ? 1 : 0; 1839 my $linestyle = $Config{plotas}; 1840 foreach my $ii (qw(LINE1 LINE2 LINE3 AREA TICK)) { 1841 if (gethsddvalue('plotas' . $ii, 0, $host, $service, $db, $ds)) { 1842 $linestyle = $ii; 1843 last; 1844 } 1845 } 1846 my $linecolor = q(); 1847 if (defined $Config{lineformat}) { 1848 my $tuple = gethsddvalue('lineformat', q(), $host, $service, $db, $ds); 1849 if ($tuple ne q()) { 1850 my @values = split /,/, $tuple; 1851 foreach my $value (@values) { 1852 if ($value eq 'LINE1' || $value eq 'LINE2' || 1853 $value eq 'LINE3' || $value eq 'AREA' || 1854 $value eq 'TICK') { 1855 $linestyle = $value; 1856 } elsif ($value =~ /[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]+/) { 1857 $linecolor = $value; 1858 } elsif ($value eq 'STACK') { 1859 $stack = 1; 1860 } 1861 } 1862 } 1863 } 1864 if ($linecolor eq q()) { 1865 $linecolor = hashcolor($ds); 1866 } 1867 return $linestyle, $linecolor, $stack; 1868} 1869 1870# the rrd vname can contain only A-Za-z0-9_- and must be no more than 255 long 1871sub mkvname { 1872 my ($dbname, $dsname) = @_; 1873 my $vname = $dbname . '_' . $dsname; 1874 $vname =~ s/[^A-Za-z0-9_-]/_/g; 1875 if (length $vname > 255) { 1876 $vname = substr $vname, 0, 255; 1877 } 1878 return $vname; 1879} 1880 1881# prepare a string for the rrd graph legend. pad with trailing spaces. 1882# escape colons so they do not confuse rrdtool 1883sub mklegend { 1884 my ($s, $maxlen) = @_; 1885 $s =~ s/\\/\\\\/g; 1886 $s =~ s/:/\\:/g; 1887 return sprintf "%-${maxlen}s", $s; 1888} 1889 1890# TODO: enable per-host/service/db/ds formats 1891sub getformat { 1892 my ($host, $service, $db, $ds) = @_; 1893 return DEFAULT_FORMAT; 1894} 1895 1896sub getgeom { 1897 my ($config, $geom) = @_; 1898 my $w = GRAPHWIDTH; 1899 my $h = GRAPHHEIGHT; 1900 if ($geom && $geom ne DEFAULT) { 1901 ($w, $h) = split /x/, $geom; 1902 } elsif (defined $config->{default_geometry}) { 1903 ($w, $h) = split /x/, $config->{default_geometry}; 1904 } 1905 return ($w, $h); 1906} 1907 1908sub setlabels { ## no critic (ProhibitManyArgs) 1909 my ($host, $serv, $dbname, $dsname, $file, $label, $maxlen) = @_; 1910 debug(DBDEB, "setlabels($host, $serv, $dbname, $dsname, $file, $maxlen)"); 1911 my @ds; 1912 my $id = mkvname($dbname, $dsname); 1913 my $legend = mklegend($label, $maxlen); 1914 my ($linestyle, $linecolor, $stack) = 1915 getlineattr($host, $serv, $dbname, $dsname); 1916 my $sdef = $stack ? ':STACK' : q(); 1917 if (gethsdvalue('maximums', 0, $host, $serv, $dbname)) { 1918 push @ds, "DEF:$id=$file:$dsname:MAX" 1919 , "CDEF:ceil$id=$id,CEIL" 1920 , "$linestyle:${id}#$linecolor:$legend$sdef"; 1921 } elsif (gethsdvalue('minimums', 0, $host, $serv, $dbname)) { 1922 push @ds, "DEF:$id=$file:$dsname:MIN" 1923 , "CDEF:floor$id=$id,FLOOR" 1924 , "$linestyle:${id}#$linecolor:$legend$sdef"; 1925 } else { 1926 my $t = gethsdvalue('lasts', 0, $host, $serv, $dbname) ? 1927 'LAST' : 'AVERAGE'; 1928 push @ds, "DEF:${id}=$file:$dsname:$t"; 1929 if (gethsddvalue('negate', 0, $host, $serv, $dbname, $dsname)) { 1930 push @ds, "CDEF:${id}_neg=${id},-1,*" 1931 , "$linestyle:${id}_neg#$linecolor:$legend$sdef"; 1932 } else { 1933 push @ds, "$linestyle:${id}#$linecolor:$legend$sdef"; 1934 } 1935 } 1936 return @ds; 1937} 1938 1939sub setdata { ## no critic (ProhibitManyArgs) 1940 my ($serv, $dbname, $dsname, $file, $dur, $fmt) = @_; 1941 my $format = defined $fmt && $fmt ne q() ? $fmt : DEFAULT_FORMAT; 1942 debug(DBDEB, "setdata($serv, $dbname, $dsname, $file, $dur, $format)"); 1943 my @ds; 1944 my $id = mkvname($dbname, $dsname); 1945 if ($dur > 120_000) { # long enough to start getting summation 1946 if (defined $Config{withmaximums}->{$serv}) { 1947 my $maxcolor = (defined $Config{colormax} 1948 ? $Config{colormax} : COLORMAX); 1949 push @ds, "DEF:${id}_max=${file}_max:$dsname:MAX" 1950 , "LINE1:${id}_max#${maxcolor}:" . _('maximum'); 1951 } 1952 if (defined $Config{withminimums}->{$serv}) { 1953 my $mincolor = (defined $Config{colormin} 1954 ? $Config{colormin} : COLORMIN); 1955 push @ds, "DEF:${id}_min=${file}_min:$dsname:MIN" 1956 , "LINE1:${id}_min#${mincolor}:" . _('minimum'); 1957 } 1958 if (defined $Config{withmaximums}->{$serv}) { 1959 push @ds, "CDEF:${id}_maxif=${id}_max,UN" 1960 , "CDEF:${id}_maxi=${id}_maxif,${id},${id}_max,IF" 1961 , "GPRINT:${id}_maxi:MAX:Max\\:$format"; 1962 } else { 1963 push @ds, "GPRINT:$id:MAX:Max\\:$format"; 1964 } 1965 push @ds, "GPRINT:$id:AVERAGE:Avg\\:$format"; 1966 if (defined $Config{withminimums}->{$serv}) { 1967 push @ds, "CDEF:${id}_minif=${id}_min,UN" 1968 , "CDEF:${id}_mini=${id}_minif,${id},${id}_min,IF" 1969 , "GPRINT:${id}_mini:MIN:Min\\:$format\\n" 1970 } else { 1971 push @ds, "GPRINT:$id:MIN:Min\\:$format\\n" 1972 } 1973 } else { 1974 push @ds, "GPRINT:$id:MAX:Max\\:$format" 1975 , "GPRINT:$id:AVERAGE:Avg\\:$format" 1976 , "GPRINT:$id:MIN:Min\\:$format" 1977 , "GPRINT:$id:LAST:Cur\\:$format\\n"; 1978 } 1979 return @ds; 1980} 1981 1982# Generate all the parameters for rrd to produce a graph 1983sub rrdline { 1984 my ($params) = @_; 1985 dumper(DBDEB, 'rrdline: params', $params); 1986 1987 my @ds; 1988 my $host = $params->{host}; 1989 my $service = $params->{service}; 1990 my $db = $params->{db}; 1991 my ($graphinfo) = graphinfo($host, $service, $db); 1992 1993 my $errmsg = q(); 1994 if (scalar @{$graphinfo} == 0) { 1995 $errmsg = 'No data available: host=' . $host . ' service=' . $service; 1996 if ($db) { $errmsg .= ' db=' . join q(,), @{$db}; } 1997 } else { 1998 foreach my $ii (@{$graphinfo}) { 1999 my @lines = keys %{$ii->{line}}; 2000 if (scalar @lines == 0) { 2001 if ($errmsg ne q()) { $errmsg .= "\n"; } 2002 $errmsg .= 'No data available: host=' . $host . ' service=' . $service . ' db=' . $ii->{dbname}; 2003 } 2004 } 2005 } 2006 if ($errmsg ne q()) { 2007 return \@ds, $errmsg; 2008 } 2009 2010 # assimilate any labels that were specified 2011 if (defined $params->{label}) { 2012 foreach my $k (@{$params->{label}}) { 2013 if ( $k =~ /([^:]+):(.+)/ ) { 2014 $Labels{$1} = $2; 2015 } 2016 } 2017 } 2018 2019 my $fixedscale = 0; 2020 if (defined $params->{fixedscale}) { 2021 $fixedscale = $params->{fixedscale}; 2022 } 2023 my $duration = 118_800; 2024 if (defined $params->{period} && $PERIOD_DATA{$params->{period}}) { 2025 $duration = $PERIOD_DATA{$params->{period}}[1]; 2026 } 2027 my $offset = 0; 2028 if (defined $params->{offset} && $params->{offset} ne q()) { 2029 $offset = $params->{offset}; 2030 } 2031 2032 # start with global rrdopts from the config file 2033 my $rrdopts = mergeopts(q(), $Config{rrdoptshash}{global}); 2034 # add options for the specified service 2035 $rrdopts = mergeopts($rrdopts, $Config{rrdoptshash}{$service}); 2036 # add options from the parameters 2037 $rrdopts = mergeopts($rrdopts, $params->{rrdopts}); 2038 2039 # use duration and offset from rrdopts if they were specified there. 2040 # this assumes formatting from printgraphicslinks. 2041 if ($rrdopts =~ /-enow-(\d+)/) { 2042 $offset = $1; 2043 } 2044 if ($rrdopts =~ /-snow-(\d+)/) { 2045 $duration = $1 - $offset; 2046 } 2047 2048 # build the list of arguments for rrdtool 2049 push @ds, q(-); 2050 if (index($rrdopts, '-a') == -1 && index($rrdopts, '--imgformat') == -1) { 2051 push @ds, '-a', 'PNG'; 2052 } 2053 if (index($rrdopts, '-s') == -1 && index($rrdopts, '--start') == -1) { 2054 my $s = $duration + $offset; 2055 push @ds, '-s', "now-$s"; 2056 } 2057 if (index($rrdopts, '-e') == -1 && index($rrdopts, '--end') == -1) { 2058 push @ds, '-e', "now-$offset"; 2059 } 2060 2061 # Identify where to pull data from and what to call it 2062 my $directory = $Config{rrddir}; 2063 # Compute the longest label length 2064 my $longest = 0; 2065 for my $ii (@{$graphinfo}) { 2066 my $dbname = $ii->{dbname}; 2067 foreach my $dsname (keys %{$ii->{line}}) { 2068 my $label = getdatalabel("$dbname,$dsname"); 2069 if (length $label > $longest) { 2070 $longest = length $label; 2071 } 2072 } 2073 } 2074 # now get the data and labels. apply fixed scaling to the vertical axis 2075 # if all of the data sources are fixed scale or if fixed scaling was 2076 # explicitly specified. 2077 for my $ii (@{$graphinfo}) { 2078 my $file = $ii->{file}; 2079 my $dbname = $ii->{dbname}; 2080 my $fn = "$directory/$file"; 2081 dumper(DBDEB, 'rrdline: this graphinfo entry', $ii); 2082 my $allfixed = 1; 2083 for my $dsname (sortnaturally(keys %{$ii->{line}})) { 2084 my ($serv, $pos) = ($service, length($service) - length $dsname); 2085 if (substr($service, $pos) eq $dsname) { 2086 $serv = substr $service, 0, $pos; 2087 } 2088 my $label = getdatalabel("$dbname,$dsname"); 2089 push @ds, setlabels($host, $serv, $dbname, $dsname, 2090 "$fn", $label, $longest); 2091 my $fmt = $fixedscale ? 2092 FIXED_SCALE_FORMAT : getformat($host, $serv, $dbname, $dsname); 2093 if (gethsddvalue('fixedscale', 0, $host, $serv, $dbname, $dsname)) { 2094 $fmt = FIXED_SCALE_FORMAT; 2095 } else { 2096 $allfixed = 0; 2097 } 2098 push @ds, setdata($serv, $dbname, $dsname, "$fn", $duration, $fmt); 2099 } 2100 $fixedscale = 1 if $allfixed; 2101 } 2102 2103 # Dimensions of graph 2104 my ($w, $h) = getgeom(\%Config, $params->{geom}); 2105 if ($w > 0 && index($rrdopts, '-w') == -1) { 2106 push @ds, '-w', $w; 2107 } 2108 if ($h > 0 && index($rrdopts, '-h') == -1) { 2109 push @ds, '-h', $h; 2110 } 2111 2112 # Additional parameters to rrd graph, if specified 2113 my $opt = q(); 2114 foreach my $ii (split /\s+/, $rrdopts) { 2115 if (substr($ii, 0, 1) eq q(-)) { 2116 $opt = $ii; 2117 push @ds, $opt; 2118 } else { 2119 if ($ds[-1] eq $opt) { 2120 push @ds, $ii; 2121 } else { 2122 $ds[-1] .= " $ii"; 2123 } 2124 } 2125 } 2126 if ($fixedscale && index($rrdopts, '-X') == -1) { 2127 push @ds, '-X', '0'; 2128 } 2129 foreach my $ii (['altautoscale', '-A'], 2130 ['altautoscalemin', '-J'], 2131 ['altautoscalemax', '-M'], 2132 ['nogridfit', '-N'], 2133 ['logarithmic', '-o']) { 2134 push @ds, addopt($ii->[0], $service, $rrdopts, $ii->[1]); 2135 } 2136 return \@ds, q(); 2137} 2138 2139sub addopt { 2140 my ($conf, $service, $rrdopts, $rrdopt) = @_; 2141 my @ds; 2142 if (defined $Config{$conf} 2143 and exists $Config{$conf}{$service} 2144 and index($rrdopts, $rrdopt) == -1) { 2145 push @ds, $rrdopt; 2146 } 2147 return @ds; 2148} 2149 2150# FIXME: at some point it might be nice to replace args in a with corresponding 2151# args from b. for now we just append everything in b to a. 2152sub mergeopts { 2153 my ($a, $b) = @_; 2154 $b ||= q(); 2155 return $a . ($b eq q() ? q() : q( ) . $b); 2156} 2157 2158# Server/service menu routines ################################################ 2159# scan the rrd files and populate the hsdata object with the result. 2160sub scanhsdata { 2161 if (defined $Config{dbseparator} && $Config{dbseparator} eq 'subdir') { 2162 File::Find::find(\&scanhierarchy, $Config{rrddir}); 2163 } else { 2164 File::Find::find(\&scandirectory, $Config{rrddir}); 2165 } 2166 return; 2167} 2168 2169# scan for rrd files in a directory hierarchy. build a hash with the result. 2170sub scanhierarchy { 2171 my $current = $_; 2172 my $rrdlen = 0 - length RRDEXT; 2173 if (-d $current and substr($current, 0, 1) ne q(.)) { 2174 # Directories are for hostnames 2175 if (not checkdirempty($current)) { %{$hsdata{$current}} = (); } 2176 } elsif (-f $current && substr($current, $rrdlen) eq RRDEXT) { 2177 # Files are for services 2178 my $host = $File::Find::dir; 2179 $host =~ s|^$Config{rrddir}/||; 2180 # We got the server to associate with and now 2181 # we get the service name by splitting on separator 2182 my ($service, $db) = split /___/, $current; 2183 if ($db) { $db = substr $db, 0, $rrdlen; } 2184 if (not exists $hsdata{$host}{unescape($service)}) { 2185 @{$hsdata{$host}{unescape($service)}} = (unescape($db)); 2186 } else { 2187 push @{$hsdata{$host}{unescape($service)}}, unescape($db); 2188 } 2189 } 2190 return; 2191} 2192 2193# scan for rrd files in a single directory. build a hash with the result. 2194sub scandirectory { 2195 my $current = $_; 2196 my $rrdlen = 0 - length RRDEXT; 2197 if (-f $current && substr($current, $rrdlen) eq RRDEXT) { 2198 my $fn = substr $current, 0, $rrdlen; 2199 my ($host, $service, $db) = split /_/, $fn; 2200 if ($host && $service && $db) { 2201 if (not exists $hsdata{$host}{unescape($service)}) { 2202 @{$hsdata{$host}{unescape($service)}} = (unescape($db)); 2203 } else { 2204 push @{$hsdata{$host}{unescape($service)}}, unescape($db); 2205 } 2206 } 2207 } 2208 return; 2209} 2210 2211# get the list of hosts and services for which the user has permission. the 2212# userid does nothing in this subroutine - it is just used in the messages. 2213sub getserverlist { 2214 my($userid) = @_; 2215 $userid ||= q(); 2216 debug(DBDEB, 'getserverlist(' . $userid . ')'); 2217 2218 my @hosts; 2219 foreach my $ii (sortnaturally(keys %hsdata)) { 2220 if (havepermission($ii)) { 2221 push @hosts, $ii; 2222 } else { 2223 debug(DBINF, "permission denied: user $userid, host $ii"); 2224 } 2225 } 2226 2227 my %hostserv; # hash of hosts, services, and data 2228 foreach my $ii (@hosts) { 2229 my @services = sortnaturally(keys %{$hsdata{$ii}}); 2230 foreach my $jj (@services) { 2231 if ( ! havepermission($ii, $jj) ) { 2232 debug(DBINF, "permission denied: user $userid, host $ii, service $jj"); 2233 next; 2234 } 2235 foreach my $kk (@{$hsdata{$ii}{$jj}}) { 2236 my @dataitems = 2237 getdataitems(join q(/), mkfilename($ii, $jj, $kk)); 2238 if (not exists $hostserv{$ii}) { 2239 $hostserv{$ii} = {}; 2240 } 2241 if (not exists $hostserv{$ii}{$jj}) { 2242 $hostserv{$ii}{$jj} = []; 2243 } 2244 push @{$hostserv{$ii}{$jj}}, [$kk, @dataitems]; 2245 } 2246 } 2247 } 2248 #dumper(DBDEB, 'hosts', \@hosts); 2249 #dumper(DBDEB, 'hosts-services', \%hostserv); 2250 return ( host => [@hosts], hostserv => \%hostserv ); 2251} 2252 2253# Create Javascript i18n string constants 2254sub printi18nscript { 2255 if ( ! defined $Config{javascript} || $Config{javascript} eq q() ) { 2256 return q(); 2257 } 2258 my $rval = "var i18n = {\n"; 2259 foreach my $ii (@JSLABELS) { 2260 $rval .= ' "' . $ii . '": \'' . _($ii) . "',\n"; 2261 } 2262 $rval .= "};\n"; 2263 return "<script type=\"text/javascript\">\n" . $rval . "</script>\n"; 2264} 2265 2266# Create Javascript Arrays for client-side menu navigation 2267sub printmenudatascript { 2268 my ($hosts, $lookup) = @_; 2269 2270 if ( ! defined $Config{javascript} || $Config{javascript} eq q() ) { 2271 return q(); 2272 } 2273 2274 my $rval .= "menudata = new Array();\n"; 2275 for my $ii (0 .. @{$hosts} - 1) { 2276 $rval .= "menudata[$ii] = [\"$hosts->[$ii]\"\n"; 2277 my @services = sortnaturally(keys %{$hsdata{$hosts->[$ii]}}); 2278 #dumper(DBDEB, 'printmenudatascript: keys', \@services); 2279 foreach my $jj (@services) { 2280 my $s = $jj; 2281 $s =~ s/\\/\\\\/g; 2282 $rval .= " ,[\"$s\","; 2283 my %dsstr; 2284 foreach my $kk (@{$lookup->{$hosts->[$ii]}{$jj}}) { 2285 my $name = q(); 2286 my @ds; 2287 foreach my $x (@{$kk}) { 2288 $x =~ s/\\/\\\\/g; 2289 if ($name eq q()) { 2290 $name = $x; 2291 } else { 2292 push @ds, $x; 2293 } 2294 } 2295 $dsstr{$name} = '["' . $name . '","' . join('","', sortnaturally(@ds)) . '"]'; 2296 } 2297 my $c = 0; 2298 foreach my $dsn (sortnaturally(keys %dsstr)) { 2299 $rval .= q(,) if $c; 2300 $rval .= $dsstr{$dsn}; 2301 $c = 1; 2302 } 2303 $rval .= "]\n"; 2304 } 2305 $rval .= "];\n"; 2306 } 2307 return "<script type=\"text/javascript\">\n" . $rval . "</script>\n"; 2308} 2309 2310# Create Javascript Arrays for default service listings. 2311# 2312# sample input: 2313# ( "net", ( "bytes-received", "bytes-transmitted" ), 2314# "ping", ( "rta,rtaloss", "ping,loss" ) 2315# ) 2316# 2317# sample output: 2318# defaultds = new Array(); 2319# defaultds[0] = ["net", "bytes-received", "bytes-transmitted" ]; 2320# defaultds[1] = ["ping", "rta,rtaloss", "ping,loss"]; 2321# 2322sub printdefaultsscript { 2323 my ($dsref) = @_; 2324 2325 if ( ! defined $Config{javascript} || $Config{javascript} eq q() ) { 2326 return q(); 2327 } 2328 2329 my $rval = "defaultds = new Array();\n"; 2330 if ($dsref) { 2331 my %dsdata = %{$dsref}; 2332 my @keys = keys %dsdata; 2333 for my $ii (0 .. @keys - 1) { 2334 $rval .= "defaultds[$ii] = [\"$keys[$ii]\""; 2335 foreach my $ds (@{$dsdata{$keys[$ii]}}) { 2336 $rval .= ", \"$ds\""; 2337 } 2338 $rval .= "];\n"; 2339 } 2340 } 2341 return "<script type=\"text/javascript\">\n" . $rval . "</script>\n"; 2342} 2343 2344sub printincludescript { 2345 if ( ! defined $Config{javascript} || $Config{javascript} eq q() ) { 2346 return q(); 2347 } 2348 return "<script type=\"text/javascript\" src=\"$Config{javascript}\"></script>\n"; 2349} 2350 2351# emit the javascript that configures the web page. this has to be at the 2352# end of the web page so that all elements have a chance to be instantiated 2353# before the javascript is invoked. 2354sub printinitscript { 2355 my ($host, $service, $expanded_periods) = @_; 2356 if ( ! defined $Config{javascript} || $Config{javascript} eq q() ) { 2357 return q(); 2358 } 2359 return "<script type=\"text/javascript\">cfgMenus(\'$host\',\'$service\',\'$expanded_periods\');</script>\n"; 2360} 2361 2362# there are 4 contexts: show, showhost, showservice, showgroup. 2363# show displays both host and service menus. 2364# showhost displays the host menu. 2365# showservice displays the service menu. 2366# showgroup displays the groups menu. 2367# 2368# primary controls consist of the host/service/group menus and the 2369# update button. secondary controls are all the others. 2370# 2371# the host and group contexts do not require javascript updates when the 2372# menus change, since there are no dependencies in those contexts. 2373sub printcontrols { 2374 my ($cgi, $opts) = @_; 2375 2376 my $context = $opts->{call}; 2377 2378 # FIXME: prolly not necessary since we fabricate the submit in javascript. 2379 my %script = qw(both show.cgi host showhost.cgi service showservice.cgi group showgroup.cgi); 2380 my $action = $Config{nagiosgraphcgiurl} . q(/) . $script{$context}; 2381 2382 # preface the geometry list with a default entry no matter what 2383 my @geom = (DEFAULT, split /,/, $Config{geometries}); 2384 my %geom_labels; 2385 foreach my $i (@geom) { 2386 $geom_labels{$i} = _($i); 2387 } 2388 my %period_labels; 2389 foreach my $i (@PERIOD_KEYS) { 2390 $period_labels{$i} = _($PERIOD_LABELS{$i}); 2391 } 2392 2393 my $menustr = q(); 2394 if ($context eq 'both') { 2395 my $host = $opts->{host}; 2396 my $service = $opts->{service}; 2397 $menustr = $cgi->span({-class => 'selector'}, 2398 _('Host:') . q( ) . 2399 $cgi->popup_menu(-name => 'servidors', 2400 -onChange => 'hostChange()', 2401 -values => [$host], 2402 -default => $host)) . "\n"; 2403 $menustr .= $cgi->span({-class => 'selector'}, 2404 _('Service:') . q( ) . 2405 $cgi->popup_menu(-name => 'services', 2406 -onChange => 'serviceChange()', 2407 -values => [$service], 2408 -default => $service)); 2409 } elsif ($context eq 'host') { 2410 my $host = $opts->{host}; 2411 $menustr = $cgi->span({-class => 'selector'}, 2412 _('Host:') . q( ) . 2413 $cgi->popup_menu(-name => 'servidors', 2414 -values => [$host], 2415 -default => $host)); 2416 } elsif ($context eq 'service') { 2417 my $service = $opts->{service}; 2418 $menustr = $cgi->span({-class => 'selector'}, 2419 _('Service:') . q( ) . 2420 $cgi->popup_menu(-name => 'services', 2421 -onChange => 'serviceChange()', 2422 -values => [$service], 2423 -default => $service)); 2424 } elsif ($context eq 'group') { 2425 my $group = $opts->{group}; 2426 my @groups = (q(-), @{$opts->{grouplist}}); 2427 $menustr = $cgi->span({-class => 'selector'}, 2428 _('Group:') . q( ) . 2429 $cgi->popup_menu(-name => 'groups', 2430 -values => [@groups], 2431 -default => $group)); 2432 } 2433 2434 return $cgi-> 2435 div({-class => 'controls'}, "\n" . 2436 $cgi->start_form(-method => 'GET', 2437 -action => $action, 2438 -name => 'menuform'), 2439 $cgi->div({-class => 'primary_controls'}, "\n", 2440 $menustr, "\n", 2441 $cgi->span({-class => 'executor'}, 2442 $cgi->button(-name => 'go', 2443 -label => _('Update Graphs'), 2444 -onClick => 'jumpto()') 2445 ), "\n", 2446 ), "\n", 2447 $cgi->div({-class => 'secondary_controls'}, "\n", 2448 $cgi->span({-class => 'controls_toggle'}, 2449 '<button type="button" onClick="toggleControlsDisplay(this)">', 2450 $cgi->img({src => IMG_PLUS}), 2451 $cgi->img({style => 'display:none', src => IMG_MINUS}), 2452 '</button>' 2453 ), "\n", 2454 ), "\n", 2455 $cgi->div({-id => 'secondary_controls_box', -style => 'display:none'}, "\n", 2456 $cgi->table($cgi->Tr({-valign => 'top'}, "\n", 2457 $cgi->td(($context eq 'both' || $context eq 'service') 2458 ? $cgi->table($cgi->Tr({-valign => 'top', -id => 'db_controls' }, "\n", 2459 $cgi->td({-class => 'control_label'}, _('Data Sets:')), "\n", 2460 $cgi->td($cgi->popup_menu(-name => 'db', -values => [], -size => DBLISTROWS, -multiple => 1)), "\n", 2461 $cgi->td($cgi->button(-name => 'clear', -label => _('Clear'), -onClick => 'clearDBSelection()')), "\n", 2462 ), "\n", 2463 ) . "\n" 2464 : q()), "\n", 2465 $cgi->td($cgi->table($cgi->Tr({-valign => 'top'}, "\n", 2466 $cgi->td({-class => 'control_label'}, _('Periods:')), "\n", 2467 $cgi->td($cgi->popup_menu(-name => 'period', -values => [@PERIOD_KEYS], -labels => \%period_labels, -size => PERIODLISTROWS, -multiple => 1)), "\n", 2468 $cgi->td($cgi->button(-name => 'clear', -label => _('Clear'), -onClick => 'clearPeriodSelection()')), "\n", 2469 ), "\n", 2470 $cgi->Tr($cgi->td({-class => 'control_label'}, _('Size:')), "\n", 2471 $cgi->td($cgi->popup_menu(-name => 'geom', -values => [@geom], -labels => \%geom_labels)), "\n", 2472 $cgi->td(q( )), "\n", 2473 ), "\n", 2474 $cgi->Tr($cgi->td({-class => 'control_label'}, _('End Date:')), "\n", 2475 $cgi->td({-colspan => '2'}, $cgi->button(-name => 'enddate', -label => 'now', -onClick => 'showDateTimePicker(this)')), "\n", 2476 ), "\n", 2477 ), "\n", 2478 ), "\n", 2479 ), "\n", 2480 ), "\n", 2481 ), "\n", 2482 $cgi->end_form, 2483 "\n"); 2484} 2485 2486sub printgraphlinks { 2487 my ($cgi, $params, $period, $title) = @_; 2488 if (! defined $title) { $title = q(); } 2489 dumper(DBDEB, 'printgraphlinks: params', $params); 2490 dumper(DBDEB, 'printgraphlinks: period', $period); 2491 2492 my $gtitle = q(); 2493 my $alttag = q(); 2494 my $desc = q(); 2495 2496 my $showtitle = $params->{showtitle}; 2497 my $showdesc = $params->{showdesc}; 2498 my $showgraphtitle = $params->{showgraphtitle}; 2499 2500 # the description contains a list of the data set names. 2501 if ($showdesc) { 2502 if ($params->{db} && scalar @{$params->{db}} > 0) { 2503 foreach my $ii (sortnaturally(@{$params->{db}})) { 2504 if ($desc ne q()) { $desc .= $cgi->br(); } 2505 $desc .= getdatalabel($ii); 2506 } 2507 } 2508 } 2509 debug(DBDEB, 'printgraphlinks: desc=' . $desc); 2510 2511 # include quite a bit of information in the alt tag - it helps when 2512 # debugging configuration files. 2513 $gtitle = $params->{service} . q( ) . _('on') . q( ) . $params->{host}; 2514 $alttag = _('Graph of') . q( ) . $gtitle; 2515 if ($params->{db} && scalar @{$params->{db}} > 0) { 2516 $alttag .= ' ('; 2517 foreach my $ii (sortnaturally(@{$params->{db}})) { 2518 $alttag .= q( ) . $ii; 2519 } 2520 $alttag .= ' )'; 2521 } 2522 debug(DBDEB, 'printgraphlinks: alttag=' . $alttag); 2523 2524 my $rrdopts = q(); 2525 if ($params->{rrdopts}) { 2526 $rrdopts .= $params->{rrdopts}; 2527 } 2528 if ($params->{graphonly} && index($rrdopts, '-j') == -1) { 2529 $rrdopts .= ' -j'; 2530 } 2531 if ($params->{hidelegend} && index($rrdopts, '-g') == -1) { 2532 $rrdopts .= ' -g'; 2533 } 2534 # the '-snow' and '-enow' formats matter - they are detected by rrdline 2535 my $soff = $period->[1] + $params->{offset}; 2536 $rrdopts .= ' -snow-' . $soff; 2537 $rrdopts .= ' -enow-' . $params->{offset}; 2538 if ($showgraphtitle) { 2539 if ($rrdopts !~ /(-t|--title)/) { 2540 my $t = $gtitle; 2541 $t =~ s/<br.*//g; # use only the first line 2542 $t =~ s/<[^>]+>//g; # punt any html markup 2543 $t =~ tr/-/:/; # hyphens cause problems 2544 $rrdopts .= ' -t ' . $t; 2545 } 2546 } 2547 debug(DBDEB, 'printgraphlinks: rrdopts=' . $rrdopts); 2548 2549 my $url = $Config{nagiosgraphcgiurl} . '/showgraph.cgi?' 2550 . buildurl($params->{host}, $params->{service}, 2551 { geom => $params->{geom}, 2552 rrdopts => [$rrdopts], 2553 fixedscale => $params->{fixedscale}, 2554 db => $params->{db}, 2555 }); 2556 debug(DBDEB, 'printgraphlinks: url=' . $url); 2557 2558 my $titlestr = $showtitle 2559 ? $cgi->p({-class=>'graph_title'}, $title) : q(); 2560 my $descstr = $desc ne q() 2561 ? $cgi->p({-class=>'graph_description'}, $desc) : q(); 2562 my ($w, $h) = getgeom(\%Config, $params->{geom}); 2563 2564 return $cgi->div({-class => 'graph'}, "\n", 2565 $cgi->div({-class => 'graph_image'}, 2566 $cgi->img({-src => $url, 2567 -alt => $alttag, 2568 -onmouseover => 'ngzInit(this)', 2569 -graphtop => GRAPHTOP, 2570 -graphleft => GRAPHLEFT, 2571 -graphwidth => $w, 2572 -graphheight => $h, 2573 })) . "\n", 2574 $cgi->div({-class => 'graph_details'}, "\n", 2575 $titlestr, $titlestr ne q() ? "\n" : q(), 2576 $descstr, $descstr ne q() ? "\n" : q(), 2577 )); 2578} 2579 2580sub printperiodlinks { 2581 my($cgi, $params, $period, $now, $content) = @_; 2582 my (@navstr) = getperiodctrls($cgi, $params->{offset}, $period, $now); 2583 my $id = 'period_data_' . $period->[0]; 2584 return $cgi->div({-class => 'period_banner'}, 2585 $cgi->span({-class => 'period_title'}, 2586 '<button type="button" class="period_toggle" id="toggle_' . $period->[0] . '" onClick="togglePeriodDisplay(\'' . $id . '\', this)">', 2587 $cgi->img({src => IMG_PLUS}), 2588 $cgi->img({src => IMG_MINUS}), 2589 '</button>', 2590 $cgi->a({ -id => $period->[0] }, 2591 _($PERIOD_LABELS{$period->[0]}))), 2592 $cgi->span({-class => 'period_controls'}, 2593 $navstr[0], 2594 $cgi->span({-class => 'period_detail'}, 2595 $navstr[1]), 2596 $navstr[2]), 2597 ) . "\n" . 2598 $cgi->div({-class => 'period', -id => $id }, "\n" . 2599 $content) . "\n"; 2600} 2601 2602sub printsummary { 2603 my($cgi, $opts) = @_; 2604 2605 my $s = q(); 2606 if ($opts->{call} eq 'both') { 2607 $s = _('Data for host') . q( ) . 2608 $cgi->span({-class => 'item_label'}, 2609 $cgi->a({href => $opts->{hosturl}}, 2610 $opts->{host})) . 2611 ', ' . 2612 _('service') . q( ) . 2613 $cgi->span({-class => 'item_label'}, 2614 $cgi->a({href => $opts->{serviceurl}}, 2615 getlabel($opts->{service}))); 2616 } elsif ($opts->{call} eq 'host') { 2617 $s = _('Data for host') . q( ) . 2618 $cgi->span({-class => 'item_label'}, 2619 $cgi->a({href => $opts->{hosturl}}, 2620 $opts->{host})); 2621 } elsif ($opts->{call} eq 'service') { 2622 $s = _('Data for service') . q( ) . 2623 $cgi->span({-class => 'item_label'}, 2624 getlabel($opts->{service})); 2625 } elsif ($opts->{call} eq 'group') { 2626 $s = _('Data for group') . q( ) . 2627 $cgi->span({-class => 'item_label'}, 2628 getlabel($opts->{group})); 2629 } 2630 2631 return $cgi->div({ -class => 'summary' }, 2632 $s . q( ) . _('as of') . q( ) . 2633 $cgi->span({ -class => 'timestamp' }, 2634 formattime(time, 'timeformat_now'))); 2635} 2636 2637sub printheader { 2638 my ($cgi, $opts) = @_; 2639 2640 my $rval = $cgi->header; 2641 $rval .= $cgi->start_html(-id => 'nagiosgraph', 2642 -title => "nagiosgraph: $opts->{title}", 2643 -head => $cgi->meta( { getrefresh() } ), 2644 getstyle()); 2645 2646 $rval .= printmenudatascript($authhosts{host}, $authhosts{hostserv}); 2647 if ($opts->{defaultdatasets}) { 2648 $rval .= printdefaultsscript($opts->{defaultdatasets}); 2649 } 2650 $rval .= printincludescript(); 2651 2652 if (! $Config{hidejswarnings}) { 2653 $rval .= $cgi->div({-id => 'js_disabled', -style => ERRSTYLE}, 2654 _(JSDISABLED)) . "\n"; 2655 $rval .= $cgi->div({-id => 'js_version_' . JSVERSION, -style => ERRSTYLE}, 2656 _(JSMISSING)) . "\n"; 2657 } 2658 2659 $rval .= printcontrols($cgi, $opts) . "\n"; 2660 2661 $rval .= (defined $Config{hidengtitle} and $Config{hidengtitle} eq 'true') 2662 ? q() : $cgi->h1('Nagiosgraph') . "\n"; 2663 2664 $rval .= printsummary($cgi, $opts) . "\n"; 2665 2666 return $rval; 2667} 2668 2669sub printfooter { 2670 my ($cgi,$sts,$ets) = @_; 2671 $sts ||= 0; 2672 $ets ||= 0; 2673 my $tstr = (defined $Config{showprocessingtime} 2674 && $Config{showprocessingtime} eq 'true') 2675 ? $cgi->br() . formatelapsedtime($sts, $ets) 2676 : q(); 2677 return $cgi->div({-class => 'footer'}, q(), # or instead of q() $cgi->hr() 2678 _('Created by') . q( ) . 2679 $cgi->a({href => NAGIOSGRAPHURL }, 2680 'Nagiosgraph ' . $VERSION) . $tstr ) 2681 . $cgi->end_html(); 2682} 2683 2684# Full page routine ########################################################### 2685# Determine the number of graphs that will be displayed on the page 2686# and the time period they will cover. This expects a comma-delimited 2687# or space-delimited list of period names. 2688# 2689# returns an array of period data, where each array element is a 2690# tuple of name, period, offset. 2691sub graphsizes { 2692 my $conf = shift; 2693 $conf =~ s/,/ /g; # we will split on whitespace 2694 dumper(DBDEB, 'graphsizes: period', $conf); 2695 my @unsorted; 2696 foreach my $ii (split /\s+/, $conf) { 2697 next if not exists $PERIOD_DATA{$ii}; 2698 push @unsorted, $PERIOD_DATA{$ii}; 2699 } 2700 if (not @unsorted) { 2701 debug(DBDEB, 'graphsizes: no period data found, using defaults'); 2702 foreach my $ii (split / /, PERIODS) { 2703 push @unsorted, $PERIOD_DATA{$ii}; 2704 } 2705 } 2706 my @rval = sort {$a->[1] <=> $b->[1]} @unsorted; 2707 return @rval; 2708} 2709 2710# returns three strings: a url for previous period, a label for current 2711# display, and a url for the next period. do not permit voyages into 2712# the future. 2713sub getperiodctrls { 2714 my ($cgi, $offset, $period, $now) = @_; 2715 2716 # strip any offset from the url 2717 my $url = $ENV{REQUEST_URI} ? $ENV{REQUEST_URI} : q(); 2718 $url =~ s/&*offset=[^&]*//; 2719 2720 # now calculate and inject our own offset 2721 my $x = ($offset + $period->[2]); 2722 my $p = $cgi->a({-href=>"$url&offset=$x"}, '<'); 2723 my $c = getperiodlabel($now,$offset,$period->[1],$period->[0]); 2724 $x = ($offset - $period->[2]); 2725 my $n = ($x < 0 ? q() : $cgi->a({-href=>"$url&offset=$x"}, '>')); 2726 2727 return ($p, $c, $n); 2728} 2729 2730# returns a human-readable string with the start and end time relative to 2731# the current hour plus the indicated offset. the resolution determines 2732# how much information to put into the label string. 2733sub getperiodlabel { 2734 my($now, $offset, $period, $res) = @_; 2735 my $e = $now - $offset; 2736 my $s = $e - $period; 2737 my $sstr = formattime($s, 'timeformat_' . $res); 2738 my $estr = formattime($e, 'timeformat_' . $res); 2739 return $sstr . q( - ) . $estr; 2740} 2741 2742sub formattime { 2743 my ($t, $key) = @_; 2744 return $key && defined $Config{$key} 2745 ? strftime $Config{$key}, localtime $t 2746 : scalar localtime $t; 2747} 2748 2749# read data from the perflog 2750sub readperfdata { 2751 my ($fn) = @_; 2752 debug(DBDEB, 'readperfdata(' . $fn . ')'); 2753 my @lines; 2754 if (-s $fn) { 2755 my $worklog = $fn . '.nagiosgraph'; 2756 if (! rename $fn, $worklog) { 2757 debug(DBCRT, "cannot process perflog: rename failed for $fn"); 2758 return @lines; 2759 } 2760 if (open my $PERFLOG, '<', $worklog) { 2761 while (<$PERFLOG>) { 2762 push @lines, $_; 2763 } 2764 close $PERFLOG or debug(DBERR, "close failed for $worklog: $OS_ERROR"); 2765 unlink $worklog; 2766 } else { 2767 debug(DBWRN, "cannot read perfdata from $worklog: $OS_ERROR"); 2768 return @lines; 2769 } 2770 } 2771 if (not @lines) { 2772 debug(DBINF, 'empty perflog ' . $fn); 2773 } else { 2774 debug(DBINF, 'read ' . scalar @lines . ' lines from perflog'); 2775 } 2776 return @lines; 2777} 2778 2779# construct the RRA strings 2780sub getrras { ## no critic (ProhibitManyArgs) 2781 my ($host, $service, $dbname, $xff, $rows, $steps, $choice) = @_; 2782 if (not $choice) { 2783 if (gethsdvalue('lasts', 0, $host, $service, $dbname)) { 2784 $choice = 'LAST'; 2785 } elsif (gethsdvalue('maximums', 0, $host, $service, $dbname)) { 2786 $choice = 'MAX'; 2787 } elsif (gethsdvalue('minimums', 0, $host, $service, $dbname)) { 2788 $choice = 'MIN'; 2789 } else { 2790 $choice = 'AVERAGE'; 2791 } 2792 } 2793 return "RRA:$choice:$xff:$steps->[0]:$rows->[0]", 2794 "RRA:$choice:$xff:$steps->[1]:$rows->[1]", 2795 "RRA:$choice:$xff:$steps->[2]:$rows->[2]", 2796 "RRA:$choice:$xff:$steps->[3]:$rows->[3]"; 2797} 2798 2799# Create new rrd databases if necessary 2800sub runcreate { 2801 my $ds = shift; 2802 dumper(DBINF, 'runcreate creating RRD: DS', $ds); 2803 RRDs::create(@{$ds}); 2804 my $ERR = RRDs::error(); 2805 if ($ERR) { 2806 debug(DBERR, 'RRDs::create ERR ' . $ERR); 2807 dumper(DBERR, 'ds', $ds); 2808 } 2809 return; 2810} 2811 2812sub checkdatasources { 2813 my ($ds, $directory, $filenames) = @_; 2814 if (scalar @{$ds} == 3 and scalar @{$filenames} == 1) { 2815 debug(DBCRT, "no data sources defined for $directory/$filenames->[0]"); 2816 return 0; 2817 } 2818 return 1; 2819} 2820 2821# ensure that the name is ok as an rrd ds name. if not, fail loudly. we do 2822# not try to fix the name - just complain loudly about it and bail out. 2823sub checkdsname { 2824 my ($dsname) = @_; 2825 if (length $dsname > DSNAME_MAXLEN or $dsname =~ /[^a-zA-Z0-9_-]/) { 2826 return 1; 2827 } 2828 return 0; 2829} 2830 2831sub createrrd { 2832 my ($start, $host, $service, $labels) = @_; 2833 debug(DBDEB, "createrrd($start,$host,$service,$labels->[0])"); 2834 my ($directory, # directory in which to put rrd files 2835 @filenames); # rrd file name(s) 2836 2837 my $db = shift @{$labels}; 2838 ($directory, $filenames[0]) = mkfilename($host, $service, $db); 2839 debug(DBDEB, "createrrd rrdfile is $directory/$filenames[0]"); 2840 if (not -e $directory) { # ensure we can write to data directory 2841 debug(DBINF, "creating directory $directory"); 2842 if ( ! mkdir $directory, 0775 ) { 2843 my $msg = "cannot create directory $directory: $OS_ERROR"; 2844 debug(DBCRT, $msg); 2845 croak($msg); 2846 } 2847 } 2848 if (not -w $directory) { 2849 my $msg = 'cannot write to directory ' . $directory; 2850 debug(DBCRT, $msg); 2851 croak($msg); 2852 } 2853 2854 my $rstr = gethsdvalue2('resolution', RESOLUTIONS, $host, $service, $db); 2855 my @rows = split / /, $rstr; 2856 if (scalar @rows != 4) { 2857 my $msg = 'wrong number of values for resolution (expecting 4, got ' 2858 . scalar @rows . ')'; 2859 debug(DBCRT, $msg); 2860 croak($msg); 2861 } 2862 2863 my $sstr = gethsdvalue2('step', STEPS, $host, $service, $db); 2864 my @steps = split / /, $sstr; 2865 if (scalar @steps != 4) { 2866 my $msg = 'wrong number of values for step (expecting 4, got ' 2867 . scalar @steps . ')'; 2868 debug(DBCRT, $msg); 2869 croak($msg); 2870 } 2871 2872 my $xff = gethsdvalue2('xff', XFF, $host, $service, $db); 2873 2874 my $heartbeat = gethsdvalue2('heartbeat', HEARTBEAT, $host, $service, $db); 2875 2876 my $stepsize = gethsdvalue2('stepsize', STEPSIZE, $host, $service, $db); 2877 2878 debug(DBDEB, 'createrrd: step=' . $stepsize 2879 . ' heartbeat=' . $heartbeat 2880 . ' xff=' . $xff 2881 . ' resolutions=' . join q( ), @rows 2882 . ' steps=' . join q( ), @steps); 2883 2884 my @ds = ("$directory/$filenames[0]", 2885 '--start', $start, '--step', $stepsize,); 2886 my @dsmin = ("$directory/$filenames[0]_min", 2887 '--start', $start, '--step', $stepsize,); 2888 my @dsmax = ("$directory/$filenames[0]_max", 2889 '--start', $start, '--step', $stepsize,); 2890 2891 my @datasets = []; 2892 for my $ii (0 .. @{$labels} - 1) { 2893 next if not $labels->[$ii]; 2894 dumper(DBDEB, "labels->[$ii]", $labels->[$ii]); 2895 if (checkdsname($labels->[$ii]->[0])) { 2896 my $msg = 'ds-name is not valid: ' . $labels->[$ii]->[0]; 2897 debug(DBCRT, $msg); 2898 croak($msg); 2899 } 2900 my $ds = join q(:), ('DS', 2901 $labels->[$ii]->[0], 2902 $labels->[$ii]->[1], 2903 $heartbeat, 2904 $labels->[$ii]->[1] eq 'DERIVE' ? '0' : 'U', 2905 'U'); 2906 if (defined $Config{hostservvar}->{$host} and 2907 defined $Config{hostservvar}->{$host}->{$service} and 2908 defined $Config{hostservvar}->{$host}->{$service}->{$labels->[$ii]->[0]}) { 2909 my $fn = (mkfilename($host, $service . $labels->[$ii]->[0], $db))[1]; 2910 push @filenames, $fn; 2911 push @datasets, [$ii]; 2912 if (not -e "$directory/$fn") { 2913 runcreate(["$directory/$fn", 2914 '--start', $start, '--step', $stepsize, $ds, 2915 getrras($host,$service,$db,$xff,\@rows,\@steps)]); 2916 } 2917 if (checkminmax('min', $service, $directory, $fn)) { 2918 runcreate(["$directory/${fn}_min", 2919 '--start', $start, '--step', $stepsize, $ds, 2920 getrras($host,$service,$db,$xff,\@rows,\@steps,'MIN')]); 2921 } 2922 if (checkminmax('max', $service, $directory, $fn)) { 2923 runcreate(["$directory/${fn}_max", 2924 '--start', $start, '--step', $stepsize, $ds, 2925 getrras($host,$service,$db,$xff,\@rows,\@steps,'MAX')]); 2926 } 2927 next; 2928 } else { 2929 push @ds, $ds; 2930 push @{$datasets[0]}, $ii; 2931 if (defined $Config{withminimums}->{$service}) { 2932 push @dsmin, $ds; 2933 } 2934 if (defined $Config{withmaximums}->{$service}) { 2935 push @dsmax, $ds; 2936 } 2937 } 2938 } 2939 if (not -e "$directory/$filenames[0]" and 2940 checkdatasources(\@ds, $directory, \@filenames)) { 2941 push @ds, getrras($host, $service, $db, $xff, \@rows, \@steps); 2942 runcreate(\@ds); 2943 } 2944 createminmax('min', \@dsmin, \@filenames, 2945 { directory => $directory, 2946 host => $host, service => $service, db => $db, 2947 xff => $xff, rows => \@rows, steps => \@steps }); 2948 createminmax('max', \@dsmax, \@filenames, 2949 { directory => $directory, 2950 host => $host, service => $service, db => $db, 2951 xff => $xff, rows => \@rows, steps => \@steps }); 2952 dumper(DBDEB, 'createrrd: filenames', \@filenames); 2953 dumper(DBDEB, 'createrrd: datasets', \@datasets); 2954 return \@filenames, \@datasets; 2955} 2956 2957sub checkminmax { 2958 my ($conf, $service, $directory, $filename) = @_; 2959 if (defined $Config{'with' . $conf . 'imums'}->{$service} and 2960 not -e $directory . q(/) . $filename . q(_) . $conf) { 2961 return 1; 2962 } 2963 return 0; 2964} 2965 2966sub createminmax { 2967 my ($conf, $ds, $filenames, $opts) = @_; 2968 if (checkminmax($conf, 2969 $opts->{service}, $opts->{directory}, $filenames->[0]) and 2970 checkdatasources($ds, $opts->{directory}, $filenames)) { 2971 my $s = $conf; 2972 $s =~ tr/[a-z]/[A-Z]/; 2973 push @{$ds}, getrras($opts->{host}, $opts->{service}, $opts->{db}, 2974 $opts->{xff}, $opts->{rows}, $opts->{steps}, $s); 2975 runcreate($ds); 2976 } 2977 return; 2978} 2979 2980# Use RRDs to update rrd file 2981sub runupdate { 2982 my $dataset = shift; 2983 dumper(DBINF, 'runupdate dataset', $dataset); 2984 RRDs::update(@{$dataset}); 2985 my $ERR = RRDs::error(); 2986 if ($ERR) { 2987 debug(DBERR, 'RRDs::update ERR ' . $ERR); 2988 dumper(DBERR, 'ds', $dataset); 2989 } 2990 return; 2991} 2992 2993sub rrdupdate { ## no critic (ProhibitManyArgs) 2994 my ($file, $time, $host, $service, $ds, $values) = @_; 2995 my $directory = $Config{rrddir}; 2996 2997 # Select target folder depending on config settings 2998 if (defined $Config{dbseparator} && $Config{dbseparator} eq 'subdir') { 2999 $directory .= "/$host"; 3000 } 3001 3002 my @dataset; 3003 push @dataset, "$directory/$file", $time; 3004 for my $ii (0 .. @{$values} - 1) { 3005 for (@{$ds}) { 3006 if ($ii == $_) { 3007 $values->[$ii]->[2] ||= 0; 3008 $dataset[1] .= ":$values->[$ii]->[2]"; 3009 last; 3010 } 3011 } 3012 } 3013 runupdate(\@dataset); 3014 3015 if (defined $Config{withminimums}->{$service}) { 3016 $dataset[0] = "$directory/${file}_min"; 3017 runupdate(\@dataset); 3018 } 3019 if (defined $Config{withmaximums}->{$service}) { 3020 $dataset[0] = "$directory/${file}_max"; 3021 runupdate(\@dataset); 3022 } 3023 return; 3024} 3025 3026# Read the map file and define a subroutine that parses performance data 3027sub getrules { 3028 my $file = getcfgfn(shift); 3029 debug(DBDEB, 'getrules(' . $file . ')'); 3030 my @rules; 3031 if ( open my $FH, '<', $file ) { 3032 while (<$FH>) { 3033 push @rules, $_; 3034 } 3035 close $FH or debug(DBERR, "close failed for $file: $OS_ERROR"); 3036 } else { 3037 my $msg = "cannot open $file: $OS_ERROR"; 3038 debug(DBCRT, $msg); 3039 return $msg; 3040 } 3041 ## no critic (RequireInterpolationOfMetachars) 3042 my $code = 'sub evalrules { $_ = $_[0];' . 3043 ' my ($d, @s) = ($_);' . 3044 ' no strict "subs";' . 3045 join(q(), @rules) . 3046 ' use strict "subs";' . 3047 ' return () if ($#s > -1 && $s[0] eq "ignore");' . 3048 ' return @s; }'; 3049 my $rval = eval $code; ## no critic (ProhibitStringyEval) 3050 if ($EVAL_ERROR or $rval) { 3051 my $msg = 'Map file eval error: ' . $EVAL_ERROR; 3052 debug(DBCRT, $msg); 3053 return $msg; 3054 } 3055 return q(); 3056} 3057 3058# process one or more lines that are nagios perfdata format 3059sub processdata { 3060 my (@lines) = @_; 3061 my $t = $#lines + 1; 3062 debug(DBDEB, 'processdata: processing ' . $t . ' lines'); 3063 my $n = 0; 3064 for my $line (@lines) { 3065 chomp $line; 3066 my @data = split /\|\|/, $line; 3067 $data[0] ||= q(); 3068 $data[1] ||= q(); 3069 $data[2] ||= q(); 3070 $data[3] ||= q(); 3071 $data[4] ||= q(); 3072 if ( $data[0] eq q() ) { 3073 debug(DBWRN, "processdata: no timestamp found:\n" . $line); 3074 next; 3075 } 3076 if ( $data[1] eq q() ) { 3077 debug(DBWRN, "processdata: no host found:\n" . $line); 3078 next; 3079 } 3080 if ( $data[2] eq q() ) { 3081 debug(DBWRN, "processdata: no service found:\n" . $line); 3082 next; 3083 } 3084 my $debug = $Config{debug}; 3085 getdebug('insert', $data[1], $data[2]); 3086 dumper(DBDEB, 'processdata: data', \@data); 3087 my $dstr = "hostname:$data[1]\nservicedesc:$data[2]\noutput:$data[3]\nperfdata:$data[4]"; 3088 my @x = evalrules($dstr); 3089 if ( ! @x || $#x < 0 ) { 3090 debug(DBWRN, "output/perfdata not recognized:\n" . $dstr); 3091 } elsif ( $x[0] eq 'ignore' ) { 3092 debug(DBINF, "output/perfdata ignored:\n" . $dstr); 3093 } else { 3094 debug(DBINF, "processing output/perfdata:\n" . $dstr); 3095 $n += 1; 3096 for my $s ( @x ) { 3097 my ($rrds, $sets) = createrrd($data[0]-1,$data[1],$data[2],$s); 3098 next if not $rrds; 3099 for my $ii (0 .. @{$rrds} - 1) { 3100 rrdupdate($rrds->[$ii], $data[0], 3101 $data[1], $data[2], $sets->[$ii], $s); 3102 } 3103 } 3104 } 3105 $Config{debug} = $debug; 3106 } 3107 debug(DBINF, 'processed ' . $n . ' of ' . $t . ' lines'); 3108 return; 3109} 3110 3111# return a translation for the indicated key. if there is no translation, 3112# return the key. 3113sub _ { 3114 my ($key) = @_; 3115 return $i18n{$key} ? $i18n{$key} : $key; 3116} 3117 3118# labels use the same lookup mechanism as translations, but labels are not 3119# necessarily defined with a specific language. we keep separate functions 3120# to make explicit the difference between a label and a translation. 3121sub getlabel { 3122 my ($key) = @_; 3123 return $Labels{$key} ? $Labels{$key} : $key; 3124} 3125 3126# get the label associated with the indicated name. the name could be a 3127# database name, a data source name, or a db,ds pair. 3128sub getdatalabel { 3129 my ($name) = @_; 3130 my $x = getlabel($name); 3131 if ($x eq $name) { 3132 my ($db,$ds) = split /,/, $name; 3133 if ($ds) { 3134 my $y = getlabel($ds); 3135 if ($y ne $ds) { 3136 $x = $y; 3137 } 3138 } elsif ($db) { 3139 my $y = getlabel($db); 3140 if ($y ne $db) { 3141 $x = $y; 3142 } 3143 } 3144 } 3145 return $x; 3146} 3147 3148# sort a list naturally using implementation by tye at 3149# http://www.perlmonks.org/?node=442237 3150sub sortnaturally { 3151 my(@list) = @_; 3152 return @list[ 3153 map { unpack 'N', substr $_,-4 } 3154 sort 3155 map { 3156 my $key = $list[$_]; 3157 $key =~ s/((?<!\.)(\d+)\.\d+(?!\.)|\d+)/ 3158 my $len = length( defined($2) ? $2 : $1 ); 3159 pack( 'N', $len ) . $1 . ' '; 3160 /ge; 3161 $key . pack 'N', $_ 3162 } 0..$#list 3163 ]; 3164} 3165 31661; 3167 3168__END__ 3169 3170=head1 NAME 3171 3172ngshared.pm - shared subroutines for the nagiosgraph programs 3173 3174=head1 SYNOPSIS 3175 3176B<use lib '/path/to/this/file';> 3177B<use ngshared;> 3178 3179=head1 DESCRIPTION 3180 3181A shared set of routines for reading configuration files, logging, etc. 3182 3183=head1 USAGE 3184 3185There is no direct invocation. ngshared.pm contains functions that can be used to graph RRD data sets with data for hosts and services from Nagios. 3186 3187=head1 REQUIRED ARGUMENTS 3188 3189=head1 OPTIONS 3190 3191=head1 DIAGNOSTICS 3192 3193=head1 EXIT STATUS 3194 3195=head1 CONFIGURATION 3196 3197ngshared.pm uses B<nagiosgraph.conf> for most configuration. ngshared.pm also includes subroutines to read from B<hostdb.conf>, B<servdb.conf>, B<groupdb.conf>, and B<rrdopts.conf> files. These files are typically located in /etc/nagiosgraph. 3198 3199=head1 INSTALLATION 3200 3201Copy this file into a configuration directory (/etc/nagiosgraph, for example) and modify the B<use lib> line in each *.cgi file to the directory. 3202 3203=head1 DEPENDENCIES 3204 3205=over 4 3206 3207=item B<rrdtool> 3208 3209This provides the data storage and graphing system. 3210 3211=item B<RRDs> 3212 3213This provides the perl interface to rrdtool. 3214 3215=back 3216 3217=head1 BUGS AND LIMITATIONS 3218 3219=head1 INCOMPATIBILITIES 3220 3221=head1 SEE ALSO 3222 3223B<insert.pl> B<showgraph.cgi> B<show.cgi> B<showhost.cgi> B<showservice.cgi> B<showgroup.cgi> B<testcolor.cgi> 3224 3225=head1 AUTHOR 3226 3227Soren Dossing, the original author in 2005. 3228 3229Alan Brenner - alan.brenner@ithaka.org; I've updated this from the version at http://nagiosgraph.wiki.sourceforge.net/ by moving some subroutines into this shared file (ngshared.pm) for use by insert.pl and the show*.cgi files. 3230 3231Matthew Wall. Added some graphing and display features. General bugfixing, 3232cleanup and refactoring. Added showgraph.cgi. Added CSS and JavaScript for 3233graph and time period controls. 3234 3235=head1 LICENSE AND COPYRIGHT 3236 3237Copyright (C) 2005 Soren Dossing, 2009 Andrew W. Mellon Foundation 3238 3239This program is free software; you can redistribute it and/or 3240modify it under the terms of the OSI Artistic License see: 3241http://www.opensource.org/licenses/artistic-license-2.0.php 3242 3243This program is distributed in the hope that it will be useful, 3244but WITHOUT ANY WARRANTY; without even the implied warranty of 3245MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 3246