#!/usr/bin/perl -w
# 
# $Id:  $

=head1 NAME

beanc.pl - OpenVZ's User Bean Counter archiver

=head1 SYNOPSYS

beanc.pl [-fiIn] [ show [VE] | brief [VE] | tiny [VE] | init |
reset [VE [varname] ] ]

=head1 DESCRIPTION

This script is intended to check the failcounts in /proc/user_beancounters
on a OpenVZ machine. Since there is no way to reset fail-counters,
all fail-counters are stored in a cache file and delta is computed
before output.

Without argument, this dump all I<B<failcnt> greater then zero> with
a banner showing the ID, name, hostname, IP and a count of failed
variables from boot or from last I<reset> command.

Even, without argument, this will output nothing if there is
no failed counter (from boot or from last I<reset> command).

=head1 LICENSE

By using this script you agree there are absolutely no limitations on using
it. Of course there are also absolutely no guarantees. Please review the code
to make sure it will work for you as expected.

Feel free to distribute and/or modify the script.

Only thing I will not appreciate is that you change my name into yours, and
act like you wrote this script. But hey, why would you do that ?
And how will I ever know ?

If you make changes, decide to distribute the script or feel the urge to
give me feedback, please let me know.

=head1 AUTHORS

Written by Felix Hauri, 12/12/2011. beanc@f-hauri.ch

This script is a perl version inspired by 

``beanc.sh'', written by Steven Broos, 7/7/2011 - Steven@Bit-IT.be

=head1 INSTALLATION

This script could be used as is, but could even be well installed:

=over 4

=item 1. Put the file to a location in your path:

=over 6

=item mv beanc.pl /usr/local/sbin/

=back

=item 2. Make sure the file can be executed

=over 6

=item chmod 500 /usr/local/sbin/beanc.pl

=back

=item 3. Put then man page at a well choosed location, example:

=over 6

=item mkdir -p /usr/local/man/man8

=item pod2man /usr/local/sbin/beanc.pl |
    gzip >/usr/local/man/man8/beanc.pl.8.gz

=back

=item 4. Use the script ;-)

Note that the script is written for intended use by root, and on the
OpenVZ host system

=back

=head1 OPTIONS

There are some switch to affect the processus:

=over 4

=item B<-f> force - Don't ask before resetting all variables

=item B<-n> nocache - Display raw values without computing cache

=item B<-i> IOACCT - Take IOACCT file too, but mark solicited counters
with a plus sing (``+'') instead of a star (``*'') as for real
B<fail>-counters.

=item B<-I> IOACCT Only - Don't compute UserBeanCounter, but only IOACCT Files.

=back

=head1 HOW THIS WORK

=head2
1. Initialitation (facultative)

I<beanc.pl [-i] init>

This will create and initialise cache only if they not exist.
The cache file, located in /var/cache/beanc and named ``cache''
contain fail-counters for all running VE.
If this file don't exist, the ``init'' command would create
one filled by ``0''.

Don't forget de I<-i> modifier if you plan to work with
ioacct files.

=head2
2. Show the fails

I<beanc.pl [-iIn] [brief [VE]]>

Without arguments, or with ``brief'' as command argument, a dump
of all recently-failled counters, with a title banner is made.
If ``VE'' is specified, only this container will by dumped.

Even nothing could by displayed if there is no recent fails.

VE could by specified by his id, name, hostname or ip address.

=over 4

=item beanc.pl

=item beanc.pl brief

=item beanc.pl -i brief

=item beanc.pl -n brief

=back

Show all recent fails in all VEs... or nothing.
With or without ioacct files values. 
With or without cached values.

=over 4

=item beanc.pl brief 123

=item beanc.pl brief mailserver

=item beanc.pl brief 192.168.1.7

show all recent fails for VE ID=123, NAME or HOSTNAME=mailserver,
than IP_ADDRESS=192.168.1.7.

=back

=head2
3. Small output

I<beanc.pl tiny [-iIn] [VE]>

As brief, only show recently failed counters, but without banner and
only the computed fail counter value, in one-value-per line format.

=over 4

=item beanc.pl tiny

Without parameter, this show all failed counter in format:

<veid> <variable name> <computed fail counter>

=back

=over 4

=item beanc.pl tiny 123

=item beanc.pl tiny mailserver

=item beanc.pl tiny 192.168.1.7

With any specified VE as argument, show only variable name and counter

<variable name> <computed fail counter>

=back

=head2
4. Dump of all counters

I<beanc.pl show [-iIn] [VE]>

This will dump current state of all values even with no fails. (fail
counters are computed with cache)

=over 4

=item beanc.pl show

dump all counters for all VEs.

=back

=over 4

=item beanc.pl show 123

=item beanc.pl show mailserver

=item beanc.pl show 192.168.1.7

dump all counters for VE ID=123, NAME or HOSTNAME=mailserver,
than IP_ADDRESS=192.168.1.7.

=back

=head2
5. To reset the failcounters

I<beanc.pl reset [-fiI] [VE] [variable]>

this ``reset'' failcounter in storing current value in cache.
If not exist, cachedir and cachefile woud by created, as ``init'' do.

=over 4

=item beanc.pl reset

to reset ALL variables in ALL VEs. (to be confirmed by ``y'').

=back

=over 4

=item beanc.pl reset 123

=item beanc.pl reset mailserver

=item beanc.pl reset 192.168.1.7

to reset ALL variables in specified container. (no confirm).

=back

=over 4

=item beanc.pl reset 123 kmemsize

=item beanc.pl reset mailserver kmemsize

=item beanc.pl reset 192.168.1.7 kmemsize

to reset ``kmemsize'' fails counter in specified container.

=back

=head1 SEE ALSO

L<proc>

=cut

use strict;
use 5.010;
use bigint;
use Time::HiRes qw|time|;
use Getopt::Std;
use Data::Dumper qw(Dumper);
$Data::Dumper::Terse = 1;
$Data::Dumper::Purity = 1;

my %opt;
getopts('fiInW',\%opt);


my $cfg={
    "resourcefile"  => "/proc/bc/resources",
    "cachedir"      => "/var/cache/beanc",
    "cachefile"     => "cache.gz",
    "configdir"     => "/etc/vz/conf",
    "configfile"    => "config.gz",
    "fieldsize"     => "19"
};

open my $ubc, "<" .$cfg->{'resourcefile'}  or die;
my %VEs;

sub initConfigVars {
    if (-f $cfg->{'cachedir'}."/".$cfg->{'configfile'}) {
	open my $hcfg, do{$cfg->{'configfile'}=~/.gz$/?"gunzip ":""}.
	    "<".$cfg->{'cachedir'}."/".$cfg->{'configfile'}.
	    do{$cfg->{'configfile'}=~/.gz$/?"|":""} or die;
	my $configstring;
	$configstring.=$_ while <$hcfg>;
	close $hcfg;
	eval '$cfg='.$configstring;
    } else {
	seek $ubc,0,0;
	my $crtcnt;
	while (<$ubc>) {
	    ($cfg->{'fieldsize'},$crtcnt)=(length $1,1) if
		/^\s+0:\s+kmemsize\s+\d+\s+\d+\s+(\d+)\s/;
	    $crtcnt=undef if /^\s*(\d+):\s/ && $1 > 0;
	    if ($crtcnt) {
		s/^\s*\d+://;
		push @{$cfg->{'ubcvars'}},$1 if
		    /^\s*(\S+)\s+\d+.*$/;
	    };
	};
	open my $ioacct, "</proc/bc/0/ioacct" or die;
	while ( my $ioacctline = <$ioacct> ) {
	    push @{$cfg->{'ioacctvars'}} , $1
		if $ioacctline =~ /^\s*(\S+)\s+\d+\s*$/;
	};
	close $ioacct;
	open my $ut,"</proc/uptime" or die;
	do {
	    no bigint;
	    $cfg->{'uptime'}=time-$1 if <$ut>=~/^(\S+)\s/;
	};
	close $ut;
    };
    $cfg->{'lastrun'}=time;
};
sub writeCfgCache {
    mkdir $cfg->{'cachedir'} unless -d $cfg->{'cachedir'};
    open my $hcfg,do{$cfg->{'configfile'}=~/.gz$/?"| gzip ":""}.
	">".$cfg->{'cachedir'}."/".$cfg->{'configfile'} or die;
    (my $cachecfgstr=Dumper($cfg)) =~ s/>\s*(\d+)\s*($|,)/> '$1'$2/mg;
    print $hcfg $cachecfgstr;
    close $hcfg;
};
sub initCache {
    foreach my $cnt ( keys %VEs ) {
	($VEs{$cnt}->{'varFCnt'},$VEs{$cnt}->{'varCCnt'})=('0','0');
	foreach my $var ( @{$cfg->{'ubcvars'}} ) {
	    $VEs{$cnt}->{$var}->{"time"}=$cfg->{'uptime'};
	    $VEs{$cnt}->{$var}->{"cachefail"}='0';
	    $VEs{$cnt}->{'varFCnt'}++ if
		$VEs{$cnt}->{$var}->{"diffcache"}=
		$VEs{$cnt}->{$var}->{"failcnt"};
	};
	foreach my $var ( @{$cfg->{'ioacctvars'}} ) {
	    $VEs{$cnt}->{$var}->{"time"}=$cfg->{'uptime'};
	    $VEs{$cnt}->{$var}->{"cachecount"}='0';
	    $VEs{$cnt}->{'varCCnt'}++ if
		$VEs{$cnt}->{$var}->{"diffcache"}=
		$VEs{$cnt}->{$var}->{"counter"};
	};
    };
}
sub readCache {
    if (-f $cfg->{'cachedir'}."/".$cfg->{'cachefile'}) {
	open my $hca, do{$cfg->{'cachefile'}=~/.gz$/?"gunzip ":""}.
	    "<".$cfg->{'cachedir'}."/".$cfg->{'cachefile'}.
	    do{$cfg->{'cachefile'}=~/.gz$/?"|":""} or die;
	while (my $hcal=<$hca>) {
	    $hcal=~/^(\d+)=(.*)$/ && do {
		my ($cnt,@vals)=($1,split(",",$2));
		($VEs{$cnt}->{'varFCnt'},$VEs{$cnt}->{'varCCnt'})=('0','0');
		foreach my $var ( @{$cfg->{'ubcvars'}} ) {
		    $VEs{$cnt}->{$var}->{"time"}=shift @vals;
		    $VEs{$cnt}->{$var}->{"cachefail"}=shift @vals;
		    $VEs{$cnt}->{'varFCnt'}++ if
			( $VEs{$cnt}->{$var}->{"diffcache"}=
			$VEs{$cnt}->{$var}->{"failcnt"}-
			$VEs{$cnt}->{$var}->{"cachefail"} ) > 0;
		};
		foreach my $var ( @{$cfg->{'ioacctvars'}}  ) {
		    $VEs{$cnt}->{$var}->{"time"}=shift @vals;
		    $VEs{$cnt}->{$var}->{"cachecount"}=shift @vals;
		    $VEs{$cnt}->{'varCCnt'}++ if
			( defined $opt{'i'} or defined $opt{'I'} ) and
			( $VEs{$cnt}->{$var}->{"diffcache"}=
			$VEs{$cnt}->{$var}->{"counter"}-
			$VEs{$cnt}->{$var}->{"cachecount"} ) > 0;
		};
	    };
	};
    };
}
sub writeCache {
    mkdir $cfg->{'cachedir'} unless -d $cfg->{'cachedir'};
    open my $hca,do{$cfg->{'cachefile'}=~/.gz$/?"| gzip ":""}.
	">".$cfg->{'cachedir'}."/".
	$cfg->{'cachefile'} or die;
    foreach my $cnt ( keys %VEs ) {
	say $hca
	    sprintf( "%d=%s", $cnt, 
		     join(",",( map
			  {
			      $VEs{$cnt}->{$_}->{"time"}.",".
			      $VEs{$cnt}->{$_}->{"cachefail"}
			  } @{$cfg->{'ubcvars'}}),
			  ( map  {
			      $VEs{$cnt}->{$_}->{"time"}.",".
			      $VEs{$cnt}->{$_}->{"cachecount"}
			  } @{$cfg->{'ioacctvars'}})));
	};
    close $hca;
}
sub readConfigFile {
    my $configfile=$cfg->{'configdir'}."/".$_[0].".conf";
    open my $hcf,"<".$configfile or die;
    $VEs{$_[0]}={'name'=>"--",'hostname'=>"--",'ipaddr'=>"--",'onboot'=>"--"};
    while (my $hcfl=<$hcf>) {
	$VEs{$_[0]}->{'name'}     =$1
	    if $hcfl=~/^NAME="(.*)"/;
	$VEs{$_[0]}->{'hostname'} =$1
	    if $hcfl=~/^HOSTNAME="(.*)"/;
	$VEs{$_[0]}->{'ipaddr'}   =$1
	    if $hcfl=~/^IP_ADDRESS=\"([^ \"]*)[ \"]/;
	$VEs{$_[0]}->{'onboot'}   =$1
	    if $hcfl=~/^ONBOOT="(.*)"/;
    };
    close $hcf;
};
sub readIoacctFile {
    my ($crtcnt) = @_;
    open my $ioacct, "</proc/bc/$crtcnt/ioacct" or die;
    while ( my $ioacctline = <$ioacct> ) {
	($VEs{$crtcnt}->{$1}->{"counter"},
	 $VEs{$crtcnt}->{$1}->{"time"}) = ( $2, time )
	    if $ioacctline =~ /^\s*(\S+)\s+(\d+)\s*$/;	
    }
    close $ioacct;
}
sub readCurrentState {
    my $crtcnt = undef;
    seek $ubc,0,0;
    while (<$ubc>) {
	$crtcnt=undef if /^\s+0:\s+kmemsize\s+\d+\s+\d+\s+(\d+)\s/;
	/^\s*(\d+):\s/ && $1 > 0 && do {
	    $crtcnt = $1;
	    readConfigFile($crtcnt) unless defined
		$VEs{$crtcnt}->{'onboot'};
	    readIoacctFile($crtcnt) if $opt{'i'} or $opt{'I'};
	    s/^\s*\d+://;
	};
	(
	 $VEs{$crtcnt}->{$1}->{"held"},
	 $VEs{$crtcnt}->{$1}->{"maxheld"},
	 $VEs{$crtcnt}->{$1}->{"barrier"},
	 $VEs{$crtcnt}->{$1}->{"limit"},
	 $VEs{$crtcnt}->{$1}->{"failcnt"}
	 ) = ($2,$3,$4,$5,$6) if
	     defined $crtcnt and
	     /^\s*(\S+)\s+
	     (\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*$/x
	     and $1 !~ /^dummy$/;
    }
};

sub showVE {
    my ($cnt,$full)=@_;
    if (! defined $cnt or $cnt =~ /^all$/) {
	foreach my $ve (sort { $a <=> $b } keys %VEs) {
	    next unless defined $VEs{$ve}->{'kmemsize'}->{'failcnt'};
	    if (defined $full) {
		showVE($ve,1);
	    } else {
		showVE($ve);
	    };
	};
    } elsif (defined $VEs{$cnt}) {
	my $VE=$VEs{$cnt};
	my $fieldpres=(" %".$cfg->{'fieldsize'}."s")x5;
	my $dispCnt=0;
	if ($opt{'i'}) {
	    $dispCnt=$VE->{'varFCnt'}+$VE->{'varCCnt'}
	} elsif ($opt{'I'}) {
	    $dispCnt=$VE->{'varCCnt'};
	}else {
	    $dispCnt=$VE->{'varFCnt'};
	};
	my $headlineformat=" %s\n|%12s : %-14s%".
	    (5*$cfg->{'fieldsize'}-16)."s%4df |\n %s\n";
	my $maxhostnamelen=(5*$cfg->{'fieldsize'}-19)-length($VE->{"ipaddr"});
	my $hoststring=substr($VE->{"hostname"},0,$maxhostnamelen).
	    " (".$VE->{"ipaddr"}.")";
	printf $headlineformat, '-' x (19+$cfg->{'fieldsize'}*5),
	    $cnt, $VE->{"name"}, $hoststring, $dispCnt,
	    '-'x(19+$cfg->{'fieldsize'}*5) if
		defined $full or $dispCnt;
	unless ($opt{'I'}) {
	    printf "  %-12s$fieldpres\n"x2,
	    (qw|resource held maxheld barrier limit failcnt
	     -------- ---- ------- ------- ----- -------|) if
	     $VE->{'varFCnt'} or $full;
	    foreach my $var (@{$cfg->{'ubcvars'}}) {
		my $UVAR=$VE->{$var};
		my $star='';
		$star='*' if $UVAR->{"diffcache"} > 0;
		printf " %1s%-12s".$fieldpres."\n", $star, $var,
		(map { $UVAR->{$_} } qw |held maxheld barrier limit|),
		$UVAR->{"diffcache"} if defined $full or $star;
	    };
	};
	return unless $opt{'i'} or $opt{'I'};
	printf "  %-18s %12s %15s %19s\n"x2,
	qw|counter elaps hit/sec hits ------- ----- ------- ----| if 
	    defined $full or $VE->{'varCCnt'};
	foreach my $var (@{$cfg->{'ioacctvars'}}) {
	    my $UVAR=$VE->{$var};
	    my $star='';
	    $star='+' if $UVAR->{"diffcache"} > 0;
	    my $elap=do { no bigint;$cfg->{'lastrun'}-$UVAR->{"time"}};
	    printf " %1s%-18s %12.2f %15.3f %19s\n", $star, $var,
	    $elap, $UVAR->{"diffcache"} /$elap,
	    $UVAR->{"diffcache"} if defined $full or $star;
	};
    };
};
sub resetVars {
    my ($cnt,$var)=@_;
    if (! defined $cnt or $cnt =~ /^all$/) {
	my $field=undef;
	unless ($opt{'f'}) {
	    if (defined $var) {
		$field=$var;
		print "Really reset $var for all VEs (y/N) ? ";
	    } else {
		print "Really reset all variables for all VEs (y/N) ? ";
	    };
	    return unless <> =~ /^y/i;
	};
	foreach my $ve (sort { $a <=> $b } keys %VEs) {
	    if (defined $field) {
		resetVars($ve,$field);
	    } else {
		resetVars($ve);
	    };
	};
    } elsif (defined $VEs{$cnt}) {
	if (defined $var) {
	    if (grep {/^$var$/} @{$cfg->{'ubcvars'}}) {
		$VEs{$cnt}->{$var}->{'time'}=$cfg->{'lastrun'};
		$VEs{$cnt}->{$var}->{"cachefail"} = 
		    $VEs{$cnt}->{$var}->{"failcnt"};
	    } elsif (grep {/^$var$/} @{$cfg->{'ioacctvars'}}) {
		$VEs{$cnt}->{$var}->{'time'}=$cfg->{'lastrun'};
		$VEs{$cnt}->{$var}->{"cachecount"} = 
		    $VEs{$cnt}->{$var}->{"counter"};
	    };
	} else {
	    foreach $var (@{$cfg->{'ubcvars'}}) {
		$VEs{$cnt}->{$var}->{'time'}=$cfg->{'lastrun'};
		$VEs{$cnt}->{$var}->{"cachefail"} = 
		    $VEs{$cnt}->{$var}->{"failcnt"};
	    };
	    if ($opt{'i'} or $opt{'I'}) {
		foreach $var (@{$cfg->{'ioacctvars'}}) {
		    $VEs{$cnt}->{$var}->{'time'}=$cfg->{'lastrun'};
		    $VEs{$cnt}->{$var}->{"cachecount"} = 
			$VEs{$cnt}->{$var}->{"counter"};
		}
	    };
	};
    };
}
sub matchVE {
    my ($ve)=@_;
    return unless $ve;
    unless (defined $VEs{$ve}) {
	my $name=$ve;
	($ve)=grep { $VEs{$_}->{'name'}=~/^$ve$/i 
 		     or
		     $VEs{$_}->{'hostname'}=~/^$ve$/i 
 		     or
		     $VEs{$_}->{'ipaddr'}=~/^$ve$/ 
		 } keys %VEs;
    };
    return $ve;
}
sub tinyOut {
    my ($veid)=@_;
    if (defined $veid and defined $VEs{$veid}) {
	foreach my $var (grep {$VEs{$veid}->{$_}->{diffcache}>0}
			 @{$cfg->{'ubcvars'}},@{$cfg->{'ioacctvars'}}) {
	    printf "%-14s %12s %12u\n",$var,
	    do { no bigint;$cfg->{'lastrun'}-
		     $VEs{$veid}->{$var}->{"time"}},
	    $VEs{$veid}->{$var}->{diffcache};
	};
    } else {
	foreach my $veid (grep {$VEs{$_}->{'varFCnt'} >0} sort keys %VEs) {
	    unless ($opt{'I'}) {
		foreach my $var ( grep {$VEs{$veid}->{$_}->{diffcache} > 0 }
				  @{$cfg->{'ubcvars'}}) {
		    printf "%8d: %-14s %12s %12u\n", $veid, $var,
		    do { no bigint;$cfg->{'lastrun'}-
			     $VEs{$veid}->{$var}->{"time"}},
		    $VEs{$veid}->{$var}->{diffcache};
		};
	    };
	    foreach my $var ( grep {$VEs{$veid}->{$_}->{diffcache} > 0 }
			      @{$cfg->{'ioacctvars'}}) {
		printf "%8d: %-14s %12s %12u\n", $veid, $var,
		do { no bigint;$cfg->{'lastrun'}-
			 $VEs{$veid}->{$var}->{"time"}},
		$VEs{$veid}->{$var}->{diffcache};
	    };
	};
    };
};
sub usage {
    say "Usage: ".$0.
	" [ show [ve] | brief [ve] | tiny [ve] | init | reset [ve [varname] ] ]";
};

initConfigVars;
writeCfgCache unless $opt{'W'};
readCurrentState;
initCache;
readCache unless $opt{'n'};

if (my $command=shift @ARGV) {
    my $VE=matchVE(shift @ARGV);
    given ($command) {
	when (/^show$/)  { showVE $VE,1;}
	when (/^brief$/) { showVE $VE; }
	when (/^init$/)  { writeCache; }
	when (/^tiny$/) { tinyOut $VE; } 
	when (/^reset$/) { resetVars $VE,@ARGV ; writeCache; }
	when (/^dump$/) {
	    print '%VEs=>'.Dumper(\%VEs); }
	default { usage }
    }
} else {
    showVE;
};