#!/usr/bin/perl
# Copyright (c) 2019 CentralNic Ltd. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
use Getopt::Long;
use JSON;
use List::MoreUtils qw(any);
use Net::ASN;
use Net::DNS::Domain;
use Net::IP;
use Net::RDAP;
use Net::RDAP::EPPStatusMap;
use Pod::Usage;
use Term::ANSIColor;
use Text::Wrap;
use URI;
use vars qw($VERSION);
use strict;

$VERSION = 0.3;

sub warning {
	my ($fmt, @params) = @_;
	my $str = sprintf("Warning: $fmt", @params);
	print STDERR colored([qw(yellow)], $str)."\n";
}

sub error {
	my ($fmt, @params) = @_;
	my $str = sprintf("Error: $fmt", @params);
	print STDERR colored([qw(red)], $str)."\n";
	exit 1;
}

my $rdap = Net::RDAP->new;

my ($type, $object, $help, $debug, $expand, $short, $bypass, $auth, $nopager, $raw);
GetOptions(
	'type:s'	=> \$type,
	'object:s'	=> \$object,
	'help'		=> \$help,
	'debug'		=> \$debug,
	'expand'	=> \$expand,
	'short'		=> \$short,
	'bypass-cache'	=> \$bypass,
	'auth:s'	=> \$auth,
	'nopager'	=> \$nopager,
	'raw'		=> \$raw,
);

$nopager = 1 if ($raw);

if (-t STDOUT && !$nopager && !$short) {
	open(LESS, sprintf('|%s', $ENV{'PAGER'} || 'less'));
	select(LESS);
}

$object = shift(@ARGV) if (!$object);

pod2usage('-verbose' => 99, '-sections' => [qw(NAME SYNOPSIS OPTIONS COPYRIGHT)]) if ($help);
pod2usage('-verbose' => 99, '-sections' => [qw(SYNOPSIS OPTIONS)]) if (length($object) < 1);

if (!$type) {
	if ($object =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/)			{ $type = 'ip'		} # v4 address
	elsif ($object =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d{1,2}$/)	{ $type = 'ip'		} # v4 range
	elsif ($object =~ /^[0-9a-f:]+$/i)					{ $type = 'ip'		} # v6 address
	elsif ($object =~ /^[0-9a-f:]+\/\d{1,3}$/i)				{ $type = 'ip'		} # v6 range
	elsif ($object =~ /^asn?\d+$/i)						{ $type = 'autnum'	} # ASN
	elsif ($object =~ /^(file|https)?:\/\//)				{ $type = 'url'		} # URL
	else									{ $type = 'domain'	} # domain
}

$Text::Wrap::columns = 80;

my $rdap = Net::RDAP->new(
	'use_cache'	=> !$bypass,
	'debug'		=> $debug,
);

my %args;
($args{'user'}, $args{'pass'}) = split(/:/, $auth, 2) if ($auth);

my $response;
if ('ip' eq $type) {
	$response = $rdap->ip(Net::IP->new($object), %args);

} elsif ('autnum' eq $type) {
	my $asn = $object;
	$asn =~ s/^asn?//ig;
	$response = $rdap->autnum(Net::ASN->new($asn), %args);

} elsif ('domain' eq $type) {
	$response = $rdap->domain(Net::DNS::Domain->new($object), %args);

} elsif ('url' eq $type) {
	$response = $rdap->fetch(URI->new($object), %args);

} elsif ('entity' eq $type) {
	$response = $rdap->entity($object, %args);

} else {
	error("Unable to handle type '$type'");

}

if (!$response) {
	error("Unable to retrieve data");

} elsif ($raw) {
	print to_json({%{$response}});

} else {
	my @errors;

	if ($response->isa('Net::RDAP::Error')) {
		push(@errors, sprintf("%03u (%s)", $response->errorCode, $response->title));

	} else {
		if ('entity' ne $response->class) {
			my $name = $response->name;
			if ($name) {
				my $xname;
				if ('Net::DNS::Domain' eq ref($name)) {
					$xname = $name->xname;
					$name = $name->name;

				} else {
					$xname = $name;

				}
				if ($xname ne $name) {
					printf("\nName: %s (%s)\n\n", uc($xname), uc($name));

				} else {
					printf("\nName: %s\n\n", uc($name));

				}
			}
		}

		printf("Handle: %s\n\n", $response->handle);

		if ('ip network' eq $response->class) {
			printf("Range: %s\n\n", $response->range->prefix);

			printf("Domain: %s\n\n", $response->domain->as_string);

		} elsif ('autnum' eq $response->class) {
			printf("Range: %u - %u\n\n", $response->start, $response->end) if ($response->start > 0 && $response->end > 0);
			printf("Type: %s\n\n", $response->type) if ($response->type);

		} elsif ('domain' eq $response->class) {
			my @ns = $response->nameservers;
			if (scalar(@ns) > 0) {
				print "Nameservers:\n\n";
				foreach my $ns (sort { lc($a->name->name) cmp lc($b->name->name) } @ns) {
					printf("  %s\n", uc($ns->name->name));
				}
				print "\n";
			}

			my @ds = $response->ds;
			if (scalar(@ds) > 0) {
				print "DNSSEC:\n\n";
				foreach my $ds ($response->ds) {
					printf("  %s. IN DS %u %u %u %s\n", uc($ds->name), $ds->keytag, $ds->algorithm, $ds->digtype, uc($ds->digest));
				}
				print "\n";
			}

			my @keys = $response->keys;
			if (scalar(@keys) > 0) {
				print "DNSSEC Keys:\n\n";
				foreach my $key (@keys) {
					printf("  %s. IN DNSKEY %u %u %u %s\n", uc($key->name), $key->flags, $key->protocol, $key->algorithm, uc($key->key));
				}
				print "\n";
			}

		} elsif ('entity' eq $response->class) {
			print_vcard($response->vcard, ' ' x 2);

		} elsif ('nameserver' eq $response->class) {
			print "IP Addresses:\n\n";

			my @addrs = $response->addresses;
			if (scalar(@addrs) > 0) {
				foreach my $ip (@addrs) {
					printf("  * %s\n", $ip->ip);
				}

			} else {
				print "  * (no IP addresses returned)\n";

			}
			print "\n";
		}

		my @events = $response->events;
		if (scalar(@events)) {
			print "Events:\n\n";
			foreach my $event (@events) {
				printf("  %s: %s\n", ucfirst($event->action), scalar($event->date));
			}
			print "\n";
		}

		my @status = $response->status;
		if (scalar(@status) > 0) {
			print "Status:\n\n";
			foreach my $status (@status) {
				my $epp = rdap2epp($status);
				if ($epp) {
					printf("  * %s (EPP: %s)\n", $status, $epp);

				} else {
					printf("  * %s\n", $status);

				}
			}
			print "\n";
		}

		my @entities = $response->entities;
		my %entities;
		foreach my $entity (@entities) {
			if (!$entity->vcard && $expand) {
				my $new = $rdap->fetch($entity);
				if ($new->isa('Net::RDAP::Error')) {
					push(@errors, sprintf('Unable to expand %s: %d (%s)', $entity->handle, $new->errorCode, $new->title));

				} else {
					$entity = $new;

				}
			}
			map { $entities{$_} = $entity } $entity->roles;
		}

		if (scalar(@entities) > 0) {
			print "Entities:\n\n";

			foreach my $entity (@entities) {

				my @roles = $entity->roles;
				if (scalar(@roles) > 0) {
					if ($entity->handle) {
						printf("  Entity %s (%s):\n\n", $entity->handle, join(', ', sort(@roles)));

					} else {
						printf("  %s:\n\n", join(', ', map { sprintf('%s Contact', ucfirst($_)) } sort(@roles)));

					}

				} else {
					printf("  Entity %s:\n\n", $entity->handle);

				}

				my $card = $entity->vcard;
				if (!$card) {
					print "    (no further information available)\n\n";

				} else {
					print_vcard($card, ' ' x 4);

				}
			}
		}
	}

	if (!$short) {
		my @links = $response->links;
		if (scalar(@links) > 0) {
			print "Links:\n";
			foreach my $link (@links) {
				printf("\n  * %s (%s)\n", $link->href->as_string, $link->title || $link->rel || '-');
			}
			print "\n";
		}

		my @remarks = $response->remarks;
		if (scalar(@remarks) > 0) {
			print "Remarks:\n\n";
			foreach my $remark (@remarks) {
				my $indent = ' ' x 2;

				printf("  %s:\n  %s\n\n", $remark->title, ('=' x (1 + length($remark->title)))) if ($remark->title);

				print fill($indent, $indent, join("\n", $remark->description))."\n";

				foreach my $link ($remark->links) {
					printf("\n%s* %s (%s)\n", ($indent x 2), $link->href->as_string, ($link->title || $link->rel || '-'));
				}

				print "\n";
			}
		}

		my @notices = $response->notices;
		if (scalar(@notices) > 0) {
			print "Notices:\n\n";
			foreach my $notice (@notices) {
				my $indent = ' ' x 2;

				printf("  %s:\n  %s\n\n", $notice->title, ('=' x (1 + length($notice->title)))) if ($notice->title);

				print fill($indent, $indent, join("\n", $notice->description))."\n";

				foreach my $link ($notice->links) {
					printf("\n%s* %s (%s)\n", ($indent x 2), $link->href->as_string, ($link->title || $link->rel || '-'));
				}

				print "\n";
			}
		}
	}

	map { warning($_) } @errors;
}

close(LESS);

sub print_vcard {
	my ($card, $indent) = @_;

	printf("%sName: %s\n\n", $indent, $card->full_name) if ($card->full_name);
	printf("%sOrganization: %s\n\n", $indent, $card->organization) if ($card->organization);

	my @addresses = @{$card->addresses};
	if (scalar(@addresses) > 0) {
		foreach my $address (@addresses) {
			printf("%sAddress:\n\n", $indent);

			my @lines;
			foreach my $element (@{$address->{'address'}}) {
				push(@lines, ('ARRAY' eq ref($element) ? @{$element} : $element));
			}

			print $indent."  ".join(sprintf("\n%s  ", $indent), grep { length > 0 } map { s/^[ \t\r\n]+//g ; s/[ \t\r\n]+$//g ; $_ } @lines)."\n\n";
		}
	}

	foreach my $email (@{$card->email_addresses}) {
		if ($email->{'type'}) {
			printf("%sEmail: %s (%s)\n\n", $indent, $email->{'address'}, $email->{'type'});

		} else {
			printf("%sEmail: %s\n\n", $indent, $email->{'address'});

		}
	}

	foreach my $number (@{$card->phones}) {
		my @types = ('ARRAY' eq ref($number->{'type'}) ? @{$number->{'type'}} : ($number->{'type'}));
		my $type = ((any { lc($_) eq 'fax' } @types) ? 'Fax' : 'Phone');
		printf("%s%s: %s\n\n", $indent, $type, $number->{'number'});
	}

}

__END__

=pod

=head1 NAME

C<rdapper> - a simple console-based RDAP client.

=head1 SYNOPSIS

	rdapper OBJECT

=head1 DESCRIPTION

C<rdapper> is a simple RDAP client. It uses L<Net::RDAP> to retrieve
data about internet resources (domain names, IP addresses, and
autonymous systems) and outputs the information in a human-readable
format. If you want to consume this data in your own program you
should use L<Net::RDAP> directly.

C<rdapper> was originally conceived as a full RDAP client (back
when the RDAP protocol was still in draft form) but is now just
a very thin front-end to L<Net::RDAP>, and its main purpose is to
allow testing of that library.

=head1 OPTIONS

You can pass any internet resource as an argument; this may be:

=over

=item * a "forward" domain name such as C<example.com>;

=item * a "reverse" domain name such as C<168.192.in-addr.arpa>;

=item * a IPv4 or IPv6 address or CIDR prefix, such as C<192.168.0.1>
or C<2001:DB8::/32>;

=item * an Autonymous System Number such as C<AS65536>.

=item * the URL of an RDAP resource such as
C<https://example.com/rdap/domain/example.com>.

=item * the "tagged" handle of an entity, such as an LIR, registrar,
or domain admin/tech contact. Because these handles are difficult
to distinguish from domain names, you must use the C<--type> argument
to explicitly tell C<rdapper> that you want to perform an entity query.

=back

=head2 ADDITIONAL ARGUMENTS

=over

=item * C<--type=TYPE> - explicitly set the object type. C<rdapper>
will guess the type by pattern matching the value of C<OBJECT> but
you can override this by explicitly setting the C<--type> argument
to one of : C<ip>, C<autnum>, C<domain>, C<entity> or C<url>.

If C<--type=url> is used, C<rdapper> will directly fetch the
specified URL and attempt to process it as an RDAP response.

If C<--type=entity> is used, C<OBJECT> must be a a string
containing a "tagged" handle, such as C<ABC123-EXAMPLE>, as per
RFC 8521.

=item * C<--help> - display help message.

=item * C<--debug> - enable L<Net::RDAP> debug mode.

=item * C<--short> - omit remarks, notices, and links. Implies
C<--nopager>.

=item * C<--expand> - attempt to "expand" truncated entity objects.

=item * C<--bypass-cache> - disable local cache of RDAP objects.

=item * C<--auth=USER:PASS> - HTTP Basic Authentication credentials
to be used when accessing the specified resource.

=item * C<--nopager> - by default, C<rdapper> will pass its output
to C<less(1)>. Setting C<--nopager> disables this behaviour.

=item * C<--raw> - output raw JSON response (implies C<--nopager>).

=back

=head1 DEPENDENCIES

C<rdapper> uses the following modules, some of which may already be
installed:

=over

=item * L<Getopt::Long>

=item * L<List::MoreUtils>

=item * L<Net::ASN>

=item * L<Net::DNS::Domain>

=item * L<Net::IP>

=item * L<Net::RDAP> (obviously)

=item * L<Term::ANSIColor>

=item * L<Text::Wrap>

=back

=head1 COPYRIGHT

Copyright 2019 CentralNic Ltd. All rights reserved.

=head1 LICENSE

Copyright (c) 2018 CentralNic Ltd. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=cut
