| [1788] | 1 | #!/usr/bin/perl -wT | 
|---|
 | 2 |  | 
|---|
 | 3 | use diagnostics; | 
|---|
 | 4 | use constant GRAPH_DIR => "/var/lib/munin/xvm-prod-hosts.mit.edu"; | 
|---|
 | 5 | use CGI; | 
|---|
 | 6 | use CGI::Carp qw(fatalsToBrowser); | 
|---|
 | 7 | use RRDs; | 
|---|
 | 8 | use File::Spec::Functions; | 
|---|
 | 9 |  | 
|---|
 | 10 | our %graph_types = (cpu => "xen_cpu"); | 
|---|
 | 11 | our %formats = qw(svg image/svg+xml png image/png eps application/postscript pdf application/pdf); | 
|---|
 | 12 |  | 
|---|
 | 13 | my @args = (qw( | 
|---|
 | 14 | --font LEGEND:7:/usr/share/munin/VeraMono.ttf | 
|---|
 | 15 | --font UNIT:7:/usr/share/munin/VeraMono.ttf | 
|---|
 | 16 | --font AXIS:7:/usr/share/munin/VeraMono.ttf | 
|---|
 | 17 | - | 
|---|
 | 18 | --title), "Domain CPU usage", qw( | 
|---|
 | 19 | --base 1000 | 
|---|
 | 20 | -r | 
|---|
 | 21 | --lower-limit 0 | 
|---|
 | 22 | --vertical-label % | 
|---|
| [2058] | 23 | --height 600 | 
|---|
 | 24 | --width 800 | 
|---|
| [1788] | 25 | --units-exponent 0)); | 
|---|
 | 26 |  | 
|---|
 | 27 | my $q = new CGI; | 
|---|
 | 28 |  | 
|---|
 | 29 | my $format = $q->param("format") || "png"; | 
|---|
 | 30 | my $mime_type; | 
|---|
 | 31 | if (exists($formats{$format})) { | 
|---|
 | 32 |     $format =~ m|^(\w+)$| or die "Invalid format"; | 
|---|
 | 33 |     $format = $1; | 
|---|
 | 34 |     $mime_type = $formats{$format}; | 
|---|
 | 35 | } else { | 
|---|
 | 36 |     die "Invalid format"; | 
|---|
 | 37 | } | 
|---|
 | 38 |  | 
|---|
 | 39 | push @args, "--imgformat", uc($format); | 
|---|
 | 40 |  | 
|---|
 | 41 | my $days = $q->param("days") || "8"; | 
|---|
 | 42 | $days =~ m|^(\d+)$| or die "Invalid number of days specified"; | 
|---|
 | 43 | $days = int($1); | 
|---|
 | 44 |  | 
|---|
 | 45 | my $type = $q->param("type") || "cpu"; | 
|---|
 | 46 | $type =~ m|^(\w+)$| or die "Invalid graph type"; | 
|---|
 | 47 | $type = $graph_types{$1} or die "Invalid graph type"; | 
|---|
 | 48 |  | 
|---|
| [2058] | 49 | my $path = catfile(GRAPH_DIR, "*-$type-????????_????_????_????_????????????-?.rrd"); | 
|---|
| [1788] | 50 | my @files = glob $path or die "No data found"; | 
|---|
 | 51 |  | 
|---|
 | 52 | push @args, "--start", "-".$days."d"; | 
|---|
 | 53 |  | 
|---|
| [2058] | 54 | my %uuids = map { m|(........_...._...._...._............)-.\.rrd$|; $1, 1 } @files; | 
|---|
 | 55 |  | 
|---|
 | 56 | # Color list shamelessly stolen from munin-graph | 
|---|
 | 57 | my @COLOUR = ("#22ff22", "#0022ff", "#ff0000", "#00aaaa", "#ff00ff", | 
|---|
 | 58 |               "#ffa500", "#cc0000", "#0000cc", "#0080C0", "#8080C0", "#FF0080", | 
|---|
 | 59 |               "#800080", "#688e23", "#408080", "#808000", "#000000", "#00FF00", | 
|---|
 | 60 |               "#0080FF", "#FF8000", "#800000", "#FB31FB"); | 
|---|
 | 61 | my $color_index = 0; | 
|---|
 | 62 |  | 
|---|
| [2059] | 63 | foreach my $uuid (sort keys %uuids) { | 
|---|
| [2058] | 64 |   my @uuid_files = grep { m|$uuid-.\.rrd$| } @files; | 
|---|
 | 65 |   foreach my $i (0..$#uuid_files) { | 
|---|
 | 66 |     $uuid_files[$i] =~ m|^([^:]+)$|; | 
|---|
 | 67 |     push @args, "DEF:odata_${uuid}_$i=$1:42:AVERAGE"; | 
|---|
 | 68 |     push @args, "CDEF:data_${uuid}_$i=odata_${uuid}_$i,UN,0,odata_${uuid}_$i,IF,10000,/"; | 
|---|
 | 69 |   } | 
|---|
 | 70 |   push @args, "CDEF:total_${uuid}=0,".join(",+,", map {"data_${uuid}_$_"} 0..$#uuid_files).",+"; | 
|---|
 | 71 |   push @args, "AREA:total_${uuid}".$COLOUR[($color_index++)%@COLOUR]."::STACK"; | 
|---|
 | 72 |   # print STDERR "VM $uuid: @uuid_files\n"; | 
|---|
| [1788] | 73 | } | 
|---|
 | 74 |  | 
|---|
 | 75 | $ENV{"PATH"} = "/usr/local/bin:/usr/bin:/bin"; | 
|---|
 | 76 |  | 
|---|
 | 77 | print $q->header(-type=>$mime_type); | 
|---|
 | 78 | $|=1; | 
|---|
 | 79 |  | 
|---|
 | 80 | { | 
|---|
 | 81 |     use Data::Dumper; | 
|---|
 | 82 |     print STDERR "XVM usage: ", Dumper(\@args); | 
|---|
 | 83 | } | 
|---|
 | 84 | RRDs::graph (@args); | 
|---|