| 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 % | 
|---|
| 23 | --height 600 | 
|---|
| 24 | --width 800 | 
|---|
| 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 |  | 
|---|
| 49 | my $path = catfile(GRAPH_DIR, "*-$type-????????_????_????_????_????????????-?.rrd"); | 
|---|
| 50 | my @files = glob $path or die "No data found"; | 
|---|
| 51 |  | 
|---|
| 52 | push @args, "--start", "-".$days."d"; | 
|---|
| 53 |  | 
|---|
| 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 |  | 
|---|
| 63 | foreach my $uuid (sort keys %uuids) { | 
|---|
| 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"; | 
|---|
| 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); | 
|---|