#!/usr/bin/perl

=pod

=head1 NAME

remote-ssh-access - An application for creating handy SSH client shortcuts.

=head1 SYNOPSIS

    remote-ssh-access [-a|--add] [-h] [-s|--silent] [-N|--no-defkey] [cmds...]

=head1 DESCRIPTION

This script replaces the use of aliases or other small scripts for automating and managing
SSH client commands.

=head1 README

This small script creates and uses shortcuts for launching SSH sessions.  It's a useful tool
when you have a lot of systems to manage.

This program is meant to be executed through a symlink to a hard link.  The hard link file is
called a C<parameter file>; the symlink is referred to as the C<shortcut>.  If you wish,
the hard link may also serve as the shortcut, obviating the step of creating a symlink.

The C<parameter file> is created with the standard F<ln(1)> command.  Its name forms the
arguments that the shorcut file uses to launch SSH sessions.  The syntax for a parameter
file is defined given the following syntax:

=over

=item host[:user[:port[:key[:version[:cmd]]]]]

=back

Where:

All parameters are delimited with a colon C<:> character unless all right-most parameters
are permitted to default, in which case they may be omitted.

=over

=item B<host> is a fully qualified hostname or IP address

This parameter is the first and the only required argument.

=item B<user> is the remote login username

The default is the invoking user if not supplied in the parameter filename.

=item B<port> is the destination SSH server port number

This parameter file argument may be a number or an /etc/services name.  The default is
whatever the current hosts' services(5) entry for 'ssh/tcp' has configured.

=item B<key> is the name of a secret private key (rsa1, rsa2 or dsa) authentication file
in your ~/.ssh directory

A default key will be selected unless the command line switch B<-N> is used.  The default
secret key file selection process uses a prioritized selection criteria ( if the key file
exists ) in ~/.ssh, which is:

=over

=item id_rsa

    ~/.ssh/id_rsa

=item id_dsa

    ~/.ssh/id_dsa

=item identity

    ~/.ssh/identity

=item Any others

Other keys are discovered by looking for key filenames ending with a F<.pub> extension, in
which a secret keyfile with the same name (sans the F<.pub> extension) exists.

=back

=item B<version> is the protocol version of SSH that the B<key> argument uses (1 or 2).

It's usually best to just leave this empty unless you're sure the SSH key is protocol
version 1.  If this is specified in the parameter filename just remember that supplying
this means that you intend to force SSH to require this protocol version (see L<ssh/-1>).

=item B<cmd> is an optional command argument list to run on the remote host (default is a
login session)

=back

When forming the C<parameter filename> all right-justified parameters and any delimiters
may be omitted if the default values are wanted.  If a right-most parameter needs to be
supplied then embed all left-to-right intermediary parameters with empty C<::> delimiters.
In other words parameters are identified using a positional argument list delimited with
colons.  Supplying empty colons will use their default values.

=head2 COMMAND LINE SWITCHES

=over

=item B<-a E<verbar> --add>

An input loop is used to gather all of the input necessary to automatically build the
C<parameter file> and C<shortcut> links.  No extra charge.

=item B<-s E<verbar> --silent>

The SSH command being spawned is normally echoed to the terminal.  The echo is suppressed
if this command line switch is given, or the remote session has command line arguments
given (either through the parameter file, or if passed to the shortcut).  Since shortcuts
might exist to launch automated processes the echo suppression for command arguments makes
parsing command output easier.

=item B<-h E<verbar> --help>

Help!

=item B<-N E<verbar> --no-defkey>

Normally, if a private authentication key is not specified in the parameter filename, or in
the F<~/.remote-ssh-access> file, a default private key is selected.  Using this switch
prevents the default identity file from being selected.

A couple things are worth noting about this option:

This switch does not prevent a secret key file from being used if it is given in the
parameter file, or the host/user specific override -- it only prevents default key
selection of a key.

The SSH client itself may or may not decide to automatically use a key anyway.

=item B<cmd...>

Multiple commands may be passed to a shortcut command.

=back

=head2 INSTALLATION AND USE

=head3 INSTALL THE SCRIPT

Install and use this script using the following steps

=over

=item   * Create a subdirectory under your home named ~/.hosts, or something similar.

=item   * Add it to your PATH environment variable (and ideally, to your login profile)

=item   * Install this script inside ~/.hosts, or whatever directory you used above.

=item   * The script must be named C<remote-ssh-access>.

If another name is desired then you must modify the source code: change the
constant C<REAL_PROCESS_NAME> in the source code to reflect the new script
name.

=item   * Do not install the script in a shared system-wide location.

Do not install this script in a directory such as F</usr/local/bin>.  This is because:

=over

=item   1.  Non-privileged users need write access to the same directory.

=item   2.  This script makes use of hard links.

Often system installation directories live on their own file systems.  Since this script
makes use of hard links, and hard links do not span disparate file systems, it would not
make sense to install the script in a system binary directory.

=back

=back

=head3 CREATE SHORTCUTS THE EASY WAY

Run this script with the C<--add> switch, you will be prompted for all of the necessary
data.  The hard and soft links will be created by this script.

=head3 CREATE HARD AND SOFT LINKS TO FORM SHORTCUTS THE HARD WAY

Hardlink the parameter file to this script given the syntax described earlier -- then
create a symlink to the hard link and invoke the SSH session with the shortcut.

=over

=item * Example 1

You want a shortcut to remote to the host B<plethora> as the user B<joe>.  On B<plethora>,
sshd runs on port B<1234>.  In addition you would like to use the public key associated
with F<id_dsa>.  Furthermore you would like the 'uptime' command to be executed.  Allow
the SSH protocol version to default.

    % cd ~/.hosts
    % ln remote-ssh-access plethora:joe:1234:id_dsa::uptime

Symlink the parameter file to a shortcut named B<duptime>

    % ln -s plethora:joe:1234:id_dsa::uptime duptime

Login and run uptime against plethora by invoking the shortcut

    % duptime

=item * Example 2

You want to connect to the host B<pinyata> as your default user, default ssh port, using
the SSH v1 public key file named 'identity' and have an interactive shell.

    % ln remote-ssh-access pinyata:::identity:1
    % ln -s pinyata:::identity:1 pinyata
    % pinyata

=item * Example 3

Using all defaults create a shortcut to the host B<domino>.  Since the command is already
sufficiently short you can use it as the shortcut (no symlink is required).

    % ln remote-ssh-access domino
    % domino

=back

=head2 OPTIONAL SSH GOODNESS

The standard SSH suite includes tools for managing sessions.  You can load your key via
ssh-agent under a sub-process (e.g., shell or X11) then add the key via ssh-add. 
Subsequent invocations of the shortcut will have the passphrase fed by the agent.

    % ssh-agent bash
    % ssh-add ~/.ssh/identity
    % pinyata

=head2 OVERRIDING PARAMETER-CONFIGURED REMOTE COMMANDS

If any command argument list is passed to the shortcut it is passed as commands to run
against the target host -- overriding any command argument in the C<parameter filename>.

    % ln remote-ssh-access dilbert:root:1234:id_dsa:2:who
    % ln -s dilbert:root:1234:id_dsa:2:who dwho
    % dwho      # runs who(1) on dilbert
    % dwho w    # runs the w(1) command on dilbert instead

=head2 OVERRIDING HOST AND USER SPECIFIC KEYS

You can override keys on a per host/user basis.

Create a file named ~/.remote-ssh-access. Other than comments (introduced with the
standard C<#> sigil) the file takes the following syntax:

B<host:user:key:version>

Either B<host> or B<user> may be the wild card (*) character, which means any host or user.
Note that the wild card does not "glob" identifiers, for example C<jo*> will not pattern
match all users prefixed with C<jo>.  The wild card is either '*' or a specific label.

The key argument can be the name of a secret key file in your ~/.ssh directory, or it may
be a fully qualified path to the file.

Note that when an authentication key is overridden you are given a hint -- the command echo
will prefix the SSH command with a B<[*]> noting that the key had been overridden (unless,
as explained earlier, echoes are suppressed).

=over

=item Example

B<foo.bar.com:*:id_dsa:2>

This would force any shortcut, which, if symlinked to a file that has a host parameter of
B<foo.bar.com> to have its secret key overridden with F<~/.ssh/id_dsa>, despite the key
specified in the parameter file.

=item Another nifty example

B<*:uploads:identity:1>

Would force all shortcuts that result in remote SSH sessions targeted to the C<uploads>
user to automatically resort to using F<~/.ssh/identity> and SSH protocol version 1.

=back

=head1 PREREQUISITES

This script requires

C<Cwd 3.12>,

C<File::Spec::Functions 1.3>,

C<File::Basename 2.74>,

C<Getopt::Long 2.35>, and

C<Pod::Usage 1.33>

It should be easy to obtain all of these since they are all standard Perl core modules.

=head1 OSNAMES

C<Linux>, C<UNIX>, C<BSD>

=head1 SCRIPT CATEGORIES

Networking
UNIX/System_administration

=head1 AUTHOR

Lane Davis <cpan@upt.org>

=cut

use strict;
use warnings;

use Cwd qw(abs_path);
use File::Spec::Functions qw(catdir catfile);
use File::Basename qw(dirname basename);
use Getopt::Long;
use Pod::Usage;

use constant REAL_PROCESS_NAME => 'remote-ssh-access';

our $VERSION = '1.7';

my $procname = basename($0);
my $realname = REAL_PROCESS_NAME;

my ( $opt_help, $opt_silent, $opt_no_defkey, $opt_add );

GetOptions(
    's|silent'    => \$opt_silent,
    'h|help'      => \$opt_help,
    'N|no-defkey' => \$opt_no_defkey,
    'a|add'       => \$opt_add,
);
usage() if $opt_help;
main(@ARGV);
exit(-1);

sub main {
    my @args = @_;

    add() if $opt_add;
    die sprintf( "This script (%s) is not meant to be run directly, unless called with --add.\n", $realname )
      if ( $procname eq $realname );

    my $settings = load_defaults();
    load_link_settings( $settings );
    override_preferences( $settings );
    run_ssh( $settings, @args );
    return;
}

sub run_ssh {
    my ( $settings, @args ) = @_;
    my $cmd = build_ssh_cmd( $settings, @args );
    if ( !$opt_silent && !( $settings->{cmd} ) && !scalar(@args) ) {
        $|++;
        printf( "%s%s\n",
            $settings->{override} ? '[*] ' : "",
            join( ' ', @$cmd ) );
    }
    exec @$cmd;
}

sub build_ssh_cmd {
    my ( $settings, @args ) = @_;
    my $ssh_exec = path_of("ssh");
    my $cmd      = [$ssh_exec];
    push @$cmd, sprintf( '-%s' => $settings->{version} )
      if $settings->{version};
    push @$cmd, ( '-p' => $settings->{port} ) if $settings->{port};
    push @$cmd, ( '-i' => $settings->{key} )  if $settings->{key};
    push @$cmd, ( '-l' => $settings->{user} ) if $settings->{user};
    push @$cmd, $settings->{host};

    if (@args) {
        push @$cmd, @args;
    }
    else {
        push @$cmd, $settings->{cmd} if $settings->{cmd};
    }
    return $cmd;
}

sub path_of {
    my ($cmd) = @_;
    my @dirs = split /:/, $ENV{PATH};
    for my $dir (@dirs) {
        my $path = catfile( $dir, $cmd );
        return $path if -x $path && -f _;
    }
    return;
}

sub load_link_settings {
    my ($settings) = @_;
    my $link = readlink($0) || $procname;
    $link =~ s|^[./]+||;
    my ( $host, $user, $port, $key, $version, $cmd ) = split( ':', $link, 6 );
    $settings->{host} = $host;
    $settings->{user} = $user if $user;
    if ($port) {
        $port = ( getservbyname( $port, 'tcp' ) )[2] if ( $port =~ /\D/ );
        $settings->{port} = $port if $port;
    }
    if ($key) {
        my $key_file = resolve_key($key);
        $settings->{key} = $key_file if $key_file;
    }
    else {
        $settings->{key} = resolve_key( $settings->{key} )
          if defined $settings->{key};
    }
    $settings->{version} = $version if $version && $version !~ /\D/;
    $settings->{cmd} = $cmd if $cmd;
    return;
}

sub override_preferences {
    my ($settings) = @_;
    my $home_dir = resolve_home();
    my $pref = catfile( $home_dir, ".remote-ssh-access" );
    return unless $pref && -f $pref;

    my ( $host, $user ) = @{$settings}{qw( host user )};

    ##
    ## Normalize the match parameters a bit
    $host =~ s/\.$//;
    $host = lc($host);
    $user = lc($user);

    ## Perl::Critic for some reason thinks @ARGV isn't localized... *sigh*
    local (*ARGV);
    @ARGV = ($pref);
    my @settings = <>;
    ##
    ## First match, first exit
    for my $config (@settings) {
        chomp($config);
        next if ( $config =~ /^$|^\s*#/ );
        my ( $mhost, $muser, $mkey, $mver ) = split( /:/, $config, 4 );
        if (   ( lc($mhost) eq $host || $mhost eq '*' )
            && ( lc($muser) eq $user || $muser eq '*' ) )
        {
            if ($mkey) {
                $mkey = resolve_key($mkey) if ( $mkey !~ m|/| );
                if ( -f $mkey ) {
                    $settings->{override}++ if ( $settings->{key} );
                    $settings->{key} = $mkey;
                    $settings->{version} = $mver if $mver && $mver !~ /\D/;
                }
            }
        }
    }
    return;
}

sub resolve_user {
    my $user =
      ( ( getpwuid $< )[0] )
        || $ENV{USER}
        || getlogin();

    die "Who are you?\n" unless $user;
    return $user;
}

sub resolve_home {
    my $user     = resolve_user();
    my $home_dir = (
          ($user)
        ? ( ( getpwnam $user )[7] )
        : ( getpwuid $< )[7]
    ) || $ENV{HOME};

    die "I couldn't find your home directory.\n" unless $home_dir;
    return $home_dir;
}

sub resolve_ssh_dir {
    my $home_dir = resolve_home();
    return ( catdir( $home_dir, '.ssh' ) ) if ( $home_dir && -d $home_dir );
    return;
}

sub resolve_key {
    my ($key) = @_;
    return unless $key;
    $key =~ s/\.pub$//;
    my $key_dir = resolve_ssh_dir();
    my $key_file = catfile( $key_dir, $key );
    return $key_file if -f $key_file;
    return;
}

sub load_defaults {
    my ( $user, $key_dir, $version, $key_file, $ssh_port );

    $user     = resolve_user();
    $key_dir  = resolve_ssh_dir();
    $key_file = default_key($key_dir)
      if ( defined $key_dir && !$opt_no_defkey );
    $ssh_port = ( getservbyname qw(ssh tcp) )[2];

    my $opts = {
        user    => $user,
        key     => $key_file,
        version => $version,
        port    => $ssh_port,
    };

    $opts->{version} = $version if $version;
    return $opts;
}

sub default_key {
    my ($dir) = @_;
    ##
    ## Don't start at 0 so we can use logicical or shortcut || for undef's
    my %prios = ( 'id_rsa' => 1, 'id_dsa' => 2, 'identity' => 3 );
    my $pdef = scalar( keys %prios ) + 1;
    my ($candidate) =
      sort { $prios{ basename $a} || $pdef <=> $prios{ basename $b} || $pdef }
      grep -f, map { /^(.*)\.pub$/ }
      grep -f, glob( catfile( $dir, '*.pub' ) );

    return unless $candidate;
    return basename($candidate);
}

sub usage {
    pod2usage(
        {
            -exitval => -1,
            -verbose => 2,
        }
    );
}

sub add {
    my @fields = (
        [
            host => {
                prompt   => "Hostname",
                required => 1,
            },
        ],
        [
            user => {
                prompt   => "Username",
                blank    => "All users",
                required => 0,
                valid    => \&validate_user,
            },
        ],
        [
            port => {
                prompt   => "Port",
                blank    => ( getservbyname( 'ssh', 'tcp' ) )[2],
                required => 0,
                valid    => qr/^\d+$/,
            },
        ],
        [
            key => {
                prompt   => "Public Key",
                blank    => "Default key",
                required => 0,
                valid    => \&resolve_key,
            },
        ],
        [
            version => {
                prompt   => "Version",
                required => 0,
                valid    => qr/^\d(?:\.\d+)?$/,
            },
        ],
        [
            cmd => {
                prompt   => "Command",
                blank    => "Login shell",
                required => 0,
            },
        ],
        [
            short => {
                prompt   => "Shortcut",
                required => 1,
                valid    => \&validate_shortcut,
            },
        ],
    );
    my $realpath = abs_path $0;
    die("I can't figure out where $0 lives!\n") unless $realpath && -x $realpath;
    my $dirpath = dirname($realpath);
    die("The directory '${dirpath}' isn't writable by you -- I can't put shortcuts there.\n") unless -w $dirpath;
    my ( $procfile, $shortcut ) = populate_fields( \@fields );
    if ( defined $procfile ) {
        chdir($dirpath) or die("Can't chdir to $dirpath: $!\n");
        link $realpath, $procfile;
        symlink $procfile, $shortcut;
        printf("The shortcut '%s' has been created.\n", $shortcut);
    }
    exit(0);
}

#
# This is a very cheap and crusty user-input loop.  It needs some cleanup or replacement
# by something more standard (e.g., some module that handles form input).
#
sub input_fields {
    my ($fields, $print_header) = @_;
    my $item = 0;
    my $iter;
    local $| = 1;
    print( q{*** Entering input loop: your valid non-data input commands are: `back', `exit' or `quit'}, "\n")
        if $print_header;
    USER_LOOP: while (1) {
        $item = 0 if $item < 0;
        $iter = ${$fields}[$item];
        my $label = $iter->[0];
        my %opts  = %{ $iter->[1] };
        my $blk   = $opts{blank} && sprintf( 'EMPTY=%s', $opts{blank} ) || '';
        my $prompt = sprintf( '%s ', $opts{prompt} );
        $prompt .= sprintf( '[%s]', $blk ) if $blk;
        $prompt .= " --> ";
        print($prompt);
        my $field = <STDIN>;
        print("*EOF*\n"), return unless defined $field;
        chomp($field);
        $item--, redo if $field eq 'back';
        return if $field =~ /^(exit|quit)$/;
        my $len = length($field);
        if ( !$len && $opts{required} ) {
            printf( "***: field '%s' is required\n", $label );
            redo USER_LOOP;
        }
        my $valid = 1;
        if ( $opts{valid} && $len ) {
            $valid = $field =~ /$opts{valid}/
              if ( ref( $opts{valid} ) eq 'Regexp' );
            $valid = $opts{valid}->($field)
              if ( ref( $opts{valid} ) eq 'CODE' );
        }
        if ( !$valid && $len ) {
            my $nein = sprintf("***: User-input '%s' is malformed -- please re-enter", $field);
            $nein   .= ', or press ENTER to accept default' unless $opts{required};
            print($nein, "\n");
            redo USER_LOOP;
        }
        $fields->[$item]->[1]->{value} = $field;
        $item++;
        last USER_LOOP if $item > $#{$fields};
    }
    continue {
        $iter = ${$fields}[$item];
    }
    return $fields;
}

sub populate_fields {
    my ($fields) = @_;
    my $rv = input_fields($fields, 1);
    return unless defined $rv;
    my $proc =
      sprintf( '%s:%s:%s:%s:%s:%s', map( $_->[1]->{value}, @{$fields} ) );
    $proc =~ s/:+$//;
    return ( $proc, $fields->[-1]->[1]->{value} );
}

sub validate_shortcut {
    my ( $shortcut ) = @_;
    my $cmd = path_of( $shortcut );
    if ($cmd && -f $cmd && -x _) {
        my @query = ( [
            verify => {
                prompt   => sprintf("Your shortcut '%s' seems to already exist -- are you sure (Y/N)? ", $shortcut),
                valid    => qr/^[yn]/i,
                required => 1,
            },
        ], );
        input_fields(\@query, 0);
        return $query[0]->[1]->{value} =~ /^y/i;
    }
    return 1;
}

sub validate_user {
    my ( $user ) = @_;
    unless(defined(getpwnam($user))) {
        my @query = ( [
            verify => {
                prompt   => sprintf("The user '%s' does not seem to exist -- are you sure (Y/N)? ", $user),
                valid    => qr/^[yn]/i,
                required => 1,
            },
        ], );
        input_fields(\@query, 0);
        return $query[0]->[1]->{value} =~ /^y/i;
    }
    return 1;
}

__END__