#!/usr/bin/perl -CSDA
# ip2mail v4.2.0  (c) 7.3.2022 by Andreas Ley  (u) 27.10.2025
# Gather admin mail adresses for IPs, optionally send mail

use strict;
#no strict 'vars';
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 feature 'state';
#use locale;

use Getopt::Long;
use File::Basename;
use File::Spec::Functions;
use Encode;
use MIME::QuotedPrint;
use Net::DNS;
use List::Util 'uniq';

use Data::Dumper;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Deepcopy = 1;
#&debug(__FILE__,__LINE__,Data::Dumper->Dump([\%hash],['*'])) if (defined($debug{'what'}) && $debug{'what'}>1);
#&debug(__FILE__,__LINE__,Data::Dumper->new([\%hash],['*'])->Indent(1)->Dump) if (defined($debug{'what'}) && $debug{'what'}>1);

my $sendmail = '/usr/sbin/sendmail';

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

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	print  STDERR  "Usage: $image [options] IP [...]\n";
	#print  STDERR  "-v, --verbose	Verbose mode (may be used several times)\n";
	#print  STDERR  "-q, --quiet	Quiet mode\n";
	print  STDERR  "-n, --dry-run	Dry run\n";
	print  STDERR  "-f, --from	Specify from mail address (defaults to EMAIL from environment or local user)\n";
	print  STDERR  "--cc		Add Cc: header\n";
	print  STDERR  "--bcc		Add Bcc: header\n";
	print  STDERR  "-s, --subject	Mail subject template\n";
	print  STDERR  "-c, --content	Mail content template\n";
	print  STDERR  "-l, --length	Line length for automatic line break\n";
	print  STDERR  "--start		Regular expression representing variable start delimiter, defaults to \"\\[%\\s*\"\n";
	print  STDERR  "--end		Regular expression representing variable end delimiter, defaults to \"\\s*%\\]\"\n";
	print  STDERR  "If at least a subject or a content template are specified, a mail is sent automatically for each IP supplied.\n"; 
	print  STDERR  "Templates can be specified either literally, as a dash \"-\" for reading STDIN (only one of them) or as an at-sign \"\@\" followed by a filename to read the template from a file.\n"; 
	print  STDERR  "Templates may use variables named IP, FQDN (contains the FQDN if resolvable, IP otherwise), IP_WITH_FQDN and FQDN_WITH_IP (which contain the second part in braces if the FQDN if resolvable).\n"; 
	print  STDERR  "Your NetVS-Token must be readable from $config\n" unless (-r $config);
	exit(1);
}

my %opt;
@_ = @ARGV unless (defined($Devel::Trace::TRACE));
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','quiet|q','dry-run|n','devel|N',
	'from|f=s','cc=s','bcc=s',
	'subject|s=s','content|c=s','length|l=i',
	'start=s','end=s') or &usage();
exec($^X,'-CSDA','-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

&usage() if (defined($opt{'help'}) ||
#	(defined($opt{'dry-run'}) && defined($opt{'devel'})) ||
	!@ARGV);
&usage() if (defined($opt{'subject'}) && $opt{'subject'} eq '-' && defined($opt{'content'}) && $opt{'content'} eq '-');
&usage() unless (-r $config);

if (defined($opt{'verbose'}) || defined($opt{'debug'}) || defined($opt{'trace'})) {
	$|=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.(@_>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
	if (defined($debug{'stacktrace'})) {
		use Carp 'longmess';
		{	no warnings 'once';
			$Carp::MaxArgLen = 0;
			$Carp::MaxArgNum = 0;
		}
		warn longmess('debug called');
	}
}
$debug{undef} = \&debug;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	if (defined($debug{'all'})) {
		my $skip = 1;
		open(SELF,'<',$0) or die "Can't read self $0: $!\n";
		while (<SELF>) {
			while (/\$debug\{'([^']+)'\}/g) {
				$debug{$1} = $debug{'all'} unless ($skip || defined($debug{$1}));
				$skip = 0 if ($1 eq 'ignore');
			}
		}
		close(SELF);
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*'])) if ($debug{'debug'}>0);
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*'])) if ($debug{'opt'}>0);
	if (defined($ENV{'TERM'})) {
		use Term::Cap;
		my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
		$on = $term->Tputs('md');
		$off = $term->Tputs('me');
	}
}

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

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

#my $from = $opt{'from'} // $ENV{'EMAIL'} // $ENV{'LOGNAME'}.'@sysmail.kit.edu';
my $from = $opt{'from'} // $ENV{'EMAIL'} // $ENV{'LOGNAME'};
my $cc = $opt{'cc'} if (defined($opt{'cc'}));
my $bcc = $opt{'bcc'} if (defined($opt{'bcc'}));

my ($subject,$content,$start,$end);
if (defined($opt{'subject'}) || defined($opt{'content'})) {
	$start = $opt{'start'} // qr/\[%\s*/;
	$end = $opt{'end'} // qr/\s*%\]/;
	$subject = defined($opt{'subject'}) ? &read_content($opt{'subject'}) : $start.'FQDN_WITH_IP'.$end;
	$content = &read_content($opt{'content'}) if (defined($opt{'content'}));
}

my $opt = NET::WebAPI->read_config($config) if (-s $config);
$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";

for my $ip (@ARGV) {
	&debug(__FILE__,__LINE__,$ip) if ($debug{'ip'}>0);
	my $json = $webapi->transaction([
		{
		'idx' => 'ip_subnet',
		'name' => 'nd.ip_subnet.list',
		'old' => {
			'cidr' => $ip,
			'cidr_operator' => 'smallest_cts',
			},
		},
		{
		'idx' => 'bcd',
		'name' => 'nd.bcd.list',
		'inner_join_ref' => {
			'ip_subnet' => 'default',
			},
		},
		{
		'idx' => 'bcd2group',
		'name' => 'nd.bcd2group.list',
		'inner_join_ref' => {
			'bcd' => 'default',
			},
		},
		{
		'idx' => 'group',
		'name' => 'cntl.group.list',
		'inner_join_ref' => {
			'bcd2group' => 'default',
			},
		},
		{
		'idx' => 'mgr2group',
		'name' => 'cntl.mgr2group.list',
		'inner_join_ref' => {
			'group' => 'default',
			},
		},
		{
		'idx' => 'mgr',
		'name' => 'cntl.mgr.list',
		'inner_join_ref' => {
			'mgr2group' => 'default',
			},
		},
	]);
	# FIXME: With 3.2, we can use /api/3.2/wapi/transaction/execute?dict_mode=true and then hopefully @{$json->{'mgr'}}
	my $to = join(',',uniq(map($_->{'email'},@{$json->[5]})));
	if (defined($subject)) {
		if ($opt{'dry-run'}) {
			print "$sendmail -i -t -f $from\n";
			open(MAIL,'>&',\*STDOUT) or die "Can't dup STDOUT: $!\n";
		}
		else {
			open(MAIL,'|-',$sendmail,'-i','-t','-f',$from) or die "Can't run $sendmail -i -t -f $from: $!\n";
			#open(MAIL,'|-',$sendmail,'-i','-f',$from,$from) or die "Can't run $sendmail -i -f $from $from: $!\n";
		}
		print MAIL "From: $from\n";
		print MAIL "To: $to\n";
		print MAIL "Cc: $cc\n" if (defined($cc));
		print MAIL "Bcc: $bcc\n" if (defined($bcc));
		print MAIL "MIME-Version: 1.0\n";
		print MAIL 'Subject: '.encode('MIME-Q',&template($subject,$ip))."\n";
		print MAIL "Content-Type: text/plain; charset=utf-8\n";
		print MAIL "Content-Transfer-Encoding: quoted-printable\n";
		if (defined($content)) {
			print MAIL "\n";
#use Devel::Peek; warn (utf8::is_utf8($content)?'true':'false'); Dump($content);
			# Encode from (internal) Unicode to Content-Type (utf-8) then to Content-Transfer-Encoding (quoted-printable)
			my $text = &template($content,$ip);
			$text = join("\n",map(&lbreak($opt{'length'},$_),split("\n",$text))) if (defined($opt{'length'}));
			print MAIL encode_qp(Encode::encode_utf8($text));
		}
		close(MAIL);
	}
	else {
		print "$to\n";
	}
}

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

	if ($template eq '-') {
		local $/;
		$template = <STDIN>;
	}
	elsif ($template =~ /^@/) {
		open(FILE,'<',$') or die "Can't read $': $!\n";
		local $/;
		$template = <FILE>;
		close(FILE);
	}

	&debug(__FILE__,__LINE__,'+ &read_content = '.$template) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'read_content'}) && $debug{'read_content'}>1);
	return($template);
}

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

	my $text;
	while ($template =~ /$start([A-Z_]+)$end/) {
		$text .= $`;
		$template = $';
		if ($1 eq 'IP') {
			$text .= $ip;
		}
		else {
			my $fqdn = &fqdn($ip);
			if ($1 eq 'FQDN') {
				$text .= $fqdn // $ip;
			}
			elsif ($1 eq 'IP_WITH_FQDN') {
				$text .= defined($fqdn) ? "$ip ($fqdn)" : $ip;
			}
			elsif ($1 eq 'FQDN_WITH_IP') {
				$text .= defined($fqdn) ? "$fqdn ($ip)" : $ip;
			}
		}
	}
	$text .= $template;

	&debug(__FILE__,__LINE__,'+ &template = '.$text) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'template'}) && $debug{'template'}>1);
	return($text);
}

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

	state $res = Net::DNS::Resolver->new; # ->debug(defined($debug{'dns'}));
	state %fqdn;

	unless (exists($fqdn{$ip})) {
		print "Resolving $ip …\n" if (defined($opt{'verbose'}));
		my $reply = $res->query($ip);
		&debug(__FILE__,__LINE__,'&fqdn: reply = '.Data::Dumper->Dump([\$reply],['*'])) if (defined($debug{'fqdn'}) && $debug{'fqdn'}>2);
		if (defined($reply)) {
			&debug(__FILE__,__LINE__,'&fqdn: reply->answer = '.Data::Dumper->Dump([\$reply->answer],['*'])) if (defined($debug{'fqdn'}) && $debug{'fqdn'}>3);
			# Yes, there can be only one PTR, but this way we trigger overloading the right way
			$fqdn{$ip} = $_->ptrdname for ($reply->answer);
		}
		else {
			$fqdn{$ip} = undef;
		}
	}

	&debug(__FILE__,__LINE__,'+ &fqdn = '.$fqdn{$ip}) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'fqdn'}) && $debug{'fqdn'}>1);
	return($fqdn{$ip});
}

sub lbreak
{
	my ($length,$text,$indent) = @_;

	my $len = $length - length($indent);
	my ($out);
	while (length($text) > $len) {
#&debug(__FILE__,__LINE__,$len,substr($text,0,$len+1));
		if (substr($text,0,$len+1) =~ /\s+(\S*)$/) {
			$out .= $indent.$`."\n";
			$text = $1.substr($text,$len+1);
		}
		else {
			$out .= $indent.substr($text,0,$len)."\n";
			$text = substr($text,$len);
		}
		$indent = " " x length($indent);
	}
	return($out.$indent.$text);
}
