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.2 by tdb, Sat May 18 18:15:59 2002 UTC vs.
Revision 1.7 by tdb, Thu Jun 20 13:46:54 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
61 < my($hex_underscore) = "_5f";
62 <        
58 > # check for command line arguments
59 > my(%opts);
60 > my($ret) = getopts('hvqVc:', \%opts);
61 >
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 >
101   # Read the contents of the base directory
102   # and pull out the list of subdirectories (except . and .. :)
103   opendir(DIR, $rrddir);
# Line 68 | Line 115 | foreach my $machine (@rrddirlist) {
115      # See what rrd we have, and generate the graphs accordingly
116      foreach my $rrd (@rrdlist) {
117          chomp $rrd;
118 +        # stat the file
119 +        my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
120 +         $ctime,$blksize,$blocks) = stat("$rrddir/$machine/$rrd");
121 +        # check if it's old enough to be deleted
122 +        if((time - $mtime) > $maxrrdage) {
123 +            # do we delete the rrd, or just ignore it?
124 +            if($deleterrds) {
125 +                # if so, delete it
126 +                unlink("$rrddir/$machine/$rrd");
127 +                &log("deleted old rrd $rrddir/$machine/$rrd\n");
128 +            }
129 +            else {
130 +                &log("ignored old rrd $rrddir/$machine/$rrd\n");
131 +            }
132 +            # no more processing required for this rrd
133 +            next;
134 +        }
135          if($rrd =~ /^(cpu)\.rrd$/) {
136              my(@data);
137              my(@rawdata);
138 <            push @data, "LINE2:$1:idle:idle#00FF00:idle cpu";
139 <            push @data, "LINE2:$1:user:user#0000FF:user cpu";
140 <            push @data, "LINE2:$1:kernel:kernel#00FFFF:kernel cpu";
141 <            push @data, "LINE2:$1:swap:swap#FF00FF:swap cpu";
142 <            push @data, "LINE2:$1:iowait:iowait#FF0000:iowait cpu";
138 >            push @data, "LINE2:$1:idle:idle#00FF00:OK:idle cpu";
139 >            push @data, "LINE2:$1:user:user#0000FF:OK:user cpu";
140 >            push @data, "LINE2:$1:kernel:kernel#00FFFF:OK:kernel cpu";
141 >            push @data, "LINE2:$1:swap:swap#FF00FF:OK:swap cpu";
142 >            push @data, "LINE2:$1:iowait:iowait#FF0000:OK:iowait cpu";
143              push @rawdata, "--upper-limit=100";
144              &makegraph($machine, $1, "CPU Usage for $machine", \@data, \@rawdata);
145          }
# Line 84 | Line 148 | foreach my $machine (@rrddirlist) {
148              my(@rawdata);
149              # we don't actually want to display free memory,
150              # although we need it to do inuse...
151 <            push @data, "NONE:$1:free:free#CCCCFF:free memory";
152 <            push @data, "LINE2:$1:total:total#0000FF:total memory";
151 >            push @data, "NONE:$1:free:free#CCCCFF:NONE:free memory";
152 >            push @data, "LINE2:$1:total:total#0000FF:NONE:total memory";
153              # calculate inuse
154              push @rawdata, "CDEF:inuse=total,free,-";
155              # and add it to the graph
156 <            push @rawdata, "AREA:inuse#CCCCFF:memory in use";
156 >            push @rawdata, "AREA:inuse#CCCCFF:memory in use\\l";
157              push @rawdata, "--base=1024";
158 +            # add some nice values to the legend
159 +            &addlegend(\@rawdata, "inuse");
160              &makegraph($machine, $1, "Memory Usage for $machine", \@data, \@rawdata);
161          }
162          if($rrd =~ /^(load)\.rrd$/) {
163              my(@data);
164 <            push @data, "LINE2:$1:load1:load1#CCCCFF:1 minute load average";
165 <            push @data, "LINE2:$1:load5:load5#7777FF:5 minute load average";
166 <            push @data, "LINE2:$1:load15:load15#0000FF:15 minute load average";
164 >            push @data, "LINE2:$1:load1:load1#CCCCFF:OK:1 minute load average";
165 >            push @data, "LINE2:$1:load5:load5#7777FF:OK:5 minute load average";
166 >            push @data, "LINE2:$1:load15:load15#0000FF:OK:15 minute load average";
167              &makegraph($machine, $1, "Loads for $machine", \@data);
168          }
169          if($rrd =~ /^(proc)\.rrd$/) {
170              my(@data);
171 <            push @data, "LINE2:$1:cpu:cpu#00FF00:cpu processes";
172 <            push @data, "LINE2:$1:sleeping:sleeping#0000FF:sleeping processes";
173 <            push @data, "LINE2:$1:stopped:stopped#00FFFF:stopped processes";
174 <            push @data, "LINE2:$1:total:total#FF00FF:total processes";
175 <            push @data, "LINE2:$1:zombie:zombie#FF0000:zombie processes";
171 >            push @data, "LINE2:$1:cpu:cpu#00FF00:OK:cpu processes";
172 >            push @data, "LINE2:$1:sleeping:sleeping#0000FF:OK:sleeping processes";
173 >            push @data, "LINE2:$1:stopped:stopped#00FFFF:OK:stopped processes";
174 >            push @data, "LINE2:$1:total:total#FF00FF:OK:total processes";
175 >            push @data, "LINE2:$1:zombie:zombie#FF0000:OK:zombie processes";
176              &makegraph($machine, $1, "Processes on $machine", \@data);
177          }
178          if($rrd =~ /^(swap)\.rrd$/) {
# Line 114 | Line 180 | foreach my $machine (@rrddirlist) {
180              my(@rawdata);
181              # we don't actually want to display free swap,
182              # although we need it to do inuse...
183 <            push @data, "NONE:$1:free:free#CCCCFF:free swap";
184 <            push @data, "LINE2:$1:total:total#0000FF:total swap";
183 >            push @data, "NONE:$1:free:free#CCCCFF:NONE:free swap";
184 >            push @data, "LINE2:$1:total:total#0000FF:NONE:total swap";
185              # calculate inuse
186              push @rawdata, "CDEF:inuse=total,free,-";
187              # and add it to the graph
188 <            push @rawdata, "AREA:inuse#CCCCFF:swap in use";
188 >            push @rawdata, "AREA:inuse#CCCCFF:swap in use\\l";
189              push @rawdata, "--base=1024";
190 +            # add some nice values to the legend
191 +            &addlegend(\@rawdata, "inuse");
192              &makegraph($machine, $1, "Swap Usage for $machine", \@data, \@rawdata);
193          }
194          if($rrd =~ /^(users)\.rrd$/) {
195              my(@data);
196 <            push @data, "AREA:$1:count:count#CCCCFF:user count";
196 >            push @data, "AREA:$1:count:count#CCCCFF:OK:user count";
197              &makegraph($machine, $1, "User Count for $machine", \@data);
198          }
199          if($rrd =~ /^(disk)-(\S+).rrd$/) {
200              my(@data);
201              my(@rawdata);
202 <            push @data, "LINE2:$1-$2:kbytes:kbytes#0000FF:total size";
203 <            push @data, "AREA:$1-$2:used:used#CCCCFF:used";
202 >            push @data, "LINE2:$1-$2:kbytes:kbytes#0000FF:NONE:total size";
203 >            push @data, "AREA:$1-$2:used:used#CCCCFF:OK:used";
204              push @rawdata, "--base=1024";
205              my($type) = $1;
206              my($name) = $2;
# Line 148 | Line 216 | foreach my $machine (@rrddirlist) {
216              my($baserrd) = $1;
217              my($i) = 0;
218              while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) {
219 <                push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":queue$i size ";
219 >                push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":OK:queue$i size ";
220                  ++$i;
221              }
222 <            push @data, "LINE2:$baserrd\_0:total:total#FF0000:packets/sec - currently";
155 <            push @rawdata, "GPRINT:total:LAST:%lf %spackets/sec";
222 >            push @data, "LINE2:$baserrd\_0:total:total#FF0000:OK:packets/sec";
223              my($comment);
224              if(-f "$rrddir/$machine/$baserrd.def") {
225                  open(DEF, "$rrddir/$machine/$baserrd.def");
# Line 163 | Line 230 | foreach my $machine (@rrddirlist) {
230              &makegraph($machine, $baserrd, $comment, \@data, \@rawdata);
231          }
232      }
233 +    # have a last check, maybe we can remove the directory now?
234 +    # (only if we're deleting stuff)
235 +    if($deleterrds) {
236 +        # Read the contents of the directory
237 +        opendir(DIR, "$rrddir/$machine");
238 +        my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
239 +        closedir DIR;
240 +        if($#dirlist == -1) {
241 +            rmdir "$rrddir/$machine";
242 +            &log("deleting empty rrd directory $rrddir/$machine\n");
243 +        }
244 +    }
245   }
246  
247 + if($deleteimgs) {
248 +    # Read the contents of the graphs directory
249 +    # and pull out the list of subdirectories (except . and .. :)
250 +    opendir(DIR, $imgdir);
251 +    my(@imgdirlist) = grep { -d "$imgdir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
252 +    closedir DIR;
253 +
254 +    # look through each directoty, as they might
255 +    # contain images for a particular machine
256 +    foreach my $machine (@imgdirlist) {
257 +        # Read the contents of the directory
258 +        opendir(DIR, "$imgdir/$machine");
259 +        my(@imglist) = grep { /\.png$/ && -f "$imgdir/$machine/$_" } readdir(DIR);
260 +        closedir DIR;
261 +
262 +        # See what rrd we have, and generate the graphs accordingly
263 +        foreach my $img (@imglist) {
264 +            chomp $img;
265 +            # stat the img
266 +            my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
267 +             $ctime,$blksize,$blocks) = stat("$imgdir/$machine/$img");
268 +            # check if it's old enough to be deleted
269 +            if((time - $mtime) > $maximgage) {
270 +                # if so, delete it
271 +                unlink("$imgdir/$machine/$img");
272 +                &log("deleted old image $imgdir/$machine/$img\n");
273 +            }
274 +        }
275 +        # have a last check, maybe we can remove the directory now?
276 +        # Read the contents of the directory
277 +        opendir(DIR, "$imgdir/$machine");
278 +        my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
279 +        closedir DIR;
280 +        if($#dirlist == -1) {
281 +            rmdir "$imgdir/$machine";
282 +            &log("deleted empty image directory $imgdir/$machine\n");
283 +        }
284 +    }
285 + }
286 +
287 + exit(0);
288 +
289 +
290   #
291   # subroutine to make some graphs
292   #
# Line 175 | Line 297 | foreach my $machine (@rrddirlist) {
297   # $title     = the title for the graph
298   #              (eg. kernow CPU usage)
299   # $dataref   = a reference to an array containing information for the graph
300 < #              elements of format: "gtype:rrdname:dsname:name#colour:comment with spaces"
300 > #              elements of format: "gtype:rrdname:dsname:name#colour:legend:comment with spaces"
301   #              (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted)
302 + #              (if legend is "NONE" the latest/average/max/min legend won't be printed)
303   # $rawcmdref = a reference to an array containing raw rrd commands
304   #              elements a single command each, no spaces
305   #
# Line 190 | Line 313 | sub makegraph() {
313      if(! -d "$imgdir/$machine") {
314          # not sure on this umask, but it seems to work?
315          mkdir "$imgdir/$machine", 0777;
316 +        &log("created directory $imgdir/$machine\n");
317      }
318      my(@rrdcmd);
319      foreach my $dataitem (@data) {
320 <        # dataitem should be: "gtype:rrdname:dsname:name#colour:comment with spaces"
320 >        # dataitem should be: "gtype:rrdname:dsname:name#colour:legend:comment with spaces"
321          # (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted)
322 <        if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(.*)$/) {
322 >        # (if legend is "NONE" the latest/average/max/min legend won't be printed)
323 >        if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(\S+):(.*)$/) {
324              push @rrdcmd, "DEF:$4=$rrddir/$machine/$2.rrd:$3:AVERAGE";
325              if($1 ne "NONE") {
326 <                push @rrdcmd, "$1:$4#$5:$6";
326 >                push @rrdcmd, "$1:$4#$5:$7\\s";
327 >                if($6 ne "NONE") {
328 >                    # add some nice values to the legend
329 >                    &addlegend(\@rrdcmd, $4);
330 >                }
331              }
332          }
333      }
# Line 211 | Line 340 | sub makegraph() {
340      push @rrdcmd, @rawcmd;
341      RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
342      my($err_3h) = RRDs::error;
343 <    print STDERR "Error generating 3h graph for $machine/$type: $err_3h\n" if $err_3h;
343 >    &log("created $imgdir/$machine/$type-3h.png\n") unless $err_3h;
344 >    &error("Error generating 3h graph for $machine/$type: $err_3h\n") if $err_3h;
345      RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
346      my($err_1d) = RRDs::error;
347 <    print STDERR "Error generating 1d graph for $machine/$type: $err_1d\n" if $err_1d;
347 >    &log("created $imgdir/$machine/$type-1d.png\n") unless $err_1d;
348 >    &error("Error generating 1d graph for $machine/$type: $err_1d\n") if $err_1d;
349      RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
350      my($err_1w) = RRDs::error;
351 <    print STDERR "Error generating 1w graph for $machine/$type: $err_1w\n" if $err_1w;
351 >    &log("created $imgdir/$machine/$type-1w.png\n") unless $err_1w;
352 >    &error("Error generating 1w graph for $machine/$type: $err_1w\n") if $err_1w;
353      RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
354      my($err_1m) = RRDs::error;
355 <    print STDERR "Error generating 1m graph for $machine/$type: $err_1m\n" if $err_1m;
355 >    &log("created $imgdir/$machine/$type-1m.png\n") unless $err_1m;
356 >    &error("Error generating 1m graph for $machine/$type: $err_1m\n") if $err_1m;
357      RRDs::graph ("$imgdir/$machine/$type-1y.png", "--start=-31536000", @rrdcmd);
358      my($err_1y) = RRDs::error;
359 <    print STDERR "Error generating 1y graph for $machine/$type: $err_1y\n" if $err_1y;
359 >    &log("created $imgdir/$machine/$type-1y.png\n") unless $err_1y;
360 >    &error("Error generating 1y graph for $machine/$type: $err_1y\n") if $err_1y;
361      return;
362   }
363  
364 + # subroutine to add a legend
365 + # accepts reference to an array and a name
366 + sub addlegend() {
367 +    my($dataref, $name) = @_;
368 +    push @$dataref, "GPRINT:$name:LAST:latest=\%lf\\r";
369 +    push @$dataref, "GPRINT:$name:AVERAGE:average=\%lf";
370 +    push @$dataref, "GPRINT:$name:MAX:max=\%lf";
371 +    push @$dataref, "GPRINT:$name:MIN:min=\%lf\\r";
372 + }
373 +
374   # hacky subroutine to return a colour
375   # could be done much better somehow :/
376   sub get_colour {
# Line 249 | Line 393 | sub get_colour {
393      else {
394          return "#000066";
395      }
396 + }
397 +
398 + # prints out usage information then exits
399 + sub usage() {
400 +    print "Usage: graph.pl [options]\n";
401 +    print "Options\n";
402 +    print "  -c config        Specifies the configuration file\n";
403 +    print "                    default: rrdgraphing.conf\n";
404 +    print "  -v               Be verbose about what's happening\n";
405 +    print "  -q               Be quiet, even supress errors\n";
406 +    print "  -V               Print version number\n";
407 +    print "  -h               Prints this help page\n";
408 +    exit(1);
409 + }      
410 +
411 + # prints a log message if verbose is turned on
412 + sub log() {
413 +    my($msg) = @_;
414 +    print $msg if $verbose;
415 + }
416 +
417 + # prints an error message unless quiet is turned on
418 + sub error() {
419 +    my($msg) = @_;
420 +    print STDERR $msg unless $quiet;
421   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines