#!/usr/bin/perl

=pod

ssh-knock is a drop-in wrapper for ssh(1) when the remote sshd(8) service is
protected by the doormand (8) <http://doorman.sf.net> port knocking daemon.

It accepts ssh optiona and arguments, from which it extracts the necessary arguments for
knock(1). It is intended to be used in all places where the ssh(1) client is normally used.

Author: Gyepi Sam <gyepi@praxis-sw.com>

=cut

use strict;
use Getopt::Long;
Getopt::Long::Configure qw(no_auto_abbrev pass_through no_ignore_case_always);

my (%knock_args,$help, $port, $verbose, $test_run);
my ($knocker, $ssh);

my ($program) = $0 =~ m:([^/]+)$:;

my @opts;

exit unless GetOptions('v+' => sub { $verbose++; &save_opts(\@opts, 'v'); },
                       'o=s' => sub { &set_conf_args($_[1], \%knock_args);  &save_opts(\@opts, @_); },
                       'p=s' => sub { $knock_args{port} = $_[1];  &save_opts(\@opts, @_); },
                       'ssh=s' => \$ssh,
                       'knock=s' => \$knocker,
                       'test|n' => \$test_run,
                       'help|h' => \$help,);

$knocker ||= &find_program('knock', die_if_missing => 1);
$ssh ||= &find_program('ssh', die_if_missing => 1);

if ($help){
  print STDERR <<EOF;
usage: $0 [options]

$program accepts, and passes through, all ssh (1) options while examining
said options for useful arguments that need to be extracted.

ssh options relating to hostname or port, whether specified on the
commandline or in the user's ssh config file, are passed to the knock program, 

The '-v' option also causes $program to generate more output.

In addition, $program accepts and consumes the following options:

--test-run  Generate command string as usual, but print it to stderr instead of executing it.
 -n

--ssh s     Specify path to ssh program. By default, $program will search for an ssh program
            using the PATH environment variable.

--knock s   Specify path to knock program. See comment about ssh program.

--help      Produce his output. 
 -h

EOF
  exit 0;
}

#Look for hostname starting with penultimate option, if there's one.
for (my $i = $#ARGV ? $#ARGV - 1 : $#ARGV; $i < @ARGV; $i++){
  last if $knock_args{hostname} = &get_hostname($ARGV[$i]);
}

#add parsed, and removed,  options back in;
splice @ARGV, 0, 0, @opts;

#get default values from ssh config file.
if (my $host_conf = &read_ssh_config($knock_args{hostname}, qq[$ENV{HOME}/.ssh/config])){

  if ( $verbose > 2 ){
    while(my ($k, $v) = each %$host_conf){
      print STDERR "$program: ssh_config: $k = $v\n";
    }
  }

  $knock_args{port} ||= $host_conf->{port};

  #resolve the command line hostname just like ssh would:
  if (!gethostbyname($knock_args{hostname}) && exists $host_conf->{hostname}){
    $knock_args{hostname} = $host_conf->{hostname}
  } 
}

unless (exists $knock_args{hostname}){
  die "$program: cannot determine hostname\n";
}

$knock_args{port} ||= 'ssh';

my @cmd = ($knocker, '-r', qq[$ssh @{[map {qq["$_"]} @ARGV]}], @knock_args{qw(hostname port)});

if ($test_run){
  print STDERR "test-run: $program: @cmd\n";
  exit;
}

exec $knocker @cmd;
#fini

sub save_opts
{
  my ($target, @args) = @_;
  $args[0] = '-' . $args[0];
  push @$target, join ' ', @args;
}

sub get_hostname
{
  local $_ = shift;

  #borrowed and edited from Abigail's url3.pl script

  my $digits         =  '(?:\d+)';
  my $dot            =  '\.';
  my $hex            =  '[a-fA-F\d]';
  my $alpha          =  '[a-zA-Z]';     # No, no locale.
  my $alphanum       =  '[a-zA-Z\d]';   # Letter or digit.

  # Letter or digit, or hex escaped letter/digit.
  my $alphanums      =  "(?:${alphanum}+)";
  my $escape         =  "(?:%$hex\{2})";
  my $safe           =  '[$\-_.+]';
  my $extra          =  "[!*'(),]";
  my $uchar          =  "(?:${alphanum}|${safe}|${extra}|${escape})";
  $uchar          =~ s/\Q]|[\E//g;  # Make string smaller, and speed up regex.

  my $user           =  "(?:(?:${uchar}|[;?&=])*)";
  my $hostnumber     =  "(?:${digits}(?:${dot}${digits}){3})";
  my $toplabel       =  "(?:${alpha}(?:(?:${alphanum}|-)*${alphanum})?)";
  my $domainlabel    =  "(?:${alphanum}(?:(?:${alphanum}|-)*${alphanum})?)";
  my $hostname       =  "(?:(?:${domainlabel}${dot})*${toplabel})";
  my $host           =  "(?:${hostname}|${hostnumber})";
  my $hostport       =  "(?:${host}(?::${digits})?)";
         
  #a username is specified
  return $1 if  /^$user\@($host)/;

  #just a hostname is specified.
  return $1 if /^($host)$/;

  return undef;
}

sub read_ssh_config
{
  my ($host, $file) = @_;
  my %config;
  
  if (-e $file){
    if (open(F, $file)){
      my $found;
      while(<F>)
      {
        chomp;
        if (/^\s*$/){
          $found = 0;
        }
        elsif (/^\s*host\s*(\S+)/){
          my $h = my $t = $1;
          #convert shell style regex quantifier to perl style after escaping dots.
          $h =~ s/\./\\./g;
          $h =~ s/\*/.*/g;
          if ($host =~ /$h/){
            $found = 1;
            $config{host}=$t if $t ne '*';
          }
        }
        elsif ($found){
          if (my ($k, $v) = &extract_conf($_)){
            if ($host eq '*'){
              $config{lc $k} ||= $v;
            }
            else {
              $config{lc $k} = $v;
            }
          }
        }
      }
      close(F);
    }
    else {
      warn "$0: Cannot open file: $file. Error: $!\n";
    }
  } 
  
  return %config ? \%config : undef;
}

sub find_program
{
  my ($program, %args) = @_;
  
  for my $path (split /:/, $ENV{PATH}){
    my $t = join('/', $path, $program);
    if (-x $t){
      return $t;
    }
  }

  if (exists $args{'die_if_missing'}){
    die "$0: cannot find $program program\n";
  }
  else {
    return undef;
  }
}


#-o option and config file values can be specified in several ways.
# -o Foo = bar
# -o Foo bar
# -oFoo=bar
# -oFoo bar

sub extract_conf
{
  my $conf_line = shift;

  my @conf = $conf_line =~ /^\s*(\S+)\s*=?\s*(\S+)/;

  return @conf;
}

sub set_conf_args
{
  my ($conf_line, $knock_args) = @_;
  
  my ($key, $value) = &extract_conf($conf_line);
  for my $t (qw(hostname port)){
      if (lc $key eq $t){
        $knock_args->{$t}=$value;
        next
      }
  }
}
