#!/usr/bin/perl -w

#############################################################################
# This script digs a ssh tunnel to another machine with an SSH server
# running. It allows then to connect throught this tunnel to the firewalled
# machine
# e.g.
#
# When the connection string is 
#    'ssh -R 2222:localhost:22 marc@myserver.homelinux.org'
# All connections on port 2222 on the myserver will be redirected through
# the ssh tunnel to this machine.
# 
# The script does this by forking an ssh connection. When the ssh connection
# gets lost, it waits 15 minutes and tries to dig the tunnel again. This 
# continues untill the tunnel is established.
# 
# There is one fail-safe mechanism in place. You can request (or deny)
# a tunnel on the other side.
# 
# The file 'http://myserver.homelinux.org/~marc/trq.txt' defines the 
# behaviour
# 1. when the file contains 'request', the tunnel is digged.
# 2. when the file containes 'die', the script exits and no tunneling can be
#    established unless this script is started again on the firewalled machine
# 3. any other content will result in re-requesting the file every 15'
#
# Bottom line, as long as a tunnel is present, little action is performed, 
# when the tunnel gets lost, the script will try to re-establish the 
# connection by digging an ssh tunnel.
#
#############################################################################

sub debug_system($);
sub main();

use Term::ANSIColor;

my %config = (
	# the remote location where the trq.txt file is located.
        "REMOTEFILE"=>"http://myserver.homelinux.org/~marc/",
	# forward connections on port 2222 on the remote machine to 22 here
        "SSHTUNNEL"=>'ssh -R 2222:localhost:22 marc@myserver.homelinux.org',
	);

&main();

sub main(){
	while(1){
		if(-f "trq.txt"){ &debug_system("rm -f trq.txt"); }
		&debug_system("wget $config{REMOTEFILE}/trq.txt");

		open(INFILE, "<  trq.txt") or &die_on_error("Couldn't open trq.txt");
		local $/ = undef; 
		my $slurp = <INFILE>;
		close INFILE;

		if($slurp =~ /request/){
			print STDOUT "Request tunnel\n";

			my $pid;
			unless (defined ($pid = fork)) {
				die "cannot fork: $!";
			} 
			unless ($pid) {
				exec($config{"SSHTUNNEL"});
			} 
			# Parent continues here
			waitpid($pid, 0);                # must clean up after dead kid
			print STDOUT "Finished\n";
		}
		elsif($slurp =~ /die/){
			print STDOUT "Exiting on request\n";
			die("Commiting Hari Kiri. Argh!\n");
		}
		else{
			print STDOUT "No tunnel request\n";
		}
		sleep 15*60;
	}
}


sub debug_system($){
	my $command = shift;

	chomp($command);
	print colored ("$command", 'bold black on_green');
	print "\n";

	open(FILE,">>/tmp/tunnel.log");
	print FILE "$command\n";
	close(FILE);

	my $retval = system($command);

	return $retval;
}