#!/usr/bin/perl -w
##
# vmstat.cgi: First snapshot
# perl script for generating xhtml + svg + javascript
# for dynamic graphics rendering
#
# (C) 2008-2012 Felix Hauri - mailto:vmstatcgi@f-hauri.ch - www.f-hauri.ch
# This script is released under term of LGPL V3 or higher.
#
# TODO:
# - Cleaning
# - Create structured modules for graphics and functions
# - calculating top graphics as rounded values
# - create bingind for drag'n drop scale and offset for
#   x (time) and y (value) positioning.
#
use vars qw(%VERSION $DEBUG $IO_CONSTANTS);
($VERSION{"name"},$VERSION{"number"},$VERSION{"date"},$VERSION{"user"})=($1,$2,$3,$4) if
    '$Id: vmstat.pl,v 0.07 2009-05-06 14:58:52 felix Exp $ ' =~
    /Id:\s(.+),v\s([0-9a-z.-]+)\s([0-9\/-]+\s[0-9:]+)\s([a-z0-9_-]+)\sExp/; # CVS Version
##
use strict;
use POSIX     qw|strftime LC_TIME setlocale|;
use CGI       qw|:standard :html3|;
use CGI::Pretty;
use Socket;
use IO::Handle;
use Getopt::Std;

$|=1;
my $q=new CGI;
my %grafsize=( 'width' => 300, 'height' => 25 );
my $delay=1;
my $tcpport=8881;
my %opts;
getopt('pwdl',\%opts );
(my $progname=$0) =~ s/^.*[\/]//g;

sub syntax {
    printf <<eof
Usage: %s [-h] [-q] [-d delay] [-p port] [-w width] [-l length]
Version: %s v%s - (%s).
    -h        This help.
    -q        Quiet.
    -d delay  Delay for command vmstat, in secs.
    -p port   TCP Port for standalone server mode.
    -w width  Width of graphics, in mesurement points.
    -l length Length of graphics, in proportional value to Width.
    -x        dump xhtml on STDOUT for debug.
eof
,$progname,$VERSION{'name'},$VERSION{'number'},$VERSION{'date'};
    exit 0;
};

my $runmode;
my ($memtot,$swaptot);
my @origrows=qw |r b swpd free buff cach si so bi bo int cs us sy idl wa|;
my %lines=('line-mem-swpd' => { 'col'=>'#FF0' , 'op'=>'1' },
	   'line-mem-free' => { 'col'=>'#3F4' , 'op'=>'1' },
	   'line-mem-buff' => { 'col'=>'#3FF' , 'op'=>'1' },
	   'line-mem-cach' => { 'col'=>'#44F' , 'op'=>'1' },
	   'line-swap-i'   => { 'col'=>'#BB4' , 'op'=>'.5' },
	   'line-swap-o'   => { 'col'=>'#4BB' , 'op'=>'.5' },
	   'line-disk-i'   => { 'col'=>'#BB4' , 'op'=>'.5' },
	   'line-disk-o'   => { 'col'=>'#4BB' , 'op'=>'.5' },
	   'line-sys-int'  => { 'col'=>'#E44' , 'op'=>'.5' },
	   'line-sys-cs'   => { 'col'=>'#44E' , 'op'=>'.5' },
	   'line-cpu-wa'   => { 'col'=>'#EE4' , 'op'=>'1' },
	   'line-cpu-us'   => { 'col'=>'#E44' , 'op'=>'1' },
	   'line-cpu-sy'   => { 'col'=>'#EB4' , 'op'=>'1' });
my @texts=map { sprintf "txt-%s",$_; } qw | sfre stot suse   sy-mc sy-mi   total   use   count |;
map {
    push @texts, sprintf "txt-%s",$_;
    push @texts, sprintf "txt-m%s",$_;
} @origrows;

sub colorblock {
    my ($ref)=@_;
    $ref='line-'.$ref;
    return sprintf "<svg:svg xmlns:svg=\"http://www.w3.org/2000/svg\" width=\"20\" height=\"10\">".
	"<svg:rect x=\"0\" y=\"0\" width=\"20\" height=\"10\"".
	" style=\"fill:%s;opacity:%s\" /></svg:svg>",$lines{$ref}{'col'},$lines{$ref}{'op'};
};

sub graf {
    my @slnes=@_;
    my $out=sprintf "<svg:svg xmlns:svg=\"http://www.w3.org/2000/svg\" ".
	"version=\"1.1\" viewBox=\"0 0 %d %d\">\n    <svg:rect x=\"0\" ".
	"y=\"0\" width=\"%d\" height=\"%d\" fill=\"#DDD\" stroke=\"#666\"/>\n",
	$grafsize{'width'}+2,$grafsize{'height'}+2,
	$grafsize{'width'}+2,$grafsize{'height'}+2;
    map {
	$out.=sprintf 
	    "    <svg:polyline id=\"%s\" points=\"0,%d 0,%d\" fill=\"%s\" ".
	    "fill-opacity=\"%s\" stroke=\"none\" transform=\"translate(1,1)\"/>\n",
	    $_,$grafsize{'height'},$grafsize{'height'},$lines{$_}{'col'},$lines{$_}{'op'};
    } @slnes;
    map {
	/^(\.\d+)(\.\d+)?$/ && do {
	    my ($hpos,$sw)=($1,$2);
	    $sw=.1 unless defined $sw;
	    $out.=sprintf
		"    <svg:line x1=\"0\" y1=\"%s\" x2=\"%d\" y2=\"%s\" ".
		"stroke-width=\"%spx\" stroke=\"#333\" stroke-opacity=\".5\"/>\n",
		1+$grafsize{'height'}*$hpos,$grafsize{'width'}+2,
		1+$grafsize{'height'}*$hpos,$sw;
	};
    } qw|.25 .5.2 .75|;
    map {
	/^(\.\d+)(\.\d+)?$/ && do {
	    my ($vpos,$sw)=($1,$2);
	    $sw=.1 unless defined $sw;
	    $out.=sprintf
		"    <svg:line x1=\"%s\" y1=\"0\" x2=\"%s\" y2=\"%d\" ".
		"stroke-width=\"%spx\" stroke=\"#333\" stroke-opacity=\".5\"/>\n",
		1.0+$grafsize{'width'}*$vpos, 1.0+$grafsize{'width'}*$vpos,
		$grafsize{'height'}+2,$sw;
	};
    } qw|.2 .4 .6 .8 .1.05 .3.05 .5.05 .7.05 .9.05|;
    return $out."</svg:svg>\n";
};

sub txtdraw {
    my ($div,$content)=@_;
    return sprintf "        this.%s.innerHTML=%s;\n",$div,$content;
#    return sprintf "        var text = document.createTextNode(%s)\n".
#	"        this.%s.replaceChild(text,this.%s.firstChild);\n",$content,$div,$div;
}
sub allval {
    my ($name)=@_;
    return txtdraw('txt_'.$name,'last_time.'.$name).
	txtdraw('txt_m'.$name,
		sprintf('" [ "+min_%s+" | "+(moy_%s/datacount).toFixed(2)+" | "+max_%s+" ] "',
			$name,$name,$name));
};
sub grdraw {
    my ($pnt,$formul)=@_;
    return sprintf "            var pnt = this.height - %s * this.height;\n".
	"            %s += ' ' + i + ',' + pnt + ' ' + (i+1) + ',' + pnt;\n", $formul, $pnt;
}
sub jscript {
    my @elements=@_;
    # UptimeData -> push vals in array
    # UptimeDisplay -> page object
    my $i=0;
    my $out="function UptimeData(str) {\n    var data = str.split(' ');\n    ".
	join("\n    ",map { sprintf "this.%s = parseFloat(data[%d]);", $_, $i++; } @origrows)."\n".
	"    if (datacount++ == 0) {\n        ".
	join("\n        ",map { sprintf "min_%s = this.%s;",$_,$_;  } @origrows )."    };\n    ".
	join("\n    ",map { sprintf ("if (this.%s > max_%s) max_%s = this.%s;",$_,$_,$_,$_),
			    sprintf ("if (min_%s > this.%s) min_%s = this.%s;",$_,$_,$_,$_),
			    sprintf ("moy_%s += this.%s;",$_,$_) } @origrows
	     ).
	     sprintf "\n}\nfunction UptimeDisplay() {\n    this.width = %d;\n    this.height = %d;\n    ".
	"this.table = new Array();\n", $grafsize{'width'}, $grafsize{'height'};
    map {
	my $elem=$_;
	tr|-|_|;
	$out.=sprintf "    this.%s = document.getElementById('%s')\n",$_,$elem;
    } @elements;
    $out.="    this.push = function (uptime) {\n        this.table.push(uptime);\n        ".
	"if (this.table.length > this.width) {\n            this.table.shift();\n        }\n    }\n";
    $out.="    this.draw_text = function() {\n        var last_time = this.table[this.table.length - 1];\n";
#    map { $out.=allval($_) } qw|swpd int cs idl wa us sy bo bi so si|;
    map { $out.=allval($_) } @origrows;
    $out.=txtdraw('txt_use','Math.abs(100-last_time.free*100/memtot).toFixed(2)+"%"').
	txtdraw('txt_sfre','(swaptot-last_time.swpd)+" Kb"').
	txtdraw('txt_suse','Math.abs(last_time.swpd*100/swaptot).toFixed(2)+"%"').
	txtdraw('txt_count','datacount+" -&gt; "+Date(startdate + 1000*datacount)').
	"    }\n    this.draw_graph = function() {\n";
    map {
	tr|-|_|;
	s/^line/point/;
	$out.=sprintf "        var %s = '0,' + this.height;\n",$_;
    } keys %lines;
    $out.="        for (var i = 0; this.table.length  > i ; ++i) {\n".
        grdraw('point_mem_swpd','this.table[i].swpd / swaptot').
        grdraw('point_mem_free','( this.table[i].free + this.table[i].buff + this.table[i].cach ) / memtot').
        grdraw('point_mem_buff','( this.table[i].buff + this.table[i].cach ) / memtot').
        grdraw('point_mem_cach','this.table[i].cach / memtot').
        grdraw('point_cpu_wa','( this.table[i].sy + this.table[i].us + this.table[i].wa ) / 100').
        grdraw('point_cpu_us','( this.table[i].sy + this.table[i].us ) / 100').
        grdraw('point_cpu_sy','this.table[i].sy / 100').
        grdraw('point_sys_int','this.table[i].int / max_int').
        grdraw('point_sys_cs','this.table[i].cs / max_cs').
        grdraw('point_swap_i','this.table[i].si / max_si').
        grdraw('point_swap_o','this.table[i].so / max_so').
        grdraw('point_disk_i','this.table[i].bi / max_bi').
	grdraw('point_disk_o','this.table[i].bo / max_bo')."        }\n";
    map { 
	tr|-|_|;
	my $line=$_;
	s/^line/point/;
	$out.= sprintf "        %s += ' ' + i + ',' + this.height + ' 0,' + this.height;\n        this.%s".
	    ".setAttribute('points', %s);\n", $_, $line,$_;
	  $_ } keys %lines;
    $out.="        }\n    this.draw = function() { this.draw_graph(); this.draw_text(); }\n}\n".
	"function onup(str) {\n    uptime_display.push(new UptimeData(str));\n    uptime_display.draw();\n".
	"    stream_elm.removeChild(stream_elm.lastChild);\n}\nvar uptime_display;\nvar stream_elm;\nvar memtot;\n".
	"var swaptot;\nvar cmdkey;\nvar delay;\nvar datacount=0;\nvar startdate=new Date('".
        strftime("%c",localtime())."')\n";
    map { $out.=sprintf "var max_%s=0;\nvar min_%s=-1;\nvar moy_%s=0;\n",$_,$_,$_;} @origrows;
    $out.="function initvars(memt,swapt,sk,interval) {\n    memtot = memt;\n    swaptot = swapt;\n    cmdkey = sk;\n".
	"    delay = interval;\n    uptime_display = new UptimeDisplay();\n    stream_elm = ".
	"document.getElementById('stream');\n    stream_elm.removeChild(stream_elm.lastChild);\n    var ".
	"text=document.createTextNode(memtot+' Kb');\n    var txttot=document.getElementById('txt-total');".
	"\n    txttot.replaceChild(text,txttot.firstChild);\n    text=document.createTextNode(swaptot+' Kb');\n".
        "    txttot=document.getElementById('txt-stot');\n    txttot.replaceChild(text,txttot.firstChild);\n".
	"    text=document.createTextNode(document.location.toString().split('/')[2]);\n    txttot=".
	"document.getElementById('host');\n    txttot.replaceChild(text,txttot.firstChild);\n}\n";
    $out.="function chng() {\n    var delay=document.getElementById('delay').value;\n".
	"    var width=document.getElementById('width').value;\n".
	"    var height=document.getElementById('height').value;\n".
	"    window.location = '".do{ $runmode =~ /CGI/ ? $q->url() : "http://localhost:".$tcpport."/".$progname }.
	"?delay='+delay+'\&width='+width+'\&height='+height; };\n";
    return $out;
};

sub falllab {
    my %vals=@_;
    return map { $vals{$_}." ".colorblock($_)} keys %vals;
}
sub fallval {
    my $out;
    while (my $item=shift) {
	$out.=th({-id=>"txt-".$item},"..").td({-align=>"center",-id=>"txt-m".$item },"..");
    };
    return $out;
};

sub dumphtml {
    my $rmode=shift;
    (my $pathname=$q->script_name) =~  s/[^\/]*$//g;
    my $expiretime=strftime("%a, %d %b %Y %T %Z",localtime(time()+2592000));
    my @cookies;
    map { push @cookies, $q->cookie(-name=>$1, -value=>$2,-expires=>$expiretime,-path=>$pathname) if /^(.*):(.*)$/;
	  } ("delay:".$delay,"width:".$grafsize{'width'},"height:".$grafsize{'height'});
    (my $start=start_html(-title=>"VMStat",-encoding=>"utf-8",-script=>jscript(@texts,keys %lines),
			  -style=>{-type=>'text/css',
				   -code=>"body { margin: 0; padding: 0 }\ntd,th,span.host { background: #EEE }\n"
				    })
     ) =~ s/^(<!--\/\* <!\[CDATA\[ \*\/|\/\* \]\]> \*\/-->|)$//gms;
    
    return join "",header(-type=>"text/xml",-charset=>"utf-8", -cache_control=>"no-cache",-cookie=>\@cookies),
    $start,
    h3('Statistic on '.span({-id=>"host",-class=>"host"},$q->virtual_host)),"Started: ".strftime("%c",localtime()),
    " Points:".span({-id=>"txt-count"},"..")," ",br(),
    table(TR([th([" Values presentation ","Delay" , "Points (Width)", "Height (Length)"]),
	      td([" [ Minimum | Average | Maximum ]",
		  textfield(-size=>"4",-name=>"delay",-id=>"delay",-value=>$delay,-onchange=>"chng()"),
		  textfield(-size=>"5",-name=>"width",-id=>"width",-value=>$grafsize{'width'},-onchange=>"chng()"),
		  textfield(-size=>"5",-name=>"height",-id=>"height",-value=>$grafsize{'height'},-onchange=>"chng()")])])),
    p('(c) 2008-2009 '.a({-href=>"http://f-hauri.ch/"},"F.Hauri").' - Run in '.b($rmode).' mode. '.
      a({-href=>$q->script_name."/download/".$progname},"[download $progname]")),b("Process"),
	table({-width=>"100%"},TR(th({-colspan=>2},[qw|R B|])),TR(fallval qw|r b|)).br(),
	b("Mem"),br(),     graf("line-mem-free","line-mem-buff","line-mem-cach").br(),
	table({-width=>"100%"},
	      TR(th("Total"),th({-colspan=>2},falllab("mem-free"=>"Free")),th("Use"),
		 th({-colspan=>2},["Buffered ".colorblock("mem-buff"),"Cached ".colorblock("mem-cach")])),
	      TR(td({-align=>"center",-id=>"txt-total"},".."),fallval("free"),td({-align=>"center",-id=>"txt-use"},".."),
		 fallval(qw|buff cach|))),"\n",
	b("Swap"),br(),    graf("line-mem-swpd").br(),
	table({-width=>"100%"},
	      TR(th([qw|Total Free|]),th({-colspan=>3},"Use ".colorblock("mem-swpd"))),
	      TR (do {my @out=map { td({-align=>"center",-id=>$_ },"...") } qw|txt-stot txt-sfre txt-suse|;
		      push @out,fallval "swpd"; @out; })),"\n",
    b("Swap IO"),br(), graf("line-swap-i","line-swap-o"),br(),
    table({-width=>"100%"},
	  TR(th({-colspan=>2},["In ".colorblock("swap-i"),"Out ".colorblock("swap-o")])),
	  TR (fallval qw|si so|)),"\n",
    b("Disks IO"),br(),graf("line-disk-i","line-disk-o"),br(),
    table({-width=>"100%"},
	  TR(th({-colspan=>2},["In ".colorblock("disk-i"),"Out ".colorblock("disk-o")])),
	  TR (fallval qw|bi bo|))."\n",
    b("System"),br(),  graf("line-sys-int","line-sys-cs"),br(),
	table({-width=>"100%"},
	      TR(th({-colspan=>2},["Interrupts ".colorblock("sys-int"),"ContextSwitch ".colorblock("sys-cs")])),
	      TR(fallval qw|int cs|))."\n",
    b("CPU").br(),     graf("line-cpu-wa","line-cpu-us","line-cpu-sy"),br(),
    table({-width=>"100%"},
	  TR(th({-colspan=>2},["System ".colorblock("cpu-sy"),"User ".colorblock("cpu-us"),"Wait ".colorblock("cpu-wa"),"Idle"])),
	  TR(fallval qw|sy us wa idl|))."\n",
    p({-align=>"right"},b($VERSION{'name'})." v".$VERSION{'number'}.
      " last modification: ".$VERSION{'date'}),
	$q->start_div({-id=>"stream",-style=>"display:none"}).
	script({-language=>"javascript"},
	       sprintf("initvars(%u,%u,%d)",$memtot,$swaptot,$delay));
};

sub datadump {
    my $handler=shift;
    my $pid=open FH,"vmstat -n $delay|" or die;
    $SIG{'PIPE'}=$SIG{'HUP'}=$SIG{'INT'}=$SIG{'QUIT'}=$SIG{'ABRT'}=$SIG{'TERM'}=$SIG{'KILL'}=$SIG{'ALRM'}=sub
    {
	kill "INT",$pid;
	exit 0;
    };
    autoflush $handler 1;
    while (<FH>) {
	/^\s*\d+\s+\d+\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/ && do {
	    s/^\s*//g;
	    s/\s+/ /g;
	    s/\s*$//g;
	    $handler->print(sprintf
			    "<script language=\"javascript\">onup(\"%s\")</script>\n",
			    $_);
	};
    };
}

open MEM,"/proc/meminfo" or die;
while (<MEM>) {
    $memtot=$1 if /^MemTotal:\s+(\d+)\s/;
    $swaptot=$1 if /^SwapTotal:\s+(\d+)\s/;
}
close MEM;
die unless defined $memtot and defined $swaptot;

# printf STDERR "THIS: %s\n",join(",",keys %ENV);

if (defined $ENV{'SCRIPT_NAME'}) {
    $runmode=' CGI ';
    if (defined $ENV{'PATH_INFO'} && $ENV{'PATH_INFO'} =~ /download/) {
	print header("text/plain").`cat $0`;
    } else {
	$grafsize{'width'}=$1 if defined $q->cookie('width') && $q->cookie('width')
	    =~ /^(\d+)$/ && $1 > 4 && 2000 > $1;
	$grafsize{'width'}=$1 if defined param('width') && (param('width') =~ /^(\d+)$/) && $1 > 4 && 2000 > $1;
	$grafsize{'height'}=$1 if defined $q->cookie('height') && $q->cookie('height')
	    =~ /^(\d+)$/ && $1 > 4 && 2000 > $1;
	$grafsize{'height'}=$1 if defined param('height') && (param('height') =~ /^(\d+)$/) && $1 > 0 && 2000 > $1;
	$delay=$1 if defined $q->cookie('delay') && 
	    $q->cookie('delay') =~ /^(\d{1,3})$/ && $1 > 0 && 1000 > $1;
	$delay=$1 if defined param('delay') && (param('delay') =~ /^(\d{1,3})$/) && $1 > 0 && 1000 >$1;
	print dumphtml(" CGI ");
	my $io = new IO::Handle;
	if ($io->fdopen(fileno(STDOUT),"w")) {
	    datadump($io);
	};
    };
} else {
    $runmode='StandAlone';
    $grafsize{'width'}=$1 if defined $opts{'w'} && $opts{'w'} =~ /^(\d+)$/ && $1 > 4 && 2000 > $1;
    $grafsize{'height'}=$1 if defined $opts{'l'} && $opts{'l'} =~ /^(\d+)$/ && $1 > 0 && 2000 > $1;
    $tcpport=$1 if defined $opts{'p'} && $opts{'p'} =~ /^(\d+)$/ && $1 > 1 && 65536 > $1;
    $delay=$1 if defined $opts{'d'} && $opts{'d'} =~ /^(\d+)$/ && $1 > 0 && 1000 > $1;
    syntax() if defined $opts{'h'};
    if ( defined $opts{'x'} ) { print dumphtml("Debug"); exit 0; };
    my ($name, $aliases, $proto) = getprotobyname('tcp');
    my $sockaddr = 'S n a4 x8';
    my $thisport = pack($sockaddr, &AF_INET, $tcpport, "\0\0\0\0");
    socket(SOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket $!\n";
    setsockopt(SOCK, &SOL_SOCKET, &SO_REUSEADDR, pack('i', 1)) || die "setsockopt $!\n";
    bind(SOCK,$thisport) || die "can't bind socket: $!\n";
    listen(SOCK,5) || die "can't listen to socket: $!\n";
    printf "Server started at port %d\n",$tcpport unless defined $opts{'q'};
    while ( 1==1 )  {	
	if (accept(NS,SOCK)) {
	    defined(my $pid = fork) or die "Can't fork";
	    if ($pid) {
		printf "Connection started (forked to %d)\n",$pid unless defined $opts{'q'};
		close NS;
	    } else {
		my $req="";
		while ( ($_=<NS>) !~ /^\r?$/) {$req.=$_};
		printf STDERR "IN: %s\n",$req unless defined $opts{'q'};
		if ($req=~/download/) {
		    syswrite NS, "HTTP/1.1 200 OK\r\n".header("text/plain").`cat $0`;
		    close NS;
		} else {
		    $delay=$1 if $req=~/^Cookie.*\sdelay=(\d+)\s*(|;.*)$/msx    && $1 > 0 && 1000 > $1;
		    $delay=$1 if $req=~/GET.*[\?\&]delay=(\d+)(|\&.*)\sHTTP/msx && $1 > 0 && 1000 > $1;
		    $grafsize{'width'}=$1 if $req=~/^Cookie.*\swidth=(\d+)\s*(|;.*)$/msx   && $1 > 4 && 1000 > $1;
		    $grafsize{'width'}=$1 if $req=~/GET.*[\?\&]width=(\d+)(|\&.*)\sHTTP/msx && $1 > 4 && 2000 > $1;
		    $grafsize{'height'}=$1 if $req=~/^Cookie.*\sheight=(\d+)\s*(|;.*)$/msx    && $1 > 0 && 1000 > $1;
		    $grafsize{'height'}=$1 if $req=~/GET.*[\?\&]height=(\d+)(|\&.*)\sHTTP/msx && $1 > 0 && 2000 > $1;
		    syswrite NS, "HTTP/1.1 200 OK\r\n".dumphtml("StandAlone");
		    my $io = new IO::Handle;
		    if ($io->fdopen(fileno(NS),"w")) {
			datadump($io);
		    };
		};
	    };
	};
    };
};