File Coverage

bin/sshss

Criterion	Covered	Total	%
statement	60	69	86.9
branch	19	20	95.0
condition	4	9	44.4
subroutine	13	14	92.8
pod			n/a
total	96	112	85.7

#!/usr/bin/perl

use 5.006;
use strict;
use warnings;

our $VERSION = '0.006';

package App::SSH::SwitchShell;

use Cwd;
use English qw(-no_match_vars);
use File::Spec;

sub _exec (&@);

if ( !caller ) {
    main();
    exit 1;
}

sub main {
    configure_home();
    my $shell = configure_shell();

    # Get the last component of the shell name.
    my $shell0 = ( File::Spec->splitpath($shell) )[2];

    # If we have no command, execute the shell.  In this case, the shell
    # name to be passed in argv[0] is preceded by '-' to indicate that
    # this is a login shell.

    if ( !exists $ENV{SSH_ORIGINAL_COMMAND} ) {

        # Launch a login shell
        _exec { $shell } "-$shell0";
    }
    else {
        # Execute the command using the user's shell.  This uses the -c
        # option to execute the command.
        _exec { $shell } $shell0, '-c', $ENV{SSH_ORIGINAL_COMMAND};
    }

    return;
}

# We have to run exec from a small wrapper function to be able to test this
# script
# https://stackoverflow.com/questions/44597021/how-do-you-test-exec-used-with-indirect-object-syntax
sub _exec (&@) {
    my ( $file, @argv ) = @_;
    $file = $file->();

    {
        exec {$file} @argv;
    }

    print {*STDERR} "$ERRNO: $file\n";
    exit 1;
}

# Update the HOME env variable and change to the new home directory if we
# are configured for a shared account. Otherwise do nothung because SSH
# already ensures that HOME is configured correctly and we are chdir'd
# into it.
sub configure_home {
    my $myhome = get_abs_script_basedir();

    my @dirs = File::Spec->splitdir($myhome);
    return if $dirs[-1] ne '.ssh';
    pop @dirs;
    $myhome = File::Spec->catdir(@dirs);

    if ( exists $ENV{HOME} && defined $ENV{HOME} && -d $ENV{HOME} ) {
        my $home = File::Spec->canonpath( $ENV{HOME} );

        my $home_rp   = Cwd::realpath($home);
        my $myhome_rp = Cwd::realpath($myhome);
        return if $home_rp eq $myhome_rp;
    }

    $ENV{HOME} = $myhome;

    if ( !chdir $myhome ) {
        print {*STDERR} "Could not chdir to home '$myhome': $ERRNO";
    }

    return;
}

sub get_abs_script_basedir {
    my $basedir = File::Spec->rel2abs(__FILE__);
    $basedir = ( File::Spec->splitpath($basedir) )[1];
    $basedir = File::Spec->canonpath($basedir);

    return $basedir;
}

sub configure_shell {
    my $shell = get_shell();

    # Make sure SHELL points to the correct shell, either the shell
    # specified as argument, the shell from the password file, or /bin/sh
    $ENV{SHELL} = $shell;

    return $shell;
}

sub get_shell {

    # The shell can be specified as argument
    if (@ARGV) {
        my $shell = shift @ARGV;

        if ( !File::Spec->file_name_is_absolute($shell) ) {
            print {*STDERR} "Shell '$shell' is not an absolute path\n";
        }
        elsif ( !-e $shell ) {
            print {*STDERR} "Shell '$shell' does not exist\n";
        }
        else {
            return $shell if -x $shell;

            print {*STDERR} "Shell '$shell' is not executable\n";
        }
    }

    # Get the shell from the password data. An empty shell field is
    # legal, and means /bin/sh.

    my $shell = ( getpwuid $EUID )[8];
    return $shell if defined $shell && $shell ne q{};
    return '/bin/sh';
}

1;

__END__