File: //proc/self/root/usr/bin/parser.pl
#!/usr/bin/perl -w
#
# $Id: parser.pl 1561 2011-02-02 14:57:59Z agolovko $
#
use strict;
use warnings;
use Data::Dumper;
use CGI;
my $q = new CGI;
my $args = args();
my $log_filename =$ENV{HTTP_USAGE_LOG};
my $global_log_filename = $ENV{HTTP_GLOBAL_USAGE_LOG};
my $tail_program = '/usr/bin/tail';
my %sort_keys = ('SystemTime'=>1,'UserTime'=>1,'RealTime'=>1,'Count'=>1,'BlocksIn'=>1,'BlocksOut'=>1);
my %group_by = ('VirtualHost'=>1,'IP'=>1,'VirtualHost-URL'=>1);
my %log_types = ('Local'=>1,'Global'=>1);
my $stat_mode = $args->{mode} || 'VirtualHost-URL';
my $output_mode = $args->{output} || 'html';
my $time_limit = $args->{time_limit} || 5; # мин
my $data_time_limit = time() - ($time_limit * 60);
my $data_row_limit = $args->{row_limit} || 10000;
my $top = $args->{top} || 10;
my $sort_key = $args->{sort_key} || 'Count';
my $log_type = $args->{log_type} || 'Local';
my $refresh = $args->{refresh} || 0;
my ($rows,$time_range);
my $fname = $log_type eq 'Local' ? $log_filename : $global_log_filename;
print $q->header(-type=>'text/html');
#check args;
unless( exists $sort_keys{$sort_key})
{
print "Error:bad arg sort_key, must in (".join(",",keys %sort_keys).")\n";
exit 1;
}
unless( exists $group_by{$stat_mode})
{
print "Error:bad arg stat_mode, must in (".join(",",keys %group_by).")\n";
exit 1;
}
unless( exists $log_types{$log_type})
{
print "Error:bad arg log_type, must in(".join(",",keys %log_types).")\n";
exit 1;
}
unless( $time_limit =~ /^\d+$/ )
{
print "Error:bad arg time_limit must be numeric\n";
exit 1;
}
unless( $data_row_limit =~ /^\d+$/ )
{
print "Error:bad arg row_limit must be numeric\n";
exit 1;
}
unless( $top =~ /^\d+$/ )
{
print "error:bad arg top must be numeric\n";
exit 1;
}
unless( $refresh =~ /^\d+$/ )
{
print "error:bad arg refresh must be numeric\n";
exit 1;
}
if($output_mode eq 'html')
{
print stat_header();
print stat_form();
print stat_footer();
}
open F,"$tail_program -n $data_row_limit $fname |" or die "Can't open file $fname: $!\n";
my $stat={};
my $sumary={sum=>{}};
while(<F>)
{
chomp;
my $str = $_;
my $h = parse_log_str($str);
next unless $h;
next if ($h->{Time}<$data_time_limit);
my $key = $h->{VirtualHost};
if($stat_mode eq 'IP')
{
$key = $h->{IP};
}
elsif($stat_mode eq 'VirtualHost-URL')
{
$key = $h->{VirtualHost} . $h->{URL};
}
$stat->{$key} = {} unless exists $stat->{$key};
merge($stat->{$key},$h);
merge($sumary->{sum},$h);
}
close F;
my $i=0;
my ($row_format, $row_format_sum);
if($output_mode eq 'html')
{
$row_format = "<tr bgcolor='#ffffff'><td> %d.%06d </td><td> %d.%06d </td><td> %d.%06d </td><td> %d </td><td> %d </td><td> %d </td><td><nobr> %s </nobr></td></tr>\n";
$row_format_sum = "<tr><td><b> %d.%06d </b></td><td><b> %d.%06d </b></td><td><b> %d.%06d </b></td><td><b> %d </b></td><td><b> %d </b></td><td><b> %d </b></td><td><nobr><b> %s </b></nobr></td></tr>\n";
}
if($output_mode eq 'html')
{
print "<table border=0 bgcolor='#cccccc'>";
print "<tr><td><b> User Time </b></td><td><b> System Time </b></td><td><b> Real Time </b></td><td><b> Blocks Input </b></td><td><b> Blocks Output </b></td><td><b> Count </b></td><td><b> $stat_mode <b/></td></tr>\n";
}
foreach my $key (sort { hvalue($stat->{$b},$sort_key) <=> hvalue($stat->{$a},$sort_key) } keys %{$stat})
{
normalize($stat->{$key});
print getrowstr($row_format,$key,$stat->{$key});
$i++;
last if $i>=$top;
}
normalize($sumary->{sum});
print getrowstr($row_format_sum,"",$sumary->{sum});
if($output_mode eq 'html')
{
print "</table>";
}
sub getrowstr
{
my $format = shift;
my $key = shift;
my $h = shift;
return sprintf($format, $h->{UserTime}->{sec}, $h->{UserTime}->{usec},
$h->{SystemTime}->{sec} , $h->{SystemTime}->{usec},
$h->{RealTime}->{sec}, $h->{RealTime}->{usec},
$h->{bin}, $h->{bout}, $h->{Count},
$key
);
}
sub hvalue
{
my $h = shift;
my $name = shift;
normalize($h);
if( $name eq 'UserTime' || $name eq 'SystemTime' || $name eq 'RealTime')
{
return int(sprintf("%d%06d",$h->{$name}->{sec},$h->{$name}->{usec}));
}
elsif($name eq 'BlocksIn')
{
return int($h->{bin});
}
elsif($name eq 'BlocksOut')
{
return int($h->{bout});
}
else
{
return $h->{$name}||0;
}
}
sub merge
{
my $h1 = shift;
my $h2 = shift;
$h1->{SystemTime}->{sec} = ($h1->{SystemTime}->{sec} || 0) + $h2->{SystemTime}->{sec};
$h1->{SystemTime}->{usec} = ($h1->{SystemTime}->{usec} || 0) + $h2->{SystemTime}->{usec};
$h1->{UserTime}->{sec} = ($h1->{UserTime}->{sec} || 0) + $h2->{UserTime}->{sec};
$h1->{UserTime}->{usec} = ($h1->{UserTime}->{usec} || 0) + $h2->{UserTime}->{usec};
$h1->{RealTime}->{sec} = ($h1->{RealTime}->{sec} || 0) + $h2->{RealTime}->{sec};
$h1->{RealTime}->{usec} = ($h1->{RealTime}->{usec} || 0) + $h2->{RealTime}->{usec};
$h1->{bin} = ($h1->{bin} || 0) + $h2->{bin};
$h1->{bout} = ($h1->{bout} || 0) + $h2->{bout};
$h1->{Count} = ($h1->{Count} || 0) + (exists $h2->{Count}? $h2->{Count} : 1);
}
sub normalize
{
my $h = shift;
$h->{SystemTime}->{sec} = $h->{SystemTime}->{sec} + int($h->{SystemTime}->{usec}/1000000);
$h->{SystemTime}->{usec} = $h->{SystemTime}->{usec}%1000000;
$h->{UserTime}->{sec} = $h->{UserTime}->{sec} + int($h->{UserTime}->{usec}/1000000);
$h->{UserTime}->{usec} = $h->{UserTime}->{usec}%1000000;
$h->{RealTime}->{sec} = $h->{RealTime}->{sec} + int($h->{RealTime}->{usec}/1000000);
$h->{RealTime}->{usec} = $h->{RealTime}->{usec}%1000000;
}
sub parse_log_str
{
my $str = shift;
my $h = {};
return undef unless $str;
# Parse usage_log record.
# Record example:
# 1288818943569081 a-vhost a-vhost 10.10.0.1 "GET /usage-top HTTP/1.1" \
# 1867 sys:0.000954 user:0.000340 real:0.001446 bin:0 bout:0
#
# FIXME (.*) - very bad idea especially on large strings
# since Perl has greedy regexps.
#
if($str =~ /^(\d+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+\"\w+\s(.+)\s+HTTP.*\"\s+(\d+)/i)
{
$h->{Time} = $1;
$h->{VirtualHost} = $2;
$h->{Group} = $3;
$h->{IP} = $4;
$h->{URL} = $5;
$h->{size} = $6;
}
if($str =~ /sys:\s*(\d+)\.(\d+)/)
{
$h->{SystemTime}->{sec} = $1;
$h->{SystemTime}->{usec} = $2;
}
if($str =~ /user:\s*(\d+)\.(\d+)/)
{
$h->{UserTime}->{sec} = $1;
$h->{UserTime}->{usec} = $2;
}
if($str =~ /real:\s*(\d+)\.(\d+)/)
{
$h->{RealTime}->{sec} = $1;
$h->{RealTime}->{usec} = $2;
}
if($str =~ /bin:\s*(\d+)/)
{
$h->{bin} = $1;
}
if($str =~ /bout:\s*(\d+)/)
{
$h->{bout} = $1;
}
return $h;
}
sub args
{
my $self = shift;
my $vars = $q->Vars;
my %args = ();
while ( my ($key,$val) = each %$vars )
{
my @val = split "\0", $val;
if ( $#val > 0 )
{
foreach ( @val )
{
if ( defined $_ )
{
s/^\s+//;
s/\s+$//;
s/[\0\r]//g;
push @{$args{$key}}, $_ if $_ ne '';
}
}
}
else
{
if ( defined $val )
{
$val =~ s/^\s+//;
$val =~ s/\s+$//;
$val =~ s/[\0\r]//g;
# $args{$key} = $val if $val ne '';
# Если не давать здесь undef, то невозможно
# будет сохранять пустые данные в Ent-объектах
# посредством $obj->set( %$args ).
$val = undef if $val eq '';
$args{$key} = $val;
}
}
}
return \%args;
}
sub stat_header
{
my $ref="";
$ref = "<META http-equiv='Refresh' content='$refresh'>" if $refresh;
return "
<html>
<head>
<title>Resources Usage Statistics</title>
$ref
<style type='text/css'>
/* TODO */
</style>
</head>
<body bgcolor='#ffffff'>";
}
sub stat_form
{
my $txt ="
<form method=GET>
<table style='font-size: 12px' bgcolor='#ffffff' border='0'>
<tr><td>Row Limit:</td><td><input type=text name=row_limit value=$data_row_limit></td>
<td>Sort Order:</td><td>".html_select("sort_key",$sort_key,keys %sort_keys)."</select></td></tr>
<tr><td>Time Limit (min):</td><td><input type=text name=time_limit value=$time_limit></td>
<td>Group By:</td><td>".html_select("mode",$stat_mode,keys %group_by)."</td></tr>
<tr><td>Top:</td><td><input type=text name=top value=$top></td>
<td>Log File:</td><td>".html_select("log_type",$log_type,keys %log_types)." ($fname)</td></tr>
<tr><td>Refresh (sec):</td><td><input type=text name=refresh value=$refresh></td></tr>
<tr><td align=center colspan=4><input type=submit value='show'></td></tr>
</table>
</form>
";
return $txt;
}
sub html_select
{
my $name = shift;
my $cur_val = shift;
my @values = @_;
my $txt = "<select name=$name>\n";
foreach my $val (sort @values)
{
my $sel = '';
$sel = "selected" if($cur_val eq $val);
$txt .= "<option $sel value=$val>$val</option>";
}
$txt .= "</select>";
return $txt;
}
sub stat_footer
{
return <<EOF;
</body></html>
EOF
}