File: Base.pm

package info (click to toggle)
rex 1.14.1-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 3,012 kB
  • sloc: perl: 35,587; xml: 264; sh: 51; makefile: 13
file content (80 lines) | stat: -rw-r--r-- 1,641 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
#
# (c) Jan Gehring <jan.gehring@gmail.com>
#

package Rex::Interface::Shell::Base;

use v5.12.5;
use warnings;

our $VERSION = '1.14.1'; # VERSION

sub new {
  my $class = shift;
  my $self  = {};
  $self->{path}            = undef;
  $self->{__inner_shell__} = undef;

  bless( $self, $class );

  return $self;
}

sub name {
  my ($self)     = @_;
  my $class_name = ref $self;
  my @parts      = split( /::/, $class_name );
  return lc( $parts[-1] );
}

sub set_environment {
  my ( $self, $env ) = @_;
  $self->{__env__} = $env;
}

sub set_inner_shell {
  my ( $self, $use_inner_shell ) = @_;
  $self->{__inner_shell__} = $use_inner_shell;
}

sub set_locale {
  my ( $self, $locale ) = @_;
  $self->{locale} = $locale;
}

sub set_sudo_env {
  my ( $self, $sudo_env ) = @_;
  $self->{__sudo_env__} = $sudo_env;
}

sub detect {
  my ( $self, $con ) = @_;

  my $shell_class = ref $self || $self; # $self might be only the classname
  my @parts       = split /::/, $shell_class;
  my $last_part   = lc( $parts[-1] || "" );

  my ($shell_path) = $con->_exec("echo \$SHELL");
  if ( !$shell_path ) {

    # try it a second time
    # we need this sometimes because the tty allocation is too slow, or
    # doesn't work, or ???
    # it seems that this happens only for the very first command with
    # Net::OpenSSH when using a tty.
    Rex::Logger::debug(
      "Failed detecting shell in the first try. Trying again.");

    ($shell_path) = $con->_exec("echo \$SHELL");
  }

  $shell_path =~ s/(\r?\n)//gms; # remove unnecessary newlines

  if ( $shell_path && $shell_path =~ m/\/\Q$last_part\E$/ ) {
    return 1;
  }

  return 0;
}

1;