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

##</code><code>##

#!/usr/bin/perl
use DB_File;
use Fcntl;
use Getopt::Std;

# 120000 2.217429, avg. 16 lookups, 360.434319750957/sec

my $maxprefix = 1000000; # ip prefix limit
my %o;
getopts('f:ast',\%o);

unless (@ARGV || grep { $_ }  @o{qw(t s)}) {
    die <<EOH;
usage: $0  -s [-f file] | [-a ] [ -t | ipaddress ]
-s : setup
-f : use values from file for setup ("xxx.xxx.xxx.xxx/nn nnnnn")
-t : average timing
-a : show all matching prefixes
EOH
}
#    unless @ARGV || grep {defined $_ } values %o;

my $filename = 'astable.db';

my $x; # DB_File handle
if ($o{s}) {
    if(! -e $filename) {
        $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE
            or die "cannot open $filename: $!\n";
    }
    else {
        die "file '$filename' exists, won't overwrite!\n";
    } 
}
else {
    $x = tie %h, "DB_File", $filename, O_RDONLY, 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 mask and network address, 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.


if ($o{s}) { # setup
    # generate some random IP addresses and masks
    # set all non-mask bits to 0 and store the generated
    # IP address (minus 1, if last byte is non-zero)
    # in the files 'ips' for further use in lookup timing

    unless (-f 'ips') {
        open IP,'>', 'ips';
    }
    else {
        die "file 'ips' exist, won't overwrite!\n";
    } 

    my $have_file;
    if ($o{f}) {
        $have_file = open I,'<', $o{f} or die "Can't read '$o{f}': $!\n";
    } 

    my $c;
    while ($. <=  $maxprefix) {
        my (@bytes,$mask,$value);
        if($have_file) {
            $_ = <I> or last;
            chomp;
            (@bytes[0..3],$mask,$value) = m!(\d+).(\d+).(\d+).(\d+)/(\d+)\s+(.*)!;
        }
        else {
            @bytes  = map { int rand 255 } 0..3;
            $mask   = int rand (30) + 1; # no null mask :)
        }

        my @nbits  = map {split//,unpack "B*",pack "C",$_ } @bytes;
        my @mbits  = ((1) x $mask, (0) x (32 - $mask));
        my $key    = '';
        my @b      = ();

        for (0..31) {
            my $mbit = shift @mbits;
            my $n    = shift @nbits;
            my $nbit = $mbit ? $n : 0;
            $key    .= $mbit . $nbit;
            push @b, $nbit;
        }
        redo if $h{$key};

        my $prefix = join('.',unpack "C4",pack"B32",join'',@b).'/'.$mask;
        $bytes[3]  += 1 if $bytes[3] == 0; # XXX should check network 
                                           # boundaries here...
        my $ip = join('.',@bytes);
        print IP $ip,"\n";
        $h{$key}  = $value || $prefix;
        $.++ unless $have_file;
    } 
    untie %h;
    exit 0;
} #setup

my $c; # lookup counter

if($o{t}) { # average
    open I, '<', 'ips';
    eval { require Time::HiRes };
    $@ and die "Sorry, no average here - Time::HiRes missing";
    Time::HiRes->import(qw(gettimeofday tv_interval));
    my $t0 = [gettimeofday()];
    my $t1 = [gettimeofday()];
    my $l;
    while(<I>) {
        chomp;
        my $net = match($_);
        $l += $c;
        unless($. % 1000) {
            my $e = tv_interval ( $t1, [gettimeofday()]);
            my $g = tv_interval ( $t0, [gettimeofday()]);
            print "$. $e, avg. ",int($l/$.);
            print ' lookups, ',$./$g,"/sec\n";
            $t1 = [gettimeofday()];
        }
    } 
    my $elapsed = tv_interval ( $t0, [gettimeofday()]);
    print "elapsed: $elapsed\n";
    print "avg. lookup time: ",$elapsed / $.,"\n";
}
else {
    /^\d+\.\d+\.\d+\.\d+$/ and print "$_ => ",match($_),"\n" for @ARGV;
}

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

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

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

    $c = 1; # lookup counter
    for(@bits) {
        my $lk = $key .= 1 . $_;
        #print "$key\n";
        next if $ok and $ok =~ /^$key/; # shortcut

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

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

        unless ($lk =~ /^$key/ && $v && length ($lk) == 64) {
            if ($o{a}) {
                print "    $_\n" for @net;
            }
            print "$c lookups - " if wantarray;
            return pop @net;      # return net with longest mask
        } 
        $ok = $lk;
        $c++;
        die "more than 32 lookups" if $c > 32;
    }
    # only one or no prefix found
    print "$c lookups - " if wantarray;
    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;
}