#!/usr/bin/perl
# a v4.2.0  (c) 20.2.2013 by Andreas Ley  (u) 27.10.2025
# Handle A and AAAA records through NET-WebAPI

use strict;
use warnings;
no warnings 'uninitialized';
use sigtrap;
#use diagnostics;

# The script itself may use utf-8 encoded identifiers and literals
use utf8;
# Latin-1 codepoints are considered characters
use feature 'unicode_strings';
use locale;
# Enable UTF-8 encoding for all files (but not already open handles)
use open ':encoding(utf8)';

use Getopt::Long;
use File::Basename;
use File::Spec::Functions;
use NetAddr::IP ':lower';

use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
#warn Data::Dumper->Dump([\%hash],['*']) if ($opt_debug>0);
#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if ($opt_debug>0);

my $config = catfile($ENV{'HOME'}||(getpwuid($<))[7],'.config','netdb_client.ini');

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	print  STDERR  "Usage: $image [-b ipv6-base] [-s] [-m] [--ns] fqdn ip [...]\n";
	print  STDERR  "Or:    $image  -b ipv6-base  fqdn\n";
	print  STDERR  "Or:    $image                -c old-fqdn new-fqdn (this in fact changes the fqdn itself!)\n";
	print  STDERR  "Or:    $image [-b ipv6-base] -c fqdn new-ip\n";
	print  STDERR  "Or:    $image                -d fqdn\n";
	print  STDERR  "Or:    $image [-b ipv6-base] -d fqdn ip [...]\n";
	print  STDERR  "Or:    $image [-b ipv6-base] -d ip [...]\n";
	print  STDERR  "Or:    $image [-b ipv6-base] -l [-v] [fqdn|ip|ip/mask] [...]\n";
	print  STDERR  "-b, --base	Specify IPv6 base address; IPv4 addresses will be mapped\n";
	print  STDERR  "-s, --set	Record is member of a set (former A2 record)\n";
	print  STDERR  "--ns		Record is NS entry\n";
	print  STDERR  "-c, --change	Change A/AAAA record\n";
	print  STDERR  "-d, --delete	Delete A/AAAA record\n";
	print  STDERR  "-l, --list	List A/AAAA record(s)\n";
	print  STDERR  "-v, --verbose	Verbose mode (list both fqdn and ip)\n";
	print  STDERR  "Your NET-WebAPI-Key and -Certificate locations must be specified in environment variables NET_WEBAPI_KEY and NET_WEBAPI_CERT or your NetVS-Token must be readable from $config\n" unless (-r $config || defined($ENV{'NET_WEBAPI_KEY'}) && -r $ENV{'NET_WEBAPI_KEY'} && defined($ENV{'NET_WEBAPI_CERT'}) && -r $ENV{'NET_WEBAPI_CERT'});
	exit(1);
}

my %opt;
@_ = @ARGV;
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v','dry-run|n','devel|N',
	'change|c','delete|d','list|l',
#	'sort-by-name|N','sort-by-addr|A',
	'base|b=s','set|s','ns');
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

&usage() if (defined($opt{'help'}) ||
	(defined($opt{'change'}) && (defined($opt{'delete'}) || defined($opt{'list'})) || defined($opt{'delete'}) && defined($opt{'list'})) ||
	(defined($opt{'dry-run'}) && defined($opt{'devel'})) ||
	@ARGV < (defined($opt{'change'}) ? 1 : 0));
&usage() unless (-r $config || defined($ENV{'NET_WEBAPI_KEY'}) && -r $ENV{'NET_WEBAPI_KEY'} && defined($ENV{'NET_WEBAPI_CERT'}) && -r $ENV{'NET_WEBAPI_CERT'});

if (defined($opt{'verbose'}) || defined($opt{'debug'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

my (%debug,$on,$off);

sub debug
{
	my $file = shift;
	my $line = shift;
	my $prefix = defined($debug{'path'})?$file:defined($debug{'file'})?basename($file):'';
	if (defined($debug{'line'})) {
		$prefix .= ':' if (length($prefix));
		$prefix .= $line;
	}
	$prefix .= '  ' if (length($prefix));
	warn $prefix.(scalar(@_)>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
}
$debug{undef} = \&debug;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*'])) if ($debug{'debug'}>0);
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*'])) if ($debug{'debug'}>0);
	if (defined($ENV{'TERM'})) {
		use Term::Cap;
		my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
		$on = $term->Tputs('md');
		$off = $term->Tputs('me');
	}
}

#$IO::Socket::SSL::DEBUG = $debug{'ssl'} if (defined($debug{'ssl'}));

# Enable UTF-8 encoding for already open handles
# ":utf8" would enable perl native coding which happens to be UTF-8 only on ASCII platforms
binmode(STDIN,':encoding(utf8)');
binmode(STDOUT,':encoding(utf8)');
binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

####################################################################################################################################

if (defined($opt{'devel'})) {
	use lib '.';
}
use NET::WebAPI ('ip','is_ip','is_cidr');

my $base = ip($opt{'base'},0,'IPv6 base') if (defined($opt{'base'}));

my $opt = NET::WebAPI->read_config($config) if (-s $config);
$opt->{'key'} = $ENV{'NET_WEBAPI_KEY'} if (defined($ENV{'NET_WEBAPI_KEY'}));
$opt->{'cert'} = $ENV{'NET_WEBAPI_CERT'} if (defined($ENV{'NET_WEBAPI_CERT'}));
$opt->{'debug'} = \%debug;
$opt->{'url'} = 'test' if (defined($opt{'dry-run'}));
$opt->{'url'} = 'devel' if (defined($opt{'devel'}));

my $webapi = NET::WebAPI->new($opt) or die "Can't connect to WebAPI\n";

# Change
if (defined($opt{'change'})) {
	&usage() if (@ARGV < 2);
	my ($fqdn,$new) = @ARGV;
	if (is_ip($new)) {
		if (@ARGV > 2) {
			&usage() if (@ARGV != 3);
			my ($fqdn,$old,$new) = @ARGV;
			$webapi->update_a($fqdn,&four2six(ip($new)),&four2six(ip($old)));
		}
		else {
			$webapi->update_a($fqdn,&four2six(ip($new)));
#			# Shouldn't this be automatic?!
#			$webapi->update_ptr(&four2six(ip($new)),$fqdn);
		}
	}
	else {
		&usage() if (@ARGV != 2);
		$webapi->update_fqdn($fqdn,$new);
	}
}

# Delete
elsif (defined($opt{'delete'})) {
	if (is_cidr($ARGV[0])) {
		$webapi->delete_a(map(&four2six(ip($_)),@ARGV));
	}
	else {
		$webapi->delete_a(shift,map(&four2six(ip($_)),@ARGV));
	}
}

# List
elsif (defined($opt{'list'}) || (@ARGV==1 && !defined($opt{'base'}))) {
	for my $arg (@ARGV) {
		if (is_cidr($arg)) {
			my $ip = ip($arg);
			$arg = &four2six($ip);
			# Force the netmask onto the converted address
			if ($ip->version() == 4 && $arg->version() == 6) {
				$arg = NetAddr::IP->new($arg->addr(),$ip->masklen()+96);
			}
		}
		my @list = $webapi->list_a($arg);
		while (@list) {
			if (defined($opt{'verbose'})) {
				print shift(@list).' => ',shift(@list)->canon(),"\n";
			}
			else {
				if (ref($arg)) {
					print shift(@list),"\n";
					shift(@list);
				}
				else {
					shift(@list);
					print shift(@list)->canon(),"\n";
				}
			}
		}
	}
}

# Create
else {
	my $fqdn = shift;
	my %options;
	$options{'set'} = defined($opt{'set'});
	$options{'ns'} = defined($opt{'ns'});
	if (@ARGV) {
		$webapi->create_a(\%options,$fqdn,map(&four2six(ip($_)),@ARGV));
	}
	else {
		&usage() unless (defined($base));
		my @list = $webapi->list_a($fqdn,'A');
		my @ip = @list[map(2*$_+1,0..@list/2-1)];;
		$webapi->create_a(\%options,$fqdn,map(&four2six($_),@ip));
	}
}

sub four2six
{
	&debug(__FILE__,__LINE__,'+ &four2six'.Data::Dumper->new([\@_],['*'])->Indent(0)->Dump) if ($debug{'call'}>1 || $debug{'four2six'}>0);
	my ($ip) = @_;

	if (defined($base)) {
		my $numeric = scalar($ip->numeric());
		# We only have 32 bit signed(!) arithmetics
		$ip = $base+int($numeric/2)+($numeric-int($numeric/2));
	}

	&debug(__FILE__,__LINE__,'+ &four2six = '.$ip.' '.Data::Dumper->new([\$ip],['*'])->Indent(0)->Dump) if ($debug{'return'}>1 || $debug{'four2six'}>1);
	return ($ip);
}
