cgi

   1 #!/usr/bin/speedy -w -- -t100 -M1
   2 # -*- perl -*-
   3 # Main CGI program's logic; must be run inside a lock.
   4
   5 # rrd-graphs/cgi - part of rrd-graphs, a tool for online graphs
   6 # Copyright 2010, 2012 Ian Jackson
   7 #
   8 # This program is free software: you can redistribute it and/or modify
   9 # it under the terms of the GNU Affero General Public License as
  10 # published by the Free Software Foundation, either version 3 of the
  11 # License, or (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU Affero General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU Affero General Public License
  19 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21
  22 use strict qw(vars);
  23 use CGI::SpeedyCGI qw/:standard -no_xhtml/;
  24 use CGI qw/:standard -no_xhtml/;
  25 use POSIX;
  26 use MD5;
  27
  28 sub fail ($) {
  29     print(header(-status=>500),
  30           start_html('Error'),
  31           h1('Error'),
  32           escapeHTML($_[0]),
  33           end_html());
  34     exit 0;
  35 }
  36
  37 our (@sections, %section_groups, %group_elems, %graphs);
  38
  39 #---------- initialisation code, run once - graphs setup ----------
  40
  41 BEGIN {
  42
  43 our $R= '/var/lib/collectd/rrd/chiark.greenend.org.uk';
  44 our $SELF= '/home/ijackson/things/rrd-graphs';
  45
  46 our @timeranges= (3600, map { $_*86400 } qw(1 7 28), 13*7+1, 366);
  47
  48 sub graph_of_group ($$$$$) {
  49     my ($section, $group, $elem, $basis, $args) = @_;
  50     $basis->{Args}= $args;
  51     $basis->{Slower}= 0 unless exists $basis->{Slower};
  52     $basis->{TimeRanges} ||= \@timeranges;
  53     $graphs{$section,$group,$elem}= $basis;
  54     if (!exists $group_elems{$section,$group}) {
  55         # new group then
  56         if (!exists $section_groups{$section}) {
  57             # new section even
  58             push @sections, $section;
  59         }
  60         push @{ $section_groups{$section} }, $group;
  61     }
  62     push @{ $group_elems{$section,$group} }, $elem;
  63 }
  64
  65 sub graph ($$$$) {
  66     my ($section, $gname, $basis, $args) = @_;
  67     graph_of_group($section, $gname,'', $basis, $args);
  68 }
  69
  70 graph('General', 'Load and processes', { },
  71       [
  72        "DEF:load=$R/load/load.rrd:shortterm:AVERAGE",
  73        (map { "DEF:$_=$R/processes/ps_state-$_.rrd:value:AVERAGE" }
  74             qw(blocked running stopped paging sleeping zombies)),
  75        "AREA:running#88f:running:STACK",
  76        "AREA:blocked#8f8:disk wait:STACK",
  77        "AREA:paging#f88:paging:STACK",
  78        "LINE:load#000:load",
  79        ]);
  80
  81 graph('General', 'Processes', { },
  82       [
  83        (map { "DEF:$_=$R/processes/ps_state-$_.rrd:value:AVERAGE" }
  84             qw(blocked running stopped paging sleeping zombies)),
  85        "CDEF:busy=0".(join '', map { ",$_,+" } qw(running blocked paging)),
  86        "AREA:sleeping#ccc:sleeping:STACK",
  87        "AREA:stopped#00f:stopped:STACK",
  88        "AREA:zombies#ff0:zombie:STACK",
  89        "AREA:busy#000:busy:STACK",
  90        ]);
  91
  92 graph('General', 'CPU', { Units => '[%]' },
  93       [
  94        (map {
  95            my $thing= $_;
  96            (map { "DEF:$thing$_=$R/cpu-$_/cpu-$thing.rrd:value:AVERAGE" }
  97                 (0..7)),
  98            "CDEF:$thing=0".join('', map { ",$thing$_,+" } (0..7)).",8.0,/";
  99        } qw(idle interrupt nice softirq steal system user wait)),
 100        "CDEF:allintr=softirq,steal,+,interrupt,+",
 101        "AREA:allintr#ff0:interrupt:STACK",
 102        "AREA:system#88f:system:STACK",
 103        "AREA:user#00f:user:STACK",
 104        "AREA:nice#ccc:nice:STACK",
 105        "AREA:wait#f00:wait:STACK",
 106        ]);
 107
 108 graph('General', 'Memory', { },
 109       [ '-b',1024,
 110        (map { "DEF:swap_$_=$R/swap/swap-$_.rrd:value:AVERAGE" }
 111             qw(free used cached)),
 112        (map { "DEF:mem_$_=$R/memory/memory-$_.rrd:value:AVERAGE" }
 113             qw(buffered free used cached)),
 114        "CDEF:c_swap_used=0,swap_used,-",
 115        "CDEF:c_swap_cached=0,swap_cached,-",
 116        "CDEF:c_swap_free=0,swap_free,-",
 117        "AREA:c_swap_used#000:used swap",
 118        "AREA:c_swap_cached#888:\"cached\" swap:STACK",
 119 #       "AREA:c_swap_free#88f:free swap:STACK",
 120        "AREA:mem_used#ff0:used memory",
 121        "AREA:mem_buffered#00f:page cache:STACK",
 122        "AREA:mem_cached#008:buffer cache:STACK",
 123        "AREA:mem_free#ccc:unused memory:STACK",
 124        ]);
 125
 126 graph('General', 'Network', { Units => '[/sec; tx +ve; errs x1000]' },
 127       [
 128        (map {
 129            ("DEF:tx_$_=$R/interface/if_$_-eth0.rrd:tx:AVERAGE",
 130             "DEF:rx_$_=$R/interface/if_$_-eth0.rrd:rx:AVERAGE",
 131             "CDEF:mrx_$_=0,rx_$_,-")
 132            } qw(octets packets errors)),
 133        (map {
 134            ("CDEF:${_}_kb=${_}_octets,1024,/",
 135             "CDEF:${_}_errsx=${_}_errors,1000,*")
 136            } qw(mrx tx)),
 137        "AREA:tx_kb#080:kby",
 138        "LINE:tx_packets#0f0:pkts",
 139        "LINE:tx_errsx#000:errs",
 140        "AREA:mrx_kb#008:kby",
 141        "LINE:mrx_packets#00f:pkts",
 142        "LINE:mrx_errsx#444:errs",
 143       ]);
 144
 145 graph('General', 'Users', {  },
 146       [
 147        "DEF:users=$R/users/users.rrd:users:AVERAGE",
 148        "LINE:users#008:users"
 149        ]);
 150
 151 foreach my $src (<$R/df/df-*.rrd>) {
 152     my $vol= $src;
 153     $vol =~ s,\.rrd$,, or next;
 154     $vol =~ s,.*/,,;
 155     $vol =~ s,^df-,,;
 156     graph('Disk space', $vol, {
 157              Slower => 1,
 158           },
 159           [ '-A','-l',0,'-r',
 160            qw(-b 1024 -l 0),
 161            (map { "DEF:$_=$src:$_:AVERAGE" } qw(free used)),
 162            "AREA:used#000:used:STACK",
 163            "AREA:free#88f:free:STACK",
 164            ]);
 165 }
 166
 167 our %news_name_map;
 168
 169 if (!open NM, '<', "$SELF/data/news/name-map") {
 170     die unless $!==&ENOENT;
 171 } else {
 172     while (<NM>) {
 173         s/^\s*//; s/\s+$//;
 174         next unless m/^[^\#]/;
 175         m/^(\S+)\s+(in|out|\*)\s+(\S+)$/ or die;
 176         if ($2 eq '*') {
 177             $news_name_map{$1,$_}= $3 foreach qw(in out);
 178         } else {
 179             $news_name_map{$1,$2}= $3;
 180         }
 181     }
 182 }
 183
 184 our %news_sources;
 185
 186 foreach my $src (<$SELF/data/news/*.rrd>) {
 187     my $site= $src;
 188     $site =~ s,\.rrd$,, or next;
 189     $site =~ s,.*/,,;
 190     $site =~ s,_(in|out)$,,;
 191     my $inout= $1;
 192     $site =~ s/^([-.0-9a-z]+)_//;
 193     my $us= $1; # all very well but we ignore it
 194     my $newsite= $news_name_map{$site,$inout};
 195     $site= $newsite if defined $newsite;
 196     next if $site eq '-';
 197     push @{ $news_sources{$site}{$inout} }, $src;
 198 }
 199
 200 our @news_graphs;
 201
 202 foreach my $site (keys %news_sources) {
 203     my $sk= $site;
 204     for (;;) {
 205         last unless $sk =~
 206   s/^[^. ]*\b(?:chiark|greenend|news|nntp|peer|feed|in|out)\b[^.]*\.//;
 207         $sk .= " $&";
 208     }
 209     foreach my $inout (keys %{ $news_sources{$site} }) {
 210         push @news_graphs, [ "$sk $inout", $site, $inout ];
 211     }
 212 }
 213
 214 foreach my $siteinfo (sort { $a->[0] cmp $b->[0] } @news_graphs) {
 215     my ($sortkey, $site, $inout)= @$siteinfo;
 216     my @sources= @{ $news_sources{$site}{$inout} };
 217
 218     my @vals= $inout eq 'out'
 219         ? qw(missing deferred unwanted accepted rejected body_missing)
 220         : qw(accepted refused rejected duplicate
 221              accepted_size duplicate_size);
 222     my @defs;
 223     foreach my $val (@vals) {
 224         my $def= "CDEF:$val=0";
 225         foreach my $si (0..$#sources) {
 226             my $src= $sources[$si];
 227             my $tvar= "${val}_${si}";
 228             push @defs, "DEF:$tvar=$src:$val:AVERAGE";
 229             $def .= ",$tvar,ADDNAN";
 230         }
 231         push @defs, $def;
 232         if ($val =~ m/_size$/) {
 233             push @defs, "CDEF:kb_$`=$val,1024,/";
 234         }
 235     }
 236     graph_of_group("News", $site, $inout,
 237           {
 238                 Units => '[art/s]',
 239                 TimeRanges => [ map { $_*86400 } qw(1 7 31), 366, 366*3 ]
 240             }, $inout eq 'out' ?
 241           [
 242            @defs,
 243            "AREA:accepted#00f:ok",
 244            "AREA:body_missing#ff0:miss:STACK",
 245            "AREA:rejected#f00:rej:STACK",
 246            "AREA:unwanted#aaa:unw:STACK",
 247            "AREA:deferred#ddd:defer:STACK",
 248            ] :
 249           [
 250            @defs,
 251            "AREA:accepted#00f:ok:STACK",
 252            "AREA:rejected#f00:rej:STACK",
 253            "AREA:duplicate#000:dupe:STACK",
 254            "AREA:refused#aaa:unw:STACK",
 255            "CDEF:kb_accepted_smooth=kb_accepted,<interval/60>,TREND",
 256            "LINE:kb_duplicate#ff0:kb dupe",
 257            "LINE:kb_accepted_smooth#008:~kb",
 258            ]);
 259 }
 260
 261 our %disk_rdev2rrd;
 262
 263 foreach my $physdiskrrd (<$R/disk-*/disk_octets.rrd>) {
 264     $physdiskrrd =~ s,octets\.rrd$,, or die;
 265     $physdiskrrd =~ m,-([^/]+)/disk_$, or die;
 266     my $physdev= "/dev/$1";
 267     if (!stat $physdev) {
 268         die "$physdev $!" unless $!==&ENOENT;
 269         next;
 270     }
 271     die "$physdev ?" unless S_ISBLK((stat _)[2]);
 272     $disk_rdev2rrd{(stat _)[6]}= $physdiskrrd;
 273 }
 274
 275 our @disk_vgs;
 276
 277 sub lvgraphs {
 278     my ($vg, $label, $factor, $rcolour, $wcolour) = @_;
 279     my @lvs;
 280     my $varname= $vg;
 281     $varname =~ s/[^0-9a-zA-Y]/ sprintf "Z%02x", ord($&) /ge;
 282     my $vginfo= {
 283         Name => $label,
 284         Varname => $varname,
 285         Colour => { 'read' => $rcolour, 'write' => $wcolour },
 286         Lvs => []
 287     };
 288     foreach my $bo (qw(octets ops)) {
 289         foreach my $rw (qw(read write)) {
 290             $vginfo->{VarDefs}{$bo}{$rw}= [];
 291             $vginfo->{Sumdef}{$bo}{$rw}= '0';
 292         }
 293     }
 294     my $ix=0;
 295     foreach my $lvpath (</dev/$vg/*>) {
 296         my $lv= $lvpath; $lv =~ s,.*/,,;
 297         if (!stat $lvpath) {
 298             die "$lvpath $!" unless $!==&ENOENT;
 299             next;
 300         }
 301         die "$lvpath ?" unless S_ISBLK((stat _)[2]);
 302         my $rrd= $disk_rdev2rrd{(stat _)[6]};
 303         next unless defined $rrd;
 304
 305         my $lvinfo= { Name => $lv };
 306         push @{ $vginfo->{Lvs} }, $lvinfo;
 307
 308         foreach my $bo (qw(octets ops)) {
 309             $lvinfo->{Defs}{$bo}=
 310               [
 311                (map { ("DEF:$_=${rrd}${bo}.rrd:$_:AVERAGE") } qw(read write)),
 312                "CDEF:mwrite=0,write,-",
 313                "AREA:read#00f:read",
 314                "AREA:mwrite#f00:write"
 315                ];
 316
 317             foreach my $rw (qw(read write)) {
 318                 $ix++;
 319                 my $tvar= "lv_${rw}_${bo}_${varname}_${ix}";
 320                 push @{ $vginfo->{VarDefs}{$bo}{$rw} },
 321                     "DEF:$tvar=${rrd}${bo}.rrd:$rw:AVERAGE";
 322                 $vginfo->{Sumdef}{$bo}{$rw} .= ",$tvar,+";
 323             }
 324         }
 325     }
 326     foreach my $bo (qw(octets ops)) {
 327         foreach my $rw (qw(read write)) {
 328             my $defs= [];
 329             push @$defs, @{ $vginfo->{VarDefs}{$bo}{$rw} };
 330             push @$defs, "CDEF:${rw}_vg_${varname}=".
 331                 $vginfo->{Sumdef}{$bo}{$rw}.
 332                 sprintf(",%f,*", $rw eq 'write' ? -$factor : $factor);
 333             $vginfo->{Defs}{$bo}{$rw}= $defs;
 334         }
 335     }
 336     push @disk_vgs, $vginfo;
 337 }
 338
 339 lvgraphs('vg-main',          'main',     1, qw(00f f00));
 340 lvgraphs('vg-chiark-stripe', 'stripe', 0.5, qw(008 800));
 341
 342 foreach my $bo (qw(octets ops)) {
 343     my @a= ();
 344     foreach my $rw (qw(read write)) {
 345         my $stack= '';
 346         foreach my $vginfo (@disk_vgs) {
 347             push @a, @{ $vginfo->{Defs}{$bo}{$rw} };
 348             push @a, "AREA:${rw}_vg_$vginfo->{Varname}#".
 349                 $vginfo->{Colour}{$rw}.
 350                 ":$vginfo->{Name} ".substr($rw,0,1).
 351                 $stack;
 352             $stack= ':STACK';
 353         }
 354     }
 355     graph_of_group('IO', 'IO', $bo, { Units => '[/s]' }, \@a);
 356 }
 357
 358 foreach my $vginfo (@disk_vgs) {
 359     foreach my $bo (qw(octets ops)) {
 360         foreach my $lv (@{ $vginfo->{Lvs} }) {
 361             graph_of_group('IO', "$vginfo->{Name} $lv->{Name}",
 362                            $bo, { Units => '[/s]' }, $lv->{Defs}{$bo});
 363         }
 364     }
 365 }
 366
 367 push @{ $section_groups{General} }, {
 368     Section => 'IO',
 369     Group => 'IO',
 370     UrlParams => "section=IO&sloth=SLOTH"
 371 };
 372
 373 }
 374 #---------- right, that was the initialisation ----------
 375
 376 our $self= url(-relative=>1);
 377
 378 if (param('debug')) {
 379     print "Content-Type: text/plain\n\n";
 380 }
 381
 382 sub source_tarball ($$) {
 383     my ($spitoutfn) = @_;
 384 }
 385
 386 if (path_info() =~ m/\.tar\.gz$/) {
 387     print "Content-Type: application/octet-stream\n\n";
 388
 389     exec '/bin/sh','-c','
 390                 (
 391                  git-ls-files -z;
 392                  git-ls-files -z --others --exclude-from=.gitignore;
 393                  if test -d .git; then find .git -print0; fi
 394                 ) | (
 395                  cpio -Hustar -o --quiet -0 -R 1000:1000 || \
 396                  cpio -Hustar -o --quiet -0
 397                 ) | gzip
 398         ';
 399     die $!;
 400 }
 401
 402 our @navsettings;
 403
 404 @navsettings= ();
 405
 406 sub navsetting ($) {
 407     my ($nav) = @_;
 408     my $var= $nav->{Variable};
 409     $$var= param($nav->{Param});
 410     $$var= $nav->{Default} if !defined $$var;
 411     die $nav->{Param} unless grep { $_ eq $$var } @{ $nav->{Values} };
 412     push @navsettings, $nav;
 413 }
 414
 415 our $section;
 416
 417 navsetting({
 418     Desc => 'Section',
 419     Param => 'section',
 420     Variable => \$section,
 421     Default => $sections[0],
 422     Values => [@sections],
 423     Show => sub { return $_[0]; }
 424 });
 425
 426
 427 sub num_param ($$$$) {
 428     my ($param,$def,$min,$max) = @_;
 429     my $v= param($param);
 430     return $def if !defined $v;
 431     $v =~ m/^([1-9]\d{0,8})$/ or die;
 432     $v= $1;
 433     die unless $v >= $min && $v <= $max;
 434     return $v + 0;
 435 }
 436
 437 our $group= param('graph');
 438
 439 my $defwidth= 370;
 440 my $defheight= 200;
 441
 442 our $elem= param('elem');
 443 if (defined $elem) {
 444     my $g= $graphs{$section,$group,$elem};
 445     die unless $g;
 446
 447     my $width= num_param('w',$defwidth,100,1600);
 448     my $height= num_param('h',$defheight,100,1600);
 449
 450     my $sloth= param('sloth');
 451     die unless defined $sloth;
 452     $sloth =~ m/^(\d+)$/ or die;
 453     $sloth= $1+0;
 454     my $end= $g->{TimeRanges}[$sloth];
 455     die unless defined $end;
 456
 457     my @args= @{ $g->{Args} };
 458     s,\<interval/(\d+)\>, $end/$1 ,ge foreach @args;
 459     unshift @args, qw(--end now --start), "end-${end}s";
 460
 461     my $title= $group;
 462     if (length $elem) { $title.= " $elem"; }
 463
 464     $title .= " $g->{Units}" if $g->{Units};
 465     unshift @args, '-t', $title, '-w',$width, '-h',$height;
 466     unshift @args, qw(-a PNG --full-size-mode);
 467
 468     my $cacheid= "$section!$group!$elem!$sloth!$width!$height!";
 469     $cacheid .= unpack "H*", MD5->hash(join '\0', @args);
 470     my $cachepath= "cache/$cacheid.png";
 471
 472     if (param('debug')) {
 473         print((join "\n",@args),"\n"); exit 0;
 474     }
 475
 476 #print STDERR "||| ",(join ' ', map { "'$_'" } @args)." |||\n";
 477     exec(qw(sh -ec), <<'END', 'x', $cachepath, @args);
 478         p="$1"; shift
 479         rrdtool graph "$p" --lazy "$@" >/dev/null
 480         printf "Content-Type: image/png\n\n"
 481         exec cat "$p"
 482 END
 483     die $!;
 484 }
 485
 486 sub start_page ($) {
 487     my ($title) = @_;
 488     print header(), start_html($title);
 489     my $outerdelim= '';
 490     foreach my $nav (@navsettings) {
 491         print $outerdelim;
 492         print $nav->{Desc}, ": ";
 493         my $delim= '';
 494         my $current= $nav->{Variable};  $current= $$current;
 495         foreach my $couldbe (@{ $nav->{Values} }) {
 496             print $delim;
 497             my $show= $nav->{Show}($couldbe);
 498             if ($couldbe eq $current) {
 499                 print "<b>$show</b>";
 500             } else {
 501                 my $u= $self;
 502                 my $delim2= '?';
 503                 foreach my $nav2 (@navsettings) {
 504                     my $current2= $nav2->{Variable};  $current2= $$current2;
 505                     $current2= $couldbe if $nav2->{Param} eq $nav->{Param};
 506                     next if $current2 eq $nav2->{Default};
 507                     $u .= $delim2;  $u .= "$nav2->{Param}=$current2";
 508                     $delim2= '&';
 509                 }
 510                 print a({href=>$u}, $show);
 511             }
 512             $delim= ' | ';
 513         }
 514         $outerdelim= "<br>\n";
 515     }
 516     print "\n";
 517
 518     print h1("$title");
 519 }
 520
 521 our $detail= param('detail');
 522 if (defined $detail) {
 523     my $elems= $group_elems{$section,$detail};
 524     die unless $elems;
 525     start_page("$detail - $section - graphs");
 526     foreach my $tsloth (0..5) {
 527         foreach my $elem (@$elems) {
 528             my $g= $graphs{$section,$detail,$elem};
 529             die unless $g;
 530             next if $tsloth >= @{ $g->{TimeRanges} };
 531             my $imgurl= "$self?graph=$detail&section=$section".
 532                 "&sloth=$tsloth&elem=$elem";
 533             print a({href=>"$imgurl&w=780&h=800"},
 534                     img({src=>$imgurl, alt=>'',
 535                          width=>$defwidth, height=>$defheight}));
 536         }
 537     }
 538     print end_html();
 539     exit 0;
 540 }
 541
 542 our $sloth;
 543
 544 navsetting({
 545     Desc => 'Time interval',
 546     Param => 'sloth',
 547     Variable => \$sloth,
 548     Default => 1,
 549     Values => [0..3],
 550     Show => sub {
 551         my ($sl) = @_;
 552         return ('Narrower', 'Normal', 'Wider', 'Extra wide')[$sl];
 553     }
 554 });
 555
 556 if (param('debug')) {
 557     use Data::Dumper;
 558     print Dumper(\%graphs);
 559     exit 0;
 560 }
 561
 562 start_page("$section - graphs");
 563
 564 foreach my $group (@{ $section_groups{$section} }) {
 565     my $ref_group= $group;
 566     my $ref_section= $section;
 567     my $ref_urlparams= "detail=$group&section=$section";
 568     if (ref $group) {
 569         $ref_group= $group->{Group};
 570         $ref_section= $group->{Section};
 571         $ref_urlparams= $group->{UrlParams};
 572         $ref_urlparams =~ s/\bSLOTH\b/$sloth/;
 573     }
 574     print a({href=>"$self?$ref_urlparams"});
 575     my $imgurl= "$self?graph=$ref_group&section=$ref_section";
 576     print "<span style=\"white-space:nowrap\">";
 577     my $elems= $group_elems{$ref_section,$ref_group};
 578     foreach my $elem (@$elems) {
 579         my $g= $graphs{$ref_section,$ref_group,$elem};
 580         print img({src=>"$imgurl&elem=$elem&sloth=".($sloth + $g->{Slower}),
 581                    alt=>'', width=>$defwidth, height=>$defheight});
 582     }
 583     print "</span>";
 584     print "</a>\n";
 585 }
 586
 587 my $homeurl =
 588     'http://www.chiark.greenend.org.uk/ucgi/~ijackson/git/rrd-graphs/';
 589 print <<END
 590 <hr>Generated by "<a href="$homeurl">rrd-graphs</a>".
 591 Copyright 2010,2012 Ian Jackson.  There is <strong>NO WARRANTY</strong>.
 592 Available under the Affero Public General Licence, version 3 or any
 593 later version.  You may download the
 594 <a href="$self/rrd-graphs.tar.gz">source code</a>
 595 for the version currently running here.
 596 END