#!/usr/bin/perl
use v5.30;
use warnings;

use OpenBSD::Pledge;
use OpenBSD::Unveil;

# Copyright (c) 2021 Andrew Hewus Fresh <andrew@afresh1.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# To use this, you copy this to the vm-server,
# add something like this to your .ssh/config
# and then, `ssh vm-whatever` will connect to the vm-server
# which will then `ssh vm`.
#
# Host vm
#  RequestTTY yes
#  HostName vm-server
#  RemoteCommand /usr/sbin/vmctl-ssh %n

my %cmd = (
	ifconfig => '/sbin/ifconfig',
	ssh      => '/usr/bin/ssh',
	vmctl    => '/usr/sbin/vmctl',
);

unveil( $_, 'x' ) for values %cmd;
pledge( qw< proc exec > );

my ($host, @args) = @ARGV;
($host) = $host =~ /^([-.\w]+)$/ if $host; # untaint, but also security
die "Usage $0 vm" unless $host;

my $vmid = do {
	open my $fh, "-|", $cmd{vmctl}, show => $host
	    or die "Unable to spawn vmctl: $!";
	readline $fh; # header
	$_ = readline $fh;
	/^\s*(\d+)\s/ && $1 if $_;
};
die "Can't find VM $host\n" unless defined $vmid;

# vmd/priv.c says:
# * 1. Set the address prefix and mask, 100.64.0.0/10 by default.
# * 2. Encode the VM ID as a per-VM subnet range N, 100.64.N.0/24.

# Can't seem to ask vmctl for the prefix, so we assume the default.
my $vmnet  = ip2num("100.64.$vmid.0");
my $vmmask = 0xff_ff_ff_00;

# * 3. Assign a /31 subnet M per VM interface, 100.64.N.M/31.
# * Each subnet contains exactly two IP addresses; skip the
# * first subnet to avoid a gateway address ending with .0.

# Which means we could calculate what the IP it should be
# directly from the above vmnet, but instead we look on
# the TAP interfaces to find out whether we have
# IP that matches this available.

my @tap_ips =
    map { /\s(inet) (\S+) (netmask) (\S+)/ ? { @{^CAPTURE} } : () }
    do {
	open my $fh, "-|", $cmd{ifconfig}, 'tap'
	    or die "Unable to spawn ifconfig: $!";
	readline $fh;
    };

my $ip;
for (@tap_ips) {
	my $gw = ip2num( $_->{inet} );

	# Look for the first interface in vmnet for this vm
	next unless ( $gw & $vmmask ) == $vmnet;

	# Again from vmd/priv.c
	# * 4. Use the first address for the gateway, the second for the VM.
	my $vm = $gw + 1;
	my $nm = hex $_->{netmask};

	# Make sure the $vm ip is actually in the $gw network
	next unless ( $vm & $nm ) == ( $gw & $nm );

	$ip = num2ip($vm);
	last;
}

die "Unable to find IP for $host\n" unless $ip;

exec $cmd{ssh}, $ip, @args;
die "Unable to exec ssh $ip @args\n";

sub ip2num {
	my @o = split /\./, $_[0];
	return ( $o[0] << 24 )
	     + ( $o[1] << 16 )
	     + ( $o[2] <<  8 )
	     + ( $o[3] <<  0 );
}

sub num2ip { join '.', map { 0xff & $_[0] >> $_ } 24, 16, 8, 0 }

sub netmask2prefix {
	my $mask = shift;

	my $prefix = 32;
	my $full   = 2 ** $prefix - 1;

	$prefix-- while $prefix
	    && $mask != ( $full & $full << ( 32 - $prefix ) );

	return $prefix;
}