#!/usr/bin/perl
use DB_File;
use Fcntl;

my $filename = 'astable.db';

my $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE
    or die "cannot open $filename: $!\n";

# set up AS table. To perform a binary search,
# we build a bit string as a sequence of alternating bits
# of network address and mask, i.e. having 10.223.2.0/23, we get
#
# net:   0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0
# mask: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
# key:  1010101011101110111110111111111110101010101011000000000000000000
#
# for ip searches, we set the "mask part bits" of an ip all to 1, and do
# a incremental partial match against the keys in the table.

while(<DATA>) {
    chomp;
    my $ip = $_;
    my ($net,$mask) = split /\//;
    my @nbits = split//,unpack("B*",pack"C4",split/\./,$net);
    my @mbits = ((1) x $mask, (0) x (32 - $mask));
    
    # merge bits
    my $key;
    for (0..31) {
        $key .= shift(@mbits) . shift(@nbits);
    }
    $h{$key} = $ip; # we just store the cidr for demo
} 

sub match {
    my $ip = shift;
    my $packedip  = pack "C4",split/\./,$ip;
    my $numericip = unpack "N", $packedip;
    my @bits = split //,unpack "B*",$packedip;
    my $dk;
    my $c = 1;

    # reset cursor.
    $x->seq(my $foo,my $bar,R_FIRST);

    # now search until mismatch. 
    my ($key,$ok,$v,@net);

    for(@bits) {
        my $lk = $key .= 1 . $_;
        next if $ok and $ok =~ /^$key/; # shortcut

        $x->seq($lk,$v,R_CURSOR);

        # check if this key is a candidate
        push @net, $v if in_range($numericip,$lk);

        unless ($lk =~ /^$key/ && $v && length($lk) == 64) {
            print "$c lookups - ";
            return pop @net;        # return net with longest mask
        } 
        $ok = $lk;
        $c++;
    }
    # only one or no prefix found
    print "$c lookups - ";
    pop @net;
} 

sub in_range {
    my ($ip,$bits) = @_;
    my $net;
    $bits =~ s/(.)(.)/$net.=$2;$1/ge;
    my ($addr, $mask) = map { pack "B32",$_ } $net, $bits;
    my ($n,$m,$b) = map { unpack"N",$_} $addr,$mask,$addr|~$mask;
    $ip >= $n && $ip <= $b;
} 

my $ip = shift;
print match($ip),"\n\n";

__DATA__
192.168.12.0/24
10.0.0.0/8
10.223.0.0/16
10.223.2.0/17
10.223.2.0/23
10.223.2.0/25
10.1.2.0/23
10.110.1.0/24
10.110.2.0/24
10.110.3.0/24
10.110.4.0/24
10.110.5.0/28
10.114.1.0/24
10.114.10.0/24
10.114.11.0/24
10.114.12.0/24
10.114.13.0/24
10.114.14.0/24
10.114.15.0/24
10.114.16.0/24
10.114.17.0/24
10.114.18.0/24
10.114.19.0/24
10.114.20.0/24
10.114.21.0/24
10.114.22.0/24
10.114.23.0/24
10.114.24.0/24
10.114.25.0/24
10.114.26.0/24
10.114.27.0/24
10.114.28.0/24
10.114.29.0/24
10.114.3.0/24
10.114.30.0/24
10.114.31.0/24
10.114.32.0/24
10.114.33.0/24
10.114.34.0/24
10.114.35.0/24
10.114.36.0/24
10.114.37.0/24
10.114.38.0/24
10.114.39.0/24
10.114.4.0/24
10.114.40.0/24
10.114.41.0/24
10.114.42.0/24
10.114.43.0/24
10.114.44.0/24
10.114.45.0/28
10.114.45.128/28
10.114.45.144/28
10.114.45.16/28
10.114.45.160/28
10.114.45.176/28
10.114.45.32/28
10.114.45.48/28
10.114.45.64/28
10.114.45.80/28
10.114.45.96/28
10.114.49.0/24
10.114.5.0/24
10.114.6.0/24
10.114.7.0/24
10.114.9.0/24
10.116.1.0/24
10.116.10.0/24
10.116.11.0/24
10.116.12.0/24
10.116.13.0/24
10.116.14.0/24
10.116.15.0/24
10.116.16.0/24
10.116.17.0/24
10.116.18.0/24
10.116.19.0/28
10.116.19.112/28
10.116.19.16/28
10.116.2.0/24
10.116.20.0/24
10.116.21.0/24
10.116.22.0/24
10.116.25.0/24
10.116.27.0/24
10.116.3.0/24
10.116.4.0/24
10.116.5.0/24
10.116.6.0/24
10.116.7.0/24
10.116.8.0/24
10.116.9.0/24
10.118.1.0/24
10.118.2.0/24
10.118.3.0/24
10.118.4.0/24
10.118.5.0/28
10.122.1.0/24
10.122.2.0/24
10.122.3.0/24
10.122.4.0/24
10.122.5.0/24
10.122.6.0/24
10.122.7.0/28
10.122.8.0/24
10.122.9.0/28
10.143.1.0/25
10.16.11.0/24
10.16.2.0/23
10.16.4.0/24
10.16.8.0/24
10.184.0.0/28
10.184.1.0/28
10.184.1.128/28
10.184.1.144/28
10.184.1.16/28
10.184.1.160/28
10.184.1.176/28
10.184.1.32/28
10.184.1.48/28
10.250.11.0/24
10.250.5.0/24
10.67.1.0/24
10.67.4.0/24

##</code><code>##

perl ip.pl 10.114.45.79
11 lookups - 10.114.45.64/28

perl ip.pl 10.223.123.34
5 lookups - 10.223.2.0/17

perl ip.pl 10.223.2.126 
7 lookups - 10.223.2.0/25