1 |
#!/usr/bin/perl -w |
2 |
|
3 |
# |
4 |
# i-scream central monitoring system |
5 |
# http://www.i-scream.org.uk |
6 |
# Copyright (C) 2000-2002 i-scream |
7 |
# |
8 |
# This program is free software; you can redistribute it and/or |
9 |
# modify it under the terms of the GNU General Public License |
10 |
# as published by the Free Software Foundation; either version 2 |
11 |
# of the License, or (at your option) any later version. |
12 |
# |
13 |
# This program is distributed in the hope that it will be useful, |
14 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
15 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
16 |
# GNU General Public License for more details. |
17 |
# |
18 |
# You should have received a copy of the GNU General Public License |
19 |
# along with this program; if not, write to the Free Software |
20 |
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
21 |
# |
22 |
|
23 |
# ----------------------------------------------------------- |
24 |
# i-scream graph generation script |
25 |
# http://www.i-scream.org.uk |
26 |
# |
27 |
# Generates graphs from rrd databases for i-scream data. |
28 |
# |
29 |
# $Author: tdb $ |
30 |
# $Id: graph.pl,v 1.10 2002/10/13 15:14:00 tdb Exp $ |
31 |
#------------------------------------------------------------ |
32 |
|
33 |
## TODO |
34 |
# possibly make more configurable? |
35 |
# -- allow configurable periods of graphs |
36 |
# -- comments, types, etc |
37 |
|
38 |
my($version) = '$Id: graph.pl,v 1.10 2002/10/13 15:14:00 tdb Exp $'; |
39 |
|
40 |
$| = 1; |
41 |
|
42 |
use strict; |
43 |
use Getopt::Std; |
44 |
use RRDs; |
45 |
|
46 |
# define variables that will be read from the config |
47 |
# nb. keep this insync with the config file! |
48 |
use vars qw{ |
49 |
$imgdir $rrddir |
50 |
$maxrrdage $maximgage $deleterrds $deleteimgs |
51 |
$hex_slash $hex_underscore |
52 |
$rrdstep $retry_wait |
53 |
$verbose $quiet |
54 |
}; |
55 |
|
56 |
# default locate of the config file |
57 |
my($configfile) = "rrdgraphing.conf"; |
58 |
|
59 |
# check for command line arguments |
60 |
my(%opts); |
61 |
my($ret) = getopts('hvqVc:', \%opts); |
62 |
|
63 |
# if invalid argument given, $ret will not be 1 |
64 |
&usage() if $ret != 1; |
65 |
|
66 |
# first process the arguments which might mean we exit now |
67 |
|
68 |
# -h is usage |
69 |
if($opts{h}) { |
70 |
&usage(); |
71 |
} |
72 |
# -V is version |
73 |
if($opts{V}) { |
74 |
print "graph.pl version: $version\n"; |
75 |
exit(1); |
76 |
} |
77 |
|
78 |
# Then try getting the config |
79 |
|
80 |
# -c specifies the config file location |
81 |
if($opts{c}) { |
82 |
$configfile = $opts{c}; |
83 |
} |
84 |
# suck in the config |
85 |
&log("reading config from $configfile\n"); |
86 |
do $configfile; |
87 |
|
88 |
# Then any options we might want to override the config with |
89 |
|
90 |
# -v is verbose |
91 |
if($opts{v}) { |
92 |
$verbose = $opts{v}; |
93 |
} |
94 |
# -q is verbose |
95 |
if($opts{q}) { |
96 |
$quiet = $opts{q}; |
97 |
# if we're meant to be quiet, we can hardly be verbose! |
98 |
$verbose = 0; |
99 |
} |
100 |
|
101 |
# Read the contents of the base directory |
102 |
# and pull out the list of subdirectories (except . and .. :) |
103 |
opendir(DIR, $rrddir); |
104 |
my(@rrddirlist) = grep { -d "$rrddir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR); |
105 |
closedir DIR; |
106 |
|
107 |
# look through each directoty, as they might |
108 |
# contain rrds for a particular machine |
109 |
foreach my $machine (@rrddirlist) { |
110 |
# Read the contents of the directory |
111 |
opendir(DIR, "$rrddir/$machine"); |
112 |
my(@rrdlist) = grep { /\.rrd$/ && -f "$rrddir/$machine/$_" } readdir(DIR); |
113 |
closedir DIR; |
114 |
|
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: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", "% cpu time", \@data, \@rawdata); |
145 |
} |
146 |
if($rrd =~ /^(mem)\.rrd$/) { |
147 |
my(@data); |
148 |
my(@rawdata); |
149 |
# we don't actually want to display free or total memory, |
150 |
# although we need it to work out peruse... |
151 |
push @data, "NONE:$1:free:free#CCCCFF:NONE:free memory"; |
152 |
push @data, "NONE:$1:total:total#0000FF:NONE:total memory\\n"; |
153 |
# calculate peruse - note that we only use 'free' if it's less than total |
154 |
# (this is to avoid negative percentages :) |
155 |
push @rawdata, "CDEF:peruse=total,free,total,LT,free,0,IF,-,total,/,100,*"; |
156 |
# and add it to the graph |
157 |
push @rawdata, "AREA:peruse#CCCCFF:% memory in use"; |
158 |
push @rawdata, "--upper-limit=100"; |
159 |
# add some nice values to the legend |
160 |
&addlegend(\@rawdata, "peruse"); |
161 |
# put the total memory on the graph so we can map percentages to real values |
162 |
push @rawdata, "GPRINT:total:LAST:Current total memory\\: \%.2lf %sMb\\c"; |
163 |
&makegraph($machine, $1, "Memory Usage for $machine", "% memory in use", \@data, \@rawdata); |
164 |
} |
165 |
if($rrd =~ /^(load)\.rrd$/) { |
166 |
my(@data); |
167 |
push @data, "LINE2:$1:load1:load1#CCCCFF:OK: 1 min load average"; |
168 |
push @data, "LINE2:$1:load5:load5#7777FF:OK: 5 min load average"; |
169 |
push @data, "LINE2:$1:load15:load15#0000FF:OK:15 min load average"; |
170 |
&makegraph($machine, $1, "Loads for $machine", "load average", \@data); |
171 |
} |
172 |
if($rrd =~ /^(proc)\.rrd$/) { |
173 |
my(@data); |
174 |
push @data, "LINE2:$1:cpu:cpu#00FF00:OK:cpu processes "; |
175 |
push @data, "LINE2:$1:sleeping:sleeping#0000FF:OK:sleeping processes"; |
176 |
push @data, "LINE2:$1:stopped:stopped#00FFFF:OK:stopped processes "; |
177 |
push @data, "LINE2:$1:total:total#FF00FF:OK:total processes "; |
178 |
push @data, "LINE2:$1:zombie:zombie#FF0000:OK:zombie processes "; |
179 |
&makegraph($machine, $1, "Processes on $machine", "no. of processes", \@data); |
180 |
} |
181 |
if($rrd =~ /^(swap)\.rrd$/) { |
182 |
my(@data); |
183 |
my(@rawdata); |
184 |
# we don't actually want to display free or total swap, |
185 |
# although we need it to work out peruse... |
186 |
push @data, "NONE:$1:free:free#CCCCFF:NONE:free swap"; |
187 |
push @data, "NONE:$1:total:total#0000FF:NONE:total swap\\n"; |
188 |
# calculate peruse - note that we only use 'free' if it's less than total |
189 |
# (this is to avoid negative percentages :) |
190 |
push @rawdata, "CDEF:peruse=total,free,total,LT,free,0,IF,-,total,/,100,*"; |
191 |
# and add it to the graph |
192 |
push @rawdata, "AREA:peruse#CCCCFF:% swap in use"; |
193 |
push @rawdata, "--upper-limit=100"; |
194 |
# add some nice values to the legend |
195 |
&addlegend(\@rawdata, "peruse"); |
196 |
# put the total swap on the graph so we can map percentages to real values |
197 |
push @rawdata, "GPRINT:total:LAST:Current total swap\\: \%.2lf %sMb\\c"; |
198 |
&makegraph($machine, $1, "Swap Usage for $machine", "% swap in use", \@data, \@rawdata); |
199 |
} |
200 |
if($rrd =~ /^(users)\.rrd$/) { |
201 |
my(@data); |
202 |
push @data, "AREA:$1:count:count#CCCCFF:OK:user count"; |
203 |
&makegraph($machine, $1, "User Count for $machine", "no. of users", \@data); |
204 |
} |
205 |
if($rrd =~ /^(paging)\.rrd$/) { |
206 |
my(@data); |
207 |
push @data, "LINE2:$1:swapins:swapins#00FF00:OK:swap pages in "; |
208 |
push @data, "LINE2:$1:swapouts:swapouts#0000FF:OK:swap pages out"; |
209 |
&makegraph($machine, $1, "Paging on $machine", "pages per second", \@data); |
210 |
} |
211 |
if($rrd =~ /^(disk)-(\S+).rrd$/) { |
212 |
my(@data); |
213 |
my(@rawdata); |
214 |
# we need this lot for our calculations, but we'll never show them |
215 |
push @data, "NONE:$1-$2:kbytes:kbytes#0000FF:NONE:total size\\n"; |
216 |
push @data, "NONE:$1-$2:used:used#CCCCFF:NONE:used space"; |
217 |
push @data, "NONE:$1-$2:totalinodes:totalinodes#000000:NONE:total inodes"; |
218 |
push @data, "NONE:$1-$2:freeinodes:freeinodes#000000:NONE:free inodes"; |
219 |
# calculate peruse, add it to the graph, and add a legend |
220 |
push @rawdata, "CDEF:peruse=used,kbytes,/,100,*"; |
221 |
push @rawdata, "AREA:peruse#CCCCFF:% disk used "; |
222 |
&addlegend(\@rawdata, "peruse"); |
223 |
# put the total space on the graph so we can map percentages to real values |
224 |
push @rawdata, "GPRINT:kbytes:LAST:Current total space\\: \%.2lf %sKb\\c"; |
225 |
# calculate perinodeuse, add it to the graph, and add a legend |
226 |
push @rawdata, "CDEF:perinodeuse=totalinodes,freeinodes,totalinodes,LT,freeinodes,0,IF,-,totalinodes,/,100,*"; |
227 |
push @rawdata, "LINE2:perinodeuse#FF4444:% inodes used"; |
228 |
push @rawdata, "--upper-limit=100"; |
229 |
&addlegend(\@rawdata, "perinodeuse"); |
230 |
# put the total inodes on the graph so we can map percentages to real values |
231 |
push @rawdata, "GPRINT:totalinodes:LAST:Current total inodes\\: \%.2lf %s\\c"; |
232 |
# some name tidting |
233 |
my($type) = $1; |
234 |
my($name) = $2; |
235 |
my($nicename) = $2; |
236 |
$nicename =~ s/$hex_slash/\//g; |
237 |
$nicename =~ s/$hex_underscore/_/g; |
238 |
&makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", "% usage", \@data, \@rawdata); |
239 |
} |
240 |
# probably a queue with a name like this :) |
241 |
if($rrd =~ /^(\d+)_0\.rrd$/) { |
242 |
my(@data); |
243 |
my(@rawdata); |
244 |
my($baserrd) = $1; |
245 |
my($i) = 0; |
246 |
while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) { |
247 |
push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":OK:queue$i size "; |
248 |
++$i; |
249 |
} |
250 |
push @data, "LINE2:$baserrd\_0:total:total#FF0000:OK:packets/sec "; |
251 |
my($comment); |
252 |
if(-f "$rrddir/$machine/$baserrd.def") { |
253 |
open(DEF, "$rrddir/$machine/$baserrd.def"); |
254 |
$comment = <DEF>; |
255 |
chomp $comment if defined $comment; |
256 |
} |
257 |
$comment = "unknown queue" if not defined $comment; |
258 |
&makegraph($machine, $baserrd, $comment, "", \@data, \@rawdata); |
259 |
} |
260 |
} |
261 |
# have a last check, maybe we can remove the directory now? |
262 |
# (only if we're deleting stuff) |
263 |
if($deleterrds) { |
264 |
# Read the contents of the directory |
265 |
opendir(DIR, "$rrddir/$machine"); |
266 |
my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR); |
267 |
closedir DIR; |
268 |
if($#dirlist == -1) { |
269 |
rmdir "$rrddir/$machine"; |
270 |
&log("deleting empty rrd directory $rrddir/$machine\n"); |
271 |
} |
272 |
} |
273 |
} |
274 |
|
275 |
if($deleteimgs) { |
276 |
# Read the contents of the graphs directory |
277 |
# and pull out the list of subdirectories (except . and .. :) |
278 |
opendir(DIR, $imgdir); |
279 |
my(@imgdirlist) = grep { -d "$imgdir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR); |
280 |
closedir DIR; |
281 |
|
282 |
# look through each directoty, as they might |
283 |
# contain images for a particular machine |
284 |
foreach my $machine (@imgdirlist) { |
285 |
# Read the contents of the directory |
286 |
opendir(DIR, "$imgdir/$machine"); |
287 |
my(@imglist) = grep { /\.png$/ && -f "$imgdir/$machine/$_" } readdir(DIR); |
288 |
closedir DIR; |
289 |
|
290 |
# See what rrd we have, and generate the graphs accordingly |
291 |
foreach my $img (@imglist) { |
292 |
chomp $img; |
293 |
# stat the img |
294 |
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, |
295 |
$ctime,$blksize,$blocks) = stat("$imgdir/$machine/$img"); |
296 |
# check if it's old enough to be deleted |
297 |
if((time - $mtime) > $maximgage) { |
298 |
# if so, delete it |
299 |
unlink("$imgdir/$machine/$img"); |
300 |
&log("deleted old image $imgdir/$machine/$img\n"); |
301 |
} |
302 |
} |
303 |
# have a last check, maybe we can remove the directory now? |
304 |
# Read the contents of the directory |
305 |
opendir(DIR, "$imgdir/$machine"); |
306 |
my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR); |
307 |
closedir DIR; |
308 |
if($#dirlist == -1) { |
309 |
rmdir "$imgdir/$machine"; |
310 |
&log("deleted empty image directory $imgdir/$machine\n"); |
311 |
} |
312 |
} |
313 |
} |
314 |
|
315 |
exit(0); |
316 |
|
317 |
|
318 |
# |
319 |
# subroutine to make some graphs |
320 |
# |
321 |
# $machine = name of the machine |
322 |
# (eg. kernow.ukc.ac.uk) |
323 |
# $type = the type of graph for the machine |
324 |
# (eg. cpu) |
325 |
# $title = the title for the graph |
326 |
# (eg. kernow CPU usage) |
327 |
# $vlabel = the vertical label to apply to the left side of the graph |
328 |
# (eg. kb/s) |
329 |
# $dataref = a reference to an array containing information for the graph |
330 |
# elements of format: "gtype:rrdname:dsname:name#colour:legend:comment with spaces" |
331 |
# (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted) |
332 |
# (if legend is "NONE" the latest/average/max/min legend won't be printed) |
333 |
# $rawcmdref = a reference to an array containing raw rrd commands |
334 |
# elements a single command each, no spaces |
335 |
# |
336 |
|
337 |
sub makegraph() { |
338 |
my($machine, $type, $title, $vlabel, $dataref, $rawcmdref) = @_; |
339 |
# pass in these arrays by reference |
340 |
my(@data) = @$dataref if defined $dataref; |
341 |
my(@rawcmd) = @$rawcmdref if defined $rawcmdref; |
342 |
# check if directory exists for images |
343 |
if(! -d "$imgdir/$machine") { |
344 |
# not sure on this umask, but it seems to work? |
345 |
mkdir "$imgdir/$machine", 0777; |
346 |
&log("created directory $imgdir/$machine\n"); |
347 |
} |
348 |
my(@rrdcmd); |
349 |
foreach my $dataitem (@data) { |
350 |
# dataitem should be: "gtype:rrdname:dsname:name#colour:legend:comment with spaces" |
351 |
# (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted) |
352 |
# (if legend is "NONE" the latest/average/max/min legend won't be printed) |
353 |
if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(\S+):(.*)$/) { |
354 |
push @rrdcmd, "DEF:$4=$rrddir/$machine/$2.rrd:$3:AVERAGE"; |
355 |
if($1 ne "NONE") { |
356 |
push @rrdcmd, "$1:$4#$5:$7"; |
357 |
if($6 ne "NONE") { |
358 |
# add some nice values to the legend |
359 |
&addlegend(\@rrdcmd, $4); |
360 |
} |
361 |
} |
362 |
} |
363 |
} |
364 |
push @rrdcmd, "--title=$title"; |
365 |
push @rrdcmd, "--imgformat=PNG"; |
366 |
push @rrdcmd, "--lower-limit=0"; |
367 |
push @rrdcmd, "--vertical-label=$vlabel"; |
368 |
# not entirely convinced this is good... |
369 |
push @rrdcmd, "--alt-autoscale-max"; |
370 |
# add any further raw commands |
371 |
push @rrdcmd, @rawcmd; |
372 |
RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd); |
373 |
my($err_3h) = RRDs::error; |
374 |
&log("created $imgdir/$machine/$type-3h.png\n") unless $err_3h; |
375 |
&error("Error generating 3h graph for $machine/$type: $err_3h\n") if $err_3h; |
376 |
RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd); |
377 |
my($err_1d) = RRDs::error; |
378 |
&log("created $imgdir/$machine/$type-1d.png\n") unless $err_1d; |
379 |
&error("Error generating 1d graph for $machine/$type: $err_1d\n") if $err_1d; |
380 |
RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd); |
381 |
my($err_1w) = RRDs::error; |
382 |
&log("created $imgdir/$machine/$type-1w.png\n") unless $err_1w; |
383 |
&error("Error generating 1w graph for $machine/$type: $err_1w\n") if $err_1w; |
384 |
RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd); |
385 |
my($err_1m) = RRDs::error; |
386 |
&log("created $imgdir/$machine/$type-1m.png\n") unless $err_1m; |
387 |
&error("Error generating 1m graph for $machine/$type: $err_1m\n") if $err_1m; |
388 |
RRDs::graph ("$imgdir/$machine/$type-1y.png", "--start=-31536000", @rrdcmd); |
389 |
my($err_1y) = RRDs::error; |
390 |
&log("created $imgdir/$machine/$type-1y.png\n") unless $err_1y; |
391 |
&error("Error generating 1y graph for $machine/$type: $err_1y\n") if $err_1y; |
392 |
return; |
393 |
} |
394 |
|
395 |
# subroutine to add a legend |
396 |
# accepts reference to an array and a name |
397 |
sub addlegend() { |
398 |
my($dataref, $name) = @_; |
399 |
push @$dataref, "GPRINT:$name:LAST:Current\\: \%8.2lf %s"; |
400 |
push @$dataref, "GPRINT:$name:AVERAGE:Average\\: \%8.2lf %s"; |
401 |
push @$dataref, "GPRINT:$name:MAX:Max\\: \%8.2lf %s\\n"; |
402 |
#push @$dataref, "GPRINT:$name:MIN:Min\\: \%8.2lf %s\\n"; |
403 |
} |
404 |
|
405 |
# hacky subroutine to return a colour |
406 |
# could be done much better somehow :/ |
407 |
sub get_colour { |
408 |
my($col) = @_; |
409 |
if($col == 0) { |
410 |
return "#0000FF"; |
411 |
} |
412 |
elsif($col == 1) { |
413 |
return "#00FF00"; |
414 |
} |
415 |
elsif($col == 2) { |
416 |
return "#FF00FF"; |
417 |
} |
418 |
elsif($col == 3) { |
419 |
return "#FFFF00"; |
420 |
} |
421 |
elsif($col == 4) { |
422 |
return "#00FFFF"; |
423 |
} |
424 |
else { |
425 |
return "#000066"; |
426 |
} |
427 |
} |
428 |
|
429 |
# prints out usage information then exits |
430 |
sub usage() { |
431 |
print "Usage: graph.pl [options]\n"; |
432 |
print "Options\n"; |
433 |
print " -c config Specifies the configuration file\n"; |
434 |
print " default: rrdgraphing.conf\n"; |
435 |
print " -v Be verbose about what's happening\n"; |
436 |
print " -q Be quiet, even supress errors\n"; |
437 |
print " -V Print version number\n"; |
438 |
print " -h Prints this help page\n"; |
439 |
exit(1); |
440 |
} |
441 |
|
442 |
# prints a log message if verbose is turned on |
443 |
sub log() { |
444 |
my($msg) = @_; |
445 |
print $msg if $verbose; |
446 |
} |
447 |
|
448 |
# prints an error message unless quiet is turned on |
449 |
sub error() { |
450 |
my($msg) = @_; |
451 |
print STDERR $msg unless $quiet; |
452 |
} |