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


line stmt bran cond sub pod time code
1             package XAS::Lib::SSH::Client::Shell;
2              
3             our $VERSION = '0.02';
4              
5             use XAS::Class
6 1         8 debug => 0,
7             version => $VERSION,
8             base => 'XAS::Lib::SSH::Client',
9             utils => ':validation trim',
10             constants => 'CRLF CODEREF',
11             vars => {
12             PARAMS => {
13             -eol => { optional => 1, default => "\012" }
14             }
15             }
16 1     1   747 ;
  1         1  
17              
18             #use Data::Dumper;
19              
20             # ----------------------------------------------------------------------
21             # Public Methods
22             # ----------------------------------------------------------------------
23              
24             sub setup {
25 0     0 1   my $self = shift;
26              
27 0           my $output;
28              
29             # Merge stderr and stdout.
30              
31 0           $self->chan->ext_data('merge');
32              
33             # The following needs to be done for shell access
34             #
35             # KpyM SSH needs a pty and dosen't seem to care what type
36             # Bitvise SSH needs a pty that is undefined
37             # OpenVMS SSH needs a pty and would really like a DEC terminal
38             # OpenSSH dosen't seem to care
39             # freeSSHD flat out doesn't work
40              
41 0           $self->chan->pty(''); # set up a default pty
42 0           $self->chan->shell(); # ask for a shell
43 0           $self->puts(''); # flush output buffer
44              
45             # Flush the input buffer. Discards any banners, welcomes,
46             # announcements, motds and other assorted stuff.
47              
48 0           while ($output = $self->get()) {
49              
50             # Parse the output looking for specific strings. There
51             # must be a better way...
52              
53 0 0         if ($output =~ /\[3;1f$/ ) {
    0          
    0          
54              
55             # Found a KpyM SSH Server, with the naq screen...
56             #
57             # cmd.exe expects a \r\n eol for command execution
58              
59 0           $self->{'eol'} = CRLF;
60              
61             # Need to wait for the "continue" line. Pay the
62             # danegield, but don't register the key, or this
63             # code will stop working!
64              
65 0           while ($output = $self->get()) {
66              
67 0 0         last if ($output =~ /continue\./);
68              
69             }
70              
71             } elsif ($output =~ /\[c$/) {
72              
73             # Found an OpenVMS SSH server. SET TERM/INQUIRE must
74             # be set for this code to work.
75             #
76             # DCL expects a \r\n eol for command execution.
77              
78 0           $self->{'eol'} = CRLF;
79              
80             # Wait for this line, it indicates that the terminal
81             # capabilities negotiation has finished.
82              
83 0           do {
84              
85 0           $output = $self->get();
86              
87             } until ($output =~ /\[0c$/);
88              
89             # give it a knudge, no terminal type was defined so
90             # the terminal driver is pondering this situation...
91              
92 0           $self->puts('');
93              
94             # get the "unknown terminal type" error
95              
96 0           do {
97              
98 0           $output = $self->gets;
99              
100             } while ($self->pending);
101              
102             # continue on
103              
104             } elsif ($output =~ /Microsoft/) {
105              
106             # found a Microsoft copyright notice.
107             #
108             # cmd.exe expects a \r\n eol for command execution
109              
110 0           $self->{eol} = CRLF;
111              
112             }
113              
114             }
115              
116 0           $self->puts(''); # get a command prompt
117 0           $self->gets(); # remove it from the buffer
118              
119             }
120              
121             sub run {
122 0     0 1   my $self = shift;
123 0           my ($command) = validate_params(\@_, [1] );
124              
125 0           $self->puts($command); # send the command
126 0           while ($self->gets()){}; # strip the echo back
127              
128             }
129              
130             sub call {
131 0     0 1   my $self = shift;
132 0           my ($command, $parser) = validate_params(\@_, [
133             1,
134             { type => CODEREF },
135             ]);
136              
137 0           my @output;
138              
139             # execute a command, retrieve the output and dispatch to a parser.
140              
141 0           $self->puts($command); # send the command
142              
143 0           $self->{'exit_code'} = $self->chan->exit_status;
144 0           $self->{'exit_signal'} = $self->chan->exit_signal;
145              
146             # retrieve the response
147              
148 0           do {
149              
150 0           my $line = $self->gets;
151 0           push(@output, $line);
152              
153             } while ($self->pending);
154              
155 0           return $parser->(\@output);
156              
157             }
158              
159             # ----------------------------------------------------------------------
160             # Private Methods
161             # ----------------------------------------------------------------------
162              
163             1;
164              
165             __END__