1#!/usr/bin/perl -w 2use strict; 3$^W = 1; 4use Socket qw ( inet_aton inet_ntoa ); 5use IO::File; 6print "Building registry... this will take a moment...\n"; 7 8my %log2; 9for (my $i=0; $i<=31; $i++){ 10 $log2{2 ** $i} = $i; 11} 12 13# this is our fast stash 14my $tree = IPTree->new(); 15 16# and this is our pre-generated list of ranges 17my $reg_file = 'sorted_countries.txt'; 18 19open (REG, "< $reg_file") || die("can't open $reg_file: $!"); 20while (my $line = <REG>){ 21 chomp $line; 22 next unless $line =~ /^([^\|]+)\|([^\|]+)\|(..)$/; 23 my ($ip,$size,$cc) = ($1,$2,$3); 24 $cc = 'CZ' if ($cc eq 'CS'); 25 $cc = 'GB' if ($cc eq 'UK'); 26 my $packed_ip = inet_aton($ip); 27 my $packed_range = substr(pack('N',$log2{$size}),3,1); 28 $tree->add($packed_ip,$packed_range,$cc); 29} 30close REG || warn("can't close $reg_file, but continuing: $!"); 31 32 33print "Saving ultralite IP registry to disk\n"; 34my $ip = new IO::File "> ../lib/IP/Country/Fast/ip.gif"; 35if (defined $ip) { 36 binmode $ip; 37 print $ip pack("N",time()); # returned by $obj->db_time() 38 $tree->printTree($ip); 39 $ip->close(); 40} else { 41 die "couldn't write IP registry:$!\n"; 42} 43 44 45print "Saving ultralite country database to disk\n"; 46 47open (CC, "> ../lib/IP/Country/Fast/cc.gif") 48 or die ("couldn't create country database: $!"); 49binmode CC; 50foreach my $country (sort $tree->get_countries()){ 51 print CC substr(pack('N',$tree->get_cc_as_num($country)),3,1).$country; 52} 53close(CC); 54print "Finished.\n"; 55 56 57 58package IPTree; 59use strict; 60use Socket qw ( inet_aton inet_ntoa ); 61$^W = 1; 62 63my @mask; 64my %ctod; 65my @dtoc; 66my $bit0; 67my $bit1; 68my $bits12; 69my $null; 70BEGIN { 71 $bit0 = substr(pack('N',2 ** 31),0,1); 72 $bit1 = substr(pack('N',2 ** 30),0,1); 73 $bits12 = substr(pack('N',2 ** 30 + 2 ** 29),0,1); 74 $null = substr(pack('N',0),0,1); 75 for (my $i = 1; $i <= 32; $i++){ 76 $mask[$i] = pack('N',2 ** (32 - $i)); 77 } 78 79 for (my $i=0; $i<=255; $i++){ 80 $ctod{substr(pack('N',$i),3,1)} = $i; 81 $dtoc[$i] = substr(pack('N',$i),3,1); 82 } 83} 84 85sub new () 86{ 87 return bless { 88 countries => {} 89 }, 'IPTree'; 90} 91 92sub add ($$$$) 93{ 94 my ($tree,$ip,$packed_range,$cc) = @_; 95 $tree->_ccPlusPlus($cc); 96 my $netmask = 32 - $ctod{$packed_range}; 97 for (my $i = 1; $i <= $netmask; $i++){ 98 if (($ip & $mask[$i]) eq $mask[$i]){ 99 unless (exists $tree->{1}){ 100 $tree->{1} = {}; 101 } 102 $tree = $tree->{1}; 103 } else { 104 unless (exists $tree->{0}){ 105 $tree->{0} = {}; 106 } 107 $tree = $tree->{0}; 108 } 109 } 110 $tree->{cc} = $cc; 111} 112 113sub get_cc_as_num ($) 114{ 115 my ($self,$cc) = @_; 116 unless (exists $self->{sorted_cc}){ 117 $self->{sorted_cc} = {}; 118 my $i = 0; 119 foreach my $c (sort { $self->{countries}->{$b} <=> $self->{countries}->{$a} } 120 keys %{$self->{countries}}) 121 { 122 $self->{sorted_cc}->{$c} = $i; 123 $i++; 124 } 125 } 126 unless (exists $self->{sorted_cc}->{$cc}){ 127 die("couldn't find $cc in country database"); 128 } 129 return $self->{sorted_cc}->{$cc}; 130} 131 132sub get_countries () 133{ 134 my ($self) = @_; 135 unless (exists $self->{sorted_cc}){ 136 $self->get_cc_as_num('GB'); 137 } 138 return sort keys %{$self->{sorted_cc}}; 139} 140 141sub _ccPlusPlus ($) 142{ 143 my ($self,$cc) = @_; 144 if (exists $self->{countries}->{$cc}){ 145 $self->{countries}->{$cc}++; 146 } else { 147 $self->{countries}->{$cc} = 1; 148 } 149} 150 151sub printTree ($) 152{ 153 my ($self,$fh) = @_; 154 _printSize($self,$self,$fh); 155} 156 157sub _printSize 158{ 159 my ($self,$node,$fh) = @_; 160 if (exists $node->{cc}){ 161 # country codes are one or two bytes - 162 # popular codes being stored in one byte 163 my $cc = $self->get_cc_as_num($node->{cc}); 164 $cc = _encode_cc($cc); 165 print $fh $cc; 166 } else { 167 # jump distances are three bytes - might also be shrunk later 168 my $jump = _findSize($self,$node->{0}); 169 my $binary_jump = _encode_size($jump); 170 print $fh $binary_jump; 171 172 _printSize($self,$node->{0},$fh); 173 _printSize($self,$node->{1},$fh); 174 } 175} 176 177sub _encode_cc 178{ 179 my $cc = shift; 180 if ($cc < 64){ 181 return $dtoc[$cc] | $bit0; 182 } else { 183 return $dtoc[255] . $dtoc[$cc]; 184 } 185} 186 187sub _encode_size 188{ 189 my $size = shift; 190 if ($size < 64){ 191 return substr(pack('N',$size),3,1) | $bit1; 192 } else { 193 die ($size) if ($size >= 2**29); 194 return substr(pack('N',$size),1,3); 195 } 196} 197 198sub _findSize 199{ 200 my ($self,$node) = @_; 201 my $size = 0; 202 if (exists $node->{cc}){ 203 my $cc = $self->get_cc_as_num($node->{cc}); 204 $size = length(_encode_cc($cc)); 205 } else { 206 my $node_zero_size = $self->_findSize($node->{0}); 207 my $node_one_size = $self->_findSize($node->{1}); 208 $size = length(_encode_size($node_zero_size)) + $node_zero_size + $node_one_size; 209 } 210 return $size; 211} 212 2131; 214