...
 
Commits (2)
......@@ -14,6 +14,8 @@ lib/Net/RDAP/Object/Entity.pm
lib/Net/RDAP/Object/IPNetwork.pm
lib/Net/RDAP/Object/Nameserver.pm
lib/Net/RDAP/Registry.pm
lib/Net/RDAP/Registry/IANARegistry.pm
lib/Net/RDAP/Registry/IANARegistry/Service.pm
lib/Net/RDAP/Remark.pm
lib/Net/RDAP/SearchResult.pm
lib/Net/RDAP/Service.pm
......
......@@ -134,7 +134,7 @@ If there was an error, this method will return a L<Net::RDAP::Error>.
Domain names which contain characters other than those from the ASCII-compatible
range must be encoded into "A-label" (or "Punycode") format before being passed
to C<Net::DNS::Domain>. You can use C<Net::LibIDN> or C<Net::LibIDN2> to
to L<Net::DNS::Domain>. You can use L<Net::LibIDN> or L<Net::LibIDN2> to
perform this encoding:
use Net::LibIDN;
......@@ -547,7 +547,7 @@ sub request {
RDAP supports a limited search capability, but you need to know in
advance which RDAP server you want to send the search query to. The
C<Net::RDAP::Service> class allows you to prepare and submit search
L<Net::RDAP::Service> class allows you to prepare and submit search
queries to specific RDAP servers.
=head2 RDAP User Agent
......@@ -660,6 +660,10 @@ RDAP-related modules that all work together. They are:
=item * L<Net::RDAP::Registry>
=item * L<Net::RDAP::Registry::IANARegistry>
=item * L<Net::RDAP::Registry::IANARegistry::Service>
=item * L<Net::RDAP::Service>
=item * L<Net::RDAP::Link>
......
......@@ -8,6 +8,7 @@ use File::stat;
use HTTP::Request::Common;
use JSON;
use Net::RDAP::UA;
use Net::RDAP::Registry::IANARegistry;
use vars qw($UA $REGISTRY);
use strict;
......@@ -106,25 +107,24 @@ sub ip {
my $registry = $package->load_registry(4 == $ip->version ? 'https://data.iana.org/rdap/ipv4.json' : 'https://data.iana.org/rdap/ipv6.json');
return undef if (!$registry);
my $matches = {};
SERVICE: foreach my $service (@{$registry->{'services'}}) {
VALUE: foreach my $value (@{$service->[0]}) {
my %matches;
SERVICE: foreach my $service ($registry->services) {
VALUE: foreach my $value ($service->registries) {
my $range = Net::IP->new($value);
if ($range->overlaps($ip)) {
$matches->{$value} = $service->[1];
$matches{$value} = $package->get_best_url($service->urls);
last VALUE;
}
}
}
return undef if (scalar(keys(%{$matches})) < 1);
return undef if (scalar(keys(%matches)) < 1);
# prefer the service with the longest prefix length
my @urls = @{$matches->{(sort { Net::IP->new($b)->prefixlen <=> Net::IP->new($a)->prefixlen } keys(%{$matches}))[0]}};
my $longest = (sort { Net::IP->new($b)->prefixlen <=> Net::IP->new($a)->prefixlen } keys(%matches))[0];
return $package->assemble_url($package->get_best_url(@urls), 'ip', split(/\//, $ip->prefix));
return $package->assemble_url($matches{$longest}, 'ip', split(/\//, $ip->prefix));
}
#
......@@ -137,27 +137,28 @@ sub autnum {
my $registry = $package->load_registry('https://data.iana.org/rdap/asn.json');
return undef if (!$registry);
my $matches = {};
SERVICE: foreach my $service (@{$registry->{'services'}}) {
VALUE: foreach my $value (@{$service->[0]}) {
my %matches;
SERVICE: foreach my $service ($registry->services) {
VALUE: foreach my $value ($service->registries) {
if ($value == $autnum->toasplain) {
# exact match, create an entry for NNNN-NNN where both sides are
# the same (simplifies sorting later)
$matches = { sprintf('%d-%d', $value, $value) => $service->[1] };
$matches{sprintf('%d-%d', $value, $value)} = $package->get_best_url($service->urls);
last SERVICE;
} elsif ($value =~ /^(\d+)-(\d+)$/) {
if ($1 <= $autnum->toasplain && $autnum->toasplain <= $2) {
$matches->{$value} = $service->[1];
$matches{sprintf('%d-%d', $value, $value)} = $package->get_best_url($service->urls);
last VALUE;
}
}
}
}
return undef if (scalar(keys(%{$matches})) < 1);
return undef if (scalar(keys(%matches)) < 1);
my @ranges = keys(%matches);
my @ranges = keys(%{$matches});
# convert array of NNNN-NNNN strings to array of array refs
my @pairs = map { [ split(/-/, $_, 2) ] } @ranges;
......@@ -166,9 +167,9 @@ sub autnum {
my $range = sprintf('%d-%d', @{$sorted[0]});
my @urls = @{$matches->{$range}};
my $url = $matches{$range};
return $package->assemble_url($package->get_best_url(@urls), 'autnum', $autnum->toasplain);
return $package->assemble_url($url, 'autnum', $autnum->toasplain);
}
#
......@@ -181,22 +182,17 @@ sub domain {
my $registry = $package->load_registry('https://data.iana.org/rdap/dns.json');
return undef if (!$registry);
my $matches = {};
SERVICE: foreach my $service (@{$registry->{'services'}}) {
VALUE: foreach my $value (@{$service->[0]}) {
if (lc($domain->name) eq lc($value)) {
$matches = { $value => $service->[1] };
last SERVICE;
} elsif ($domain->name =~ /\.$value$/i) {
$matches->{$value} = $service->[1];
my %matches;
SERVICE: foreach my $service ($registry->services) {
VALUE: foreach my $value ($service->registries) {
if ($domain->name =~ /\.$value$/i) {
$matches{$value} = $package->get_best_url($service->urls);
last VALUE;
}
}
}
if (scalar(keys(%{$matches})) < 1) {
if (scalar(keys(%matches)) < 1) {
if ($domain->name =~ /\.(in-addr|ip6)\.arpa$/) {
# special workaround for the lack of .arpa in the RDAP registry
return $package->reverse_domain($domain);
......@@ -208,9 +204,9 @@ sub domain {
} else {
# prefer the service with the longest domain name
my @urls = @{$matches->{(sort { length($b) <=> length($a) } keys(%{$matches}))[0]}};
my $parent = (sort { length($b) <=> length($a) } keys(%matches))[0];
return $package->assemble_url($package->get_best_url(@urls), 'domain', $domain->name);
return $package->assemble_url($matches{$parent}, 'domain', $domain->name);
}
}
......@@ -285,10 +281,10 @@ sub entity {
my $registry = $package->load_registry('https://data.iana.org/rdap/object-tags.json');
return undef if (!$registry);
foreach my $service (@{$registry->{'services'}}) {
foreach my $value (@{$service->[1]}) {
foreach my $service ($registry->services) {
foreach my $value ($service->registries) {
# unlike the other registries we are only looking for an exact match as there is no hierarchy to tag
return $package->assemble_url($package->get_best_url(@{$service->[2]}), 'entity', $handle) if (lc($value) eq lc($tag));
return $package->assemble_url($package->get_best_url($service->urls), 'entity', $handle) if (lc($value) eq lc($tag));
}
}
......@@ -341,10 +337,10 @@ sub load_registry {
}
if (-e $file) {
return from_json(read_file($file));
$REGISTRY->{$url} = Net::RDAP::Registry::IANARegistry->new(from_json(read_file($file)));
} else {
return undef;
$REGISTRY->{$url} = undef;
}
}
......@@ -359,12 +355,13 @@ sub load_registry {
sub get_best_url {
my ($package, @urls) = @_;
my @https = grep { $_ =~ /^https/ } @urls;
my @https = grep { 'https' eq lc($_->scheme) } @urls;
if (scalar(@https)) {
return URI->new($https[0]);
return shift(@https);
} else {
return URI->new($urls[0]);
return shift(@urls);
}
}
......@@ -375,11 +372,11 @@ sub get_best_url {
# trailing slashes
#
sub assemble_url {
my ($package, $uri, @segments) = @_;
my ($package, $url, @segments) = @_;
$uri->path_segments(grep { length > 0 } $uri->path_segments, @segments);
$url->path_segments(grep { length > 0 } ($url->path_segments, @segments));
return $uri;
return $url;
}
=pod
......
package Net::RDAP::Registry::IANARegistry;
use DateTime::Format::ISO8601;
use Net::RDAP::Registry::IANARegistry::Service;
use strict;
=pod
=head1 NAME
L<Net::RDAP::Registry::IANARegistry> - a class which represents an RDAP
bootstrap registry.
=head1 DESCRIPTION
The IANA maintains a set of RDAP boostrap registries: for IPv4 and IPv6
address blocks, top-level domains, AS number ranges, and object tags.
This class represents these registries.
This class is use internally by L<Net::RDAP>.
=head1 CONSTRUCTOR
$registry = Net::RDAP::Registry::IANARegistry->new($data);
C<$data> is a hashref corresponding to the decoded JSON representation
of the IANA registry.
=cut
sub new {
my ($package, $args, $url) = @_;
my %self = %{$args};
return bless(\%self, $package);
}
=pod
=head1 METHODS
$description = $registry->description;
Returns a string containing the description of the registry.
$version = $registry->version;
Returns a string containing the version of the registry.
$date = $registry->publication;
Returns a L<DateTime> object corresponding to the date and time
that the registry was last updated.
@services = $registry->services;
Returns an array of L<Net::RDAP::Registry::IANARegistry::Service>
objects corresponding to each of the RDAP services listed in the
registry.
=cut
sub description { $_[0]->{'description'} }
sub version { $_[0]->{'version'} }
sub publication { DateTime::Format::ISO8601->parse_datetime($_[0]->{'publication'}) }
sub services {
my $self = shift;
my @services;
foreach my $svc (@{$self->{'services'}}) {
push(@services, Net::RDAP::Registry::IANARegistry::Service->new(@{$svc}));
}
return @services;
}
=pod
=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;
\ No newline at end of file
package Net::RDAP::Registry::IANARegistry::Service;
use URI;
use strict;
=pod
=head1 NAME
L<Net::RDAP::Registry::IANARegistry::Service> - a class which represents
an RDAP service in an IANA bootstrap registry.
=head1 DESCRIPTION
Each of the entries in the IANA RDAP Bootstrap registries represent a
specific RDAP service that corresponds to the unique identifiers
associated with that entry (e.g. top-level domains, IP blocks, or AS
number ranges).
L<Net::RDAP::Registry::IANARegistry::Service> provides a representation
of these entries.
This class is use internally by L<Net::RDAP>.
=head1 CONSTRUCTOR
The constructor accepts two or three arguments:
$svc = Net::RDAP::Registry::IANARegistry::Service->new(
$registryref,
$urlref,
);
# or:
$svc = Net::RDAP::Registry::IANARegistry::Service->new(
$registrant,
$registryref,
$urlref,
);
=over
=item * C<$registrant> is the email address of the registrant of the
service.
=item * C<$registryref> is a reference to an array of "registries",
i.e. top-level domains, IP address blocks, ASN ranges, or object
tags.
=item * C<$urlref> is a reference to an array of RDAP base URLs.
=back
=cut
sub new {
my ($package, @args) = @_;
my $self = bless({}, $package);
$self->{'urls'} = pop(@args);
$self->{'registries'} = pop(@args);
$self->{'registrant'} = pop(@args);
return $self;
}
=pod
=head1 METHODS
@urls = $svc->urls;
This method returns an array of C<URI> objects representing the
RDAP base URLs for the RDAP service.
@registries = $svc->registries;
This method returns an array of "registries" (TLDs, IP blocks,
ASN ranges, etc).
$registrant = $svc->registrant;
This method returns the registrant of the entry into the
registry. This is typically an email address. Note that as of
writing, only the Object Tag registry lists the registrant.
=cut
sub urls { map { URI->new($_) } @{$_[0]->{'urls'}} }
sub registries { @{$_[0]->{'registries'}} }
sub registrant { $_[0]->{'registries'} }
=pod
=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;