File Coverage

blib/lib/NOLookup/DAS/DASLookup.pm
Criterion Covered Total %
statement 51 59 86.4
branch 17 28 60.7
condition 1 3 33.3
subroutine 10 10 100.0
pod 2 2 100.0
total 81 102 79.4


line stmt bran cond sub pod time code
1             package NOLookup::DAS::DASLookup;
2              
3 1     1   786 use strict;
  1         4  
  1         30  
4 1     1   9 use warnings;
  1         2  
  1         27  
5 1     1   528 use IO::Socket;
  1         20031  
  1         5  
6 1     1   963 use Encode;
  1         15591  
  1         82  
7              
8 1     1   7 use vars qw(@ISA @EXPORT_OK);
  1         2  
  1         126  
9             @ISA = qw( Exporter );
10             @EXPORT_OK = qw / $DAS_LOOKUP_ERR_NO_CONN
11              
12             $DAS_LOOKUP_ERR_QUOTA_EXCEEDED
13             $DAS_LOOKUP_ERR_NO_ACCESS
14             $DAS_LOOKUP_ERR_REFERRAL_DENIED
15              
16             $DAS_LOOKUP_ERR_OTHER
17             /;
18              
19             # Error codes returned fom the DASLookup module
20             # Ref. the Norid API definition at
21             # https://www.norid.no/en/registrar/system/dokumentasjon/whoisdas-grensesnitt/
22            
23             # Connection problems
24             our $DAS_LOOKUP_ERR_NO_CONN = 100;
25              
26             # Controlled refuses
27             our $DAS_LOOKUP_ERR_QUOTA_EXCEEDED = 101;
28             our $DAS_LOOKUP_ERR_NO_ACCESS = 102;
29             our $DAS_LOOKUP_ERR_REFERRAL_DENIED = 103;
30              
31             # DB and other problems, all the 'ERROR - xxxx'
32             # See raw_text for details on the problem.
33             our $DAS_LOOKUP_ERR_OTHER = 104;
34              
35 1     1   601 use Data::Dumper;
  1         6686  
  1         71  
36             $Data::Dumper::Indent=1;
37              
38 1     1   9 use vars qw/$AUTOLOAD/;
  1         2  
  1         585  
39              
40             sub AUTOLOAD {
41 26     26   4199 my $self=shift;
42 26         230 $AUTOLOAD =~ s/.*:://;
43            
44 26 50       107 if (@_) {
45             # set operation
46 0         0 return $self->{$AUTOLOAD} = shift;
47             } else {
48             # get operation
49 26         401 return $self->{$AUTOLOAD};
50             }
51             }
52              
53             sub new {
54 4     4 1 619 my ($proto, $query, $das_server, $das_port, $client_ip)=@_;
55 4   33     47 my $class=ref $proto||$proto;
56 4         20 my $self=bless {},$class;
57              
58             # $query is required for something to happen
59 4 50       17 return $self unless $query;
60              
61             # defaults
62 4 50       16 $das_server = 'finger.norid.no' unless ($das_server);
63 4 50       15 $das_port = 79 unless ($das_port);
64              
65 4         25 return $self->lookup($query, $das_server, $das_port, $client_ip);
66             }
67              
68             sub lookup {
69 4     4 1 32 my ($self, $query, $das_server, $das_port, $client_ip) = @_;
70              
71 4         10 my ($line, $text);
72              
73 4         53 my $sock = IO::Socket::INET->new (
74             PeerAddr => $das_server,
75             PeerPort => $das_port,
76             Proto => 'tcp',
77             Timeout => 10,
78             );
79              
80 4 50       497252 unless($sock) {
81 0         0 $self->{errno} = $DAS_LOOKUP_ERR_NO_CONN;
82             #print STDERR "SOCK ERR: $!\n";
83 0         0 return $self;
84             }
85              
86 4         98 $query = Encode::encode('UTF-8', $query);
87              
88             # Always code query as utf-8
89 4 50       598 if ($client_ip) {
90             # Use the special -V option to identify the client IP
91             # for proper rate limiting purposes.
92             # Note that the ip address must be registered by Norid
93             # to work properly, if not, a referral error is returned.
94 0         0 print $sock "-V v0,$client_ip -c utf-8 $query\n";
95             } else {
96 4         608 print $sock "-c utf-8 $query\n";
97             }
98            
99             # Read all answer lines into one long LF separated $text
100 4         157468 while ($line = <$sock>) {
101 4         186 $text .= $line;
102             }
103 4         468 close $sock;
104 4         40 chomp $text;
105            
106 4         96 $text = Encode::decode('UTF-8', $text);
107              
108             # Parse DAS response and map values into object methods.
109 4         429 $self->{raw_text} = $text;
110              
111             # Detect any of the error situations
112 4 50       135 if ($text =~ m/Quota exceeded/) {
    50          
    50          
    100          
    50          
    100          
    100          
    50          
113 0         0 $self->{errno} = $DAS_LOOKUP_ERR_QUOTA_EXCEEDED;
114              
115             } elsif ($text =~ m/Access denied/) {
116 0         0 $self->{errno} = $DAS_LOOKUP_ERR_NO_ACCESS;
117            
118             } elsif ($text =~ m/Referral denied/) {
119 0         0 $self->{errno} = $DAS_LOOKUP_ERR_REFERRAL_DENIED;
120              
121             } elsif ($text =~ m/ERROR - /) {
122 1         7 $self->{errno} = $DAS_LOOKUP_ERR_OTHER;
123              
124             } elsif ($text =~ m/ is available /) {
125 0         0 $self->{available} = 1;
126              
127             } elsif ($text =~ m/ is delegated /) {
128 1         6 $self->{delegated} = 1;
129              
130             } elsif ($text =~ m/This domain can currently not be registered/) {
131 1         8 $self->{prohibited} = 1;
132              
133             } elsif ($text =~ m/Domain is not valid /) {
134 1         7 $self->{invalid} = 1;
135             }
136              
137             #print STDERR "\n\n====\nDAS self after $query: ", Dumper $self;
138 4         213 return $self;
139             }
140              
141             =pod
142              
143             =encoding ISO-8859-1
144              
145             =head1 NAME
146              
147             NOLookup::DAS::DASLookup - Lookup DAS data from Norid.
148              
149             =head1 SYNOPSIS
150              
151             my $das = NOLookup::DAS::DASLookup->new('norid.no');
152              
153             One of the below accessor methods will return something:
154            
155             $das->errno() Set to an error code if some error has occured.
156             $das->available() True if domain is available, thus registration can be attempted.
157             $das->delegated() True if domain is delegated, and thus not available.
158             $das->prohibited() True if domain is prohibited by policy, and thus not allowed.
159             $das->invalid() True if domain or zone is invalid, like a .com domain,
160             or if the zone is not administered by Norid, like
161             some 'test.mil.no' domain.
162             $das->raw_text() Contains the raw DAS response.
163              
164             =head1 DESCRIPTION
165              
166             This module provides an object oriented API for use with the
167             Norid DAS service. It uses the command line based DAS interface
168             internally to fetch information from Norid.
169              
170             =head2 METHODS
171              
172             =over 5
173              
174             =item new
175              
176             The constructor. Takes a lookup argument. Returns a new object.
177              
178             =item lookup
179              
180             Do a DAS lookup in the Norid database and populate the object
181             from the result.
182              
183              
184             =item AUTOLOAD
185              
186             This module uses the autoload mechanism to provide accessors for any
187             available data through the get mechanism above.
188              
189             =item errno, available, delegated, prohibited, invalid
190              
191             See SYNOPSIS.
192              
193             =back
194              
195             =head1 SEE ALSO
196              
197             L<http://www.norid.no/en>
198             L<https://www.norid.no/en/registrar/system/tjenester/whois-das-service>
199              
200             =head1 AUTHOR
201              
202             Trond Haugen, E<lt>(nospam)info(at)norid.noE<gt>
203              
204             =head1 COPYRIGHT
205              
206             Copyright (c) 2017 Trond Haugen <(nospam)info(at)norid.no>.
207             All rights reserved.
208              
209             This program is free software; you can redistribute it and/or modify
210             it under the terms of the GNU General Public License as published by
211             the Free Software Foundation; either version 2 of the License, or
212             (at your option) any later version.
213              
214             =head1 LICENSE
215              
216             This library is free software. You can redistribute it and/or modify
217             it under the same terms as Perl itself.
218              
219             =cut
220              
221             1;