/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 dpavlin 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 dpavlin 4 use constant BASEDIR => '/var/www/rrd';
26 dpavlin 1 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 dpavlin 4 table => \&table,
319 dpavlin 1 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 dpavlin 4 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 dpavlin 1 # 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