概要
- Apache の error_log を HTML テーブルとして整形する。
- mod_security 対応。
動作サンプル
ソース
index.cgi
#!/usr/bin/perl
# Apache のエラーログを整形
use strict;
use warnings;
use utf8;
use Encode;
use CGI::Pretty qw( -no_xhtml *table *ol );
use Net::DNS::Resolver;
$CGI::POST_MAX = 80 * 1024;
my $charsetConsole = 'UTF-8';
#my $charsetConsole = 'CP932';
my $charsetFile = 'UTF-8';
binmode( STDIN, ":encoding($charsetConsole)" );
binmode( STDOUT, ":encoding($charsetConsole)" );
binmode( STDERR, ":encoding($charsetConsole)" );
my $cgiName = 'Apache Error Log Formatter';
my @pair_type = (
{ # mod_security
header => qr/(ModSecurity:.*\.)\s(\[.*)\s*/,
to_pair => qr/\[\S+\s[^\]]+\]\s*/,
to_keyval => qr/\[(\S+)\s"([^\]]+)"\]\s*/,
},
{ # default, detail部無し
header => qr/(.*)\s*/,
},
);
my $q = new CGI;
$q->charset( $charsetFile );
my $br = $q->br();
my %processer = (
Client => \&toHostName,
data => sub{
my $word = shift;
$word =~ s/(\s(ARGS|ARGS_NAMES):)/$1$br/;
return $word;
},
);
my $log = $q->param('LOG') || '';
if ( ( ! $ENV{'SERVER_ADDR'} ) && ( ! $log ) && ( my $file = $q->param('FILE') ) ){
open( my $IN, "<:encoding($charsetFile)", $file ) or die( "$file: $!\n" );
my @body = <$IN>;
close( $IN );
$log = join( "", @body );
}
print $q->header(
-type => 'text/html',
-charset => $charsetConsole,
);
print $q->start_html(
-title => $cgiName,
-head => [
$q->meta( { -http_equiv=>'Content-Type', -content=>"text/html; charset=" . $charsetConsole } ),
$q->meta( { -http_equiv=>'Content-style-type', -content=>"text/css" } ),
],
-style => [ { 'src'=>'/take.css' }, ],
);
print $q->h1( $cgiName );
if ( $log ){
print_result( $log );
} else {
print_form();
}
print $q->end_html . "\n";
exit;
sub print_result
{
my( $log ) = @_;
$log =~ s/\r\n|\n\r/\n/gmx;
$log =~ s/\r/\n/gmx;
$log =~ s/"([^\"]*)"/'"'.encodeURIComponent($1).'"'/gmxe;
print $q->p( $q->a( { -href => $q->url( -absolute => 1 ) }, 'form' ) );
my $index = 0;
foreach my $line ( split( "\n", $log ) ){
if ( $line =~ /^\x{feff}?\s*$/ ){
next;
}
# print $q->h2( ++$index );
print $q->start_table( { -border => 1 } );
# print $q->Tr( $q->th( 'Line' ), $q->td( $line ) );
my( $datetime, $level, $client, $line2 ) =
( $line =~ /\[([^\]]+)\]\s\[([^\]]+)\](?:\s\[client\s([^\]]+)\])?\s*(.*)\s*$/ );
print $q->Tr( $q->th( 'Date Time' ), $q->td( $datetime ) );
print $q->Tr( $q->th( 'Level' ), $q->td( $level ) );
if ( $client ){
print $q->Tr( $q->th( 'Client' ), $q->td( toHostName( $client ) ) );
}
# print $q->Tr( $q->th( 'Line2' ), $q->td( $line2 ) );
foreach my $type ( @pair_type ){
if ( $line2 =~ /^$type->{'header'}/ ){
my( $summary, $detail ) = ( $1, $2 );
$summary =~ s/([\.\,])\s/$1$br/;
print $q->Tr( $q->th( 'Summary' ), $q->td( decodeURIComponent( $summary ) ) );
if ( $detail ){
foreach my $pair ( getPair( $type->{'to_pair'}, $type->{'to_keyval'}, $detail ) ){
my( $key, $val ) = ( $pair->[0], $pair->[1] );
if ( my $proc = $processer{$key} ){
$val = $proc->( $val );
}
print $q->Tr( $q->th( $key ), $q->td( $val ) );
}
}
last;
}
}
print $q->end_table(), $q->br();
}
print $q->p( $q->a( { -href => $q->url( -absolute => 1 ) }, 'form' ) );
}
sub getPair
{
my( $to_pair, $to_keyval, $line ) = @_;
my @ret = ();
# print "'$to_pair'\n'$line'\n";
foreach my $pair ( $line =~ /$to_pair/g ){
# print "'$pair'\n";
my( $key, $val ) = ( $pair =~ /^$to_keyval$/ );
$val = decodeURIComponent( $val );
push( @ret, [ $key, $val ] );
}
return @ret;
}
sub print_form
{
print
$q->start_form( -action => $q->url, -enctype => 'multipart/form-data' ),
$q->submit, " ", $q->reset, $q->br(),
$q->textarea( -name=>'LOG', -rows=>20, -columns=>80 ),
$q->end_form;
}
sub encodeURIComponent
{
my $str = encode( 'utf-8', shift );
$str =~ s/([^0-9A-Za-z!\x27()*\-._~])/sprintf("%%%02X", ord($1))/eg; # \x27 = '
return $str;
}
sub decodeURIComponent
{
my $str = shift;
$str =~ s/%([0-9A-F][0-9A-F])/pack( "H*", $1 )/egi;
return decode( 'utf-8', $str );
}
sub toHostName
{
my $ip_address = shift || '';
my $ret = '';
my $resolver = Net::DNS::Resolver->new;
if ( my $ans = $resolver->query( $ip_address ) ){
for my $rr ( $ans->answer ){
#print $rr->string, "\n";
if ( $rr->type eq 'PTR' ){
$ret = $rr->ptrdname;
last;
}
}
}
return $ip_address . '; ' . $ret;
}
# EOF