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.3 by tdb, Mon May 20 16:11:23 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)
64 < my($maxrrdage) = 3600; # 1 hour
65 < my($maxgraphage) = 3600; # 1 hour
66 <    
62 > # if invalid argument given, $ret will not be 1
63 > &usage() if $ret != 1;
64 >
65 > # first process the arguments which might mean we exit now
66 >
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 78 | Line 119 | foreach my $machine (@rrddirlist) {
119           $ctime,$blksize,$blocks) = stat("$rrddir/$machine/$rrd");
120          # check if it's old enough to be deleted
121          if((time - $mtime) > $maxrrdage) {
122 < print "pruning rrd $rrddir/$machine/$rrd\n";
123 <            # if so, delete it
124 <            unlink("$rrddir/$machine/$rrd");
122 >            # do we delete the rrd, or just ignore it?
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 164 | Line 215 | print "pruning rrd $rrddir/$machine/$rrd\n";
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";
171 <            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 176 | Line 226 | print "pruning rrd $rrddir/$machine/$rrd\n";
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?
233 <    # Read the contents of the directory
234 <    opendir(DIR, "$rrddir/$machine");
235 <    my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
236 <    closedir DIR;
237 <    if($#dirlist == -1) {
238 < print "pruning rrddir $rrddir/$machine\n";
239 <        rmdir "$rrddir/$machine";
233 >    # (only if we're deleting stuff)
234 >    if($deleterrds) {
235 >        # Read the contents of the directory
236 >        opendir(DIR, "$rrddir/$machine");
237 >        my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
238 >        closedir DIR;
239 >        if($#dirlist == -1) {
240 >            rmdir "$rrddir/$machine";
241 >            &log("deleting empty rrd directory $rrddir/$machine\n");
242 >        }
243      }
244   }
245  
246 < # Read the contents of the graphs directory
247 < # and pull out the list of subdirectories (except . and .. :)
248 < opendir(DIR, $imgdir);
249 < my(@imgdirlist) = grep { -d "$imgdir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
250 < closedir DIR;
198 <
199 < # look through each directoty, as they might
200 < # contain images for a particular machine
201 < foreach my $machine (@imgdirlist) {
202 <    # Read the contents of the directory
203 <    opendir(DIR, "$imgdir/$machine");
204 <    my(@imglist) = grep { /\.png$/ && -f "$imgdir/$machine/$_" } readdir(DIR);
246 > if($deleteimgs) {
247 >    # Read the contents of the graphs directory
248 >    # and pull out the list of subdirectories (except . and .. :)
249 >    opendir(DIR, $imgdir);
250 >    my(@imgdirlist) = grep { -d "$imgdir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
251      closedir DIR;
252  
253 <    # See what rrd we have, and generate the graphs accordingly
254 <    foreach my $img (@imglist) {
255 <        chomp $img;
256 <        # stat the img
257 <        my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
258 <         $ctime,$blksize,$blocks) = stat("$imgdir/$machine/$img");
259 <        # check if it's old enough to be deleted
260 <        if((time - $mtime) > $maxgraphage) {
261 < print "pruning img $imgdir/$machine/$img\n";
262 <            # if so, delete it
263 <            unlink("$imgdir/$machine/$img");
253 >    # look through each directoty, as they might
254 >    # contain images for a particular machine
255 >    foreach my $machine (@imgdirlist) {
256 >        # Read the contents of the directory
257 >        opendir(DIR, "$imgdir/$machine");
258 >        my(@imglist) = grep { /\.png$/ && -f "$imgdir/$machine/$_" } readdir(DIR);
259 >        closedir DIR;
260 >
261 >        # See what rrd we have, and generate the graphs accordingly
262 >        foreach my $img (@imglist) {
263 >            chomp $img;
264 >            # stat the img
265 >            my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
266 >             $ctime,$blksize,$blocks) = stat("$imgdir/$machine/$img");
267 >            # check if it's old enough to be deleted
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?
275 +        # Read the contents of the directory
276 +        opendir(DIR, "$imgdir/$machine");
277 +        my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
278 +        closedir DIR;
279 +        if($#dirlist == -1) {
280 +            rmdir "$imgdir/$machine";
281 +            &log("deleted empty image directory $imgdir/$machine\n");
282 +        }
283      }
220    # have a last check, maybe we can remove the directory now?
221    # Read the contents of the directory
222    opendir(DIR, "$imgdir/$machine");
223    my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
224    closedir DIR;
225    if($#dirlist == -1) {
226 print "pruning img dir $imgdir/$machine\n";
227        rmdir "$imgdir/$machine";
228    }
284   }
285  
286 + exit(0);
287 +
288 +
289   #
290   # subroutine to make some graphs
291   #
# Line 237 | Line 295 | print "pruning img dir $imgdir/$machine\n";
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 253 | 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 312 | 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