App-SSH-SwitchShell
view release on metacpan or search on metacpan
t/configure_shell.t view on Meta::CPAN
chmod 0755, $shell_from_getpwuid;
my @getpwuid_ref = ( 'username', 'x', 1000, 1000, q{}, q{}, q{}, '/tmp', $shell_from_getpwuid );
*App::SSH::SwitchShell::getpwuid = sub {
return @getpwuid_ref;
};
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ("$tmpdir/does_not_exist");
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'$tmpdir/does_not_exist' returns shell from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell '$tmpdir/does_not_exist' does not exist\n", '... prints that non existing shell does not exist to STDERR' );
}
my $shell_1 = "$tmpdir/testshell";
open $fh, '>', $shell_1;
close $fh;
chmod 0644, $shell_1;
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell_1);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'$shell_1' (not executable) returns shell from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell '$shell_1' is not executable\n", '... prints that shell is not executable to STDERR' );
}
chmod 0755, $shell_1;
SKIP: {
skip "File '$shell_1' is not executable - this OS seems to require more then chmod 0755" if !-x $shell_1;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell_1);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_1, "'$shell_1' (executable) returns '$shell_1'" );
is( $ENV{SHELL}, $shell_1, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
}
{
my $cwd = cwd();
chdir $tmpdir;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ('testshell');
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, q{'testshell' returns shell from getpwuid()} );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell 'testshell' is not an absolute path\n", '... prints that shell is not absolute path to STDERR' );
chdir $cwd;
}
chmod 0644, $shell_from_getpwuid;
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ();
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "no shell specified as argument returns '$shell_from_getpwuid' (not executable) from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
}
chmod 0644, $shell_1;
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell_1);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'$shell_1' (not executbale) returns '$shell_from_getpwuid' (not executable) from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell '$shell_1' is not executable\n", "... prints that '$shell_1' is not executable to STDERR" );
}
{
my $cwd = cwd();
chdir $tmpdir;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ('testshell');
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'testshell' returns '$shell_from_getpwuid' (not executable) from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell 'testshell' is not an absolute path\n", '... prints not absolute path error message to STDERR' );
chdir $cwd;
}
#
chdir $basedir;
note('login shell, script inside .ssh dir');
{
local $ENV{HOME} = '/home/dummy';
local $ENV{SHELL} = '/bin/dummy';
$script_basedir = File::Spec->catdir( $tmpdir, '.ssh' );
mkdir $script_basedir;
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
is( $ENV{HOME}, $tmpdir, '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), $tmpdir, '... cwd is correctly changed' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
}
note(q{run 'perl -v', script inside .ssh dir});
{
local $ENV{HOME} = '/home/dummy';
local $ENV{SHELL} = '/bin/dummy';
local $ENV{SSH_ORIGINAL_COMMAND} = "$EXECUTABLE_NAME -v";
$script_basedir = File::Spec->catdir( $tmpdir, '.ssh' );
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT (because we mocked _exec)' );
is( $stderr, q{}, '... prints nothing to STDERR' );
is( $ENV{HOME}, $tmpdir, '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), $tmpdir, '... cwd is correctly changed' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
}
note('login shell, script in "invalid directory"');
{
local $ENV{HOME} = '/home/dummy';
local $ENV{SHELL} = '/bin/dummy';
my $not_existing_home = File::Spec->catdir( $tmpdir, 'dir_does_not_exist' );
$script_basedir = File::Spec->catdir( $not_existing_home, '.ssh' );
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
like( $stderr, "/ ^ \QCould not chdir to home '$not_existing_home':\E /xsm", '... prints that chdir() failed to STDERR' );
is( $ENV{HOME}, $not_existing_home, '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), $basedir, '... cwd is not changed because dir does not exist' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
}
note('login shell, script in ~/.ssh');
{
local $ENV{HOME} = $tmpdir;
local $ENV{SHELL} = '/bin/dummy';
chdir $tmpdir;
$script_basedir = File::Spec->catdir( $tmpdir, '.ssh' );
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
is( $ENV{HOME}, $tmpdir, '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), $tmpdir, '... cwd is correctly changed' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
symlink 'HOMEDIR', $homelnk;
$script_basedir = File::Spec->catdir( $homelnk, 'abc' );
mkdir $script_basedir;
$script_basedir = File::Spec->catdir( $script_basedir, '.ssh' );
mkdir $script_basedir;
local $ENV{HOME} = $homelnk;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
is( $ENV{HOME}, File::Spec->catdir( $homelnk, 'abc' ), '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), File::Spec->catdir( $homedir, 'abc' ), '... cwd is correctly changed' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
note('login shell, HOME is reached through symlink, script basedir is not');
{
my $homedir = File::Spec->catdir( $tmpdir, 'HOMEDIR' );
my $homelnk = File::Spec->catfile( $tmpdir, 'HOMELINK' );
local $ENV{HOME} = $homelnk;
local $ENV{SHELL} = '/bin/dummy';
$script_basedir = File::Spec->catdir( $homedir, 'abc', '.ssh' );
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
is( $ENV{HOME}, File::Spec->catdir( $homedir, 'abc' ), '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), File::Spec->catdir( $homedir, 'abc' ), '... cwd is correctly changed' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
note('login shell, script basedir is reached through symlink, HOME is not');
{
my $homedir = File::Spec->catdir( $tmpdir, 'HOMEDIR' );
my $homelnk = File::Spec->catfile( $tmpdir, 'HOMELINK' );
local $ENV{HOME} = $homedir;
local $ENV{SHELL} = '/bin/dummy';
$script_basedir = File::Spec->catdir( $homelnk, 'abc', '.ssh' );
local @ARGV = ($shell);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::main() };
is( $result[0], undef, 'main() returns undef (because we mocked _exec)' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
is( $ENV{HOME}, File::Spec->catdir( $homelnk, 'abc' ), '... HOME environment variable is correctly set' );
is( $ENV{SHELL}, $shell, '... SHELL environment variable is correctly set' );
is( cwd(), File::Spec->catdir( $homedir, 'abc' ), '... cwd is correctly changed' );
my $exec_file = ( shift @exec_args )->();
is( $exec_file, $shell, '... the correct shell was run' );
( run in 0.278 second using v1.01-cache-2.11-cpan-eab888a1d7d )