Table of Contents

概要

  • 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

リンク

Perl