/[rrd-simple-monitoring]/cgi-bin/rrd-browse.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /cgi-bin/rrd-browse.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (show annotations)
Thu Jul 16 20:01:16 2009 UTC (10 years, 2 months ago) by dpavlin
File size: 13926 byte(s)
turn min/max/last <pre> into table for nicer layout

1 #!/usr/bin/perl
2 ############################################################
3 #
4 # $Id: rrd-browse.cgi 692 2006-06-26 19:11:14Z nicolaw $
5 # rrd-browse.cgi - Graph browser CGI script for RRD::Simple
6 #
7 # Copyright 2006,2007 Nicola Worthington
8 #
9 # Licensed under the Apache License, Version 2.0 (the "License");
10 # you may not use this file except in compliance with the License.
11 # You may obtain a copy of the License at
12 #
13 # http://www.apache.org/licenses/LICENSE-2.0
14 #
15 # Unless required by applicable law or agreed to in writing, software
16 # distributed under the License is distributed on an "AS IS" BASIS,
17 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
18 # See the License for the specific language governing permissions and
19 # limitations under the License.
20 #
21 ############################################################
22 # vim:ts=4:sw=4:tw=78
23
24 # User defined constants
25 use constant BASEDIR => '/var/www/rrd';
26 use constant RRDURL => '';
27
28 # Caching
29 use constant CACHE => 1;
30 use constant DEFAULT_EXPIRES => '60 minutes';
31
32 # When is an RRD file regarded as stale?
33 use constant STALE_THRESHOLD => 60*60; # 60 minutes
34
35 ############################################################
36
37
38
39
40 use 5.6.1;
41 use warnings;
42 use strict;
43 use CGI;
44 use CGI::Carp qw(fatalsToBrowser);
45 use HTML::Template::Expr;
46 use File::Basename qw(basename);
47 use Config::General qw();
48 use File::Spec::Functions qw(tmpdir catdir catfile);
49 use vars qw(%LIST_CACHE %GRAPH_CACHE %SLURP_CACHE
50 $CACHE_ROOT $CACHE $FRESHEN_CACHE %STALERRD_CACHE);
51
52 # Enable some basic caching.
53 # See notes about $tmpl_cache a little further
54 # down in this code.
55 if (CACHE) {
56 # Cache calls to list_dir() and graph_def()
57 require Memoize;
58 Memoize::memoize('list_dir', LIST_CACHE => [HASH => \%LIST_CACHE]);
59 Memoize::memoize('graph_def', SCALAR_CACHE => [HASH => \%GRAPH_CACHE]);
60 Memoize::memoize('stale_rrd', SCALAR_CACHE => [HASH => \%STALERRD_CACHE]);
61
62 # This isn't really necessary unless you're viewing the same page many
63 # times over in defail view - i don't think that the extra memory utilisation
64 # is worth the small improvement in rendering time.
65 #Memoize::memoize('slurp', SCALAR_CACHE => [HASH => \%SLURP_CACHE]);
66
67 # Try some caching on disk
68 unless (defined($CACHE) && ref($CACHE)) {
69 $CACHE_ROOT = catdir(tmpdir(), 'rrd-browse.cgi');
70 mkdir($CACHE_ROOT,0700) unless -d $CACHE_ROOT;
71 eval {
72 require Cache::File;
73 $CACHE = Cache::File->new(
74 cache_root => $CACHE_ROOT,
75 default_expires => DEFAULT_EXPIRES
76 );
77 };
78 warn $@ if $@;
79 };
80 }
81
82
83 # Grab CGI paramaters
84 my $cgi = new CGI;
85 my %q = $cgi->Vars;
86 my $cache_key = $cgi->self_url(-absolute => 1, -query_string => 1, -path_info => 1);
87
88 # cd to the righr location and define directories
89 my %dir = map { ( $_ => BASEDIR."/$_" ) } qw(data etc graphs cgi-bin thumbnails);
90 chdir $dir{'cgi-bin'} || die sprintf("Unable to chdir to '%s': %s", $dir{'cgi-bin'}, $!);
91
92 # Create the initial %tmpl data hash
93 my %tmpl = %ENV;
94 $tmpl{template} = defined $q{template} && -f $q{template} ? $q{template} : 'index.tmpl';
95 die "Uh uh uh! Who's a naughty boy?\n" if $tmpl{template} =~ /^\s*\// || $tmpl{template} =~ /\.\./ || $tmpl{template} !~ /\.tmpl$/i;
96 $tmpl{PERIOD} = defined $q{PERIOD} && $q{PERIOD} =~ /^(daily|weekly|monthly|annual)$/i ? lc($q{PERIOD}) : 'daily';
97 $tmpl{title} = ucfirst(basename($tmpl{template},'.tmpl')); $tmpl{title} =~ s/[_\-]/ /g;
98 $tmpl{self_url} = $cgi->self_url(-absolute => 1, -query_string => 0, -path_info => 0);
99 $tmpl{rrd_url} = RRDURL;
100
101 # Go read a bunch of stuff from disk to pump in to %tmpl in a moment
102 my $gdefs = read_graph_data("$dir{etc}/graph.defs");
103 my @graphs = list_dir($dir{graphs});
104 # my @thumbnails = list_dir($dir{thumbnails}); # Not used anywhere
105
106
107 # Build up the data in %tmpl by host
108 # The $tmpl_cache structure could be cached in theory, but
109 # the process of thawing actually uses LOTS of memory if
110 # the source structure was quite sizable to start with. For
111 # this reason, I'm *NOT* actually caching this structure
112 # anymore, and am opting to cache the HTML output on a per
113 # URL basis. This means there's less chance of a cache hit,
114 # but it means you don't use 715MB of memory if you have
115 # 100 or so servers with an average of 25 graphs per host.
116 my $tmpl_cache = {
117 graph_tmpl => {},
118 hosts => [],
119 graphs => [],
120 };
121
122
123 # Pull in the HTML cache (mentioned above)
124 my $html = { last_update => 0, html => '' };
125
126 # Check if we should force an update on the cache
127 if ($q{FRESHEN_CACHE}) {
128 $FRESHEN_CACHE = 1 ;
129 }
130
131 # Check the mtimes of each directory for any modifications
132 # and thereby a requirement to freshen our caches
133 if (!defined($FRESHEN_CACHE) && !$FRESHEN_CACHE) {
134 while (my ($k,$dir) = each %dir) {
135 if (!defined $html->{last_update} || (stat($dir))[9] > $html->{last_update}) {
136 $FRESHEN_CACHE = 1;
137 warn "$k($dir) has been modified since the cache was last updated; forcing an update now\n";
138 }
139 }
140 }
141
142 # Output from the cache if possible
143 if (!$FRESHEN_CACHE) {
144 eval { $html = $CACHE->thaw($cache_key); };
145 warn $@ if $@;
146 if ($html->{html}) {
147 #warn "Using cached version '$cache_key'\n";
148 $html->{html} =~ s/[ \t][ \t]+/ /g unless $q{DEBUG};
149 print $cgi->header(-content => 'text/html'), $html->{html};
150 exit;
151 }
152 } else {
153 %LIST_CACHE = ();
154 %GRAPH_CACHE = ();
155 %STALERRD_CACHE = ();
156 %SLURP_CACHE = ();
157 }
158
159
160 #######################################
161 #
162 # This section of code is REALLY slow and
163 # ineffecient. A basic work around of caching
164 # pages based on the URL has been implemented
165 # to try and avoid having to execute this code
166 # at all. This is a poor work around. I need
167 # to optimise this code. If you have any
168 # patches to help, please send them to
169 # nicolaw@cpan.org.
170 #
171 #######################################
172 for my $host (sort by_domain list_dir($dir{data})) {
173 my $path = catfile($dir{data},$host);
174 next unless -d $path || (-l $path && -d readlink($path));
175
176 # NEECHI-HACK!
177 # This is removing some templating logic from the HTML::Template .tmpl file
178 # themsevles and bringing it in to this loop in order to save a number of
179 # loop cycles and speed up the pre-processing before we render the HTML.
180 next if defined($q{HOST}) && $q{HOST} ne $host;
181 next if defined($q{LIKE}) && $tmpl{template} =~ /^by_host\.[^\.]+$/i && $host !~ /$q{LIKE}/i;
182
183 (my $node = $host) =~ s/\..*//;
184 (my $domain = $host) =~ s/^.*?\.//;
185 (my $domain2 = $domain) =~ s/[^a-zA-Z0-9\_]/_/g;
186 (my $host2 = $host) =~ s/[^a-zA-Z0-9\_]/_/g;
187
188 my %host = (
189 host => $host,
190 host2 => $host2,
191 node => $node,
192 domain => $domain,
193 domain2 => $domain2,
194 );
195
196 # Build a hash of potential files that users can slurp() or include
197 # in their output template on a per host basis.
198 for my $file (grep(/\.(?:te?xt|s?html?|xslt?|xml|css|tmpl)$/i,
199 glob("$dir{data}/$host/include*.*"))) {
200 (my $base = basename($file)) =~ s/\./_/g;
201 $host{$base} = $file;
202 }
203
204 if (!grep(/^$host$/,@graphs)) {
205 $host{no_graphs} = 1;
206 push @{$tmpl_cache->{hosts}}, \%host;
207
208 } else {
209 my $all_host_rrds_stale = 1;
210
211 for (qw(thumbnails graphs)) {
212 eval {
213 my @ary = ();
214 for my $img (sort alpha_period
215 grep(/\.(png|jpe?g|gif)$/i,list_dir("$dir{$_}/$host"))) {
216 my ($graph) = ($img =~ /^(.+)\-\w+\.\w+$/);
217
218 # NEECHI-HACK!
219 # This is another nasty hack that removed some of the logic from the
220 # HTML::Template code by pre-excluding specific data from the template
221 # data and thereby speeding up the rendering of the HTML.
222 next if defined($q{GRAPH}) && $q{GRAPH} ne $graph;
223 next if defined($q{LIKE})
224 && $tmpl{template} =~ /^by_graph\.[^\.]+$/i
225 && $graph !~ /$q{LIKE}/i;
226
227 my %hash = (
228 src => "$tmpl{rrd_url}/$_/$host/$img",
229 period => ($img =~ /.*-(\w+)\.\w+$/),
230 graph => $graph,
231 );
232
233 my $gdef = graph_def($gdefs,$hash{graph});
234 $hash{title} = defined $gdef->{title} ? $gdef->{title} : $hash{graph};
235
236 # Is the RRD file that generated this image considered stale?
237 my ($stale, $last_modified) = stale_rrd(catfile($dir{data},$host,"$graph.rrd"));
238 if (defined($stale) && $stale) {
239 $hash{stale} = $last_modified;
240 } else {
241 $all_host_rrds_stale = 0;
242 }
243
244 # Include the path on disk to the .txt file that is generated by the
245 # output of the RRD::Simple->graph() method while generating the graphs
246 $hash{txt} = catfile($dir{graphs},$host,"$img.txt")
247 if $_ eq 'graphs'
248 && -e catfile($dir{graphs},$host,"$img.txt")
249 && (stat(_))[7] > 5;
250
251 push @ary, \%hash;
252
253 # By graph later
254 if ($_ eq 'thumbnails' && defined $hash{graph}) {
255 # && defined $hash{period} && $hash{period} eq 'daily') {
256 my %hash2 = %hash;
257 delete $hash2{title};
258 $hash2{host} = $host;
259 if (defined $hash{period} && $hash{period} eq 'daily') {
260 $tmpl_cache->{hosts_per_graph}->{$hash{graph}} = 0
261 unless defined $tmpl_cache->{hosts_per_graph}->{$hash{graph}};
262 $tmpl_cache->{hosts_per_graph}->{$hash{graph}}++;
263 }
264 push @{$tmpl_cache->{graph_tmpl}->{"$hash{graph}\t$hash{title}"}}, \%hash2;
265 }
266 }
267 $host{$_} = \@ary;
268 };
269 warn $@ if $@;
270 }
271
272 if ($all_host_rrds_stale) {
273 $host{stale} = 1;
274 }
275 $host{total_graphs} = grep(/^daily$/, map { $_->{period} } @{$host{graphs}});
276 push @{$tmpl_cache->{hosts}}, \%host;
277 }
278 }
279
280 # Merge cache data in
281 $tmpl{hosts} = $tmpl_cache->{hosts};
282
283 # Merge by-graph cache data in
284 for (sort keys %{$tmpl_cache->{graph_tmpl}}) {
285 my ($graph,$title) = split(/\t/,$_);
286 push @{$tmpl{graphs}}, {
287 graph => $graph,
288 graph_title => $title,
289 total_hosts => $tmpl_cache->{hosts_per_graph}->{$graph},
290 thumbnails => $tmpl_cache->{graph_tmpl}->{$_},
291 };
292 }
293
294 # Render the output
295 if (exists $q{DEBUG} && $q{DEBUG} eq 'insecure') {
296 require Data::Dumper;
297 $tmpl{DEBUG} = Data::Dumper::Dumper(\%tmpl);
298 }
299 my $template = HTML::Template::Expr->new(
300 filename => $tmpl{template},
301
302 # This caching doesn't work properly with
303 # HTML::Template::Expr
304 #cache => 1,
305 #shared_cache => 1,
306 #file_cache => 1,
307 #file_cache_dir => $CACHE_ROOT,
308 #file_cache_dir_mode => 0700,
309
310 associate => $cgi,
311 case_sensitive => 1,
312 loop_context_vars => 1,
313 max_includes => 5,
314 global_vars => 1,
315 die_on_bad_params => 0,
316 functions => {
317 slurp => \&slurp,
318 table => \&table,
319 like => sub { return defined($_[0]) && defined($_[1]) && $_[0] =~ /$_[1]/i ? 1 : 0; },
320 not => sub { return !$_[0]; },
321 equal_or_like => sub {
322 return 1 if (!defined($_[1]) || !length($_[1])) && (!defined($_[2]) || !length($_[2]));
323 #(warn "$_[0] eq $_[1]\n" && return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
324 (return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
325 return 1 if defined $_[2] && "$_[0]" =~ /$_[2]/;
326 return 0;
327 },
328 },
329 );
330 $template->param(\%tmpl);
331
332 $html->{html} = $template->output();
333 $html->{html} =~ s/[ \t][ \t]+/ /g unless $q{DEBUG};
334 $html->{last_update} = time;
335 eval { $CACHE->freeze($cache_key, $html); };
336 warn $@ if $@;
337 print $cgi->header(-content => 'text/html'), $html->{html};
338
339 exit;
340
341
342 # Is the RRD file that generated this image considered stale?
343 sub stale_rrd {
344 my $rrd_file = shift;
345 return unless defined $rrd_file && $rrd_file;
346 my $rrd_mtime = (stat($rrd_file))[9];
347
348 if (defined(wantarray)) {
349 my $modified = scalar(localtime($rrd_mtime));
350 if (wantarray) {
351 return (1, $modified) if time - $rrd_mtime >= STALE_THRESHOLD;
352 return (0, $modified);
353 } else {
354 return 1 if time - $rrd_mtime >= STALE_THRESHOLD;
355 return 0;
356 }
357 }
358
359 return;
360 }
361
362 # Slurp in a file from disk, yum yum
363 sub slurp {
364 my $rtn = $_[0];
365 if (open(FH,'<',$_[0])) {
366 local $/ = undef;
367 $rtn = <FH>;
368 close(FH);
369 }
370 return $rtn;
371 }
372
373 sub table {
374 my $file = shift;
375 my @rows = split(/[\n\r]+/, slurp($file));
376 use Data::Dump qw/dump/;
377 warn dump( @rows );
378 return
379 qq|<tr><th colspan=4>| . shift(@rows) . qq|</th><tr>|
380 . qq|<tr><th></th><th>min</th><th>max</th><th>last</th></tr>|
381 . join("\n", map {
382 qq|<tr><td>|
383 . join(qq|</td><td align=right>|, split(/,?\s+\w+:\s+/, $_))
384 . qq|</tr><td>|
385 } @rows
386 )
387 ;
388 }
389
390 # Sort by domain
391 sub by_domain {
392 sub split_domain {
393 local $_ = shift || '';
394 if (/(.*)\.(\w\w\w+)$/) {
395 return ($2,$1);
396 } elsif (/(.*)\.(\w+\.\w\w)$/) {
397 return ($2,$1);
398 }
399 return ($_,'');
400 }
401 my @A = split_domain($a);
402 my @B = split_domain($b);
403
404 ($A[0] cmp $B[0])
405 ||
406 ($A[1] cmp $B[1])
407 }
408
409 # Sort by time period
410 sub alpha_period {
411 my %order = qw(daily 0 weekly 1 monthly 2 annual 3 3year 4);
412 ($a =~ /^(.+)\-/)[0] cmp ($b =~ /^(.+)\-/)[0]
413 ||
414 $order{($a =~ /^.+\-(\w+)\./)[0]} <=> $order{($b =~ /^.+\-(\w+)\./)[0]}
415 }
416
417 # Return a list of items in a directory
418 sub list_dir {
419 my $dir = shift;
420 opendir(DH,$dir) || die "Unable to open file handle for directory '$dir': $!";
421 my @items = grep(!/^\./,readdir(DH));
422 closedir(DH) || die "Unable to close file handle for directory '$dir': $!";
423 return @items;
424 }
425
426 # Pull out the most relevent graph definition
427 sub graph_def {
428 my ($gdefs,$graph) = @_;
429 return {} unless defined $graph;
430
431 my $rtn = {};
432 for (keys %{$gdefs->{graph}}) {
433 my $graph_key = qr(^$_$);
434 if ($graph =~ /$graph_key/) {
435 $rtn = { %{$gdefs->{graph}->{$_}} };
436 my ($var) = $graph =~ /_([^_]+)$/;
437 for my $key (keys %{$rtn}) {
438 $rtn->{$key} =~ s/\$1/$var/g;
439 }
440 last;
441 }
442 }
443
444 return $rtn;
445 }
446
447 # Read in the graph definition config file
448 sub read_graph_data {
449 my $filename = shift || undef;
450
451 my %config = ();
452 eval {
453 my $conf = new Config::General(
454 -ConfigFile => $filename,
455 -LowerCaseNames => 1,
456 -UseApacheInclude => 1,
457 -IncludeRelative => 1,
458 # -DefaultConfig => \%default,
459 -MergeDuplicateBlocks => 1,
460 -AllowMultiOptions => 1,
461 -MergeDuplicateOptions => 1,
462 -AutoTrue => 1,
463 );
464 %config = $conf->getall;
465 };
466 warn $@ if $@;
467
468 return \%config;
469 }
470
471 1;
472
473

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26