diff options
author | Tobi Oetiker <tobi@oetiker.ch> | 2005-04-13 21:31:27 +0200 |
---|---|---|
committer | Tobi Oetiker <tobi@oetiker.ch> | 2005-04-13 21:31:27 +0200 |
commit | 21df925982b162f18479c9ab8312e3573dcd7f24 (patch) | |
tree | 9827c5621273b1f5748cce1886ae8e2fbb79853b /lib/Smokeping.pm | |
parent | d9b0e622f870cc151ffe814abde6f62a47cdba58 (diff) | |
download | smokeping-21df925982b162f18479c9ab8312e3573dcd7f24.tar.gz smokeping-21df925982b162f18479c9ab8312e3573dcd7f24.tar.xz |
* added labeling fixes for rrdtool 1.2 compatibility
* added navigator mode where it is possible to alter the timerange shown in a graph.
This feature is sponsored by BeverlyCorp.
* fix fix for matcher cache skipping
Diffstat (limited to 'lib/Smokeping.pm')
-rw-r--r-- | lib/Smokeping.pm | 347 |
1 files changed, 218 insertions, 129 deletions
diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 048f795..963299d 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -542,6 +542,9 @@ sub get_overview ($$$$){ my $date = $cfg->{Presentation}{overview}{strftime} ? POSIX::strftime($cfg->{Presentation}{overview}{strftime}, localtime(time)) : scalar localtime(time); + if ( $RRDs::VERSION >= 1.199908 ){ + $date =~ s|:|\\:|g; + } foreach my $prop (sort {$tree->{$a}{_order} <=> $tree->{$b}{_order}} grep { ref $tree->{$_} eq 'HASH' and defined $tree->{$_}{host}} keys %$tree) { @@ -566,11 +569,10 @@ sub get_overview ($$$$){ "CDEF:dm=median,0,$max,LIMIT", "CDEF:dm2=median,1.5,*,0,$max,LIMIT", "LINE1:dm2", # this is for kicking things down a bit - "LINE1:dm#$medc:median RTT avg\\: ", - "GPRINT:median:AVERAGE: %0.2lf %ss ", - "GPRINT:median:LAST: latest RTT\\: %0.2lf %ss ", - "GPRINT:ploss:AVERAGE: avg pkg loss\\: %.2lf %% ", - "COMMENT: $date\\j"); + "LINE1:dm#$medc:median RTT", + "GPRINT:median:AVERAGE:avg RTT\\: %.2lf %ss", + "GPRINT:ploss:AVERAGE:avg pkt loss\\: %.2lf %%", + "COMMENT:$date\\j"); my $ERROR = RRDs::error(); $page .= "<div>"; if (defined $ERROR) { @@ -645,26 +647,46 @@ sub smokecol ($) { return \@items; } +sub parse_datetime($){ + my $in = shift; + for ($in){ + /^\s*(\d{4})-(\d{1,2})-(\d{1,2})(?:\s+(\d{1,2}):(\d{2})(?::(\d{2}))?)?\s*$/ && + return POSIX::mktime($6||0,$5||0,$4||0,$3,$2-1,$1-1900,0,0,-1); + /([ -:a-z0-9]+)/ && return $1; + }; +} + sub get_detail ($$$$){ + # when drawing the detail page there are two modes for doing it + # a) classic with several static graphs on the page + # b) with one graph and below the graph one can specify the end time + # and the length of the graph. my $cfg = shift; my $q = shift; my $tree = shift; my $open = shift; + return "" unless $tree->{host}; + my @dirs = @{$open}; my $file = pop @dirs; my $dir = ""; - die "ERROR: ".(join ".", @dirs)." has no probe defined\n" + + return "<div>ERROR: ".(join ".", @dirs)." has no probe defined</div>" unless $tree->{probe}; - die "ERROR: ".(join ".", @dirs)." $tree->{probe} is not known\n" + + return "<div>ERROR: ".(join ".", @dirs)." $tree->{probe} is not known</div>" unless $cfg->{__probes}{$tree->{probe}}; + my $probe = $cfg->{__probes}{$tree->{probe}}; my $ProbeDesc = $probe->ProbeDesc(); my $step = $probe->step(); my $pings = $probe->_pings($tree); - my $page; + my $mode = $q->param('displaymode') || 's'; + return "<div>ERROR: unknown displaymode $mode</div>" + unless $mode =~ /^[sn]$/; for (@dirs) { $dir .= "/$_"; @@ -674,142 +696,190 @@ sub get_detail ($$$$){ unless -d $cfg->{General}{imgcache}.$dir; } - my $rrd = $cfg->{General}{datadir}."/".(join "/", @dirs)."/${file}.rrd"; - my $img = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}.rrd"; - - my %lasthight; - if (open (HG,"<${img}.maxhight")){ - while (<HG>){ - chomp; - my @l = split / /; - $lasthight{$l[0]} = $l[1]; - } - close HG; - } - my $max = findmax $cfg, $rrd; - if (open (HG,">${img}.maxhight")){ - foreach my $s (keys %{$max}){ - print HG "$s $max->{$s}\n"; - } - close HG; - } + my $rrd = $cfg->{General}{datadir}."/".$dir."/${file}.rrd"; + + my $imgbase; + my $imghref; + my $max; + my @tasks; + my %lasthight; + + if ($mode eq 's'){ + # in nave mode there is only one graph, so the height calculation + # is not necessary. + $imgbase = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}"; + $imghref = $cfg->{General}{imgurl}."/".(join "/", @dirs)."/${file}"; + @tasks = @{$cfg->{Presentation}{detail}{_table}}; + if (open (HG,"<${imgbase}.maxhight")){ + while (<HG>){ + chomp; + my @l = split / /; + $lasthight{$l[0]} = $l[1]; + } + close HG; + } + $max = findmax $cfg, $rrd; + if (open (HG,">${imgbase}.maxhight")){ + foreach my $s (keys %{$max}){ + print HG "$s $max->{$s}\n"; + } + close HG; + } + } else { + my $basedir = + mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $imgbase; + # remove old images after one hour + my $pattern = "$cfg->{General}{imgcache}/__navcache/*.png"; + for (<$pattern>){ + unlink $_ if -A $_ > 1/24; + } + $imgbase =$cfg->{General}{imgcache}."/__navcache/".time()."$$"; + $imghref =$cfg->{General}{imgurl}."/__navcache/".time()."$$"; + @tasks = (["Navigator Mode", parse_datetime($q->param('start')),parse_datetime($q->param('end'))]); + my ($graphret,$xs,$ys) = RRDs::graph + ("dummy", + '--start', $tasks[0][1], + '--end',$tasks[0][2], + "DEF:maxping=${rrd}:median:AVERAGE", + 'PRINT:maxping:MAX:%le' ); + my $ERROR = RRDs::error(); + do_log $ERROR if $ERROR; + my $val = $graphret->[0]; + $val = 1 if $val =~ /nan/i; + $max = { $tasks[0][1] => $val }; + } + my $smoke = $pings >= 3 - ? smokecol $pings : - [ 'COMMENT:(Not enough pings to draw any smoke.)\s', 'COMMENT:\s' ]; - # one \s doesn't seem to be enough + ? smokecol $pings : + [ 'COMMENT:(Not enough pings to draw any smoke.)\s', 'COMMENT:\s' ]; + # one \s doesn't seem to be enough my @upargs; my @upsmoke; - my @median; - my $date = $cfg->{Presentation}{detail}{strftime} ? - POSIX::strftime($cfg->{Presentation}{detail}{strftime}, - localtime(time)) : scalar localtime(time); - - for (@{$cfg->{Presentation}{detail}{_table}}) { - my ($desc,$start) = @{$_}; - $start = exp2seconds($start); - do { - @median = ("DEF:median=${rrd}:median:AVERAGE", - "DEF:loss=${rrd}:loss:AVERAGE", - "CDEF:ploss=loss,$pings,/,100,*", - "GPRINT:median:AVERAGE:Median Ping RTT (avg %.1lf %ss) ", - "LINE1:median#202020" - ); + my %lc; + if ( defined $cfg->{Presentation}{detail}{loss_colors}{_table} ) { + for (@{$cfg->{Presentation}{detail}{loss_colors}{_table}}) { + my ($num,$col,$txt) = @{$_}; + $lc{$num} = [ $txt, "#".$col ]; + } + } else { my $p = $pings; + %lc = (0 => ['0', '#26ff00'], + 1 => ["1/$p", '#00b8ff'], + 2 => ["2/$p", '#0059ff'], + 3 => ["3/$p", '#5e00ff'], + 4 => ["4/$p", '#7e00ff'], + int($p/2) => [int($p/2)."/$p", '#dd00ff'], + $p-1 => [($p-1)."/$p", '#ff0000'], + ); + }; + + my %upt; + if ( defined $cfg->{Presentation}{detail}{uptime_colors}{_table} ) { + for (@{$cfg->{Presentation}{detail}{uptime_colors}{_table}}) { + my ($num,$col,$txt) = @{$_}; + $upt{$num} = [ $txt, "#".$col]; + } + } else { + %upt = ( 3600 => ['<1h', '#FFD3D3'], + 2*3600 => ['<2h', '#FFE4C7'], + 6*3600 => ['<6h', '#FFF9BA'], + 12*3600 => ['<12h','#F3FFC0'], + 24*3600 => ['<1d', '#E1FFCC'], + 7*24*3600 => ['<1w', '#BBFFCB'], + 30*24*3600 => ['<1m', '#BAFFF5'], + '1e100' => ['>1m', '#DAECFF'] + ); + } + + my $date = $cfg->{Presentation}{detail}{strftime} ? + POSIX::strftime($cfg->{Presentation}{detail}{strftime}, + localtime(time)) : scalar localtime(time); + my $BS = ''; + if ( $RRDs::VERSION >= 1.199908 ){ + $date =~ s|:|\\:|g; + $ProbeDesc =~ s|:|\\:|g; + $BS = '\\'; + } - my %lc; - my $lastup = 0; - if ( defined $cfg->{Presentation}{detail}{loss_colors}{_table} ) { - for (@{$cfg->{Presentation}{detail}{loss_colors}{_table}}) { - my ($num,$col,$txt) = @{$_}; - $lc{$num} = [ $txt, "#".$col ]; - } - } else { - %lc = (0 => ['0', '#26ff00'], - 1 => ["1/$p", '#00b8ff'], - 2 => ["2/$p", '#0059ff'], - 3 => ["3/$p", '#5e00ff'], - 4 => ["4/$p", '#7e00ff'], - int($p/2) => [int($p/2)."/$p", '#dd00ff'], - $p-1 => [($p-1)."/$p", '#ff0000'], + for (@tasks) { + my ($desc,$start,$end) = @{$_}; + $end ||= 'last'; + $start = exp2seconds($start) if $mode eq 's'; + + my $startstr = POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)); + my $endstr = POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)); + + my $last = -1; + my $swidth = $max->{$start} / $cfg->{Presentation}{detail}{height}; + my @median = ("DEF:median=${rrd}:median:AVERAGE", + "DEF:loss=${rrd}:loss:AVERAGE", + "CDEF:ploss=loss,$pings,/,100,*", + "GPRINT:median:AVERAGE:Median Ping RTT (%.1lf %ss avg) ", + "LINE1:median#202020" ); - }; - my $last = -1; - my $swidth = $max->{$start} / $cfg->{Presentation}{detail}{height}; foreach my $loss (sort {$a <=> $b} keys %lc){ next if $loss >= $pings; - my $lvar = $loss; $lvar =~ s/\./d/g ; + my $lvar = $loss; $lvar =~ s/\./d/g ; push @median, - ( - "CDEF:me$lvar=loss,$last,GT,loss,$loss,LE,*,1,UNKN,IF,median,*", - "CDEF:meL$lvar=me$lvar,$swidth,-", - "CDEF:meH$lvar=me$lvar,0,*,$swidth,2,*,+", - "AREA:meL$lvar", - "STACK:meH$lvar$lc{$loss}[1]:$lc{$loss}[0]" - ); - $last = $loss; + ( + "CDEF:me$lvar=loss,$last,GT,loss,$loss,LE,*,1,UNKN,IF,median,*", + "CDEF:meL$lvar=me$lvar,$swidth,-", + "CDEF:meH$lvar=me$lvar,0,*,$swidth,2,*,+", + "AREA:meL$lvar", + "STACK:meH$lvar$lc{$loss}[1]:$lc{$loss}[0]" + # "LINE2:me$lvar$lc{$loss}[1]:$lc{$loss}[0]" + ); + $last = $loss; } - push @median, ( "GPRINT:ploss:AVERAGE: avg pkg loss\\: %.2lf %%\\l" ); -# map {print "$_<br/>"} @median; - }; + push @median, ( "COMMENT:\\l", + "GPRINT:ploss:AVERAGE:Packet Loss\\: %.2lf %% average", + "GPRINT:ploss:MAX:%.2lf %% maximum", + "GPRINT:ploss:LAST:%.2lf %% current\\l" + ); + # if we have uptime draw a colorful background or the graph showing the uptime my $cdir=$cfg->{General}{datadir}."/".(join "/", @dirs)."/"; if (-f "$cdir/${file}.adr") { - @upsmoke = (); - @upargs = ('COMMENT:Link Up: ', - "DEF:uptime=${rrd}:uptime:AVERAGE", - "CDEF:duptime=uptime,86400,/", - 'GPRINT:duptime:LAST: %0.1lf days ('); - my %upt; - if ( defined $cfg->{Presentation}{detail}{uptime_colors}{_table} ) { - for (@{$cfg->{Presentation}{detail}{uptime_colors}{_table}}) { - my ($num,$col,$txt) = @{$_}; - $upt{$num} = [ $txt, "#".$col]; - } - } else { - %upt = ( 3600 => ['<1h', '#FFD3D3'], - 2*3600 => ['<2h', '#FFE4C7'], - 6*3600 => ['<6h', '#FFF9BA'], - 12*3600 => ['<12h','#F3FFC0'], - 24*3600 => ['<1d', '#E1FFCC'], - 7*24*3600 => ['<1w', '#BBFFCB'], - 30*24*3600 => ['<1m', '#BAFFF5'], - '1e100' => ['>1m', '#DAECFF'] - ); - } - my $lastup = 0; - foreach my $uptime (sort {$a <=> $b} keys %upt){ - push @upargs, - ( - "CDEF:up$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,INF,UNKN,IF", - "AREA:up$uptime$upt{$uptime}[1]:$upt{$uptime}[0]" - ); - push @upsmoke, - ( - "CDEF:ups$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,cp2,UNKN,IF", - "AREA:ups$uptime$upt{$uptime}[1]" + @upsmoke = (); + @upargs = ('COMMENT:Link Up${BS}: ', + "DEF:uptime=${rrd}:uptime:AVERAGE", + "CDEF:duptime=uptime,86400,/", + 'GPRINT:duptime:LAST: %0.1lf days ('); + my $lastup = 0; + foreach my $uptime (sort {$a <=> $b} keys %upt){ + push @upargs, + ( + "CDEF:up$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,INF,UNKN,IF", + "AREA:up$uptime$upt{$uptime}[1]:$upt{$uptime}[0]" + ); + push @upsmoke, + ( + "CDEF:ups$uptime=uptime,$lastup,GE,uptime,$uptime,LE,*,cp2,UNKN,IF", + "AREA:ups$uptime$upt{$uptime}[1]" ); - $lastup=$uptime; - } - - push @upargs, 'COMMENT:)\l'; -# map {print "$_<br/>"} @upargs; - }; + $lastup=$uptime; + } + + push @upargs, 'COMMENT:)\l'; + # map {print "$_<br/>"} @upargs; + }; my @log = (); push @log, "--logarithmic" if $cfg->{Presentation}{detail}{logarithmic} and - $cfg->{Presentation}{detail}{logarithmic} eq 'yes'; - + $cfg->{Presentation}{detail}{logarithmic} eq 'yes'; + my @lazy =(); - @lazy = ('--lazy') if $lasthight{$start} and $lasthight{$start} == $max->{$start}; + @lazy = ('--lazy') if $mode eq 's' and $lasthight{$start} and $lasthight{$start} == $max->{$start}; + $desc = "Navigator Graph" if $mode eq 'n'; my ($graphret,$xs,$ys) = RRDs::graph - ($cfg->{General}{imgcache}.$dir."/${file}_last_${start}.png", + ("${imgbase}_${end}_${start}.png", @lazy, - '--start','-'.$start, + '--start',( $mode eq 's' ? '-'.$start : $start), + ($end ne 'last' ? ('--end',$end) : ()), '--height',$cfg->{Presentation}{detail}{height}, '--width',,$cfg->{Presentation}{detail}{width}, '--title',$desc, - '--rigid', - '--upper-limit', $max->{$start}, + '--rigid','--upper-limit', $max->{$start}, @log, '--lower-limit',(@log ? ($max->{$start} > 0.01) ? '0.001' : '0.0001' : '0'), '--vertical-label',"Seconds", @@ -824,8 +894,6 @@ sub get_detail ($$$$){ @$smoke, @upsmoke, # draw the rest of the uptime bg color @median, -# 'LINE3:median#ff0000:Median RTT in grey '.$cfg->{Database}{pings}.' pings sorted by RTT', -# 'LINE1:median#ff8080', # Gray background for times when no data was collected, so they can # be distinguished from network being down. ( $cfg->{Presentation}{detail}{nodata_color} ? ( @@ -834,14 +902,34 @@ sub get_detail ($$$$){ ()), 'HRULE:0#000000', 'COMMENT:\s', - "COMMENT:Probe: $pings $ProbeDesc every $step seconds", + "COMMENT:Probe${BS}: $pings $ProbeDesc every $step seconds", 'COMMENT:created on '.$date.'\j' ); my $ERROR = RRDs::error(); - $page .= "<div>". - ( $ERROR || - "<IMG BORDER=\"0\" WIDTH=\"$xs\" HEIGHT=\"$ys\" ". - "SRC=\"".$cfg->{General}{imgurl}.$dir."/${file}_last_${start}.png\">" )."</div>"; + if ($mode eq 'n'){ + $page .= "<div>"; + $page .= ( $ERROR || qq{<IMG BORDER="0" WIDTH="$xs" HEIGHT="$ys" SRC="${imghref}_${end}_${start}.png">} ); + $page .= "</div>"; + $page .= $q->start_form(-method=>'GET') + . "<p>Time range: " + . $q->textfield(-name=>'start',-default=>$startstr) + . " to ".$q->textfield(-name=>'end',-default=>$endstr) + . $q->hidden(-name=>'target' ) + . $q->hidden(-name=>'displaymode',-default=>$mode ) + . " " + . $q->submit(-name=>'Generate!') + . "</p>" + . $q->end_form(); + } else { + $startstr =~ s/\s/%20/g; + $endstr =~ s/\s/%20/g; + $page .= "<div>"; + $page .= ( $ERROR || + qq{<a href="?displaymode=n;start=$startstr;end=$endstr;}."target=".$q->param('target').'">' + . qq{<IMG BORDER="0" WIDTH="$xs" HEIGHT="$ys" SRC="${imghref}_${end}_${start}.png">}."</a>" ); + $page .= "</div>"; + + } } return $page; @@ -925,7 +1013,8 @@ sub update_rrds($$$$$) { } # if we are looking down a branche where no probe propperty is set there is not sense # in further exploring it - next unless defined $probe and defined $justthisprobe and $probe ne $justthisprobe; + next unless defined $probe; + next if defined $justthisprobe and $probe ne $justthisprobe; my $probeobj = $probes->{$probe}; if ($prop eq 'host' and check_filter($cfg,$name)) { #print "update $name\n"; |