ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/reports/rrdgraphing/graph.pl
(Generate patch)

Comparing projects/cms/source/reports/rrdgraphing/graph.pl (file contents):
Revision 1.4 by tdb, Tue May 21 11:37:56 2002 UTC vs.
Revision 1.10 by tdb, Sun Oct 13 15:14:00 2002 UTC

# Line 33 | Line 33
33   # possibly make more configurable?
34   #  -- allow configurable periods of graphs
35   #  -- comments, types, etc
36 #  -- move all to external config file
36  
37 + my($version) = '$Id$';
38 +
39   $| = 1;
40 +
41   use strict;
42 + use Getopt::Std;
43   use RRDs;
44  
45 < # Base directory for images
46 < # (a directory will be constructed for each host under this)
47 < my($imgdir) = "/home/pkg/iscream/public_html/graphs";
45 > # define variables that will be read from the config
46 > # nb. keep this insync with the config file!
47 > use vars qw{
48 >    $imgdir $rrddir                    
49 >    $maxrrdage $maximgage $deleterrds $deleteimgs
50 >    $hex_slash $hex_underscore  
51 >    $rrdstep $retry_wait
52 >    $verbose $quiet
53 > };
54  
55 < # Location of RRD databases
56 < my($rrddir) = "/u1/i-scream/databases";
55 > # default locate of the config file
56 > my($configfile) = "rrdgraphing.conf";
57  
58 < # / converted to a decimal then hex'd
59 < my($hex_slash) = "_2f";
60 < # _ converted to a decimal then hex'd
52 < my($hex_underscore) = "_5f";
58 > # check for command line arguments
59 > my(%opts);
60 > my($ret) = getopts('hvqVc:', \%opts);
61  
62 < # maximum age (last modified) before an rrd or graph get cleaned up
63 < # (in seconds)
56 < my($maxrrdage) = 3600; # 1 hour
57 < my($maximgage) = 3600; # 1 hour
62 > # if invalid argument given, $ret will not be 1
63 > &usage() if $ret != 1;
64  
65 < # delete rrd's when they get cleaned up?
60 < # if unset, will just ignore the rrd's
61 < #  - usually best to leave this off, we don't want to delete useful rrds :)
62 < my($deleterrds) = 0;
65 > # first process the arguments which might mean we exit now
66  
67 < # delete graphs when they get cleaned up?
68 < # if unset, won't bother checking at all
69 < #  - usually best to leave this on
70 < my($deleteimgs) = 1;
71 <    
67 > # -h is usage
68 > if($opts{h}) {
69 >    &usage();
70 > }
71 > # -V is version
72 > if($opts{V}) {
73 >    print "graph.pl version: $version\n";
74 >    exit(1);
75 > }
76 >
77 > # Then try getting the config
78 >
79 > # -c specifies the config file location
80 > if($opts{c}) {
81 >    $configfile = $opts{c};
82 > }
83 > # suck in the config
84 > &log("reading config from $configfile\n");
85 > do $configfile;
86 >
87 > # Then any options we might want to override the config with
88 >
89 > # -v is verbose
90 > if($opts{v}) {
91 >    $verbose = $opts{v};
92 > }
93 > # -q is verbose
94 > if($opts{q}) {
95 >    $quiet = $opts{q};
96 >    # if we're meant to be quiet, we can hardly be verbose!
97 >    $verbose = 0;
98 > }
99 >
100   # Read the contents of the base directory
101   # and pull out the list of subdirectories (except . and .. :)
102   opendir(DIR, $rrddir);
# Line 92 | Line 123 | foreach my $machine (@rrddirlist) {
123              if($deleterrds) {
124                  # if so, delete it
125                  unlink("$rrddir/$machine/$rrd");
126 +                &log("deleted old rrd $rrddir/$machine/$rrd\n");
127              }
128 +            else {
129 +                &log("ignored old rrd $rrddir/$machine/$rrd\n");
130 +            }
131              # no more processing required for this rrd
132              next;
133          }
134          if($rrd =~ /^(cpu)\.rrd$/) {
135              my(@data);
136              my(@rawdata);
137 <            push @data, "LINE2:$1:idle:idle#00FF00:idle cpu";
138 <            push @data, "LINE2:$1:user:user#0000FF:user cpu";
139 <            push @data, "LINE2:$1:kernel:kernel#00FFFF:kernel cpu";
140 <            push @data, "LINE2:$1:swap:swap#FF00FF:swap cpu";
141 <            push @data, "LINE2:$1:iowait:iowait#FF0000:iowait cpu";
137 >            push @data, "LINE2:$1:idle:idle#00FF00:OK:idle cpu  ";
138 >            push @data, "LINE2:$1:user:user#0000FF:OK:user cpu  ";
139 >            push @data, "LINE2:$1:kernel:kernel#00FFFF:OK:kernel cpu";
140 >            push @data, "LINE2:$1:swap:swap#FF00FF:OK:swap cpu  ";
141 >            push @data, "LINE2:$1:iowait:iowait#FF0000:OK:iowait cpu";
142              push @rawdata, "--upper-limit=100";
143 <            &makegraph($machine, $1, "CPU Usage for $machine", \@data, \@rawdata);
143 >            &makegraph($machine, $1, "CPU Usage for $machine", "% cpu time", \@data, \@rawdata);
144          }
145          if($rrd =~ /^(mem)\.rrd$/) {
146              my(@data);
147              my(@rawdata);
148              # we don't actually want to display free memory,
149              # although we need it to do inuse...
150 <            push @data, "NONE:$1:free:free#CCCCFF:free memory";
151 <            push @data, "LINE2:$1:total:total#0000FF:total memory";
150 >            push @data, "NONE:$1:free:free#CCCCFF:NONE:free memory";
151 >            push @data, "LINE2:$1:total:total#0000FF:NONE:total memory\\n";
152              # calculate inuse
153              push @rawdata, "CDEF:inuse=total,free,-";
154              # and add it to the graph
155              push @rawdata, "AREA:inuse#CCCCFF:memory in use";
156              push @rawdata, "--base=1024";
157 <            &makegraph($machine, $1, "Memory Usage for $machine", \@data, \@rawdata);
157 >            # add some nice values to the legend
158 >            &addlegend(\@rawdata, "inuse");
159 >            &makegraph($machine, $1, "Memory Usage for $machine", "megabytes", \@data, \@rawdata);
160          }
161          if($rrd =~ /^(load)\.rrd$/) {
162              my(@data);
163 <            push @data, "LINE2:$1:load1:load1#CCCCFF:1 minute load average";
164 <            push @data, "LINE2:$1:load5:load5#7777FF:5 minute load average";
165 <            push @data, "LINE2:$1:load15:load15#0000FF:15 minute load average";
166 <            &makegraph($machine, $1, "Loads for $machine", \@data);
163 >            push @data, "LINE2:$1:load1:load1#CCCCFF:OK: 1 min load average";
164 >            push @data, "LINE2:$1:load5:load5#7777FF:OK: 5 min load average";
165 >            push @data, "LINE2:$1:load15:load15#0000FF:OK:15 min load average";
166 >            &makegraph($machine, $1, "Loads for $machine", "load average", \@data);
167          }
168          if($rrd =~ /^(proc)\.rrd$/) {
169              my(@data);
170 <            push @data, "LINE2:$1:cpu:cpu#00FF00:cpu processes";
171 <            push @data, "LINE2:$1:sleeping:sleeping#0000FF:sleeping processes";
172 <            push @data, "LINE2:$1:stopped:stopped#00FFFF:stopped processes";
173 <            push @data, "LINE2:$1:total:total#FF00FF:total processes";
174 <            push @data, "LINE2:$1:zombie:zombie#FF0000:zombie processes";
175 <            &makegraph($machine, $1, "Processes on $machine", \@data);
170 >            push @data, "LINE2:$1:cpu:cpu#00FF00:OK:cpu processes     ";
171 >            push @data, "LINE2:$1:sleeping:sleeping#0000FF:OK:sleeping processes";
172 >            push @data, "LINE2:$1:stopped:stopped#00FFFF:OK:stopped processes ";
173 >            push @data, "LINE2:$1:total:total#FF00FF:OK:total processes   ";
174 >            push @data, "LINE2:$1:zombie:zombie#FF0000:OK:zombie processes  ";
175 >            &makegraph($machine, $1, "Processes on $machine", "no. of processes", \@data);
176          }
177          if($rrd =~ /^(swap)\.rrd$/) {
178              my(@data);
179              my(@rawdata);
180              # we don't actually want to display free swap,
181              # although we need it to do inuse...
182 <            push @data, "NONE:$1:free:free#CCCCFF:free swap";
183 <            push @data, "LINE2:$1:total:total#0000FF:total swap";
182 >            push @data, "NONE:$1:free:free#CCCCFF:NONE:free swap";
183 >            push @data, "LINE2:$1:total:total#0000FF:NONE:total swap\\n";
184              # calculate inuse
185              push @rawdata, "CDEF:inuse=total,free,-";
186              # and add it to the graph
187              push @rawdata, "AREA:inuse#CCCCFF:swap in use";
188              push @rawdata, "--base=1024";
189 <            &makegraph($machine, $1, "Swap Usage for $machine", \@data, \@rawdata);
189 >            # add some nice values to the legend
190 >            &addlegend(\@rawdata, "inuse");
191 >            &makegraph($machine, $1, "Swap Usage for $machine", "megabytes", \@data, \@rawdata);
192          }
193          if($rrd =~ /^(users)\.rrd$/) {
194              my(@data);
195 <            push @data, "AREA:$1:count:count#CCCCFF:user count";
196 <            &makegraph($machine, $1, "User Count for $machine", \@data);
195 >            push @data, "AREA:$1:count:count#CCCCFF:OK:user count";
196 >            &makegraph($machine, $1, "User Count for $machine", "no. of users", \@data);
197          }
198          if($rrd =~ /^(disk)-(\S+).rrd$/) {
199              my(@data);
200              my(@rawdata);
201 <            push @data, "LINE2:$1-$2:kbytes:kbytes#0000FF:total size";
202 <            push @data, "AREA:$1-$2:used:used#CCCCFF:used";
201 >            push @data, "LINE2:$1-$2:kbytes:kbytes#0000FF:NONE:total size\\n";
202 >            push @data, "AREA:$1-$2:used:used#CCCCFF:OK:used space";
203              push @rawdata, "--base=1024";
204              my($type) = $1;
205              my($name) = $2;
206              my($nicename) = $2;
207              $nicename =~ s/$hex_slash/\//g;
208              $nicename =~ s/$hex_underscore/_/g;
209 <            &makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", \@data, \@rawdata);
209 >            &makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", "kilobytes", \@data, \@rawdata);
210          }
211          # probably a queue with a name like this :)
212          if($rrd =~ /^(\d+)_0\.rrd$/) {
# Line 176 | Line 215 | foreach my $machine (@rrddirlist) {
215              my($baserrd) = $1;
216              my($i) = 0;
217              while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) {
218 <                push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":queue$i size ";
218 >                push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":OK:queue$i size ";
219                  ++$i;
220              }
221 <            push @data, "LINE2:$baserrd\_0:total:total#FF0000:packets/sec - currently";
183 <            push @rawdata, "GPRINT:total:LAST:%lf %spackets/sec";
221 >            push @data, "LINE2:$baserrd\_0:total:total#FF0000:OK:packets/sec ";
222              my($comment);
223              if(-f "$rrddir/$machine/$baserrd.def") {
224                  open(DEF, "$rrddir/$machine/$baserrd.def");
# Line 188 | Line 226 | foreach my $machine (@rrddirlist) {
226                  chomp $comment if defined $comment;
227              }
228              $comment = "unknown queue" if not defined $comment;
229 <            &makegraph($machine, $baserrd, $comment, \@data, \@rawdata);
229 >            &makegraph($machine, $baserrd, $comment, "", \@data, \@rawdata);
230          }
231      }
232      # have a last check, maybe we can remove the directory now?
# Line 200 | Line 238 | foreach my $machine (@rrddirlist) {
238          closedir DIR;
239          if($#dirlist == -1) {
240              rmdir "$rrddir/$machine";
241 +            &log("deleting empty rrd directory $rrddir/$machine\n");
242          }
243      }
244   }
# Line 229 | Line 268 | if($deleteimgs) {
268              if((time - $mtime) > $maximgage) {
269                  # if so, delete it
270                  unlink("$imgdir/$machine/$img");
271 +                &log("deleted old image $imgdir/$machine/$img\n");
272              }
273          }
274          # have a last check, maybe we can remove the directory now?
# Line 238 | Line 278 | if($deleteimgs) {
278          closedir DIR;
279          if($#dirlist == -1) {
280              rmdir "$imgdir/$machine";
281 +            &log("deleted empty image directory $imgdir/$machine\n");
282          }
283      }
284   }
# Line 254 | Line 295 | exit(0);
295   #              (eg. cpu)
296   # $title     = the title for the graph
297   #              (eg. kernow CPU usage)
298 + # $vlabel    = the vertical label to apply to the left side of the graph
299 + #              (eg. kb/s)
300   # $dataref   = a reference to an array containing information for the graph
301 < #              elements of format: "gtype:rrdname:dsname:name#colour:comment with spaces"
301 > #              elements of format: "gtype:rrdname:dsname:name#colour:legend:comment with spaces"
302   #              (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted)
303 + #              (if legend is "NONE" the latest/average/max/min legend won't be printed)
304   # $rawcmdref = a reference to an array containing raw rrd commands
305   #              elements a single command each, no spaces
306   #
307  
308   sub makegraph() {
309 <    my($machine, $type, $title, $dataref, $rawcmdref) = @_;
309 >    my($machine, $type, $title, $vlabel, $dataref, $rawcmdref) = @_;
310      # pass in these arrays by reference
311      my(@data) = @$dataref if defined $dataref;
312      my(@rawcmd) = @$rawcmdref if defined $rawcmdref;
# Line 270 | Line 314 | sub makegraph() {
314      if(! -d "$imgdir/$machine") {
315          # not sure on this umask, but it seems to work?
316          mkdir "$imgdir/$machine", 0777;
317 +        &log("created directory $imgdir/$machine\n");
318      }
319      my(@rrdcmd);
320      foreach my $dataitem (@data) {
321 <        # dataitem should be: "gtype:rrdname:dsname:name#colour:comment with spaces"
321 >        # dataitem should be: "gtype:rrdname:dsname:name#colour:legend:comment with spaces"
322          # (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted)
323 <        if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(.*)$/) {
323 >        # (if legend is "NONE" the latest/average/max/min legend won't be printed)
324 >        if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(\S+):(.*)$/) {
325              push @rrdcmd, "DEF:$4=$rrddir/$machine/$2.rrd:$3:AVERAGE";
326              if($1 ne "NONE") {
327 <                push @rrdcmd, "$1:$4#$5:$6";
327 >                push @rrdcmd, "$1:$4#$5:$7";
328 >                if($6 ne "NONE") {
329 >                    # add some nice values to the legend
330 >                    &addlegend(\@rrdcmd, $4);
331 >                }
332              }
333          }
334      }
335      push @rrdcmd, "--title=$title";
336      push @rrdcmd, "--imgformat=PNG";
337      push @rrdcmd, "--lower-limit=0";
338 +    push @rrdcmd, "--vertical-label=$vlabel";
339      # not entirely convinced this is good...
340      push @rrdcmd, "--alt-autoscale-max";
341      # add any further raw commands
342      push @rrdcmd, @rawcmd;
343      RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
344      my($err_3h) = RRDs::error;
345 <    print STDERR "Error generating 3h graph for $machine/$type: $err_3h\n" if $err_3h;
345 >    &log("created $imgdir/$machine/$type-3h.png\n") unless $err_3h;
346 >    &error("Error generating 3h graph for $machine/$type: $err_3h\n") if $err_3h;
347      RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
348      my($err_1d) = RRDs::error;
349 <    print STDERR "Error generating 1d graph for $machine/$type: $err_1d\n" if $err_1d;
349 >    &log("created $imgdir/$machine/$type-1d.png\n") unless $err_1d;
350 >    &error("Error generating 1d graph for $machine/$type: $err_1d\n") if $err_1d;
351      RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
352      my($err_1w) = RRDs::error;
353 <    print STDERR "Error generating 1w graph for $machine/$type: $err_1w\n" if $err_1w;
353 >    &log("created $imgdir/$machine/$type-1w.png\n") unless $err_1w;
354 >    &error("Error generating 1w graph for $machine/$type: $err_1w\n") if $err_1w;
355      RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
356      my($err_1m) = RRDs::error;
357 <    print STDERR "Error generating 1m graph for $machine/$type: $err_1m\n" if $err_1m;
357 >    &log("created $imgdir/$machine/$type-1m.png\n") unless $err_1m;
358 >    &error("Error generating 1m graph for $machine/$type: $err_1m\n") if $err_1m;
359      RRDs::graph ("$imgdir/$machine/$type-1y.png", "--start=-31536000", @rrdcmd);
360      my($err_1y) = RRDs::error;
361 <    print STDERR "Error generating 1y graph for $machine/$type: $err_1y\n" if $err_1y;
361 >    &log("created $imgdir/$machine/$type-1y.png\n") unless $err_1y;
362 >    &error("Error generating 1y graph for $machine/$type: $err_1y\n") if $err_1y;
363      return;
364   }
365  
366 + # subroutine to add a legend
367 + # accepts reference to an array and a name
368 + sub addlegend() {
369 +    my($dataref, $name) = @_;
370 +    push @$dataref, "GPRINT:$name:LAST:Current\\: \%8.2lf %s";
371 +    push @$dataref, "GPRINT:$name:AVERAGE:Average\\: \%8.2lf %s";
372 +    push @$dataref, "GPRINT:$name:MAX:Max\\: \%8.2lf %s\\n";
373 +    #push @$dataref, "GPRINT:$name:MIN:Min\\: \%8.2lf %s\\n";
374 + }
375 +
376   # hacky subroutine to return a colour
377   # could be done much better somehow :/
378   sub get_colour {
# Line 329 | Line 395 | sub get_colour {
395      else {
396          return "#000066";
397      }
398 + }
399 +
400 + # prints out usage information then exits
401 + sub usage() {
402 +    print "Usage: graph.pl [options]\n";
403 +    print "Options\n";
404 +    print "  -c config        Specifies the configuration file\n";
405 +    print "                    default: rrdgraphing.conf\n";
406 +    print "  -v               Be verbose about what's happening\n";
407 +    print "  -q               Be quiet, even supress errors\n";
408 +    print "  -V               Print version number\n";
409 +    print "  -h               Prints this help page\n";
410 +    exit(1);
411 + }      
412 +
413 + # prints a log message if verbose is turned on
414 + sub log() {
415 +    my($msg) = @_;
416 +    print $msg if $verbose;
417 + }
418 +
419 + # prints an error message unless quiet is turned on
420 + sub error() {
421 +    my($msg) = @_;
422 +    print STDERR $msg unless $quiet;
423   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines