File Coverage

lib/Rex/Helper/SSH2/Expect.pm
Criterion Covered Total %
statement 5 60 8.3
branch 0 12 0.0
condition 0 3 0.0
subroutine 2 15 13.3
pod 8 9 88.8
total 15 99 15.1


line stmt bran cond sub pod time code
1             #
2             # (c) 2011 Jan Gehring
3             #
4              
5             =head1 NAME
6              
7             Rex::Helper::SSH2::Expect - An Expect like module for Net::SSH2
8              
9             =head1 DESCRIPTION
10              
11             This is a module to have expect like features for Net::SSH2. This is the first version of this module. Please report bugs at GitHub L
12              
13             =head1 DEPENDENCIES
14              
15             =over 4
16              
17             =item *
18              
19             L
20              
21             =back
22              
23             =head1 SYNOPSIS
24              
25             use Rex::Helper::SSH2::Expect;
26              
27             my $exp = Rex::Helper::SSH2::Expect->new($ssh2);
28             $exp->spawn("passwd");
29             $exp->expect($timeout, [
30             qr/Enter new UNIX password:/ => sub {
31             my ($exp, $line) = @_;
32             $exp->send($new_password);
33             }
34             ],
35             [
36             qr/Retype new UNIX password:/ => sub {
37             my ($exp, $line) = @_;
38             $exp->send($new_password);
39             }
40             ],
41             [
42             qr/passwd: password updated successfully/ => sub {
43             my ($exp, $line) = @_;
44             $exp->hard_close;
45             }
46             ]);
47              
48             =head1 CLASS METHODS
49              
50             =cut
51              
52             package Rex::Helper::SSH2::Expect;
53              
54 83     83   1100 use v5.12.5;
  83         283  
55 83     83   466 use warnings;
  83         148  
  83         63507  
56              
57             our $VERSION = '1.14.3'; # VERSION
58              
59             =head2 new($ssh2)
60              
61             Constructor: You need to parse an connected Net::SSH2 Object.
62              
63             =cut
64              
65             our $Log_Stdout = 1;
66              
67             sub new {
68 0     0 1   my $that = shift;
69 0   0       my $proto = ref($that) || $that;
70 0           my $self = {};
71              
72 0           bless( $self, $proto );
73              
74 0           $self->{"__shell"} = $_[0]->channel();
75 0           $self->{"__shell"}->pty("vt100");
76 0           $self->{"__shell"}->shell;
77              
78 0           $self->{"__log_stdout"} = $Rex::Helper::SSH2::Expect::Log_Stdout;
79 0     0     $self->{"__log_to"} = sub { };
80              
81 0           return $self;
82             }
83              
84             =head2 log_stdout(0|1)
85              
86             Log on STDOUT.
87              
88             =cut
89              
90             sub log_stdout {
91 0     0 1   my ( $self, $log ) = @_;
92 0           $self->{"__log_stdout"} = $log;
93             }
94              
95             =head2 log_file($file)
96              
97             Log everything to a file. $file can be a filename, a filehandle or a subRef.
98              
99             =cut
100              
101             sub log_file {
102 0     0 1   my ( $self, $file ) = @_;
103 0           $self->{"__log_to"} = $file;
104             }
105              
106             sub shell {
107 0     0 0   my ($self) = @_;
108 0           return $self->{"__shell"};
109             }
110              
111             =head2 spawn($command, @parameters)
112              
113             Spawn $command with @parameters as parameters.
114              
115             =cut
116              
117             sub spawn {
118 0     0 1   my ( $self, $command, @parameters ) = @_;
119              
120 0           my $cmd = "$command " . join( " ", @parameters );
121 0           $self->shell->write("$cmd\n");
122             }
123              
124             =head2 soft_close()
125              
126             Currently only an alias to hard_close();
127              
128             =cut
129              
130             sub soft_close {
131 0     0 1   my ($self) = @_;
132 0           $self->hard_close;
133             }
134              
135             =head2 hard_close();
136              
137             Stops the execution of the process.
138              
139             =cut
140              
141             sub hard_close {
142 0     0 1   my ($self) = @_;
143 0           die;
144             }
145              
146             =head2 expect($timeout, @match_patters)
147              
148             This method controls the execution of your process.
149              
150             =cut
151              
152             sub expect {
153 0     0 1   my ( $self, $timeout, @match_patterns ) = @_;
154              
155 0           eval {
156 0     0     local $SIG{'ALRM'} = sub { die; };
  0            
157 0           alarm $timeout;
158              
159 0           my $line = "";
160 0           while (1) {
161 0           my $buf;
162 0           $self->shell->read( $buf, 1 );
163              
164             # log to stdout if wanted
165 0 0         print $buf if $self->{"__log_stdout"};
166 0           $self->_log($buf);
167              
168 0 0         if ( $self->_check_patterns( $line, @match_patterns ) ) {
169 0           $line = "";
170 0           alarm $timeout;
171 0           next;
172             }
173 0           $line .= $buf;
174             }
175             };
176             }
177              
178             =head2 send($string)
179              
180             Send a string to the running command.
181              
182             =cut
183              
184             sub send {
185 0     0 1   my ( $self, $str ) = @_;
186 0           $self->shell->write($str);
187             }
188              
189             sub _check_patterns {
190 0     0     my ( $self, $line, @match_patterns ) = @_;
191              
192 0           for my $pattern (@match_patterns) {
193 0 0         if ( $line =~ $pattern->[0] ) {
194 0           my $code = $pattern->[1];
195 0           &$code( $self, $line );
196 0           return 1;
197             }
198             }
199             }
200              
201             sub _log {
202 0     0     my ( $self, $str ) = @_;
203              
204 0           my $log_to = $self->{"__log_to"};
205              
206 0 0         if ( ref($log_to) eq "CODE" ) {
    0          
207 0           &$log_to($str);
208             }
209             elsif ( ref($log_to) eq "GLOB" ) {
210 0           print $log_to $str;
211             }
212             else {
213             # log to a file
214 0 0         open( my $fh, ">>", $log_to ) or die($!);
215 0           print $fh $str;
216 0           close($fh);
217             }
218              
219             }
220              
221             1;