File Coverage

blib/lib/Metabrik/Lookup/Iplocation.pm
Criterion Covered Total %
statement 9 165 5.4
branch 0 62 0.0
condition 0 41 0.0
subroutine 3 13 23.0
pod 2 10 20.0
total 14 291 4.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # lookup::iplocation Brik
5             #
6             package Metabrik::Lookup::Iplocation;
7 1     1   763 use strict;
  1         2  
  1         28  
8 1     1   5 use warnings;
  1         3  
  1         26  
9              
10 1     1   14 use base qw(Metabrik);
  1         2  
  1         1980  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable location ipv4 ipv6 ip geo geolocation) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             _na => [ qw(INTERNAL) ],
21             },
22             commands => {
23             update => [ ],
24             from_ip => [ qw(ip_address) ],
25             from_ipv4 => [ qw(ipv4_address) ],
26             from_ipv6 => [ qw(ipv6_address) ],
27             subnet4 => [ qw(ipv4_address) ],
28             organization_name => [ qw(ip_address) ],
29             range_from_ipv4 => [ qw(ipv4_address) ],
30             networks_from_ipv4 => [ qw(ipv4_address) ],
31             },
32             require_modules => {
33             'Geo::IP' => [ ],
34             'Metabrik::Client::Www' => [ ],
35             'Metabrik::File::Compress' => [ ],
36             'Metabrik::Network::Address' => [ ],
37             },
38             need_packages => {
39             ubuntu => [ qw(libgeoip-dev) ],
40             debian => [ qw(libgeoip-dev) ],
41             kali => [ qw(libgeoip-dev) ],
42             freebsd => [ qw(net/GeoIP) ],
43             },
44             };
45             }
46              
47             sub brik_init {
48 0     0 1   my $self = shift;
49              
50 0 0         my $init = $self->SUPER::brik_init or return;
51              
52 0 0         my $na = Metabrik::Network::Address->new_from_brik_init($self) or return;
53 0           $self->_na($na);
54              
55 0           return 1;
56             }
57              
58             sub update {
59 0     0 0   my $self = shift;
60              
61 0           my $datadir = $self->datadir;
62              
63 0           my $dl_path = 'http://geolite.maxmind.com/download/geoip/database/';
64              
65 0           my %mirror = (
66             'GeoIP.dat.gz' => 'GeoLiteCountry/GeoIP.dat.gz',
67             'GeoIPv6.dat.gz' => 'GeoIPv6.dat.gz',
68             'GeoLiteCity.dat.gz' => 'GeoLiteCity.dat.gz',
69             'GeoLiteCityv6.dat.gz' => 'GeoLiteCityv6-beta/GeoLiteCityv6.dat.gz',
70             'GeoIPASNum.dat.gz' => 'asnum/GeoIPASNum.dat.gz',
71             'GeoIPASNumv6.dat.gz' => 'asnum/GeoIPASNumv6.dat.gz',
72             );
73              
74 0 0         my $cw = Metabrik::Client::Www->new_from_brik_init($self) or return;
75 0           $cw->user_agent("Metabrik-MaxMind-geolite-mirror/1.01");
76 0           $cw->datadir($datadir);
77              
78 0 0         my $fc = Metabrik::File::Compress->new_from_brik_init($self) or return;
79 0           $fc->datadir($datadir);
80              
81 0           my @updated = ();
82 0           for my $f (keys %mirror) {
83 0 0         my $files = $cw->mirror($dl_path.$mirror{$f}, $f) or next;
84 0           for my $file (@$files) {
85 0           (my $outfile = $file) =~ s/\.gz$//;
86 0           $self->log->verbose("update: uncompressing to [$outfile]");
87 0 0         $fc->uncompress($file, $outfile) or next;
88 0           push @updated, $outfile;
89             }
90             }
91              
92 0           return \@updated;
93             }
94              
95             sub from_ipv4 {
96 0     0 0   my $self = shift;
97 0           my ($ipv4) = @_;
98              
99 0 0         $self->brik_help_run_undef_arg('from_ipv4', $ipv4) or return;
100              
101 0           my $na = $self->_na;
102              
103 0 0         my $gi = Geo::IP->open($self->datadir.'/GeoLiteCity.dat', Geo::IP::GEOIP_STANDARD())
104             or return $self->log->error("from_ipv4: unable to open GeoLiteCity.dat");
105              
106 0 0         my $gi_asn = Geo::IP->open($self->datadir.'/GeoIPASNum.dat', Geo::IP::GEOIP_STANDARD())
107             or return $self->log->error("from_ipv4: unable to open GeoIPASNum.dat");
108              
109 0           my $record;
110 0           eval {
111 0           $record = $gi->record_by_addr($ipv4);
112             };
113 0 0 0       if ($@ || ! defined($record)) {
114 0           chomp($@);
115 0           return $self->log->error("from_ipv4: unable to find info for IPv4 [$ipv4]");
116             }
117              
118 0           my $h = {};
119 0           $h->{country_code} = $record->country_code;
120 0           $h->{country_code3} = $record->country_code3;
121 0           $h->{country_name} = $record->country_name;
122 0           $h->{region} = $record->region;
123 0           $h->{region_name} = $record->region_name;
124 0           $h->{city} = $record->city;
125 0           $h->{postal_code} = $record->postal_code;
126 0           $h->{latitude} = $record->latitude;
127 0           $h->{longitude} = $record->longitude;
128 0           $h->{time_zone} = $record->time_zone;
129 0           $h->{area_code} = $record->area_code;
130 0           $h->{continent_code} = $record->continent_code;
131 0           $h->{metro_code} = $record->metro_code;
132              
133 0           my $asn = '';
134 0           my $organization = '';
135 0           my $asn_organization = $gi_asn->name_by_addr($ipv4);
136 0 0         if ($asn_organization) {
137 0           ($asn, $organization) = $asn_organization =~ m{^(\S+)(?:\s+(.*))?$};
138 0   0       $asn ||= $asn_organization; # Not able to parse, we put it raw.
139             }
140 0   0       $asn ||= 'undef';
141 0   0       $organization ||= 'undef';
142              
143 0           my ($from, $to) = $gi->range_by_ip($ipv4);
144 0 0 0       if (! defined($from) || ! defined($to)) {
145 0           return $self->log->error("from_ipv4: unable to find range for IPv4 [$ipv4]");
146             }
147              
148 0 0         my $network = $na->range_to_cidr($from, $to) or return;
149 0           my $network_list = join('|', @$network);
150              
151             # Add other info and return
152 0           $h->{asn} = $asn;
153 0           $h->{organization} = $organization;
154 0           $h->{first_ip} = $from;
155 0           $h->{last_ip} = $to;
156 0           $h->{networks} = $network_list;
157              
158             # If not defined, we set to 0, as this should be a number.
159 0   0       $h->{dma_code} ||= 0;
160 0   0       $h->{area_code} ||= 0;
161 0   0       $h->{metro_code} ||= 0;
162              
163             # Set as undef if nothing found
164 0           for my $k (keys %$h) {
165 0 0 0       if (! defined($h->{$k}) || ! length($h->{$k})) {
166 0           $h->{$k} = 'undef';
167             }
168             }
169              
170 0           return $h;
171             }
172              
173             sub from_ipv6 {
174 0     0 0   my $self = shift;
175 0           my ($ipv6) = @_;
176              
177 0 0         $self->brik_help_run_undef_arg('from_ipv6', $ipv6) or return;
178              
179 0           my $na = $self->_na;
180              
181 0 0         my $gi = Geo::IP->open($self->datadir.'/GeoLiteCityv6.dat', Geo::IP::GEOIP_STANDARD())
182             or return $self->log->error("from_ipv6: unable to open GeoLiteCityv6.dat");
183              
184 0 0         my $gi_asn = Geo::IP->open($self->datadir.'/GeoIPASNumv6.dat',
185             Geo::IP::GEOIP_STANDARD())
186             or return $self->log->error("from_ipv6: unable to open GeoIPASNumv6.dat");
187              
188 0           my $record;
189 0           eval {
190 0           $record = $gi->record_by_addr_v6($ipv6);
191             };
192 0 0 0       if ($@ || ! defined($record)) {
193 0           chomp($@);
194 0           return $self->log->error("from_ipv6: unable to find info for IPv6 [$ipv6]");
195             }
196              
197 0           my $h = {};
198 0           $h->{country_code} = $record->country_code;
199 0           $h->{country_code3} = $record->country_code3;
200 0           $h->{country_name} = $record->country_name;
201 0           $h->{region} = $record->region;
202 0           $h->{region_name} = $record->region_name;
203 0           $h->{city} = $record->city;
204 0           $h->{postal_code} = $record->postal_code;
205 0           $h->{latitude} = $record->latitude;
206 0           $h->{longitude} = $record->longitude;
207 0           $h->{time_zone} = $record->time_zone;
208 0           $h->{area_code} = $record->area_code;
209 0           $h->{continent_code} = $record->continent_code;
210 0           $h->{metro_code} = $record->metro_code;
211              
212 0           my $asn = '';
213 0           my $organization = '';
214 0           my $asn_organization = $gi_asn->name_by_addr_v6($ipv6);
215 0 0         if ($asn_organization) {
216 0           ($asn, $organization) = $asn_organization =~ m{^(\S+)(?:\s+(.*))?$};
217 0   0       $asn ||= $asn_organization; # Not able to parse, we put it raw.
218             }
219 0   0       $asn ||= 'undef';
220 0   0       $organization ||= 'undef';
221              
222             #my ($from, $to) = $gi->range_by_ip($ipv6);
223             #if (! defined($from) || ! defined($to)) {
224             #return $self->log->error("from_ipv6: unable to find range for IPv6 [$ipv6]");
225             #}
226              
227             #my $network = $na->range_to_cidr($from, $to) or return;
228 0           my $network = [ 'undef' ]; # Not avail in IPv6 for now.
229 0           my $network_list = join('|', @$network);
230 0           $h->{first_ip} = 'undef';
231 0           $h->{last_ip} = 'undef';
232              
233             # Add other info and return
234 0           $h->{asn} = $asn;
235 0           $h->{organization} = $organization;
236 0           $h->{networks} = $network_list;
237              
238             # If not defined, we set to 0, as this should be a number.
239 0   0       $h->{dma_code} ||= 0;
240 0   0       $h->{area_code} ||= 0;
241 0   0       $h->{metro_code} ||= 0;
242              
243             # Set as undef if nothing found
244 0           for my $k (keys %$h) {
245 0 0 0       if (! defined($h->{$k}) || ! length($h->{$k})) {
246 0           $h->{$k} = 'undef';
247             }
248             }
249              
250 0           return $h;
251             }
252              
253             sub from_ip {
254 0     0 0   my $self = shift;
255 0           my ($ip) = @_;
256              
257 0 0         $self->brik_help_run_undef_arg('from_ip', $ip) or return;
258              
259 0           my $na = $self->_na;
260 0 0         if ($na->is_ipv4($ip)) {
    0          
261 0           return $self->from_ipv4($ip);
262             }
263             elsif ($na->is_ipv6($ip)) {
264 0           return $self->from_ipv6($ip);
265             }
266              
267 0           $self->log->info("from_ip: IP [$ip] is not a valid IP address");
268              
269 0           return 0;
270             }
271              
272             sub subnet4 {
273 0     0 0   my $self = shift;
274 0           my ($ipv4_address) = @_;
275              
276 0 0         $self->brik_help_run_undef_arg('subnet4', $ipv4_address) or return;
277              
278 0 0         my $gi = Geo::IP->open($self->datadir.'/GeoLiteCity.dat', Geo::IP::GEOIP_STANDARD())
279             or return $self->log->error("subnet4: unable to open GeoLiteCity.dat");
280              
281 0           my ($from, $to) = $gi->range_by_ip($ipv4_address);
282              
283 0           return [ $from, $to ];
284             }
285              
286             sub organization_name {
287 0     0 0   my $self = shift;
288 0           my ($ip_address) = @_;
289              
290 0 0         $self->brik_help_run_undef_arg('organization_name', $ip_address) or return;
291            
292 0 0         my $gi = Geo::IP->open($self->datadir.'/GeoLiteCity.dat', Geo::IP::GEOIP_STANDARD())
293             or return $self->log->error("organization_name: unable to open GeoLiteCity.dat");
294              
295 0           my $record = $gi->name_by_addr($ip_address);
296              
297 0           return $record;
298             }
299              
300             sub range_from_ipv4 {
301 0     0 0   my $self = shift;
302 0           my ($ipv4) = @_;
303              
304 0 0         $self->brik_help_run_undef_arg('range_from_ipv4', $ipv4) or return;
305              
306 0 0         my $gi = Geo::IP->open($self->datadir.'/GeoLiteCity.dat', Geo::IP::GEOIP_STANDARD())
307             or return $self->log->error("range_from_ipv4: unable to open GeoLiteCity.dat");
308              
309 0           my ($from, $to) = $gi->range_by_ip($ipv4);
310              
311 0           return [ $from, $to ];
312             }
313              
314             sub networks_from_ipv4 {
315 0     0 0   my $self = shift;
316 0           my ($ipv4) = @_;
317              
318 0 0         $self->brik_help_run_undef_arg('networks_from_ipv4', $ipv4) or return;
319              
320 0 0         my $range = $self->range_from_ipv4($ipv4) or return;
321              
322 0           my $na = $self->_na;
323              
324 0           return $na->range_to_cidr($range->[0], $range->[1]);
325             }
326              
327             1;
328              
329             __END__