#! /usr/bin/perl
#
# Geo::IP の国コードを得る関数のエミュレーション
# (country_code_by_addr, country_code_by_name のみ)
# と、ホスト名正引きのモジュール
# Copyright (C) 2022 HIRAMOTO Kouji
#
# 使用例:
# use GeoIP_emulate;
# my $geoip = GeoIP_emulate->new();
# print $geoip->country_code_by_addr("1.2.3.4"), "\n";
# print $geoip->country_code_by_name("example.com"), "\n";
#
# 使用例2:
# use GeoIP_emulate;
# my $geoip = GeoIP_emulate->new()->use_array(1);
# my %hash = $geoip->get_country("1.2.3.4");
# printf("  '%s' '%s' '%s'\n", $hash{country}, $hash{name_en}, $hash{name_ja});
#
# Geo::IP を使っていたプログラムの修正例:
# use Geo::IP;
# $geoip = Geo::IP->new(GEOIP_STANDARD);
# ↓
# use GeoIP_emulate;
# $geoip = GeoIP_emulate->new();
#
#------------------------------------------------------------------------------
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# ライセンス全文: https://www.gnu.org/licenses/old-licenses/gpl-2.0.ja.html
# 日本語訳: https://licenses.opensource.jp/GPL-2.0/gpl/gpl.ja.html
#------------------------------------------------------------------------------

package GeoIP_emulate;

use GeoIP2::Database::Reader;
use Encode;
use ConfigReader::Simple;
use Net::DNS;
use Class::Std;

use strict;

{
my %geoip_of; # GeoIP2::Database::Reader オブジェクトを格納
my %res_of; # Net::DNS オブジェクトを格納
my %use_array_of; # 返り値をハッシュにするかどうかを格納

# new で実行する処理
sub BUILD {
    my ($self, $obj_ID, $arg_ref) = @_;

    my $ident = ident $self;

    my $config = ConfigReader::Simple->new("/usr/share/GeoLite2/config");
    my $geoip = GeoIP2::Database::Reader->new(
	file    => $config->get("MMDB"),
	locales => [ 'en', 'ja', ]
	);
    $geoip_of{$ident} = $geoip;
}

# 真の引数を与えると、配列やハッシュに格納する際自動的に配列を返す
# デフォルトでは常に国コードのみのスカラーを返す
sub use_array
{
    my $self = shift;
    my $ident = ident $self;
    my $flag = shift;
    $use_array_of{$ident} = $flag;
    return $self;
}

# 国コードを得る
sub get_country
{
    my $self = shift;
    my $ident = ident $self;

    my $ip = shift;

    my $geoip = $geoip_of{$ident};

    if ($ip eq "127.0.0.1" || $ip eq "::1") {
	return "";
    }

    # IPv4/IPv6 アドレスではない = ホスト名を与えられた時
    if ($ip !~ /^\d+\.\d+\.\d+\.\d+$/ && $ip !~ /[0-9a-f]+:[0-9a-f:]*/) {
	my @ip_list = $self->nslookup($ip);
	# IPアドレスが索けなかった時
	if (! @ip_list) {
	    return "";
	}
	$ip = $ip_list[0];
    }

    my $country;
    my $name_en;
    my $name_ja;
    # 稀に致命的なエラーが発生するので eval でハンドリング
    eval {
	my $country_record = $geoip->country( ip => $ip )->country;
	$country = $country_record->iso_code();
	$name_en = $country_record->names()->{en};
	$name_ja = encode('UTF-8', $country_record->names()->{ja});
    };
    # エラーが起きた時
    if ($@) {
	my $c = $@;
	$c =~ s/[\r\n].*$//s;
	$country = "($c)";
	$name_en = "";
	$name_ja = "";
    }
    # DBに情報がなかった時
    if (! $country) {
	$country = "";
	$name_en = "";
	$name_ja = "";
    }
    if ($use_array_of{$ident} && wantarray) {
	return ( country => $country, name_en => $name_en, name_ja => $name_ja );
    }
    else {
	return $country;
    }
}

# country_code_by_addr のエミュレーション
sub country_code_by_addr
{
    my $self = shift;
    $self->get_country(@_);
}

# country_code_by_name のエミュレーション
sub country_code_by_name
{
    my $self = shift;
    $self->get_country(@_);
}

# ホスト名を正引きし IPv4 -> IPv6 の順のリストを返す
sub nslookup
{
    my $self = shift;
    my $ident = ident $self;

    my $host = shift;

    my $res;
    if (exists $res_of{$ident}) {
	$res = $res_of{$ident};
    }
    else {
	$res_of{$ident} = $res = Net::DNS::Resolver->new;
    }

    my @result = ();
    my @result_ipv4 = ();
    my @result_ipv6 = ();
    for my $record ("A", "AAAA") {
	my $query = $res->query($host, $record);
	if ($query) {
	    foreach my $rr ($query->answer) {
		if ($rr->type eq "A") {
		    push(@result_ipv4, $rr->address);
		}
		elsif ($rr->type eq "AAAA") {
		    push(@result_ipv6, $rr->address);
		}
	    }
	}
    }
    @result = (@result_ipv4, @result_ipv6);
    return @result;
}

}

1;