web/usage.cgi

   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 RRDs;
   7 use File::Spec::Functions;
   8 use subs 'die';
   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 175
  24 --width 400
  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 $uuid = $q->param("uuid");
  46 $uuid =~ m|^([0-9a-f]{8})-([0-9a-f]{4})-([0-9a-f]{4})-([0-9a-f]{4})-([0-9a-f]{12})$| or die "Invalid UUID specified";
  47 $uuid = "$1_$2_$3_$4_$5";
  48
  49 my $type = $q->param("type") || "cpu";
  50 $type =~ m|^(\w+)$| or die "Invalid graph type";
  51 $type = $graph_types{$1} or die "Invalid graph type";
  52
  53 my $path = catfile(GRAPH_DIR, "*-$type-uuid_$uuid-?.rrd");
  54 my @files = glob $path or die "No data found";
  55
  56 push @args, "--start", "-".$days."d";
  57
  58 foreach my $i (0..$#files) {
  59   $files[$i] =~ m|^([^:]+)$|;
  60   push @args, "DEF:odata$i=$1:42:AVERAGE";
  61   push @args, "CDEF:data$i=odata$i,UN,0,odata$i,IF,10000,/";
  62 }
  63 push @args, "CDEF:total=0,".join(",+,", map {"data$_"} 0..$#files).",+";
  64 push @args, "AREA:total#0000FF";
  65
  66 $ENV{"PATH"} = "/usr/local/bin:/usr/bin:/bin";
  67
  68 print $q->header(-type=>$mime_type);
  69 $|=1;
  70
  71 {
  72     use Data::Dumper;
  73     print STDERR "XVM usage: ", Dumper(\@args);
  74 }
  75 RRDs::graph (@args);
  76
  77 sub die(@) {
  78   use Image::Magick;
  79
  80   my $im = Image::Magick->new(background => "white",
  81                               fill => "red",
  82                               pointsize => 14,
  83                               );
  84   $im->Read('label:'.join('', @_));
  85   $format = 'png' unless exists($formats{$format});
  86   $mime_type = $formats{$format};
  87   $| = 1;
  88   print $q->header(-type=>$mime_type);
  89   $im->Write($format.':-');
  90   CORE::die @_;
  91 }