Created
October 9, 2015 11:55
-
-
Save chenryn/40620f3ea734f42c0e56 to your computer and use it in GitHub Desktop.
a perl6 script to call libmaxminddb using NativeCall
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl6-m | |
use v6; | |
use NativeCall; | |
class MaxMindDB { | |
enum MMDB_DATA_TYPE ( | |
MMDB_DATA_TYPE_EXTENDED => 0, | |
MMDB_DATA_TYPE_POINTER => 1, | |
MMDB_DATA_TYPE_UTF8_STRING => 2, | |
MMDB_DATA_TYPE_DOUBLE => 3, | |
MMDB_DATA_TYPE_BYTES => 4, | |
MMDB_DATA_TYPE_UINT16 => 5, | |
MMDB_DATA_TYPE_UINT32 => 6, | |
MMDB_DATA_TYPE_MAP => 7, | |
MMDB_DATA_TYPE_INT32 => 8, | |
MMDB_DATA_TYPE_UINT64 => 9, | |
MMDB_DATA_TYPE_UINT128 => 10, | |
MMDB_DATA_TYPE_ARRAY => 11, | |
MMDB_DATA_TYPE_CONTAINER => 12, | |
MMDB_DATA_TYPE_END_MARKER => 13, | |
MMDB_DATA_TYPE_BOOLEAN => 14, | |
MMDB_DATA_TYPE_FLOAT => 15, | |
); | |
enum MMDB ( | |
MMDB_SUCCESS => 0, | |
MMDB_FILE_OPEN_ERROR => 1, | |
MMDB_CORRUPT_SEARCH_TREE_ERROR => 2, | |
MMDB_INVALID_METADATA_ERROR => 3, | |
MMDB_IO_ERROR => 4, | |
MMDB_OUT_OF_MEMORY_ERROR => 5, | |
MMDB_UNKNOWN_DATABASE_FORMAT_ERROR => 6, | |
MMDB_INVALID_DATA_ERROR => 7, | |
MMDB_INVALID_LOOKUP_PATH_ERROR => 8, | |
MMDB_LOOKUP_PATH_DOES_NOT_MATCH_DATA_ERROR => 9, | |
MMDB_INVALID_NODE_NUMBER_ERROR => 10, | |
MMDB_IPV6_LOOKUP_IN_IPV4_DATABASE_ERROR => 11, | |
); | |
class MMDB_entry_data_s is repr('CStruct') { | |
# CStruct don't support bool | |
has int $.has_data; | |
has int32 $.pointer; | |
has Str $.utf8_string; | |
has num $.double_value; | |
has int8 $.bytes; | |
has int16 $.uint16; | |
has int32 $.uint32; | |
has int32 $.int32; | |
has int64 $.uint64; | |
has CArray[int8] $.uint128; | |
# CStruct don't support bool | |
has int $.boolean; | |
has num32 $.float_value; | |
has int32 $.offset; | |
has int32 $.offset_to_next; | |
has int32 $.data_size; | |
has int32 $.type; | |
} | |
class MMDB_ipv4_start_node_s is repr('CStruct') { | |
has int16 $.netmask; | |
has int32 $.node_value; | |
} | |
class MMDB_description_s is repr('CStruct') { | |
has Str $.language; | |
has Str $.description; | |
} | |
class metadata_languages is repr('CStruct') { | |
has int $.count; | |
has Str $.names; | |
} | |
class metadata_description is repr('CStruct') { | |
has int $.count; | |
has MMDB_description_s $.descriptions; | |
} | |
class MMDB_metadata_s is repr('CStruct') { | |
has int32 $.node_count; | |
has int16 $.record_size; | |
has int16 $.ip_version; | |
has Str $.database_type; | |
has metadata_languages $.languages; | |
has int16 $.binary_format_major_version; | |
has int16 $.binary_format_minor_version; | |
has int64 $.build_epoch; | |
has metadata_description $.description; | |
} | |
class MMDB_entry_data_list_s is repr('CStruct') { | |
has MMDB_entry_data_s $.entry_data; | |
has MMDB_entry_data_list_s $.next; | |
} | |
class MMDB_s is repr('CStruct') { | |
has int32 $.flags; | |
has Str $.filename; | |
has int $.file_size; | |
has int8 $.file_content; | |
has int8 $.data_section; | |
has int32 $.data_section_size; | |
has int8 $.metadata_section; | |
has int32 $.metadata_section_size; | |
has int16 $.full_record_byte_size; | |
has int16 $.depth; | |
has MMDB_ipv4_start_node_s $.ipv4_start_node; | |
has MMDB_metadata_s $.metadata; | |
} | |
class MMDB_entry_s is repr('CStruct') { | |
has MMDB_s $.mmdb; | |
has int32 $.offset; | |
} | |
class MMDB_lookup_result_s is repr('CStruct') { | |
# CStruct don't support bool | |
has int $.found_entry; | |
has MMDB_entry_s $.entry; | |
has int16 $.netmask; | |
} | |
sub LIB { | |
given $*VM.config{'load_ext'} { | |
when '.so' { return 'libmaxminddb.so.1' } # Linux | |
when '.bundle' { return 'libmaxminddb.dylib' } # Mac OS | |
default { return 'libmaxminddb' } | |
} | |
} | |
sub MMDB_open ( Str, Int, MMDB_s ) returns Int is native( LIB ) { * } | |
sub MMDB_lookup_string ( MMDB_s, Str, Int, Int ) returns MMDB_lookup_result_s is native( LIB ) { * } | |
sub MMDB_aget_value ( MMDB_entry_s, MMDB_entry_data_s, CArray[Str] ) returns Int is native( LIB ) { * } | |
sub MMDB_get_entry_data_list ( MMDB_entry_s, MMDB_entry_data_list_s ) returns Int is native( LIB ) { * } | |
sub MMDB_free_entry_data_list ( MMDB_entry_data_list_s ) returns Bool is native( LIB ) { * } | |
sub MMDB_close ( MMDB_s ) returns Bool is native( LIB ) { * } | |
sub MMDB_lib_version ( Bool ) returns Str is native( LIB ) { * } | |
sub MMDB_strerror ( Int ) returns Str is native( LIB ) { * } | |
sub MMDB_entry_to_perl ( MMDB_entry_data_list_s $entry_data_list ) { | |
my $first = $entry_data_list; | |
while $entry_data_list.next -> $entry_data_list { | |
given $entry_data_list.entry_data.type { | |
when MMDB_DATA_TYPE_MAP { ... } | |
when MMDB_DATA_TYPE_ARRAY { ... } | |
when MMDB_DATA_TYPE_UTF8_STRING { | |
say $entry_data_list.entry_data.utf8_string; | |
last; | |
} | |
} | |
} | |
MMDB_free_entry_data_list($first); | |
} | |
has MMDB_s $!mmdb = .new; | |
has Str $!file where $_.IO ~~ :f & :r; | |
submethod BUILD ( :$!file ) { | |
# MMDB_MODE_MMAP == 1 | |
my $ret = MMDB_open($!file, 1, $!mmdb); | |
if MMDB_SUCCESS != $ret { | |
note MMDB_strerror($ret); | |
exit(2); | |
} | |
} | |
submethod DESTROY { | |
MMDB_close($!mmdb); | |
} | |
method lookup ( Str $ip where /^\d+\.\d+\.\d+\.\d+$/ ) { | |
my ($gai_error, $mmdb_error); | |
my $result = MMDB_lookup_string( $!mmdb, $ip, $gai_error, $mmdb_error); | |
if $gai_error { | |
note "Error from call to getaddrinfo for {$ip}"; | |
exit(3); | |
} | |
if MMDB_SUCCESS != $mmdb_error { | |
my $err_msg = MMDB_strerror($mmdb_error); | |
note "Got an error from the maxminddb library: {$err_msg}"; | |
exit(4); | |
} | |
return $result; | |
} | |
multi method get ( Str $ip! where /^\d+\.\d+\.\d+\.\d+$/, @path = [] ) { | |
my $result = $.lookup($ip); | |
my MMDB_entry_data_list_s $entry_data_list = .new; | |
my @c_path := CArray[Str].new(); | |
@c_path[$_] = @path[$_] for ^@path.elems; | |
@c_path[@path.elems] = Str; | |
if $result.found_entry { | |
my Int $status; | |
my MMDB_entry_data_s $entry_data = .new; | |
$status = MMDB_aget_value( $result.entry, $entry_data, @c_path); | |
if MMDB_SUCCESS == $status { | |
if $entry_data.offset { | |
my $entry = MMDB_entry_s.new(mmdb => $!mmdb, offset => $entry_data.offset); | |
$status = MMDB_get_entry_data_list($entry, $entry_data_list); | |
} | |
} | |
if MMDB_SUCCESS != $status { | |
note "Got an error looking up the entry data - {MMDB_strerror($status)}"; | |
} | |
MMDB_entry_to_perl($entry_data_list); | |
} | |
MMDB_free_entry_data_list($entry_data_list); | |
} | |
} | |
my $mmdb = MaxMindDB.new(file=>'/Users/raochenlin/gitdir/rsyslog-maxminddb/src/tests/test.mmdb'); | |
$mmdb.get("202.106.0.20",["city"]); | |
# set filetype=perl6 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Not totally complete. Because NativeCall don't support __int128 and bool in CStruct now.
the submethod BUILD got segmentfault at
MMDB_open
call, I believe this must because the structs...