File Coverage

blib/lib/Metabrik/Network/Whois.pm
Criterion Covered Total %
statement 9 36 25.0
branch 0 20 0.0
condition 0 14 0.0
subroutine 3 6 50.0
pod 1 3 33.3
total 13 79 16.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::whois Brik
5             #
6             package Metabrik::Network::Whois;
7 1     1   723 use strict;
  1         2  
  1         30  
8 1     1   6 use warnings;
  1         3  
  1         27  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         675  
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             attributes => {
19             datadir => [ qw(datadir) ],
20             rtimeout => [ qw(timeout) ],
21             last_server => [ qw(server) ],
22             src_ip => [ qw(ip_list) ],
23             },
24             attributes_default => {
25             rtimeout => 2,
26             },
27             commands => {
28             target => [ qw(domain|ip_address) ],
29             queried_server => [ ],
30             },
31             require_modules => {
32             'Net::Whois::Raw' => [ ],
33             'Metabrik::String::Parse' => [ ],
34             },
35             };
36             }
37              
38             sub target {
39 0     0 0   my $self = shift;
40 0           my ($target) = @_;
41              
42 0 0         $self->brik_help_run_undef_arg('target', $target) or return;
43              
44 0           $Net::Whois::Raw::TIMEOUT = $self->rtimeout;
45 0           $Net::Whois::Raw::CACHE_DIR = $self->datadir.'/cache';
46              
47             # Whois server custo
48             #$Net::Whois::Raw::Data::servers{TLD} = SRV;
49              
50 0           my $info;
51             my $server;
52 0           eval {
53 0 0         ($info, $server) = Net::Whois::Raw::whois($target)
54             or return $self->log->error("target: whois for target [$target] failed");
55             };
56 0 0         if ($@) {
57 0           chomp($@);
58 0 0         if ($@ =~ /(Connection timeout to \S+)/) {
    0          
    0          
59 0           $@ = $1;
60             }
61             elsif ($@ =~ /(\S+): Invalid argument: /) {
62 0           $@ = "Invalid server $1";
63             }
64             elsif ($@ =~ /(\S+): Connection refused: /) {
65 0           $@ = "Connection refused to $1";
66             }
67              
68 0           return $self->log->error("target: failed target [$target]: [$@]");
69             }
70              
71 0 0         if (! defined($info)) {
72 0           return $self->log->error("target: whois returned nothing");
73             }
74              
75 0 0         my $sp = Metabrik::String::Parse->new_from_brik_init($self) or return;
76 0 0         my $lines = $sp->to_array($info) or return;
77              
78 0           for (@$lines) {
79 0 0 0       if (/Whois Requests exceeded the allowed limit/i
      0        
      0        
      0        
80             || /Your request cannot be completed at this time due to query limit controls/i
81             || /Maximum Daily connection limit reached. Lookup refused/i
82             || /database is contained within a list of IP addresses that may have failed/i
83             || /Connection refused: exceeded maximum connection limit from /i
84             ) {
85 0           return $self->log->error("target: failed target [limit exceeded]");
86             }
87             }
88              
89 0           $self->last_server($server);
90              
91 0           return $lines;
92             }
93              
94             sub queried_server {
95 0     0 0   my $self = shift;
96              
97 0   0       return $self->last_server || 'undef';
98             }
99              
100             1;
101              
102             __END__