line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Geo::IP::PurePerl; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
707
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
893
|
use FileHandle; |
|
1
|
|
|
|
|
18972
|
|
|
1
|
|
|
|
|
7
|
|
5
|
1
|
|
|
1
|
|
420
|
use File::Spec; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
91
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
1
|
50
|
|
1
|
|
109
|
if ( $] >= 5.008 ) { |
9
|
1
|
|
|
|
|
870
|
require Encode; |
10
|
1
|
|
|
|
|
9877
|
Encode->import(qw/ decode /); |
11
|
|
|
|
|
|
|
} |
12
|
|
|
|
|
|
|
else { |
13
|
|
|
|
|
|
|
*decode = sub { |
14
|
0
|
|
|
|
|
0
|
local $_ = $_[1]; |
15
|
1
|
|
|
1
|
|
1095
|
use bytes; |
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
5
|
|
16
|
0
|
|
|
|
|
0
|
s/([\x80-\xff])/my $c = ord($1); |
|
0
|
|
|
|
|
0
|
|
17
|
0
|
0
|
|
|
|
0
|
my $p = $c >= 192 ? 1 : 0; |
18
|
0
|
|
|
|
|
0
|
pack ( 'CC' => 0xc2 + $p , $c & ~0x40 ); /ge; |
19
|
0
|
|
|
|
|
0
|
return $_; |
20
|
0
|
|
|
|
|
0
|
}; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
}; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
7
|
use vars qw( @ISA $VERSION @EXPORT $OPEN_TYPE_PATH ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
83
|
|
26
|
|
|
|
|
|
|
|
27
|
1
|
|
|
1
|
|
6
|
use constant GEOIP_CHARSET_ISO_8859_1 => 0; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
94
|
|
28
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_CHARSET_UTF8 => 1; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
1
|
|
16
|
use constant FULL_RECORD_LENGTH => 50; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
31
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_COUNTRY_BEGIN => 16776960; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
32
|
1
|
|
|
1
|
|
5
|
use constant RECORD_LENGTH => 3; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
52
|
|
33
|
1
|
|
|
1
|
|
6
|
use constant GEOIP_STATE_BEGIN_REV0 => 16700000; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
34
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_STATE_BEGIN_REV1 => 16000000; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
56
|
|
35
|
1
|
|
|
1
|
|
13
|
use constant STRUCTURE_INFO_MAX_SIZE => 20; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
36
|
1
|
|
|
1
|
|
5
|
use constant DATABASE_INFO_MAX_SIZE => 100; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
37
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_COUNTRY_EDITION => 1; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
60
|
|
38
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_REGION_EDITION_REV0 => 7; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
35
|
|
39
|
1
|
|
|
1
|
|
4
|
use constant GEOIP_REGION_EDITION_REV1 => 3; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
40
|
1
|
|
|
1
|
|
4
|
use constant GEOIP_CITY_EDITION_REV0 => 6; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
32
|
|
41
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_CITY_EDITION_REV1 => 2; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
41
|
|
42
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_ORG_EDITION => 5; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
39
|
|
43
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_ISP_EDITION => 4; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
44
|
1
|
|
|
1
|
|
17
|
use constant GEOIP_PROXY_EDITION => 8; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
50
|
|
45
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_ASNUM_EDITION => 9; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
55
|
|
46
|
1
|
|
|
1
|
|
5
|
use constant GEOIP_NETSPEED_EDITION => 10; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
49
|
|
47
|
1
|
|
|
1
|
|
6
|
use constant GEOIP_DOMAIN_EDITION => 11; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
47
|
|
48
|
1
|
|
|
1
|
|
7
|
use constant SEGMENT_RECORD_LENGTH => 3; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
49
|
|
49
|
1
|
|
|
1
|
|
6
|
use constant STANDARD_RECORD_LENGTH => 3; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
77
|
|
50
|
1
|
|
|
1
|
|
5
|
use constant ORG_RECORD_LENGTH => 4; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
45
|
|
51
|
1
|
|
|
1
|
|
5
|
use constant MAX_RECORD_LENGTH => 4; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
52
|
|
52
|
1
|
|
|
1
|
|
6
|
use constant MAX_ORG_RECORD_LENGTH => 300; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
53
|
1
|
|
|
1
|
|
5
|
use constant US_OFFSET => 1; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
49
|
|
54
|
1
|
|
|
1
|
|
5
|
use constant CANADA_OFFSET => 677; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
55
|
1
|
|
|
1
|
|
5
|
use constant WORLD_OFFSET => 1353; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
38
|
|
56
|
1
|
|
|
1
|
|
5
|
use constant FIPS_RANGE => 360; |
|
1
|
|
|
|
|
19
|
|
|
1
|
|
|
|
|
115
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$VERSION = '1.25'; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
require Exporter; |
61
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# cheat --- try to load Sys::Mmap |
64
|
|
|
|
|
|
|
BEGIN { |
65
|
1
|
|
|
1
|
|
2
|
eval { |
66
|
|
|
|
|
|
|
# wrap into eval again, as workaround for centos / mod_perl issue |
67
|
|
|
|
|
|
|
# seems they use $@ without eval somewhere |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
eval "require Sys::Mmap" |
70
|
|
|
|
|
|
|
? Sys::Mmap->import |
71
|
1
|
50
|
|
|
|
65
|
: do { |
72
|
1
|
|
|
|
|
4
|
for (qw/ PROT_READ MAP_PRIVATE MAP_SHARED /) { |
73
|
1
|
|
|
1
|
|
6
|
no strict 'refs'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
72
|
|
74
|
3
|
|
|
|
|
4
|
my $unused_stub = $_; # we must use a copy |
75
|
3
|
|
|
0
|
|
49
|
*$unused_stub = sub { die 'Sys::Mmap required for mmap support' }; |
|
0
|
|
|
|
|
0
|
|
76
|
|
|
|
|
|
|
} # for |
77
|
|
|
|
|
|
|
}; # do |
78
|
1
|
|
|
|
|
6832
|
1; |
79
|
|
|
|
|
|
|
}; # eval |
80
|
|
|
|
|
|
|
} # begin |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub GEOIP_STANDARD(){0;} |
84
|
|
|
|
|
|
|
sub GEOIP_MEMORY_CACHE(){1;} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
#sub GEOIP_CHECK_CACHE(){2;} |
87
|
|
|
|
|
|
|
#sub GEOIP_INDEX_CACHE(){4;} |
88
|
|
|
|
|
|
|
sub GEOIP_MMAP_CACHE(){8;} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub GEOIP_UNKNOWN_SPEED(){0;} |
91
|
|
|
|
|
|
|
sub GEOIP_DIALUP_SPEED(){1;} |
92
|
|
|
|
|
|
|
sub GEOIP_CABLEDSL_SPEED(){2;} |
93
|
|
|
|
|
|
|
sub GEOIP_CORPORATE_SPEED(){3;} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
@EXPORT = qw( GEOIP_STANDARD GEOIP_MEMORY_CACHE GEOIP_MMAP_CACHE |
96
|
|
|
|
|
|
|
GEOIP_UNKNOWN_SPEED GEOIP_DIALUP_SPEED GEOIP_CABLEDSL_SPEED GEOIP_CORPORATE_SPEED ); |
97
|
|
|
|
|
|
|
my @countries = |
98
|
|
|
|
|
|
|
(undef,"AP","EU","AD","AE","AF","AG","AI","AL","AM","AN","AO","AQ","AR","AS","AT","AU","AW","AZ","BA","BB","BD","BE","BF","BG","BH","BI","BJ","BM","BN","BO","BR","BS","BT","BV","BW","BY","BZ","CA","CC","CD","CF","CG","CH","CI","CK","CL","CM","CN","CO","CR","CU","CV","CX","CY","CZ","DE","DJ","DK","DM","DO","DZ","EC","EE","EG","EH","ER","ES","ET","FI","FJ","FK","FM","FO","FR","FX","GA","GB","GD","GE","GF","GH","GI","GL","GM","GN","GP","GQ","GR","GS","GT","GU","GW","GY","HK","HM","HN","HR","HT","HU","ID","IE","IL","IN","IO","IQ","IR","IS","IT","JM","JO","JP","KE","KG","KH","KI","KM","KN","KP","KR","KW","KY","KZ","LA","LB","LC","LI","LK","LR","LS","LT","LU","LV","LY","MA","MC","MD","MG","MH","MK","ML","MM","MN","MO","MP","MQ","MR","MS","MT","MU","MV","MW","MX","MY","MZ","NA","NC","NE","NF","NG","NI","NL","NO","NP","NR","NU","NZ","OM","PA","PE","PF","PG","PH","PK","PL","PM","PN","PR","PS","PT","PW","PY","QA","RE","RO","RU","RW","SA","SB","SC","SD","SE","SG","SH","SI","SJ","SK","SL","SM","SN","SO","SR","ST","SV","SY","SZ","TC","TD","TF","TG","TH","TJ","TK","TM","TN","TO","TL","TR","TT","TV","TW","TZ","UA","UG","UM","US","UY","UZ","VA","VC","VE","VG","VI","VN","VU","WF","WS","YE","YT","RS","ZA","ZM","ME","ZW","A1","A2","O1","AX","GG","IM","JE","BL","MF"); |
99
|
|
|
|
|
|
|
my @code3s = ( undef,"AP","EU","AND","ARE","AFG","ATG","AIA","ALB","ARM","ANT","AGO","AQ","ARG","ASM","AUT","AUS","ABW","AZE","BIH","BRB","BGD","BEL","BFA","BGR","BHR","BDI","BEN","BMU","BRN","BOL","BRA","BHS","BTN","BV","BWA","BLR","BLZ","CAN","CC","COD","CAF","COG","CHE","CIV","COK","CHL","CMR","CHN","COL","CRI","CUB","CPV","CX","CYP","CZE","DEU","DJI","DNK","DMA","DOM","DZA","ECU","EST","EGY","ESH","ERI","ESP","ETH","FIN","FJI","FLK","FSM","FRO","FRA","FX","GAB","GBR","GRD","GEO","GUF","GHA","GIB","GRL","GMB","GIN","GLP","GNQ","GRC","GS","GTM","GUM","GNB","GUY","HKG","HM","HND","HRV","HTI","HUN","IDN","IRL","ISR","IND","IO","IRQ","IRN","ISL","ITA","JAM","JOR","JPN","KEN","KGZ","KHM","KIR","COM","KNA","PRK","KOR","KWT","CYM","KAZ","LAO","LBN","LCA","LIE","LKA","LBR","LSO","LTU","LUX","LVA","LBY","MAR","MCO","MDA","MDG","MHL","MKD","MLI","MMR","MNG","MAC","MNP","MTQ","MRT","MSR","MLT","MUS","MDV","MWI","MEX","MYS","MOZ","NAM","NCL","NER","NFK","NGA","NIC","NLD","NOR","NPL","NRU","NIU","NZL","OMN","PAN","PER","PYF","PNG","PHL","PAK","POL","SPM","PCN","PRI","PSE","PRT","PLW","PRY","QAT","REU","ROU","RUS","RWA","SAU","SLB","SYC","SDN","SWE","SGP","SHN","SVN","SJM","SVK","SLE","SMR","SEN","SOM","SUR","STP","SLV","SYR","SWZ","TCA","TCD","TF","TGO","THA","TJK","TKL","TKM","TUN","TON","TLS","TUR","TTO","TUV","TWN","TZA","UKR","UGA","UM","USA","URY","UZB","VAT","VCT","VEN","VGB","VIR","VNM","VUT","WLF","WSM","YEM","YT","SRB","ZAF","ZMB","MNE","ZWE","A1","A2","O1","ALA","GGY","IMN","JEY","BLM","MAF"); |
100
|
|
|
|
|
|
|
my @names = (undef,"Asia/Pacific Region","Europe","Andorra","United Arab Emirates","Afghanistan","Antigua and Barbuda", |
101
|
|
|
|
|
|
|
"Anguilla","Albania","Armenia","Netherlands Antilles","Angola","Antarctica","Argentina","American Samoa", |
102
|
|
|
|
|
|
|
"Austria","Australia","Aruba","Azerbaijan","Bosnia and Herzegovina","Barbados","Bangladesh","Belgium","Burkina Faso", |
103
|
|
|
|
|
|
|
"Bulgaria","Bahrain","Burundi","Benin","Bermuda","Brunei Darussalam","Bolivia","Brazil","Bahamas","Bhutan","Bouvet Island", |
104
|
|
|
|
|
|
|
"Botswana","Belarus","Belize","Canada","Cocos (Keeling) Islands","Congo, The Democratic Republic of the","Central African Republic", |
105
|
|
|
|
|
|
|
"Congo","Switzerland","Cote D'Ivoire","Cook Islands","Chile","Cameroon","China","Colombia","Costa Rica","Cuba","Cape Verde", |
106
|
|
|
|
|
|
|
"Christmas Island","Cyprus","Czech Republic","Germany","Djibouti","Denmark","Dominica","Dominican Republic","Algeria","Ecuador", |
107
|
|
|
|
|
|
|
"Estonia","Egypt","Western Sahara","Eritrea","Spain","Ethiopia","Finland","Fiji","Falkland Islands (Malvinas)", |
108
|
|
|
|
|
|
|
"Micronesia, Federated States of","Faroe Islands","France","France, Metropolitan","Gabon","United Kingdom","Grenada","Georgia", |
109
|
|
|
|
|
|
|
"French Guiana","Ghana","Gibraltar","Greenland","Gambia","Guinea","Guadeloupe","Equatorial Guinea","Greece", |
110
|
|
|
|
|
|
|
"South Georgia and the South Sandwich Islands","Guatemala","Guam","Guinea-Bissau","Guyana","Hong Kong", |
111
|
|
|
|
|
|
|
"Heard Island and McDonald Islands","Honduras","Croatia","Haiti","Hungary","Indonesia","Ireland","Israel","India", |
112
|
|
|
|
|
|
|
"British Indian Ocean Territory","Iraq","Iran, Islamic Republic of","Iceland","Italy","Jamaica","Jordan","Japan","Kenya", |
113
|
|
|
|
|
|
|
"Kyrgyzstan","Cambodia","Kiribati","Comoros","Saint Kitts and Nevis","Korea, Democratic People's Republic of","Korea, Republic of", |
114
|
|
|
|
|
|
|
"Kuwait","Cayman Islands","Kazakhstan","Lao People's Democratic Republic","Lebanon","Saint Lucia","Liechtenstein","Sri Lanka", |
115
|
|
|
|
|
|
|
"Liberia","Lesotho","Lithuania","Luxembourg","Latvia","Libyan Arab Jamahiriya","Morocco","Monaco","Moldova, Republic of", |
116
|
|
|
|
|
|
|
"Madagascar","Marshall Islands","Macedonia","Mali","Myanmar","Mongolia","Macau","Northern Mariana Islands","Martinique", |
117
|
|
|
|
|
|
|
"Mauritania","Montserrat","Malta","Mauritius","Maldives","Malawi","Mexico","Malaysia","Mozambique","Namibia","New Caledonia", |
118
|
|
|
|
|
|
|
"Niger","Norfolk Island","Nigeria","Nicaragua","Netherlands","Norway","Nepal","Nauru","Niue","New Zealand","Oman","Panama","Peru", |
119
|
|
|
|
|
|
|
"French Polynesia","Papua New Guinea","Philippines","Pakistan","Poland","Saint Pierre and Miquelon","Pitcairn Islands","Puerto Rico", |
120
|
|
|
|
|
|
|
"Palestinian Territory","Portugal","Palau","Paraguay","Qatar","Reunion","Romania","Russian Federation","Rwanda","Saudi Arabia", |
121
|
|
|
|
|
|
|
"Solomon Islands","Seychelles","Sudan","Sweden","Singapore","Saint Helena","Slovenia","Svalbard and Jan Mayen","Slovakia","Sierra Leone", |
122
|
|
|
|
|
|
|
"San Marino","Senegal","Somalia","Suriname","Sao Tome and Principe","El Salvador","Syrian Arab Republic","Swaziland", |
123
|
|
|
|
|
|
|
"Turks and Caicos Islands","Chad","French Southern Territories","Togo","Thailand","Tajikistan","Tokelau","Turkmenistan","Tunisia", |
124
|
|
|
|
|
|
|
"Tonga","Timor-Leste","Turkey","Trinidad and Tobago","Tuvalu","Taiwan","Tanzania, United Republic of","Ukraine","Uganda", |
125
|
|
|
|
|
|
|
"United States Minor Outlying Islands","United States","Uruguay","Uzbekistan","Holy See (Vatican City State)", |
126
|
|
|
|
|
|
|
"Saint Vincent and the Grenadines","Venezuela","Virgin Islands, British","Virgin Islands, U.S.","Vietnam","Vanuatu", |
127
|
|
|
|
|
|
|
"Wallis and Futuna","Samoa","Yemen","Mayotte","Serbia","South Africa","Zambia","Montenegro","Zimbabwe","Anonymous Proxy", |
128
|
|
|
|
|
|
|
"Satellite Provider","Other","Aland Islands","Guernsey","Isle of Man","Jersey","Saint Barthelemy","Saint Martin"); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# --- unfortunately we do not know the path so we assume the |
132
|
|
|
|
|
|
|
# default path /usr/local/share/GeoIP |
133
|
|
|
|
|
|
|
# if thats not true, you can set $Geo::IP::PurePerl::OPEN_TYPE_PATH |
134
|
|
|
|
|
|
|
# |
135
|
|
|
|
|
|
|
sub open_type { |
136
|
0
|
|
|
0
|
0
|
|
my ( $class, $type, $flags ) = @_; |
137
|
0
|
|
|
|
|
|
my %type_dat_name_mapper = ( |
138
|
|
|
|
|
|
|
GEOIP_COUNTRY_EDITION() => 'GeoIP', |
139
|
|
|
|
|
|
|
GEOIP_REGION_EDITION_REV0() => 'GeoIPRegion', |
140
|
|
|
|
|
|
|
GEOIP_REGION_EDITION_REV1() => 'GeoIPRegion', |
141
|
|
|
|
|
|
|
GEOIP_CITY_EDITION_REV0() => 'GeoIPCity', |
142
|
|
|
|
|
|
|
GEOIP_CITY_EDITION_REV1() => 'GeoIPCity', |
143
|
|
|
|
|
|
|
GEOIP_ISP_EDITION() => 'GeoIPISP', |
144
|
|
|
|
|
|
|
GEOIP_ORG_EDITION() => 'GeoIPOrg', |
145
|
|
|
|
|
|
|
GEOIP_PROXY_EDITION() => 'GeoIPProxy', |
146
|
|
|
|
|
|
|
GEOIP_ASNUM_EDITION() => 'GeoIPASNum', |
147
|
|
|
|
|
|
|
GEOIP_NETSPEED_EDITION() => 'GeoIPNetSpeed', |
148
|
|
|
|
|
|
|
GEOIP_DOMAIN_EDITION() => 'GeoIPDomain', |
149
|
|
|
|
|
|
|
); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# backward compatibility for 2003 databases. |
152
|
0
|
0
|
|
|
|
|
$type -= 105 if $type >= 106; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
|
my $name = $type_dat_name_mapper{$type}; |
155
|
0
|
0
|
|
|
|
|
die("Invalid database type $type\n") unless $name; |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
|
0
|
|
|
my $mkpath = sub { File::Spec->catfile( File::Spec->rootdir, @_ ) }; |
|
0
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my $path = |
160
|
|
|
|
|
|
|
defined $Geo::IP::PurePerl::OPEN_TYPE_PATH |
161
|
|
|
|
|
|
|
? $Geo::IP::PurePerl::OPEN_TYPE_PATH |
162
|
0
|
0
|
|
|
|
|
: do { |
163
|
|
|
|
|
|
|
$^O eq 'NetWare' |
164
|
|
|
|
|
|
|
? $mkpath->(qw/ etc GeoIP /) |
165
|
0
|
0
|
|
|
|
|
: do { |
166
|
0
|
0
|
|
|
|
|
$^O eq 'MSWin32' |
167
|
|
|
|
|
|
|
? $mkpath->(qw/ GeoIP /) |
168
|
|
|
|
|
|
|
: $mkpath->(qw/ usr local share GeoIP /); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
}; |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
my $filename = File::Spec->catfile( $path, $name . '.dat' ); |
173
|
0
|
|
|
|
|
|
return $class->open( $filename, $flags ); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub open { |
178
|
0
|
0
|
0
|
0
|
1
|
|
die "Geo::IP::PurePerl::open() requires a path name" |
179
|
|
|
|
|
|
|
unless( @_ > 1 and $_[1] ); |
180
|
0
|
|
|
|
|
|
my ($class, $db_file, $flags) = @_; |
181
|
0
|
|
|
|
|
|
my $fh = FileHandle->new; |
182
|
0
|
|
|
|
|
|
my $gi; |
183
|
0
|
0
|
|
|
|
|
CORE::open $fh, $db_file or die "Error opening $db_file"; |
184
|
0
|
|
|
|
|
|
binmode($fh); |
185
|
0
|
0
|
0
|
|
|
|
if ( $flags && ( $flags & ( GEOIP_MEMORY_CACHE | GEOIP_MMAP_CACHE ) ) ) { |
186
|
0
|
|
|
|
|
|
my %self; |
187
|
|
|
|
|
|
|
|
188
|
0
|
0
|
|
|
|
|
if ( $flags & GEOIP_MMAP_CACHE ) { |
189
|
0
|
0
|
|
|
|
|
die "Sys::Mmap required for MMAP support" |
190
|
|
|
|
|
|
|
unless defined $Sys::Mmap::VERSION; |
191
|
0
|
0
|
|
|
|
|
mmap( $self{buf} = undef, 0, PROT_READ, MAP_PRIVATE, $fh ) |
192
|
|
|
|
|
|
|
or die "mmap: $!"; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
else { |
195
|
0
|
|
|
|
|
|
local $/ = undef; |
196
|
0
|
|
|
|
|
|
$self{buf} = <$fh>; |
197
|
|
|
|
|
|
|
} |
198
|
0
|
|
|
|
|
|
$self{fh} = $fh; |
199
|
0
|
|
|
|
|
|
$gi = bless \%self, $class; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
else { |
202
|
0
|
|
|
|
|
|
$gi = bless { fh => $fh }, $class; |
203
|
|
|
|
|
|
|
} |
204
|
0
|
|
|
|
|
|
$gi->_setup_segments(); |
205
|
0
|
|
|
|
|
|
return $gi; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub new { |
209
|
0
|
|
|
0
|
1
|
|
my ($class, $db_file, $flags) = @_; |
210
|
|
|
|
|
|
|
# this will be less messy once deprecated new( $path, [$flags] ) |
211
|
|
|
|
|
|
|
# is no longer supported (that's what open() is for) |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
my $def_db_file = '/usr/local/share/GeoIP/GeoIP.dat'; |
214
|
0
|
0
|
|
|
|
|
if ($^O eq 'NetWare') { |
|
|
0
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
$def_db_file = 'sys:/etc/GeoIP/GeoIP.dat'; |
216
|
|
|
|
|
|
|
} elsif ($^O eq 'MSWin32') { |
217
|
0
|
|
|
|
|
|
$def_db_file = 'c:/GeoIP/GeoIP.dat'; |
218
|
|
|
|
|
|
|
} |
219
|
0
|
0
|
|
|
|
|
if ( !defined $db_file ) { |
|
|
0
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# called as new() |
221
|
0
|
|
|
|
|
|
$db_file = $def_db_file; |
222
|
|
|
|
|
|
|
} elsif ( $db_file =~ /^\d+$/ ) { |
223
|
|
|
|
|
|
|
# db_file is GEOIP_MEMORY_CACHE or GEOIP_STANDARD |
224
|
|
|
|
|
|
|
# called as new( $flags ) |
225
|
0
|
|
|
|
|
|
$flags = $db_file; |
226
|
0
|
|
|
|
|
|
$db_file = $def_db_file; |
227
|
|
|
|
|
|
|
} # else called as new( $database_filename, [$flags] ); |
228
|
|
|
|
|
|
|
|
229
|
0
|
|
|
|
|
|
$class->open( $db_file, $flags ); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
#this function setups the database segments |
233
|
|
|
|
|
|
|
sub _setup_segments { |
234
|
0
|
|
|
0
|
|
|
my ($gi) = @_; |
235
|
0
|
|
|
|
|
|
my $a = 0; |
236
|
0
|
|
|
|
|
|
my $i = 0; |
237
|
0
|
|
|
|
|
|
my $j = 0; |
238
|
0
|
|
|
|
|
|
my $delim; |
239
|
|
|
|
|
|
|
my $buf; |
240
|
0
|
|
|
|
|
|
$gi->{_charset} = GEOIP_CHARSET_ISO_8859_1; |
241
|
0
|
|
|
|
|
|
$gi->{"databaseType"} = GEOIP_COUNTRY_EDITION; |
242
|
0
|
|
|
|
|
|
$gi->{"record_length"} = STANDARD_RECORD_LENGTH; |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
my $filepos = tell($gi->{fh}); |
245
|
0
|
|
|
|
|
|
seek($gi->{fh}, -3, 2); |
246
|
0
|
|
|
|
|
|
for ($i = 0; $i < STRUCTURE_INFO_MAX_SIZE; $i++) { |
247
|
0
|
|
|
|
|
|
read($gi->{fh},$delim,3); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
#find the delim |
250
|
0
|
0
|
|
|
|
|
if ($delim eq (chr(255).chr(255).chr(255))) { |
251
|
0
|
|
|
|
|
|
read($gi->{fh},$a,1); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
#read the databasetype |
254
|
0
|
|
|
|
|
|
$gi->{"databaseType"} = ord($a); |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# backward compatibility for 2003 databases. |
257
|
0
|
0
|
|
|
|
|
$gi->{databaseType} -= 105 if $gi->{databaseType} >= 106; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
#chose the database segment for the database type |
260
|
|
|
|
|
|
|
#if database Type is GEOIP_REGION_EDITION then use database segment GEOIP_STATE_BEGIN |
261
|
0
|
0
|
0
|
|
|
|
if ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV0) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
262
|
0
|
|
|
|
|
|
$gi->{"databaseSegments"} = GEOIP_STATE_BEGIN_REV0; |
263
|
|
|
|
|
|
|
} elsif ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV1) { |
264
|
0
|
|
|
|
|
|
$gi->{"databaseSegments"} = GEOIP_STATE_BEGIN_REV1; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
#if database Type is GEOIP_CITY_EDITION, GEOIP_ISP_EDITION or GEOIP_ORG_EDITION then |
268
|
|
|
|
|
|
|
#read in the database segment |
269
|
|
|
|
|
|
|
elsif (($gi->{"databaseType"} == GEOIP_CITY_EDITION_REV0) || |
270
|
|
|
|
|
|
|
($gi->{"databaseType"} == GEOIP_CITY_EDITION_REV1) || |
271
|
|
|
|
|
|
|
($gi->{"databaseType"} == GEOIP_ORG_EDITION) || |
272
|
|
|
|
|
|
|
($gi->{"databaseType"} == GEOIP_ASNUM_EDITION) || |
273
|
|
|
|
|
|
|
($gi->{"databaseType"} == GEOIP_DOMAIN_EDITION) || |
274
|
|
|
|
|
|
|
($gi->{"databaseType"} == GEOIP_ISP_EDITION)) { |
275
|
0
|
|
|
|
|
|
$gi->{"databaseSegments"} = 0; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
#read in the database segment for the database type |
278
|
0
|
|
|
|
|
|
read($gi->{fh},$buf,SEGMENT_RECORD_LENGTH); |
279
|
0
|
|
|
|
|
|
for ($j = 0;$j < SEGMENT_RECORD_LENGTH;$j++) { |
280
|
0
|
|
|
|
|
|
$gi->{"databaseSegments"} += (ord(substr($buf,$j,1)) << ($j * 8)); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
#record length is four for ISP databases and ORG databases |
284
|
|
|
|
|
|
|
#record length is three for country databases, region database and city databases |
285
|
0
|
0
|
0
|
|
|
|
if ($gi->{"databaseType"} == GEOIP_ORG_EDITION || |
|
|
|
0
|
|
|
|
|
286
|
|
|
|
|
|
|
$gi->{"databaseType"} == GEOIP_ISP_EDITION || |
287
|
|
|
|
|
|
|
$gi->{"databaseType"} == GEOIP_DOMAIN_EDITION) { |
288
|
0
|
|
|
|
|
|
$gi->{"record_length"} = ORG_RECORD_LENGTH; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
} |
291
|
0
|
|
|
|
|
|
last; |
292
|
|
|
|
|
|
|
} else { |
293
|
0
|
|
|
|
|
|
seek($gi->{fh}, -4 , 1); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
#if database Type is GEOIP_COUNTY_EDITION then use database segment GEOIP_COUNTRY_BEGIN |
297
|
0
|
0
|
0
|
|
|
|
if ($gi->{"databaseType"} == GEOIP_COUNTRY_EDITION || |
298
|
|
|
|
|
|
|
$gi->{"databaseType"} == GEOIP_NETSPEED_EDITION) { |
299
|
0
|
|
|
|
|
|
$gi->{"databaseSegments"} = GEOIP_COUNTRY_BEGIN; |
300
|
|
|
|
|
|
|
} |
301
|
0
|
|
|
|
|
|
seek($gi->{fh},$filepos,0); |
302
|
0
|
|
|
|
|
|
return $gi; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub _seek_country { |
306
|
0
|
|
|
0
|
|
|
my ($gi, $ipnum) = @_; |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
|
my $fh = $gi->{fh}; |
309
|
0
|
|
|
|
|
|
my $offset = 0; |
310
|
|
|
|
|
|
|
|
311
|
0
|
|
|
|
|
|
my ($x0, $x1); |
312
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
my $reclen = $gi->{"record_length"}; |
314
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
for (my $depth = 31; $depth >= 0; $depth--) { |
316
|
0
|
0
|
|
|
|
|
unless ( exists $gi->{buf} ) { |
317
|
0
|
|
|
|
|
|
seek $fh, $offset * 2 * $reclen, 0; |
318
|
0
|
|
|
|
|
|
read $fh, $x0, $reclen; |
319
|
0
|
|
|
|
|
|
read $fh, $x1, $reclen; |
320
|
|
|
|
|
|
|
} else { |
321
|
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
$x0 = substr($gi->{buf}, $offset * 2 * $reclen, $reclen); |
323
|
0
|
|
|
|
|
|
$x1 = substr($gi->{buf}, $offset * 2 * $reclen + $reclen, $reclen); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
|
$x0 = unpack("V1", $x0."\0"); |
327
|
0
|
|
|
|
|
|
$x1 = unpack("V1", $x1."\0"); |
328
|
|
|
|
|
|
|
|
329
|
0
|
0
|
|
|
|
|
if ($ipnum & (1 << $depth)) { |
330
|
0
|
0
|
|
|
|
|
if ($x1 >= $gi->{"databaseSegments"}) { |
331
|
0
|
|
|
|
|
|
$gi->{last_netmask} = 32 - $depth; |
332
|
0
|
|
|
|
|
|
return $x1; |
333
|
|
|
|
|
|
|
} |
334
|
0
|
|
|
|
|
|
$offset = $x1; |
335
|
|
|
|
|
|
|
} else { |
336
|
0
|
0
|
|
|
|
|
if ($x0 >= $gi->{"databaseSegments"}) { |
337
|
0
|
|
|
|
|
|
$gi->{last_netmask} = 32 - $depth; |
338
|
0
|
|
|
|
|
|
return $x0; |
339
|
|
|
|
|
|
|
} |
340
|
0
|
|
|
|
|
|
$offset = $x0; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
|
print STDERR "Error Traversing Database for ipnum = $ipnum - Perhaps database is corrupt?"; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
sub charset { |
347
|
0
|
|
|
0
|
1
|
|
return $_[0]->{_charset}; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub set_charset{ |
351
|
0
|
|
|
0
|
1
|
|
my ( $gi, $charset ) = @_; |
352
|
0
|
|
|
|
|
|
my $old_charset = $gi->{_charset}; |
353
|
0
|
|
|
|
|
|
$gi->{_charset} = $charset; |
354
|
|
|
|
|
|
|
|
355
|
0
|
|
|
|
|
|
return $old_charset; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
#this function returns the country code of ip address |
359
|
|
|
|
|
|
|
sub country_code_by_addr { |
360
|
0
|
|
|
0
|
1
|
|
my ($gi, $ip_address) = @_; |
361
|
0
|
0
|
|
|
|
|
return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; |
362
|
0
|
|
|
|
|
|
return $countries[$gi->id_by_addr($ip_address)]; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
#this function returns the country code3 of ip address |
366
|
|
|
|
|
|
|
sub country_code3_by_addr { |
367
|
0
|
|
|
0
|
1
|
|
my ($gi, $ip_address) = @_; |
368
|
0
|
0
|
|
|
|
|
return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; |
369
|
0
|
|
|
|
|
|
return $code3s[$gi->id_by_addr($ip_address)]; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
#this function returns the name of ip address |
373
|
|
|
|
|
|
|
sub country_name_by_addr { |
374
|
0
|
|
|
0
|
1
|
|
my ($gi, $ip_address) = @_; |
375
|
0
|
0
|
|
|
|
|
return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; |
376
|
0
|
|
|
|
|
|
return $names[$gi->id_by_addr($ip_address)]; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub id_by_addr { |
380
|
0
|
|
|
0
|
0
|
|
my ($gi, $ip_address) = @_; |
381
|
0
|
0
|
|
|
|
|
return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; |
382
|
0
|
|
|
|
|
|
return $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_COUNTRY_BEGIN; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
#this function returns the country code of domain name |
386
|
|
|
|
|
|
|
sub country_code_by_name { |
387
|
0
|
|
|
0
|
1
|
|
my ($gi, $host) = @_; |
388
|
0
|
|
|
|
|
|
my $country_id = $gi->id_by_name($host); |
389
|
0
|
|
|
|
|
|
return $countries[$country_id]; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
#this function returns the country code3 of domain name |
393
|
|
|
|
|
|
|
sub country_code3_by_name { |
394
|
0
|
|
|
0
|
1
|
|
my ($gi, $host) = @_; |
395
|
0
|
|
|
|
|
|
my $country_id = $gi->id_by_name($host); |
396
|
0
|
|
|
|
|
|
return $code3s[$country_id]; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
#this function returns the country name of domain name |
400
|
|
|
|
|
|
|
sub country_name_by_name { |
401
|
0
|
|
|
0
|
1
|
|
my ($gi, $host) = @_; |
402
|
0
|
|
|
|
|
|
my $country_id = $gi->id_by_name($host); |
403
|
0
|
|
|
|
|
|
return $names[$country_id]; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub id_by_name { |
407
|
0
|
|
|
0
|
0
|
|
my ($gi, $host) = @_; |
408
|
0
|
|
|
|
|
|
my $ip_address; |
409
|
0
|
0
|
|
|
|
|
if ($host =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!) { |
410
|
0
|
|
|
|
|
|
$ip_address = $host; |
411
|
|
|
|
|
|
|
} else { |
412
|
0
|
|
|
|
|
|
$ip_address = join('.',unpack('C4',(gethostbyname($host))[4])); |
413
|
|
|
|
|
|
|
} |
414
|
0
|
0
|
|
|
|
|
return unless $ip_address; |
415
|
0
|
|
|
|
|
|
return $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_COUNTRY_BEGIN; |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
#this function returns the city record as a array |
419
|
|
|
|
|
|
|
sub get_city_record { |
420
|
0
|
|
|
0
|
1
|
|
my ($gi, $host) = @_; |
421
|
0
|
|
|
|
|
|
my $ip_address = $gi->get_ip_address($host); |
422
|
0
|
0
|
|
|
|
|
return unless $ip_address; |
423
|
0
|
|
|
|
|
|
my $record_buf; |
424
|
|
|
|
|
|
|
my $record_buf_pos; |
425
|
0
|
|
|
|
|
|
my $char; |
426
|
0
|
|
|
|
|
|
my $metroarea_combo; |
427
|
0
|
|
|
|
|
|
my $record_country_code = ""; |
428
|
0
|
|
|
|
|
|
my $record_country_code3 = ""; |
429
|
0
|
|
|
|
|
|
my $record_country_name = ""; |
430
|
0
|
|
|
|
|
|
my $record_region = ""; |
431
|
0
|
|
|
|
|
|
my $record_city = ""; |
432
|
0
|
|
|
|
|
|
my $record_postal_code = ""; |
433
|
0
|
|
|
|
|
|
my $record_latitude = ""; |
434
|
0
|
|
|
|
|
|
my $record_longitude = ""; |
435
|
0
|
|
|
|
|
|
my $record_metro_code = ""; |
436
|
0
|
|
|
|
|
|
my $record_area_code = ""; |
437
|
0
|
|
|
|
|
|
my $str_length = 0; |
438
|
0
|
|
|
|
|
|
my $i; |
439
|
|
|
|
|
|
|
my $j; |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
#lookup the city |
442
|
0
|
|
|
|
|
|
my $seek_country = $gi->_seek_country(addr_to_num($ip_address)); |
443
|
0
|
0
|
|
|
|
|
if ($seek_country == $gi->{"databaseSegments"}) { |
444
|
0
|
|
|
|
|
|
return; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
#set the record pointer to location of the city record |
447
|
0
|
|
|
|
|
|
my $record_pointer = $seek_country + (2 * $gi->{"record_length"} - 1) * $gi->{"databaseSegments"}; |
448
|
|
|
|
|
|
|
|
449
|
0
|
0
|
|
|
|
|
unless ( exists $gi->{buf} ) { |
450
|
0
|
|
|
|
|
|
seek( $gi->{"fh"}, $record_pointer, 0 ); |
451
|
0
|
|
|
|
|
|
read( $gi->{"fh"}, $record_buf, FULL_RECORD_LENGTH ); |
452
|
0
|
|
|
|
|
|
$record_buf_pos = 0; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
else { |
455
|
0
|
|
|
|
|
|
$record_buf = substr($gi->{buf}, $record_pointer, FULL_RECORD_LENGTH); |
456
|
0
|
|
|
|
|
|
$record_buf_pos = 0; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
#get the country |
460
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos,1)); |
461
|
0
|
|
|
|
|
|
$record_country_code = $countries[$char];#get the country code |
462
|
0
|
|
|
|
|
|
$record_country_code3 = $code3s[$char];#get the country code with 3 letters |
463
|
0
|
|
|
|
|
|
$record_country_name = $names[$char];#get the country name |
464
|
0
|
|
|
|
|
|
$record_buf_pos++; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
#get the region |
467
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); |
468
|
0
|
|
|
|
|
|
while ($char != 0) { |
469
|
0
|
|
|
|
|
|
$str_length++;#get the length of string |
470
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); |
471
|
|
|
|
|
|
|
} |
472
|
0
|
0
|
|
|
|
|
if ($str_length > 0) { |
473
|
0
|
|
|
|
|
|
$record_region = substr($record_buf,$record_buf_pos,$str_length); |
474
|
|
|
|
|
|
|
} |
475
|
0
|
|
|
|
|
|
$record_buf_pos += $str_length + 1; |
476
|
0
|
|
|
|
|
|
$str_length = 0; |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
#get the city |
479
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); |
480
|
0
|
|
|
|
|
|
while ($char != 0) { |
481
|
0
|
|
|
|
|
|
$str_length++;#get the length of string |
482
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); |
483
|
|
|
|
|
|
|
} |
484
|
0
|
0
|
|
|
|
|
if ($str_length > 0) { |
485
|
0
|
|
|
|
|
|
$record_city = substr($record_buf,$record_buf_pos,$str_length); |
486
|
|
|
|
|
|
|
} |
487
|
0
|
|
|
|
|
|
$record_buf_pos += $str_length + 1; |
488
|
0
|
|
|
|
|
|
$str_length = 0; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
#get the postal code |
491
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); |
492
|
0
|
|
|
|
|
|
while ($char != 0) { |
493
|
0
|
|
|
|
|
|
$str_length++;#get the length of string |
494
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); |
495
|
|
|
|
|
|
|
} |
496
|
0
|
0
|
|
|
|
|
if ($str_length > 0) { |
497
|
0
|
|
|
|
|
|
$record_postal_code = substr($record_buf,$record_buf_pos,$str_length); |
498
|
|
|
|
|
|
|
} |
499
|
0
|
|
|
|
|
|
$record_buf_pos += $str_length + 1; |
500
|
0
|
|
|
|
|
|
$str_length = 0; |
501
|
0
|
|
|
|
|
|
my $latitude = 0; |
502
|
0
|
|
|
|
|
|
my $longitude = 0; |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
#get the latitude |
505
|
0
|
|
|
|
|
|
for ($j = 0;$j < 3; ++$j) { |
506
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos++,1)); |
507
|
0
|
|
|
|
|
|
$latitude += ($char << ($j * 8)); |
508
|
|
|
|
|
|
|
} |
509
|
0
|
|
|
|
|
|
$record_latitude = ($latitude/10000) - 180; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
#get the longitude |
512
|
0
|
|
|
|
|
|
for ($j = 0;$j < 3; ++$j) { |
513
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos++,1)); |
514
|
0
|
|
|
|
|
|
$longitude += ($char << ($j * 8)); |
515
|
|
|
|
|
|
|
} |
516
|
0
|
|
|
|
|
|
$record_longitude = ($longitude/10000) - 180; |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
#get the metro code and the area code |
519
|
0
|
0
|
|
|
|
|
if (GEOIP_CITY_EDITION_REV1 == $gi->{"databaseType"}) { |
520
|
0
|
|
|
|
|
|
$metroarea_combo = 0; |
521
|
0
|
0
|
|
|
|
|
if ($record_country_code eq "US") { |
522
|
|
|
|
|
|
|
#if the country is US then read the metro area combo |
523
|
0
|
|
|
|
|
|
for ($j = 0;$j < 3;++$j) { |
524
|
0
|
|
|
|
|
|
$char = ord(substr($record_buf,$record_buf_pos++,1)); |
525
|
0
|
|
|
|
|
|
$metroarea_combo += ($char << ($j * 8)); |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
#split the metro area combo into the metro code and the area code |
528
|
0
|
|
|
|
|
|
$record_metro_code = int($metroarea_combo/1000); |
529
|
0
|
|
|
|
|
|
$record_area_code = $metroarea_combo%1000; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# the pureperl API must convert the string by themself to UTF8 |
534
|
|
|
|
|
|
|
# using Encode for perl >= 5.008 otherwise use it's own iso-8859-1 to utf8 converter |
535
|
0
|
0
|
|
|
|
|
$record_city = decode( 'iso-8859-1' => $record_city ) |
536
|
|
|
|
|
|
|
if $gi->charset == GEOIP_CHARSET_UTF8; |
537
|
|
|
|
|
|
|
|
538
|
0
|
|
|
|
|
|
return ($record_country_code,$record_country_code3,$record_country_name,$record_region,$record_city,$record_postal_code,$record_latitude,$record_longitude,$record_metro_code,$record_area_code); |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
#this function returns the city record as a hash ref |
542
|
|
|
|
|
|
|
sub get_city_record_as_hash { |
543
|
0
|
|
|
0
|
1
|
|
my ($gi, $host) = @_; |
544
|
0
|
|
|
|
|
|
my %h; |
545
|
0
|
|
|
|
|
|
@h{qw/ country_code country_code3 country_name |
546
|
|
|
|
|
|
|
region city postal_code |
547
|
|
|
|
|
|
|
latitude longitude metro_code |
548
|
|
|
|
|
|
|
area_code /} |
549
|
|
|
|
|
|
|
= $gi->get_city_record($host); |
550
|
0
|
|
|
|
|
|
$h{dma_code} = $h{metro_code}; # alias for depreciated dma_code |
551
|
0
|
|
|
|
|
|
return \%h; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
#this function returns isp or org of the domain name |
555
|
|
|
|
|
|
|
sub org_by_name { |
556
|
0
|
|
|
0
|
1
|
|
my ($gi, $host) = @_; |
557
|
0
|
|
|
|
|
|
my $ip_address = $gi->get_ip_address($host); |
558
|
0
|
|
|
|
|
|
my $seek_org = $gi->_seek_country(addr_to_num($ip_address)); |
559
|
0
|
|
|
|
|
|
my $char; |
560
|
|
|
|
|
|
|
my $org_buf; |
561
|
0
|
|
|
|
|
|
my $org_buf_length = 0; |
562
|
0
|
|
|
|
|
|
my $record_pointer; |
563
|
|
|
|
|
|
|
|
564
|
0
|
0
|
|
|
|
|
if ($seek_org == $gi->{"databaseSegments"}) { |
565
|
0
|
|
|
|
|
|
return undef; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
0
|
|
|
|
|
|
$record_pointer = $seek_org + (2 * $gi->{"record_length"} - 1) * $gi->{"databaseSegments"}; |
569
|
|
|
|
|
|
|
|
570
|
0
|
0
|
|
|
|
|
unless ( exists $gi->{buf} ) { |
571
|
0
|
|
|
|
|
|
seek( $gi->{"fh"}, $record_pointer, 0 ); |
572
|
0
|
|
|
|
|
|
read( $gi->{"fh"}, $org_buf, MAX_ORG_RECORD_LENGTH ); |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
else { |
575
|
0
|
|
|
|
|
|
$org_buf = substr($gi->{buf}, $record_pointer, MAX_ORG_RECORD_LENGTH ); |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
0
|
|
|
|
|
|
$char = ord(substr($org_buf,0,1)); |
579
|
0
|
|
|
|
|
|
while ($char != 0) { |
580
|
0
|
|
|
|
|
|
$org_buf_length++; |
581
|
0
|
|
|
|
|
|
$char = ord(substr($org_buf,$org_buf_length,1)); |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
0
|
|
|
|
|
|
$org_buf = substr($org_buf, 0, $org_buf_length); |
585
|
0
|
|
|
|
|
|
return $org_buf; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
#this function returns isp or org of the domain name |
589
|
|
|
|
|
|
|
*isp_by_name = \*org_by_name; |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
*org_by_addr = \*org_by_name; |
592
|
|
|
|
|
|
|
*isp_by_addr = \*org_by_name; |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
#this function returns the region |
595
|
|
|
|
|
|
|
sub region_by_name { |
596
|
0
|
|
|
0
|
0
|
|
my ($gi, $host) = @_; |
597
|
0
|
|
|
|
|
|
my $ip_address = $gi->get_ip_address($host); |
598
|
0
|
0
|
|
|
|
|
return unless $ip_address; |
599
|
0
|
0
|
|
|
|
|
if ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV0) { |
|
|
0
|
|
|
|
|
|
600
|
0
|
|
|
|
|
|
my $seek_region = $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_STATE_BEGIN_REV0; |
601
|
0
|
0
|
|
|
|
|
if ($seek_region >= 1000) { |
602
|
0
|
|
|
|
|
|
return ("US",chr(($seek_region - 1000)/26 + 65) . chr(($seek_region - 1000)%26 + 65)); |
603
|
|
|
|
|
|
|
} else { |
604
|
0
|
|
|
|
|
|
return ($countries[$seek_region],""); |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
} elsif ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV1) { |
607
|
0
|
|
|
|
|
|
my $seek_region = $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_STATE_BEGIN_REV1; |
608
|
0
|
0
|
|
|
|
|
if ($seek_region < US_OFFSET) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
609
|
0
|
|
|
|
|
|
return ("",""); |
610
|
|
|
|
|
|
|
} elsif ($seek_region < CANADA_OFFSET) { |
611
|
|
|
|
|
|
|
# return a us state |
612
|
0
|
|
|
|
|
|
return ("US",chr(($seek_region - US_OFFSET)/26 + 65) . chr(($seek_region - US_OFFSET)%26 + 65)); |
613
|
|
|
|
|
|
|
} elsif ($seek_region < WORLD_OFFSET) { |
614
|
|
|
|
|
|
|
# return a canada province |
615
|
0
|
|
|
|
|
|
return ("CA",chr(($seek_region - CANADA_OFFSET)/26 + 65) . chr(($seek_region - CANADA_OFFSET)%26 + 65)); |
616
|
|
|
|
|
|
|
} else { |
617
|
|
|
|
|
|
|
# return a country of the world |
618
|
0
|
|
|
|
|
|
my $c = $countries[($seek_region - WORLD_OFFSET) / FIPS_RANGE]; |
619
|
0
|
|
|
|
|
|
my $a2 = ($seek_region - WORLD_OFFSET) % FIPS_RANGE; |
620
|
0
|
|
|
|
|
|
my $r = chr(($a2 / 100)+48) . chr((($a2 / 10) % 10)+48) . chr(($a2 % 10)+48); |
621
|
0
|
|
|
|
|
|
return ($c,$r); |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
sub get_ip_address { |
627
|
0
|
|
|
0
|
0
|
|
my ($gi, $host) = @_; |
628
|
0
|
|
|
|
|
|
my $ip_address; |
629
|
|
|
|
|
|
|
#check if host is ip address |
630
|
0
|
0
|
|
|
|
|
if ($host =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!) { |
631
|
|
|
|
|
|
|
#host is ip address |
632
|
0
|
|
|
|
|
|
$ip_address = $host; |
633
|
|
|
|
|
|
|
} else { |
634
|
|
|
|
|
|
|
#host is domain name do a dns lookup |
635
|
0
|
|
|
|
|
|
$ip_address = join('.',unpack('C4',(gethostbyname($host))[4])); |
636
|
|
|
|
|
|
|
} |
637
|
0
|
|
|
|
|
|
return $ip_address; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
0
|
|
|
0
|
0
|
|
sub addr_to_num { unpack( N => pack( C4 => split( /\./, $_[0] ) ) ) } |
641
|
0
|
|
|
0
|
0
|
|
sub num_to_addr { join q{.}, unpack( C4 => pack( N => $_[0] ) ) } |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub database_info { |
644
|
0
|
|
|
0
|
1
|
|
my $gi = shift; |
645
|
0
|
|
|
|
|
|
my $i = 0; |
646
|
0
|
|
|
|
|
|
my $buf; |
647
|
|
|
|
|
|
|
my $retval; |
648
|
0
|
|
|
|
|
|
my $hasStructureInfo; |
649
|
0
|
|
|
|
|
|
seek($gi->{fh},-3,2); |
650
|
0
|
|
|
|
|
|
for (my $i = 0;$i < STRUCTURE_INFO_MAX_SIZE;$i++) { |
651
|
0
|
|
|
|
|
|
read($gi->{fh},$buf,3); |
652
|
0
|
0
|
|
|
|
|
if ($buf eq (chr(255) . chr(255) . chr(255))) { |
653
|
0
|
|
|
|
|
|
$hasStructureInfo = 1; |
654
|
0
|
|
|
|
|
|
last; |
655
|
|
|
|
|
|
|
} |
656
|
0
|
|
|
|
|
|
seek($gi->{fh},-4,1); |
657
|
|
|
|
|
|
|
} |
658
|
0
|
0
|
|
|
|
|
if ($hasStructureInfo == 1) { |
659
|
0
|
|
|
|
|
|
seek($gi->{fh},-6,1); |
660
|
|
|
|
|
|
|
} else { |
661
|
|
|
|
|
|
|
# no structure info, must be pre Sep 2002 database, go back to |
662
|
0
|
|
|
|
|
|
seek($gi->{fh},-3,2); |
663
|
|
|
|
|
|
|
} |
664
|
0
|
|
|
|
|
|
for (my $i = 0;$i < DATABASE_INFO_MAX_SIZE;$i++){ |
665
|
0
|
|
|
|
|
|
read($gi->{fh},$buf,3); |
666
|
0
|
0
|
|
|
|
|
if ($buf eq (chr(0). chr(0). chr(0))){ |
667
|
0
|
|
|
|
|
|
read($gi->{fh},$retval,$i); |
668
|
0
|
|
|
|
|
|
return $retval; |
669
|
|
|
|
|
|
|
} |
670
|
0
|
|
|
|
|
|
seek($gi->{fh},-4,1); |
671
|
|
|
|
|
|
|
} |
672
|
0
|
|
|
|
|
|
return ""; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub range_by_ip { |
676
|
0
|
|
|
0
|
1
|
|
my $gi = shift; |
677
|
0
|
|
|
|
|
|
my $ipnum = addr_to_num( shift ); |
678
|
0
|
|
|
|
|
|
my $c = $gi->_seek_country( $ipnum ); |
679
|
0
|
|
|
|
|
|
my $nm = $gi->last_netmask; |
680
|
0
|
|
|
|
|
|
my $m = 0xffffffff << 32 - $nm; |
681
|
0
|
|
|
|
|
|
my $left_seek_num = $ipnum & $m; |
682
|
0
|
|
|
|
|
|
my $right_seek_num = $left_seek_num + ( 0xffffffff & ~$m ); |
683
|
|
|
|
|
|
|
|
684
|
0
|
|
0
|
|
|
|
while ( $left_seek_num != 0 |
685
|
|
|
|
|
|
|
and $c == $gi->_seek_country( $left_seek_num - 1) ) { |
686
|
0
|
|
|
|
|
|
my $lm = 0xffffffff << 32 - $gi->last_netmask; |
687
|
0
|
|
|
|
|
|
$left_seek_num = ( $left_seek_num - 1 ) & $lm; |
688
|
|
|
|
|
|
|
} |
689
|
0
|
|
0
|
|
|
|
while ( $right_seek_num != 0xffffffff |
690
|
|
|
|
|
|
|
and $c == $gi->_seek_country( $right_seek_num + 1 ) ) { |
691
|
0
|
|
|
|
|
|
my $rm = 0xffffffff << 32 - $gi->last_netmask; |
692
|
0
|
|
|
|
|
|
$right_seek_num = ( $right_seek_num + 1 ) & $rm; |
693
|
0
|
|
|
|
|
|
$right_seek_num += ( 0xffffffff & ~$rm ); |
694
|
|
|
|
|
|
|
} |
695
|
0
|
|
|
|
|
|
return ( num_to_addr($left_seek_num), num_to_addr($right_seek_num) ); |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
0
|
|
|
0
|
1
|
|
sub netmask { $_[0]->{last_netmask} = $_[1] } |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub last_netmask { |
701
|
0
|
|
|
0
|
1
|
|
return $_[0]->{last_netmask}; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
sub DESTROY { |
705
|
0
|
|
|
0
|
|
|
my $gi = shift; |
706
|
|
|
|
|
|
|
|
707
|
0
|
0
|
0
|
|
|
|
if ( exists $gi->{buf} && $gi->{flags} && ( $gi->{flags} & GEOIP_MMAP_CACHE ) ) { |
|
|
|
0
|
|
|
|
|
708
|
0
|
0
|
|
|
|
|
munmap( $gi->{buf} ) or die "munmap: $!"; |
709
|
0
|
|
|
|
|
|
delete $gi->{buf}; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
1; |
713
|
|
|
|
|
|
|
__END__ |