| 1 | tdb | 1.1 | #!/usr/bin/perl -w | 
 
 
 
 
 | 2 |  |  |  | 
 
 
 
 
 | 3 |  |  | # ----------------------------------------------------------- | 
 
 
 
 
 | 4 |  |  | # i-scream graph generation script | 
 
 
 
 
 | 5 |  |  | # http://www.i-scream.org.uk | 
 
 
 
 
 | 6 |  |  | # | 
 
 
 
 
 | 7 |  |  | # Generates graphs from rrd databases for i-scream data. | 
 
 
 
 
 | 8 |  |  | # | 
 
 
 
 
 
 
 
 | 9 | tdb | 1.4 | # $Author: tdb $ | 
 
 
 
 
 | 10 |  |  | # $Id: graph.pl,v 1.3 2002/03/10 03:19:57 tdb Exp $ | 
 
 
 
 
 
 
 
 | 11 | tdb | 1.1 | #------------------------------------------------------------ | 
 
 
 
 
 | 12 |  |  |  | 
 
 
 
 
 | 13 |  |  | ## TODO | 
 
 
 
 
 
 
 
 | 14 | tdb | 1.4 | # allow specification of lower/upper graph bounds | 
 
 
 
 
 | 15 |  |  | #  -- then replace mem/swap/disk "total" line ;) | 
 
 
 
 
 
 
 
 | 16 | tdb | 1.5 | # fix mem/swap issues | 
 
 
 
 
 | 17 |  |  | #  -- should be graphing "in use", not "free" | 
 
 
 
 
 
 
 
 | 18 | tdb | 1.1 | # possibly make more configurable? | 
 
 
 
 
 | 19 |  |  | #  -- allow configurable periods of graphs | 
 
 
 
 
 | 20 |  |  | #  -- comments, types, etc | 
 
 
 
 
 | 21 |  |  | #  -- move all to external config file | 
 
 
 
 
 | 22 |  |  |  | 
 
 
 
 
 | 23 |  |  | $| = 1; | 
 
 
 
 
 | 24 |  |  | use strict; | 
 
 
 
 
 | 25 |  |  | use RRDs; | 
 
 
 
 
 | 26 |  |  |  | 
 
 
 
 
 | 27 |  |  | # Base directory for images | 
 
 
 
 
 | 28 |  |  | # (a directory will be constructed for each host under this) | 
 
 
 
 
 | 29 |  |  | my($imgdir) = "/home/tdb/public_html/rrd"; | 
 
 
 
 
 | 30 |  |  |  | 
 
 
 
 
 | 31 |  |  | # Location of RRD databases | 
 
 
 
 
 | 32 |  |  | my($rrddir) = "/u1/i-scream/rrd"; | 
 
 
 
 
 | 33 |  |  |  | 
 
 
 
 
 | 34 |  |  | # / converted to a decimal then hex'd | 
 
 
 
 
 | 35 |  |  | my($hex_slash) = "_2f"; | 
 
 
 
 
 | 36 |  |  | # _ converted to a decimal then hex'd | 
 
 
 
 
 | 37 |  |  | my($hex_underscore) = "_5f"; | 
 
 
 
 
 | 38 |  |  |  | 
 
 
 
 
 | 39 |  |  | # Read the contents of the base directory | 
 
 
 
 
 | 40 |  |  | # and pull out the list of subdirectories (except . and .. :) | 
 
 
 
 
 | 41 |  |  | opendir(DIR, $rrddir); | 
 
 
 
 
 | 42 |  |  | my(@rrddirlist) = grep { -d "$rrddir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR); | 
 
 
 
 
 | 43 |  |  | closedir DIR; | 
 
 
 
 
 | 44 |  |  |  | 
 
 
 
 
 | 45 |  |  | # look through each directoty, as they might | 
 
 
 
 
 | 46 |  |  | # contain rrds for a particular machine | 
 
 
 
 
 | 47 |  |  | foreach my $machine (@rrddirlist) { | 
 
 
 
 
 | 48 |  |  | # Read the contents of the directory | 
 
 
 
 
 | 49 |  |  | opendir(DIR, "$rrddir/$machine"); | 
 
 
 
 
 | 50 |  |  | my(@rrdlist) = grep { /\.rrd$/ && -f "$rrddir/$machine/$_" } readdir(DIR); | 
 
 
 
 
 | 51 |  |  | closedir DIR; | 
 
 
 
 
 | 52 |  |  |  | 
 
 
 
 
 | 53 |  |  | # See what rrd we have, and generate the graphs accordingly | 
 
 
 
 
 | 54 |  |  | foreach my $rrd (@rrdlist) { | 
 
 
 
 
 | 55 |  |  | chomp $rrd; | 
 
 
 
 
 | 56 |  |  | if($rrd =~ /^(cpu)\.rrd$/) { | 
 
 
 
 
 | 57 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 58 | tdb | 1.5 | my(@rawdata); | 
 
 
 
 
 
 
 
 | 59 | tdb | 1.3 | push @data, "LINE2:$1:idle:idle#00FF00:idle cpu"; | 
 
 
 
 
 | 60 |  |  | push @data, "LINE2:$1:user:user#0000FF:user cpu"; | 
 
 
 
 
 | 61 |  |  | push @data, "LINE2:$1:kernel:kernel#00FFFF:kernel cpu"; | 
 
 
 
 
 | 62 |  |  | push @data, "LINE2:$1:swap:swap#FF00FF:swap cpu"; | 
 
 
 
 
 | 63 |  |  | push @data, "LINE2:$1:iowait:iowait#FF0000:iowait cpu"; | 
 
 
 
 
 
 
 
 | 64 | tdb | 1.5 | push @rawdata, "--upper-limit=100"; | 
 
 
 
 
 | 65 |  |  | &makegraph($machine, $1, "CPU Usage for $machine", \@data, \@rawdata); | 
 
 
 
 
 
 
 
 | 66 | tdb | 1.1 | } | 
 
 
 
 
 | 67 |  |  | if($rrd =~ /^(mem)\.rrd$/) { | 
 
 
 
 
 | 68 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 69 | tdb | 1.5 | my(@rawdata); | 
 
 
 
 
 | 70 |  |  | push @data, "AREA:$1:free:free#CCCCFF:free memory"; | 
 
 
 
 
 
 
 
 | 71 | tdb | 1.3 | push @data, "LINE2:$1:total:total#0000FF:total memory"; | 
 
 
 
 
 
 
 
 | 72 | tdb | 1.5 | push @rawdata, "--base=1024"; | 
 
 
 
 
 | 73 |  |  | &makegraph($machine, $1, "Memory Usage for $machine", \@data, \@rawdata); | 
 
 
 
 
 
 
 
 | 74 | tdb | 1.1 | } | 
 
 
 
 
 | 75 |  |  | if($rrd =~ /^(load)\.rrd$/) { | 
 
 
 
 
 | 76 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 77 | tdb | 1.5 | push @data, "LINE2:$1:load1:load1#CCCCFF:1 minute load average"; | 
 
 
 
 
 | 78 |  |  | push @data, "LINE2:$1:load5:load5#7777FF:5 minute load average"; | 
 
 
 
 
 | 79 |  |  | push @data, "LINE2:$1:load15:load15#0000FF:15 minute load average"; | 
 
 
 
 
 
 
 
 | 80 | tdb | 1.1 | &makegraph($machine, $1, "Loads for $machine", \@data); | 
 
 
 
 
 | 81 |  |  | } | 
 
 
 
 
 | 82 |  |  | if($rrd =~ /^(proc)\.rrd$/) { | 
 
 
 
 
 | 83 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 84 | tdb | 1.3 | push @data, "LINE2:$1:cpu:cpu#00FF00:cpu processes"; | 
 
 
 
 
 | 85 |  |  | push @data, "LINE2:$1:sleeping:sleeping#0000FF:sleeping processes"; | 
 
 
 
 
 | 86 |  |  | push @data, "LINE2:$1:stopped:stopped#00FFFF:stopped processes"; | 
 
 
 
 
 | 87 |  |  | push @data, "LINE2:$1:total:total#FF00FF:total processes"; | 
 
 
 
 
 | 88 |  |  | push @data, "LINE2:$1:zombie:zombie#FF0000:zombie processes"; | 
 
 
 
 
 
 
 
 | 89 | tdb | 1.1 | &makegraph($machine, $1, "Processes on $machine", \@data); | 
 
 
 
 
 | 90 |  |  | } | 
 
 
 
 
 | 91 |  |  | if($rrd =~ /^(swap)\.rrd$/) { | 
 
 
 
 
 | 92 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 93 | tdb | 1.5 | my(@rawdata); | 
 
 
 
 
 | 94 |  |  | push @data, "AREA:$1:free:free#CCCCFF:free swap"; | 
 
 
 
 
 
 
 
 | 95 | tdb | 1.3 | push @data, "LINE2:$1:total:total#0000FF:total swap"; | 
 
 
 
 
 
 
 
 | 96 | tdb | 1.5 | push @rawdata, "--base=1024"; | 
 
 
 
 
 | 97 |  |  | &makegraph($machine, $1, "Swap Usage for $machine", \@data, \@rawdata); | 
 
 
 
 
 
 
 
 | 98 | tdb | 1.1 | } | 
 
 
 
 
 | 99 |  |  | if($rrd =~ /^(users)\.rrd$/) { | 
 
 
 
 
 | 100 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 101 | tdb | 1.5 | push @data, "AREA:$1:count:count#CCCCFF:user count"; | 
 
 
 
 
 
 
 
 | 102 | tdb | 1.1 | &makegraph($machine, $1, "User Count for $machine", \@data); | 
 
 
 
 
 | 103 |  |  | } | 
 
 
 
 
 | 104 |  |  | if($rrd =~ /^(disk)-(\S+).rrd$/) { | 
 
 
 
 
 | 105 |  |  | my(@data); | 
 
 
 
 
 
 
 
 | 106 | tdb | 1.5 | my(@rawdata); | 
 
 
 
 
 
 
 
 | 107 | tdb | 1.3 | push @data, "LINE2:$1-$2:kbytes:kbytes#0000FF:total size"; | 
 
 
 
 
 
 
 
 | 108 | tdb | 1.5 | push @data, "AREA:$1-$2:used:used#CCCCFF:used"; | 
 
 
 
 
 | 109 |  |  | push @rawdata, "--base=1024"; | 
 
 
 
 
 
 
 
 | 110 | tdb | 1.1 | my($type) = $1; | 
 
 
 
 
 | 111 |  |  | my($name) = $2; | 
 
 
 
 
 | 112 |  |  | my($nicename) = $2; | 
 
 
 
 
 | 113 |  |  | $nicename =~ s/$hex_slash/\//g; | 
 
 
 
 
 | 114 |  |  | $nicename =~ s/$hex_underscore/_/g; | 
 
 
 
 
 
 
 
 | 115 | tdb | 1.5 | &makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", \@data, \@rawdata); | 
 
 
 
 
 
 
 
 | 116 | tdb | 1.1 | } | 
 
 
 
 
 | 117 |  |  | # probably a queue with a name like this :) | 
 
 
 
 
 | 118 |  |  | if($rrd =~ /^(\d+)_0\.rrd$/) { | 
 
 
 
 
 | 119 |  |  | my(@data); | 
 
 
 
 
 | 120 |  |  | my(@rawdata); | 
 
 
 
 
 | 121 |  |  | my($baserrd) = $1; | 
 
 
 
 
 | 122 |  |  | my($i) = 0; | 
 
 
 
 
 | 123 |  |  | while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) { | 
 
 
 
 
 
 
 
 | 124 | tdb | 1.3 | push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":queue$i size "; | 
 
 
 
 
 
 
 
 | 125 | tdb | 1.1 | ++$i; | 
 
 
 
 
 | 126 |  |  | } | 
 
 
 
 
 
 
 
 | 127 | tdb | 1.3 | push @data, "LINE2:$baserrd\_0:total:total#FF0000:packets/sec - currently"; | 
 
 
 
 
 
 
 
 | 128 | tdb | 1.2 | push @rawdata, "GPRINT:total:LAST:%lf %spackets/sec"; | 
 
 
 
 
 
 
 
 | 129 | tdb | 1.1 | my($comment); | 
 
 
 
 
 | 130 |  |  | if(-f "$rrddir/$machine/$baserrd.def") { | 
 
 
 
 
 | 131 |  |  | open(DEF, "$rrddir/$machine/$baserrd.def"); | 
 
 
 
 
 | 132 |  |  | $comment = <DEF>; | 
 
 
 
 
 | 133 |  |  | chomp $comment if defined $comment; | 
 
 
 
 
 | 134 |  |  | } | 
 
 
 
 
 | 135 |  |  | $comment = "unknown queue" if not defined $comment; | 
 
 
 
 
 | 136 |  |  | &makegraph($machine, $baserrd, $comment, \@data, \@rawdata); | 
 
 
 
 
 | 137 |  |  | } | 
 
 
 
 
 | 138 |  |  | } | 
 
 
 
 
 | 139 |  |  | } | 
 
 
 
 
 | 140 |  |  |  | 
 
 
 
 
 | 141 |  |  | # | 
 
 
 
 
 | 142 |  |  | # subroutine to make some graphs | 
 
 
 
 
 | 143 |  |  | # | 
 
 
 
 
 | 144 |  |  | # $machine   = name of the machine | 
 
 
 
 
 | 145 |  |  | #              (eg. kernow.ukc.ac.uk) | 
 
 
 
 
 | 146 |  |  | # $type      = the type of graph for the machine | 
 
 
 
 
 | 147 |  |  | #              (eg. cpu) | 
 
 
 
 
 | 148 |  |  | # $title     = the title for the graph | 
 
 
 
 
 | 149 |  |  | #              (eg. kernow CPU usage) | 
 
 
 
 
 | 150 |  |  | # $dataref   = a reference to an array containing information for the graph | 
 
 
 
 
 
 
 
 | 151 | tdb | 1.3 | #              elements of format: "gtype:rrdname:dsname:name#colour:comment with spaces" | 
 
 
 
 
 
 
 
 | 152 | tdb | 1.1 | # $rawcmdref = a reference to an array containing raw rrd commands | 
 
 
 
 
 | 153 |  |  | #              elements a single command each, no spaces | 
 
 
 
 
 | 154 |  |  | # | 
 
 
 
 
 
 
 
 | 155 | tdb | 1.2 |  | 
 
 
 
 
 
 
 
 | 156 | tdb | 1.1 | sub makegraph() { | 
 
 
 
 
 | 157 |  |  | my($machine, $type, $title, $dataref, $rawcmdref) = @_; | 
 
 
 
 
 | 158 |  |  | # pass in these arrays by reference | 
 
 
 
 
 | 159 |  |  | my(@data) = @$dataref if defined $dataref; | 
 
 
 
 
 | 160 |  |  | my(@rawcmd) = @$rawcmdref if defined $rawcmdref; | 
 
 
 
 
 | 161 |  |  | # check if directory exists for images | 
 
 
 
 
 | 162 |  |  | if(! -d "$imgdir/$machine") { | 
 
 
 
 
 | 163 |  |  | # not sure on this umask, but it seems to work? | 
 
 
 
 
 | 164 |  |  | mkdir "$imgdir/$machine", 0777; | 
 
 
 
 
 | 165 |  |  | } | 
 
 
 
 
 | 166 |  |  | my(@rrdcmd); | 
 
 
 
 
 | 167 |  |  | foreach my $dataitem (@data) { | 
 
 
 
 
 
 
 
 | 168 | tdb | 1.3 | # dataitem should be: "gtype:rrdname:dsname:name#colour:comment with spaces" | 
 
 
 
 
 | 169 |  |  | if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(.*)$/) { | 
 
 
 
 
 | 170 |  |  | push @rrdcmd, "DEF:$4=$rrddir/$machine/$2.rrd:$3:MAX"; | 
 
 
 
 
 | 171 |  |  | push @rrdcmd, "$1:$4#$5:$6"; | 
 
 
 
 
 
 
 
 | 172 | tdb | 1.1 | } | 
 
 
 
 
 | 173 |  |  | } | 
 
 
 
 
 | 174 |  |  | push @rrdcmd, "--title=$title"; | 
 
 
 
 
 | 175 |  |  | push @rrdcmd, "--imgformat=PNG"; | 
 
 
 
 
 | 176 |  |  | push @rrdcmd, "--lower-limit=0"; | 
 
 
 
 
 
 
 
 | 177 | tdb | 1.5 | # not entirely convinced this is good... | 
 
 
 
 
 | 178 |  |  | push @rrdcmd, "--alt-autoscale-max"; | 
 
 
 
 
 
 
 
 | 179 | tdb | 1.1 | # add any further raw commands | 
 
 
 
 
 | 180 |  |  | push @rrdcmd, @rawcmd; | 
 
 
 
 
 | 181 |  |  | RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd); | 
 
 
 
 
 | 182 |  |  | my($err_3h) = RRDs::error; | 
 
 
 
 
 
 
 
 | 183 | tdb | 1.2 | print STDERR "Error generating 3h graph for $machine/$type: $err_3h\n" if $err_3h; | 
 
 
 
 
 
 
 
 | 184 | tdb | 1.1 | RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd); | 
 
 
 
 
 | 185 |  |  | my($err_1d) = RRDs::error; | 
 
 
 
 
 
 
 
 | 186 | tdb | 1.2 | print STDERR "Error generating 1d graph for $machine/$type: $err_1d\n" if $err_1d; | 
 
 
 
 
 
 
 
 | 187 | tdb | 1.1 | RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd); | 
 
 
 
 
 | 188 |  |  | my($err_1w) = RRDs::error; | 
 
 
 
 
 
 
 
 | 189 | tdb | 1.2 | print STDERR "Error generating 1w graph for $machine/$type: $err_1w\n" if $err_1w; | 
 
 
 
 
 
 
 
 | 190 | tdb | 1.1 | RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd); | 
 
 
 
 
 | 191 |  |  | my($err_1m) = RRDs::error; | 
 
 
 
 
 
 
 
 | 192 | tdb | 1.2 | print STDERR "Error generating 1m graph for $machine/$type: $err_1m\n" if $err_1m; | 
 
 
 
 
 
 
 
 | 193 | tdb | 1.1 | return; | 
 
 
 
 
 | 194 |  |  | } | 
 
 
 
 
 | 195 |  |  |  | 
 
 
 
 
 | 196 |  |  | # hacky subroutine to return a colour | 
 
 
 
 
 | 197 |  |  | # could be done much better somehow :/ | 
 
 
 
 
 | 198 |  |  | sub get_colour { | 
 
 
 
 
 | 199 |  |  | my($col) = @_; | 
 
 
 
 
 | 200 |  |  | if($col == 0) { | 
 
 
 
 
 | 201 |  |  | return "#0000FF"; | 
 
 
 
 
 | 202 |  |  | } | 
 
 
 
 
 | 203 |  |  | elsif($col == 1) { | 
 
 
 
 
 | 204 |  |  | return "#00FF00"; | 
 
 
 
 
 | 205 |  |  | } | 
 
 
 
 
 | 206 |  |  | elsif($col == 2) { | 
 
 
 
 
 | 207 |  |  | return "#FF00FF"; | 
 
 
 
 
 | 208 |  |  | } | 
 
 
 
 
 | 209 |  |  | elsif($col == 3) { | 
 
 
 
 
 | 210 |  |  | return "#FFFF00"; | 
 
 
 
 
 | 211 |  |  | } | 
 
 
 
 
 | 212 |  |  | elsif($col == 4) { | 
 
 
 
 
 | 213 |  |  | return "#00FFFF"; | 
 
 
 
 
 | 214 |  |  | } | 
 
 
 
 
 | 215 |  |  | else { | 
 
 
 
 
 | 216 |  |  | return "#000066"; | 
 
 
 
 
 | 217 |  |  | } | 
 
 
 
 
 | 218 |  |  | } |