view release on metacpan or  search on metacpan

t/configure_home.t  view on Meta::CPAN

        is( $stderr,                        q{},     '... prints nothing to STDERR' );
        is( $ENV{HOME},                     $tmpdir, '... HOME environment variable is correctly set' );
        is( File::Spec->canonpath( cwd() ), $tmpdir, '... cwd is correctly changed' );

        chdir $basedir;
    }

    note('feed invalid dir');
    {
        local $ENV{HOME} = '/home/dummy';
        my $not_existing_home = File::Spec->catdir( $tmpdir, 'dir_does_not_exist' );
        $script_basedir = File::Spec->catdir( $not_existing_home, '.ssh' );

        my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_home() };
        is( $result[0], undef, 'configure_home() returns undef' );
        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( cwd(),      $basedir,           '... cwd is not changed because dir does not exist' );

        chdir $basedir;
    }

    note('HOME env variable same as script basedir');
    {
        local $ENV{HOME} = $tmpdir;
        $script_basedir = File::Spec->catdir( $tmpdir, '.ssh' );

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);

t/main.t  view on Meta::CPAN

        is_deeply( \@exec_args, [ 'shell.pl', '-c', "$EXECUTABLE_NAME -v" ], '... with the correct arguments' );

        chdir $basedir;
    }

    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' );
        is_deeply( \@exec_args, [qw(-shell.pl)], '... with the correct arguments' );

        chdir $basedir;
    }

    note('login shell, script in ~/.ssh');