File Coverage

blib/lib/Net/Magallanes.pm
Criterion Covered Total %
statement 20 161 12.4
branch 0 64 0.0
condition 0 18 0.0
subroutine 7 14 50.0
pod 5 7 71.4
total 32 264 12.1


line stmt bran cond sub pod time code
1             package Net::Magallanes;
2              
3 1     1   76724 use strict;
  1         14  
  1         30  
4 1     1   33 use 5.008_005;
  1         4  
5             our $VERSION = '0.01';
6              
7 1     1   825 use LWP::UserAgent;
  1         50973  
  1         58  
8 1     1   1024 use JSON;
  1         11395  
  1         7  
9 1     1   1178 use MIME::Base64;
  1         640  
  1         72  
10 1     1   508 use Net::DNS;
  1         119426  
  1         359  
11 1     1   18 use Carp;
  1         8  
  1         8974  
12              
13             sub new {
14 0     0 1   my $this = shift;
15 0           my %params = @_;
16              
17 0           my ($API_KEY, $IN_FILES);
18 0           my $API_BASE = 'https://atlas.ripe.net/api/v2';
19              
20 0   0       my $class = ref($this) || $this;
21              
22 0 0         $API_KEY = $params{'KEY'} if $params{'KEY'};
23 0 0         $IN_FILES = $params{'INFILES'} if $params{'INFILES'};
24              
25             # armar estructura con defaults sensibles
26 0           my $self = {};
27 0           bless $self, $class;
28              
29             # Si no hay KEY igual le damos, pero no podremos crear cosas, solo
30             # consultar.
31 0           $self->{'KEY'} = $API_KEY;
32 0           $self->{'ua'} = LWP::UserAgent->new(timeout => 10);
33 0           $self->{'ua'}->default_header('Content-Type' => 'application/json');
34 0           $self->{'ua'}->default_header('Accept' => 'application/json');
35 0           $self->{'URL'} = $API_BASE;
36              
37 0           $self->{'_CACHE_MSM'} = {};
38              
39 0 0         if ($IN_FILES) {
40 0           my @files = split ',', $IN_FILES;
41 0           my $data;
42 0           foreach my $file (@files) {
43 0 0         open my $fh, '<', $file
44             or croak "Couldn't open file $file: $!";
45 0           local $/ = undef;
46 0           $data = <$fh>;
47 0           close $fh;
48 0           my $result = decode_json $data;
49 0           my $mi = $result->[0]->{msm_id};
50 0           $self->{'_CACHE_MSM'}->{$mi} = $result;
51             }
52             }
53              
54             # Qué puede venir:
55             # timeouts de https request
56             # versión de API
57             # defaults comunes a todo:
58             # - one_off (default true)
59              
60 0           return $self;
61             }
62              
63             sub results {
64 0     0 0   my $self = shift;
65 0           my $msm_id = shift;
66              
67 0           my $result;
68              
69 0 0 0       croak("You must provide the measurement identificator msm_id (only digits)")
70             unless defined $msm_id and $msm_id =~ /^\d+$/;
71              
72             return $self->{'_CACHE_MSM'}->{$msm_id}
73 0 0         if defined $self->{'_CACHE_MSM'}->{$msm_id};
74              
75 0           my $res = $self->{'ua'}->get( $self->{'URL'} .
76             "/measurements/$msm_id/results/" .
77             '?format=json'
78             );
79              
80 0           $self->{'_JSON'} = $res->decoded_content;
81              
82 0 0         if ($res->is_success) {
83 0           $result = decode_json $res->decoded_content;
84             }
85             else {
86 0           $result = 'ERROR: ' . $res->status_line;
87             }
88              
89 0           $self->{'_CACHE_MSM'}->{$msm_id} = $result;
90              
91 0           return $result;
92             }
93              
94             sub json {
95 0     0 0   my $self = shift;
96              
97 0           return $self->{'_JSON'};
98             }
99              
100             sub answers {
101 0     0 1   my $self = shift;
102 0           my $msm_id = shift;
103 0           my $type = shift;
104              
105 0 0         $type = 'A' unless $type;
106              
107 0           my $result = results($self, $msm_id);
108              
109 0           my @sal;
110 0           foreach my $resdo (@{$result}) {
  0            
111 0 0         if ($resdo->{'type'} eq 'dns') {
112 0           my $res_set = $resdo->{'resultset'};
113 0 0         if ($#{$res_set} < 0) {
  0            
114 0           push @{$res_set}, $resdo;
  0            
115             }
116 0           foreach my $dns (@$res_set) {
117 0           my $abuf = $dns->{'result'}->{'abuf'};
118 0 0         next unless $abuf;
119 0           my $dec_buff = decode_base64 $abuf;
120 0 0 0       if(defined $abuf && defined $dec_buff) {
121 0           my ($dns_pack)= new Net::DNS::Packet(\$dec_buff);
122 0           my @ans = $dns_pack->answer;
123 0           foreach my $ans (@ans) {
124 0 0         next unless $ans->type eq $type;
125 0           my $res_ip;
126 0 0         if ($type eq 'A') {
    0          
127 0           $res_ip = $ans->address;
128             }
129             elsif ($type eq 'AAAA') {
130 0           $res_ip = $ans->address_short;
131             }
132             else {
133 0           $res_ip = $ans->string;
134             }
135 0 0         push @sal, $res_ip if $res_ip;
136             }
137             }
138             }
139             }
140             }
141 0           return @sal;
142             }
143              
144             sub nsids {
145 0     0 1   my $self = shift;
146 0           my $msm_id = shift;
147              
148 0           my $result = results($self, $msm_id);
149              
150 0           my @sal;
151 0           foreach my $resdo (@{$result}) {
  0            
152 0 0         if ($resdo->{'type'} eq 'dns') {
153 0           my $res_set = $resdo->{'resultset'};
154 0 0         if ($#{$res_set} < 0) {
  0            
155 0           push @{$res_set}, $resdo;
  0            
156             }
157 0           foreach my $dns (@$res_set) {
158 0           my $abuf = $dns->{'result'}->{'abuf'};
159 0 0         next unless $abuf;
160 0           my $dec_buff = decode_base64 $abuf;
161 0 0 0       if(defined $abuf && defined $dec_buff) {
162 0           my ($dns_pack)= new Net::DNS::Packet(\$dec_buff);
163 0           my @edns = $dns_pack->edns;
164 0           foreach my $edn (@edns) {
165 0           my $res_ip = $edn->option(3);
166 0 0         push @sal, ($res_ip ? $res_ip : 'NULL');
167             }
168             }
169             }
170             }
171             }
172 0           return @sal;
173             }
174              
175             sub rcodes {
176 0     0 1   my $self = shift;
177 0           my $msm_id = shift;
178              
179 0           my $result = results($self, $msm_id);
180              
181 0           my @sal;
182 0           foreach my $resdo (@{$result}) {
  0            
183 0 0         if ($resdo->{'type'} eq 'dns') {
184 0           my $res_set = $resdo->{'resultset'};
185 0 0         if ($#{$res_set} < 0) {
  0            
186 0           push @{$res_set}, $resdo;
  0            
187             }
188 0           foreach my $dns (@$res_set) {
189 0           my $abuf = $dns->{'result'}->{'abuf'};
190 0 0         next unless $abuf;
191 0           my $dec_buff = decode_base64 $abuf;
192 0 0 0       if(defined $abuf && defined $dec_buff) {
193 0           my ($dns_pack)= new Net::DNS::Packet(\$dec_buff);
194 0           my $header = $dns_pack->header;
195 0           push @sal, $header->rcode;
196             }
197             }
198             }
199             }
200 0           return @sal;
201             }
202              
203             sub dns {
204 0     0 1   my $self = shift;
205 0           my %params = @_;
206              
207             croak("You must provide at least the query name")
208 0 0         unless defined $params{'name'};
209             croak('You must provide an API key (KEY constructor param) to create measurements')
210 0 0 0       unless defined $self->{'KEY'} and $self->{'KEY'};
211              
212 0 0         my $qtype = defined($params{'type'}) ? $params{'type'} : 'AAAA';
213 0 0         my $nprb = defined($params{'num_prb'}) ? $params{'num_prb'} : 5;
214              
215 0           my %DEFS = (
216             description => 'DNS measurement to ',
217             type => 'dns',
218             query_class => 'IN',
219             timeout => 5000,
220             retry => 0,
221             af => 4,
222             use_macros => 'false',
223             use_probe_resolver => 'true',
224             resolve_on_probe => 'false',
225             set_nsid_bit => 'true',
226             protocol => 'UDP',
227             udp_payload_size => 1232,
228             skip_dns_check => 'false',
229             include_qbuf => 'false',
230             include_abuf => 'true',
231             prepend_probe_id => 'false',
232             set_rd_bit => 'false',
233             set_do_bit => 'true',
234             set_cd_bit => 'false',
235             # start_time
236             # stop_time
237             # interval
238             # target
239             );
240              
241 0           my %PROBES = (
242             type => 'area',
243             value => 'WW',
244             # tags_include => 'system-ipv4-works,system-can-resolve-a',
245             tags_include => 'system-ipv4-works',
246             );
247              
248 0           $PROBES{'requested'} = $nprb;
249              
250 0           $DEFS{'query_argument'} = $params{'name'};
251 0           $DEFS{'query_type'} = $qtype;
252 0           $DEFS{'description'} .= $params{'name'};
253              
254 0           my %ATLASCALL;
255 0           push @{$ATLASCALL{'definitions'}}, \%DEFS;
  0            
256 0           push @{$ATLASCALL{'probes'}}, \%PROBES;
  0            
257              
258 0           $ATLASCALL{'is_oneoff'} = 'true';
259              
260 0           my $json = encode_json \%ATLASCALL;
261              
262             my $res = $self->{'ua'}->post( $self->{'URL'} .
263             '/measurements/' .
264 0           '?key=' . $self->{'KEY'},
265             Content => $json
266             );
267              
268 0 0         if ($res->is_success) {
269 0           my $msmout = $res->decoded_content;
270 0 0         my $msm = $1 if $res->decoded_content =~ /{"measurements":\[(\d+)\]}/;
271              
272 0 0         croak 'Bad measurement id, please check: ' . $res->decoded_content unless $msm;
273              
274 0           return $msm;
275             }
276             else {
277 0           croak 'Could not create a measurement: ' . $res->status_line;
278             }
279             }
280              
281             1;
282              
283             __END__