#!/usr/bin/perl
#
# Copyright (c) 2015  Peter Pentchev
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use v5.12;
use strict;
use warnings;

use Digest::SHA1 qw/sha1_hex/;
use Getopt::Std;
use JSON::PP;
use Net::SixXS::Data::Tunnel;
use POSIX qw/:sys_wait_h/;

my $debug = 0;
my ($tempfile, $tempname);

sub debug($);
sub usage($);
sub version();

sub get_ayiya(;$);
sub ngctl_list();
sub ngctl($ @);
sub run_command(@);
sub check_wait_result($ $ $);
sub get_tic_tunnel($);
sub setup_node($ $);
sub setup_inet6($ $);
sub setup_ayiya($ $; $);
sub ensure_inet_aliases($ @);

sub cmd_help($ @);
sub cmd_setup($ @);
sub cmd_shutdown($ @);
sub cmd_status($ @);
sub cmd_version($ @);
sub cmd_inet6($ @);
sub cmd_two($ @);

my %cmds = (
	ayiya => \&cmd_ayiya,
	build => \&cmd_setup,
	erect => \&cmd_setup,
	help => \&cmd_help,
	inet6 => \&cmd_inet6,
	setup => \&cmd_setup,
	shutdown => \&cmd_shutdown,
	teardown => \&cmd_shutdown,
	two => \&cmd_two,
	status => \&cmd_status,
	version => \&cmd_version,
);

MAIN:
{
	my %opts;

	getopts('hVv', \%opts) or usage(1);
	version() if $opts{V};
	usage 0 if $opts{h};
	exit 0 if $opts{V} || $opts{h};
	$debug = $opts{v};

	usage 1 unless @ARGV;
	my $cmd = shift @ARGV;
	my $handler = $cmds{$cmd};
	if (!defined $handler) {
		say STDERR "Invalid command '$cmd'";
		usage 1;
	} else {
		$handler->($cmd, @ARGV);
	}
}

sub usage($)
{
	my ($err) = @_;
	my $s = <<EOUSAGE
Usage:	scaffold ayiya tunnelname
	scaffold help
	scaffold inet6 tunnelname
	scaffold [-v] setup
	scaffold [-v] shutdown [all]
	scaffold [-v] status
	scaffold [-v] two
	scaffold -V | -h

	-h	display program usage information and exit
	-V	display program version information and exit
	-v	verbose operation; display diagnostic output
EOUSAGE
	;

	if ($err) {
		die $s;
	} else {
		print "$s";
	}
}

sub version()
{
	say 'scaffold 0.1.0';
}

sub debug($)
{
	say STDERR "RDBG $_[0]" if $debug;
}

sub check_wait_result($ $ $)
{
	my ($stat, $pid, $name) = @_;

	if (WIFEXITED($stat)) {
		if (WEXITSTATUS($stat) != 0) {
			die "Program '$name' (pid $pid) exited with ".
			    "non-zero status ".WEXITSTATUS($stat)."\n";
		}
	} elsif (WIFSIGNALED($stat)) {
		die "Program '$name' (pid $pid) was killed by signal ".
		    WTERMSIG($stat)."\n";
	} elsif (WIFSTOPPED($stat)) {
		die "Program '$name' (pid $pid) was stopped by signal ".
		    WSTOPSIG($stat)."\n";
	} else {
		die "Program '$name' (pid $pid) neither exited nor was ".
		    "it killed or stopped; what does wait(2) status $stat ".
		    "mean?!\n";
	}
}

sub cmd_help($ @)
{
	usage 0;
}

sub cmd_version($ @)
{
	version;
}

sub cmd_status($ @)
{
	my ($cmd, @args) = @_;

	if (@args) {
		say STDERR "The 'status' command does not need any arguments";
		usage 1;
	}

	my $ay = get_ayiya;
	my @all = @{$ay->{all}};
	if (!@all) {
		say 'No AYIYA nodes configured';
		return;
	}
	say scalar(@all).' AYIYA node'.(@all == 1? '': 's').' found'.
	    (@all? ': '.(join ', ', map "[$_->{id}] $_->{name}", @all): '');
	my $node = $ay->{ours};
	if (!defined $node) {
		say "Ours is not there";
		return;
	}
	say "Ours is there: [$node->{id}] $node->{name}";
	# TODO: config, status, hooks, interfaces
}

sub shutdown_node($)
{
	my ($node) = @_;

	for (grep defined, @{$node->{config}->{hooks}}{qw/ayiya inet6/}) {
		ngctl 'shutdown', "[$_->{id}]:";
	}
	ngctl 'shutdown', "[$node->{id}]:";
}

sub cmd_shutdown($ @)
{
	my ($cmd, @args) = @_;

	my $all;
	if (@args == 1 && $args[0] eq 'all') {
		$all = 1;
	} elsif (@args) {
		say STDERR "Invalid arguments to 'shutdown'";
		usage 1;
	}

	my $ay = get_ayiya;
	if ($ay->{ours}) {
		debug "Shutting down our node $ay->{ours}->{id}";
		shutdown_node $ay->{ours};
	} else {
		say "Our node not found";
	}
	if ($all) {
		debug "Shutting down ".scalar(@{$ay->{others}}).
		    " other node(s)";
		for (@{$ay->{others}}) {
			debug "- $_->{id}";
			shutdown_node $_;
		}
	}

	if ((run_command 'kldstat') =~ /ng_ayiya\.ko/) {
		run_command 'make', 'unload';
	} else {
		debug "The ng_ayiya.ko module is not even loaded";
	}
}

sub cmd_setup($ @)
{
	my ($cmd, @args) = @_;

	if (@args) {
		say STDERR "The 'status' command does not need any arguments";
		usage 1;
	}

	if ((run_command 'kldstat') !~ /ng_ayiya\.ko/) {
		debug "Trying to build the ng_ayiya.ko module";
		debug run_command 'env', 'CFLAGS=-O0', 'DEBUG_FLAGS=-g', 'make', 'depend';
		debug run_command 'env', 'CFLAGS=-O0', 'DEBUG_FLAGS=-g', 'make';
		debug "Trying to load the ng_ayiya.ko module";
		run_command 'make', 'load';
	} else {
		debug "The ng_ayiya.ko module seems to be loaded already";
	}

	my $ay = get_ayiya;
	if (!$ay->{ours}) {
		$ay = setup_node $ay, '';
	} else {
		debug "Our node already there";
	}

	# TODO: interfaces, hooks...
	debug "Setup complete, our node is ".
	    "[$ay->{ours}->{id}] $ay->{ours}->{name}";
}

sub setup_node($ $)
{
	my ($ay, $suffix) = @_;

	my %found = map { ($_->{id}, 1) } @{$ay->{all}};

	debug "Creating a new AYIYA node";
	ngctl 'mkpeer', 'ayiya', 'a', 'control/create';
	$ay = get_ayiya $suffix;
	my @new = map $_->{id}, @{$ay->{all}};
	debug "Looking for an ID in (".join(' ', sort @new).
	    ") that's not in (".join(' ', sort keys %found).")";
	my $id;
	for (@new) {
		if (!defined $found{$_}) {
			$id = $_;
			last;
		}
	}
	if (!defined $id) {
		die "Internal error: no new AYIYA nodes\n";
	}
	debug "- found $id";
	ngctl 'name', "[$id]:", "sc_ayiya$suffix";
	$ay = get_ayiya $suffix;
	if (!$ay->{ours} || $ay->{ours}->{id} ne $id) {
		die "Internal error: get_ayiya() did not recognize ".
			"node [$id] as ours\n";
	}
	return $ay;
}

sub get_ayiya(;$)
{
	my ($suffix) = @_;
	$suffix //= '';

	my $nodes = ngctl_list;
	my $res = {
		all => $nodes->{type}{ayiya} // [],
		ours => undef,
		others => [],
	};
	my $nm = "sc_ayiya$suffix";
	debug "Got ".scalar(@{$res->{all}})." AYIYA node(s), looking for $nm";
	for my $node (@{$res->{all}}) {
		my $name = "[$node->{id}] '$node->{name}'";
		my $js = ngctl 'config', "[$node->{id}]:";
		$js =~ s/\A[^{]*//s;
		debug "- got ".length($js)." characters of JSON for node $name";
		my $d;
		eval {
			$d = decode_json $js;
		};
		my $err = $@;
		if (length ($err // '') || !defined($d) || ref $d ne 'HASH' ||
		    grep !exists $d->{$_}, qw/id name configured hooks/) {
			warn "Node [$node->{id}] '$node->{name}' returned ".
			    "an invalid JSON configuration\n";
			next;
		}
		$node->{config} = $d;
		if ($node->{name} eq $nm) {
			if (defined $res->{ours}) {
				die "Inconsistent Netgraph configuration: ".
				    "duplicate name '$nm' for nodes ".
				    "[$res->{ours}->{id}] and [$node->{id}]\n";
			}
			$res->{ours} = $node;
			debug "  - ours!";
		} else {
			push @{$res->{others}}, $node;
		}
	}
	return $res;
}

sub ngctl_list()
{
	my $s = ngctl 'list';

	my %nodes;
	my @lines = split /\n+/, $s;
	for (@lines) {
		if (/^\s*Name:\s*(\S+)\s+Type:\s*(\S+)\s+ID:\s*0*(\S+)\s+Num hooks:\s*(\S+)\s*$/) {
			my ($name, $type, $id, $hooks) = ($1, $2, $3, $4);
			my $node = {
				name => $name,
				type => $type,
				id => $id,
				num_hooks => $hooks,
			};
			$nodes{id}{$id} = $node;
			push @{$nodes{type}{$type}}, $node;
			if ($name ne '<unnamed>') {
				$nodes{name}{$name} = $node;
			}
		}
	}
	return \%nodes;
}

sub ngctl($ @)
{
	my ($cmd, @args) = @_;

	return run_command 'ngctl', $cmd, @args;
}

sub run_command(@)
{
	my @cmd = @_;
	debug "About to run @cmd";
	my $pid = open(my $pipe, '-|');
	if (!defined $pid) {
		die "Could not fork for '@cmd': $!\n";
	} elsif ($pid == 0) {
		exec { $cmd[0] } @cmd;
		die "Could not run '@cmd': $!\n";
	}

	my $output;
	{
		local $/;
		$output = <$pipe>;
	}
	my $res = close $pipe;
	my $msg = $!;
	my $status = $?;
	check_wait_result $status, $pid, "@cmd";
	if (!$res) {
		die "Some error occurred closing the pipe from '@cmd': $msg\n";
	}
	return $output;
}

sub cmd_inet6($ @)
{
	my ($cmd, @args) = @_;

	if (@args != 1) {
		warn "The inet6 command expects a tunnel name parameter\n";
		usage 1;
	}

	setup_inet6 '', get_tic_tunnel shift @args;
	# FIXME: Add a default route here, too.
}

sub setup_inet6($ $)
{
	my ($suffix, $t) = @_;

	my $ayiya = get_ayiya $suffix;
	if (!$ayiya->{ours}) {
		die "Our ng_ayiya node is not configured\n";
	}
	# Tear down the interface if it's configured
	my $c = $ayiya->{ours}->{config};
	my $i6 = $c->{hooks}->{inet6};
	if (defined $i6) {
		debug "Shutting down the current interface";
		ngctl 'shutdown', "[$i6->{id}]:";
	}

	# OK, let's create one
	my $hkname = 'inet6/'.$t->id;
	ngctl 'mkpeer', "$c->{name}:", 'iface', $hkname, 'inet6';
	$ayiya = get_ayiya $suffix;
	my $iface = $ayiya->{ours}->{config}->{hooks}->{inet6}->{name};
	if (!defined $iface) {
		die "Could not query the newly-created ng_iface node\n";
	}

	run_command 'ifconfig', $iface, 'inet6', $t->ipv6_local;
}

sub get_tic_tunnel($)
{
	my ($tunnel) = @_;

	my $fname = 'tic-tunnels.txt';
	open my $f, '<', $fname or
	    die "Could not open $fname: $!\n";
	my $in;
	my %cfg;
	while (<$f>) {
		s/[\r\n]*$//;
		if ($in) {
			last unless /^\s+(\S[^:]+?)\s*:\s*(.*?)\s*$/;
			my ($k, $v) = ($1, $2);
			if (exists $cfg{$k}) {
				die "Duplicate key $k for $tunnel in $fname\n";
			}
			$cfg{$k} = $v;
		} elsif ($_ eq $tunnel) {
			$in = 1;
		}
	}
	close $f or die "Could not close $fname: $!\n";
	if (!%cfg) {
		if ($in) {
			die "No key/value lines for $tunnel in $fname\n";
		} else {
			die "No tunnel $tunnel defined in $fname\n";
		}
	}
	return Net::SixXS::Data::Tunnel->from_json(\%cfg);
}

sub cmd_ayiya($ @)
{
	my ($cmd, @args) = @_;

	if (@args != 1) {
		warn "The ayiya command expects a tunnel name parameter\n";
		usage 1;
	}

	setup_ayiya '', get_tic_tunnel shift @args;
}

sub setup_ayiya($ $; $)
{
	my ($suffix, $t, $localaddr) = @_;

	my $ayiya = get_ayiya $suffix;
	if (!$ayiya->{ours}) {
		die "Our ng_ayiya node is not configured\n";
	}
	# Tear down the socket if it's configured
	my $c = $ayiya->{ours}->{config};
	my $sa = $c->{hooks}->{ayiya};
	if (defined $sa) {
		debug "Shutting down the current socket";
		ngctl 'shutdown', "[$sa->{id}]:";
	}

	# Initialize the shared secret
	my $p = sha1_hex($t->password);
	$p =~ s/(..)/0x$1, /g;
	$p = "[ $p ]";
	ngctl 'msg', "$c->{name}:", 'secrethash', $p;
	# OK, let's create one
	my $hkname = 'ayiya/'.$t->id;
	my $hkpeer = 'inet/dgram/udp';
	my $pname = "sc_conn$suffix";
	ngctl 'mkpeer', "$c->{name}:", 'ksocket', $hkname, $hkpeer;
	ngctl 'name', "$c->{name}:$hkname", $pname;
	$ayiya = get_ayiya $suffix;
	$c = $ayiya->{ours}->{config};
	if (!defined $c || $c->{hooks}->{ayiya}->{name} ne $pname) {
		die "Could not query the newly-created ng_ksocket node\n";
	}
	if (!defined $localaddr && defined $t->ipv4_local &&
	    $t->ipv4_local =~ /^\d+(\.\d+)+$/) {
		$localaddr = $t->ipv4_local;
	}
	if (defined $localaddr) {
		ngctl 'msg', "$pname:", 'bind', "inet/$localaddr:5072";
	}
	ngctl 'msg', "$pname:", 'connect', 'inet/'.$t->ipv4_pop.':5072';

	debug "Trying to get the node to configure itself";
	ngctl 'msg', "$c->{name}:", 'configure';
}

sub cmd_two($ @)
{
	my ($cmd, @args) = @_;

	if (@args) {
		say STDERR "The 'two' command does not need any arguments\n";
		usage 1;
	}

	cmd_setup 'setup';

	my $client = get_ayiya;
	if (!$client->{ours}) {
		die "Our ng_ayiya node is not configured\n";
	}

	my $server = get_ayiya '_s';
	if (!$server->{ours}) {
		debug "Setting up the server node";
		$server = setup_node $server, '_s';
		debug "Got a server node: [$server->{ours}->{id}] ".
		    "'$server->{ours}->{name}'";
	}

	my ($client6, $server6) = ('fec0::1', 'fec0::2');
	my ($client4, $server4) = ('127.0.13.1', '127.0.13.2');
	ensure_inet_aliases 'lo0', $client4, $server4;

	my %defs = (
		TunnelId => 'T00001',
		Password => 'secret',
		Type => 'AYIYA',
	);
	my $cli_tun = Net::SixXS::Data::Tunnel->from_hash({
		%defs,
		'IPv6 Endpoint' => $client6,
		'IPv6 POP' => $server6,
		'IPv4 POP' => $server4,
	});
	my $srv_tun = Net::SixXS::Data::Tunnel->from_hash({
		%defs,
		'IPv6 Endpoint' => $server6,
		'IPv6 POP' => $client6,
		'IPv4 POP' => $client4,
	});

	setup_inet6 '', $cli_tun;
	setup_inet6 '_s', $srv_tun;

	setup_ayiya '', $cli_tun, $client4;
	setup_ayiya '_s', $srv_tun, $server4;
}

sub ensure_inet_aliases($ @)
{
	my ($iface, @addresses) = @_;
	
	my $all = 1;
	my $config = run_command 'ifconfig', $iface;
	for my $addr (@addresses) {
		debug "Checking $iface for $addr";
		if (index($config, $addr) == -1) {
			undef $all;
			debug "- nope, trying to bring it up";
			run_command 'ifconfig', $iface, 'inet', $addr,
			    'netmask', '0xffffffff', 'alias';
		}
	}
	return if $all;

	# Now check...
	$config = run_command 'ifconfig', $iface;
	my @missing = grep { index($config, $_) == -1 } @addresses;
	if (@missing) {
		die "Could not bring up @missing on $iface\n";
	}
}