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 $ENV{"RRDCACHED_ADDRESS"} = "/var/run/munin/rrdcached.sock";
  11
  12 our %graph_types =
  13   (cpu =>
  14    {
  15     plugin_name => "xen_cpu",
  16     args => ["--title", "Domain CPU usage",
  17              qw(
  18                  --base 1000
  19                  -r
  20                  --lower-limit 0
  21                  --vertical-label %
  22                  --units-exponent 0)],
  23     cdef => "10000,/",
  24     draw => "AREA",
  25    },
  26    net =>
  27    {
  28     plugin_name => "xen_net",
  29     args => ["--title", "Domain network usage",
  30              qw(
  31                  --base 1000
  32                  --vertical-label), "bits in (-) / out (+) per ${graph_period}",
  33             ],
  34     cdef => "8,*",
  35     draw => "LINE",
  36     sub_types => [{suffix => "_up", cdef => "8,*"},
  37                   {suffix => "_down", cdef => "-8,*"},
  38                  ]
  39    },
  40                    );
  41 our %formats = qw(svg image/svg+xml png image/png eps application/postscript pdf application/pdf);
  42
  43 my @args = (qw(
  44 --font LEGEND:7:/usr/share/munin/VeraMono.ttf
  45 --font UNIT:7:/usr/share/munin/VeraMono.ttf
  46 --font AXIS:7:/usr/share/munin/VeraMono.ttf
  47 -
  48 --height 175
  49 --width 400
  50 ));
  51
  52 my $q = new CGI;
  53
  54 my $format = $q->param("format") || "png";
  55 my $mime_type;
  56 if (exists($formats{$format})) {
  57     $format =~ m|^(\w+)$| or die "Invalid format";
  58     $format = $1;
  59     $mime_type = $formats{$format};
  60 } else {
  61     die "Invalid format";
  62 }
  63
  64 push @args, "--imgformat", uc($format);
  65
  66 my $days = $q->param("days") || "8";
  67 $days =~ m|^(\d+)$| or die "Invalid number of days specified";
  68 $days = int($1);
  69
  70 my $uuid = $q->param("uuid");
  71 $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";
  72 $uuid = "$1_$2_$3_$4_$5";
  73
  74 my $type = $q->param("type") || "cpu";
  75 $type =~ m|^(\w+)$| or die "Invalid graph type";
  76 my %type = %{$graph_types{$1}} or die "Invalid graph type";
  77 push @args, @{$type{"args"}};
  78
  79 push @args, "--start", "-".$days."d";
  80
  81 my @sub_types = {suffix => ""};
  82 if ($type{"sub_types"}) {
  83   @sub_types = @{$type{"sub_types"}};
  84 }
  85
  86 foreach my $sub_type (@sub_types) {
  87   my $cdef = $sub_type->{"cdef"} || $type{"cdef"};
  88   my $suffix = $sub_type->{"suffix"};
  89
  90   my $path = catfile(GRAPH_DIR, "*-$type{plugin_name}-uuid_$uuid$suffix-?.rrd");
  91   my @files = glob $path;
  92   unless (@files) {
  93     print STDERR "No data found: $path\n";
  94     die "No data found";
  95   }
  96
  97   foreach my $i (0..$#files) {
  98     $files[$i] =~ m|^([^:]+)$|;
  99     my $data = "data$suffix$i";
 100     push @args, "DEF:o$data=$1:42:AVERAGE";
 101     push @args, "CDEF:$data=o$data,UN,0,o$data,IF".($cdef ? ",$cdef" : "");
 102   }
 103   push @args, "CDEF:total$suffix=0,".join(",+,", map {"data$suffix$_"} 0..$#files).",+";
 104   push @args, "$type{draw}:total$suffix#0000FF";
 105 }
 106
 107 $ENV{"PATH"} = "/usr/local/bin:/usr/bin:/bin";
 108
 109 print $q->header(-type=>$mime_type);
 110 $|=1;
 111
 112 {
 113     use Data::Dumper;
 114     print STDERR "XVM usage: ", Dumper(\@args);
 115 }
 116 RRDs::graph (@args);
 117
 118 sub die(@) {
 119   use Image::Magick;
 120
 121   my $im = Image::Magick->new(background => "white",
 122                               fill => "red",
 123                               pointsize => 14,
 124                               );
 125   $im->Read('label:'.join('', @_));
 126   $format = 'png' unless exists($formats{$format});
 127   $mime_type = $formats{$format};
 128   $| = 1;
 129   print $q->header(-type=>$mime_type);
 130   $im->Write($format.':-');
 131   CORE::die @_;
 132 }