File Coverage

blib/lib/Metabrik/Client/Dns.pm
Criterion Covered Total %
statement 9 205 4.3
branch 0 140 0.0
condition 0 92 0.0
subroutine 3 15 20.0
pod 2 12 16.6
total 14 464 3.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # client::dns Brik
5             #
6             package Metabrik::Client::Dns;
7 1     1   657 use strict;
  1         3  
  1         29  
8 1     1   4 use warnings;
  1         2  
  1         27  
9              
10 1     1   5 use base qw(Metabrik::Network::Dns);
  1         2  
  1         489  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             commands => {
19             get_local_resolver => [ qw(file|OPTIONAL) ],
20             a_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
21             aaaa_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
22             ptr_lookup => [ qw(ip_address|$ip_address_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
23             mx_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
24             ns_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
25             cname_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
26             soa_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
27             srv_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
28             txt_lookup => [ qw(host|$host_list nameserver|$nameserver_list|OPTIONAL port|OPTIONAL) ],
29             },
30             attributes => {
31             nameserver => [ qw(ip_address|$ip_address_list) ],
32             timeout => [ qw(0|1) ],
33             rtimeout => [ qw(timeout) ],
34             return_list => [ qw(0|1) ],
35             port => [ qw(port) ],
36             use_recursion => [ qw(0|1) ],
37             },
38             attributes_default => {
39             timeout => 0,
40             rtimeout => 2,
41             return_list => 1,
42             port => 53,
43             use_recursion => 1,
44             },
45             require_modules => {
46             'Metabrik::File::Text' => [ ],
47             },
48             };
49             }
50              
51             sub brik_init {
52 0     0 1   my $self = shift;
53              
54 0           my $ns = $self->get_local_resolver;
55 0 0         if (defined($ns)) {
56 0           $self->nameserver($ns);
57             }
58              
59 0           return $self->SUPER::brik_init(@_);
60             }
61              
62             sub get_local_resolver {
63 0     0 0   my $self = shift;
64 0           my ($file) = @_;
65              
66 0   0       $file ||= "/etc/resolv.conf";
67              
68 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
69 0           $ft->as_array(1);
70 0           $ft->strip_crlf(1);
71              
72 0           my @nameservers = ();
73 0 0         if (-f $file) {
74 0 0         my $lines = $ft->read($file) or return;
75 0           for (@$lines) {
76 0 0         if (/^\s*nameserver\s+/) {
77 0           my @toks = split(/\s+/);
78 0           push @nameservers, $toks[1];
79             }
80             }
81              
82 0           $self->log->verbose("brik_init: using resolve.conf DNS: [@nameservers]");
83             }
84              
85 0           my $google_ns = [ qw(8.8.8.8 8.8.4.4) ];
86 0 0         if (@nameservers > 0) {
87 0           $self->nameserver(\@nameservers);
88             }
89             else {
90 0           $self->nameserver($google_ns);
91             }
92              
93 0 0         return @nameservers > 0 ? \@nameservers : $google_ns;
94             }
95              
96             sub a_lookup {
97 0     0 0   my $self = shift;
98 0           my ($host, $nameserver, $port) = @_;
99              
100 0   0       $nameserver ||= $self->nameserver;
101 0   0       $port ||= $self->port || 53;
      0        
102 0 0         $self->brik_help_run_undef_arg('a_lookup', $host) or return;
103 0 0         my $ref = $self->brik_help_run_invalid_arg('a_lookup', $host, 'ARRAY', 'SCALAR')
104             or return;
105              
106 0 0         if ($ref eq 'ARRAY') {
107 0           my %res = ();
108 0           for my $this (@$host) {
109 0 0         my $r = $self->a_lookup($this, $nameserver, $port) or next;
110 0           $res{$this} = $r;
111             }
112              
113 0           return \%res;
114             }
115             else {
116 0 0         my $list = $self->lookup($host, 'A', $nameserver, $port) or return;
117              
118 0           my @res = ();
119 0           for (@$list) {
120 0 0         if (defined($_->{address})) {
121 0           push @res, $_->{address};
122             }
123             }
124              
125 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
126             }
127              
128 0           return; # Error
129             }
130              
131             sub aaaa_lookup {
132 0     0 0   my $self = shift;
133 0           my ($host, $nameserver, $port) = @_;
134              
135 0   0       $nameserver ||= $self->nameserver;
136 0   0       $port ||= $self->port || 53;
      0        
137 0 0         $self->brik_help_run_undef_arg('aaaa_lookup', $host) or return;
138 0 0         my $ref = $self->brik_help_run_invalid_arg('aaaa_lookup', $host, 'ARRAY', 'SCALAR')
139             or return;
140              
141 0 0         if ($ref eq 'ARRAY') {
142 0           my %res = ();
143 0           for my $this (@$host) {
144 0 0         my $r = $self->aaaa_lookup($this, $nameserver, $port) or next;
145 0           $res{$this} = $r;
146             }
147              
148 0           return \%res;
149             }
150             else {
151 0 0         my $list = $self->lookup($host, 'AAAA', $nameserver, $port) or return;
152              
153 0           my @res = ();
154 0           for (@$list) {
155 0 0         if (defined($_->{address})) {
156 0           push @res, $_->{address};
157             }
158             }
159              
160 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
161             }
162              
163 0           return; # Error
164             }
165              
166             sub ptr_lookup {
167 0     0 0   my $self = shift;
168 0           my ($host, $nameserver, $port) = @_;
169              
170 0   0       $nameserver ||= $self->nameserver;
171 0   0       $port ||= $self->port || 53;
      0        
172 0 0         $self->brik_help_run_undef_arg('ptr_lookup', $host) or return;
173 0 0         my $ref = $self->brik_help_run_invalid_arg('ptr_lookup', $host, 'ARRAY', 'SCALAR')
174             or return;
175              
176 0 0         if ($ref eq 'ARRAY') {
177 0           my %res = ();
178 0           for my $this (@$host) {
179 0 0         my $r = $self->ptr_lookup($this, $nameserver, $port) or next;
180 0           $res{$this} = $r;
181             }
182              
183 0           return \%res;
184             }
185             else {
186 0 0         my $list = $self->lookup($host, 'PTR', $nameserver, $port) or return;
187              
188 0           my @res = ();
189 0           for (@$list) {
190 0 0         if (defined($_->{ptrdname})) {
191 0           push @res, $_->{ptrdname};
192             }
193             }
194              
195 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
196             }
197              
198 0           return; # Error
199             }
200              
201             sub mx_lookup {
202 0     0 0   my $self = shift;
203 0           my ($host, $nameserver, $port) = @_;
204              
205 0   0       $nameserver ||= $self->nameserver;
206 0   0       $port ||= $self->port || 53;
      0        
207 0 0         $self->brik_help_run_undef_arg('mx_lookup', $host) or return;
208 0 0         my $ref = $self->brik_help_run_invalid_arg('mx_lookup', $host, 'ARRAY', 'SCALAR')
209             or return;
210              
211 0 0         if ($ref eq 'ARRAY') {
212 0           my %res = ();
213 0           for my $this (@$host) {
214 0 0         my $r = $self->mx_lookup($this, $nameserver, $port) or next;
215 0           $res{$this} = $r;
216             }
217              
218 0           return \%res;
219             }
220             else {
221 0 0         my $list = $self->lookup($host, 'MX', $nameserver, $port) or return;
222              
223 0           my @res = ();
224 0           for (@$list) {
225 0 0         if (defined($_->{exchange})) {
226 0           push @res, $_->{exchange};
227             }
228             }
229              
230 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
231             }
232              
233 0           return; # Error
234             }
235              
236             sub ns_lookup {
237 0     0 0   my $self = shift;
238 0           my ($host, $nameserver, $port) = @_;
239              
240 0   0       $nameserver ||= $self->nameserver;
241 0   0       $port ||= $self->port || 53;
      0        
242 0 0         $self->brik_help_run_undef_arg('ns_lookup', $host) or return;
243 0 0         my $ref = $self->brik_help_run_invalid_arg('ns_lookup', $host, 'ARRAY', 'SCALAR')
244             or return;
245              
246 0 0         if ($ref eq 'ARRAY') {
247 0           my %res = ();
248 0           for my $this (@$host) {
249 0 0         my $r = $self->ns_lookup($this, $nameserver, $port) or next;
250 0           $res{$this} = $r;
251             }
252              
253 0           return \%res;
254             }
255             else {
256 0 0         my $list = $self->lookup($host, 'NS', $nameserver, $port) or return;
257              
258 0           my @res = ();
259 0           for (@$list) {
260 0 0         if (defined($_->{nsdname})) {
261 0           push @res, $_->{nsdname};
262             }
263             }
264              
265 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
266             }
267              
268 0           return; # Error
269             }
270              
271             sub soa_lookup {
272 0     0 0   my $self = shift;
273 0           my ($host, $nameserver, $port) = @_;
274              
275 0   0       $nameserver ||= $self->nameserver;
276 0   0       $port ||= $self->port || 53;
      0        
277 0 0         $self->brik_help_run_undef_arg('soa_lookup', $host) or return;
278 0 0         my $ref = $self->brik_help_run_invalid_arg('soa_lookup', $host, 'ARRAY', 'SCALAR')
279             or return;
280              
281 0 0         if ($ref eq 'ARRAY') {
282 0           my %res = ();
283 0           for my $this (@$host) {
284 0 0         my $r = $self->soa_lookup($this, $nameserver, $port) or next;
285 0           $res{$this} = $r;
286             }
287              
288 0           return \%res;
289             }
290             else {
291 0 0         my $list = $self->lookup($host, 'SOA', $nameserver, $port) or return;
292              
293 0           my @res = ();
294 0           for (@$list) {
295 0 0         if (defined($_->{rdatastr})) {
296 0           push @res, $_->{rdatastr};
297             }
298             }
299              
300 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
301             }
302              
303 0           return; # Error
304             }
305              
306             sub txt_lookup {
307 0     0 0   my $self = shift;
308 0           my ($host, $nameserver, $port) = @_;
309              
310 0   0       $nameserver ||= $self->nameserver;
311 0   0       $port ||= $self->port || 53;
      0        
312 0 0         $self->brik_help_run_undef_arg('txt_lookup', $host) or return;
313 0 0         my $ref = $self->brik_help_run_invalid_arg('txt_lookup', $host, 'ARRAY', 'SCALAR')
314             or return;
315              
316 0 0         if ($ref eq 'ARRAY') {
317 0           my %res = ();
318 0           for my $this (@$host) {
319 0 0         my $r = $self->txt_lookup($this, $nameserver, $port) or next;
320 0           $res{$this} = $r;
321             }
322              
323 0           return \%res;
324             }
325             else {
326 0 0         my $list = $self->lookup($host, 'TXT', $nameserver, $port) or return;
327              
328 0           my @res = ();
329 0           for (@$list) {
330 0 0         if (defined($_->{rdatastr})) {
331 0           push @res, $_->{rdatastr};
332             }
333             }
334              
335 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
336             }
337              
338 0           return; # Error
339             }
340              
341             sub srv_lookup {
342 0     0 0   my $self = shift;
343 0           my ($host, $nameserver, $port) = @_;
344              
345 0   0       $nameserver ||= $self->nameserver;
346 0   0       $port ||= $self->port || 53;
      0        
347 0 0         $self->brik_help_run_undef_arg('srv_lookup', $host) or return;
348 0 0         my $ref = $self->brik_help_run_invalid_arg('srv_lookup', $host, 'ARRAY', 'SCALAR')
349             or return;
350              
351 0 0         if ($ref eq 'ARRAY') {
352 0           my %res = ();
353 0           for my $this (@$host) {
354 0 0         my $r = $self->srv_lookup($this, $nameserver, $port) or next;
355 0           $res{$this} = $r;
356             }
357              
358 0           return \%res;
359             }
360             else {
361 0 0         my $list = $self->lookup($host, 'SRV', $nameserver, $port) or return;
362              
363 0           my @res = ();
364 0           for (@$list) {
365 0 0         if (defined($_->{target})) {
366 0           push @res, $_->{target};
367             }
368             }
369              
370 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
371             }
372              
373 0           return; # Error
374             }
375              
376             sub cname_lookup {
377 0     0 0   my $self = shift;
378 0           my ($host, $nameserver, $port) = @_;
379              
380 0   0       $nameserver ||= $self->nameserver;
381 0   0       $port ||= $self->port || 53;
      0        
382 0 0         $self->brik_help_run_undef_arg('cname_lookup', $host) or return;
383 0 0         my $ref = $self->brik_help_run_invalid_arg('cname_lookup', $host, 'ARRAY', 'SCALAR')
384             or return;
385              
386 0 0         if ($ref eq 'ARRAY') {
387 0           my %res = ();
388 0           for my $this (@$host) {
389 0 0         my $r = $self->cname_lookup($this, $nameserver, $port) or next;
390 0           $res{$this} = $r;
391             }
392              
393 0           return \%res;
394             }
395             else {
396 0 0         my $list = $self->lookup($host, 'CNAME', $nameserver, $port) or return;
397              
398 0           my @res = ();
399 0           for (@$list) {
400 0 0         if (defined($_->{cname})) {
401 0           push @res, $_->{cname};
402             }
403             }
404              
405 0 0 0       return $self->return_list ? \@res : ($res[0] || 'undef');
406             }
407              
408 0           return; # Error
409             }
410              
411             1;
412              
413             __END__