File Coverage

blib/lib/Net/SCP/Expect.pm
Criterion Covered Total %
statement 47 194 24.2
branch 9 114 7.8
condition 26 81 32.1
subroutine 11 24 45.8
pod 8 8 100.0
total 101 421 23.9


line stmt bran cond sub pod time code
1             ##################################################################
2             # Net::SCP::Expect
3             #
4             # Wrapper for scp, with the ability to send passwords via Expect.
5             #
6             # See POD for more details.
7             ##################################################################
8             package Net::SCP::Expect;
9 3     3   120875 use strict;
  3         8  
  3         120  
10 3     3   17104 use Expect;
  3         188084  
  3         271  
11 3     3   39 use File::Basename;
  3         9  
  3         283  
12 3     3   19 use Carp;
  3         6  
  3         183  
13 3     3   16 use Cwd;
  3         7  
  3         297  
14 3     3   3265 use Net::IPv6Addr;
  3         187610  
  3         262  
15              
16             BEGIN{
17 3     3   36 use vars qw/$VERSION/;
  3         6  
  3         154  
18 3     3   7763 $VERSION = '0.16';
19             }
20              
21             # Options added as needed
22             sub new{
23 5     5 1 70 my($class,%arg) = @_;
24              
25 5   66     454 my $self = {
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
      50        
26             _host => $arg{host},
27             _user => $arg{user} || $ENV{'USER'},
28             _password => $arg{password},
29             _cipher => $arg{cipher},
30             _port => $arg{port},
31             _error_handler => $arg{error_handler},
32             _preserve => $arg{preserve} || 0,
33             _recursive => $arg{recursive} || 0,
34             _verbose => $arg{verbose} || 0,
35             _auto_yes => $arg{auto_yes} || 0,
36             _terminator => $arg{terminator} || "\n",
37             _timeout => $arg{timeout} || 10,
38             _timeout_auto => $arg{timeout_auto} || 1,
39             _timeout_err => $arg{timeout_err} || undef,
40             _no_check => $arg{no_check} || 0,
41             _protocol => $arg{protocol} || undef,
42             _identity_file => $arg{identity_file} || undef,
43             _option => $arg{option} || undef,
44             _subsystem => $arg{subsystem} || undef,
45             _scp_path => $arg{scp_path} || undef,
46             _auto_quote => $arg{auto_quote} || 1,
47             _compress => $arg{compress} || 0,
48             _force_ipv4 => $arg{force_ipv4} || 0,
49             _force_ipv6 => $arg{force_ipv6} || 0,
50             };
51              
52 5         26 bless($self,$class);
53             }
54              
55             sub _get{
56 67     67   116 my($self,$attr) = @_;
57              
58 67         250 return $self->{"_$attr"};
59             }
60              
61             sub _set{
62 0     0   0 my($self,$attr,$val) = @_;
63 0 0       0 croak("No attribute supplied to 'set()' method") unless defined $attr;
64 0         0 $self->{"_$attr"} = $val;
65             }
66              
67             sub auto_yes{
68 0     0 1 0 my($self,$val) = @_;
69 0 0       0 croak("No value passed to 'auto_yes()' method") unless defined $val;
70 0         0 $self->_set('auto_yes',$val);
71             }
72              
73             sub error_handler{
74 0     0 1 0 my($self,$sub) = @_;
75 0 0       0 croak("No sub supplied to 'error_handler()' method") unless defined $sub;
76 0         0 $self->_set('error_handler',$sub)
77             }
78              
79             sub login{
80 0     0 1 0 my($self,$user,$password) = @_;
81            
82 0 0       0 croak("No user supplied to 'login()' method") unless defined $user;
83 0 0 0     0 croak("No password supplied to 'login()' method") if @_ > 2 && !defined $password;
84              
85 0         0 $self->_set('user',$user);
86 0         0 $self->_set('password',$password);
87             }
88              
89             sub password{
90 0     0 1 0 my($self,$password) = @_;
91 0         0 croak("No password supplied to 'password()' method");
92            
93 0 0       0 $self->_set('password',$password) unless $password;
94             }
95              
96             sub host{
97 0     0 1 0 my($self,$host) = @_;
98 0 0       0 croak("No host supplied to 'host()' method") unless $host;
99              
100             # If host is an IPv6 address, strip any enclosing brackets if used
101 0 0 0     0 $host = substr($host, 1, length($host)-2) if $host && $host =~ /^\[/ && $host =~ /\]$/;
      0        
102              
103 0         0 $self->_set('host',$host);
104             }
105              
106              
107             sub user{
108 0     0 1 0 my($self,$user) = @_;
109 0 0       0 croak("No user supplied to 'user()' method") unless $user;
110 0         0 $self->_set('user',$user);
111             }
112              
113             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
114             # If the hostname is not included as part of the source, it is assumed to
115             # be part of the destination.
116             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
117             sub scp{
118 0     0 1 0 my($self,$from,$to) = @_;
119              
120 0         0 my $login = $self->_get('user');
121 0         0 my $password = $self->_get('password');
122 0         0 my $timeout = $self->_get('timeout');
123 0         0 my $timeout_auto = $self->_get('timeout_auto');
124 0         0 my $timeout_err = $self->_get('timeout_err');
125 0         0 my $cipher = $self->_get('cipher');
126 0         0 my $port = $self->_get('port');
127 0         0 my $recursive = $self->_get('recursive');
128 0         0 my $verbose = $self->_get('verbose');
129 0         0 my $preserve = $self->_get('preserve');
130 0         0 my $handler = $self->_get('error_handler');
131 0         0 my $auto_yes = $self->_get('auto_yes');
132 0         0 my $no_check = $self->_get('no_check');
133 0         0 my $terminator = $self->_get('terminator');
134 0         0 my $protocol = $self->_get('protocol');
135 0         0 my $identity_file = $self->_get('identity_file');
136 0         0 my $option = $self->_get('option');
137 0         0 my $subsystem = $self->_get('subsystem');
138 0         0 my $scp_path = $self->_get('scp_path');
139 0         0 my $auto_quote = $self->_get('auto_quote');
140 0         0 my $compress = $self->_get('compress');
141 0         0 my $force_ipv4 = $self->_get('force_ipv4');
142 0         0 my $force_ipv6 = $self->_get('force_ipv6');
143            
144             ##################################################################
145             # If the second argument is not provided, the remote file will be
146             # given the same (base) name as the local file (or vice-versa).
147             ##################################################################
148 0 0       0 unless($to){
149 0         0 $to = basename($from);
150             }
151              
152 0         0 my($host,$dest);
153              
154             # Parse the to/from string. If the $from contains a ':', assume it is a Remote to Local transfer
155 0 0       0 if($from =~ /:/){
156 0         0 ($login,$host,$dest) = $self->_parse_scp_string($from);
157 0         0 $from = $login . '@' . $self->_format_host_string($host) . ':';
158 0 0       0 $from .= "$dest" if $dest;
159             }
160             else{ # Local to Remote transfer
161 0         0 ($login,$host,$dest) = $self->_parse_scp_string($to);
162 0         0 $to = $login . '@' . $self->_format_host_string($host) . ':';
163 0 0       0 $to .= "$dest" if $dest;
164             }
165              
166 0 0       0 croak("No login. Can't scp") unless $login;
167 0 0 0     0 croak("No password or identity file. Can't scp") unless $password || $identity_file;
168 0 0       0 croak("No host specified. Can't scp") unless $host;
169              
170             # Define argument auto-quote
171 0 0       0 my $qt = $auto_quote ? '\'' : '';
172              
173             # Gather flags.
174 0         0 my $flags;
175              
176 0 0       0 $flags .= "-c $qt$cipher$qt " if $cipher;
177 0 0       0 $flags .= "-P $qt$port$qt " if $port;
178 0 0       0 $flags .= "-r " if $recursive;
179 0 0       0 $flags .= "-v " if $verbose;
180 0 0       0 $flags .= "-p " if $preserve;
181 0 0       0 $flags .= "-$qt$protocol$qt " if $protocol;
182 0         0 $flags .= "-q "; # Always pass this option (no progress meter)
183 0 0       0 $flags .= "-s $qt$subsystem$qt " if $subsystem;
184 0 0       0 $flags .= "-o $qt$option$qt " if $option;
185 0 0       0 $flags .= "-i $qt$identity_file$qt " if $identity_file;
186 0 0       0 $flags .= "-C " if $compress;
187 0 0       0 $flags .= "-4 " if $force_ipv4;
188 0 0       0 $flags .= "-6 " if $force_ipv6;
189              
190 0         0 my $scp = Expect->new;
191             #if($verbose){ $scp->raw_pty(1) }
192             #$scp->debug(1);
193              
194             # Use scp specified by the user, if possible
195 0 0       0 $scp_path = defined $scp_path ? "$qt$scp_path$qt" : "scp ";
196              
197             # Escape quotes
198 0 0       0 if ($auto_quote) {
199 0         0 $from =~ s/'/'"'"'/go;
200 0         0 $to =~ s/'/'"'"'/go;
201             }
202              
203 0         0 my $scp_string = "$scp_path $flags $qt$from$qt $qt$to$qt";
204 0         0 $scp = Expect->spawn($scp_string);
205            
206 0 0       0 unless ($scp) {
207 0 0       0 if($handler){ $handler->($!); return; }
  0         0  
  0         0  
208 0         0 else { croak("Couldn't start program: $!"); }
209             }
210              
211 0         0 $scp->log_stdout(0);
212              
213 0 0       0 if($auto_yes){
214 0         0 while($scp->expect($timeout_auto,-re=>'[Yy]es\/[Nn]o')){
215 0         0 $scp->send("yes\n");
216             }
217             }
218              
219 0 0       0 if ($password) {
220 0 0       0 unless($scp->expect($timeout,-re=>'[Pp]assword.*?:|[Pp]assphrase.*?:')){
221 0   0     0 my $err = $scp->before() || $scp->match();
222 0 0       0 if($err){
223 0 0       0 if($handler){ $handler->($err); return; }
  0         0  
  0         0  
224 0         0 else { croak("Problem performing scp: $err"); }
225             }
226 0         0 $err = "scp timed out while trying to connect to $host";
227 0 0       0 if($handler){ $handler->($err); return; }
  0         0  
  0         0  
228 0         0 else{ croak($err) };
229             }
230              
231 0 0       0 if($verbose){ print $scp->before() }
  0         0  
232              
233 0 0       0 $password .= $terminator if $terminator;
234              
235 0         0 $scp->send($password);
236             }
237              
238             ################################################################
239             # Check to see if we sent the correct password, or if we got
240             # some other bizarre error. Anything passed back to the
241             # terminal at this point means that something went wrong.
242             #
243             # The exception to this is verbose output, which can mistakenly
244             # be picked up by Expect.
245             ################################################################
246 0         0 my $error;
247 0         0 my $eof = 0;
248 0 0 0     0 unless($no_check || $verbose){
249              
250             $error = ($scp->expect($timeout_err,
251             [qr/[Pp]ass.*/ => sub{
252 0   0 0   0 my $error = $scp->before() || $scp->match();
253 0 0       0 if($handler){
254 0         0 $handler->($error);
255 0         0 return;
256             }
257             else{
258 0         0 croak("Error: Bad password [$error]");
259             }
260             }
261             ],
262             [qr/\w+.*/ => sub{
263 0   0 0   0 my $error = $scp->match() || $scp->before();
264 0 0       0 if($handler){
265 0         0 $handler->($error);
266 0         0 return;
267             }
268             else{
269 0         0 croak("Error: last line returned was: $error");
270             }
271             }
272             ],
273 0     0   0 ['eof' => sub{ $eof = 1 } ],
  0         0  
274             ))[1];
275             }
276             else{
277 0     0   0 $error = ($scp->expect($timeout_err, ['eof' => sub { $eof = 1 }]))[1];
  0         0  
278             }
279              
280 0 0       0 if($verbose){ print $scp->after(),"\n" }
  0         0  
281              
282             # Ignore error if it was due to scp auto-exiting successfully (which may trigger false positives on some platforms)
283 0 0 0     0 if ($error && !($eof && $error =~ m/^(2|3)/o)) {
      0        
284 0 0       0 if ($handler) {
285 0         0 $handler->($error);
286 0         0 return;
287             }
288             else {
289 0         0 croak("scp processing error occured: $error");
290             }
291             }
292            
293             # Insure we check exit state of process
294 0         0 $scp->hard_close();
295              
296 0 0       0 if ($scp->exitstatus > 0) { #ignore -1, in case there's a waitpid portability issue
297 0 0       0 if ($handler) {
298 0         0 $handler->($scp->exitstatus);
299 0         0 return;
300             }
301             else {
302 0         0 croak("scp exited with non-success state: " . $scp->exitstatus);
303             }
304             }
305              
306 0         0 return 1;
307             }
308              
309             # Break the from/to line into its various parts
310             sub _parse_scp_string{
311 29     29   13927 my($self,$string) = @_;
312 29         41 my @parts;
313 29         36 my($user,$host,$dest);
314              
315 29         88 @parts = split(/@/,$string,2);
316 29 100       68 if(scalar(@parts) == 2){
317 8         12 $user = shift(@parts);
318             }
319             else{
320 21         60 $user = $self->_get("user");
321             }
322              
323 29         63 my $temp = join('',@parts);
324 29         135 @parts = split(/:/,$temp);
325 29 100       73 if (@parts) {
326 23 100       48 if (@parts > 1) {
327 13         46 $host = join('',@parts[0,1..scalar(@parts)-2]);
328 13         21 $dest = $parts[-1];
329             } else {
330 10         216 $host = $parts[0];
331             }
332             }
333              
334             # scp('file','file') syntax, where local to remote is assumed
335 29 100       59 unless($dest){
336 16         20 $dest = $host;
337 16         36 $host = $self->_get("host");
338             }
339              
340 29   100     74 $host ||= $self->_get("host");
341              
342             # If host is an IPv6 address, strip any enclosing brackets if used
343 29 50 66     135 $host = substr($host, 1, length($host)-2) if $host && $host =~ /^\[/ && $host =~ /\]$/;
      33        
344              
345 29         293 return ($user,$host,$dest);
346             }
347              
348             sub _format_host_string{
349 0     0     my ($self,$host) = @_;
350              
351             # If host is an IPv6 address, verify it is correctly formatted for scp
352 0 0         if ($host) {
353 0 0 0       $host = substr($host, 1, length($host)-2) if $host =~ /^\[/ && $host =~ /\]$/;
354 0           local $@;
355 0 0         $host = "[$host]" if eval { Net::IPv6Addr::ipv6_parse($host) };
  0            
356             }
357              
358 0           return $host;
359             }
360             1;
361             __END__