File Coverage

blib/lib/XAS/Lib/SSH/Client/Shell.pm

Criterion	Covered	Total	%
statement	3	37	8.1
branch	0	8	0.0
condition			n/a
subroutine	1	4	25.0
pod	3	3	100.0
total	7	52	13.4

package XAS::Lib::SSH::Client::Shell;

our $VERSION = '0.02';

use XAS::Class
  debug     => 0,
  version   => $VERSION,
  base      => 'XAS::Lib::SSH::Client',
  utils     => ':validation trim',
  constants => 'CRLF CODEREF',
  vars => {
    PARAMS => {
      -eol => { optional => 1, default => "\012" }
    }
  }
;

#use Data::Dumper;

# ----------------------------------------------------------------------
# Public Methods
# ----------------------------------------------------------------------

sub setup {
    my $self = shift;

    my $output;

    # Merge stderr and stdout.

    $self->chan->ext_data('merge');

    # The following needs to be done for shell access
    #
    # KpyM    SSH needs a pty and dosen't seem to care what type
    # Bitvise SSH needs a pty that is undefined
    # OpenVMS SSH needs a pty and would really like a DEC terminal
    # OpenSSH dosen't seem to care
    # freeSSHD flat out doesn't work

    $self->chan->pty('');        # set up a default pty
    $self->chan->shell();        # ask for a shell
    $self->puts('');             # flush output buffer

    # Flush the input buffer. Discards any banners, welcomes,
    # announcements, motds and other assorted stuff.

    while ($output = $self->get()) {

        # Parse the output looking for specific strings. There
        # must be a better way...

        if ($output =~ /\[3;1f$/ ) {

            # Found a KpyM SSH Server, with the naq screen...
            #
            # cmd.exe expects a \r\n eol for command execution

            $self->{'eol'} = CRLF;

            # Need to wait for the "continue" line. Pay the
            # danegield, but don't register the key, or this
            # code will stop working!

            while ($output = $self->get()) {

                last if ($output =~ /continue\./);

            }

        } elsif ($output =~ /\[c$/) {

            # Found an OpenVMS SSH server. SET TERM/INQUIRE must
            # be set for this code to work.
            #
            # DCL expects a \r\n eol for command execution.

            $self->{'eol'} = CRLF;

            # Wait for this line, it indicates that the terminal
            # capabilities negotiation has finished.

            do {

                $output = $self->get();

            } until ($output =~ /\[0c$/);

            # give it a knudge, no terminal type was defined so
            # the terminal driver is pondering this situation...

            $self->puts('');

            # get the "unknown terminal type" error

            do {

                $output = $self->gets;

            } while ($self->pending);

            # continue on

        } elsif ($output =~ /Microsoft/) {

            # found a Microsoft copyright notice.
            #
            # cmd.exe expects a \r\n eol for command execution

            $self->{eol} = CRLF;

        }

    }

    $self->puts('');       # get a command prompt
    $self->gets();         # remove it from the buffer

}

sub run {
    my $self = shift;
    my ($command) = validate_params(\@_, [1] );

    $self->puts($command);    # send the command
    while ($self->gets()){};  # strip the echo back

}

sub call {
    my $self = shift;
    my ($command, $parser) = validate_params(\@_, [
       1,
       { type => CODEREF },
    ]);

    my @output;

    # execute a command, retrieve the output and dispatch to a parser.

    $self->puts($command);      # send the command

    $self->{'exit_code'}   = $self->chan->exit_status;
    $self->{'exit_signal'} = $self->chan->exit_signal;

    # retrieve the response

    do {

        my $line = $self->gets;
        push(@output, $line);

    } while ($self->pending);

    return $parser->(\@output);

}

# ----------------------------------------------------------------------
# Private Methods
# ----------------------------------------------------------------------

1;

__END__