# -*- perl -*- # Copyright (C) 2014 Sergey Poznyakoff # # 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 3, or (at your option) # any later version. # # 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. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . package Whoseip::DB; use strict; use Fcntl qw(SEEK_SET SEEK_CUR :flock); use Socket qw(inet_ntoa); use Storable qw(freeze thaw); use Data::UUID; use Carp; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw(ipdb_open ipdb_lookup ipdb_insert ipdb_sync ipdb_locker ipdb_close) ] ); our @EXPORT_OK = ( qw(ipdb_open ipdb_lookup ipdb_insert ipdb_sync ipdb_locker ipdb_close) ); our @EXPORT = qw(); our $VERSION = "0.1"; =pod =head1 NAME Whoseip::DB - WhoseIP cache database =head1 SYNOPSIS use Whoseip::DB; use Whoseip::DB qw(:all); $dbf = Whoseip::DB::ipdb_open($filename[, pagesize => $psize, cachesize => $csize]); $ref = Whoseip::DB::ipdb_lookup($ip); print $ref->{country} if defined($ref); Whoseip::DB::ipdb_insert($dbf, "192.0.2.0/24", 'US'); Whoseip::DB::ipdb_close($dbf); =head1 DESCRIPTION The B package provides functions for creating and accessing a B(1) cache database. This database is analogous to a GeoIP database, except that it keeps more information. The database is kept in a single file and consists of B of the same size. The file begins with a 512-byte header block of the following structure: B B B 0 8 "WHOSEIP\0" 8 2 major version 10 2 minor version 12 16 UUID 28 4 page size 32 4 number of allocated pages 36 4 number of entries in root index table 40 472 root index table The first three fields serve to identify the file format and its version. At the time of this writing, major and minor versions are B<1>.B<0>. B defines the size of the file page. It defaults to 1280 bytes. Pages are of two types: B, that serve to navigate through the file, and B, that keep actual data. The B, located at the end of the file header keeps offsets of the initial index page for IP addresses of different sizes kept in the database. Each entry in this table consists of two 32-bit words: the first one keeps the length of the IP address in bits (e.g. 32 for IPv4 and 128 for IPv6), and the second one keeps the offset of the first index table for entries of that size. The table can accomodate at most 59 entries, which is more than enough for the purpose. An B contains a table of offsets of the next page to look up (whether index or leaf) and is indexed by the octet value (0 -- 255). An extra slot keeps the offset of the leaf page. The overall structure of an index page is as follows: B B B 0 4 Index page type: B<1> 4 4 OFF[0] 8 4 OFF[1] . . . . . . . . . 1024 4 OFF[255] 1028 4 OFF[LEAF] When looking up for an IP address, index pages are descended starting from the root page. The octets of the IP address in host order are iterated from left to right. Each subsequent octet is used to select offset of the next page from the current index page. If the corresponding offset is zero the last entry (B) is used. This process stops when the B is encountered. A B contains a table of Bs and their descriptions. Its structure is as follows: B B B 0 4 Leaf page type: B<2> 4 4 Number of entries in the table 8 4 Offset of the continuation page (0 if none) 12 4 Entry 0: network address 16 4 Entry 0: network mask 20 4 Entry 0: timestamp 24 2 Entry 0: ISO 3166-1 country code 26 4 Entry 0: length of additional data 30 ? Entry 0: additional data . . . . . . . . . 12+N*14 4 Entry N: network address 16+N*14 4 Entry N: network mask 20+N*14 4 Entry N: timestamp 24+N*14 2 Entry N: ISO 3166-1 country code 26+N*14 4 Entry N: length of additional data 30+N*14 ? Entry N: additional data When a leaf page is encountered, the IP address in question is compared with each entry in turn using the usual procedure (Bing with the network mask and comparing the result with the network address). Search stops when a matching entry is found. Very large tables can span several leaf pages: if no entry matches in the current page, the search continues at the continuation page whose offset is indicated by the third field. If that field is 0, the search returns failure. =cut my $dbsign = 'WHOSEIP'; my $vmajor = 1; my $vminor = 0; use constant IPDB_PAGE_INDEX => 1; use constant IPDB_PAGE_LEAF => 2; use constant LEAF_IDX => 256; sub pagetypestr { my $t = shift; return "index" if ($t == IPDB_PAGE_INDEX); return "leaf" if ($t == IPDB_PAGE_LEAF); return $t; } sub systell { sysseek($_[0], 0, SEEK_CUR) } my @ipdb_open_files; sub ipdb_close_all { foreach my $file (@ipdb_open_files) { ipdb_close($file) if defined($file->{fd}); } } END { ipdb_close_all(); } =pod =head2 B = Whoseip::DB::ipdb_open(I<$filename>>[B<,> I]B<);> Opens the database file I<$filename> and returns a descriptor to be used for searches in that file. I is a hash that can contain the following keys: =over 4 =item B Page size for the file. This option is honoured only when creating the file. It cannot be less than 1032 bytes. Default is 1280 bytes. =item B Maximum number of pages to keep in a B cache. Defaults to 16. =back =cut sub ipdb_open { my $filename = shift; local %_ = @_; my %ipdbfile; my $fd; if (-e $filename) { my $mode; if ($_{mode} eq 'ro') { $ipdbfile{mode} = "<"; } elsif ($_{mode} eq 'rw') { $ipdbfile{mode} = "+<"; } elsif (-w $filename) { $ipdbfile{mode} = "+<"; } else { $ipdbfile{mode} = "<"; } open($fd, $ipdbfile{mode}, $filename) or croak "can't open $filename: $!"; binmode $fd; croak "$filename is not a valid IP cache file" unless sysread($fd, my $s, 512) == 512; my ($sign,$maj,$min,$uuid,$size,$np,$count,@tab) = unpack('Z8 S S a16 L L L L*', $s); croak "$filename is not a valid IP cache file" unless $sign eq $dbsign; croak "$filename is of wrong version ($maj.$min, expected $vmajor.$vminor)" unless ($maj == $vmajor and $min == $vminor); croak "$filename: page size too small ($size)" if ($size < 1032); $ipdbfile{uuid} = $uuid; $ipdbfile{pagesize} = $size; $ipdbfile{numpages} = $np; for (my $i = 0; $i < $count; $i += 2) { $ipdbfile{rootidx}->{$tab[$i]} = $tab[$i+1]; print STDERR "ROOTIDX $tab[$i]=$tab[$i+1]\n" if $_{debug} > 1; } } else { open($fd, "+>", $filename) or croak "can't open $filename: $!"; binmode $fd; $ipdbfile{pagesize} = defined($_{pagesize}) ? $_{pagesize} : 1280; $ipdbfile{numpages} = 0; my $ug = new Data::UUID; my $uuid = $ug->create(); $ipdbfile{uuid} = $uuid; syswrite($fd, pack('Z8 S S a16 L L L @512', $dbsign, $vmajor, $vminor, $uuid, $ipdbfile{pagesize}, 0, 0)); } $ipdbfile{filename} = $filename; $ipdbfile{fd} = $fd; $ipdbfile{maxpagecache} = defined($_{maxpagecache}) ? $_{maxpagecache} : 16; $ipdbfile{debug} = $_{debug}; if ($ipdbfile{debug} > 1) { my $ug = new Data::UUID; print STDERR "file $filename, UUID ".$ug->to_string($ipdbfile{uuid})."\n"; } push @ipdb_open_files, \%ipdbfile; return \%ipdbfile; } =pod =head2 B>[B<, I>]B<);> Lock or unlock the database. I is a hash of the following options: =over 4 =item B => I Defines the locking operation. I is one of: B or B, B or B, B or B. If this option is not supplied, no locking will be done. This is useful to force syncronization with the disk state. =item B => B<0>|B<1> When set to B<0>, disables synchronization with the disk file. Default is B<1>. =cut sub ipdb_locker { my ($dbf) = shift; local %_ = @_; my $mode; if ($_{lock} eq 'exclusive') { $mode = LOCK_EX; } elsif ($_{lock} eq 'shared') { $mode = LOCK_SH; } elsif ($_{lock} eq 'unlock') { $mode = LOCK_UN; } else { $mode = $_{lock}; } if (defined($mode)) { flock($dbf->{fd}, $mode) or do { carp "$dbf->{filename}: can't lock: $!"; return 0; }; if ($mode == LOCK_UN) { delete $dbf->{lockmode}; } else { $dbf->{lockmode} = $mode; } return 1 if $mode == LOCK_UN; } return 1 if (defined($_{sync} and $_{sync} == 0)); if (sysseek($dbf->{fd}, 0, SEEK_SET) != 0) { croak "$dbf->{filename}: can't seek: $!"; } croak "$dbf->{filename}: read error: $!" unless sysread($dbf->{fd}, my $s, 512) == 512; my ($sign,$maj,$min,$uuid,$size,$np,$count,@tab) = unpack('Z8 S S a16 L L L L*', $s); if ($uuid ne $dbf->{uuid}) { print STDERR "$dbf->{filename}: disk file has changed\n" if $dbf->{debug}; # Re-initialize DB info $dbf->{uuid} = $uuid; $dbf->{pagesize} = $size; $dbf->{numpages} = $np; for (my $i = 0; $i < $count; $i += 2) { $dbf->{rootidx}{$tab[$i]} = $tab[$i+1]; print STDERR "ROOTIDX $tab[$i]=$tab[$i+1]\n" if $_{debug} > 1; } # Invalidate the cache ipdb_cache_invalidate($dbf); } return 1; } sub ipdb_save_page($$) { my ($dbf, $page) = @_; if (sysseek($dbf->{fd}, $page->{off}, SEEK_SET) != $page->{off}) { croak "$dbf->{filename}: can't seek: $!"; } my $ret; if ($page->{type} == IPDB_PAGE_INDEX) { print STDERR "saving index page $page->{off}: ". join(',', @{$page->{tab}})."\n" if $dbf->{debug} > 1; $ret = syswrite($dbf->{fd}, pack('LL[257].', $page->{type}, @{$page->{tab}}, $dbf->{pagesize}), $dbf->{pagesize}); croak "$dbf->{file}: write error at $page->{off}: $ret: $!" unless ($ret == $dbf->{pagesize}); delete $page->{dirty}; } elsif ($page->{type} == IPDB_PAGE_LEAF) { my $nextpage; do { print STDERR "saving leaf page $page->{off}\n" if $dbf->{debug} > 1; my $size = length(pack('LLL',0,0,0)); my $i = 0; my $a; foreach my $ent (@{$page->{tab}}) { my $fdata = eval { freeze($ent->[4]) }; if ($@) { print STDERR "failed to freeze data for " . inet_ntoa(pack('N', $ent->[0])) . "/" . inet_ntoa(pack('N', $ent->[1])) . ":". $ent->[3] ."\n"; exit; } my $x = pack('LLLa2L/a', @{$ent}[0 .. 3],$fdata); my $l = length($x); if ($size + $l > $dbf->{pagesize}) { print STDERR "SPLIT at $i: $size + $l, rest ". ($#{$page->{tab}}-$i+1)."\n" if $dbf->{debug} > 1; $nextpage = ipdb_alloc_page($dbf, IPDB_PAGE_LEAF, nocache => 1); $page->{next} = $nextpage->{off}; @{$nextpage->{tab}} = @{$page->{tab}}[$i .. $#{$page->{tab}}]; $nextpage->{dirty} = 1; splice @{$page->{tab}}, $i; last; } $size += $l; $a .= $x; ++$i; } $ret = syswrite($dbf->{fd}, pack('LLLa'.length($a).'@'.$dbf->{pagesize}, $page->{type}, $i, $page->{next}, $a)); croak "$dbf->{file}: write error at $page->{off}: $ret: $!" unless ($ret == $dbf->{pagesize}); delete $page->{dirty}; $page = $nextpage; $nextpage = undef; } while (defined($page)); } else { croak "unrecognized page type ($page->{type})"; } } sub ipdb_cache_invalidate($) { my $dbf = shift; $dbf->{pagecache} = (); } sub ipdb_cache_put($$) { my ($dbf,$page) = @_; if (keys(%{$dbf->{pagecache}}) >= $dbf->{maxpagecache}) { my $prev = $dbf->{pagecache}{lru_oldest}{lru_newer}; if ($dbf->{pagecache}{lru_oldest}{dirty}) { ipdb_save_page($dbf, $dbf->{pagecache}{lru_oldest}); } delete $dbf->{pagecache}{$dbf->{pagecache}{lru_oldest}{off}}; $dbf->{pagecache}{lru_oldest} = $prev; delete $prev->{lru_older}; } my $n = $dbf->{pagecache}{lru_newest}; if (defined($n)) { $n->{lru_newer} = $page; } $page->{lru_newer} = undef; $page->{lru_older} = $n; $dbf->{pagecache}{lru_newest} = $page; $dbf->{pagecache}{lru_oldest} = $page unless defined $dbf->{pagecache}{lru_oldest}; $dbf->{pagecache}{$page->{off}} = $page; dump_lru($dbf, "put $page->{off}"); } sub dump_lru { my ($dbf,$pfx) = @_; return unless $dbf->{debug} > 2; my $x = $dbf->{pagecache}{lru_oldest}; print STDERR "DUMP $pfx\n"; print STDERR "KEYS: ".join(',', sort keys %{$dbf->{pagecache}})."\n"; while (defined($x)) { print STDERR "==> $x->{off} (".pagetypestr($x->{type}).","; if (defined($x->{lru_newer})) { print STDERR $x->{lru_newer}{off}; } else { print STDERR "NIL"; } print STDERR ","; if (defined($x->{lru_older})) { print STDERR $x->{lru_older}{off}; } else { print STDERR "NIL"; } print STDERR ")\n"; $x = $x->{lru_newer}; } print STDERR "END\n"; } sub ipdb_cache_get($$) { my ($dbf,$off) = @_; my $page; if (defined($dbf->{pagecache}{$off})) { print STDERR "$off found in cache\n" if $dbf->{debug}; $page = $dbf->{pagecache}{$off}; if (defined($page->{lru_newer})) { print STDERR "promoting $page->{off}\n" if $dbf->{debug} > 2; # promote the page if (defined($page->{lru_older})) { $page->{lru_older}{lru_newer} = $page->{lru_newer}; } else { # It was the oldest page $dbf->{pagecache}{lru_oldest} = $page->{lru_newer}; } $page->{lru_newer}{lru_older} = $page->{lru_older}; $page->{lru_older} = $dbf->{pagecache}{lru_newest}; $dbf->{pagecache}{lru_newest}{lru_newer} = $page; $dbf->{pagecache}{lru_newest} = $page; $page->{lru_newer} = undef; $dbf->{pagecache}{lru_oldest} = $page unless defined $dbf->{pagecache}{lru_oldest}; dump_lru($dbf, "after promoting $page->{off}"); } } else { print STDERR "$off NOT found in cache\n" if $dbf->{debug}; $page = ipdb_get_page($dbf, $off); ipdb_cache_put($dbf, $page); } return $page; } =pod =head2 B);> Sunchronizes the database with the disk. =cut sub ipdb_sync($) { my $dbf = shift; if ($dbf->{modified}) { croak "$dbf->{filename}: can't seek: $!" if (sysseek($dbf->{fd}, 0, SEEK_SET) != 0); my $ug = new Data::UUID; $dbf->{uuid} = $ug->create(); my $n = syswrite($dbf->{fd}, pack('Z8 S S a16 L L L L* @512', $dbsign, $vmajor, $vminor, $dbf->{uuid}, $dbf->{pagesize}, $dbf->{numpages}, keys(%{$dbf->{rootidx}})+0, map { $_, $dbf->{rootidx}{$_} } keys %{$dbf->{rootidx}})); croak "$dbf->{filename}: write error at header: $n: $!" unless ($n == 512); $dbf->{modified} = 0; } while (my ($off, $page) = each %{$dbf->{pagecache}}) { ipdb_save_page($dbf, $page) if $page->{dirty}; } } =pod =head2 B);> Close the database. I<$dbf> is the handle returned from the previous call to B. =cut sub ipdb_close($) { my $dbf = shift; ipdb_locker($dbf, lock => LOCK_EX, sync => 0); ipdb_sync($dbf); ipdb_locker($dbf, lock => LOCK_UN); close $dbf->{fd}; delete $dbf->{fd}; } sub ipdb_get_page($$) { my ($dbf,$off) = @_; my %ret; if (sysseek($dbf->{fd}, $off, SEEK_SET) != $off) { croak "$dbf->{filename}: can't seek: $!"; } my $n = sysread($dbf->{fd}, my $s, $dbf->{pagesize}); unless (defined($n)) { croak "$dbf->{filename}: can't read page: $!"; } elsif ($n != $dbf->{pagesize}) { croak "$dbf->{filename}: short read ($n < $dbf->{pagesize})"; } $ret{type} = unpack('L', $s); $ret{off} = $off; if ($ret{type} == IPDB_PAGE_INDEX) { print STDERR "found index page at $off\n" if $dbf->{debug} > 3; my ($x, @a) = unpack('LL257', $s); $ret{tab} = \@a; } elsif ($ret{type} == IPDB_PAGE_LEAF) { (my $x, my $nent, $ret{next}) = unpack('LLL', $s); print STDERR "found leaf page at $off, has $nent entries\n" if $dbf->{debug} > 3; my ($x1, $x2, $x3, @a) = unpack("LLL(LLLa2L/a)$nent", $s); for (my $i = 0; $i < $nent; $i++) { my $href = thaw $a[$i*5 + 4]; if ($dbf->{debug} > 3) { print STDERR "[$i] = ".join(' ', @a[$i*5 .. $i*5 + 3]).'; ('; while (my ($k,$v) = each %{$href}) { print STDERR "$k => $v, "; } print STDERR ")\n"; } push @{$ret{tab}}, [ @a[$i*5 .. $i*5 + 3], $href ]; } } else { croak "$dbf->{filename}: invalid page type at offset $off"; } return \%ret; } sub ipdb_alloc_page($$) { my ($dbf,$type) = @_; my %page; local %_ = @_; $page{type} = $type; $page{off} = $dbf->{numpages}++ * $dbf->{pagesize} + 512; if ($type == IPDB_PAGE_INDEX) { $#{$page{tab}} = 256; } else { $page{next} = 0; $#{$page{tab}} = -1; } print STDERR "new ".pagetypestr($type)." page at $page{off}\n" if $dbf->{debug}; $page{dirty} = 1; ipdb_cache_put($dbf, \%page) unless ($_{nocache}); ++$dbf->{modified}; return \%page; } sub ipdb_get_root_page($$) { my ($dbf,$nbits) = @_; my $p; if (!defined($dbf->{rootidx}{$nbits})) { $p = ipdb_alloc_page($dbf, IPDB_PAGE_INDEX); print STDERR "root page for $nbits: created at $p->{off}\n" if $dbf->{debug} > 2; $dbf->{rootidx}{$nbits} = $p->{off}; $dbf->{modified}++; } else { print STDERR "root page for $nbits: $dbf->{rootidx}{$nbits}\n" if $dbf->{debug} > 2; $p = ipdb_cache_get($dbf, $dbf->{rootidx}{$nbits}); } return $p; } =pod =head2 $res = B, I<$ip>);> Look up IP address I<$ip> in the database identified by I<$dbf> (a handle returned by the previous call to B. If found, B<$ref> is a reference to a hash that contains the following keys: =over 4 =item B ISO 3166-1 country code =item B Network address in a dotted-quad form. =item B Network mask in a dotted-quad form. =back If not found, the function returns B. =cut sub ipdb_lookup_unlocked($$) { my ($dbf,$ipstr) = @_; my @ipo; my $ipn; my $nbits; if ($ipstr =~ /^\d{1,3}((\.\d{1,3}){3})$/) { @ipo = split(/\./, $ipstr); $ipn = ($ipo[0] << 24) + ($ipo[1] << 16) + ($ipo[2] << 8) + $ipo[3]; $nbits = 32; } else { print STDERR "ipdb_lookup: unsupported IP address $ipstr\n" if $dbf->{debug}; return undef; } print STDERR "ipdb_lookup: looking up for $ipstr\n" if $dbf->{debug}; my $page = ipdb_get_root_page($dbf, $nbits); my $n = 0; while (1) { if ($page->{type} == IPDB_PAGE_INDEX) { print STDERR "index page $page->{off}: ". join(',', @{$page->{tab}})."\n" if $dbf->{debug} > 1; print STDERR "ipdb_lookup: octet ${n}=$ipo[$n], off=$page->{tab}[$ipo[$n]]\n" if $dbf->{debug}; if ($page->{tab}[$ipo[$n]]) { $page = ipdb_cache_get($dbf, $page->{tab}[$ipo[$n]]); ++$n; next; } return undef if (!$page->{tab}[LEAF_IDX]); $page = ipdb_cache_get($dbf, $page->{tab}[LEAF_IDX]); } foreach my $r (@{$page->{tab}}) { print STDERR "ipdb_lookup: compare ($ipn & $r->[1]) == $r->[0]\n" if $dbf->{debug}; if (($ipn & $r->[1]) == $r->[0]) { # FIXME: check timestamp print STDERR "ipdb_lookup: MATCH $r->[3]\n" if $dbf->{debug}; my %res = ( country => $r->[3], network => inet_ntoa(pack('N', $r->[0])), netmask => inet_ntoa(pack('N', $r->[1])) ); @res{keys %{$r->[4]}} = values %{$r->[4]} if (defined($r->[4]) and ref($r->[4]) eq 'HASH'); return %res; } } return undef if (!$page->{next}); $page = ipdb_cache_get($dbf, $page->{next}); } } sub ipdb_lookup($$) { my ($dbf) = @_; if ($dbf->{lockmode} == LOCK_EX) { return &ipdb_lookup_unlocked; } elsif ($dbf->{lockmode} == LOCK_SH) { ipdb_locker($dbf, sync => 1); return &ipdb_lookup_unlocked; } else { ipdb_locker($dbf, lock => LOCK_SH); my %res = &ipdb_lookup_unlocked; ipdb_locker($dbf, lock => LOCK_UN); return %res; } } =pod =head2 $res = B, I<$cidr>, I<$country>);> Inserts into the database I<$cidr> and the corresponding country code I<$country>. Currently, I<$cidr> must be in the form B/I>. =cut sub ipdb_insert_unlocked { my $dbf = shift; my $cidr = shift; my $country = shift; local %_ = @_; my @ipo; my $ipn; my $masklen; my $netmask; my $nbits; return 0 if ($dbf->{mode} eq '<'); if ($cidr =~ m#^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/(\d+)$#) { @ipo = ( $1, $2, $3, $4 ); $ipn = ($1 << 24) + ($2 << 16) + ($3 << 8) + $4; $masklen = $5; $netmask = (0xffffffff ^ (0xffffffff >> $masklen)); $nbits = 32; } else { carp "invalid CIDR: $cidr"; return 0; } print STDERR "inserting $cidr $country\n" if $dbf->{debug}; my $n = int($masklen / 8); my $page = ipdb_get_root_page($dbf, $nbits); for (my $i = 0; $i < $n; $i++) { if ($page->{tab}[$ipo[$i]]) { print STDERR "ipdb_insert: octet ${i}=$ipo[$i], off=$page->{tab}[$ipo[$i]]\n" if $dbf->{debug}; $page = ipdb_cache_get($dbf, $page->{tab}[$ipo[$i]]); } else { my $p = ipdb_alloc_page($dbf, IPDB_PAGE_INDEX); $page->{tab}[$ipo[$i]] = $p->{off}; $page->{dirty} = 1; $page = $p; } } if ($page->{tab}[LEAF_IDX]) { print STDERR "ipdb_insert: loading leaf page from $page->{tab}[LEAF_IDX]\n" if $dbf->{debug}; $page = ipdb_cache_get($dbf, $page->{tab}[LEAF_IDX]); croak "$dbf->{filename}: index page found where leaf was expected" unless $page->{type} == IPDB_PAGE_LEAF; } else { print STDERR "ipdb_insert: creating leaf page\n" if $dbf->{debug}; my $p = ipdb_alloc_page($dbf, IPDB_PAGE_LEAF); $page->{tab}[LEAF_IDX] = $p->{off}; $page->{dirty} = 1; $page = $p; } push @{$page->{tab}}, [ $ipn, $netmask, time(), $country, \%_ ]; $page->{dirty} = 1; return 1; } sub ipdb_insert { my ($dbf) = @_; return &ipdb_insert_unlocked if ($dbf->{lockmode}); ipdb_locker($dbf, lock => LOCK_EX); my $res = &ipdb_insert_unlocked; ipdb_sync($dbf); ipdb_locker($dbf, lock => LOCK_UN); return $res; } 1;