#!/usr/local/bin/perl
# ssh-tunnel - establish an auto-reconnecting SSH tunnel
# Andrew Ho (andrew@zeuscat.com)
#
# Before using this script, you will need to edit the places
# marked with "FIXME" (no quotes) below.
#
# See http://www.zeuscat.com/andrew/software/desktop_hacks/#ssh-tunnel
# for some background information about how I use this script.

require 5.6.0;
use warnings;
use strict;

use POSIX qw(setsid);
use Symbol qw(gensym);
use File::Basename qw(basename);

use constant ME => basename $0;
use constant SSH => '/usr/bin/ssh';
use constant SSH_OPTIONS => (
    '-2',
    '-l' => 'FIXME',    # Login name (andrew)
    '-i' => 'FIXME',    # Identity file (/home/andrew/.ssh/id_rsa)
    '-L' => 'FIXME',    # Port forwarding (2401:cvs.example.com:2401)
);
use constant SSH_COMMAND => 'FIXME';  # Safe command (/home/andrew/bin/nothing)
use constant REMOTE_HOST => 'FIXME';  # Remote host (foo.example.com)
use constant RECONNECT_DELAY => 5;    # Seconds before reconnect attempts
use constant LOGFILE => 'FIXME';      # Logfile (/home/andrew/.ssh-tunnel.log)
use constant DEBUG => 0;

use constant MONTHS => qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
use constant WEEKDAYS => qw(Sun Mon Tue Wed Thu Fri Sat);

use vars qw($Exit $LogFH $LastPID);
$Exit    = 0;
$LogFH   = gensym;
$LastPID = undef;

open $LogFH, '>>', LOGFILE or die sprintf "%s: could not open %s: %s\n",
    ME, LOGFILE, $! || 'unknown error';
notice_log($0, ' starting tunnel at ', scalar localtime);

$SIG{TERM} = sub {
    notice_log('received SIGTERM, signalling exit');
    kill(TERM => $LastPID) if $LastPID;
    $Exit = 1;
};
$SIG{INT} = sub {
    notice_log('received SIGINT, signalling exit');
    kill(TERM => $LastPID) if $LastPID;
    $Exit = 1;
};
$SIG{PIPE} = sub {
    warning_log('received SIGPIPE, ignoring (remote end disconnect?)');
    kill(TERM => $LastPID) if $LastPID;
};
$SIG{__DIE__} = sub { error_die('caught fatal error: ', @_) };
$SIG{__WARN__} = sub { warning_log('uncaught warning: ', @_) };

daemonize();

while(!$Exit) {
    info_log(join ' ', 'command:', SSH, SSH_OPTIONS, REMOTE_HOST, SSH_COMMAND);
    $LastPID = fork();
    if(!defined $LastPID) {
        error_die(ME, ': cannot fork: ', $! || 'unknown error');
    } elsif($LastPID) {
        my $pid = waitpid $LastPID, 0;
    } else {
        exec(SSH, SSH_OPTIONS, REMOTE_HOST, SSH_COMMAND);
    }
    my $exit_value  = $? >> 8;
    my $signal_num  = $? & 127;
    my $dumped_core = $? & 128;
    if($signal_num) {
        error_log( 'command exited on signal ', $signal_num,
            $dumped_core ? ' (core dump)' : '' );
    } elsif($exit_value) { 
        error_log('command returned non-zero error code ', $exit_value);
    }
    unless($Exit) {
        info_log( 'waiting ', RECONNECT_DELAY, RECONNECT_DELAY == 1 ?
            ' second' : ' seconds', ' before reconnecting...' );
        sleep RECONNECT_DELAY;
    }
}

notice_log('process exiting normally');
close $LogFH;

exit 0;


sub daemonize {
    my $pid = fork;
    if(!defined $pid) {
        error_die(ME, ': cannot fork: ', $! || 'unknown error');
    } elsif($pid) {
        exit 0;    # parent process should exit
    } else {
        foreach my $handle (*STDIN, *STDOUT, *STDERR) {
            close $handle;
            unless(open $handle, '+<', '/dev/null') {
                warning_log( ME, ': could not reopen ', $handle, ': ',
                    $! || 'unknown error' );
            }
        }
        if(setsid() < 0) {
            error_die(ME, ': cannot setsid(): ', $! || 'unknown error');
        }
    }
}

sub debug       { event_log(debug   => @_) if DEBUG }
sub notice_log  { event_log(notice  => @_) }
sub info_log    { event_log(info    => @_) }
sub warning_log { event_log(warning => @_) }
sub error_log   { event_log(error   => @_) }
sub error_die   { event_log(error   => @_); exit -1 }

sub event_log {
    my $level = shift;
    if(@_) {
        my $output = join '', timestamp(), ' [', $level, '] ', $$, ' ', @_;
           $output .= "\n" unless $_[$#_] =~ /\n$/;
        my $old_fh = select $LogFH;
        local $| = 1;
        print $output;
        select $old_fh;
    }
}

sub timestamp {
    my($sec, $min, $hour, $day, $mon, $year, $wday) = (localtime)[0..6];
    sprintf '[%-3s %-3s %2d %02d:%02d:%02d %04d]',
        (WEEKDAYS)[$wday], (MONTHS)[$mon], $day,
        $hour, $min, $sec, $year + 1900;
}