#!/usr/bin/perl
# FQDN v4.2.0  (c) 20.2.2013 by Andreas Ley  (u) 27.10.2025
# Handle FQDN 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 [-l|-t|-d] fqdn [...]\n";
	print  STDERR  "Or:    $image -C fqdn\n";
	print  STDERR  "-C, --create	Create FQDN(s)\n";
	print  STDERR  "-l, --list	List FQDN(s)\n";
	print  STDERR  "-t, --type	Show FQDN(s) type\n";
	print  STDERR  "-d, --domain	Show wether this/these FQDN(s) is/are a domain\n";
	print  STDERR  "-e, --exist	Check wether this FQDN exists (sets return code)\n";
	print  STDERR  "--dnsvs		Check wether this FQDN's zone is provided via DNSVS (sets return code)\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',
	'create|C',
	'list|l',
	'type|t',
	'domain|d',
	'exist|check|e',
	'dnsvs');
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

&usage if (defined($opt{'help'}) ||
	(defined($opt{'list'}) + defined($opt{'check'}) + defined($opt{'domain'})) > 1 ||
	(defined($opt{'dry-run'}) && defined($opt{'devel'})) ||
	@ARGV < 1 || defined($opt{'check'}) && @ARGV > 1);
&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__,'%debug = '.Data::Dumper->Dump([\%debug],['*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','chopp');
#use NET::WebAPI ('ip','is_ip','is_cidr','chopp');

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";

if (defined($opt{'type'})) {
	for my $fqdn (@ARGV) {
		for my $type ($webapi->fqdn_type($fqdn)) {
			print "$fqdn => " if (defined($opt{'verbose'}));
			print $type,"\n";
		}
	}
}

elsif (defined($opt{'exist'})) {
	&usage if (@ARGV>1);
	my $json = $webapi->request('fqdn/list',{'old'=>{'value_list'=>[$ARGV[0]]}});
	exit(!@{$json->[0]});
}

elsif (defined($opt{'dnsvs'})) {
	&usage if (@ARGV>1);
	exit(!$webapi->is_dnsvs($ARGV[0]));
}

elsif (defined($opt{'domain'})) {
	for my $fqdn (@ARGV) {
		print $fqdn.' => '.($webapi->is_domain($fqdn)?'1':'0'),"\n";
	}
}

elsif (defined($opt{'create'})) {
	for my $fqdn (@ARGV) {
		$webapi->create_fqdn($fqdn);
	}
}

else {
	for my $fqdn (@ARGV) {
		my $json = $webapi->request('fqdn/list',{'old'=>{'value_list'=>[$fqdn]}});
		print $fqdn." does not exist\n" unless (@{$json->[0]});
		for (@{$json->[0]}) {
			if (defined($debug{'all'})) {
				for my $key (sort keys %{$_}) {
					#warn $key,': ',ref($_->{$key}),"\n";
					print $key,': ',ref($_->{$key})?ref($_->{$key}) eq 'ARRAY'?join(', ',@{$_->{$key}}):$_->{$key}?'true':'false':$_->{$key},"\n";
				}
			}
			else {
				# <= [[{"gpk": "e4f6a059-d2b4-4238-a20c-294df3da2824", "type": "domain", "zone": "kit.edu.", "label": "andy3", "value": "andy3.scc.kit.edu.", "is_own": false, "label_idna": "andy3", "parent_gfk": "55b3168c-3bf4-4d43-8c8e-66a1281cfcd7", "tree_level": 4, "value_idna": "andy3.scc.kit.edu.", "description": null, "parent_value": "scc.kit.edu.", "type_is_dhcp": false, "type_is_host": true, "type_rad_type": 0, "type_is_wildcard": false, "hierarchy_gfk_list": ["e4f6a059-d2b4-4238-a20c-294df3da2824", "55b3168c-3bf4-4d43-8c8e-66a1281cfcd7", "f48c92ec-42b6-4f32-8635-645bbba390c4", "7b22aacf-150e-422c-8917-9fd031a9d064", "6467ef53-f830-44e2-8256-b943f48e069c"], "type_is_nonterminal": true, "is_empty_nonterminal": false, "rr_chain_target_is_own": false, "rr_chain_target_subnet_gfk_list": ["297778d8-60e2-4e78-ad3a-21b8384e363f"]}]]
				my %property = (
					'type_is_dhcp' => 'is DHCP',
					'is_empty_nonterminal' => 'is an empty domain',
					#'type_is_host' => 'is a host',
					#'type_is_nonterminal' => 'is a domain',
					'type_is_wildcard' => 'is a wildcard',
					);
				my @properties;
				for my $property (sort keys %property) {
					push(@properties,$property{$property}) if (defined($_->{$property}) && $_->{$property});
				}
				push(@properties,'is '.($_->{'is_empty_nonterminal'}?'an empty':'a').' '.$_->{'type'});
				# Die Statistikparameter has_rr, sub_fqdn_count des Objekttyps dns.fqdn wurden aus Performancegründen in den neuen Objekttyp dns.fqdn_statistic verlagert.
				#push(@properties,'has '.$_->{'sub_fqdn_count'}.' sub-FQDNs') if (defined($_->{'sub_fqdn_count'}) && $_->{'sub_fqdn_count'});
				my $property = pop(@properties);
				#print $_->{'label'},' ',join(' and ',@properties?join(', ',@properties):(),$property),".\n";
				print &chopp($_->{'value'}),' ',join(' and ',@properties?join(', ',@properties):(),$property),".\n";
				print 'Description: ',$_->{'description'},"\n" if (defined($_->{'description'}));
				print 'Zone: ',$_->{'zone'},"\n";
				print 'Has RRs in BCDs: ',join(', ',@{$_->{'rr_chain_target_bcd_list'}}),"\n" if (defined($_->{'rr_chain_target_bcd_list'}));
			}
		}
	}
}
