first commit

parents
# NAME
`rdap-conformance` - a script to validate the conformance of an RDAP server.
# DESCRIPTION
`rdap-conformance` provides a report of the conformance of an RDAP server to
the RDAP profile for generic top-level domains. It tests the responses from
an RDAP server against the requirements published by ICANN.
# USAGE
rdap-conformance OPTIONS URL
# OPTIONS
- `--handle=HANDLE` - explicitly specify handle. If not provided, this is
derived from the path segment of the URL.
- `--type=TYPE` - specify response type, must be one of `domain` (the default),
`entity`, `nameserver`, or `help`.
- `--debug` - enable debug mode (i.e. print the HTTP request and response)
- `--help` - show this help
# COPYRIGHT
Copyright 2018 CentralNic Ltd. This program is free software, you can
use it and/or modify it under the same terms as Perl itself.
# SEE ALSO
- [https://www.icann.org/rdap](https://www.icann.org/rdap) - the RDAP information page on the ICANN website
- [Net::RDAP](https://metacpan.org/pod/Net::RDAP)
#!/usr/bin/perl
# Copyright 2018 CentralNic Ltd. This program is free software, you can
# use it and/or modify it under the same terms as Perl itself.
use File::Basename qw(basename);
use Getopt::Long;
use List::MoreUtils qw(any);
use Net::RDAP;
use Pod::Usage;
use Text::Wrap;
use URI;
use strict;
my $opt = {};
GetOptions(
$opt,
'help',
'handle=s',
'type=s',
'debug',
);
pod2usage() if ($opt->{'help'});
pod2usage({'-verbose' => 99, '-sections' => 'USAGE|OPTIONS'}) unless ($ARGV[0]);
$opt->{'type'} ||= 'domain';
pod2usage({'-verbose' => 99, '-sections' => 'USAGE|OPTIONS'}) unless ($opt->{'type'} =~ /^(domain|entity|nameserver|help)$/);
$opt->{'handle'} ||= basename($ARGV[0]);
$ENV{'NET_RDAP_UA_DEBUG'} = $opt->{'debug'};
printf(STDERR "Testing %s which is a domain...\n", $ARGV[0], $opt->{'type'});
my $response = Net::RDAP->new->fetch(URI->new($ARGV[0]));
my $errors = 0;
if ($response->isa('Net::RDAP::Error')) {
fail($response);
} else {
check_rdap_conformance($response);
check_gtld_conformance($response);
if ('domain' eq $opt->{'type'}) {
check_domain_conformance($response);
} elsif ('entity' eq $opt->{'type'}) {
check_entity_conformance($response);
} elsif ('nameserver' eq $opt->{'type'}) {
check_nameserver_conformance($response);
} elsif ('help' eq $opt->{'type'}) {
check_help_conformance($response);
} else {
print STDERR "Cannot validate responses of type '$opt->{'type'}'\n";
exit(1);
}
printf(STDERR "Completed with %d errors\n", $errors);
exit($errors);
}
sub check_rdap_conformance {
my $response = shift;
# to get this far, Net::RDAP has already validated a lot of stuff, e.g. the media type, JSON well-formedness, etc.
my @conformance = $response->conformance;
if (scalar(@conformance) < 1) {
fail('rdapConformance is missing or empty', [ "The 'rdapConformance' property must be an array of one or more strings"]);
} else {
pass("'rdapConformance' property is an array of one or more values");
my %conformance;
for (my $i = 0 ; $i < scalar(@conformance) ; $i++) {
my $value = $conformance[$i];
if (ref($value)) {
fail(sprintf('value #%d in rdapConformance array is not a string', $i));
} else {
$conformance{$value}++;
}
pass("values in the 'rdapConformance' property are all strings");
if (defined($conformance{'rdap_level_0'})) {
pass("'rdap_level_0' is present in the 'rdapConformance' array");
} else {
fail("'rdap_level_0' is not present in the 'rdapConformance' array");
}
}
}
}
sub check_gtld_conformance {
my $response = shift;
# TODO
}
sub check_domain_conformance {
my $response = shift;
# TODO
}
sub check_entity_conformance {
my $response = shift;
# TODO
}
sub check_nameserver_conformance {
my $response = shift;
# TODO
}
sub check_help_conformance {
my $response = shift;
# TODO
}
sub pass {
my $fmt = shift;
printf(STDERR "PASS (%04d): %s\n", (caller)[2], sprintf($fmt, @_));
}
sub fail {
my $error = shift;
$error = mkerror($error, @_) if (!$error->isa('Net::RDAP::Error'));
printf(STDERR "FAIL (#%04d): %s\n\n", $error->errorCode, $error->title);
my @description = $error->description;
print "Description:\n\n".fill(" ", " ", join("\n", @description))."\n\n" if (scalar(@description) > 0);
}
sub mkerror {
my ($title, $description) = @_;
return Net::RDAP::Error->new({
'errorCode' => 600 + (caller)[2],
'title' => $title,
'description' => $description,
});
}
__END__
=pod
=head1 NAME
C<rdap-conformance> - a script to validate the conformance of an RDAP server.
=head1 DESCRIPTION
C<rdap-conformance> provides a report of the conformance of an RDAP server to
the RDAP profile for generic top-level domains. It tests the responses from
an RDAP server against the requirements published by ICANN.
=head1 USAGE
rdap-conformance OPTIONS URL
=head1 OPTIONS
=over
=item * C<--handle=HANDLE> - explicitly specify handle. If not provided, this is
derived from the path segment of the URL.
=item * C<--type=TYPE> - specify response type, must be one of C<domain> (the default),
C<entity>, C<nameserver>, or C<help>.
=item * C<--debug> - enable debug mode (i.e. print the HTTP request and response)
=item * C<--help> - show this help
=back
=head1 COPYRIGHT
Copyright 2018 CentralNic Ltd. This program is free software, you can
use it and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
=over
=item * L<https://www.icann.org/rdap> - the RDAP information page on the ICANN website
=item * L<Net::RDAP>
=back
=cut
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment