#!/usr/bin/perl

use IO::Socket;
use IO::Select;
use IPC::Open2;
use Getopt::Std;
use POSIX;
use strict;

my $MAXPACKETLEN = 65535;

#
# sprox.pl
# make an HTTPS connection to an
# Apache server running mod_proxy
#

# subs
sub print_help;
sub REAPER;
sub HUNTER;

# variables
my ($srv_skt, %children, %opts);

# get the commandline arguments
getopts('hDr:p:l:x:', \%opts);
# print help if requested or if no host specified
if ($opts{'h'} || !$opts{'r'}) { &print_help(); }
$opts{'l'} ||= 8082;
$opts{'p'} ||= 443;
$opts{'x'} ||= "/usr/bin/openssl";

# disconnect from controlling term unless $opts{'D'}
unless ($opts{'D'}) { 
	if (fork()) { exit(0); }
	else { POSIX::setsid(); }
}

# open a listener socket for incoming local connections
$srv_skt = IO::Socket::INET->new(LocalPort => $opts{'l'},
				 Type => SOCK_STREAM,
				 PROTO => 'tcp',
				 Reuse => 1,
				 Listen => 10)
	or die "Couldn't start TCP server on port $opts{'l'}: $!";

# make sure the socket is autoflushing.  Some versions of
# perl and/or IO::Socket don't do this automatically.
$srv_skt->autoflush(1);

# make sure those signals are set right
$SIG{'CHLD'} = \&REAPER;
$SIG{'HUP'} = $SIG{'TERM'} = $SIG{'INT'} = \&HUNTER;

# main loop
LOCAL: while (1) {

	my ($clt_skt, $sslin, $sslout);

	# accept connection
	unless ($clt_skt = $srv_skt->accept)
	{
		sleep 5 unless ($! == EINTR);
		next;
	}

	if (my $childproc = fork)
	{
		$children{$childproc} = 1;
		close ($clt_skt);
		next LOCAL;
	}

	# autoflushing
	$clt_skt->autoflush(1);

	# start up the SSL session
	open2 ( $sslout, $sslin, $opts{'x'}, "s_client", "-connect",
		$opts{'r'}.":".$opts{'p'}, "-quiet", "-nbio")
		or die "Couldn't start SSL session: $!";
	
	# prepare select loop
	my $sel = IO::Select->new() or die("Couldn't begin select loop: $!");
	$sel->add($sslout);
	$sel->add($clt_skt);

	# loop on selects
	while (my @ready = $sel->can_read()) { 
	foreach my $fh (@ready)
	{
		my $in_data;
		if (($fh == $sslout) &&
		    (defined(sysread($sslout,$in_data,$MAXPACKETLEN,0))))
		{
			# a zero-length read on a readable socket is
			# interpreted as an EOF
			unless(length($in_data))
			{
				close ($sslout);
				close ($sslin);
				close ($clt_skt);
				exit(1);
			}

			# send the data through
			send($clt_skt,$in_data,0);
		}
		elsif (($fh == $clt_skt) &&
		       (defined(recv($clt_skt,$in_data,$MAXPACKETLEN,0))))
		{
			# zero-length read == EOF
			unless(length($in_data))
			{
				close($clt_skt);
				close($sslout);
				close($sslin);
				exit(1);
			}

			# send the data through
			syswrite($sslin,$in_data);
		}
	}
	}
}

sub print_help
{
	print "Usage: $0 -r <host> [...]\n";
	print "\t-r host\t\tRemote host (required)\n";
	print "\t-p port\t\tRemote port (default 443)\n";
	print "\t-l port\t\tLocal port (default 8082)\n";
	print "\t-x path\t\tPath to openssl executable (default /usr/bin/openssl)\n";
	print "\t-D     \t\tDon't background\n";
	print "\t-h     \t\tPrint this message\n";
	exit(0);
}

# celebrate the death of a child process
sub REAPER
{
	my $pid = wait;
	delete $children{$pid};	

	$SIG{'CHLD'} = \&REAPER;
}

# kill them kiddies
sub HUNTER
{
	local $SIG{'CHLD'} = 'IGNORE';
	kill(-15, keys %children);
	wait;
	exit(0);
}