#!/usr/bin/perl
=pod

=head1 NAME

ssh_tunnel	 - Create an SSH tunnel and make sure it stays there

=head1 SYNOPSIS

ssh_tunnel options

  Options:
    -d                    become a daemon
    --uid                 UID to run as
    --gid                 GID to run as
    --bind-address        IP address to bind to locally; default 127.0.0.1
    --port                port to listen on; default 2222
    --proxy-address       address of the ssh proxy server
    --proxy-port          port ssh proxy server is listening on
    --proxy-user          user to log in as if not default user
    --remote-host         address of the host the proxy should connect to
    --remote-port         port on the remote host the proxy should connect to
    --with-ssh            path to the ssh executable; default /usr/bin/ssh
    --help                this message; use perldoc for complete docs
    --verbose             use verbose logging
    --pidfile             pid file to write

=head1 DESCRIPTION

This program will fork a child process and execute an SSH tunnel using the 
supplied configuration.  The parent process will monitor the child, and 
restart the SSH tunnel whenever it is killed or dropped.  Logging is done 
via the syslog 'daemon' facility.

=head1 EXAMPLE

Given the following hypothetical scenario:
  * An SMTP server behind a firewall or NAT layer (relay.internal.automagick.us)
  * An SSH host on the border of that network (proxy.automagick.us)

In order to send email through the relay, we create a tunnel through the SSH host 
to the relay host:

ssh_tunnel --bind-address=127.0.0.1 --port=5023 \ 
           --proxy-user=proxyuser --proxy-address=proxy.automagick.us --proxy-port=22 \ 
           --remote-host=relay.internal.automagick.us --remote-port=25 -d

This assumes that I<proxyuser> exists on proxy.automagick.us, and has authorized a key  
for the user invoking the daemon.

We can now point our mail client at localhost, port 5023 to send email; if our network connection 
drops (say because we're moving from one public wifi hotspot to another), ssh_tunnel will detect this 
and automatically restart the tunnel.  Killing the daemon will shut down the tunnel.

=head1 VERSION

This is version 1.0 of ssh_tunnel.

=head1 TO DO

  * Should probably do a little more checking of proxy and remote host address/port info 
	instead of blindly assuming they're valid and reachable.

  * Add support for specifying alternative ssh config, keys, certs, etc.

=head1 AUTHOR

Greg Boyington <greg@automagick.us>

=cut

use strict;
use Symbol;
use POSIX;
use POSIX qw/:sys_wait_h/;
use Getopt::Long;;
use Pod::Usage;
use Sys::Syslog;
use English '-no_match_vars';

use vars qw/
	$tunnel_pid $SYSLOG_IDENT $SYSLOG_FACILITY $NORESTART $VERSION
	$SYSLOG_IDENT $SYSLOG_FACILITY $TIMEOUT $LISTEN $BIND_IP
	$PROXY_HOST $PROXY_PORT $PROXY_USER $REMOTE_HOST $REMOTE_PORT
	$SSH_CMD $VERBOSE $UID $GID $PID_FILE
/;

# we will override die and warn to use syslog
use subs 'die', 'warn';

$VERSION=1.0;

$NORESTART=0;

$SYSLOG_IDENT 	 = 'ssh_tunnel';
$SYSLOG_FACILITY = 'daemon';

# local daemon configuration
$TIMEOUT = 30;
$LISTEN  = 2222;
$BIND_IP = '127.0.0.1';

# ssh proxy configuration
$PROXY_HOST	= '';
$PROXY_PORT	= '';
$PROXY_USER	= '';

# remote host configuration
$REMOTE_HOST = '';
$REMOTE_PORT = '';

# where is ssh?
$SSH_CMD = '/usr/bin/ssh';

# make noise?
$VERBOSE = 0;

# parse the command-line args
my $daemonize = 0;
my $help=0;
GetOptions(
	"bind-address|b=s"	=> \$BIND_IP,
	"port|p=s"			=> \$LISTEN,
	"proxy-address=s"	=> \$PROXY_HOST,
	"proxy-port=s"		=> \$PROXY_PORT,
	"proxy-user=s"		=> \$PROXY_USER,
	"remote-host=s"		=> \$REMOTE_HOST,
	"remote-port=s"		=> \$REMOTE_PORT,
	'with-ssh=s'		=> \$SSH_CMD,
	'verbose'			=> \$VERBOSE,
	'uid=s'				=> \$UID,
	'gid=s'				=> \$GID,
	'pidfile=s'			=> \$PID_FILE,
	"d"					=> \$daemonize,
	'help'				=> \$help
) or pod2usage(2);
pod2usage(1) if $help;

unless ( $PROXY_HOST && $PROXY_PORT && $PROXY_USER && $REMOTE_HOST && $REMOTE_PORT )  {
	print "Error: Creating a tunnel requires a proxy host, proxy port, proxy user, remote host and remote port.\n";
	pod2usage(2);
}

# drop privileges
if ( $UID || $GID ) {
	$EUID = $UID if $UID;
	$EGID = $GID if $GID;
	die "Cannot drop privileges!"
		unless $UID == $EUID && $GID eq $EGID;
	$ENV{'PATH'} = "/bin:/usr/bin";
}

# daemonize, if requested
if ( $daemonize ) { 
	print "Becoming a daemon...\n" if $VERBOSE;
	fork && exit;
}

# write the pid file
open (OUT, '>' . $PID_FILE )
	or die "EUID $EUID Couldn't open pid file for writing: $!";
print OUT $$
	or die "Couldn't write pid file: $!";
close OUT;

# override standard warn and die with syslog calls
sub warn {
	openlog ($SYSLOG_IDENT, 'pid,cons', $SYSLOG_FACILITY );
	syslog 'info', @_;
	closelog();
	CORE::warn @_ if $VERBOSE;
	return 1;
}
sub die {
	openlog ($SYSLOG_IDENT, 'pid,cons', $SYSLOG_FACILITY );
	syslog 'err', @_;
	closelog();
	CORE::die @_;
	
}

# Make sure the port isn't already in use
# XXX: This is technically a race condition, as something might 
#      bind to the port between now and the exec() later, but 
#	   but it will serve.
my $bound = `lsof -ni :$LISTEN | grep $BIND_IP`;
die "$BIND_IP:$LISTEN is already in use; exiting\n"
	if $bound;

# whenever the child process exits, start a new tunnel 
# (unless the child process exits because we told it to)
sub REAPER {
	1 until ( -1 == waitpid( -1, WNOHANG ) );
	$SIG{'CHLD'} = \&REAPER;
	unless ( $NORESTART ) {
		warn "tunnel process $tunnel_pid exited; restarting...\n";
		sleep 3;
		$tunnel_pid = &setup_tunnel;
	}
}
$SIG{'CHLD'} = \&REAPER;

# Intercept signals to make sure we handle the child process properly
$SIG{'INT'} = 'INT';
$SIG{'HUP'} = 'HUP';
$SIG{'TERM'} = 'TERM';

sub INT {
	warn "Interrupt detected; sending SIGINT to $tunnel_pid\n";
	$NORESTART=1;
	kill 15, $tunnel_pid;
	exit 1;
}

sub HUP {
	warn "HUP detected; sending SIGTERM to $tunnel_pid and restarting\n";
	$NORESTART=1;
	kill 15, $tunnel_pid;
	exec $0;
}

sub TERM {
	warn "$0 shutting down" if $VERBOSE;
	$NORESTART=1;
	kill 15, $tunnel_pid;
	exit 1;
}

# start the tunnel
$tunnel_pid = &setup_tunnel;

# parent does nothing but sit and wait for signals
sleep 1 while 1;
exit 0;

######################################################################
#
# setup_tunnel()
#	- fork a child process and exec ssh to make the tunnel
#
#	parent process returns child process id; child exits
#
######################################################################
sub setup_tunnel() {
	my $pid;
	my $sigset;

	# block SIGINT from killing our fork
	$sigset = POSIX::SigSet->new(SIGINT);
	sigprocmask( SIG_BLOCK, $sigset );

	# fork the child process
	die "fork: $!" unless defined( $pid = fork() );

	# unblock sigints
	$SIG{'INT'} = 'INT';
	sigprocmask(SIG_UNBLOCK, $sigset)
		or die "Couldn't unblock SIGINT for fork: $!\n";
		
	# parent is all done
	return $pid if $pid;

	warn "Starting tunnel on $BIND_IP:$LISTEN to proxy $PROXY_HOST:$PROXY_PORT for $REMOTE_HOST:$REMOTE_PORT\n"
		if $VERBOSE;

	# child execs the ssh tunnel
	exec $SSH_CMD, 
		'-p', $PROXY_PORT, 
		'-NL', $BIND_IP . ':' . $LISTEN . ':' . $REMOTE_HOST . ':' . $REMOTE_PORT, 
		$PROXY_USER . '@' . $PROXY_HOST;
	exit 0;
}