File Coverage

blib/lib/NOLookup/RDAP/RDAPLookup.pm
Criterion Covered Total %
statement 113 396 28.5
branch 30 206 14.5
condition 2 27 7.4
subroutine 23 31 74.1
pod 8 8 100.0
total 176 668 26.3


line stmt bran cond sub pod time code
1             package NOLookup::RDAP::RDAPLookup;
2              
3 1     1   96834 use warnings;
  1         10  
  1         27  
4 1     1   5 use strict;
  1         1  
  1         19  
5 1     1   3 use POSIX qw(locale_h);
  1         2  
  1         6  
6 1     1   1875 use URI::Encode qw(uri_encode);
  1         1141  
  1         46  
7 1     1   478 use URI;
  1         5887  
  1         28  
8 1     1   634 use JSON;
  1         8501  
  1         6  
9 1     1   118 use base qw(Class::Accessor::Chained); ## Provides a new() method
  1         2  
  1         393  
10 1     1   2508 use Net::DNS::Domain;
  1         4895  
  1         30  
11 1     1   579 use Net::IP;
  1         47549  
  1         145  
12 1     1   586 use List::MoreUtils qw(any);
  1         10839  
  1         6  
13 1     1   1362 use Text::Wrap;
  1         2231  
  1         48  
14 1     1   6 use base qw(Net::RDAP);
  1         2  
  1         461  
15 1     1   693399 use Net::RDAP::EPPStatusMap;
  1         329  
  1         52  
16 1     1   6 use Net::RDAP::Error;
  1         3  
  1         17  
17 1     1   379 use NOLookup;
  1         2  
  1         24  
18             # debug only for dev env.
19             #use LWP::ConsoleLogger::Easy qw /debug_ua /;
20 1     1   445 use Sys::HostIP;
  1         1492  
  1         43  
21 1     1   449 use Data::Validate::IP qw(is_ip);
  1         32822  
  1         79  
22              
23 1     1   665 use Data::Dumper;
  1         5325  
  1         71  
24             $Data::Dumper::Indent=1;
25              
26             our $VERSION = $NOLookup::VERSION;
27              
28 1     1   20 use vars qw(@ISA @EXPORT_OK);
  1         2  
  1         3897  
29              
30             @ISA = qw( Exporter Class::Accessor::Chained Net::RDAP);
31             @EXPORT_OK = qw / $RDAP_LOOKUP_ERR_NO_CONN
32              
33             $RDAP_LOOKUP_ERR_QUOTA_EXCEEDED
34             $RDAP_LOOKUP_ERR_NO_ACCESS
35             $RDAP_LOOKUP_ERR_REFERRAL_DENIED
36             $RDAP_LOOKUP_ERR_OTHER
37             $RDAP_LOOKUP_ERR_NO_MATCH
38             $RDAP_LOOKUP_ERR_NO_CONFORMANCE
39             $RDAP_LOOKUP_ERR_INVALID
40             /;
41              
42             # Connection problems
43             our $RDAP_LOOKUP_ERR_NO_CONN = 100;
44              
45             # Controlled refuses
46             our $RDAP_LOOKUP_ERR_QUOTA_EXCEEDED = 101;
47             our $RDAP_LOOKUP_ERR_NO_ACCESS = 102;
48             our $RDAP_LOOKUP_ERR_REFERRAL_DENIED = 103;
49             our $RDAP_LOOKUP_ERR_OTHER = 104;
50             our $RDAP_LOOKUP_ERR_NO_MATCH = 105;
51             our $RDAP_LOOKUP_ERR_NO_CONFORMANCE = 106;
52             our $RDAP_LOOKUP_ERR_INVALID = 107;
53              
54             my $RDAP_TIMEOUT = 60; # secs (default is 180 secs but we want shorter time).
55              
56             # Default API service URL
57             my $SERVICE_URL = "https://rdap.norid.no";
58              
59             ############
60             #
61             # RDAP API. See section 'About the Norid RDAP API' below for more info.
62             #
63              
64             my %rdap_head_get_method_args = (
65             DBDN => 'domain/',
66             EBEH => 'entity/',
67             NBNH => 'nameserver_handle/'
68             );
69              
70             # Not used RBRH => 'registrar/', same as EBEH => 'entity/'
71              
72             my %rdap_get_method_args = (
73             NBNN => 'nameservers?name=',
74             DBID => 'domains?identity=',
75             DBRH => 'domains?registrant=',
76             EBID => 'entities?identity='
77             );
78              
79             my $ht;
80              
81             ##
82             # RDAP API conformance values.
83             # This library supports and expects the following conformance values.
84             # if other values are returned, the library _may_ need an upgrade, so the
85             # lookup will simply fail if any conformance mismatch is detected.
86             #
87              
88             my %rdapConformance_vals_supported = (
89             'rdap_level_0' => 1,
90             'rdap_objectTag_level_0' => 1,
91             'norid_level_0' => 1
92             );
93              
94             # Some accessor methods.
95             # Those starting with '_' are meant for internal use.
96             my @methods = qw /
97              
98             warning
99             error
100             status
101              
102             result
103             raw_json_decoded
104              
105             _method
106             _uri
107             _full_url
108              
109             /;
110              
111             __PACKAGE__->mk_accessors(
112             @methods
113             );
114              
115             # Set an env var to suppress warnings from Net::RDAP
116             unless ($ENV{'NET_RDAP_UA_DEBUG'}) {
117             $ENV{'NET_RDAP_UA_DEBUG'} = 0;
118             }
119              
120             =head2 new
121              
122             new handles the following parameters:
123              
124             {
125             debug => <0|1|5>,
126             use_cache => <0|1>,
127             service_url => <0|service_url,
128             norid_header_secret => <0|test_secret>,
129             norid_header_proxy => <0|1>,
130             norid_referral_ip => <0|1|ip-address>,
131             }
132              
133             All parameters are optional:
134              
135             * use_cache:
136             - 1: activate lookup cache, see Net::RDAP for use
137              
138             * debug:
139             - 0: debug off
140             - 1: debug from this module on
141             - 5: full debug from Net::RDAP on, see Net::RDAP for use
142              
143             * service_url:
144             - the full http(s)-address of the Norid RDAP-servie to
145             be accessed.
146             - default is $SERVICE_URL above.
147              
148             * norid_header_secret:
149             - access token for layered access, and
150             the token is sent in the 'X-RDAP-Secret' header.
151              
152             * norid_header_proxy :
153             - Norid internal use only.
154             - true if the calling client can act as a proxy,
155             and the header 'X-RDAP-Web-Proxy' is then set to 1.
156              
157             * norid_referral_ip :
158             - Norid internal use only.
159             - set if the calling client ip address argument shall be sent. When set:
160             - if the argument passed is a pure integer, use the local ip-address as value.
161             - if the argument passed is a valid ip address, use that address
162             as value. This is the normal variant to be used to pass a proper client
163             ip address.
164             - the ip-address is passed to the server in the '?client_ip=<ip-address>'
165             argument.
166              
167             =cut
168              
169             sub new {
170 4     4 1 5855 my ($self, $args)=@_;
171              
172             # defaults
173 4 50       13 $args->{service_url} = $SERVICE_URL unless ($args->{service_url});
174              
175 4 50 33     14 if ($args->{norid_referral_ip} && $args->{norid_referral_ip} =~ m/^\d+$/) {
176             # Set to true (a pure number) - then select a local ip-address
177 0         0 delete($args->{norid_referral_ip});
178 0         0 my $ip = get_my_ip_address();
179 0 0       0 $args->{norid_referral_ip} = $ip if ($ip);
180             }
181              
182 4         22 $self->SUPER::new($args);
183              
184             }
185              
186             =head2 lookup
187              
188             Do an RDAP lookup.
189              
190             - $query : specifies the query string
191             - $check : specifies if http 'head' shall be done, default is 'get'.
192             - $nameservers: must be set to true for nameserver_name search
193             - $entity : must be set to true for entity lookup, in which case the query should
194             identify an entity, like:
195             - a domain name
196             - a handle, like registrar handle, registrant handle, ns handle or contact handle
197             must be set to false to trig a search if the query
198             contains something that allows a search, like:
199             - identity (organization number, N.PRI.xxx etc)
200             - a registrant handle (P- or O- handle)
201             - a nameserver name (must then be combined with
202             $nameservers=1 to distinguish from a domain name)
203              
204             =cut
205              
206             sub lookup {
207 4     4 1 1564 my ($self, $query, $check, $nameservers, $entity ) = @_;
208              
209             #print STDERR "RDAPLookup: lookup on query: $query, check: ", $check || 0, ", nameservers: ", $nameservers || 0, ", entity: ", $entity || 0, "\n";
210              
211 4 50       21 unless ($self->_validate_and_analyze($query, $check, $nameservers, $entity)) {
212             # errno has already been set
213 0         0 return $self;
214             }
215             # _method (head or get) and args are set in $self
216 4         14 $self->_lookup_rdap($query, $self->_method, $self->_uri);
217            
218             }
219              
220             =head2 _lookup_rdap
221              
222             Do an RDAP HEAD or GET lookup.
223              
224             - $http_type: 'head' or 'get'
225             - $uri : full arguments to base URI, identifying the actual lookup
226             method and args
227             - other args as passed in $self.
228              
229             =cut
230              
231             sub _lookup_rdap {
232 4     4   79 my ($self, $query, $http_type, $uri ) = @_;
233              
234 4         26 my $ua = $self->ua;
235              
236             # debug only for dev env.
237             # if ($self->{debug} && $self->{debug} > 1) {
238             # debug_ua ( $ua, 5 );
239             # }
240              
241 4         3972 $ua->default_header( Charset => "UTF-8");
242 4         227 $ua->default_header( 'Content-Type' => "application/rdap+json");
243              
244 4 50       167 if ($self->{norid_header_secret}) {
245             # Use Norid RDAP layer secret headers
246 0         0 $ua->default_header( 'X-RDAP-Secret' => $self->{norid_header_secret});
247             }
248              
249 4 50       13 if ($self->{norid_header_proxy}) {
250             # Use Norid RDAP proxy headers
251 0         0 $ua->default_header( 'X-RDAP-Web-Proxy' => 1);
252             }
253              
254 4         19 my $URL = $self->{service_url} . "/$uri";
255              
256 4 50       12 if ($self->{norid_referral_ip}) {
257 0         0 my $a = '?';
258 0 0       0 if ($URL =~ m/\?/) {
259             # args already exists, use '&' for extra arg
260 0         0 $a = '&';
261             }
262 0         0 $URL .= $a ."client_ip=" . $self->{norid_referral_ip};
263             }
264            
265 4         18 $self->_full_url($URL);
266              
267 4 50       58 if ($self->{debug}) {
268 0         0 print STDERR "_lookup-rdap called with URL: '$URL', and:\n";
269 0 0       0 print STDERR " proxy is : ", $self->{norid_header_proxy} , "\n" if ($self->{norid_header_proxy});
270 0 0       0 print STDERR " secret is : ", $self->{norid_header_secret}, "\n" if ($self->{norid_header_secret});
271 0 0       0 print STDERR " referral_ip: ", $self->{norid_referral_ip} , "\n" if ($self->{norid_referral_ip});
272             }
273              
274 4         6 my $resp;
275            
276 4 100       13 if ($http_type eq 'head') {
277             # An RDAP HEAD operation. Head is not supported by Net::RDAP,
278             # so call it via the already created UA
279 2         12 $resp = $ua->head($URL);
280 2 50       557138 unless ($resp->is_success) {
281 0         0 $self->error(_map_rdap_error($query, $resp->code));
282 0         0 $self->status($resp->status_line);
283             }
284 2         75 return $self;
285             }
286              
287             # An RDAP GET operation.
288 2         14 $resp = $self->fetch(URI->new($URL));
289              
290 2 50       776845 unless ($resp) {
291             #print STDERR "Empty GET resp\n";
292 0         0 $self->error( _map_rdap_error($query, 404) );
293 0         0 $self->status("Lookup returned nothing!");
294 0         0 return $self;
295             }
296 2 50       22 if ($resp->isa('NOLookup::RDAP::RDAPLookup')) {
297             # a $resp is returned, but when fetch() finds nothing, it
298             # just returs the $self-object, possible with an error[] filled in,
299             # so handle it as nothing found
300              
301             #print STDERR "Nothing found returned 'NOLookup::RDAP::RDAPLookup' self resp\n";
302            
303 0         0 my $err = $resp->error;
304 0 0       0 if (ref($err) eq 'ARRAY') {
305 0         0 my $ix = 0;
306 0         0 foreach my $el (@$err) {
307 0 0       0 if ($el eq 'errorCode') {
    0          
308 0         0 $self->error( _map_rdap_error($query, $err->[$ix+1]) );
309             #print STDERR " ARRAY error:", $self->error, "\n";
310              
311             } elsif ($el eq 'title') {
312 0         0 $self->status($err->[$ix+1]);
313             }
314 0         0 ++$ix;
315             }
316             } else {
317 0         0 $self->error(_map_rdap_error($query, $err));
318             #print STDERR " scalar error:", $self->error, "\n";
319 0         0 $self->status("Lookup rejected or returned no match!");
320             }
321             #print STDERR " RDAPLookup.pm: lookup_error on URL: $URL, error: ", $self->error, "\n";
322 0         0 return $self;
323             }
324              
325 2 50       17 if ($resp->isa('Net::RDAP::Error')) {
326             #print STDERR "Error GET resp\n";
327 0         0 $self->error(_map_rdap_error($query,$resp->errorCode));
328 0         0 $self->status($resp->title);
329 0         0 return $self;
330             }
331              
332             # Check conformance values before we accept the answer
333 2         5 my @cf = @{$resp->{rdapConformance}};
  2         8  
334 2         6 foreach my $cfe (@cf) {
335 6 50       18 unless ($rdapConformance_vals_supported{$cfe}) {
336 0         0 $self->status("Conformance mismatch on key $cfe, this library does not support this RDAP version!");
337 0         0 $self->error($RDAP_LOOKUP_ERR_NO_CONFORMANCE);
338 0         0 return $self;
339             }
340             }
341              
342             # resp contains the json data
343 2         5 $self->raw_json_decoded(to_json({%{$resp}}, {utf8 => 1, pretty => 1}));
  2         145  
344              
345 2         250 $self->result($resp);
346            
347 2         31 return $self;
348             }
349              
350             =head2 _map_rdap_error
351              
352             Some RDAP error is returned from Net::RDAP, ref. Net::RDAP::Error.
353              
354             Those are normally HTTP response errors in the 400 and 500 range,
355             which are mapped to one of the $RDAP_LOOKUP_ERR_XXX local errors.
356              
357             https://developer.mozilla.org/en-US/docs/Web/HTTP/Status
358             - All 1xx are not errors, but Ok, need not be handled.
359             - All 2xx are not errors, but Ok, need not be handled.
360             - All 3xx are redirection errors, which are not expected,
361             map to other if we get it.
362             - All 3xx are redirection errors, which are not expected,
363             map to other if we get it.
364            
365             All 5xx errors are considered connection problems at some level
366              
367             =cut
368              
369             sub _map_rdap_error {
370 0     0   0 my ($query, $rdap_error) = @_;
371              
372 0         0 my $rcode;
373 0 0       0 if ($rdap_error =~ m/^4\d+$/) {
    0          
374             # Some client side problem
375 0 0       0 if ($rdap_error == 404) {
    0          
376 0         0 $rcode = $RDAP_LOOKUP_ERR_NO_MATCH;
377             } elsif ($rdap_error == 429) {
378 0         0 $rcode = $RDAP_LOOKUP_ERR_QUOTA_EXCEEDED;
379             } else {
380 0         0 $rcode = $RDAP_LOOKUP_ERR_INVALID;
381             }
382              
383             } elsif ($rdap_error =~ m/^5\d+$/) {
384             # Some some server side problems
385 0 0       0 if ($rdap_error == 501) {
386 0         0 $rcode = $RDAP_LOOKUP_ERR_INVALID;
387             } else {
388 0         0 $rcode = $RDAP_LOOKUP_ERR_NO_CONN;
389             }
390              
391             } else {
392 0         0 $rcode = $RDAP_LOOKUP_ERR_OTHER;
393             # report other case in case the code can be mapped to a better value
394 0         0 print STDERR "_map_rdap_error - some other error code: '$rdap_error' was returned for query: $query\n";
395             }
396              
397 0         0 return $rcode;
398              
399             }
400              
401             =head2 get_my_ip_address
402              
403             Find local ip-address.
404              
405             (Note: Sys::HostAddr were also tried for this purpose, but could die at
406             random, so Sys::HostIP is selected. Only ipv4 seems to be processed by
407             Sys::HostIP, so the selection is limited to ipv4.
408             TODO: Consider using another module, which also supports v6).
409              
410             Best guess IP seems to be the one on the en0-interface, but when a VPN
411             is in use, you might want that address to be selected. So, try to do
412             the best ip selection by ourselves by a reverse sort instead of a
413             sort, thus selecting the 'highest' numbered and public ip-address).
414              
415             Return localhost if no other ip is found.
416              
417             Return empty if localhost iface not found.
418              
419             =cut
420              
421             sub get_my_ip_address {
422              
423 0     0 1 0 my $hostip = Sys::HostIP->new;
424            
425 0         0 my $if_info = $hostip->if_info;
426 0         0 my $lo_found;
427 0         0 foreach my $key ( reverse sort keys %{$if_info} ) {
  0         0  
428             # we don't want the loopback
429 0 0       0 if ( $if_info->{$key} eq '127.0.0.1' ) {
430 0         0 $lo_found++;
431 0         0 next;
432             }
433             # now we return the first one that comes up
434 0         0 return ( $if_info->{$key} );
435             }
436            
437             # we get here if loopback is the only active device
438 0 0       0 $lo_found and return '127.0.0.1';
439            
440 0         0 return '';
441              
442             }
443              
444             =head2 _validate_and_analyze
445              
446             1) Validate ip address, if set
447            
448             2) Validate query, return if query not among the expexted ones.
449             - domain name or name server name
450             - some object handle (D, P, R, H)
451             - some registrar handle (regXXX-NORID)
452             - some identity (9 digits orgno, N.XXX.yyyyyyyy)
453              
454             2) Analyze query and args and find what http method and uri arguments
455             to use for the lookup and set them in '_method' and '_uri'
456              
457             =cut
458              
459             sub _validate_and_analyze {
460 4     4   14 my ($self, $q, $check, $ns, $entity) = @_;
461              
462 4 50       23 if (my $ip = $self->{norid_referral_ip}) {
463 0 0       0 unless (is_ip($ip)) {
464 0         0 $self->status("Invalid referral ip address: $ip");
465 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
466 0         0 return 0;
467             }
468             }
469            
470 4         8 my $arg;
471            
472 4 50       25 $q =~ s/\s+//g if ($q);
473              
474 4 50       16 unless ($q) {
475 0         0 $self->status("mandatory query parameter not specified");
476 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
477 0         0 return 0;
478             }
479              
480 4 50       104 if ($q =~ m/^\d{9}$/) {
    50          
    50          
    50          
    50          
481             # org number OK
482 0 0       0 if ($q eq "000000000") {
    0          
483 0         0 $self->status("Invalid ID: $q");
484 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
485 0         0 return 0;
486              
487             } elsif ($q !~ m/^[8|9]\d{8}/) {
488 0         0 $self->status("Invalid ID, org.number must start on 8 or 9: $q");
489 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
490 0         0 return 0;
491             }
492             # Search domains by identity to get list of domain names for that orgno
493 0         0 $arg = 'DBID';
494 0 0       0 if ($entity) {
495             # search entities by identity to get list of handles with that orgno
496 0         0 $arg = 'EBID';
497             }
498              
499             } elsif ($q =~ /^N\.(PRI|LEG|ORG|REG)\.\d+$/i) {
500 0         0 $q = uc($q);
501              
502             # Some other identity
503             # domains by identity is default
504 0         0 $arg = 'DBID';
505 0 0       0 if ($entity) {
506             # entities by identity
507 0         0 $arg = 'EBID';
508             }
509              
510             } elsif ($q =~ /REG(\d+)-NORID$/i) {
511             # registrar handle lookup
512             # is case sensitive, syntax: 'reg2-NORID'
513 0         0 $q = "reg$1-NORID";
514              
515             # registrar by reg handle RBRH, same as EBEH, so use that
516 0         0 $arg = 'EBEH';
517            
518             } elsif ($q =~ /.+([PORH])-NORID$/i) {
519             # P, O, R or H handle
520             # Note D-handle lookup is not supported by the rdap, use the domain name instead
521 0         0 $q = uc($q);
522              
523 0         0 my $ot = uc($1);
524            
525 0 0 0     0 if ($ot eq 'P' || $ot eq 'O') {
    0          
526             # is a registrant handle
527              
528             # domains by registrant handle is default
529 0         0 $arg = 'DBRH';
530 0 0       0 if ($entity) {
531             # entities by entity handle
532 0         0 $arg = 'EBEH';
533             }
534              
535             } elsif ($ot eq 'H') {
536             # is a name server handle
537              
538             # nameserver_handle by nameserver handle is default
539 0         0 $arg = 'NBNH';
540 0 0       0 if ($entity) {
541             # entity by entity handle not possible here
542             #$arg = 'EBEH';
543             }
544              
545             } else {
546             # is a D or R, only option is lookup entity by entity handle
547 0         0 $arg = 'EBEH';
548             }
549            
550             } elsif ($q =~ /.+\..+$|^\.(no.*)$/i) {
551              
552             # Some string with a dot in it is assumed to be a domain name or name server
553             # name, or just 'no' itself
554 4         17 $q = lc($q);
555              
556             # TODO: if $1, we have no alone to be looked up, maybe RDAP
557             # will need only one syntax, like 'no.' for the name,
558             # adjust $q to comply to the rule if it comes.
559 4 50       17 if ($1) {
560             #print "STDERR: a single no domain lookup requested, q: $q\n";
561             # adjust $q here:
562             }
563            
564             # domain by domain name is default
565 4         13 $arg = 'DBDN';
566 4 50       13 if ($ns) {
567             # nameservers by name server name (NBNN)
568 0         0 $arg = 'NBNN';
569             }
570            
571             } else {
572 0         0 $self->status("Invalid query, not supported by the RDAP service: $q");
573 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
574 0         0 return 0;
575             }
576              
577 4 50       14 unless ($arg) {
578 0         0 $self->status("No success in finding a lookup method, try a valid query combination: $q");
579 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
580 0         0 return 0;
581             }
582              
583 4 50       14 unless ($arg) {
584 0         0 $self->status("No success in finding a lookup method, try a valid query combination: $q");
585 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
586 0         0 return 0;
587             }
588              
589 4 100       11 if ($check) {
590 2 50       8 unless ($rdap_head_get_method_args{$arg}) {
591 0         0 $self->status("No success in finding a HEAD lookup method for $arg, try a valid query combination: $q");
592 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
593 0         0 return 0;
594             }
595 2         11 $self->_method('head');
596 2         43 $self->_uri($rdap_head_get_method_args{$arg} . $q);
597              
598             } else {
599 2 0 33     9 unless ($rdap_head_get_method_args{$arg} || $rdap_get_method_args{$arg}) {
600 0         0 $self->status("No success in finding a GET lookup method for $arg, try a valid query combination: $q");
601 0         0 $self->error($RDAP_LOOKUP_ERR_INVALID);
602 0         0 return 0;
603             }
604              
605 2         11 $self->_method('get');
606              
607 2 50       39 if ($rdap_head_get_method_args{$arg}) {
608 2         12 $self->_uri($rdap_head_get_method_args{$arg} . $q);
609             } else {
610 0         0 $self->_uri($rdap_get_method_args{$arg} . $q);
611             }
612             }
613             # remember the query
614 4         54 $self->{query} = $q;
615              
616 4         16 return 1;
617             }
618              
619             =head2 result_as_rdap_string
620              
621             Return sensible rdap formatted string.
622             Uses internal helper formatting functions.
623              
624             Shows how to access data returned by Net::RDAP.
625              
626             =cut
627              
628             sub result_as_rdap_string {
629 0     0 1   my ($self, $check, $nameservers, $entity, $short, $expand) = @_;
630              
631 0           my @errors;
632              
633 0           my $response = $self->result;
634              
635 0           my $rs = "";
636            
637 0 0         if ($response->isa('Net::RDAP::Error')) {
    0          
638 0           push(@errors, sprintf("%03u (%s)", $response->errorCode, $response->title));
639            
640             } elsif ($response->isa('Net::RDAP::SearchResult')) {
641              
642 0           foreach my $o ($response->nameservers, $response->domains, $response->entities) {
643 0           my ($rst, $errs) = $self->rdap_obj_as_string($o, $check, $nameservers, $entity, $short, $expand);
644 0 0         $rs .= $rst if ($rst);
645 0 0 0       push @errors, @$errs if ($errs && @$errs);
646              
647             }
648              
649             } else {
650              
651 0           my ($rst, $errs) = $self->rdap_obj_as_string($response, $check, $nameservers, $entity, $short, $expand);
652 0 0         $rs .= $rst if ($rst);
653 0 0 0       push @errors, @$errs if ($errs && @$errs);
654             }
655              
656 0           return $rs, \@errors;
657              
658             }
659              
660             =head2 rdap_obj_as_string
661              
662             Return sensible rdap formatted string.
663              
664             Code stolen from rdapper and adapted.
665              
666             =cut
667              
668             sub rdap_obj_as_string {
669 0     0 1   my ($self, $response, $check, $nameservers, $entity, $short, $expand) = @_;
670              
671 0           my @errors;
672 0           my $rs = "";
673            
674 0 0         if ('entity' ne $response->class) {
675              
676 0           my ($name, $xname) = $self->rdap_get_obj_name($response);
677              
678 0 0         if ($xname ne $name) {
679 0           $rs .= sprintf("\nName: %s (%s)\n\n", $xname, $name);
680             } else {
681 0           $rs .= sprintf("\nName: %s\n\n", $name);
682             }
683             }
684              
685 0           $rs .= sprintf("Handle: %s\n\n", $response->handle);
686              
687 0 0         if ('ip network' eq $response->class) {
    0          
    0          
    0          
    0          
688 0           $rs .= sprintf("Range: %s\n\n", $response->range->prefix);
689 0           $rs .= sprintf("Domain: %s\n\n", $response->domain->as_string);
690            
691             } elsif ('autnum' eq $response->class) {
692 0 0 0       $rs .= sprintf("Range: %u - %u\n\n", $response->start, $response->end) if ($response->start > 0 && $response->end > 0);
693 0 0         $rs .= sprintf("Type: %s\n\n", $response->type) if ($response->type);
694            
695             } elsif ('domain' eq $response->class) {
696 0           my @ns = $response->nameservers;
697 0 0         if (scalar(@ns) > 0) {
698 0           $rs .= "Nameservers:\n\n";
699 0           foreach my $ns (sort { lc($a->name->name) cmp lc($b->name->name) } @ns) {
  0            
700 0           $rs .= sprintf(" %s\n", $ns->name->name);
701             }
702 0           $rs .= "\n";
703             }
704            
705 0           my @ds = $response->ds;
706 0 0         if (scalar(@ds) > 0) {
707 0           $rs .= "DNSSEC:\n\n";
708 0           foreach my $ds ($response->ds) {
709 0           $rs .= sprintf(" %s. IN DS %u %u %u %s\n", uc($ds->name),
710             $ds->keytag, $ds->algorithm, $ds->digtype, uc($ds->digest));
711             }
712 0           $rs .= "\n";
713             }
714            
715 0           my @keys = $response->keys;
716 0 0         if (scalar(@keys) > 0) {
717 0           $rs .= "DNSSEC Keys:\n\n";
718 0           foreach my $key (@keys) {
719 0           $rs .= sprintf(" %s. IN DNSKEY %u %u %u %s\n", uc($key->name), $key->flags, $key->protocol, $key->algorithm, uc($key->key));
720             }
721 0           $rs .= "\n";
722             }
723            
724             } elsif ('entity' eq $response->class) {
725 0           $rs .= $self->rdap_vcard_as_string($response->vcard, ' ' x 2);
726            
727             } elsif ('nameserver' eq $response->class) {
728 0           $rs .= "IP Addresses:\n\n";
729            
730 0           my @addrs = $response->addresses;
731 0 0         if (scalar(@addrs) > 0) {
732 0           foreach my $ip (@addrs) {
733 0           $rs .= sprintf(" * %s\n", $ip->ip);
734             }
735             } else {
736 0           $rs .= " * (no IP addresses returned)\n";
737             }
738 0           $rs .= "\n";
739             }
740            
741 0           my @events = $response->events;
742 0 0         if (scalar(@events)) {
743 0           $rs .= "Events:\n\n";
744 0           foreach my $event (@events) {
745 0           $rs .= sprintf(" %s: %s\n", ucfirst($event->action), scalar($event->date));
746             }
747 0           $rs .= "\n";
748             }
749            
750 0           my @status = $response->status;
751 0 0         if (scalar(@status) > 0) {
752 0           $rs .= "Status:\n\n";
753 0           foreach my $status (@status) {
754 0           my $epp = rdap2epp($status);
755 0 0         if ($epp) {
756 0           $rs .= sprintf(" * %s (EPP: %s)\n", $status, $epp);
757            
758             } else {
759 0           $rs .= sprintf(" * %s\n", $status);
760             }
761             }
762 0           $rs .= "\n";
763             }
764            
765 0           my @entities = $response->entities;
766 0           my %entities;
767 0           foreach my $ent (@entities) {
768            
769 0 0 0       if (!$ent->vcard && $expand) {
770              
771             my $ro = NOLookup::RDAP::RDAPLookup->new(
772             {
773             service_url => $self->{service_url},
774             debug => $self->{debug},
775             use_cache => $self->{use_cache},
776             norid_header_secret => $self->{norid_header_secret},
777             norid_header_proxy => $self->{norid_header_proxy},
778 0           });
779            
780 0           my $new = $ro->lookup($ent->handle, $check, $nameservers, 1);
781            
782 0 0         if ($new->isa('Net::RDAP::Error')) {
783 0           push(@errors, sprintf('Unable to expand %s: %d (%s)',
784             $ent->handle, $new->errorCode, $new->title));
785             } else {
786 0           $ent = $new->result;
787             }
788             }
789            
790 0           map { $entities{$_} = $ent } $ent->roles;
  0            
791             }
792            
793 0 0         if (scalar(@entities) > 0) {
794 0           $rs .= "Entities:\n\n";
795            
796 0           foreach my $entity (@entities) {
797            
798 0           my @roles = $entity->roles;
799 0 0         if (scalar(@roles) > 0) {
800 0 0         if ($entity->handle) {
801 0           $rs .= sprintf(" Entity %s (%s):\n\n", $entity->handle, join(', ', sort(@roles)));
802            
803             } else {
804 0           $rs .= sprintf(" %s:\n\n", join(', ', map { sprintf('%s Contact', ucfirst($_)) } sort(@roles)));
  0            
805            
806             }
807            
808             } else {
809 0           $rs .= sprintf(" Entity %s:\n\n", $entity->handle);
810            
811             }
812            
813 0           my $card = $entity->vcard;
814 0 0         if (!$card) {
815 0           $rs .= " (no further information available)\n\n";
816            
817             } else {
818 0           $rs .= $self->rdap_vcard_as_string($card, ' ' x 4);
819            
820             }
821             }
822             }
823            
824 0 0         if (!$short) {
825 0           my @links = $response->links;
826 0 0         if (scalar(@links) > 0) {
827 0           $rs .= "Links:\n";
828 0           foreach my $link (@links) {
829 0   0       $rs .= sprintf("\n * %s (%s)\n", $link->href->as_string, $link->title || $link->rel || '-');
830             }
831 0           $rs .= "\n";
832             }
833            
834 0           my @remarks = $response->remarks;
835 0 0         if (scalar(@remarks) > 0) {
836 0           $rs .= "Remarks:\n\n";
837 0           foreach my $remark (@remarks) {
838 0           my $indent = ' ' x 2;
839            
840 0 0         $rs .= sprintf(" %s:\n %s\n\n", $remark->title, ('=' x (1 + length($remark->title)))) if ($remark->title);
841            
842 0           $rs .= fill($indent, $indent, join("\n", $remark->description))."\n";
843            
844 0           foreach my $link ($remark->links) {
845 0   0       $rs .= sprintf("\n%s* %s (%s)\n", ($indent x 2), $link->href->as_string, ($link->title || $link->rel || '-'));
846             }
847            
848 0           $rs .= "\n";
849             }
850             }
851            
852 0           my @notices = $response->notices;
853 0 0         if (scalar(@notices) > 0) {
854 0           $rs .= "Notices:\n\n";
855 0           foreach my $notice (@notices) {
856 0           my $indent = ' ' x 2;
857            
858 0 0         $rs .= sprintf(" %s:\n %s\n\n", $notice->title, ('=' x (1 + length($notice->title)))) if ($notice->title);
859            
860 0           $rs .= fill($indent, $indent, join("\n", $notice->description))."\n";
861            
862 0           foreach my $link ($notice->links) {
863 0   0       $rs .= sprintf("\n%s* %s (%s)\n", ($indent x 2), $link->href->as_string, ($link->title || $link->rel || '-'));
864             }
865            
866 0           $rs .= "\n";
867             }
868             }
869             }
870              
871 0           return $rs, \@errors;
872             }
873              
874             =head2 rdap_vcard_as_string
875              
876             Format vcard object(s) as string.
877              
878             =cut
879              
880             sub rdap_vcard_as_string {
881 0     0 1   my ($self, $card, $indent) = @_;
882              
883 0           my $vc = "";
884            
885 0 0         $vc .= sprintf("%sName: %s\n\n", $indent, $card->full_name) if ($card->full_name);
886 0 0         $vc .= sprintf("%sOrganization: %s\n\n", $indent, $card->organization) if ($card->organization);
887            
888 0           my @addresses = @{$card->addresses};
  0            
889 0 0         if (scalar(@addresses) > 0) {
890 0           foreach my $address (@addresses) {
891 0           $vc .= sprintf("%sAddress:\n\n", $indent);
892            
893 0           my @lines;
894 0           foreach my $element (@{$address->{'address'}}) {
  0            
895 0 0         push(@lines, ('ARRAY' eq ref($element) ? @{$element} : $element));
  0            
896             }
897            
898 0           $vc .= sprintf $indent." ".join(sprintf("\n%s ", $indent), grep { length > 0 } map { s/^[ \t\r\n]+//g ; s/[ \t\r\n]+$//g ; $_ } @lines)."\n\n";
  0            
  0            
  0            
  0            
899             }
900             }
901            
902 0           foreach my $email (@{$card->email_addresses}) {
  0            
903 0 0         if ($email->{'type'}) {
904 0           $vc .= sprintf("%sEmail: %s (%s)\n\n", $indent, $email->{'address'}, $email->{'type'});
905            
906             } else {
907 0           $vc .= sprintf("%sEmail: %s\n\n", $indent, $email->{'address'});
908            
909             }
910             }
911              
912 0           foreach my $number (@{$card->phones}) {
  0            
913 0 0         my @types = ('ARRAY' eq ref($number->{'type'}) ? @{$number->{'type'}} : ($number->{'type'}));
  0            
914 0 0   0     my $type = ((any { lc($_) eq 'fax' } @types) ? 'Fax' : 'Phone');
  0            
915 0           $vc .= sprintf("%s%s: %s\n\n", $indent, $type, $number->{'number'});
916             }
917            
918 0           return $vc;
919            
920             }
921              
922             =head2 rdap_get_obj_name
923              
924             Fetch the name from an object.
925             If we have a Net::DNS::Domain object (domain/ns), also get the xname.
926              
927             =cut
928              
929             sub rdap_get_obj_name {
930 0     0 1   my ($self, $o) = @_;
931              
932 0           my $xname;
933 0           my $name = $o->name;
934 0 0         return unless $name;
935            
936 0 0         if ('Net::DNS::Domain' eq ref($name)) {
937 0           $xname = $name->xname;
938 0           $name = $name->name;
939             } else {
940 0           $xname = $name;
941             }
942 0           return $name, $xname;
943             }
944              
945             =head2 norid_handle_type
946              
947             Determine type of Norid handle.
948              
949             =cut
950              
951             sub norid_handle_type {
952 0     0 1   my ($self, $handle) = @_;
953              
954 0           $handle = uc($handle);
955            
956 0 0         if ($handle =~ m/REG\d+-NORID$/) {
    0          
957 0           return 'registrar';
958              
959             } elsif ($handle =~ m/.+([O|P|R|H|D])-NORID$/) {
960 0 0         return 'organization' if ($1 eq 'O');
961 0 0         return 'role' if ($1 eq 'R');
962 0 0         return 'person' if ($1 eq 'P');
963 0 0         return 'host' if ($1 eq 'H');
964 0 0         return 'domain' if ($1 eq 'D');
965             }
966 0           die "unknown handle type for: $handle";
967             }
968              
969              
970              
971              
972             =pod
973              
974             =encoding ISO-8859-1
975              
976             =head1 NAME
977              
978             NOLookup::RDAP::RDAPLookup - Lookup RDAP data from the Norid (.no)
979             RDAP service.
980              
981             =head1 SYNOPSIS
982              
983             use Encode;
984             use NOLookup::RDAP::RDAPLookup;
985            
986             # Default API service URL
987             my $SERVICE_URL = "https://rdap.norid.no";
988              
989             # Example 1: Domain name lookup
990             # Decode the query when needed, like for IDNs
991             # or names with national characters.
992              
993             my $q = 'norid.no';
994             #$q = decode('ISO8859-1', 'øl.no');
995              
996             my $bo = NOLookup::RDAP::RDAPLookup->new(
997             {
998             service_url => 'https://rdap.norid.no',
999             debug => 0,
1000             use_cache => 0,
1001             norid_header_secret => 'secret1234',
1002             norid_header_proxy => 1,
1003             });
1004              
1005             # test HEAD operation for existence
1006             $bo->lookup($q, 1, 0, 0);
1007             if ($bo->error) {
1008             print "HEAD: Error, error / status: ",
1009             $bo->error . "/" . $bo->status) . "\n";
1010             }
1011              
1012             # test GET operations
1013             $bo->lookup($q, 0, 0, 0);
1014             if ($bo->error) {
1015             print "GET: Error, error / status: ",
1016             $bo->error . "/" . $bo->status) . "\n";
1017             }
1018            
1019             # result of lookup is in $bo->result
1020             # This result contains response objects built by Net::RDAP
1021              
1022             my $res = $bo->result;
1023             print "handle: ", $bo->handle, "\n";
1024              
1025             * See bin/no_rdap.pl for more information on usage.
1026              
1027             * See various formatting/helper functions in this file for how to
1028             access the various objects returned by Net::RDAP.
1029              
1030             =head1 DESCRIPTION
1031              
1032             This module provides an object oriented API for use with the
1033             Norid RDAP service. It uses the Net::RDAP module from Cpan
1034             internally to fetch information from the Norid RDAP.
1035              
1036             =head1 SUPPORT
1037              
1038             For now, support questions should be sent to:
1039              
1040             E<lt>(nospam)info(at)norid.noE<gt>
1041              
1042             =head1 SEE ALSO
1043              
1044             L<http://www.norid.no/en>
1045             L<https://www.norid.no/en/registrar/system/tjenester/whois-das-service>
1046             L<https://teknisk.norid.no/en/registrar/system/tjenester/rdap>
1047             =head1 CAVEATS
1048              
1049             =head1 AUTHOR
1050              
1051             Trond Haugen, E<lt>(nospam)info(at)norid.noE<gt>
1052              
1053             =head1 COPYRIGHT
1054              
1055             Copyright (c) 2020- Trond Haugen <(nospam)info(at)norid.no>.
1056             All rights reserved.
1057              
1058             This program is free software; you can redistribute it and/or modify
1059             it under the terms of the GNU General Public License as published by
1060             the Free Software Foundation; either version 2 of the License, or
1061             (at your option) any later version.
1062              
1063             =head1 LICENSE
1064              
1065             This library is free software. You can redistribute it and/or modify
1066             it under the same terms as Perl itself.
1067              
1068             =head1 About the Norid RDAP API
1069              
1070             From Norid doc:
1071              
1072             RDAP is based on a subset of the HTTP protocol. The server accepts
1073             requests of type GET and HEAD. GET lookup is answered with data about
1074             the object in question. HEAD responds if the object exists or
1075             not. Both request types are answered with return code 200 / OK if the object
1076             exists, and return code 404 / NOT FOUND if the object does not exist, and other
1077             return code for other error types.
1078              
1079             The server supports the following types of lookups:
1080              
1081             GET/HEAD https://rdap.norid.no/domain/<domenenavn>
1082             GET/HEAD https://rdap.norid.no/entity/<handle>
1083             GET/HEAD https://rdap.norid.no/registrar/<reg_handle> (Norid extension)
1084             Note: Returns same result as /entity/<reg_handle>
1085             GET/HEAD https://rdap.norid.no/nameserver_handle/<handle> (Norid extension)
1086              
1087             And the following searches:
1088              
1089             GET https://rdap.norid.no/nameservers?name=<hostname>
1090             GET https://rdap.norid.no/domains?identity=<identity> (Norid extension for proxy)
1091             GET https://rdap.norid.no/domains?registrant=<handle> (Norid extension for proxy)
1092             GET https://rdap.norid.no/entities?identity=<identity> (Norid extension for proxy)
1093              
1094             =cut
1095              
1096             1;