Perl を使用して、IPv4/IPv6 アドレスからホスト名を取得する際に必要となる事項などを、以下にまとめておきます。

IPv4 アドレスについての正規表現

まず IPv4 アドレスについて。

IPv4 アドレスの一般的な形式である xxx.xxx.xxx.xxx、この他、IPv4 互換 IPv6 アドレス (::xxx.xxx.xxx.xxx) および IPv4 射影 IPv6 アドレス (::ffff:xxx.xxx.xxx.xxx) をマッチングするようにしてみました。

/^(?:::(?:f{4}:)?)?((?:0*(?:2[0-4]\d|25[0-5]|[01]?\d\d|\d)\.){3}0*(?:2[0-4]\d|25[0-5]|[01]?\d\d|\d))$/i

$1 に xxx.xxx.xxx.xxx の部分だけが入ります。

数字の先頭に 0 が連続していた場合でも通るようにしました。例えば 192.168.000.014 など。vishnu さん、ありがとうございました。

IPv4 互換 IPv6 アドレスや IPv4 射影 IPv6 アドレスではない場合、10 進数表記パターンがありますので以下の様な感じとなります。

/^(?:::(?:f{4}:)?)?((?:0*(?:2[0-4]\d|25[0-5]|[01]?\d\d|\d)\.){3}0*(?:2[0-4]\d|25[0-5]|[01]?\d\d|\d)|(?:\d+))$/i

この場合、取得できた値が 10 進数のみで構成されていた場合 (/^\d+$/) には、次の行で 0 ~ 4,294,967,295 (0 ~ 0xFFFFFFFF) の範囲チェックを行いましょう。

杉村さん、ありがとうございました。

この正規表現では、IPv4 互換/射影 IPv6 アドレスの場合、先頭に :: もしくは ::ffff: が入りますから、これを取り除く為の内容です。そして、後ろの方では普通に IPv4 アドレスのマッチングを行います。

IPv4 アドレスの正規表現は Perl クックブックのものを少し書き換えました。オリジナルのものだと、\d|[01]?\d\d|2[0-4]\d|25[0-5] になるのですが、この場合、最後の項目で、最初の候補である \d で引っかかってしまい、最後の数値が 2 桁以上ある場合に 1 桁しかマッチしないで終わってしまうことになりました。

なので、111.111.111.999 なんてのが通ってしまう事になりますので、順序を変えて通らなくしておきました。

IPv6 アドレスの展開

逆引きなどのために展開する処理を書いてみました。

my $original = '123:4567:8::9ab:c:def';
my @address;
if ($original =~ /::/) {
	# 短縮形式を展開する
	my ($adr_a, $adr_b) = split /::/, $original;
	my @adr_a = split /:/, $adr_a;
	my @adr_b = split /:/, $adr_b;
	for (scalar @adr_a .. 7 - scalar @adr_b) { push @adr_a, 0 };
	@address = (@adr_a, @adr_b);
} else {
	@address = split /:/, $original;
}
print STDOUT (join ":", @address)."\n";

なお、これを逆引きアドレスに変換する場合は以下にします。

print STDOUT
	(join ".",
	 reverse split //,
	 (join "",
	  map { sprintf "%04x", hex $_ }
	  @address)).
	".ip6.int\n";

ホスト名の取得

今までで取得できた IP アドレスを DNS へ問い合わせることで、ホスト名を取得します。(Perl 組み込みの gethostbyaddr では IPv6 アドレスの問い合わせができなかったので、Net::DNS::Resolver を CPAN から拾ってきて使用することにします。

なお、取得した IP アドレスの文字列は $ip_address へ格納しているものとします。

my $resolver = new Net::DNS::Resolver;
my $ans = $resolver->query($ip_address, 'PTR', 'IN');
return '' unless defined $ans;
my $ret = $ip_address;
for my $rr ($ans->answer) {
	next unless $rr-> eq 'PTR';
	$ret = $rr->ptrdname;
	last;
}
print "hostname: $ret\n";