...
 
Commits (2)
package Net::RDAP; package Net::RDAP;
use Digest::SHA1 qw(sha1_hex); use Digest::SHA1 qw(sha1_hex);
use File::stat;
use File::Slurp; use File::Slurp;
use File::stat;
use HTTP::Request::Common; use HTTP::Request::Common;
use JSON; use JSON;
use MIME::Base64;
use Net::RDAP::Error; use Net::RDAP::Error;
use Net::RDAP::Object::Autnum; use Net::RDAP::Object::Autnum;
use Net::RDAP::Object::Domain; use Net::RDAP::Object::Domain;
use Net::RDAP::Object::IPNetwork; use Net::RDAP::Object::IPNetwork;
use Net::RDAP::Registry; use Net::RDAP::Registry;
use Net::RDAP::SearchResult;
use vars qw($VERSION); use vars qw($VERSION);
use strict; use strict;
...@@ -213,7 +215,7 @@ sub query { ...@@ -213,7 +215,7 @@ sub query {
); );
} else { } else {
return $self->fetch($url); return $self->fetch($url, %args);
} }
} }
...@@ -262,7 +264,7 @@ can. ...@@ -262,7 +264,7 @@ can.
=cut =cut
sub fetch { sub fetch {
my ($self, $arg) = @_; my ($self, $arg, %args) = @_;
my $url; my $url;
if ($arg->isa('URI')) { if ($arg->isa('URI')) {
...@@ -293,6 +295,8 @@ sub fetch { ...@@ -293,6 +295,8 @@ sub fetch {
my $request = GET($url); my $request = GET($url);
$request->header('Authorization' => sprintf('Basic %s', encode_base64(join(':', ($args{'user'}, $args{'pass'}))))) if ($args{'user'} && $args{'pass'});
my $file = sprintf( my $file = sprintf(
'%s/%s::cache::%s.json', '%s/%s::cache::%s.json',
($ENV{'TMPDIR'} || '/tmp'), ($ENV{'TMPDIR'} || '/tmp'),
...@@ -354,7 +358,7 @@ sub fetch { ...@@ -354,7 +358,7 @@ sub fetch {
'description' => [ 'The response from the server is not a valid JSON object' ], 'description' => [ 'The response from the server is not a valid JSON object' ],
); );
} elsif (!defined($data->{'objectClassName'})) { } elsif (!defined($data->{'objectClassName'}) && scalar(grep { /^(domain|nameserver|entity)SearchResults$/ } keys(%{$data})) < 1) {
return $self->error( return $self->error(
'url' => $url, 'url' => $url,
'errorCode' => 500, 'errorCode' => 500,
...@@ -370,14 +374,31 @@ sub fetch { ...@@ -370,14 +374,31 @@ sub fetch {
} }
} }
#
# generate an RDAP object from an RDAP response
#
sub object_from_response { sub object_from_response {
my ($self, $data, $url) = @_; my ($self, $data, $url) = @_;
if ('domain' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Domain->new($data, $url) } #
elsif ('ip network' eq $data->{'objectClassName'}) { return Net::RDAP::Object::IPNetwork->new($data, $url) } # lookup results
elsif ('autnum' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Autnum->new($data, $url) } #
elsif ('nameserver' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Nameserver->new($data, $url) } if ('domain' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Domain->new($data, $url) }
elsif ('entity' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Entity->new($data, $url) } elsif ('ip network' eq $data->{'objectClassName'}) { return Net::RDAP::Object::IPNetwork->new($data, $url) }
elsif ('autnum' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Autnum->new($data, $url) }
elsif ('nameserver' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Nameserver->new($data, $url)}
elsif ('entity' eq $data->{'objectClassName'}) { return Net::RDAP::Object::Entity->new($data, $url) }
#
# search results
#
elsif (defined($data->{'domainSearchResults'})) { return Net::RDAP::SearchResult->new($data, $url) }
elsif (defined($data->{'nameserverSearchResults'})) { return Net::RDAP::SearchResult->new($data, $url) }
elsif (defined($data->{'entitySearchResults'})) { return Net::RDAP::SearchResult->new($data, $url) }
#
# unprocessable response
#
else { else {
return $self->error( return $self->error(
'url' => $url, 'url' => $url,
...@@ -388,6 +409,9 @@ sub object_from_response { ...@@ -388,6 +409,9 @@ sub object_from_response {
} }
} }
#
# simple check that a server response is indeed an RDAP object
#
sub is_rdap { sub is_rdap {
my ($self, $response) = @_; my ($self, $response) = @_;
...@@ -488,6 +512,8 @@ RDAP-related modules that all work together. They are: ...@@ -488,6 +512,8 @@ RDAP-related modules that all work together. They are:
=item * L<Net::RDAP::Object::Nameserver> =item * L<Net::RDAP::Object::Nameserver>
=item * L<Net::RDAP::SearchResult>
=back =back
=item * L<Net::RDAP::Remark>, and its submodule: =item * L<Net::RDAP::Remark>, and its submodule:
...@@ -504,6 +530,8 @@ RDAP-related modules that all work together. They are: ...@@ -504,6 +530,8 @@ RDAP-related modules that all work together. They are:
=item * L<Net::RDAP::Registry> =item * L<Net::RDAP::Registry>
=item * L<Net::RDAP::Service>
=item * L<Net::RDAP::Link> =item * L<Net::RDAP::Link>
=item * L<Net::RDAP::UA> =item * L<Net::RDAP::UA>
......
...@@ -350,9 +350,7 @@ sub get_best_url { ...@@ -350,9 +350,7 @@ sub get_best_url {
sub assemble_url { sub assemble_url {
my ($package, $uri, @segments) = @_; my ($package, $uri, @segments) = @_;
my $path = $uri->path; $uri->path_segments(grep { defined } $uri->path_segments, @segments);
$path =~ s/\/+$//g;
$uri->path(join('/', $path, @segments));
return $uri; return $uri;
} }
......