#!/usr/bin/perl
use warnings;
use strict;

# FSSH
#
# Wrapper for ssh
# 
# Version 0.5

# This wrapper script is meant to be used as a drop-in replacement for
# ssh. It fixes some lexing problems with the standard 'ssh'
# command, and adds useful features such as automatic secure
# end-to-end encryption through multiple hosts, and host aliases.

# Please send patches, bug reports, and questions to frederik@ofb.net.

# ----------------------------------------------------------------
# INVOCATION
#
# As in ssh, the first non-option argument is a hostname. Options can
# precede or follow the hostname. The second non-option argument is
# the start of a command.
#
# Host syntax examples:
# To specify options, login and port number:
#   login@host:port{--extra --opts}
# To "chain" multiple hosts using end-to-end encryption:
#   host1+host2
#
# Sometimes, only local connections are allowed to forwarded ports. So
# one has to chain to "localhost" to connect to these ports:
#
#   fssh some-proxy.net+localhost:28412

# ----------------------------------------------------------------
# FEATURES
#
# - Simplifies connections made through proxies
#   - "ssh host1 ssh host2" is not secure, since host1 can see the
#   unencrypted data sent to host2
#   - For end-to-end encryption, must use "-o ProxyCommand" and
#   "connect" (install Debian package: connect-proxy)
#   - In fssh, this is done automatically with chaining via "+"
#   syntax:
#      ; fssh host1+host2
#
# - Fixes problems with command lexing in ssh:
# ('print' is zsh built-in, "print -l" says to print arguments on
# multiple lines)
#
#      ; ssh localhost print -l "hi bye"
#      hi
#      bye
# (note "hi bye" was one argument to ssh, but is split into two
# arguments when executed)
#
#      (a); fssh localhost print -l "hi bye"
#      hi bye
# (with fssh, the argument "hi bye" is preserved, and printed on one
# line)
#
#      (b); fssh localhost "print -l hi bye"
#      hi
#      bye
# (here, a command is passed as a single argument, to be parsed by the
# remote shell)
#
#   - Summary: commands passed to fssh as separate arguments will be
#   executed as separate arguments (a); single-argument commands will
#   be passed to the shell as-is (b). Unless you have executable names
#   which contain spaces, there is no ambiguity.
#
# - Allows "host aliases", usually in a script ~/.host_alias. For
# example, this can depend on current network settings, so that a
# proxy is only used when connecting from outside a firewall.
#
# Example .host_alias (below, NETLOC is a user-defined environment
# variable with no meaning to fssh):
# ----------------------------------------------------------------
#     #!/bin/zsh
#     case $1 in
#         foo)
#             case $NETLOC in
#                 # at home, connect via LAN
#                 home) echo 10.0.0.93;;
#
#                 # somewhere else, tunnel through proxy
#                 *)
#                   # some options for proxy
#                   print -l -- --connect-cmd netcat
#                   # the hostname appears on the last line of output:
#                   echo "some-proxy.net+localhost:24812";;
#             esac
#         ;;
#     esac

# ----------------------------------------------------------------
# ENVIRONMENT VARIABLES
#
# FSSH_ALIAS_FILE: file to use instead of ~/.host_alias
# FSSH_LOG_LEVEL: verbosity, for debugging. Overrides command line
# FSSH_CONNECT: command to use instead of "connect" (e.g. "netcat")

# ----------------------------------------------------------------
# COMPATIBILITY
#
# To use fssh with rsync, etc., put something like this in your shell
# profile script:
#
#     if which fssh >/dev/null 2>&1; then
#         # use fssh where possible
#         export CVS_RSH=fssh
#         # use old-style command-line lexing with rsync, otherwise we can't
#         # do e.g. "rsync host:path/{a,b} ."
#         export RSYNC_RSH="fssh --old-style-lexing"
#     else 
#         export CVS_RSH=ssh
#         export RSYNC_RSH=ssh
#     fi
# 

sub print_help {
  print "Usage: fssh [SSH_ARGS] [--old-style-lexing] [--encrypt-separately]\n";
}

sub print_version {
  print "fssh 0.0.1\n";
  print `ssh -V`;
}

# ----------------------------------------------------------------
# Utilities

my ($log_prefix) = "fssh: ";
my ($log_level)=1;


sub shell_quotemeta ($$$) {
  my ($quote, $esc_chars, $str) = @_;
  my (@c) = split('', $str);
  my (@res);
  for my $c (@c) {
    if($c !~ /$esc_chars/) {
      push @res, $c;
    } elsif($c eq "\n") {
      push @res, $quote."\$'\\n'".$quote;
    } elsif($c eq "\t") {
      push @res, $quote."\$'\\t'".$quote;
    } elsif($c eq "'" && $quote eq "'") {
      push @res, "'\\''";
    } else {
      push @res, "\\$c";
    }
  }
  return $quote.join("",@res).$quote;
}

# routine to shell quote, arguments: delimiter (",',none) for tab or
# newline, regex for characters needing escape, string

my $sq_plain = qr/[\$\(\)^#&*{}<>~"'\\|;?\[\] \n\t]/;
my $sq_single = qr/['\\\t]/;
my $sq_double = qr/[\$"\\\t]/;

sub unshellwords {
  my (@w) = @_;
  my (@l) = ();
  for my $w (@w) {
    my $n;
    if ($w =~ /^$/) {
      $n = "''";
    } else {
      if ($w !~ /$sq_plain/) {
        $n = $w;
      } elsif ($w !~ /$sq_single/) {
        $n = shell_quotemeta ("'", $sq_single, $w);
      } else {
        $n = shell_quotemeta ('"', $sq_double, $w);
      }
    }
    push @l, $n;
  }
  return join(" ", @l);
}

sub vmsg {
  print STDERR $log_prefix, @_, "\n" if($log_level > 0);
}
sub dmsg {
  print STDERR $log_prefix, @_, "\n" if($log_level > 1);
}
sub max {
  my $v = shift;
  for(@_) { $v = $_ if $_ > $v; }
  return $v;
}

sub my_system {
  my (@cmd) = @_;
  do {
    local $SIG{__WARN__}=sub{};
    system(@cmd);
  };

  my $sh_err;
  my ($sh_ev, $sh_failed, $sh_sig, $sh_core, $sh_errno) =
    ($?>>8, $?==-1, $? & 127, !!($? & 128), $!);
    
  if ($sh_failed) {
    $sh_err = "Failed to execute: $sh_errno";
  } elsif ($sh_sig) {
    $sh_err = "Died with signal $sh_sig".($sh_core?", dumped core":"");
  } elsif ($sh_ev) {
    $sh_err = "Exit value $sh_ev";
  } else {
    $sh_err = undef;
  }
  die ("$sh_err: ".(unshellwords @cmd)."\n") if defined($sh_err);
}

#----------------------------------------------------------------
# shellwords, copied from Text::ParseWords

sub shellwords {
  my (@lines) = @_;
  my @allwords;

  foreach my $line (@lines) {
    $line =~ s/^\s+//;
    my @words = parse_line('\s+', 0, $line);
    pop @words if (@words and !defined $words[-1]);
    return() unless (@words || !length($line));
    push(@allwords, @words);
  }
  return(@allwords);
}

sub parse_line {
  my($delimiter, $keep, $line) = @_;
  my($word, @pieces);

  no warnings 'uninitialized';  # we will be testing undef strings

  while (length($line)) {
    # This pattern is optimised to be stack conservative on older perls.
    # Do not refactor without being careful and testing it on very long strings.
    # See Perl bug #42980 for an example of a stack busting input.
    $line =~ s/^
                    (?: 
                        # double quoted string
                        (")                             # $quote
                        ((?>[^\\"]*(?:\\.[^\\"]*)*))"   # $quoted 
                    |   # --OR--
                        # singe quoted string
                        (')                             # $quote
                        ((?>[^\\']*(?:\\.[^\\']*)*))'   # $quoted
                    |   # --OR--
                        # unquoted string
                        (                               # $unquoted 
                            (?:\\.|[^\\"'])*?           
                        )               
                        # followed by
                        (                               # $delim
                            \Z(?!\n)                    # EOL
                        |   # --OR--
                            (?-x:$delimiter)            # delimiter
                        |   # --OR--                    
                            (?!^)(?=["'])               # a quote
                        )  
                    )//xs or return;            # extended layout                  
                      my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);

    return() unless( defined($quote) || length($unquoted) || length($delim));

    if ($keep) {
      $quoted = "$quote$quoted$quote";
    } else {
      $unquoted =~ s/\\(.)/$1/sg;
      if (defined $quote) {
        $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
      }
    }
    $word .= substr($line, 0, 0); # leave results tainted
    $word .= defined $quote ? $quoted : $unquoted;
 
    if (length($delim)) {
      push(@pieces, $word);
      push(@pieces, $delim) if ($keep eq 'delimiters');
      undef $word;
    }
    if (!length($line)) {
      push(@pieces, $word);
    }
  }
  return(@pieces);
}

#----------------------------------------------------------------
# Alias file stuff

my $alias_file = undef;

if (defined $ENV{FSSH_ALIAS_FILE}) {
  my ($fn) = $ENV{FSSH_ALIAS_FILE};
  if (!-e $fn) {
    die "No alias file FSSH_ALIAS_FILE=$fn";
  }
} elsif (defined $ENV{HOME}) {
  my ($fn) = "$ENV{HOME}/.host_alias";
  if (-e $fn) {
    $alias_file = $fn;
  }
}
if (defined $alias_file) {
  if(!-x $alias_file) {
    die "Alias file $alias_file not executable";
  }
}

my %alias_table=();

sub get_host_alias ($) {
  my ($h) = @_;
  # see if cached version exists
  if(!exists $alias_table{$h}) {
    # run alias file to lookup host
    # check $alias_file exists
    return undef unless defined $alias_file;
    # alias_args
    my (@alias_args);
    my ($res)="";
    open ALIAS, "$alias_file \Q$h\E |" or die "Couldn't run $alias_file";
    while(<ALIAS>) {
      chomp;
      $res .= "$_ ";
    }
    close ALIAS;
    @alias_args = shellwords $res;
    if (@alias_args) {
      $alias_table{$h} = \@alias_args;
    } else {
      $alias_table{$h} = undef;
    }
  }
  return $alias_table{$h};
}

sub expand_host ($$$);

sub get_host_alias_opt ($$) {
  my ($is_proxy, $p) = @_;
  my ($a) = get_host_alias $p->{host};;
  if(!defined $a) {
    return $p;
  } else {
    my (@args) = @$a;
    dmsg "Expanded $p->{host} to ".(join " ", @args);
    unshift @args, @{$p->{opts}};
    my ($pa) = parse_cmdline ($is_proxy, "Host alias for $p->{host}", @args);
    dmsg "New host: $pa->{host}";
    if (@{$pa->{remote_cmd}}) {
      warn ("remote_cmd = ".join(", ",@{$pa->{remote_cmd}})."\n");
      die "No remote commands allowed for aliases ($p->{host})";
    }
    $pa->{remote_cmd} = $p->{remote_cmd};
    $pa->{old_style} = $p->{old_style};
    $pa->{enc_separately} = $p->{enc_separately};
    $pa->{verbose} = $p->{verbose};
    if ($pa->{host} eq $p->{host}) {
      # 2010-Nov-25 - before, this was "return $p"
      # but then if .host_alias defined extra options on a host, $p wouldn't include them
      # changing to "return $pa" appears to fix the problem
      return $pa;
    } else {
      return expand_host ($is_proxy, $p->{host}, $pa);
    }
  }
}

#----------------------------------------------------------------

# parse command line. used for both main invocation and aliases
sub parse_cmdline {
  my ($is_proxy,$where,@args) = @_;
  my ($help,$debug,$verbose,$version,$login,$port,
      $background,$redirect_stdin,$quiet,@config_options,
      $identity_file,$force_ptty,$enable_x11,
      $enable_x11_trusted,$enable_forward_auth,
      @local_to_remote,@remote_to_local,
      $no_remote,$allow_remote_connect,$escape_char,
      $compression);
  my ($version_two,$version_one,$subsystem,$master,$control_path);
  my ($old_style_lexing,$encrypt_separately,$connect_cmd,$just_print);
  my ($host,@cmd);

  my ($die) = sub {
    my ($msg) = @_;
    die "$where: $msg\n";
  };

  while(@args) {
    $_ = shift @args;

    # deal with collapsed abbreviated arguments: e.g. -fN
    if($_ =~ /^-([a-zA-Z0-9])(.+)$/) {
      $_ = "-$1";
      unshift @args, "-$2";
    }

    if($_ eq '-h' || $_ eq '--help') {$help=1; next;}
    if($_ eq '-d' || $_ eq '--debug') {$debug=1; next;}
    if($_ eq '-v' || $_ eq '--verbose') {$verbose++; next;}
    if($_ eq '-V' || $_ eq '--version') {$version=1; next;}
    if($_ eq '-l' || $_ eq '--login') {$login=shift @args; next;}
    if($_ eq '-p' || $_ eq '--port') {$port=shift @args; next;}
    if($_ eq '-f' || $_ eq '--background') {$background=1; next;}
    if($_ eq '-n' || $_ eq '--redirect-stdin') {$redirect_stdin=1; next;}
    if($_ eq '-q' || $_ eq '--quiet') {$quiet=1; next;}
    if($_ =~ /^-o(.+)?/ || $_ =~ /^--option(?:=(.*))$/) {push @config_options, defined $1 ? $1 : shift @args; next;}
    if($_ eq '-i' || $_ eq '--identity') {$identity_file=shift @args; next;}
    if($_ eq '-t' || $_ eq '--force-ptty') {$force_ptty=1; next;}
    if($_ eq '-T' || $_ eq '--disable-ptty') {$force_ptty=0; next;}
    if($_ eq '-X' || $_ eq '--enable-x11') {$enable_x11=1; next;}
    if($_ eq '-x' || $_ eq '--disable-x11') {$enable_x11=0; next;}
    if($_ eq '-Y' || $_ eq '--enable-x11-trusted') {$enable_x11_trusted=1; next;}
    if($_ eq '-A' || $_ eq '--enable-forward-auth') {$enable_forward_auth=1; next;}
    if($_ eq '-a' || $_ eq '--disable-forward-auth') {$enable_forward_auth=0; next;}
    if($_ eq '-L' || $_ eq '--local-to-remote') {push @local_to_remote, shift @args; next;}
    if($_ eq '-R' || $_ eq '--remote-to-local') {push @remote_to_local, shift @args; next;}
    if($_ eq '-N' || $_ eq '--no-remote') {$no_remote=1; next;}
    if($_ eq '-g' || $_ eq '--allow-remote-connect') {$allow_remote_connect=1; next;}
    if($_ eq '-e' || $_ eq '--escape-char') {$escape_char=shift @args; next;}
    if($_ eq '-C') {$compression=1; next;}
    if($_ eq '-2') {$version_two=1; next;}
    if($_ eq '-1') {$version_one=1; next;}
    if($_ eq '-s') {$subsystem=1; next;}
    if($_ eq '-M') {$master++; next;}
    if($_ eq '-S') {$control_path=shift @args; next;}
# our arguments
    if($_ eq '-O' || $_ eq '--old-style-lexing') {$old_style_lexing=1; next;}
    if($_ eq '--encrypt-separately') {$encrypt_separately=1; next;}
    if($_ eq '--connect-cmd') {$connect_cmd=shift @args; next;}
    if($_ eq '--just-print') {$just_print=1; next;}
    if($_ eq '--') { last; }
    if($_ =~ /^-/) { &$die("Unknown option: $_"); }
    if(!defined $host) { $host = $_; } # can have options after hostname, so stay in loop
    else { unshift @args, $_; last; }
  }
  if(!defined $host) { $host = shift @args; } # maybe got here by '--'
  @cmd = @args;
  @args = ();
  
  my ($check_no_proxy) = sub {
    my ($opt,$arg) = @_;
    &$die("Option $opt cannot be specified for proxy or alias") if($is_proxy && $arg);
  };
  
  &$check_no_proxy('-h', $help);
  if($help) {print_help; exit 0;}
  &$check_no_proxy('-V', $version);
  if($version) {print_version; exit 0;}

  if (!defined $host) {
    &$die("Must specify hostname\n");
  }
  
  my @ssh_args;
  $verbose = 0 unless defined $verbose;
  for (1..$verbose) {
    push @ssh_args, '-v';
  } 
  push @ssh_args, '-d' if defined $debug;
  push @ssh_args, '-l', $login if defined $login;
  push @ssh_args, '-p', $port if defined $port;
  push @ssh_args, '-f' if defined $background;
  push @ssh_args, '-n' if defined $redirect_stdin;
  push @ssh_args, '-q' if defined $quiet;
  push @ssh_args, (map {('-o', $_)} @config_options);
  push @ssh_args, '-i', $identity_file if defined $identity_file;
  push @ssh_args, '-t' if defined $force_ptty && $force_ptty;
  push @ssh_args, '-T' if defined $force_ptty && !$force_ptty;
  push @ssh_args, '-X' if defined $enable_x11 && $enable_x11;
  push @ssh_args, '-x' if defined $enable_x11 && !$enable_x11;
  push @ssh_args, '-Y' if defined $enable_x11_trusted;
  defined $enable_x11 && !$enable_x11 && $enable_x11_trusted and &$die("Error: Specified both -x and -Y");
  push @ssh_args, '-A' if defined $enable_forward_auth && $enable_forward_auth;
  push @ssh_args, '-a' if defined $enable_forward_auth && !$enable_forward_auth;
  &$check_no_proxy('-L', scalar @local_to_remote);
  push @ssh_args, (map {('-L', $_)} @local_to_remote) if @local_to_remote;
  &$check_no_proxy('-R', scalar @remote_to_local);
  push @ssh_args, (map {('-R', $_)} @remote_to_local) if @remote_to_local;
  &$check_no_proxy('-N', defined $no_remote);
  push @ssh_args, '-N' if defined $no_remote;
  &$check_no_proxy('-g', defined $allow_remote_connect);
  push @ssh_args, '-g' if defined $allow_remote_connect;
  push @ssh_args, '-C' if defined $compression;
  push @ssh_args, '-e', $escape_char if defined $escape_char;
  $version_two && $version_one and &$die("Error: Specified both -1 and -2");
  push @ssh_args, '-1' if defined $version_one;
  push @ssh_args, '-2' if defined $version_two;
  push @ssh_args, '-s' if defined $subsystem;
  if(defined $master) {
    for (1..$master) {
      push @ssh_args, '-M';
    }
  }
  push @ssh_args, '-S', $control_path if defined $control_path;

  return { host => $host,
           port => $port,
           opts => \@ssh_args,
           just_print => $just_print,
           remote_cmd => \@cmd,
           old_style => $old_style_lexing,
           enc_separately => $encrypt_separately,
           connect_cmd => $connect_cmd,
           verbose => $verbose
         };
}

my ($nested_curly_brackets) = qr/({(?:[^{}]++|(?1))*})/;

sub expand_host ($$$) {
  my ($is_proxy, $orig_host, $p) = @_;
  my ($h) = $p->{host};
  my (@chain) = ();
  # split foo+bar+baz into qw(baz bar foo)
  while(defined $h) {
    $h =~ /^((?:[^\+{]*$nested_curly_brackets?)+)(?:\+(.*))?$/ 
      or die "Malformed host: $h\n";
    unshift @chain, $1;
    $h = $3;
  }

  # parse login@host:port{--extra --opts} syntax, and create parsed host list @ps
  my (@ps)=();
  my ($first)=1;
  while(@chain) {
    my ($c) = shift @chain;
    $c =~ /(?:([^@]*)\@)?([^:{]*)(?::([^{]*))?$nested_curly_brackets?/ 
      or die "Malformed host: $c\n";
    my ($login, $host, $port, $extra_opts) = ($1,$2,$3,$4);
    $extra_opts =~ s/^{(.*)}$/$1/ if defined $extra_opts;
    my (@extra_opts) = defined $extra_opts ? shellwords $extra_opts : ();

    # for first host: if we've defined a port on the command line and
    # also in the host:port syntax, insert an extra 'localhost' to
    # prevent these options from overriding each other
    if($first && defined $port && defined $p->{port}) {
      unshift @chain, $c;
      $host = "localhost";
      $port = undef; # use $p->{port} instead
    }

    my (@cmdline) = $host;
    # put extra_opts first since they are overridden by @{$p->{opts}
    # (for first host)
    push @cmdline, @extra_opts; 
    # first host gets command line options
    if($first) {
      push @cmdline, @{$p->{opts}};
    } else {
      # default: disable agent, X11 forwarding for proxy hosts
      push @cmdline, qw(-a -x); 
      # propagate verbose settings to all proxies
      push @cmdline, ("-v")x$p->{verbose};
    }
    push @cmdline, "-l", $login if defined $login;
    push @cmdline, "-p", $port if defined $port;
    if($first) {
      push @cmdline, "--old-style-lexing" if $p->{old_style};
      push @cmdline, "--encrypt-separately" if $p->{enc_separately};
      push @cmdline, "--connect-cmd", $p->{connect_cmd} if $p->{connect_cmd};
      push @cmdline, @{$p->{remote_cmd}};
    }

    my $p = (parse_cmdline((!$first), "Host \"$c\"", @cmdline));

    # if last, expand alias
    # (but not if it would cause a loop)
    if(@chain == 0 && $host ne $orig_host) {
      my (@ps1) = get_host_alias_opt ($is_proxy, $p);
      push @ps, @ps1;
    } else {
      push @ps, $p;
    }
    
    $first = 0;
  }
  return @ps;
}

sub make_proxy_command {
  my (@ps) = @_; # first is last
  my ($p) = shift @ps;

  my ($host) = $p->{host};
  my ($port) = $p->{port};
  my (@new_opts) = ($host, @{$p->{opts}});
  if(@ps) {
    my ($alias) = $host;
    $alias .= ":$port" if defined $port;
    push @new_opts, "-o", "HostKeyAlias=$alias";

    $port = 22 unless defined $port;
    my $remcmd = $p->{connect_cmd} || $ENV{FSSH_CONNECT} || "connect";
    $ps[0]->{remote_cmd} = [$remcmd, $host, $port];
    my (@proxy_command) = make_proxy_command(@ps);
    push @new_opts, "-o", "ProxyCommand=".(unshellwords @proxy_command);
  }
  my (@cmd) = @{$p->{remote_cmd}};
  if(@cmd) {
    if ($p->{old_style} || @cmd==1) {
      push @new_opts, "--", @cmd;
    } else {
      push @new_opts, "--", unshellwords @cmd;
    }
  }
  return ("ssh", @new_opts);
}

sub get_ssh_opts ($$) {
  my ($is_proxy, $p) = @_;
  
  my (@chain) = expand_host ($is_proxy, "", $p);

  return make_proxy_command(@chain);
}


my ($p) = parse_cmdline (0, "fssh command line", @ARGV);
if(defined $ENV{FSSH_LOG_LEVEL} && $ENV{FSSH_LOG_LEVEL} ne "") {
  $log_level = $ENV{FSSH_LOG_LEVEL};
} else {
  $log_level = $p->{verbose};
}

my (@cmd) = get_ssh_opts (0, $p);

if($p->{just_print} || $log_level >= 1) {
  print STDERR ($log_prefix."Running: ".(unshellwords @cmd)."\n");
}

if(!$p->{just_print}) {
  my_system(@cmd);
}

exit 0;