#!/usr/bin/perl

# 
# 
# CNGEOIP module
# 
# 

=head1 NAME

CNGeoip - Модуль для связи программ на языке PERL с базой CNGeoip

=head1 SYNOPSYS

use CNGeoip;
my $cngeoip = new CNGeoip('dbfile'=>"cngeoip.dat") || die;
my %res = $cngeoip->lookup($ip);
foreach my $key ( keys %res ) {
	print "($key) => ($res{$key})\n";
}
foreach my $item ( @{$res{'items'}} ) {
	print "item : (", join(")(", @{$item}), ")\n";
}

=head1 DESCRIPTION

Модуль предоставляет объект CNGeoip.

В конструкторе должен передаваться параметр 'dbfile', указывающий на расположение файла с базой CNGeoip. В случае
отсутствия возможности открыть указанный файл конструктор возвращает значение undef.

Объкт CNGeoip обладает методом lookup($ip). Метод возвращает хэш со следующими, не всегда обязательными, ключами:

'error' :	Если данный ключ присутствует, вызов завершился ошибкой. Возможны следующие значения ошибок
		$CNGeoip::E_INVALID_IP - аргумент не является ipv4-адресом в формате aaa.bbb.ccc.ddd
		$CNGeoip::E_NO_DATAFILE - файл базы данных не может быть открыт
		$CNGeoip::E_INVALID_SIGNATURE - файл не является базой данных CNGeoip
		$CNGeoip::E_INCOMPATIBLE_DATAFILE - файл базы данных не совместимой версии
		$CNGeoip::E_INVALID_POSITION - неверная позиция в файле базы данных, возможно, файл поврежден

'special' :	Если данный ключ присутствует, то искомый адрес относится к одному из зарезервированных диапазонов,
		например, 10.0.0.0/8, 192.168.0.0/16 и так далее. Является скаляром.

'items' : 	В случае, если адрес не является зарезервированным, содержит ссылку на список как минимум из одного элемента.
		Каждый элемент списка является описанием географического места. Первый - наиболее точно указывает на место,
		обычно это описание города. Далее может идти описание области, штата, земли. Последний элемент - обычно страна.
		Максимальное количество элементов не регламентировано. Минимальное количество элементов: 1, в таком случае это
		страна.
		
		Каждый элемент является ссылкой на список из 7 элементов. Описание элементов:
		[0] - тип географической единицы. Содержит один символ:
			'c' - страна
			'r' - область/штат/провинция
			't' - город
			'd' - район города
			's' - улица;
		[1] - название на национальном языке страны;
		[2] - название на английском языке;
		[3] - название на русском языке;
		[4] - географическая широта в градусах от -90 до 90. Положительные значения
		соответствуют северному полушарию, отрицательные - южному.
		[5] - географическая долгота в градусах от -180 до 180. Положительные
		значения соответствуют восточному полушарию, отрицательные - западному.
		[6] - краткий двух- или трехбуквенный код страны или штата.
		
		Ключи 'special' и 'items' взаимно исключают друг друга.

'line' :	В случае, если присутствует ключ 'special' или 'items', содержит скалярное описание адреса.


=cut

package CNGeoip;

use strict;

our ($VERSION, $E_INVALID_IP, $E_NO_DATAFILE, $E_INVALID_SIGNATURE, $E_INCOMPATIBLE_DATAFILE, $E_INVALID_POSITION);


BEGIN {
    $VERSION='4';

    *E_INVALID_IP =\ 'invalid ip';
    *E_NO_DATAFILE =\ 'no datafile';
    *E_INVALID_SIGNATURE =\ 'invalid signature';
    *E_INCOMPATIBLE_DATAFILE =\ 'incompatible datafile version';
    *E_INVALID_POSITION =\ 'invalid datafile position';
}


sub new {
    my($class, %init) = @_;
    my $self = {};
    bless $self;

    if ( defined $init{'dbfile'} ) {
	$$self{'dbfile'} = $init{'dbfile'};
    }
    else {
	$$self{'dbfile'} = "cngeoip.dat";
    }
    return undef unless -r $$self{'dbfile'};
    return undef unless -f $$self{'dbfile'};

    return $self;
}



sub lookup {
    my ($self, $ip) = @_;

    # Проверка формата аргумента $ip.
    return ( 'error' => $E_INVALID_IP ) unless $ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
    return ( 'error' => $E_INVALID_IP ) if $1>255 || $2>255 || $3>255 || $4>255;

    my ( $ipint, $FILE, $data, @LEVEL_SIZE, $fxc, $shift, $offset, $info );

    # Преобразование адреса в формат 32-битного целого
    $ipint = ($1<<24) + ($2<<16) + ($3<<8) + $4;

    open($FILE, $$self{'dbfile'}) || return ( 'error' => $E_NO_DATAFILE );

    use bytes;
    
    # Проверка версии датафайла
    read($FILE, $data, 4);
    my $label = unpack('N', $data);
    return ('error'=>$E_INVALID_SIGNATURE, 'signature'=>(($label >> 8) & 0xffffff)) if (($label >> 8) & 0xffffff) != 0xcd301b;
    return ('error'=>$E_INCOMPATIBLE_DATAFILE, 'version'=>($label & 0xff)) if ($label & 0xff) != 0x01;

    for (;;) {
	read($FILE, $data, 1);
	my $byte = unpack('C', $data);
	my $hi = ($byte>>4) & 0x0f;
	my $lo = $byte & 0x0f;
	push @LEVEL_SIZE, $hi;
	last if $hi == 0;
	push @LEVEL_SIZE, $lo;
	last if $lo == 0;
    }

    $fxc = 1;
    for(my $i=0,my $left=32;$i<@LEVEL_SIZE;$i++) {
	last if $LEVEL_SIZE[$i] == 0;
	$fxc <<= $LEVEL_SIZE[$i];
	$fxc += $left;
	$fxc = (($fxc >> 11) & 0x001fffff) + ( $fxc << 11);
	$left -= $LEVEL_SIZE[$i];
    }
    
    $shift = 32;
    $offset = tell($FILE);
    
    for(my $l=0; $l<@LEVEL_SIZE; $l++) {
	$shift -= $LEVEL_SIZE[$l];
	my $index = (($ipint>>$shift)) & ((1<<$LEVEL_SIZE[$l])-1);
	my $tell = $offset + $index*4;
	seek($FILE, $tell, 0) || return ('error'=>$E_INVALID_POSITION);
	read($FILE, $data, 4) || return ('error'=>$E_INVALID_POSITION);

	$offset = unpack('N',$data) ^ $fxc ^ $tell;
	$offset &= 0xffffffff;
	if ( $offset & 0x80000000 ) {
	    $tell = $offset & 0x7fffffff;
	    seek($FILE, $tell, 0) || return ('error'=>$E_INVALID_POSITION);
	    read($FILE, $data, 2) || return ('error'=>$E_INVALID_POSITION);
	    my $length = ( unpack('n', $data) ^ $fxc ^ $tell ) & 0xffff;
	    $tell += 2;
	    my $xor = $tell ^ $fxc;
	    read($FILE, $data, $length) || return ('error'=>$E_INVALID_POSITION);
	    for(my $i=0,$info=""; $i<$length; $i++) {
		$info .= chr((ord(substr($data,$i,1)) ^ $xor) & 0xff );
		$xor = ( ($xor >> 3) &0x1fffffff) ^ ( ($xor & 0x1fffffff) << 3);
	    }
	    last;
	}
    }
    
    close($FILE);

    no bytes;

    my %result;
    $result{'line'} = $info;
    my @array = split /\!/, $info;
    if ( $array[0] eq '' ) {
	shift @array;
	$result{'items'} = [];
	foreach my $item ( @array ) {
	    push @{$result{'items'}}, [ split(/\|/, $item) ];
	}
    }
    else {
	$result{'special'} = $info;
    }

    return %result;
}



1;


__END__
