...
 
Commits (3)
......@@ -6,9 +6,12 @@ use HTTP::Request::Common;
use JSON;
use MIME::Base64;
use Net::RDAP::Error;
use Net::RDAP::Help;
use Net::RDAP::Object::Autnum;
use Net::RDAP::Object::Domain;
use Net::RDAP::Object::Entity;
use Net::RDAP::Object::IPNetwork;
use Net::RDAP::Object::Nameserver;
use Net::RDAP::Registry;
use Net::RDAP::SearchResult;
use vars qw($VERSION);
......@@ -320,9 +323,19 @@ In order for this form to work, the object must have a C<self> link:
L<Net::RDAP> will auto-create one for objects that don't have one if it
can.
C<%OPTIONS> is an optional hash containing additional options for the query. At
the moment, only the C<user> and C<pass> options are supported; if provided,
they will be sent to the server in an HTTP Basic Authorization header field.
C<%OPTIONS> is an optional hash containing additional options for the query.
The following options are supported:
=over
=item * C<user> and C<pass>: if provided, they will be sent to the
server in an HTTP Basic Authorization header field.
=item * C<class_override>: allows you to set or override the
C<objectClassName> property in RDAP responses.
=back
=cut
......@@ -444,28 +457,32 @@ sub fetch {
'description' => [ 'The response from the server is not a valid JSON object' ],
);
} elsif (!defined($data->{'objectClassName'}) && scalar(grep { /^(domain|nameserver|entity)SearchResults$/ } keys(%{$data})) < 1) {
#
# response is missing the objectClassName property and is not a search result:
#
return $self->error(
'url' => $url,
'errorCode' => 500,
'title' => "Missing 'objectClassName' property",
'description' => [ "The response from the server is missing the 'objectClassName' property" ],
);
} else {
#
# update local cache
#
write_file($file, $response->decoded_content) if ($self->{'use_cache'});
chmod(0600, $file);
$data->{'objectClassName'} = $args{'class_override'} if ($args{'class_override'});
#
# return object
#
return $self->object_from_response($data, $url);
if (!defined($data->{'objectClassName'}) && scalar(grep { /^(domain|nameserver|entity)SearchResults$/ } keys(%{$data})) < 1) {
#
# response is missing the objectClassName property and is not a search result:
#
return $self->error(
'url' => $url,
'errorCode' => 500,
'title' => "Missing 'objectClassName' property",
'description' => [ "The response from the server is missing the 'objectClassName' property" ],
);
} else {
#
# update local cache
#
write_file($file, $response->decoded_content) if ($self->{'use_cache'});
chmod(0600, $file);
#
# return object
#
return $self->object_from_response($data, $url);
}
}
}
......@@ -483,6 +500,7 @@ sub object_from_response {
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) }
elsif ('help' eq $data->{'objectClassName'}) { return Net::RDAP::Help->new($data, $url) }
#
# search results
......@@ -610,6 +628,8 @@ RDAP-related modules that all work together. They are:
=item * L<Net::RDAP::Error>
=item * L<Net::RDAP::Help>
=item * L<Net::RDAP::Object::Autnum>
=item * L<Net::RDAP::Object::Domain>
......
package Net::RDAP::Help;
use base qw(Net::RDAP::Object);
use strict;
=head1 NAME
L<Net::RDAP::Help> - an RDAP object representing a help
response.
=head1 DESCRIPTION
L<Net::RDAP::Help> represents an RDAP server's "help" query.
Help responses typically only contain notices, so use the C<notices()>
method to obtain them.
Otherwise, L<Net::RDAP::Help> inherits from L<Net::RDAP::Object>
so has access to all that module's methods.
=head1 COPYRIGHT
Copyright 2019 CentralNic Ltd. All rights reserved.
=head1 LICENSE
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both that copyright notice and this permission notice appear in
supporting documentation, and that the name of the author not be used
in advertising or publicity pertaining to distribution of the software
without specific prior written permission.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
=cut
1;
......@@ -11,11 +11,12 @@ sub new {
}, $package);
}
sub domain { $_[0]->fetch('domain', $_[1]->name) }
sub ip { $_[0]->fetch('ip', $_[1]->prefix) }
sub autnum { $_[0]->fetch('autnum', $_[1]->toasplain) }
sub entity { $_[0]->fetch('entity', $_[1]->handle) }
sub nameserver { $_[0]->fetch('nameserver', $_[1]->name) }
sub help { $_[0]->fetch('help' ) }
sub domain { $_[0]->fetch('domain', $_[1]->name ) }
sub ip { $_[0]->fetch('ip', $_[1]->prefix ) }
sub autnum { $_[0]->fetch('autnum', $_[1]->toasplain ) }
sub entity { $_[0]->fetch('entity', $_[1]->handle ) }
sub nameserver { $_[0]->fetch('nameserver', $_[1]->name ) }
sub fetch {
my ($self, $type, $handle, %params) = @_;
......@@ -25,7 +26,10 @@ sub fetch {
$uri->path_segments(grep { defined } ($uri->path_segments, $type, $handle));
$uri->query_form(%params);
return $self->client->fetch($uri);
my %opt;
$opt{'class_override'} = 'help' if ('help' eq $type);
return $self->client->fetch($uri, %opt);
}
sub base { $_[0]->{'base'} }
......@@ -67,6 +71,12 @@ L<Net::RDAP::Service> - an interface to an RDAP server.
my $result = $svc->domains('name' => 'ex*mple.com');
#
# get help:
#
my $help = $svc->help;
=head1 DESCRIPTION
While L<Net::RDAP> provides a unified interface to the universe of
......@@ -149,6 +159,18 @@ in the string.
These methods all return L<Net::RDAP::SearchResult> objects.
=head2 Help
Each RDAP server has a "help" endpoint which provides "helpful
information" (command syntax, terms of service, privacy policy,
rate-limiting policy, supported authentication methods, supported
extensions, technical support contact, etc.). This information may be
obtained by performing a C<help> query:
my $help = $svc->help;
The return value is a L<Net::RDAP::Object::Help> object.
=head1 COPYRIGHT
Copyright 2018 CentralNic Ltd. All rights reserved.
......