contrib/collection3/bin/graph.cgi

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2008-2011  Florian Forster
   4 # Copyright (C) 2011       noris network AG
   5 #
   6 # This program is free software; you can redistribute it and/or modify it under
   7 # the terms of the GNU General Public License as published by the Free Software
   8 # Foundation; only version 2 of the License is applicable.
   9 #
  10 # This program is distributed in the hope that it will be useful, but WITHOUT
  11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 # FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  13 # details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # this program; if not, write to the Free Software Foundation, Inc.,
  17 # 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  18 #
  19 # Authors:
  20 #   Florian "octo" Forster <octo at collectd.org>
  21
  22 use strict;
  23 use warnings;
  24 use utf8;
  25 use vars (qw($BASE_DIR));
  26
  27 BEGIN
  28 {
  29   if (defined $ENV{'SCRIPT_FILENAME'})
  30   {
  31     if ($ENV{'SCRIPT_FILENAME'} =~ m{^(/.+)/bin/[^/]+$})
  32     {
  33       $::BASE_DIR = $1;
  34       unshift (@::INC, "$::BASE_DIR/lib");
  35     }
  36   }
  37 }
  38
  39 use Carp (qw(confess cluck));
  40 use CGI (':cgi');
  41 use RRDs ();
  42 use File::Temp (':POSIX');
  43
  44 use Collectd::Graph::Config (qw(gc_read_config gc_get_scalar));
  45 use Collectd::Graph::TypeLoader (qw(tl_load_type));
  46
  47 use Collectd::Graph::Common (qw(sanitize_type get_selected_files
  48       epoch_to_rfc1123 flush_files));
  49 use Collectd::Graph::Type ();
  50
  51 sub base_dir
  52 {
  53   if (defined $::BASE_DIR)
  54   {
  55     return ($::BASE_DIR);
  56   }
  57
  58   if (!defined ($ENV{'SCRIPT_FILENAME'}))
  59   {
  60     return;
  61   }
  62
  63   if ($ENV{'SCRIPT_FILENAME'} =~ m{^(/.+)/bin/[^/]+$})
  64   {
  65     $::BASE_DIR = $1;
  66     return ($::BASE_DIR);
  67   }
  68
  69   return;
  70 }
  71
  72 sub lib_dir
  73 {
  74   my $base = base_dir ();
  75
  76   if ($base)
  77   {
  78     return "$base/lib";
  79   }
  80   else
  81   {
  82     return "../lib";
  83   }
  84 }
  85
  86 sub sysconf_dir
  87 {
  88   my $base = base_dir ();
  89
  90   if ($base)
  91   {
  92     return "$base/etc";
  93   }
  94   else
  95   {
  96     return "../etc";
  97   }
  98 }
  99
 100 sub init
 101 {
 102   my $lib_dir = lib_dir ();
 103   my $sysconf_dir = sysconf_dir ();
 104
 105   if (!grep { $lib_dir eq $_ } (@::INC))
 106   {
 107     unshift (@::INC, $lib_dir);
 108   }
 109
 110   gc_read_config ("$sysconf_dir/collection.conf");
 111 }
 112
 113 sub main
 114 {
 115   my $Begin = param ('begin');
 116   my $End = param ('end');
 117   my $GraphWidth = param ('width');
 118   my $GraphHeight = param ('height');
 119   my $Index = param ('index') || 0;
 120   my $OutputFormat = 'PNG';
 121   my $ContentType = 'image/png';
 122
 123   init ();
 124
 125   if (param ('format'))
 126   {
 127     my $temp = param ('format') || '';
 128     $temp = uc ($temp);
 129
 130     if ($temp =~ m/^(PNG|SVG|EPS|PDF)$/)
 131     {
 132       $OutputFormat = $temp;
 133
 134       if ($OutputFormat eq 'SVG') { $ContentType = 'image/svg+xml'; }
 135       elsif ($OutputFormat eq 'EPS') { $ContentType = 'image/eps'; }
 136       elsif ($OutputFormat eq 'PDF') { $ContentType = 'application/pdf'; }
 137     }
 138   }
 139
 140   if (param ('debug'))
 141   {
 142     print <<HTTP;
 143 Content-Type: text/plain
 144
 145 HTTP
 146     $ContentType = 'text/plain';
 147   }
 148
 149   if ($GraphWidth)
 150   {
 151     $GraphWidth =~ s/\D//g;
 152   }
 153
 154   if (!$GraphWidth)
 155   {
 156     $GraphWidth = gc_get_scalar ('GraphWidth', 400);
 157   }
 158
 159   if ($GraphHeight)
 160   {
 161     $GraphHeight =~ s/\D//g;
 162   }
 163
 164   if (!$GraphHeight)
 165   {
 166     $GraphHeight = gc_get_scalar ('GraphHeight', 100);
 167   }
 168
 169   { # Sanitize begin and end times
 170     $End ||= 0;
 171     $Begin ||= 0;
 172
 173     if ($End =~ m/\D/)
 174     {
 175       $End = 0;
 176     }
 177
 178     if (!$Begin || !($Begin =~ m/^-?([1-9][0-9]*)$/))
 179     {
 180       $Begin = -86400;
 181     }
 182
 183     if ($Begin < 0)
 184     {
 185       if ($End)
 186       {
 187         $Begin = $End + $Begin;
 188       }
 189       else
 190       {
 191         $Begin = time () + $Begin;
 192       }
 193     }
 194
 195     if ($Begin < 0)
 196     {
 197       $Begin = time () - 86400;
 198     }
 199
 200     if (($End > 0) && ($Begin > $End))
 201     {
 202       my $temp = $End;
 203       $End = $Begin;
 204       $Begin = $temp;
 205     }
 206   }
 207
 208   my $type = param ('type') or die;
 209   my $obj;
 210
 211   $obj = tl_load_type ($type);
 212   if (!$obj)
 213   {
 214     confess ("tl_load_type ($type) failed");
 215   }
 216
 217   $type = ucfirst (lc ($type));
 218   $type =~ s/_([A-Za-z])/\U$1\E/g;
 219   $type = sanitize_type ($type);
 220
 221   my $files = get_selected_files ();
 222   if (param ('debug'))
 223   {
 224     require Data::Dumper;
 225     print Data::Dumper->Dump ([$files], ['files']);
 226   }
 227   for (@$files)
 228   {
 229     $obj->addFiles ($_);
 230   }
 231
 232   my $expires = time ();
 233 # IF (End is `now')
 234 #    OR (Begin is before `now' AND End is after `now')
 235   if (($End == 0) || (($Begin <= $expires) && ($End >= $expires)))
 236   {
 237     # 400 == width in pixels
 238     my $timespan;
 239
 240     if ($End == 0)
 241     {
 242       $timespan = $expires - $Begin;
 243     }
 244     else
 245     {
 246       $timespan = $End - $Begin;
 247     }
 248     $expires += int ($timespan / 400.0);
 249   }
 250 # IF (End is not `now')
 251 #    AND (End is before `now')
 252 # ==> Graph will never change again!
 253   elsif (($End > 0) && ($End < $expires))
 254   {
 255     $expires += (366 * 86400);
 256   }
 257   elsif ($Begin > $expires)
 258   {
 259     $expires = $Begin;
 260   }
 261
 262 # Send FLUSH command to the daemon if necessary and possible.
 263   flush_files ($files,
 264     begin => $Begin,
 265     end => $End,
 266     addr => gc_get_scalar ('UnixSockAddr', undef),
 267     interval => gc_get_scalar ('Interval', 10));
 268
 269   print header (-Content_type => $ContentType,
 270     -Last_Modified => epoch_to_rfc1123 ($obj->getLastModified ()),
 271     -Expires => epoch_to_rfc1123 ($expires));
 272
 273   if (param ('debug'))
 274   {
 275     print "\$expires = $expires;\n";
 276   }
 277
 278   my $args = $obj->getRRDArgs (0 + $Index);
 279   if (param ('debug'))
 280   {
 281     require Data::Dumper;
 282     print Data::Dumper->Dump ([$obj], ['obj']);
 283     print join (",\n", @$args) . "\n";
 284     print "Last-Modified: " . epoch_to_rfc1123 ($obj->getLastModified ()) . "\n";
 285   }
 286   else
 287   {
 288     my @timesel = ();
 289     my $tmpfile = tmpnam ();
 290     my $status;
 291
 292     if ($End) # $Begin is always true
 293     {
 294       @timesel = ('-s', $Begin, '-e', $End);
 295     }
 296     else
 297     {
 298       @timesel = ('-s', $Begin); # End is implicitely `now'.
 299     }
 300
 301     if (-S "/var/run/rrdcached.sock" && -w "/var/run/rrdcached.sock")
 302     {
 303       $ENV{"RRDCACHED_ADDRESS"} = "/var/run/rrdcached.sock";
 304     }
 305     unlink ($tmpfile);
 306     RRDs::graph ($tmpfile, '-a', $OutputFormat, '--width', $GraphWidth, '--height', $GraphHeight, @timesel, @$args);
 307     if (my $err = RRDs::error ())
 308     {
 309       print STDERR "RRDs::graph failed: $err\n";
 310       exit (1);
 311     }
 312
 313     $status = open (IMG, '<', $tmpfile) or die ("open ($tmpfile): $!");
 314     if (!$status)
 315     {
 316       print STDERR "graph.cgi: Unable to open temporary file \"$tmpfile\" for reading: $!\n";
 317     }
 318     else
 319     {
 320       local $/ = undef;
 321       while (my $data = <IMG>)
 322       {
 323         print STDOUT $data;
 324       }
 325
 326       close (IMG);
 327       unlink ($tmpfile);
 328     }
 329   }
 330 } # sub main
 331
 332 main ();
 333
 334 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :