#!/usr/bin/perl
#
# Create persistant, transparent tcp-over-ssh port forward
# Usage: porthole <FWDPort> <RemoteHost>
#

use strict;
use warnings;
use English;
use IO::Socket::INET;
use POSIX;
use User::pwent;
use User::grent;
use Data::Dumper;
use File::Basename;
use Term::ANSIColor;

$0 = basename(__FILE__);

my $BOLD = color("bold white");
my $RBOLD = color("bold red");
my $NORM = color("reset");

my $helpme = <<"EOT";

${BOLD}USAGE${NORM}: $0 [<port-to-forward>]:<target-host>[:<ssh-port>]

  Where

      <port-to-forward> - The TCP port to be forwarded over the ssh tunnel (Default 10050)
      <target-host>     - The name or address of the host to forward to
      <ssh-port>        - The port the target-host listens for ssh on (Default 22)

  When used via systemctl the unit instance should be the same as above, e.g.

      systemctl enable $0\@10051:remote.example.com:222

EOT

my $LocalAddr  = '127.0.0.1';
my $SSHUser    = 'zabbix-vpn';

my $FWDPort    = 10050;
my $RemoteHost = undef;
my $SSHPort    = 22;

if (@ARGV == 1 && $ARGV[0] =~ m/^(-[h?]|--(help|usage))$/) {
   print "$helpme";
   exit(1);
# Split the arguments in positional variables using capture groups
# Default values for FWDPort and SSHPort are used if not provided
} elsif (@ARGV == 1 && $ARGV[0] =~ m/^(?:(\d+):)?([^:]+)(?::(\d+))?$/) {
   $FWDPort    = $1 || 10050;
   $RemoteHost = $2 || undef;
   $SSHPort    = $3 || '22';
# Print the help message if there are no arguments
} elsif (@ARGV == 0) {
   print "$helpme";
   exit(1);
}

# The RemoteHost (target) argument is mandatory
if (!defined $RemoteHost || $RemoteHost !~ m/^[-_.0-9a-zA-Z]+$/) {
        print STDERR "${RBOLD}\nERROR: Incorrect usage\n${NORM}",;
        print "$helpme";
        exit(2);
}

# Resolve the UID of the SSH user (as a blessed object courtesy of User::pwent)
my $SSHPWENT = getpwnam($SSHUser) or die "Unable to resolve $SSHUser account details: $@";

# Make sure we have an IP (rather than a hostname) for the remote system
# DONE: Support multi-ip remote hosts
my @addrs = gethostbyname($RemoteHost) or die "Failed to resolve IPv4 address from '$RemoteHost': $@" ;
my @RemoteAddrs = map { inet_ntoa($_) } @addrs[4 .. $#addrs];

# Port 0 bind gives a kernel allocated free ephemeral port
my $TCPSocket = IO::Socket::INET->new(
	LocalAddr => $LocalAddr,
	LocalPort => 0,
	Proto     => 'tcp'
);

# Find out what port number we got
my $LocalPort = $TCPSocket->sockport();

# Make sure that our intercept chain exists and is called
# TODO: Check before inserting firewalld spews to the journal on duplicates....
qx(firewall-cmd --quiet --direct --add-chain ipv4 nat PORTHOLE >/dev/null 2>/dev/null);
die "Unable to create nat chain: $@" unless $? == 0;
qx(firewall-cmd --quiet --direct --add-rule ipv4 nat OUTPUT 5 -j PORTHOLE -m comment --comment "PORTHOLE ssh tunnel intercept dispatcher" >/dev/null 2>/dev/null);
die "Unable to call nat chain: $@" unless $? == 0;

# Nuke any old intercept rule(s) for this destination
$_ = qx(firewall-cmd --direct --get-rules ipv4 nat PORTHOLE);
foreach my $ip(@RemoteAddrs) {
	my @RULES = split(/\n/);
	for my $rule (@RULES) {
		if ($rule =~ m/ -d $ip -p tcp --dport $FWDPort /) {
			qx(firewall-cmd --direct --remove-rule ipv4 nat PORTHOLE $rule);
			die "Unable to remove existing intercept rule '$rule': $@" unless $? == 0;
		}
	}
}

# Free up our ephermeral port so ssh can use it
$TCPSocket->close();

# Launch the ssh-port forward as the target user, ssh uses the real UID so we can't just change EUID
my $pid = fork();
my $_cleanup_done = 0;
if ($pid > 0) {
	# Parent
	# Set up our new intercept rule and cleanup handler for it
	$SIG{'INT'} = \&cleanup;
	$SIG{'KILL'} = \&cleanup;
	$SIG{'TERM'} = \&cleanup;
	# Loop through each IP we have resolved
	foreach my $ip(@RemoteAddrs) {
		qx(
        		firewall-cmd --direct --add-rule ipv4 nat PORTHOLE 500 -d $ip -p tcp --dport $FWDPort -j DNAT --to-dest $LocalAddr:$LocalPort -m comment --comment "porthole[$$] $RemoteHost:$FWDPort"
		);
	}
	die  "Unable to insert intercept rule: $@" unless $? == 0;
	waitpid($pid, 0);
	cleanup();
} elsif ($pid == 0) {
	# Child

	# Find supplementary group memberships by checking all groups
	# returned by getent to see if we are a member of them
	my $grent = undef;	
	my @groups = ();
	do {
		$grent = getgrent();
		if ($grent && $SSHPWENT->name ~~ $grent->members) {
			push(@groups, $grent->gid);
		}
	} until (! $grent);

	# perl has no native setgroups(), but setting $EGID calls setegid() + setgroups();
	# Note that the setgid() is still required in order to set the real (rather than just effective gid)
	# and really drop privileges and ordering matters here!
	$EGID = ($SSHPWENT->gid, @groups);
	setgid($SSHPWENT->gid);
	setuid($SSHPWENT->uid);
	$ENV{'HOME'    } = $SSHPWENT->dir;
	$ENV{'USER'    } = $SSHPWENT->name;
	$ENV{'LOGNAME' } = $SSHPWENT->name;
	$ENV{'USERNAME'} = $SSHPWENT->name;
	exec(qq(/bin/ssh -q4NL $LocalPort:localhost:$FWDPort -p $SSHPort $RemoteHost)) or die "Unable to start ssh tunnel: $@\n";
	#exec(qq(/sbin/runuser -u zabbix-vpn -- /bin/ssh -q4NL $LocalPort:localhost:$FWDPort $RemoteHost)) or die "Unable to start ssh tunnel: $@\n";
} else {
	die "Fork failed: $@";
}

#print $_cleanup_done;
sub cleanup {
	# Remove our intercept rule (but only the first time we are called)
	if ($_cleanup_done == 0) {
		foreach my $ip(@RemoteAddrs) {
			qx(
				firewall-cmd --direct --remove-rule ipv4 nat PORTHOLE 500 -d $ip -p tcp --dport $FWDPort -j DNAT --to-dest $LocalAddr:$LocalPort -m comment --comment "porthole[$$] $RemoteHost:$FWDPort"
			);
			die "Unable to delete intercept rule: $@" unless $? == 0;
			$_cleanup_done = 1;
		}
	}
}
