contrib/rrdview/rrdview.cgi

   1 #!/usr/bin/perl -T -w
   2
   3 use CGI::Carp qw(fatalsToBrowser carpout);
   4 use Time::Local;
   5 use File::Basename;
   6 use FileHandle;
   7 use POSIX;
   8 use RRDs;
   9
  10 BEGIN {
  11         carpout(\*STDOUT);
  12 };
  13
  14 use strict;
  15
  16 use vars qw($VERSION);
  17 my $rcs = ' $Id$ ' ;
  18 $rcs =~ m/,v (\d+\.\d+)/;
  19 $VERSION = ($1) ? $1 : "UNKNOWN";
  20
  21 my $mod_perl = (exists $ENV{MOD_PERL}) ? 1 : 0;
  22 my $self  = basename($0);
  23 my $imgErr; # global is good in that huge case.
  24
  25 doit();
  26
  27 sub doit {
  28
  29         my $debug = 0;
  30         my $cgi   = myCGI->new();
  31         my $q     = $cgi->r();
  32         my $now   = time();
  33
  34         my $strftime = '%A %d %B %Y %H:%M:%S %Z';
  35
  36         my ($minD,$hourD,$mdayD,$monD,$yearD) = (myLocaltime($now));
  37         $cgi->paramDefault(
  38                            'minE'  => $minD,
  39                            'hourE' => $hourD,
  40                            'mdayE' => $mdayD,
  41                            'monE'  => $monD,
  42                            'yearE' => $yearD,
  43                           );
  44
  45         ($minD,$hourD,$mdayD,$monD,$yearD) = (myLocaltime($now - 86400));
  46
  47         $cgi->paramDefault(
  48                            'minS'  => $minD,
  49                            'hourS' => $hourD,
  50                            'mdayS' => $mdayD,
  51                            'monS'  => $monD,
  52                            'yearS' => $yearD,
  53                           );
  54
  55
  56         my ($minS,$hourS,$mdayS,$monS,$yearS) =
  57           (
  58            $q->param(-Name => 'minS'),
  59            $q->param('hourS'),
  60            $q->param('mdayS'),
  61            $q->param('monS'),
  62            $q->param('yearS'),
  63           );
  64
  65         my ($minE,$hourE,$mdayE,$monE,$yearE) =
  66           (
  67            $q->param('minE'),
  68            $q->param('hourE'),
  69            $q->param('mdayE'),
  70            $q->param('monE'),
  71            $q->param('yearE'),
  72           );
  73
  74         my $start = myTimelocal($minS,$hourS,$mdayS,$monS,$yearS);
  75         my $end   = myTimelocal($minE,$hourE,$mdayE,$monE,$yearE);
  76
  77         my $startString = strftime($strftime, localtime($start));
  78         my $endString   = strftime($strftime, localtime($end));
  79
  80         $q->param('start', $start);
  81         $q->param('end', $end);
  82
  83         $cgi->paramDefault(
  84                            'hight'   => 150,
  85                            'width'   => 600,
  86                            'rrdfile' => 'foo.rrd',
  87                           );
  88
  89         my $width = $q->param(-Name=>'width');
  90         my $hight = $q->param(-Name=>'hight');
  91         my $owner = $q->param(-Name=>'owner') || "No Owner";
  92         my $title = $q->param(-Name=>'title') || "No Title";
  93
  94         my $rrdfile = $q->param("rrdfile");
  95
  96         $debug and $cgi->saveparam("/tmp/rrdmon.out");
  97         my $error = "";
  98         my $rrdinfo;
  99         my @dsname;
 100         unless (-f $rrdfile) {
 101                 $error = "<big>File '$rrdfile' does not exist!</big><BR>\n";
 102         }else{
 103                 $rrdinfo = RRDs::info $rrdfile;
 104                 if (my $ERR=RRDs::error) {
 105                         $error = "<big>" . $ERR . "</big><BR>\n";
 106                         @dsname = ('RRD ERROR');
 107                 }else{
 108                         foreach my $key (keys %$rrdinfo) {
 109                                 if ($key =~ m/ds\[(\w+)\]\.value/) {
 110                                         push(@dsname, $1);
 111                                 }
 112                         }
 113                 }
 114         };
 115
 116         my $dsname  = $q->param("dsname") || $dsname[0] || "unknown";
 117
 118         if (defined $q->param(-Name=>'child')) {
 119                 # cgi child
 120                 imagepage($q,
 121                           $cgi,
 122                           $debug,
 123                           $rrdfile,
 124                           $dsname,
 125                           $owner,
 126                           $hight,
 127                           $width,
 128                           $start,
 129                           $end,
 130                           $title,
 131                          );
 132         }else{
 133                 # cgi parent
 134                 mainpage($q,
 135                          $cgi,
 136                          $debug,
 137                  $dsname,
 138                  \@dsname,
 139                  $hight,
 140                  $width,
 141                  $error,
 142                  $startString,
 143                  $endString,
 144                 );
 145         }
 146 }
 147
 148 sub mainpage {
 149
 150         my $q = shift;
 151         my $cgi = shift;
 152         my $debug = shift;
 153         my $dsname = shift;
 154         my $ldsname = shift;
 155         my $hight = shift;
 156         my $width =  shift;
 157         my $error = shift;
 158         my $startString = shift;
 159         my $endString = shift;
 160
 161         my $queryChild = "child=yes&".$q->query_string();
 162         my $cgiChild = myCGI->new($queryChild);
 163         # CGI fork !
 164         print
 165           $q->header(),
 166           #$q->start_html($q->param('owner'). " " . $q->param('title') ),
 167           $q->start_html(
 168                          -Title=>"RRDVIEW $VERSION",
 169                          -Author=>'lamiral@mail.dotcom.fr',
 170                          -Meta=>{'keywords'=>'monitoring rrdtool rrdmon rrdview',
 171                                  'copyright'=>'Copyleft GPL'},
 172                          -BGCOLOR=>'lightblue',
 173                         ),
 174             ($debug) ?                   "<tt>\n" : "",
 175             ($debug and $mod_perl) ?     "mod_perl PID $$<BR>\n" : "",
 176             ($debug and not $mod_perl) ? "PID=$$<BR>\n" : "",
 177             ($debug) ?                   "$cgi<BR>\n" : "",
 178             ($debug) ?                   "$q<BR>\n" : "",
 179             ($debug) ?                   "img=".\$imgErr."<BR>\n" : "",
 180             ($debug) ?                   "</tt>\n" : "",
 181             $q->startform(-Method=>'GET',
 182                           #-Enctype=>'multipart/form-data',
 183                          ),
 184             $q->textfield(-Name=>'rrdfile',
 185                         -Default=>'Give me a file like foo.rrd',
 186                         -Size=>76),
 187           $q->br(),"\n",
 188           $q->popup_menu(-Name=>'dsname',
 189                          -Values=>[@$ldsname],
 190                          -Default=>$dsname,
 191                     ),
 192           $q->textfield(-Name=>'hight', -Size=>length($hight)), "x",
 193           $q->textfield(-Name=>'width', -Size=>length($width)), " ",
 194           $q->br(),"\n",
 195           $q->image_button(-Name=>'Beautiful Image!',
 196                            -Src=>"$self?$queryChild",
 197                           ),
 198           $q->br(),"\n",
 199           $error,
 200           $q->tt(" From "),
 201           $q->textfield(-Name=>'yearS', -Size=>4),
 202           $q->textfield(-Name=>'monS',  -Size=>2),
 203           $q->textfield(-Name=>'mdayS', -Size=>2),
 204           " ",
 205           $q->textfield(-Name=>'hourS', -Size=>2),
 206           $q->textfield(-Name=>'minS',  -Size=>2),
 207           " $startString",
 208           $q->br(),"\n",
 209           $q->tt(" To", "&nbsp;" x 2),
 210           $q->textfield(-Name=>'yearE', -Size=>4),
 211           $q->textfield(-Name=>'monE',  -Size=>2),
 212           $q->textfield(-Name=>'mdayE', -Size=>2),
 213           " ",
 214           $q->textfield(-Name=>'hourE', -Size=>2),
 215           $q->textfield(-Name=>'minE',  -Size=>2),
 216           " $endString",
 217           $q->br(),"\n",
 218           $cgi->paramHidden(
 219                             'title',
 220                             'owner',
 221                            ),
 222             $q->endform(),
 223             ($debug) ? $q->dump(): "",
 224             $q->end_html(),
 225             "\n",
 226             ;
 227 }
 228
 229
 230 sub imagepage {
 231
 232         my $q = shift;
 233         my $cgi = shift;
 234         my $debug = shift;
 235         my $rrdfile = shift;
 236         my $dsname = shift;
 237         my $owner  = shift;
 238         my $hight = shift;
 239         my $width = shift;
 240         my $start = shift;
 241         my $end = shift;
 242         my $title = shift;
 243
 244         $debug and $cgi->saveparam("/tmp/png.out");
 245
 246         my $output;
 247         RRDs::last($rrdfile);
 248
 249         print $q->header(
 250                          -Type=>'image/png',
 251                          -Expires=>'now'
 252                         );
 253
 254         if($mod_perl) {
 255                 #carp("we're running under mod_perl");
 256                 $output = "/tmp/rrdmon.img.$$.png";
 257
 258         }
 259         else {
 260                 #we're NOT running under mod_perl
 261                 $output = "-";
 262
 263         }
 264
 265         RRDs::graph($output,"--title", "$owner",
 266                     "--imgformat", "PNG",
 267                     "--height","$hight", "--width","$width",
 268                     "--start",$start,"--end",$end,
 269                     "DEF:value=$rrdfile:$dsname:AVERAGE",
 270                     "AREA:value#00FF00:$title",
 271                    );
 272
 273
 274         if (my $ERROR = RRDs::error()) {
 275                 carp "ERROR: $ERROR\n";
 276                 my $rimgErr = loadImageErrorFromVar();
 277                 print $$rimgErr;
 278                 return();
 279         }
 280         if($mod_perl) {
 281                 my $fh = FileHandle->new($output, "r");
 282                 unless (defined($fh)){
 283                         carp("Could not open ",$output,"$!");
 284                         return undef;
 285                 }
 286                 local $/ = undef;
 287                 my $file = <$fh>;
 288                 $fh->close();
 289                 print $file;
 290         }
 291 }
 292
 293
 294 sub myLocaltime {
 295         my $time = shift;
 296
 297         my ($min,$hour,$mday,$mon,$year)
 298           = (localtime($time))[1,2,3,4,5];
 299
 300         $min  = sprintf("%02s", $min);
 301         $hour = sprintf("%02s", $hour);
 302         $mday = sprintf("% 2s", $mday);
 303         $mon  = sprintf("% 2s", $mon + 1);
 304
 305         return($min,$hour,$mday,$mon,$year + 1900);
 306 }
 307
 308 sub myTimelocal {
 309         my ($min,$hours,$mday,$mon,$year) = @_;
 310
 311         my $time = timelocal(0,$min,$hours,$mday,
 312                              $mon - 1,$year - 1900);
 313         return($time);
 314 }
 315
 316 sub loadImageErrorFromVar {
 317         unless (defined ($main::imgErr)){
 318                 $main::imgErr = pack "h*", '9805e474d0a0a1a0000000d09484442500000069000000b480000000100cdc1195000000407614d4140010680a138e69f5000080769444144587adde959607357d51e37fdb7291b42b469cb0e51f283c26028d4ce2484034020129430947b0d24c01a30482e4a30c47b480cc00d2d47adcc47843186a094999423818201a10a9408c0d670360a50c18016316b3605cb8c6958d2b4a7fee7df1290b63bcb45818c8fef1947ed5d9bfd937fbb769bf818246801c204819525793f2746a31d92001110e2070a618aa8300032040c2f590000dbc54000d600b06c22b44ca728f88a7c3f2cbc6168a019d9d08910000ee9f02cbf08a1a381ba164f880211ead6a43a63aad41bb5f6df73074502c8d6db0b3a7866400af76c7844999afc9968ea68ecb6810a74481e1b65022af90888e8debf8e2e7abb57fd7a64d8e88e93776d2bd110b830bdb3ae4602edbb24c18fa08ad9e3d662024c322b4d5852152784fa4b901595259e1dca25483ac40f8f7addbb10fb9473d4aaaea475e5d31119444515711654de759be1c5bebe321380e54f3a2f37e92222eb7c37e9d73870de8f320005cad67eadf871f15c8c1a781dadabd237da20006ba4f1bc2b1006ad520e68e08fcea34f8a979b2db63a76690444467b219e378821ebd44ab61a262ad95c12eb7651752e972232aae9a44f0c68c91b46addeb7eaf2a8ede6f49e776e4f6665f0fc7443f015f78e25e70742a6ab4c7261bc7be7873ec0c96dbe7efaa56d4a6f659d4cfada9cefcb74b72cc8d971b5c5c93a7d3a95f72e6d771888826757decebfc0a26caf0ef69014efa9ff5f1379bd527f1c16c246f1d052faee9d3b7e428888b39fa3d5a728dfade7e8fbd4d50662227f9b7bf02cb9fe9c6b566e4c5aa404150418981736182e53af64c7ed25e008fadce2823ec93c1543af88be7a3ad904d8eccf24cfaf6d00fa6ba9a2f6d77faea2fc179f423753d100007524117008d191e404e2a5304d4c9ef3806fdbdcf47979f5d46d9a981768905ea015be025111115bbdf12644443ba068759bff5f5e3a44cbde7e3724c1617941c632750008f1b73414b7397445f9f57ed5f4eacd959a00082199f1ff7e9d65ce1f7b7ec6f73436ecd63d530efae75d5052a7abefbfc8b3a6abc8f9993a6ab2d4f712a6ab4596e7ab42f5ce8a73f7179e1850db55d24a45709eab2f2f5233f8d4e4397e7fa185a852847d7cbff75352f2e4d205fe31462d930b00d5f80a433af8e03d403fb235b76bfc465a0acbda91b70bfeccf02c5c62d177abddeee358f1fb224c34282c353c78d0bcf39e59957fe15758628fe442c34b990f3e75ebae79622968311193555b3dadcebef5cd5397073dacb13b7988486c39797ea988804c88f9eda7648f3d86f385c2827da5d07adb9f2dd397bf8f7cc653dcec292e6d786479d37e40f7b5d989df8ab00cb7fe1eaec1dd4953b1c2d99f57dd38a405d31d69c74cbfb9f2fc5df53000bc0e71d87d0c18ddab23b99d8f1208973fe47ac4c31189cb7dd44e14abc934678f4055aafe97e9eb41b56c108c3ee76c1cf9f728303febb9b3fb3282febf3e2f8fe9987bc3892cb8c3e18247e246444cda36811b2da0b111d923cb11311a8931c7e4377db5c14444a0cb5bcad8560111949d74412238ca019257faae24a0a04037287bdb93a686e5ed29a322e4ed5afa88134444c6deec55de6f57363e98a95d3d34802afcf0ed74741c4df375d5ef06c76991d0aa30e1be7a81db7b607825253533fb000b97e5861ade67228be24583004bd68a60fa39d32a7565af6e4dfebd7d0d954a5f5aef2edbe89bd5fc71a72aaa52a793d4e7af464fa6396983170aec910d57fe5d1d779a98300bee0d09ee4e2e8b975097a3677b97b8f995c33e7fdc77dd62a836663e0c97e77d17b4b7f72c5fbceee117b04a822bce4ea3dcde78c26656e9cb0de131906926f6d63b89babea1cad4dae454693ff5f70557bb16133429273adc8110657cbfbaa15538c46a4fcc173831d46885ead4de7835aad1c0b8d2d957d0b45959ce85a569426f5e696bfe34d625bdbd1cab6acb83a729bf87db424fb2a22620361eab1fe4a572ccccafcf8a3afb30a21744e8b5251c407c7a5bdfc505036c2c2b6cf86d90f0fef35b5a054260292d2f3e28663758488efe030c800619065c4e7ae99dc1f2011194326571aff934e53bbe3aa681a86151aa41798a264407438d44db14b267ed8c9ca8a4516073fe0b53b38b06c4b8903f091182c17bcf6176953ef259cb697c880c898ed9b86aa4efd26bd635341f2b147aa1d22bcf7f5dad2d9394d2b7fda3fc81f4bf5f391b4448693478cc536552f69dc2db71b8da52ed0201c175f0f1c37dc42231febfdd8fe54814f7f986784c43ad5a0c8decfaef6fcec25dee4dd8f4be8188816a77cf175d1f54b77b5acb6f4a6c6c60f022243deadc7e4c2c9f9779edd79a275e0164444695bbdf9d5d94f9ff5f085435cfb82ec0d03625c801692fc882cc62affba5ee8772d78de3938abc57eea11a5de0f2fecb4809ffd52ad1168bf7fafaba6e6ef1b1a07b6d9c08be0c833eb2e97d9153375b37f8e2f494a7eff1d0274ae1ab57db172e9803fe6ccfd406a159bd1a4070cb1f3aa3499df8576ed21b0eb3aeb86c55335debe36ff3785756f3a431984539616c69f11797e48905db4ff2505eb96642a81992f00ab9a028136168f713219a2b26df50a30d8c90aae43626c573d36c866a61cd834d2e95e493b7d71d699caee630480dd50802254143e9abe75aaf6a49034746e42a7e8e8bbd1a238fb9ceeabe012da3b6a496ce3efeef1a1b437442a6f3171539fa52222278bcdf4db09add60419bd4614ce60657c9fa77ea05bec49117eaf277a597afc9939b211113a0438a9bacdaec0f3734acab9ef6e6cda52f0b1bef39a814b2e78a1222218129e9dcdee3cc9ea47c4ec80619bf4443f9374a72be4d20328ba5e8db3519bfa71b44ea345e9bb023cfefa7179c1d16f65940c9b27e58f0f31b82252fca9d9b2973eac53d765ccd696f55eb94171ec1c27d6d46e019248bbc1d50f4eb14d55fd9c68c8f75708e1fc01ee1a6f570ea646006d00ca10857fa1caff107d7f7057eba98065000000009454e444ea240628';
 319         }
 320         return(\$main::imgErr);
 321 }
 322
 323
 324 package myCGI;
 325
 326 use CGI;
 327
 328 sub new {
 329         my $proto = shift;
 330         my $class = ref($proto) || $proto;
 331         my $self  = {};
 332         $self->{'CGI'} = CGI->new(shift);
 333         bless ($self, $class);
 334         return $self;
 335 }
 336
 337 sub r {
 338         my $self = shift;
 339         return($self->{'CGI'});
 340 }
 341
 342 sub DESTROY {
 343         my $self = shift;
 344
 345 }
 346
 347 sub paramDefault {
 348         my $self    = shift;
 349         my %param   = @_;
 350
 351         foreach my $param (keys(%param)) {
 352                 unless (defined($self->r->param(-Name=>$param))) {
 353                         $self->r->param(-Name=>$param, -Value=>$param{$param});
 354                 }
 355         }
 356         return values(%param);
 357 }
 358
 359 sub paramHidden {
 360         my $self    = shift;
 361         my @hidden = @_;
 362
 363         my @result;
 364         foreach my $param (@hidden) {
 365                 push(@result, $self->r->hidden(-Name=>$param));
 366         }
 367         return(@result);
 368 }
 369
 370 sub saveparam {
 371         my $self = shift;
 372         my $savefile = shift;
 373         my $fh = FileHandle->new($savefile, "w");
 374         defined($fh) || confess("Error opening $savefile (w): $!");
 375         $self->r->save($fh);
 376         $fh->close();
 377         chmod 0777, $savefile;
 378 }
 379
 380
 381 =head1 NAME
 382
 383 rrdview.cgi - Perl CGI software to graph rrd image online
 384
 385 =head1 SYNOPSIS
 386
 387 Put it on any cgi-bin/ directory, use a browser, click and fill in an
 388 rrd file in the first textfield (replacing foo.rrd). The file belongs
 389 to the web server.
 390
 391 =head1 DESCRIPTION
 392
 393 Just another rrd viewer.
 394
 395 =head1 TODO
 396
 397  . An upload textfield to allow graphing client rrd files.
 398  . Deal with LAST, MAX, MIN RRA.
 399
 400 =head1 AUTHOR
 401
 402 Gilles LAMIRAL
 403 lamiral@mail.dotcom.fr
 404
 405 =head1 SEE ALSO
 406
 407 rrdtool(1), perl(1).
 408
 409 =cut
 410
 411
 412