access_log_with_gethostbyaddr

目次

• 背景
• ソース

背景

• 呼び出し側のHTMLは適当に用意して下さい。POSTのkeyは list (= $targetKey)です。
• POSTの入力は必要な箇所、つまり ---: ---: --- の次の行から、[その他: xx ホスト]の
上の行までを、copy & pasteされていると仮定してます。入力のvalidateはしてません。

ソース

#!/usr/bin/perl
use CGI qw/:standart/;
use Socket;
use strict;

my ($buf, @input, $i);
my $debug = 0;
my $targetKey = "list";
my @result = ();

print <<"EOF";
Content-Type: text/plain; charset=euc-jp

EOF
if ( $ENV{'REQUEST_METHOD'} =~ /POST/ ) {
	my $query = new CGI(\*STDIN);
	@result = &prelookup($query->param($targetKey));
}

if ( $debug != 0 ) {
	undef $/;
	my $in = <STDIN>;
	$/ = "\n";
	@result = &prelookup($in);
}

&printResult(@result);

## sub routines
sub printResult {
	my $href;
	foreach $href ( sort by_req(@_) ) {
		printf("%s %s %s %s\n",
			&string_padding($href->{"req"}, 8),
			&string_padding($href->{"pct"}, 7),
			$href->{"addr"},
			$href->{"name"}
		);
	}
}

sub by_req {
	my $href_a = $a;
	my $href_b = $b;
	my $w = "req";

	if ( $href_a->{$w} > $href_b->{$w} ) {
		return -1;
	} elsif ( $href_a->{$w} == $href_b->{$w} ) {
		return 0;
	} else {
		return 1;
	}
}

sub prelookup {
	my @lines = split(/\n/, $_[0]);
	my @ret;
	my $hash;

	foreach ( @lines ) {
		push(@ret, &lookup($_));
	}

	return @ret;
}

sub lookup {
	my $input = $_[0];
	$input =~ s/\s//g;
	my @lists = split(/:/,$input);
	my (@res, $word, $host, $addr, $i, $ret);

	$ret = {req=>$lists[0], pct=>$lists[1], addr=>$lists[2], name=>""};
	$ret->{"name"} = &by_addr($ret->{"addr"});
	$ret->{"addr"} = &string_padding($ret->{"addr"}, 15);

	return ($ret);
}

sub string_padding {
	my $in = $_[0];
	my $countup = $_[1];
	# set countup byte
	my $len = $countup - length($in);
	my ($i, $tail);
	if ( $len > 0 ) {
		$tail = "";
		for ( $i = 0; $i < $len; $i++ ) {
			$tail .= ' ';
		}
	}
	return $in.$tail;
}

sub by_addr {
	my $addr = pack('C*', split(/\./, $_[0]));
	return gethostbyaddr($addr, AF_INET);
}

sub by_name {
	my $addr = gethostbyname($_[0]);
	return join('.', unpack('C*', $addr));
}