File Coverage

blib/lib/Metabrik/Database/Rir.pm
Criterion Covered Total %
statement 9 89 10.1
branch 0 36 0.0
condition 0 12 0.0
subroutine 3 7 42.8
pod 1 4 25.0
total 13 148 8.7


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # database::rir Brik
5             #
6             package Metabrik::Database::Rir;
7 1     1   657 use strict;
  1         2  
  1         29  
8 1     1   9 use warnings;
  1         2  
  1         27  
9              
10             # Some history:
11             # http://www.apnic.net/about-APNIC/organization/history-of-apnic/history-of-the-regional-internet-registries
12              
13 1     1   5 use base qw(Metabrik);
  1         7  
  1         1075  
14              
15             sub brik_properties {
16             return {
17 0     0 1   revision => '$Revision$',
18             tags => [ qw(unstable as country subnet) ],
19             author => 'GomoR ',
20             license => 'http://opensource.org/licenses/BSD-3-Clause',
21             attributes => {
22             datadir => [ qw(datadir) ],
23             input => [ qw(input.rir) ],
24             _read => [ qw(INTERNAL) ],
25             },
26             attributes_default => {
27             input => 'input.rir',
28             },
29             commands => {
30             update => [ ],
31             next_record => [ qw(input|OPTIONAL) ],
32             ip_to_asn => [ qw(ipv4_address) ],
33             },
34             require_modules => {
35             'Metabrik::Client::Www' => [ ],
36             'Metabrik::File::Read' => [ ],
37             'Metabrik::Network::Address' => [ ],
38             },
39             };
40             }
41              
42             sub update {
43 0     0 0   my $self = shift;
44              
45 0           my @urls = qw(
46             ftp://ftp.arin.net/pub/stats/arin/delegated-arin-extended-latest
47             ftp://ftp.ripe.net/ripe/stats/delegated-ripencc-extended-latest
48             ftp://ftp.afrinic.net/pub/stats/afrinic/delegated-afrinic-extended-latest
49             ftp://ftp.apnic.net/pub/stats/apnic/delegated-apnic-extended-latest
50             ftp://ftp.lacnic.net/pub/stats/lacnic/delegated-lacnic-extended-latest
51             );
52              
53 0           my $datadir = $self->datadir;
54              
55 0 0         my $cw = Metabrik::Client::Www->new_from_brik_init($self) or return;
56              
57 0           my @fetched = ();
58 0           for my $url (@urls) {
59 0           $self->log->verbose("update: fetching url [$url]");
60              
61 0           (my $filename = $url) =~ s/^.*\/(.*?)$/$1/;
62              
63 0           my $output = $datadir.'/'.$filename;
64 0           my $r = $cw->mirror($url, $filename, $datadir);
65 0 0         if (! defined($r)) {
66 0           $self->log->warning("update: can't fetch url [$url]");
67 0           next;
68             }
69 0 0         if (@$r == 0) { # Nothing new
70 0           next;
71             }
72 0           push @fetched, $output;
73             }
74              
75 0           return \@fetched;
76             }
77              
78             sub next_record {
79 0     0 0   my $self = shift;
80 0           my ($input) = @_;
81              
82 0           my $fr = $self->_read;
83 0 0         if (! defined($fr)) {
84 0   0       $input ||= $self->datadir.'/'.$self->input;
85 0 0         $self->brik_help_run_file_not_found('next_record', $input) or return;
86              
87 0 0         $fr = Metabrik::File::Read->new_from_brik_init($self) or return;
88 0           $fr->encoding('ascii');
89 0           $fr->input($input);
90 0           $fr->as_array(0);
91 0 0         $fr->open or return;
92 0           $self->_read($fr);
93             }
94              
95 0 0         my $na = Metabrik::Network::Address->new_from_brik_init($self) or return;
96              
97             # 2|afrinic|20150119|4180|00000000|20150119|00000
98             # afrinic|*|asn|*|1146|summary
99             # afrinic|*|ipv4|*|2586|summary
100             # afrinic|*|ipv6|*|448|summary
101             # afrinic|ZA|asn|1228|1|19910301|allocated
102             # arin|US|ipv4|13.128.0.0|524288|19860425|assigned|efe0f73dfd0d72364bf64f417b803f18
103              
104 0           my $line;
105 0           while ($line = $fr->read_line) {
106 0 0         next if $line =~ /^\s*#/; # Skip comments
107              
108 0           chomp($line);
109              
110 0           $self->log->debug("next_record: line[$line]");
111              
112 0           my @t = split(/\|/, $line);
113              
114 0           my $cc = $t[1];
115 0 0         if (! defined($cc)) {
116 0           $self->log->verbose("next_record: skipping line [$line]");
117 0           next;
118             }
119 0 0         next if ($cc eq '*');
120              
121 0           my $type = $t[2];
122 0 0         if (! defined($type)) {
123 0           $self->log->verbose("next_record: skipping line [$line]");
124 0           next;
125             }
126 0 0 0       next if ($type ne 'asn' && $type ne 'ipv4' && $type ne 'ipv6');
      0        
127              
128 0           my $source = $t[0];
129 0           my $value = $t[3];
130 0           my $count = $t[4];
131 0           my $date = $t[5];
132 0           my $status = $t[6];
133              
134 0 0 0       if ($date !~ /^\d{8}$/ && $date ne '') {
135 0           $self->log->warning("next_record: invalid date [$date] for line [$line]");
136 0           $date = '1970-01-01';
137             }
138             else {
139 0           $date =~ s/^(\d{4})(\d{2})(\d{2})$/$1-$2-$3/;
140             }
141              
142 0           my $from = 'undef';
143 0           my $to = 'undef';
144 0           my $subnet = 'undef';
145 0 0         if ($type eq 'ipv4') {
146 0           $from = $value;
147 0           my $integer = $na->ipv4_to_integer($from);
148 0 0         if (! defined($integer)) {
149 0           $self->log->warning("next_record: unable to convert IPv4 [$from]");
150 0           next;
151             }
152 0           $to = $na->integer_to_ipv4($integer + $count - 1);
153 0 0         if (! defined($to)) {
154 0           $self->log->warning("next_record: unable to convert integer [".$integer + $count."]");
155 0           next;
156             }
157 0           $subnet = $na->range_to_cidr($from, $to);
158 0 0         if (! defined($subnet)) {
159 0           $self->log->warning("next_record: unable to get subnet with [$from] [$to]");
160 0           next;
161             }
162 0           $subnet = join('|', @$subnet);
163             }
164              
165 0           my $h = {
166             raw => $line,
167             source => uc($source),
168             cc => uc($cc),
169             type => $type,
170             value => $value,
171             count => $count,
172             date => $date,
173             status => $status,
174             subnet => $subnet,
175             from => $value,
176             to => $to,
177             };
178              
179 0           return $h;
180             }
181              
182 0           return;
183             }
184              
185             sub ip_to_asn {
186 0     0 0   my $self = shift;
187 0           my ($ip) = @_;
188              
189 0           return $self;
190             }
191              
192             1;
193              
194             __END__