/[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 1 - (show annotations)
Thu Jul 16 18:48:19 2009 UTC (11 years, 6 months ago) by dpavlin
File size: 13543 byte(s)
import upstream http://rrd.me.uk/rrd-simple-monitoring.tar.gz

without prerequisities

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 => '/home/nicolaw/webroot/www/rrd.me.uk';
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 like => sub { return defined($_[0]) && defined($_[1]) && $_[0] =~ /$_[1]/i ? 1 : 0; },
319 not => sub { return !$_[0]; },
320 equal_or_like => sub {
321 return 1 if (!defined($_[1]) || !length($_[1])) && (!defined($_[2]) || !length($_[2]));
322 #(warn "$_[0] eq $_[1]\n" && return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
323 (return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
324 return 1 if defined $_[2] && "$_[0]" =~ /$_[2]/;
325 return 0;
326 },
327 },
328 );
329 $template->param(\%tmpl);
330
331 $html->{html} = $template->output();
332 $html->{html} =~ s/[ \t][ \t]+/ /g unless $q{DEBUG};
333 $html->{last_update} = time;
334 eval { $CACHE->freeze($cache_key, $html); };
335 warn $@ if $@;
336 print $cgi->header(-content => 'text/html'), $html->{html};
337
338 exit;
339
340
341 # Is the RRD file that generated this image considered stale?
342 sub stale_rrd {
343 my $rrd_file = shift;
344 return unless defined $rrd_file && $rrd_file;
345 my $rrd_mtime = (stat($rrd_file))[9];
346
347 if (defined(wantarray)) {
348 my $modified = scalar(localtime($rrd_mtime));
349 if (wantarray) {
350 return (1, $modified) if time - $rrd_mtime >= STALE_THRESHOLD;
351 return (0, $modified);
352 } else {
353 return 1 if time - $rrd_mtime >= STALE_THRESHOLD;
354 return 0;
355 }
356 }
357
358 return;
359 }
360
361 # Slurp in a file from disk, yum yum
362 sub slurp {
363 my $rtn = $_[0];
364 if (open(FH,'<',$_[0])) {
365 local $/ = undef;
366 $rtn = <FH>;
367 close(FH);
368 }
369 return $rtn;
370 }
371
372 # Sort by domain
373 sub by_domain {
374 sub split_domain {
375 local $_ = shift || '';
376 if (/(.*)\.(\w\w\w+)$/) {
377 return ($2,$1);
378 } elsif (/(.*)\.(\w+\.\w\w)$/) {
379 return ($2,$1);
380 }
381 return ($_,'');
382 }
383 my @A = split_domain($a);
384 my @B = split_domain($b);
385
386 ($A[0] cmp $B[0])
387 ||
388 ($A[1] cmp $B[1])
389 }
390
391 # Sort by time period
392 sub alpha_period {
393 my %order = qw(daily 0 weekly 1 monthly 2 annual 3 3year 4);
394 ($a =~ /^(.+)\-/)[0] cmp ($b =~ /^(.+)\-/)[0]
395 ||
396 $order{($a =~ /^.+\-(\w+)\./)[0]} <=> $order{($b =~ /^.+\-(\w+)\./)[0]}
397 }
398
399 # Return a list of items in a directory
400 sub list_dir {
401 my $dir = shift;
402 opendir(DH,$dir) || die "Unable to open file handle for directory '$dir': $!";
403 my @items = grep(!/^\./,readdir(DH));
404 closedir(DH) || die "Unable to close file handle for directory '$dir': $!";
405 return @items;
406 }
407
408 # Pull out the most relevent graph definition
409 sub graph_def {
410 my ($gdefs,$graph) = @_;
411 return {} unless defined $graph;
412
413 my $rtn = {};
414 for (keys %{$gdefs->{graph}}) {
415 my $graph_key = qr(^$_$);
416 if ($graph =~ /$graph_key/) {
417 $rtn = { %{$gdefs->{graph}->{$_}} };
418 my ($var) = $graph =~ /_([^_]+)$/;
419 for my $key (keys %{$rtn}) {
420 $rtn->{$key} =~ s/\$1/$var/g;
421 }
422 last;
423 }
424 }
425
426 return $rtn;
427 }
428
429 # Read in the graph definition config file
430 sub read_graph_data {
431 my $filename = shift || undef;
432
433 my %config = ();
434 eval {
435 my $conf = new Config::General(
436 -ConfigFile => $filename,
437 -LowerCaseNames => 1,
438 -UseApacheInclude => 1,
439 -IncludeRelative => 1,
440 # -DefaultConfig => \%default,
441 -MergeDuplicateBlocks => 1,
442 -AllowMultiOptions => 1,
443 -MergeDuplicateOptions => 1,
444 -AutoTrue => 1,
445 );
446 %config = $conf->getall;
447 };
448 warn $@ if $@;
449
450 return \%config;
451 }
452
453 1;
454
455

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26