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__ |