line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::SFTP::Foreign; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '1.93'; |
4
|
|
|
|
|
|
|
|
5
|
3
|
|
|
3
|
|
132314
|
use strict; |
|
3
|
|
|
|
|
26
|
|
|
3
|
|
|
|
|
83
|
|
6
|
3
|
|
|
3
|
|
13
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
70
|
|
7
|
3
|
|
|
3
|
|
14
|
use warnings::register; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
418
|
|
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
17
|
use Carp qw(carp croak); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
149
|
|
10
|
|
|
|
|
|
|
|
11
|
3
|
|
|
3
|
|
1451
|
use Symbol (); |
|
3
|
|
|
|
|
2108
|
|
|
3
|
|
|
|
|
61
|
|
12
|
3
|
|
|
3
|
|
1225
|
use Errno (); |
|
3
|
|
|
|
|
3668
|
|
|
3
|
|
|
|
|
68
|
|
13
|
3
|
|
|
3
|
|
16
|
use Fcntl; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
630
|
|
14
|
3
|
|
|
3
|
|
30
|
use File::Spec (); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
57
|
|
15
|
3
|
|
|
3
|
|
1481
|
use Time::HiRes (); |
|
3
|
|
|
|
|
3993
|
|
|
3
|
|
|
|
|
65
|
|
16
|
3
|
|
|
3
|
|
1461
|
use POSIX (); |
|
3
|
|
|
|
|
17061
|
|
|
3
|
|
|
|
|
289
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
BEGIN { |
19
|
3
|
50
|
|
3
|
|
17
|
if ($] >= 5.008) { |
20
|
3
|
|
|
|
|
1554
|
require Encode; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
else { |
23
|
|
|
|
|
|
|
# Work around for incomplete Unicode handling in perl 5.6.x |
24
|
0
|
|
|
|
|
0
|
require bytes; |
25
|
0
|
|
|
|
|
0
|
bytes->import(); |
26
|
0
|
|
|
|
|
0
|
*Encode::encode = sub { $_[1] }; |
|
0
|
|
|
|
|
0
|
|
27
|
0
|
|
|
|
|
0
|
*Encode::decode = sub { $_[1] }; |
|
0
|
|
|
|
|
0
|
|
28
|
0
|
|
|
|
|
0
|
*utf8::downgrade = sub { 1 }; |
|
0
|
|
|
|
|
0
|
|
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# we make $Net::SFTP::Foreign::Helpers::debug an alias for |
33
|
|
|
|
|
|
|
# $Net::SFTP::Foreign::debug so that the user can set it without |
34
|
|
|
|
|
|
|
# knowing anything about the Helpers package! |
35
|
|
|
|
|
|
|
our $debug; |
36
|
3
|
|
|
3
|
|
28290
|
BEGIN { *Net::SFTP::Foreign::Helpers::debug = \$debug }; |
37
|
3
|
|
|
|
|
281
|
use Net::SFTP::Foreign::Helpers qw(_is_reg _is_lnk _is_dir _debug |
38
|
|
|
|
|
|
|
_sort_entries _gen_wanted |
39
|
|
|
|
|
|
|
_gen_converter _hexdump |
40
|
|
|
|
|
|
|
_ensure_list _catch_tainted_args |
41
|
|
|
|
|
|
|
_file_part _umask_save_and_set |
42
|
3
|
|
|
3
|
|
1371
|
_untaint); |
|
3
|
|
|
|
|
7
|
|
43
|
3
|
|
|
|
|
1426
|
use Net::SFTP::Foreign::Constants qw( :fxp :flags :att |
44
|
|
|
|
|
|
|
:status :error |
45
|
3
|
|
|
3
|
|
1315
|
SSH2_FILEXFER_VERSION ); |
|
3
|
|
|
|
|
8
|
|
46
|
3
|
|
|
3
|
|
1395
|
use Net::SFTP::Foreign::Attributes; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
84
|
|
47
|
3
|
|
|
3
|
|
19
|
use Net::SFTP::Foreign::Buffer; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
288
|
|
48
|
|
|
|
|
|
|
require Net::SFTP::Foreign::Common; |
49
|
|
|
|
|
|
|
our @ISA = qw(Net::SFTP::Foreign::Common); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
our $dirty_cleanup; |
52
|
|
|
|
|
|
|
my $windows; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
BEGIN { |
55
|
3
|
|
|
3
|
|
16
|
$windows = $^O =~ /Win(?:32|64)/; |
56
|
|
|
|
|
|
|
|
57
|
3
|
50
|
|
|
|
316
|
if ($^O =~ /solaris/i) { |
58
|
0
|
0
|
|
|
|
0
|
$dirty_cleanup = 1 unless defined $dirty_cleanup; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $thread_generation = 1; |
63
|
0
|
|
|
0
|
|
0
|
sub CLONE { $thread_generation++ } |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub _deprecated { |
66
|
0
|
0
|
0
|
0
|
|
0
|
if (warnings::enabled('deprecated') and warnings::enabled(__PACKAGE__)) { |
67
|
0
|
|
|
|
|
0
|
Carp::carp(join('', @_)); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
0
|
|
0
|
sub _next_msg_id { shift->{_msg_id}++ } |
72
|
|
|
|
|
|
|
|
73
|
3
|
|
|
3
|
|
31
|
use constant _empty_attributes => Net::SFTP::Foreign::Attributes->new; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub _queue_new_msg { |
76
|
0
|
|
|
0
|
|
0
|
my $sftp = shift; |
77
|
0
|
|
|
|
|
0
|
my $code = shift; |
78
|
0
|
|
|
|
|
0
|
my $id = $sftp->_next_msg_id; |
79
|
0
|
|
|
|
|
0
|
$sftp->{incomming}{$id} = undef; |
80
|
0
|
|
|
|
|
0
|
my $msg = Net::SFTP::Foreign::Buffer->new(int8 => $code, int32 => $id, @_); |
81
|
0
|
|
|
|
|
0
|
$sftp->_queue_msg($msg); |
82
|
0
|
|
|
|
|
0
|
return $id; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub _queue_msg { |
86
|
0
|
|
|
0
|
|
0
|
my ($sftp, $buf) = @_; |
87
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
0
|
my $bytes = $buf->bytes; |
89
|
0
|
|
|
|
|
0
|
my $len = length $bytes; |
90
|
|
|
|
|
|
|
|
91
|
0
|
0
|
0
|
|
|
0
|
if ($debug and $debug & 1) { |
92
|
0
|
|
|
|
|
0
|
$sftp->{_queued}++; |
93
|
0
|
|
|
|
|
0
|
_debug(sprintf("queueing msg len: %i, code:%i, id:%i ... [$sftp->{_queued}]", |
94
|
|
|
|
|
|
|
$len, unpack(CN => $bytes))); |
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
0
|
$debug & 16 and _hexdump(pack('N', length($bytes)) . $bytes); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
0
|
$sftp->{_bout} .= pack('N', length($bytes)); |
100
|
0
|
|
|
|
|
0
|
$sftp->{_bout} .= $bytes; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
0
|
|
|
0
|
|
0
|
sub _do_io { $_[0]->{_backend}->_do_io(@_) } |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub _conn_lost { |
107
|
0
|
|
|
0
|
|
0
|
my ($sftp, $status, $err, @str) = @_; |
108
|
|
|
|
|
|
|
|
109
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32 and _debug("_conn_lost"); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$sftp->{_status} or |
112
|
0
|
0
|
|
|
|
0
|
$sftp->_set_status(defined $status ? $status : SSH2_FX_CONNECTION_LOST); |
|
|
0
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
$sftp->{_error} or |
115
|
0
|
0
|
|
|
|
0
|
$sftp->_set_error((defined $err ? $err : SFTP_ERR_CONNECTION_BROKEN), |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
116
|
|
|
|
|
|
|
(@str ? @str : "Connection to remote server is broken")); |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
0
|
undef $sftp->{_connected}; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _conn_failed { |
122
|
0
|
|
|
0
|
|
0
|
my $sftp = shift; |
123
|
|
|
|
|
|
|
$sftp->_conn_lost(SSH2_FX_NO_CONNECTION, |
124
|
|
|
|
|
|
|
SFTP_ERR_CONNECTION_BROKEN, |
125
|
|
|
|
|
|
|
@_) |
126
|
0
|
0
|
|
|
|
0
|
unless $sftp->{_error}; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub _get_msg { |
130
|
0
|
|
|
0
|
|
0
|
my $sftp = shift; |
131
|
|
|
|
|
|
|
|
132
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 1 and _debug("waiting for message... [$sftp->{_queued}]"); |
133
|
|
|
|
|
|
|
|
134
|
0
|
0
|
|
|
|
0
|
unless ($sftp->_do_io($sftp->{_timeout})) { |
135
|
0
|
|
|
|
|
0
|
$sftp->_conn_lost(undef, undef, "Connection to remote server stalled"); |
136
|
0
|
|
|
|
|
0
|
return undef; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
0
|
my $bin = \$sftp->{_bin}; |
140
|
0
|
|
|
|
|
0
|
my $len = unpack N => substr($$bin, 0, 4, ''); |
141
|
0
|
|
|
|
|
0
|
my $msg = Net::SFTP::Foreign::Buffer->make(substr($$bin, 0, $len, '')); |
142
|
|
|
|
|
|
|
|
143
|
0
|
0
|
0
|
|
|
0
|
if ($debug and $debug & 1) { |
144
|
0
|
|
|
|
|
0
|
$sftp->{_queued}--; |
145
|
0
|
|
|
|
|
0
|
my ($code, $id, $status) = unpack( CNN => $$msg); |
146
|
0
|
0
|
|
|
|
0
|
$id = '-' if $code == SSH2_FXP_VERSION; |
147
|
0
|
0
|
|
|
|
0
|
$status = '-' unless $code == SSH2_FXP_STATUS; |
148
|
0
|
|
|
|
|
0
|
_debug(sprintf("got it!, len:%i, code:%i, id:%s, status: %s", |
149
|
|
|
|
|
|
|
$len, $code, $id, $status)); |
150
|
0
|
0
|
|
|
|
0
|
$debug & 8 and _hexdump($$msg); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
0
|
return $msg; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub _croak_bad_options { |
157
|
0
|
0
|
|
0
|
|
0
|
if (@_) { |
158
|
0
|
0
|
|
|
|
0
|
my $s = (@_ > 1 ? 's' : ''); |
159
|
0
|
|
|
|
|
0
|
croak "Invalid option$s '" . CORE::join("', '", @_) . "' or bad combination of options"; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub _fs_encode { |
164
|
0
|
|
|
0
|
|
0
|
my ($sftp, $path) = @_; |
165
|
0
|
|
|
|
|
0
|
Encode::encode($sftp->{_fs_encoding}, $path); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub _fs_decode { |
169
|
0
|
|
|
0
|
|
0
|
my ($sftp, $path) = @_; |
170
|
0
|
|
|
|
|
0
|
Encode::decode($sftp->{_fs_encoding}, $path); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub new { |
174
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
175
|
|
|
|
|
|
|
|
176
|
0
|
|
|
|
|
0
|
my $class = shift; |
177
|
0
|
0
|
|
|
|
0
|
unshift @_, 'host' if @_ & 1; |
178
|
0
|
|
|
|
|
0
|
my %opts = @_; |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
0
|
my $sftp = { _msg_id => 0, |
181
|
|
|
|
|
|
|
_bout => '', |
182
|
|
|
|
|
|
|
_bin => '', |
183
|
|
|
|
|
|
|
_connected => 1, |
184
|
|
|
|
|
|
|
_queued => 0, |
185
|
|
|
|
|
|
|
_error => 0, |
186
|
|
|
|
|
|
|
_status => 0, |
187
|
|
|
|
|
|
|
_incomming => {} }; |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
0
|
bless $sftp, $class; |
190
|
|
|
|
|
|
|
|
191
|
0
|
0
|
|
|
|
0
|
if ($debug) { |
192
|
0
|
|
|
|
|
0
|
_debug "This is Net::SFTP::Foreign $Net::SFTP::Foreign::VERSION"; |
193
|
0
|
|
|
|
|
0
|
_debug "Loaded from $INC{'Net/SFTP/Foreign.pm'}"; |
194
|
0
|
|
|
|
|
0
|
_debug "Running on Perl $^V for $^O"; |
195
|
0
|
|
|
|
|
0
|
_debug "debug set to $debug"; |
196
|
0
|
|
|
|
|
0
|
_debug "~0 is " . ~0; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
0
|
my $backend = delete $opts{backend}; |
202
|
0
|
0
|
|
|
|
0
|
unless (ref $backend) { |
203
|
0
|
0
|
|
|
|
0
|
$backend = ($windows ? 'Windows' : 'Unix') |
|
|
0
|
|
|
|
|
|
204
|
|
|
|
|
|
|
unless (defined $backend); |
205
|
0
|
0
|
|
|
|
0
|
$backend =~ /^\w+$/ |
206
|
|
|
|
|
|
|
or croak "Bad backend name $backend"; |
207
|
0
|
|
|
|
|
0
|
my $backend_class = "Net::SFTP::Foreign::Backend::$backend"; |
208
|
0
|
0
|
|
|
|
0
|
eval "require $backend_class; 1" |
209
|
|
|
|
|
|
|
or croak "Unable to load backend $backend: $@"; |
210
|
0
|
|
|
|
|
0
|
$backend = $backend_class->_new($sftp, \%opts); |
211
|
|
|
|
|
|
|
} |
212
|
0
|
|
|
|
|
0
|
$sftp->{_backend} = $backend; |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
0
|
if ($debug) { |
215
|
0
|
|
0
|
|
|
0
|
my $class = ref($backend) || $backend; |
216
|
3
|
|
|
3
|
|
21
|
no strict 'refs'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
15411
|
|
217
|
0
|
|
0
|
|
|
0
|
my $version = ${$class .'::VERSION'} || 0; |
218
|
0
|
|
|
|
|
0
|
_debug "Using backend $class $version"; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
0
|
my %defs = $backend->_defaults; |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
0
|
$sftp->{_autodie} = delete $opts{autodie}; |
224
|
0
|
|
0
|
|
|
0
|
$sftp->{_block_size} = delete $opts{block_size} || $defs{block_size} || 32*1024; |
225
|
0
|
|
0
|
|
|
0
|
$sftp->{_min_block_size} = delete $opts{min_block_size} || $defs{min_block_size} || 512; |
226
|
0
|
|
0
|
|
|
0
|
$sftp->{_queue_size} = delete $opts{queue_size} || $defs{queue_size} || 32; |
227
|
0
|
|
0
|
|
|
0
|
$sftp->{_read_ahead} = $defs{read_ahead} || $sftp->{_block_size} * 4; |
228
|
0
|
|
0
|
|
|
0
|
$sftp->{_write_delay} = $defs{write_delay} || $sftp->{_block_size} * 8; |
229
|
0
|
|
|
|
|
0
|
$sftp->{_autoflush} = delete $opts{autoflush}; |
230
|
0
|
|
|
|
|
0
|
$sftp->{_late_set_perm} = delete $opts{late_set_perm}; |
231
|
0
|
|
|
|
|
0
|
$sftp->{_dirty_cleanup} = delete $opts{dirty_cleanup}; |
232
|
0
|
|
|
|
|
0
|
$sftp->{_remote_has_volumes} = delete $opts{remote_has_volumes}; |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
0
|
$sftp->{_timeout} = delete $opts{timeout}; |
235
|
0
|
0
|
0
|
|
|
0
|
defined $sftp->{_timeout} and $sftp->{_timeout} <= 0 and croak "invalid timeout"; |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
0
|
$sftp->{_fs_encoding} = delete $opts{fs_encoding}; |
238
|
0
|
0
|
|
|
|
0
|
if (defined $sftp->{_fs_encoding}) { |
239
|
0
|
0
|
|
|
|
0
|
$] < 5.008 |
240
|
|
|
|
|
|
|
and carp "fs_encoding feature is not supported in this perl version $]"; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
else { |
243
|
0
|
|
|
|
|
0
|
$sftp->{_fs_encoding} = 'utf8'; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
0
|
$sftp->autodisconnect(delete $opts{autodisconnect}); |
247
|
|
|
|
|
|
|
|
248
|
0
|
|
|
|
|
0
|
$backend->_init_transport($sftp, \%opts); |
249
|
0
|
0
|
|
|
|
0
|
%opts and _croak_bad_options(keys %opts); |
250
|
|
|
|
|
|
|
|
251
|
0
|
0
|
|
|
|
0
|
$sftp->_init unless $sftp->{_error}; |
252
|
0
|
|
|
|
|
0
|
$backend->_after_init($sftp); |
253
|
0
|
|
|
|
|
0
|
$sftp |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub autodisconnect { |
257
|
0
|
|
|
0
|
1
|
0
|
my ($sftp, $ad) = @_; |
258
|
0
|
0
|
0
|
|
|
0
|
if (not defined $ad or $ad == 2) { |
259
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "setting disconnecting pid to $$ and thread to $thread_generation"; |
260
|
0
|
|
|
|
|
0
|
$sftp->{_disconnect_by_pid} = $$; |
261
|
0
|
|
|
|
|
0
|
$sftp->{_disconnect_by_thread} = $thread_generation; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
else { |
264
|
0
|
|
|
|
|
0
|
delete $sftp->{_disconnect_by_thread}; |
265
|
0
|
0
|
|
|
|
0
|
if ($ad == 0) { |
|
|
0
|
|
|
|
|
|
266
|
0
|
|
|
|
|
0
|
$sftp->{_disconnect_by_pid} = -1; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
elsif ($ad == 1) { |
269
|
0
|
|
|
|
|
0
|
delete $sftp->{_disconnect_by_pid}; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
else { |
272
|
0
|
|
|
|
|
0
|
croak "bad value '$ad' for autodisconnect"; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
0
|
|
|
|
|
0
|
1; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub disconnect { |
279
|
0
|
|
|
0
|
1
|
0
|
my $sftp = shift; |
280
|
0
|
|
|
|
|
0
|
my $pid = delete $sftp->{pid}; |
281
|
|
|
|
|
|
|
|
282
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug("$sftp->disconnect called (ssh pid: ".($pid||'').")"); |
|
|
|
0
|
|
|
|
|
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
0
|
local $sftp->{_autodie}; |
285
|
0
|
|
|
|
|
0
|
$sftp->_conn_lost; |
286
|
|
|
|
|
|
|
|
287
|
0
|
0
|
|
|
|
0
|
if (defined $pid) { |
288
|
0
|
0
|
0
|
|
|
0
|
close $sftp->{ssh_out} if (defined $sftp->{ssh_out} and not $sftp->{_ssh_out_is_not_dupped}); |
289
|
0
|
0
|
|
|
|
0
|
close $sftp->{ssh_in} if defined $sftp->{ssh_in}; |
290
|
0
|
0
|
|
|
|
0
|
if ($windows) { |
291
|
0
|
0
|
|
|
|
0
|
kill KILL => $pid |
292
|
|
|
|
|
|
|
and waitpid($pid, 0); |
293
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "process $pid reaped"; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
else { |
296
|
|
|
|
|
|
|
my $dirty = ( defined $sftp->{_dirty_cleanup} |
297
|
|
|
|
|
|
|
? $sftp->{_dirty_cleanup} |
298
|
0
|
0
|
|
|
|
0
|
: $dirty_cleanup ); |
299
|
|
|
|
|
|
|
|
300
|
0
|
0
|
0
|
|
|
0
|
if ($dirty or not defined $dirty) { |
301
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug("starting dirty cleanup of process $pid"); |
302
|
0
|
0
|
|
|
|
0
|
OUT: for my $sig (($dirty ? () : 0), qw(TERM TERM KILL KILL)) { |
303
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug("killing process $pid with signal $sig"); |
304
|
0
|
0
|
|
|
|
0
|
$sig and kill $sig, $pid; |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
0
|
local ($@, $SIG{__DIE__}, $SIG{__WARN__}); |
307
|
0
|
|
|
|
|
0
|
my $deadline = Time::HiRes::time + 8; |
308
|
0
|
|
|
|
|
0
|
my $dt = 0.01; |
309
|
0
|
|
|
|
|
0
|
while (Time::HiRes::time < $deadline) { |
310
|
0
|
|
|
|
|
0
|
my $wpr = waitpid($pid, POSIX::WNOHANG()); |
311
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug("waitpid returned ", $wpr); |
312
|
0
|
0
|
0
|
|
|
0
|
last OUT if $wpr or $! == Errno::ECHILD(); |
313
|
0
|
|
|
|
|
0
|
Time::HiRes::sleep($dt); |
314
|
0
|
|
|
|
|
0
|
$dt *= 1.2; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
else { |
319
|
0
|
|
|
|
|
0
|
while (1) { |
320
|
0
|
0
|
|
|
|
0
|
last if waitpid($pid, 0) > 0; |
321
|
0
|
0
|
|
|
|
0
|
if ($! != Errno::EINTR()) { |
322
|
0
|
0
|
|
|
|
0
|
warn "internal error: unexpected error in waitpid($pid): $!" |
323
|
|
|
|
|
|
|
if $! != Errno::ECHILD(); |
324
|
0
|
|
|
|
|
0
|
last; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "process $pid reaped"; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
} |
331
|
0
|
0
|
|
|
|
0
|
close $sftp->{_pty} if defined $sftp->{_pty}; |
332
|
0
|
|
|
|
|
0
|
1 |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
sub DESTROY { |
336
|
0
|
|
|
0
|
|
0
|
local ($?, $!, $@); |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
0
|
my $sftp = shift; |
339
|
0
|
|
|
|
|
0
|
my $dbpid = $sftp->{_disconnect_by_pid}; |
340
|
0
|
|
|
|
|
0
|
my $dbthread = $sftp->{_disconnect_by_thread}; |
341
|
|
|
|
|
|
|
|
342
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug("$sftp->DESTROY called (current pid: $$, disconnect_by_pid: " . |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
343
|
|
|
|
|
|
|
($dbpid || '') . |
344
|
|
|
|
|
|
|
"), current thread generation: $thread_generation, disconnect_by_thread: " . |
345
|
|
|
|
|
|
|
($dbthread || '') . ")"); |
346
|
|
|
|
|
|
|
|
347
|
0
|
0
|
0
|
|
|
0
|
if (!defined $dbpid or ($dbpid == $$ and $dbthread == $thread_generation)) { |
|
|
|
0
|
|
|
|
|
348
|
0
|
|
|
|
|
0
|
$sftp->disconnect |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
else { |
351
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "skipping disconnection because pid and/or thread generation don't match"; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub _init { |
356
|
0
|
|
|
0
|
|
0
|
my $sftp = shift; |
357
|
0
|
|
|
|
|
0
|
$sftp->_queue_msg( Net::SFTP::Foreign::Buffer->new(int8 => SSH2_FXP_INIT, |
358
|
|
|
|
|
|
|
int32 => SSH2_FILEXFER_VERSION)); |
359
|
|
|
|
|
|
|
|
360
|
0
|
0
|
0
|
|
|
0
|
if (my $msg = $sftp->_get_msg) { |
|
|
0
|
0
|
|
|
|
|
361
|
0
|
|
|
|
|
0
|
my $type = $msg->get_int8; |
362
|
0
|
0
|
|
|
|
0
|
if ($type == SSH2_FXP_VERSION) { |
363
|
0
|
|
|
|
|
0
|
my $version = $msg->get_int32; |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
0
|
$sftp->{server_version} = $version; |
366
|
0
|
|
|
|
|
0
|
$sftp->{server_extensions} = {}; |
367
|
0
|
|
|
|
|
0
|
while (length $$msg) { |
368
|
0
|
|
|
|
|
0
|
my $key = $msg->get_str; |
369
|
0
|
|
|
|
|
0
|
my $value = $msg->get_str; |
370
|
0
|
|
|
|
|
0
|
$sftp->{server_extensions}{$key} = $value; |
371
|
|
|
|
|
|
|
|
372
|
0
|
0
|
|
|
|
0
|
if ($key eq 'vendor-id') { |
|
|
0
|
|
|
|
|
|
373
|
0
|
|
|
|
|
0
|
my $vid = Net::SFTP::Foreign::Buffer->make("$value"); |
374
|
0
|
|
|
|
|
0
|
$sftp->{_ext__vendor_id} = [ Encode::decode(utf8 => $vid->get_str), |
375
|
|
|
|
|
|
|
Encode::decode(utf8 => $vid->get_str), |
376
|
|
|
|
|
|
|
Encode::decode(utf8 => $vid->get_str), |
377
|
|
|
|
|
|
|
$vid->get_int64 ]; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
elsif ($key eq 'supported2') { |
380
|
0
|
|
|
|
|
0
|
my $s2 = Net::SFTP::Foreign::Buffer->make("$value"); |
381
|
0
|
|
|
|
|
0
|
$sftp->{_ext__supported2} = [ $s2->get_int32, |
382
|
|
|
|
|
|
|
$s2->get_int32, |
383
|
|
|
|
|
|
|
$s2->get_int32, |
384
|
|
|
|
|
|
|
$s2->get_int32, |
385
|
|
|
|
|
|
|
$s2->get_int32, |
386
|
|
|
|
|
|
|
$s2->get_int16, |
387
|
|
|
|
|
|
|
$s2->get_int16, |
388
|
|
|
|
|
|
|
[map Encode::decode(utf8 => $_), $s2->get_str_list], |
389
|
|
|
|
|
|
|
[map Encode::decode(utf8 => $_), $s2->get_str_list] ]; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
|
|
|
0
|
return $version; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
0
|
|
|
|
|
0
|
$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE, |
397
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_BAD_MESSAGE, |
398
|
|
|
|
|
|
|
"bad packet type, expecting SSH2_FXP_VERSION, got $type"); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
elsif ($sftp->{_status} == SSH2_FX_CONNECTION_LOST |
401
|
|
|
|
|
|
|
and $sftp->{_password_authentication} |
402
|
|
|
|
|
|
|
and $sftp->{_password_sent}) { |
403
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_PASSWORD_AUTHENTICATION_FAILED, |
404
|
|
|
|
|
|
|
"Password authentication failed or connection lost"); |
405
|
|
|
|
|
|
|
} |
406
|
0
|
|
|
|
|
0
|
return undef; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
0
|
|
|
0
|
0
|
0
|
sub server_extensions { %{shift->{server_extensions}} } |
|
0
|
|
|
|
|
0
|
|
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
sub _check_extension { |
412
|
0
|
|
|
0
|
|
0
|
my ($sftp, $name, $version, $error, $errstr) = @_; |
413
|
0
|
|
|
|
|
0
|
my $ext = $sftp->{server_extensions}{$name}; |
414
|
0
|
0
|
0
|
|
|
0
|
return 1 if (defined $ext and $ext == $version); |
415
|
|
|
|
|
|
|
|
416
|
0
|
|
|
|
|
0
|
$sftp->_set_status(SSH2_FX_OP_UNSUPPORTED); |
417
|
0
|
|
|
|
|
0
|
$sftp->_set_error($error, "$errstr: extended operation not supported by server"); |
418
|
0
|
|
|
|
|
0
|
return undef; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# helper methods: |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
sub _get_msg_by_id { |
424
|
0
|
|
|
0
|
|
0
|
my ($sftp, $eid) = @_; |
425
|
0
|
|
|
|
|
0
|
while (1) { |
426
|
0
|
|
0
|
|
|
0
|
my $msg = delete($sftp->{incomming}{$eid}) || $sftp->_get_msg || return undef; |
427
|
0
|
|
|
|
|
0
|
my $id = unpack xN => $$msg; |
428
|
0
|
0
|
|
|
|
0
|
return $msg if $id == $eid; |
429
|
0
|
0
|
|
|
|
0
|
unless (exists $sftp->{incomming}{$id}) { |
430
|
0
|
|
|
|
|
0
|
$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE, |
431
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_BAD_MESSAGE, |
432
|
|
|
|
|
|
|
$_[2], "bad packet sequence, expected $eid, got $id"); |
433
|
0
|
|
|
|
|
0
|
return undef; |
434
|
|
|
|
|
|
|
} |
435
|
0
|
|
|
|
|
0
|
$sftp->{incomming}{$id} = $msg |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub _get_msg_and_check { |
440
|
0
|
|
|
0
|
|
0
|
my ($sftp, $etype, $eid, $err, $errstr) = @_; |
441
|
0
|
|
|
|
|
0
|
my $msg = $sftp->_get_msg_by_id($eid, $errstr); |
442
|
0
|
0
|
|
|
|
0
|
if ($msg) { |
443
|
0
|
|
|
|
|
0
|
my $type = $msg->get_int8; |
444
|
0
|
|
|
|
|
0
|
$msg->get_int32; # discard id, it has already been checked at _get_msg_by_id |
445
|
|
|
|
|
|
|
|
446
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
447
|
|
|
|
|
|
|
|
448
|
0
|
0
|
|
|
|
0
|
if ($type != $etype) { |
449
|
0
|
0
|
|
|
|
0
|
if ($type == SSH2_FXP_STATUS) { |
450
|
0
|
|
|
|
|
0
|
my $code = $msg->get_int32; |
451
|
0
|
|
|
|
|
0
|
my $str = Encode::decode(utf8 => $msg->get_str); |
452
|
0
|
0
|
|
|
|
0
|
my $status = $sftp->_set_status($code, (defined $str ? $str : ())); |
453
|
0
|
|
|
|
|
0
|
$sftp->_set_error($err, $errstr, $status); |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
else { |
456
|
0
|
|
|
|
|
0
|
$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE, |
457
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_BAD_MESSAGE, |
458
|
|
|
|
|
|
|
$errstr, "bad packet type, expected $etype packet, got $type"); |
459
|
|
|
|
|
|
|
} |
460
|
0
|
|
|
|
|
0
|
return undef; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
0
|
|
|
|
|
0
|
$msg; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# reads SSH2_FXP_HANDLE packet and returns handle, or undef on failure |
467
|
|
|
|
|
|
|
sub _get_handle { |
468
|
0
|
|
|
0
|
|
0
|
my ($sftp, $eid, $error, $errstr) = @_; |
469
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_HANDLE, $eid, |
470
|
|
|
|
|
|
|
$error, $errstr)) { |
471
|
0
|
|
|
|
|
0
|
return $msg->get_str; |
472
|
|
|
|
|
|
|
} |
473
|
0
|
|
|
|
|
0
|
return undef; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub _rid { |
477
|
0
|
|
|
0
|
|
0
|
my ($sftp, $rfh) = @_; |
478
|
0
|
|
|
|
|
0
|
my $rid = $rfh->_rid; |
479
|
0
|
0
|
|
|
|
0
|
unless (defined $rid) { |
480
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_REMOTE_ACCESING_CLOSED_FILE, |
481
|
|
|
|
|
|
|
"Couldn't access a file that has been previosly closed"); |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
$rid |
484
|
0
|
|
|
|
|
0
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub _rfid { |
487
|
0
|
|
|
0
|
|
0
|
$_[1]->_check_is_file; |
488
|
0
|
|
|
|
|
0
|
&_rid; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub _rdid { |
492
|
0
|
|
|
0
|
|
0
|
$_[1]->_check_is_dir; |
493
|
0
|
|
|
|
|
0
|
&_rid; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub _queue_rid_request { |
497
|
0
|
|
|
0
|
|
0
|
my ($sftp, $code, $fh, $attrs) = @_; |
498
|
0
|
|
|
|
|
0
|
my $rid = $sftp->_rid($fh); |
499
|
0
|
0
|
|
|
|
0
|
return undef unless defined $rid; |
500
|
|
|
|
|
|
|
|
501
|
0
|
0
|
|
|
|
0
|
$sftp->_queue_new_msg($code, str => $rid, |
502
|
|
|
|
|
|
|
(defined $attrs ? (attr => $attrs) : ())); |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub _queue_rfid_request { |
506
|
0
|
|
|
0
|
|
0
|
$_[2]->_check_is_file; |
507
|
0
|
|
|
|
|
0
|
&_queue_rid_request; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub _queue_rdid_request { |
511
|
0
|
|
|
0
|
|
0
|
$_[2]->_check_is_dir; |
512
|
0
|
|
|
|
|
0
|
&_queue_rid_request; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub _queue_str_request { |
516
|
0
|
|
|
0
|
|
0
|
my($sftp, $code, $str, $attrs) = @_; |
517
|
0
|
0
|
|
|
|
0
|
$sftp->_queue_new_msg($code, str => $str, |
518
|
|
|
|
|
|
|
(defined $attrs ? (attr => $attrs) : ())); |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub _check_status_ok { |
522
|
0
|
|
|
0
|
|
0
|
my ($sftp, $eid, $error, $errstr) = @_; |
523
|
0
|
0
|
|
|
|
0
|
if (defined $eid) { |
524
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_STATUS, $eid, |
525
|
|
|
|
|
|
|
$error, $errstr)) { |
526
|
0
|
|
|
|
|
0
|
my $status = $sftp->_set_status($msg->get_int32, $msg->get_str); |
527
|
0
|
0
|
|
|
|
0
|
return 1 if $status == SSH2_FX_OK; |
528
|
|
|
|
|
|
|
|
529
|
0
|
|
|
|
|
0
|
$sftp->_set_error($error, $errstr, $status); |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
} |
532
|
0
|
|
|
|
|
0
|
return undef; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
sub setcwd { |
536
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
537
|
|
|
|
|
|
|
|
538
|
0
|
|
|
|
|
0
|
my ($sftp, $cwd, %opts) = @_; |
539
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
540
|
|
|
|
|
|
|
|
541
|
0
|
|
|
|
|
0
|
my $check = delete $opts{check}; |
542
|
0
|
0
|
|
|
|
0
|
$check = 1 unless defined $check; |
543
|
|
|
|
|
|
|
|
544
|
0
|
0
|
|
|
|
0
|
%opts and _croak_bad_options(keys %opts); |
545
|
|
|
|
|
|
|
|
546
|
0
|
0
|
|
|
|
0
|
if (defined $cwd) { |
547
|
0
|
0
|
|
|
|
0
|
if ($check) { |
548
|
0
|
|
|
|
|
0
|
$cwd = $sftp->realpath($cwd); |
549
|
0
|
0
|
|
|
|
0
|
return undef unless defined $cwd; |
550
|
0
|
|
|
|
|
0
|
_untaint($cwd); |
551
|
0
|
0
|
|
|
|
0
|
my $a = $sftp->stat($cwd) |
552
|
|
|
|
|
|
|
or return undef; |
553
|
0
|
0
|
|
|
|
0
|
unless (_is_dir($a->perm)) { |
554
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT, |
555
|
|
|
|
|
|
|
"Remote object '$cwd' is not a directory"); |
556
|
0
|
|
|
|
|
0
|
return undef; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
else { |
560
|
0
|
|
|
|
|
0
|
$cwd = $sftp->_rel2abs($cwd); |
561
|
|
|
|
|
|
|
} |
562
|
0
|
|
|
|
|
0
|
return $sftp->{cwd} = $cwd; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
else { |
565
|
0
|
|
|
|
|
0
|
delete $sftp->{cwd}; |
566
|
0
|
0
|
|
|
|
0
|
return $sftp->cwd if defined wantarray; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub cwd { |
571
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 1 or croak 'Usage: $sftp->cwd()'; |
572
|
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
0
|
my $sftp = shift; |
574
|
0
|
0
|
|
|
|
0
|
return defined $sftp->{cwd} ? $sftp->{cwd} : $sftp->realpath(''); |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
## SSH2_FXP_OPEN (3) |
578
|
|
|
|
|
|
|
# returns handle on success, undef on failure |
579
|
|
|
|
|
|
|
sub open { |
580
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 2 and @_ <= 4) |
581
|
|
|
|
|
|
|
or croak 'Usage: $sftp->open($path [, $flags [, $attrs]])'; |
582
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
583
|
|
|
|
|
|
|
|
584
|
0
|
|
|
|
|
0
|
my ($sftp, $path, $flags, $a) = @_; |
585
|
0
|
|
|
|
|
0
|
$path = $sftp->_rel2abs($path); |
586
|
0
|
0
|
|
|
|
0
|
defined $flags or $flags = SSH2_FXF_READ; |
587
|
0
|
0
|
|
|
|
0
|
defined $a or $a = Net::SFTP::Foreign::Attributes->new; |
588
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_OPEN, |
589
|
|
|
|
|
|
|
str => $sftp->_fs_encode($path), |
590
|
|
|
|
|
|
|
int32 => $flags, attr => $a); |
591
|
|
|
|
|
|
|
|
592
|
0
|
|
|
|
|
0
|
my $rid = $sftp->_get_handle($id, |
593
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_OPEN_FAILED, |
594
|
|
|
|
|
|
|
"Couldn't open remote file '$path'"); |
595
|
|
|
|
|
|
|
|
596
|
0
|
0
|
0
|
|
|
0
|
if ($debug and $debug & 2) { |
597
|
0
|
0
|
|
|
|
0
|
if (defined $rid) { |
598
|
0
|
|
|
|
|
0
|
_debug("new remote file '$path' open, rid:"); |
599
|
0
|
|
|
|
|
0
|
_hexdump($rid); |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
else { |
602
|
0
|
|
|
|
|
0
|
_debug("open failed: $sftp->{_status}"); |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
} |
605
|
|
|
|
|
|
|
|
606
|
0
|
0
|
|
|
|
0
|
defined $rid or return undef; |
607
|
|
|
|
|
|
|
|
608
|
0
|
|
|
|
|
0
|
my $fh = Net::SFTP::Foreign::FileHandle->_new_from_rid($sftp, $rid); |
609
|
0
|
0
|
|
|
|
0
|
$fh->_flag(append => 1) if ($flags & SSH2_FXF_APPEND); |
610
|
|
|
|
|
|
|
|
611
|
0
|
|
|
|
|
0
|
$fh; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
sub _open_mkpath { |
615
|
0
|
|
|
0
|
|
0
|
my ($sftp, $filename, $mkpath, $flags, $attrs) = @_; |
616
|
0
|
|
0
|
|
|
0
|
$flags = ($flags || 0) | SSH2_FXF_WRITE|SSH2_FXF_CREAT; |
617
|
0
|
|
|
|
|
0
|
my $fh = do { |
618
|
0
|
|
|
|
|
0
|
local $sftp->{_autodie}; |
619
|
0
|
|
|
|
|
0
|
$sftp->open($filename, $flags, $attrs); |
620
|
|
|
|
|
|
|
}; |
621
|
0
|
0
|
|
|
|
0
|
unless ($fh) { |
622
|
0
|
0
|
0
|
|
|
0
|
if ($mkpath and $sftp->status == SSH2_FX_NO_SUCH_FILE) { |
623
|
0
|
|
|
|
|
0
|
my $da = $attrs->clone; |
624
|
0
|
|
0
|
|
|
0
|
$da->set_perm(($da->perm || 0) | 0700); |
625
|
0
|
0
|
|
|
|
0
|
$sftp->mkpath($filename, $da, 1) or return; |
626
|
0
|
|
|
|
|
0
|
$fh = $sftp->open($filename, $flags, $attrs); |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
else { |
629
|
0
|
|
|
|
|
0
|
$sftp->_ok_or_autodie; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
0
|
|
|
|
|
0
|
$fh; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
## SSH2_FXP_OPENDIR (11) |
636
|
|
|
|
|
|
|
sub opendir { |
637
|
0
|
0
|
|
0
|
1
|
0
|
@_ <= 2 or croak 'Usage: $sftp->opendir($path)'; |
638
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
639
|
|
|
|
|
|
|
|
640
|
0
|
|
|
|
|
0
|
my $sftp = shift; |
641
|
0
|
|
|
|
|
0
|
my $path = shift; |
642
|
0
|
0
|
|
|
|
0
|
$path = '.' unless defined $path; |
643
|
0
|
|
|
|
|
0
|
$path = $sftp->_rel2abs($path); |
644
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_str_request(SSH2_FXP_OPENDIR, $sftp->_fs_encode($path), @_); |
645
|
0
|
|
|
|
|
0
|
my $rid = $sftp->_get_handle($id, SFTP_ERR_REMOTE_OPENDIR_FAILED, |
646
|
|
|
|
|
|
|
"Couldn't open remote dir '$path'"); |
647
|
|
|
|
|
|
|
|
648
|
0
|
0
|
0
|
|
|
0
|
if ($debug and $debug & 2) { |
649
|
0
|
|
|
|
|
0
|
_debug("new remote dir '$path' open, rid:"); |
650
|
0
|
|
|
|
|
0
|
_hexdump($rid); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
0
|
0
|
|
|
|
0
|
defined $rid |
654
|
|
|
|
|
|
|
or return undef; |
655
|
|
|
|
|
|
|
|
656
|
0
|
|
|
|
|
0
|
Net::SFTP::Foreign::DirHandle->_new_from_rid($sftp, $rid, 0) |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
## SSH2_FXP_READ (4) |
660
|
|
|
|
|
|
|
# returns data on success undef on failure |
661
|
|
|
|
|
|
|
sub sftpread { |
662
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 3 and @_ <= 4) |
663
|
|
|
|
|
|
|
or croak 'Usage: $sftp->sftpread($fh, $offset [, $size])'; |
664
|
|
|
|
|
|
|
|
665
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh, $offset, $size) = @_; |
666
|
|
|
|
|
|
|
|
667
|
0
|
0
|
|
|
|
0
|
unless ($size) { |
668
|
0
|
0
|
|
|
|
0
|
return '' if defined $size; |
669
|
0
|
|
|
|
|
0
|
$size = $sftp->{_block_size}; |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
0
|
|
|
|
|
0
|
my $rfid = $sftp->_rfid($rfh); |
673
|
0
|
0
|
|
|
|
0
|
defined $rfid or return undef; |
674
|
|
|
|
|
|
|
|
675
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid, |
676
|
|
|
|
|
|
|
int64 => $offset, int32 => $size); |
677
|
|
|
|
|
|
|
|
678
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $id, |
679
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READ_FAILED, |
680
|
|
|
|
|
|
|
"Couldn't read from remote file")) { |
681
|
0
|
|
|
|
|
0
|
return $msg->get_str; |
682
|
|
|
|
|
|
|
} |
683
|
0
|
|
|
|
|
0
|
return undef; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
## SSH2_FXP_WRITE (6) |
687
|
|
|
|
|
|
|
# returns true on success, undef on failure |
688
|
|
|
|
|
|
|
sub sftpwrite { |
689
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 4 or croak 'Usage: $sftp->sftpwrite($fh, $offset, $data)'; |
690
|
|
|
|
|
|
|
|
691
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh, $offset) = @_; |
692
|
0
|
|
|
|
|
0
|
my $rfid = $sftp->_rfid($rfh); |
693
|
0
|
0
|
|
|
|
0
|
defined $rfid or return undef; |
694
|
0
|
0
|
|
|
|
0
|
utf8::downgrade($_[3], 1) or croak "wide characters found in data"; |
695
|
|
|
|
|
|
|
|
696
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid, |
697
|
|
|
|
|
|
|
int64 => $offset, str => $_[3]); |
698
|
|
|
|
|
|
|
|
699
|
0
|
0
|
|
|
|
0
|
if ($sftp->_check_status_ok($id, |
700
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_WRITE_FAILED, |
701
|
|
|
|
|
|
|
"Couldn't write to remote file")) { |
702
|
0
|
|
|
|
|
0
|
return 1; |
703
|
|
|
|
|
|
|
} |
704
|
0
|
|
|
|
|
0
|
return undef; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub seek { |
708
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 3 and @_ <= 4) |
709
|
|
|
|
|
|
|
or croak 'Usage: $sftp->seek($fh, $pos [, $whence])'; |
710
|
|
|
|
|
|
|
|
711
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh, $pos, $whence) = @_; |
712
|
0
|
0
|
|
|
|
0
|
$sftp->flush($rfh) or return undef; |
713
|
|
|
|
|
|
|
|
714
|
0
|
0
|
|
|
|
0
|
if (!$whence) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
715
|
0
|
|
|
|
|
0
|
$rfh->_pos($pos) |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
elsif ($whence == 1) { |
718
|
0
|
|
|
|
|
0
|
$rfh->_inc_pos($pos) |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
elsif ($whence == 2) { |
721
|
0
|
0
|
|
|
|
0
|
my $a = $sftp->stat($rfh) or return undef; |
722
|
0
|
|
|
|
|
0
|
$rfh->_pos($pos + $a->size); |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
else { |
725
|
0
|
|
|
|
|
0
|
croak "invalid value for whence argument ('$whence')"; |
726
|
|
|
|
|
|
|
} |
727
|
0
|
|
|
|
|
0
|
1; |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
sub tell { |
731
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 2 or croak 'Usage: $sftp->tell($fh)'; |
732
|
|
|
|
|
|
|
|
733
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh) = @_; |
734
|
0
|
|
|
|
|
0
|
return $rfh->_pos + length ${$rfh->_bout}; |
|
0
|
|
|
|
|
0
|
|
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
sub eof { |
738
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 2 or croak 'Usage: $sftp->eof($fh)'; |
739
|
|
|
|
|
|
|
|
740
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh) = @_; |
741
|
0
|
|
|
|
|
0
|
$sftp->_fill_read_cache($rfh, 1); |
742
|
0
|
|
|
|
|
0
|
return length(${$rfh->_bin}) == 0 |
|
0
|
|
|
|
|
0
|
|
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
sub _write { |
746
|
0
|
|
|
0
|
|
0
|
my ($sftp, $rfh, $off, $cb) = @_; |
747
|
|
|
|
|
|
|
|
748
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
749
|
|
|
|
|
|
|
|
750
|
0
|
|
|
|
|
0
|
my $rfid = $sftp->_rfid($rfh); |
751
|
0
|
0
|
|
|
|
0
|
defined $rfid or return undef; |
752
|
|
|
|
|
|
|
|
753
|
0
|
|
|
|
|
0
|
my $qsize = $sftp->{_queue_size}; |
754
|
|
|
|
|
|
|
|
755
|
0
|
|
|
|
|
0
|
my @msgid; |
756
|
|
|
|
|
|
|
my @written; |
757
|
0
|
|
|
|
|
0
|
my $written = 0; |
758
|
0
|
|
|
|
|
0
|
my $end; |
759
|
|
|
|
|
|
|
|
760
|
0
|
|
0
|
|
|
0
|
while (!$end or @msgid) { |
761
|
0
|
|
0
|
|
|
0
|
while (!$end and @msgid < $qsize) { |
762
|
0
|
|
|
|
|
0
|
my $data = $cb->(); |
763
|
0
|
0
|
0
|
|
|
0
|
if (defined $data and length $data) { |
764
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid, |
765
|
|
|
|
|
|
|
int64 => $off + $written, str => $data); |
766
|
0
|
|
|
|
|
0
|
push @written, $written; |
767
|
0
|
|
|
|
|
0
|
$written += length $data; |
768
|
0
|
|
|
|
|
0
|
push @msgid, $id; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
else { |
771
|
0
|
|
|
|
|
0
|
$end = 1; |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
0
|
|
|
|
|
0
|
my $eid = shift @msgid; |
776
|
0
|
|
|
|
|
0
|
my $last = shift @written; |
777
|
0
|
0
|
|
|
|
0
|
unless ($sftp->_check_status_ok($eid, |
778
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_WRITE_FAILED, |
779
|
|
|
|
|
|
|
"Couldn't write to remote file")) { |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
# discard responses to queued requests: |
782
|
0
|
|
|
|
|
0
|
$sftp->_get_msg_by_id($_) for @msgid; |
783
|
0
|
|
|
|
|
0
|
return $last; |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
|
787
|
0
|
|
|
|
|
0
|
return $written; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
sub write { |
791
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 3 or croak 'Usage: $sftp->write($fh, $data)'; |
792
|
|
|
|
|
|
|
|
793
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh) = @_; |
794
|
0
|
0
|
|
|
|
0
|
$sftp->flush($rfh, 'in') or return undef; |
795
|
0
|
0
|
|
|
|
0
|
utf8::downgrade($_[2], 1) or croak "wide characters found in data"; |
796
|
0
|
|
|
|
|
0
|
my $datalen = length $_[2]; |
797
|
0
|
|
|
|
|
0
|
my $bout = $rfh->_bout; |
798
|
0
|
|
|
|
|
0
|
$$bout .= $_[2]; |
799
|
0
|
|
|
|
|
0
|
my $len = length $$bout; |
800
|
|
|
|
|
|
|
|
801
|
0
|
0
|
0
|
|
|
0
|
if ($len >= $sftp->{_write_delay} or ($len and $sftp->{_autoflush} )) { |
|
|
|
0
|
|
|
|
|
802
|
0
|
0
|
|
|
|
0
|
$sftp->flush($rfh, 'out') or return undef; |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
0
|
|
|
|
|
0
|
return $datalen; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
sub flush { |
809
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 2 and @_ <= 3) |
810
|
|
|
|
|
|
|
or croak 'Usage: $sftp->flush($fh [, $direction])'; |
811
|
|
|
|
|
|
|
|
812
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh, $dir) = @_; |
813
|
0
|
|
0
|
|
|
0
|
$dir ||= ''; |
814
|
|
|
|
|
|
|
|
815
|
0
|
0
|
|
|
|
0
|
defined $sftp->_rfid($rfh) or return; |
816
|
|
|
|
|
|
|
|
817
|
0
|
0
|
|
|
|
0
|
if ($dir ne 'out') { # flush in! |
818
|
0
|
|
|
|
|
0
|
${$rfh->_bin} = ''; |
|
0
|
|
|
|
|
0
|
|
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
0
|
0
|
|
|
|
0
|
if ($dir ne 'in') { # flush out! |
822
|
0
|
|
|
|
|
0
|
my $bout = $rfh->_bout; |
823
|
0
|
|
|
|
|
0
|
my $len = length $$bout; |
824
|
0
|
0
|
|
|
|
0
|
if ($len) { |
825
|
0
|
|
|
|
|
0
|
my $start; |
826
|
0
|
|
|
|
|
0
|
my $append = $rfh->_flag('append'); |
827
|
0
|
0
|
|
|
|
0
|
if ($append) { |
828
|
0
|
0
|
|
|
|
0
|
my $attr = $sftp->stat($rfh) |
829
|
|
|
|
|
|
|
or return undef; |
830
|
0
|
|
|
|
|
0
|
$start = $attr->size; |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
else { |
833
|
0
|
|
|
|
|
0
|
$start = $rfh->_pos; |
834
|
0
|
|
|
|
|
0
|
${$rfh->_bin} = ''; |
|
0
|
|
|
|
|
0
|
|
835
|
|
|
|
|
|
|
} |
836
|
0
|
|
|
|
|
0
|
my $off = 0; |
837
|
|
|
|
|
|
|
my $written = $sftp->_write($rfh, $start, |
838
|
|
|
|
|
|
|
sub { |
839
|
0
|
|
|
0
|
|
0
|
my $data = substr($$bout, $off, $sftp->{_block_size}); |
840
|
0
|
|
|
|
|
0
|
$off += length $data; |
841
|
0
|
|
|
|
|
0
|
$data; |
842
|
0
|
|
|
|
|
0
|
} ); |
843
|
0
|
0
|
|
|
|
0
|
$rfh->_inc_pos($written) |
844
|
|
|
|
|
|
|
unless $append; |
845
|
|
|
|
|
|
|
|
846
|
0
|
|
|
|
|
0
|
$$bout = ''; # The full buffer is discarded even when some error happens. |
847
|
0
|
0
|
|
|
|
0
|
$written == $len or return undef; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
} |
850
|
0
|
|
|
|
|
0
|
1; |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
sub _fill_read_cache { |
854
|
0
|
|
|
0
|
|
0
|
my ($sftp, $rfh, $len) = @_; |
855
|
|
|
|
|
|
|
|
856
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
857
|
|
|
|
|
|
|
|
858
|
0
|
0
|
|
|
|
0
|
$sftp->flush($rfh, 'out') |
859
|
|
|
|
|
|
|
or return undef; |
860
|
|
|
|
|
|
|
|
861
|
0
|
|
|
|
|
0
|
my $rfid = $sftp->_rfid($rfh); |
862
|
0
|
0
|
|
|
|
0
|
defined $rfid or return undef; |
863
|
|
|
|
|
|
|
|
864
|
0
|
|
|
|
|
0
|
my $bin = $rfh->_bin; |
865
|
|
|
|
|
|
|
|
866
|
0
|
0
|
|
|
|
0
|
if (defined $len) { |
867
|
0
|
0
|
|
|
|
0
|
return 1 if ($len < length $$bin); |
868
|
|
|
|
|
|
|
|
869
|
0
|
|
|
|
|
0
|
my $read_ahead = $sftp->{_read_ahead}; |
870
|
0
|
0
|
|
|
|
0
|
$len = length($$bin) + $read_ahead |
871
|
|
|
|
|
|
|
if $len - length($$bin) < $read_ahead; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
0
|
|
|
|
|
0
|
my $pos = $rfh->_pos; |
875
|
|
|
|
|
|
|
|
876
|
0
|
|
|
|
|
0
|
my $qsize = $sftp->{_queue_size}; |
877
|
0
|
|
|
|
|
0
|
my $bsize = $sftp->{_block_size}; |
878
|
|
|
|
|
|
|
|
879
|
0
|
|
|
|
|
0
|
do { |
880
|
0
|
|
|
|
|
0
|
local $sftp->{_autodie}; |
881
|
|
|
|
|
|
|
|
882
|
0
|
|
|
|
|
0
|
my @msgid; |
883
|
0
|
|
|
|
|
0
|
my $askoff = length $$bin; |
884
|
0
|
|
|
|
|
0
|
my $ensure_eof; |
885
|
|
|
|
|
|
|
|
886
|
0
|
|
0
|
|
|
0
|
while (!defined $len or length $$bin < $len) { |
887
|
0
|
|
0
|
|
|
0
|
while ((!defined $len or $askoff < $len) and @msgid < $qsize) { |
|
|
|
0
|
|
|
|
|
888
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid, |
889
|
|
|
|
|
|
|
int64 => $pos + $askoff, int32 => $bsize); |
890
|
0
|
|
|
|
|
0
|
push @msgid, $id; |
891
|
0
|
|
|
|
|
0
|
$askoff += $bsize; |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
0
|
|
|
|
|
0
|
my $eid = shift @msgid; |
895
|
0
|
0
|
|
|
|
0
|
my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $eid, |
896
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READ_FAILED, |
897
|
|
|
|
|
|
|
"Couldn't read from remote file") |
898
|
|
|
|
|
|
|
or last; |
899
|
|
|
|
|
|
|
|
900
|
0
|
|
|
|
|
0
|
my $data = $msg->get_str; |
901
|
0
|
|
|
|
|
0
|
$$bin .= $data; |
902
|
0
|
0
|
|
|
|
0
|
if (length $data < $bsize) { |
903
|
0
|
0
|
|
|
|
0
|
unless (defined $len) { |
904
|
0
|
|
|
|
|
0
|
$ensure_eof = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid, |
905
|
|
|
|
|
|
|
int64 => $pos + length $$bin, int32 => 1); |
906
|
|
|
|
|
|
|
} |
907
|
0
|
|
|
|
|
0
|
last; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
0
|
|
|
|
|
0
|
$sftp->_get_msg_by_id($_) for @msgid; |
912
|
|
|
|
|
|
|
|
913
|
0
|
0
|
0
|
|
|
0
|
if ($ensure_eof and |
914
|
|
|
|
|
|
|
$sftp->_get_msg_and_check(SSH2_FXP_DATA, $ensure_eof, |
915
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READ_FAILED, |
916
|
|
|
|
|
|
|
"Couldn't read from remote file")) { |
917
|
|
|
|
|
|
|
|
918
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL, |
919
|
|
|
|
|
|
|
"Received block was too small"); |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
0
|
0
|
|
|
|
0
|
if ($sftp->{_status} == SSH2_FX_EOF) { |
923
|
0
|
|
|
|
|
0
|
$sftp->_set_error; |
924
|
0
|
0
|
|
|
|
0
|
$sftp->_set_status if length $$bin |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
}; |
927
|
|
|
|
|
|
|
|
928
|
0
|
0
|
|
|
|
0
|
$sftp->_ok_or_autodie and length $$bin; |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
sub read { |
932
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 3 or croak 'Usage: $sftp->read($fh, $len)'; |
933
|
|
|
|
|
|
|
|
934
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh, $len) = @_; |
935
|
0
|
0
|
|
|
|
0
|
if ($sftp->_fill_read_cache($rfh, $len)) { |
936
|
0
|
|
|
|
|
0
|
my $bin = $rfh->_bin; |
937
|
0
|
|
|
|
|
0
|
my $data = substr($$bin, 0, $len, ''); |
938
|
0
|
|
|
|
|
0
|
$rfh->_inc_pos(length $data); |
939
|
0
|
|
|
|
|
0
|
return $data; |
940
|
|
|
|
|
|
|
} |
941
|
0
|
|
|
|
|
0
|
return undef; |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
sub _readline { |
945
|
0
|
|
|
0
|
|
0
|
my ($sftp, $rfh, $sep) = @_; |
946
|
|
|
|
|
|
|
|
947
|
0
|
0
|
|
|
|
0
|
$sep = "\n" if @_ < 3; |
948
|
|
|
|
|
|
|
|
949
|
0
|
|
|
|
|
0
|
my $sl = length $sep; |
950
|
|
|
|
|
|
|
|
951
|
0
|
|
|
|
|
0
|
my $bin = $rfh->_bin; |
952
|
0
|
|
|
|
|
0
|
my $last = 0; |
953
|
|
|
|
|
|
|
|
954
|
0
|
|
|
|
|
0
|
while(1) { |
955
|
0
|
|
|
|
|
0
|
my $ix = index $$bin, $sep, $last + 1 - $sl ; |
956
|
0
|
0
|
|
|
|
0
|
if ($ix >= 0) { |
957
|
0
|
|
|
|
|
0
|
$ix += $sl; |
958
|
0
|
|
|
|
|
0
|
$rfh->_inc_pos($ix); |
959
|
0
|
|
|
|
|
0
|
return substr($$bin, 0, $ix, ''); |
960
|
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
|
962
|
0
|
|
|
|
|
0
|
$last = length $$bin; |
963
|
0
|
|
|
|
|
0
|
$sftp->_fill_read_cache($rfh, length($$bin) + 1); |
964
|
|
|
|
|
|
|
|
965
|
0
|
0
|
|
|
|
0
|
unless (length $$bin > $last) { |
966
|
|
|
|
|
|
|
$sftp->{_error} |
967
|
0
|
0
|
|
|
|
0
|
and return undef; |
968
|
|
|
|
|
|
|
|
969
|
0
|
|
|
|
|
0
|
my $line = $$bin; |
970
|
0
|
|
|
|
|
0
|
$rfh->_inc_pos(length $line); |
971
|
0
|
|
|
|
|
0
|
$$bin = ''; |
972
|
0
|
0
|
|
|
|
0
|
return (length $line ? $line : undef); |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
} |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
sub readline { |
978
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 2 and @_ <= 3) |
979
|
|
|
|
|
|
|
or croak 'Usage: $sftp->readline($fh [, $sep])'; |
980
|
|
|
|
|
|
|
|
981
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh, $sep) = @_; |
982
|
0
|
0
|
|
|
|
0
|
$sep = "\n" if @_ < 3; |
983
|
0
|
0
|
0
|
|
|
0
|
if (!defined $sep or $sep eq '') { |
984
|
0
|
|
|
|
|
0
|
$sftp->_fill_read_cache($rfh); |
985
|
|
|
|
|
|
|
$sftp->{_error} |
986
|
0
|
0
|
|
|
|
0
|
and return undef; |
987
|
0
|
|
|
|
|
0
|
my $bin = $rfh->_bin; |
988
|
0
|
|
|
|
|
0
|
my $line = $$bin; |
989
|
0
|
|
|
|
|
0
|
$rfh->_inc_pos(length $line); |
990
|
0
|
|
|
|
|
0
|
$$bin = ''; |
991
|
0
|
|
|
|
|
0
|
return $line; |
992
|
|
|
|
|
|
|
} |
993
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
994
|
0
|
|
|
|
|
0
|
my @lines; |
995
|
0
|
|
|
|
|
0
|
while (defined (my $line = $sftp->_readline($rfh, $sep))) { |
996
|
0
|
|
|
|
|
0
|
push @lines, $line; |
997
|
|
|
|
|
|
|
} |
998
|
0
|
|
|
|
|
0
|
return @lines; |
999
|
|
|
|
|
|
|
} |
1000
|
0
|
|
|
|
|
0
|
return $sftp->_readline($rfh, $sep); |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
sub getc { |
1004
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 2 or croak 'Usage: $sftp->getc($fh)'; |
1005
|
|
|
|
|
|
|
|
1006
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh) = @_; |
1007
|
|
|
|
|
|
|
|
1008
|
0
|
|
|
|
|
0
|
$sftp->_fill_read_cache($rfh, 1); |
1009
|
0
|
|
|
|
|
0
|
my $bin = $rfh->_bin; |
1010
|
0
|
0
|
|
|
|
0
|
if (length $bin) { |
1011
|
0
|
|
|
|
|
0
|
$rfh->_inc_pos(1); |
1012
|
0
|
|
|
|
|
0
|
return substr $$bin, 0, 1, ''; |
1013
|
|
|
|
|
|
|
} |
1014
|
0
|
|
|
|
|
0
|
return undef; |
1015
|
|
|
|
|
|
|
} |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
## SSH2_FXP_LSTAT (7), SSH2_FXP_FSTAT (8), SSH2_FXP_STAT (17) |
1018
|
|
|
|
|
|
|
# these all return a Net::SFTP::Foreign::Attributes object on success, undef on failure |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
sub lstat { |
1021
|
0
|
0
|
|
0
|
1
|
0
|
@_ <= 2 or croak 'Usage: $sftp->lstat($path)'; |
1022
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1023
|
|
|
|
|
|
|
|
1024
|
0
|
|
|
|
|
0
|
my ($sftp, $path) = @_; |
1025
|
0
|
0
|
|
|
|
0
|
$path = '.' unless defined $path; |
1026
|
0
|
|
|
|
|
0
|
$path = $sftp->_rel2abs($path); |
1027
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_str_request(SSH2_FXP_LSTAT, $sftp->_fs_encode($path)); |
1028
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id, |
1029
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_LSTAT_FAILED, "Couldn't stat remote link")) { |
1030
|
0
|
|
|
|
|
0
|
return $msg->get_attributes; |
1031
|
|
|
|
|
|
|
} |
1032
|
0
|
|
|
|
|
0
|
return undef; |
1033
|
|
|
|
|
|
|
} |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
sub stat { |
1036
|
0
|
0
|
|
0
|
1
|
0
|
@_ <= 2 or croak 'Usage: $sftp->stat($path_or_fh)'; |
1037
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1038
|
|
|
|
|
|
|
|
1039
|
0
|
|
|
|
|
0
|
my ($sftp, $pofh) = @_; |
1040
|
0
|
0
|
|
|
|
0
|
$pofh = '.' unless defined $pofh; |
1041
|
0
|
0
|
0
|
|
|
0
|
my $id = $sftp->_queue_new_msg( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle')) |
1042
|
|
|
|
|
|
|
? ( SSH2_FXP_FSTAT, str => $sftp->_rid($pofh)) |
1043
|
|
|
|
|
|
|
: ( SSH2_FXP_STAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh))) ); |
1044
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id, |
1045
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_STAT_FAILED, "Couldn't stat remote file")) { |
1046
|
0
|
|
|
|
|
0
|
return $msg->get_attributes; |
1047
|
|
|
|
|
|
|
} |
1048
|
0
|
|
|
|
|
0
|
return undef; |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
sub fstat { |
1052
|
0
|
|
|
0
|
1
|
0
|
_deprecated "fstat is deprecated and will be removed on the upcoming 2.xx series, " |
1053
|
|
|
|
|
|
|
. "stat method accepts now both file handlers and paths"; |
1054
|
0
|
|
|
|
|
0
|
goto &stat; |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
## SSH2_FXP_RMDIR (15), SSH2_FXP_REMOVE (13) |
1058
|
|
|
|
|
|
|
# these return true on success, undef on failure |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
sub _gen_remove_method { |
1061
|
6
|
|
|
6
|
|
19
|
my($name, $code, $error, $errstr) = @_; |
1062
|
|
|
|
|
|
|
my $sub = sub { |
1063
|
0
|
0
|
|
0
|
|
0
|
@_ == 2 or croak "Usage: \$sftp->$name(\$path)"; |
1064
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1065
|
|
|
|
|
|
|
|
1066
|
0
|
|
|
|
|
0
|
my ($sftp, $path) = @_; |
1067
|
0
|
|
|
|
|
0
|
$path = $sftp->_rel2abs($path); |
1068
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path)); |
1069
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, $error, $errstr); |
1070
|
6
|
|
|
|
|
36
|
}; |
1071
|
3
|
|
|
3
|
|
26
|
no strict 'refs'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
4815
|
|
1072
|
6
|
|
|
|
|
36
|
*$name = $sub; |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
_gen_remove_method(remove => SSH2_FXP_REMOVE, |
1076
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_REMOVE_FAILED, "Couldn't delete remote file"); |
1077
|
|
|
|
|
|
|
_gen_remove_method(rmdir => SSH2_FXP_RMDIR, |
1078
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_RMDIR_FAILED, "Couldn't remove remote directory"); |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
## SSH2_FXP_MKDIR (14), SSH2_FXP_SETSTAT (9) |
1081
|
|
|
|
|
|
|
# these return true on success, undef on failure |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
sub mkdir { |
1084
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 2 and @_ <= 3) |
1085
|
|
|
|
|
|
|
or croak 'Usage: $sftp->mkdir($path [, $attrs])'; |
1086
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1087
|
|
|
|
|
|
|
|
1088
|
0
|
|
|
|
|
0
|
my ($sftp, $path, $attrs) = @_; |
1089
|
0
|
0
|
|
|
|
0
|
$attrs = _empty_attributes unless defined $attrs; |
1090
|
0
|
|
|
|
|
0
|
$path = $sftp->_rel2abs($path); |
1091
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_str_request(SSH2_FXP_MKDIR, |
1092
|
|
|
|
|
|
|
$sftp->_fs_encode($path), |
1093
|
|
|
|
|
|
|
$attrs); |
1094
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, |
1095
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_MKDIR_FAILED, |
1096
|
|
|
|
|
|
|
"Couldn't create remote directory"); |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
sub join { |
1100
|
17
|
|
|
17
|
1
|
841
|
my $sftp = shift; |
1101
|
17
|
|
|
|
|
24
|
my $vol = ''; |
1102
|
17
|
|
|
|
|
20
|
my $a = '.'; |
1103
|
17
|
|
|
|
|
37
|
while (@_) { |
1104
|
34
|
|
|
|
|
43
|
my $b = shift; |
1105
|
34
|
50
|
|
|
|
52
|
if (defined $b) { |
1106
|
34
|
0
|
33
|
|
|
75
|
if (ref $sftp and # this method can also be used as a static one |
|
|
|
0
|
|
|
|
|
1107
|
|
|
|
|
|
|
$sftp->{_remote_has_volumes} and $b =~ /^([a-z]\:)(.*)/i) { |
1108
|
0
|
|
|
|
|
0
|
$vol = $1; |
1109
|
0
|
|
|
|
|
0
|
$a = '.'; |
1110
|
0
|
|
|
|
|
0
|
$b = $2; |
1111
|
|
|
|
|
|
|
} |
1112
|
34
|
|
|
|
|
81
|
$b =~ s|^(?:\./+)+||; |
1113
|
34
|
100
|
100
|
|
|
105
|
if (length $b and $b ne '.') { |
1114
|
19
|
100
|
100
|
|
|
74
|
if ($b !~ m|^/| and $a ne '.' ) { |
1115
|
2
|
50
|
|
|
|
7
|
$a = ($a =~ m|/$| ? "$a$b" : "$a/$b"); |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
else { |
1118
|
17
|
|
|
|
|
21
|
$a = $b |
1119
|
|
|
|
|
|
|
} |
1120
|
19
|
|
|
|
|
59
|
$a =~ s|(?:/+\.)+/?$|/|; |
1121
|
19
|
|
|
|
|
44
|
$a =~ s|(?<=[^/])/+$||; |
1122
|
19
|
50
|
|
|
|
43
|
$a = '.' unless length $a; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
} |
1126
|
17
|
|
|
|
|
66
|
"$vol$a"; |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
sub _rel2abs { |
1130
|
0
|
|
|
0
|
|
0
|
my ($sftp, $path) = @_; |
1131
|
0
|
|
|
|
|
0
|
my $old = $path; |
1132
|
0
|
|
|
|
|
0
|
my $cwd = $sftp->{cwd}; |
1133
|
0
|
|
|
|
|
0
|
$path = $sftp->join($sftp->{cwd}, $path); |
1134
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4096 and _debug("'$old' --> '$path'"); |
1135
|
0
|
|
|
|
|
0
|
return $path |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
sub mkpath { |
1139
|
0
|
0
|
0
|
0
|
1
|
0
|
(@_ >= 2 and @_ <= 4) |
1140
|
|
|
|
|
|
|
or croak 'Usage: $sftp->mkpath($path [, $attrs [, $parent]])'; |
1141
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1142
|
|
|
|
|
|
|
|
1143
|
0
|
|
|
|
|
0
|
my ($sftp, $path, $attrs, $parent) = @_; |
1144
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
1145
|
0
|
|
|
|
|
0
|
my $first = !$parent; # skips file name |
1146
|
0
|
|
|
|
|
0
|
$path =~ s{^(/*)}{}; |
1147
|
0
|
|
|
|
|
0
|
my $start = $1; |
1148
|
0
|
|
|
|
|
0
|
$path =~ s{/+$}{}; |
1149
|
0
|
|
|
|
|
0
|
my @path; |
1150
|
0
|
|
|
|
|
0
|
while (1) { |
1151
|
0
|
0
|
|
|
|
0
|
if ($first) { |
1152
|
0
|
|
|
|
|
0
|
$first = 0 |
1153
|
|
|
|
|
|
|
} |
1154
|
|
|
|
|
|
|
else { |
1155
|
0
|
|
|
|
|
0
|
$path =~ s{/*[^/]*$}{} |
1156
|
|
|
|
|
|
|
} |
1157
|
0
|
|
|
|
|
0
|
my $p = "$start$path"; |
1158
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8192 and _debug "checking $p"; |
1159
|
0
|
0
|
|
|
|
0
|
if ($sftp->test_d($p)) { |
1160
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8192 and _debug "$p is a dir"; |
1161
|
0
|
|
|
|
|
0
|
last; |
1162
|
|
|
|
|
|
|
} |
1163
|
0
|
0
|
|
|
|
0
|
unless (length $path) { |
1164
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED, |
1165
|
|
|
|
|
|
|
"Unable to make path, bad root"); |
1166
|
0
|
|
|
|
|
0
|
return undef; |
1167
|
|
|
|
|
|
|
} |
1168
|
0
|
|
|
|
|
0
|
unshift @path, $p; |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
} |
1171
|
0
|
|
|
|
|
0
|
for my $p (@path) { |
1172
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8192 and _debug "mkdir $p"; |
1173
|
0
|
0
|
0
|
|
|
0
|
if ($p =~ m{^(?:.*/)?\.{1,2}$} or $p =~ m{/$}) { |
1174
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8192 and _debug "$p is a symbolic dir, skipping"; |
1175
|
0
|
0
|
|
|
|
0
|
unless ($sftp->test_d($p)) { |
1176
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8192 and _debug "symbolic dir $p can not be checked"; |
1177
|
|
|
|
|
|
|
$sftp->{_error} or |
1178
|
0
|
0
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED, |
1179
|
|
|
|
|
|
|
"Unable to make path, bad name"); |
1180
|
0
|
|
|
|
|
0
|
return undef; |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
} |
1183
|
|
|
|
|
|
|
else { |
1184
|
0
|
0
|
|
|
|
0
|
$sftp->mkdir($p, $attrs) |
1185
|
|
|
|
|
|
|
or return undef; |
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
} |
1188
|
0
|
|
|
|
|
0
|
1; |
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
sub _mkpath_local { |
1192
|
0
|
|
|
0
|
|
0
|
my ($sftp, $path, $perm, $parent) = @_; |
1193
|
|
|
|
|
|
|
# When parent is set, the last path part is removed and the parent |
1194
|
|
|
|
|
|
|
# directory of the path given created. |
1195
|
|
|
|
|
|
|
|
1196
|
0
|
|
|
|
|
0
|
my @parts = File::Spec->splitdir($path); |
1197
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32768 and _debug "_mkpath_local($path, $perm, ".($parent||0).")"; |
|
|
|
0
|
|
|
|
|
1198
|
|
|
|
|
|
|
|
1199
|
0
|
0
|
|
|
|
0
|
if ($parent) { |
1200
|
0
|
|
0
|
|
|
0
|
pop @parts while @parts and not length $parts[-1]; |
1201
|
0
|
0
|
|
|
|
0
|
unless (@parts) { |
1202
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED, |
1203
|
|
|
|
|
|
|
"mkpath failed, top dir reached"); |
1204
|
0
|
|
|
|
|
0
|
return; |
1205
|
|
|
|
|
|
|
} |
1206
|
0
|
|
|
|
|
0
|
pop @parts; |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
|
1209
|
0
|
|
|
|
|
0
|
my @tail; |
1210
|
0
|
|
|
|
|
0
|
while (@parts) { |
1211
|
0
|
|
|
|
|
0
|
my $target = File::Spec->catdir(@parts); |
1212
|
0
|
0
|
|
|
|
0
|
if (-e $target) { |
1213
|
0
|
0
|
|
|
|
0
|
unless (-d $target) { |
1214
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT, |
1215
|
|
|
|
|
|
|
"Local file '$target' is not a directory"); |
1216
|
0
|
|
|
|
|
0
|
return; |
1217
|
|
|
|
|
|
|
} |
1218
|
|
|
|
|
|
|
last |
1219
|
0
|
|
|
|
|
0
|
} |
1220
|
0
|
|
|
|
|
0
|
unshift @tail, pop @parts; |
1221
|
|
|
|
|
|
|
} |
1222
|
0
|
|
|
|
|
0
|
while (@tail) { |
1223
|
0
|
|
|
|
|
0
|
push @parts, shift @tail; |
1224
|
0
|
|
|
|
|
0
|
my $target = File::Spec->catdir(@parts); |
1225
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug and 32768 and _debug "creating local directory '$target'"; |
|
|
|
0
|
|
|
|
|
1226
|
0
|
0
|
|
|
|
0
|
unless (CORE::mkdir $target, $perm) { |
1227
|
0
|
0
|
|
|
|
0
|
unless (do { local $!; -d $target}) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1228
|
0
|
|
|
|
|
0
|
$sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED, |
1229
|
|
|
|
|
|
|
"mkdir '$target' failed", $!); |
1230
|
0
|
|
|
|
|
0
|
return; |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
} |
1234
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32768 and _debug "_mkpath_local succeeded"; |
1235
|
0
|
|
|
|
|
0
|
return 1; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
sub setstat { |
1239
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 3 or croak 'Usage: $sftp->setstat($path_or_fh, $attrs)'; |
1240
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1241
|
|
|
|
|
|
|
|
1242
|
0
|
|
|
|
|
0
|
my ($sftp, $pofh, $attrs) = @_; |
1243
|
0
|
0
|
0
|
|
|
0
|
my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') ) |
1244
|
|
|
|
|
|
|
? ( SSH2_FXP_FSETSTAT, str => $sftp->_rid($pofh) ) |
1245
|
|
|
|
|
|
|
: ( SSH2_FXP_SETSTAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ), |
1246
|
|
|
|
|
|
|
attr => $attrs ); |
1247
|
0
|
|
|
|
|
0
|
return $sftp->_check_status_ok($id, |
1248
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_SETSTAT_FAILED, |
1249
|
|
|
|
|
|
|
"Couldn't setstat remote file"); |
1250
|
|
|
|
|
|
|
} |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
## SSH2_FXP_CLOSE (4), SSH2_FXP_FSETSTAT (10) |
1253
|
|
|
|
|
|
|
# these return true on success, undef on failure |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
sub fsetstat { |
1256
|
0
|
|
|
0
|
1
|
0
|
_deprecated "fsetstat is deprecated and will be removed on the upcoming 2.xx series, " |
1257
|
|
|
|
|
|
|
. "setstat method accepts now both file handlers and paths"; |
1258
|
0
|
|
|
|
|
0
|
goto &setstat; |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
sub _gen_setstat_shortcut { |
1262
|
12
|
|
|
12
|
|
31
|
my ($name, $rid_type, $attrs_flag, @arg_types) = @_; |
1263
|
12
|
|
|
|
|
18
|
my $nargs = 2 + @arg_types; |
1264
|
12
|
|
|
|
|
62
|
my $usage = ("\$sftp->$name(" |
1265
|
|
|
|
|
|
|
. CORE::join(', ', '$path_or_fh', map "arg$_", 1..@arg_types) |
1266
|
|
|
|
|
|
|
. ')'); |
1267
|
12
|
50
|
|
|
|
42
|
my $rid_method = ($rid_type eq 'file' ? '_rfid' : |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
$rid_type eq 'dir' ? '_rdid' : |
1269
|
|
|
|
|
|
|
$rid_type eq 'any' ? '_rid' : |
1270
|
|
|
|
|
|
|
croak "bad rid type $rid_type"); |
1271
|
|
|
|
|
|
|
my $sub = sub { |
1272
|
0
|
0
|
|
0
|
|
0
|
@_ == $nargs or croak $usage; |
1273
|
0
|
|
|
|
|
0
|
my $sftp = shift; |
1274
|
0
|
|
|
|
|
0
|
my $pofh = shift; |
1275
|
|
|
|
|
|
|
my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') ) |
1276
|
|
|
|
|
|
|
? ( SSH2_FXP_FSETSTAT, str => $sftp->$rid_method($pofh) ) |
1277
|
|
|
|
|
|
|
: ( SSH2_FXP_SETSTAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ), |
1278
|
|
|
|
|
|
|
int32 => $attrs_flag, |
1279
|
0
|
0
|
0
|
|
|
0
|
map { $arg_types[$_] => $_[$_] } 0..$#arg_types ); |
|
0
|
|
|
|
|
0
|
|
1280
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, |
1281
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_SETSTAT_FAILED, |
1282
|
|
|
|
|
|
|
"Couldn't setstat remote file ($name)"); |
1283
|
12
|
|
|
|
|
39
|
}; |
1284
|
3
|
|
|
3
|
|
24
|
no strict 'refs'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
12520
|
|
1285
|
12
|
|
|
|
|
39
|
*$name = $sub; |
1286
|
|
|
|
|
|
|
} |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
_gen_setstat_shortcut(truncate => 'file', SSH2_FILEXFER_ATTR_SIZE, 'int64'); |
1289
|
|
|
|
|
|
|
_gen_setstat_shortcut(chown => 'any' , SSH2_FILEXFER_ATTR_UIDGID, 'int32', 'int32'); |
1290
|
|
|
|
|
|
|
_gen_setstat_shortcut(chmod => 'any' , SSH2_FILEXFER_ATTR_PERMISSIONS, 'int32'); |
1291
|
|
|
|
|
|
|
_gen_setstat_shortcut(utime => 'any' , SSH2_FILEXFER_ATTR_ACMODTIME, 'int32', 'int32'); |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
sub _close { |
1294
|
0
|
0
|
|
0
|
|
0
|
@_ == 2 or croak 'Usage: $sftp->close($fh, $attrs)'; |
1295
|
|
|
|
|
|
|
|
1296
|
0
|
|
|
|
|
0
|
my $sftp = shift; |
1297
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_rid_request(SSH2_FXP_CLOSE, @_); |
1298
|
0
|
0
|
|
|
|
0
|
defined $id or return undef; |
1299
|
|
|
|
|
|
|
|
1300
|
0
|
|
|
|
|
0
|
my $ok = $sftp->_check_status_ok($id, |
1301
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_CLOSE_FAILED, |
1302
|
|
|
|
|
|
|
"Couldn't close remote file"); |
1303
|
|
|
|
|
|
|
|
1304
|
0
|
0
|
0
|
|
|
0
|
if ($debug and $debug & 2) { |
1305
|
0
|
0
|
|
|
|
0
|
_debug sprintf("closing file handle, return: %s, rid:", (defined $ok ? $ok : '-')); |
1306
|
0
|
|
|
|
|
0
|
_hexdump($sftp->_rid($_[0])); |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
|
1309
|
0
|
|
|
|
|
0
|
return $ok; |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
sub close { |
1313
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 2 or croak 'Usage: $sftp->close($fh)'; |
1314
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1315
|
|
|
|
|
|
|
|
1316
|
0
|
|
|
|
|
0
|
my ($sftp, $rfh) = @_; |
1317
|
|
|
|
|
|
|
# defined $sftp->_rfid($rfh) or return undef; |
1318
|
|
|
|
|
|
|
# ^--- commented out because flush already checks it is an open file |
1319
|
0
|
0
|
|
|
|
0
|
$sftp->flush($rfh) |
1320
|
|
|
|
|
|
|
or return undef; |
1321
|
|
|
|
|
|
|
|
1322
|
0
|
0
|
|
|
|
0
|
if ($sftp->_close($rfh)) { |
1323
|
0
|
|
|
|
|
0
|
$rfh->_close; |
1324
|
0
|
|
|
|
|
0
|
return 1 |
1325
|
|
|
|
|
|
|
} |
1326
|
|
|
|
|
|
|
undef |
1327
|
0
|
|
|
|
|
0
|
} |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
sub closedir { |
1330
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 2 or croak 'Usage: $sftp->closedir($dh)'; |
1331
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1332
|
|
|
|
|
|
|
|
1333
|
0
|
|
|
|
|
0
|
my ($sftp, $rdh) = @_; |
1334
|
0
|
|
|
|
|
0
|
$rdh->_check_is_dir; |
1335
|
|
|
|
|
|
|
|
1336
|
0
|
0
|
|
|
|
0
|
if ($sftp->_close($rdh)) { |
1337
|
0
|
|
|
|
|
0
|
$rdh->_close; |
1338
|
0
|
|
|
|
|
0
|
return 1; |
1339
|
|
|
|
|
|
|
} |
1340
|
|
|
|
|
|
|
undef |
1341
|
0
|
|
|
|
|
0
|
} |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
sub readdir { |
1344
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 2 or croak 'Usage: $sftp->readdir($dh)'; |
1345
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1346
|
|
|
|
|
|
|
|
1347
|
0
|
|
|
|
|
0
|
my ($sftp, $rdh) = @_; |
1348
|
|
|
|
|
|
|
|
1349
|
0
|
|
|
|
|
0
|
my $rdid = $sftp->_rdid($rdh); |
1350
|
0
|
0
|
|
|
|
0
|
defined $rdid or return undef; |
1351
|
|
|
|
|
|
|
|
1352
|
0
|
|
|
|
|
0
|
my $cache = $rdh->_cache; |
1353
|
|
|
|
|
|
|
|
1354
|
0
|
|
0
|
|
|
0
|
while (!@$cache or wantarray) { |
1355
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid); |
1356
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id, |
1357
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READDIR_FAILED, |
1358
|
|
|
|
|
|
|
"Couldn't read remote directory" )) { |
1359
|
0
|
0
|
|
|
|
0
|
my $count = $msg->get_int32 or last; |
1360
|
|
|
|
|
|
|
|
1361
|
0
|
|
|
|
|
0
|
for (1..$count) { |
1362
|
0
|
|
|
|
|
0
|
push @$cache, { filename => $sftp->_fs_decode($msg->get_str), |
1363
|
|
|
|
|
|
|
longname => $sftp->_fs_decode($msg->get_str), |
1364
|
|
|
|
|
|
|
a => $msg->get_attributes }; |
1365
|
|
|
|
|
|
|
} |
1366
|
|
|
|
|
|
|
} |
1367
|
|
|
|
|
|
|
else { |
1368
|
0
|
0
|
|
|
|
0
|
$sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF; |
1369
|
0
|
|
|
|
|
0
|
last; |
1370
|
|
|
|
|
|
|
} |
1371
|
|
|
|
|
|
|
} |
1372
|
|
|
|
|
|
|
|
1373
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
1374
|
0
|
|
|
|
|
0
|
my $old = $cache; |
1375
|
0
|
|
|
|
|
0
|
$cache = []; |
1376
|
0
|
|
|
|
|
0
|
return @$old; |
1377
|
|
|
|
|
|
|
} |
1378
|
0
|
|
|
|
|
0
|
shift @$cache; |
1379
|
|
|
|
|
|
|
} |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
sub _readdir { |
1382
|
0
|
|
|
0
|
|
0
|
my ($sftp, $rdh); |
1383
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
1384
|
0
|
|
|
|
|
0
|
my $line = $sftp->readdir($rdh); |
1385
|
0
|
0
|
|
|
|
0
|
if (defined $line) { |
1386
|
0
|
|
|
|
|
0
|
return $line->{filename}; |
1387
|
|
|
|
|
|
|
} |
1388
|
|
|
|
|
|
|
} |
1389
|
|
|
|
|
|
|
else { |
1390
|
0
|
|
|
|
|
0
|
return map { $_->{filename} } $sftp->readdir($rdh); |
|
0
|
|
|
|
|
0
|
|
1391
|
|
|
|
|
|
|
} |
1392
|
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
sub _gen_getpath_method { |
1395
|
6
|
|
|
6
|
|
12
|
my ($code, $error, $name) = @_; |
1396
|
|
|
|
|
|
|
return sub { |
1397
|
0
|
0
|
|
0
|
|
0
|
@_ == 2 or croak 'Usage: $sftp->some_method($path)'; |
1398
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1399
|
|
|
|
|
|
|
|
1400
|
0
|
|
|
|
|
0
|
my ($sftp, $path) = @_; |
1401
|
0
|
|
|
|
|
0
|
$path = $sftp->_rel2abs($path); |
1402
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path)); |
1403
|
|
|
|
|
|
|
|
1404
|
0
|
0
|
|
|
|
0
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id, |
1405
|
|
|
|
|
|
|
$error, |
1406
|
|
|
|
|
|
|
"Couldn't get $name for remote '$path'")) { |
1407
|
0
|
0
|
|
|
|
0
|
$msg->get_int32 > 0 |
1408
|
|
|
|
|
|
|
and return $sftp->_fs_decode($msg->get_str); |
1409
|
|
|
|
|
|
|
|
1410
|
0
|
|
|
|
|
0
|
$sftp->_set_error($error, |
1411
|
|
|
|
|
|
|
"Couldn't get $name for remote '$path', no names on reply") |
1412
|
|
|
|
|
|
|
} |
1413
|
0
|
|
|
|
|
0
|
return undef; |
1414
|
6
|
|
|
|
|
35
|
}; |
1415
|
|
|
|
|
|
|
} |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
## SSH2_FXP_REALPATH (16) |
1418
|
|
|
|
|
|
|
## SSH2_FXP_READLINK (19) |
1419
|
|
|
|
|
|
|
# return path on success, undef on failure |
1420
|
|
|
|
|
|
|
*realpath = _gen_getpath_method(SSH2_FXP_REALPATH, |
1421
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_REALPATH_FAILED, |
1422
|
|
|
|
|
|
|
"realpath"); |
1423
|
|
|
|
|
|
|
*readlink = _gen_getpath_method(SSH2_FXP_READLINK, |
1424
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READLINK_FAILED, |
1425
|
|
|
|
|
|
|
"link target"); |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
## SSH2_FXP_RENAME (18) |
1428
|
|
|
|
|
|
|
# true on success, undef on failure |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
sub _rename { |
1431
|
0
|
|
|
0
|
|
0
|
my ($sftp, $old, $new) = @_; |
1432
|
|
|
|
|
|
|
|
1433
|
0
|
|
|
|
|
0
|
$old = $sftp->_rel2abs($old); |
1434
|
0
|
|
|
|
|
0
|
$new = $sftp->_rel2abs($new); |
1435
|
|
|
|
|
|
|
|
1436
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_RENAME, |
1437
|
|
|
|
|
|
|
str => $sftp->_fs_encode($old), |
1438
|
|
|
|
|
|
|
str => $sftp->_fs_encode($new)); |
1439
|
|
|
|
|
|
|
|
1440
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_RENAME_FAILED, |
1441
|
|
|
|
|
|
|
"Couldn't rename remote file '$old' to '$new'"); |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
sub rename { |
1445
|
0
|
0
|
|
0
|
1
|
0
|
(@_ & 1) or croak 'Usage: $sftp->rename($old, $new, %opts)'; |
1446
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1447
|
|
|
|
|
|
|
|
1448
|
0
|
|
|
|
|
0
|
my ($sftp, $old, $new, %opts) = @_; |
1449
|
|
|
|
|
|
|
|
1450
|
0
|
|
|
|
|
0
|
my $overwrite = delete $opts{overwrite}; |
1451
|
0
|
|
|
|
|
0
|
my $numbered = delete $opts{numbered}; |
1452
|
0
|
0
|
0
|
|
|
0
|
croak "'overwrite' and 'numbered' options can not be used together" |
1453
|
|
|
|
|
|
|
if ($overwrite and $numbered); |
1454
|
0
|
0
|
|
|
|
0
|
%opts and _croak_bad_options(keys %opts); |
1455
|
|
|
|
|
|
|
|
1456
|
0
|
0
|
|
|
|
0
|
if ($overwrite) { |
1457
|
0
|
0
|
|
|
|
0
|
$sftp->atomic_rename($old, $new) and return 1; |
1458
|
0
|
0
|
|
|
|
0
|
$sftp->{_status} != SSH2_FX_OP_UNSUPPORTED and return undef; |
1459
|
|
|
|
|
|
|
} |
1460
|
|
|
|
|
|
|
|
1461
|
0
|
|
|
|
|
0
|
for (1) { |
1462
|
0
|
|
|
|
|
0
|
local $sftp->{_autodie}; |
1463
|
|
|
|
|
|
|
# we are optimistic here and try to rename it without testing |
1464
|
|
|
|
|
|
|
# if a file of the same name already exists first |
1465
|
0
|
0
|
0
|
|
|
0
|
if (!$sftp->_rename($old, $new) and |
1466
|
|
|
|
|
|
|
$sftp->{_status} == SSH2_FX_FAILURE) { |
1467
|
0
|
0
|
0
|
|
|
0
|
if ($numbered and $sftp->test_e($new)) { |
|
|
0
|
|
|
|
|
|
1468
|
0
|
|
|
|
|
0
|
_inc_numbered($new); |
1469
|
0
|
|
|
|
|
0
|
redo; |
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
elsif ($overwrite) { |
1472
|
0
|
|
|
|
|
0
|
my $rp_old = $sftp->realpath($old); |
1473
|
0
|
|
|
|
|
0
|
my $rp_new = $sftp->realpath($new); |
1474
|
0
|
0
|
0
|
|
|
0
|
if (defined $rp_old and defined $rp_new and $rp_old eq $rp_new) { |
|
|
0
|
0
|
|
|
|
|
1475
|
0
|
|
|
|
|
0
|
$sftp->_clear_error_and_status; |
1476
|
|
|
|
|
|
|
} |
1477
|
|
|
|
|
|
|
elsif ($sftp->remove($new)) { |
1478
|
0
|
|
|
|
|
0
|
$overwrite = 0; |
1479
|
0
|
|
|
|
|
0
|
redo; |
1480
|
|
|
|
|
|
|
} |
1481
|
|
|
|
|
|
|
} |
1482
|
|
|
|
|
|
|
} |
1483
|
|
|
|
|
|
|
} |
1484
|
0
|
|
|
|
|
0
|
$sftp->_ok_or_autodie; |
1485
|
|
|
|
|
|
|
} |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
sub atomic_rename { |
1488
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 3 or croak 'Usage: $sftp->atomic_rename($old, $new)'; |
1489
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1490
|
|
|
|
|
|
|
|
1491
|
0
|
|
|
|
|
0
|
my ($sftp, $old, $new) = @_; |
1492
|
|
|
|
|
|
|
|
1493
|
0
|
0
|
|
|
|
0
|
$sftp->_check_extension('posix-rename@openssh.com' => 1, |
1494
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_RENAME_FAILED, |
1495
|
|
|
|
|
|
|
"atomic rename failed") |
1496
|
|
|
|
|
|
|
or return undef; |
1497
|
|
|
|
|
|
|
|
1498
|
0
|
|
|
|
|
0
|
$old = $sftp->_rel2abs($old); |
1499
|
0
|
|
|
|
|
0
|
$new = $sftp->_rel2abs($new); |
1500
|
|
|
|
|
|
|
|
1501
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED, |
1502
|
|
|
|
|
|
|
str => 'posix-rename@openssh.com', |
1503
|
|
|
|
|
|
|
str => $sftp->_fs_encode($old), |
1504
|
|
|
|
|
|
|
str => $sftp->_fs_encode($new)); |
1505
|
|
|
|
|
|
|
|
1506
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_RENAME_FAILED, |
1507
|
|
|
|
|
|
|
"Couldn't rename remote file '$old' to '$new'"); |
1508
|
|
|
|
|
|
|
} |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
## SSH2_FXP_SYMLINK (20) |
1511
|
|
|
|
|
|
|
# true on success, undef on failure |
1512
|
|
|
|
|
|
|
sub symlink { |
1513
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 3 or croak 'Usage: $sftp->symlink($sl, $target)'; |
1514
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1515
|
|
|
|
|
|
|
|
1516
|
0
|
|
|
|
|
0
|
my ($sftp, $sl, $target) = @_; |
1517
|
0
|
|
|
|
|
0
|
$sl = $sftp->_rel2abs($sl); |
1518
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_SYMLINK, |
1519
|
|
|
|
|
|
|
str => $sftp->_fs_encode($target), |
1520
|
|
|
|
|
|
|
str => $sftp->_fs_encode($sl)); |
1521
|
|
|
|
|
|
|
|
1522
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_SYMLINK_FAILED, |
1523
|
|
|
|
|
|
|
"Couldn't create symlink '$sl' pointing to '$target'"); |
1524
|
|
|
|
|
|
|
} |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
sub hardlink { |
1527
|
0
|
0
|
|
0
|
1
|
0
|
@_ == 3 or croak 'Usage: $sftp->hardlink($hl, $target)'; |
1528
|
0
|
0
|
|
|
|
0
|
${^TAINT} and &_catch_tainted_args; |
1529
|
|
|
|
|
|
|
|
1530
|
0
|
|
|
|
|
0
|
my ($sftp, $hl, $target) = @_; |
1531
|
|
|
|
|
|
|
|
1532
|
0
|
0
|
|
|
|
0
|
$sftp->_check_extension('hardlink@openssh.com' => 1, |
1533
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_HARDLINK_FAILED, |
1534
|
|
|
|
|
|
|
"hardlink failed") |
1535
|
|
|
|
|
|
|
or return undef; |
1536
|
0
|
|
|
|
|
0
|
$hl = $sftp->_rel2abs($hl); |
1537
|
0
|
|
|
|
|
0
|
$target = $sftp->_rel2abs($target); |
1538
|
|
|
|
|
|
|
|
1539
|
0
|
|
|
|
|
0
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED, |
1540
|
|
|
|
|
|
|
str => 'hardlink@openssh.com', |
1541
|
|
|
|
|
|
|
str => $sftp->_fs_encode($target), |
1542
|
|
|
|
|
|
|
str => $sftp->_fs_encode($hl)); |
1543
|
0
|
|
|
|
|
0
|
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_HARDLINK_FAILED, |
1544
|
|
|
|
|
|
|
"Couldn't create hardlink '$hl' pointing to '$target'"); |
1545
|
|
|
|
|
|
|
} |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
sub _gen_save_status_method { |
1548
|
9
|
|
|
9
|
|
26
|
my $method = shift; |
1549
|
|
|
|
|
|
|
sub { |
1550
|
0
|
|
|
0
|
|
|
my $sftp = shift; |
1551
|
0
|
0
|
|
|
|
|
local ($sftp->{_error}, $sftp->{_status}) if $sftp->{_error}; |
1552
|
0
|
|
|
|
|
|
$sftp->$method(@_); |
1553
|
|
|
|
|
|
|
} |
1554
|
9
|
|
|
|
|
36
|
} |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
*_close_save_status = _gen_save_status_method('close'); |
1558
|
|
|
|
|
|
|
*_closedir_save_status = _gen_save_status_method('closedir'); |
1559
|
|
|
|
|
|
|
*_remove_save_status = _gen_save_status_method('remove'); |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
sub _inc_numbered { |
1562
|
0
|
0
|
|
0
|
|
|
$_[0] =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e or |
|
0
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
$_[0] =~ s{((?:\.[^\.]*)?)$}{(1)$1}; |
1564
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 128 and _debug("numbering to: $_[0]"); |
1565
|
|
|
|
|
|
|
} |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
## High-level client -> server methods. |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
sub abort { |
1570
|
0
|
|
|
0
|
1
|
|
my $sftp = shift; |
1571
|
0
|
0
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_ABORTED, ($@ ? $_[0] : "Aborted")); |
1572
|
|
|
|
|
|
|
} |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
# returns true on success, undef on failure |
1575
|
|
|
|
|
|
|
sub get { |
1576
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->get($remote, $local, %opts)'; |
1577
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
1578
|
|
|
|
|
|
|
|
1579
|
0
|
|
|
|
|
|
my ($sftp, $remote, $local, %opts) = @_; |
1580
|
0
|
0
|
|
|
|
|
defined $remote or croak "remote file path is undefined"; |
1581
|
|
|
|
|
|
|
|
1582
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
1583
|
|
|
|
|
|
|
|
1584
|
0
|
|
|
|
|
|
$remote = $sftp->_rel2abs($remote); |
1585
|
0
|
0
|
|
|
|
|
$local = _file_part($remote) unless defined $local; |
1586
|
0
|
|
0
|
|
|
|
my $local_is_fh = (ref $local and $local->isa('GLOB')); |
1587
|
|
|
|
|
|
|
|
1588
|
0
|
|
|
|
|
|
my $cb = delete $opts{callback}; |
1589
|
0
|
|
|
|
|
|
my $umask = delete $opts{umask}; |
1590
|
0
|
|
|
|
|
|
my $perm = delete $opts{perm}; |
1591
|
0
|
0
|
|
|
|
|
my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'}; |
1592
|
0
|
|
|
|
|
|
my $copy_time = delete $opts{copy_time}; |
1593
|
0
|
|
|
|
|
|
my $overwrite = delete $opts{overwrite}; |
1594
|
0
|
|
|
|
|
|
my $resume = delete $opts{resume}; |
1595
|
0
|
|
|
|
|
|
my $append = delete $opts{append}; |
1596
|
0
|
|
0
|
|
|
|
my $block_size = delete $opts{block_size} || $sftp->{_block_size}; |
1597
|
0
|
|
0
|
|
|
|
my $queue_size = delete $opts{queue_size} || $sftp->{_queue_size}; |
1598
|
0
|
|
|
|
|
|
my $dont_save = delete $opts{dont_save}; |
1599
|
0
|
|
|
|
|
|
my $conversion = delete $opts{conversion}; |
1600
|
0
|
|
|
|
|
|
my $numbered = delete $opts{numbered}; |
1601
|
0
|
|
|
|
|
|
my $cleanup = delete $opts{cleanup}; |
1602
|
0
|
|
|
|
|
|
my $atomic = delete $opts{atomic}; |
1603
|
0
|
|
|
|
|
|
my $best_effort = delete $opts{best_effort}; |
1604
|
0
|
|
|
|
|
|
my $mkpath = delete $opts{mkpath}; |
1605
|
|
|
|
|
|
|
|
1606
|
0
|
0
|
0
|
|
|
|
croak "'perm' and 'copy_perm' options can not be used simultaneously" |
1607
|
|
|
|
|
|
|
if (defined $perm and defined $copy_perm); |
1608
|
0
|
0
|
0
|
|
|
|
croak "'numbered' can not be used with 'overwrite', 'resume' or 'append'" |
|
|
|
0
|
|
|
|
|
1609
|
|
|
|
|
|
|
if ($numbered and ($overwrite or $resume or $append)); |
1610
|
0
|
0
|
0
|
|
|
|
if ($resume or $append) { |
1611
|
0
|
0
|
0
|
|
|
|
$resume and $append and croak "'resume' and 'append' options can not be used simultaneously"; |
1612
|
0
|
0
|
|
|
|
|
$atomic and croak "'atomic' can not be used with 'resume' or 'append'"; |
1613
|
0
|
0
|
|
|
|
|
$overwrite and croak "'overwrite' can not be used with 'resume' or 'append'"; |
1614
|
|
|
|
|
|
|
} |
1615
|
|
|
|
|
|
|
|
1616
|
0
|
0
|
|
|
|
|
if ($local_is_fh) { |
1617
|
0
|
|
|
|
|
|
my $tail = 'option can not be used when target is a file handle'; |
1618
|
0
|
0
|
|
|
|
|
$resume and croak "'resume' $tail"; |
1619
|
0
|
0
|
|
|
|
|
$overwrite and croak "'overwrite' $tail"; |
1620
|
0
|
0
|
|
|
|
|
$numbered and croak "'numbered' $tail"; |
1621
|
0
|
0
|
|
|
|
|
$dont_save and croak "'dont_save' $tail"; |
1622
|
0
|
0
|
|
|
|
|
$atomic and croak "'croak' $tail"; |
1623
|
|
|
|
|
|
|
} |
1624
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
1625
|
|
|
|
|
|
|
|
1626
|
0
|
0
|
0
|
|
|
|
if ($resume and $conversion) { |
1627
|
0
|
|
|
|
|
|
carp "resume option is useless when data conversion has also been requested"; |
1628
|
0
|
|
|
|
|
|
undef $resume; |
1629
|
|
|
|
|
|
|
} |
1630
|
|
|
|
|
|
|
|
1631
|
0
|
0
|
0
|
|
|
|
$overwrite = 1 unless (defined $overwrite or $local_is_fh or $numbered or $append); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1632
|
0
|
0
|
0
|
|
|
|
$copy_perm = 1 unless (defined $perm or defined $copy_perm or $local_is_fh); |
|
|
|
0
|
|
|
|
|
1633
|
0
|
0
|
0
|
|
|
|
$copy_time = 1 unless (defined $copy_time or $local_is_fh); |
1634
|
0
|
0
|
|
|
|
|
$mkpath = 1 unless defined $mkpath; |
1635
|
0
|
0
|
0
|
|
|
|
$cleanup = ($atomic || $numbered) unless defined $cleanup; |
1636
|
|
|
|
|
|
|
|
1637
|
0
|
|
|
|
|
|
my $a = do { |
1638
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
1639
|
0
|
|
|
|
|
|
$sftp->stat($remote); |
1640
|
|
|
|
|
|
|
}; |
1641
|
0
|
0
|
|
|
|
|
my ($rperm, $size, $atime, $mtime) = ($a ? ($a->perm, $a->size, $a->atime, $a->mtime) : ()); |
1642
|
0
|
0
|
|
|
|
|
$size = -1 unless defined $size; |
1643
|
|
|
|
|
|
|
|
1644
|
0
|
0
|
0
|
|
|
|
if ($copy_time and not defined $atime) { |
1645
|
0
|
0
|
|
|
|
|
if ($best_effort) { |
1646
|
0
|
|
|
|
|
|
undef $copy_time; |
1647
|
|
|
|
|
|
|
} |
1648
|
|
|
|
|
|
|
else { |
1649
|
0
|
0
|
|
|
|
|
$sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED, |
1650
|
|
|
|
|
|
|
"Not enough information on stat, amtime not included"); |
1651
|
0
|
|
|
|
|
|
return undef; |
1652
|
|
|
|
|
|
|
} |
1653
|
|
|
|
|
|
|
} |
1654
|
|
|
|
|
|
|
|
1655
|
0
|
0
|
|
|
|
|
$umask = (defined $perm ? 0 : umask) unless defined $umask; |
|
|
0
|
|
|
|
|
|
1656
|
0
|
0
|
|
|
|
|
if ($copy_perm) { |
1657
|
0
|
0
|
|
|
|
|
if (defined $rperm) { |
|
|
0
|
|
|
|
|
|
1658
|
0
|
|
|
|
|
|
$perm = $rperm; |
1659
|
|
|
|
|
|
|
} |
1660
|
|
|
|
|
|
|
elsif ($best_effort) { |
1661
|
0
|
|
|
|
|
|
undef $copy_perm |
1662
|
|
|
|
|
|
|
} |
1663
|
|
|
|
|
|
|
else { |
1664
|
0
|
0
|
|
|
|
|
$sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED, |
1665
|
|
|
|
|
|
|
"Not enough information on stat, mode not included"); |
1666
|
|
|
|
|
|
|
return undef |
1667
|
0
|
|
|
|
|
|
} |
1668
|
|
|
|
|
|
|
} |
1669
|
0
|
0
|
|
|
|
|
$perm &= ~$umask if defined $perm; |
1670
|
|
|
|
|
|
|
|
1671
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
1672
|
|
|
|
|
|
|
|
1673
|
0
|
0
|
0
|
|
|
|
if ($resume and $resume eq 'auto') { |
1674
|
0
|
|
|
|
|
|
undef $resume; |
1675
|
0
|
0
|
|
|
|
|
if (defined $mtime) { |
1676
|
0
|
0
|
|
|
|
|
if (my @lstat = CORE::stat $local) { |
1677
|
0
|
|
|
|
|
|
$resume = ($mtime <= $lstat[9]); |
1678
|
|
|
|
|
|
|
} |
1679
|
|
|
|
|
|
|
} |
1680
|
|
|
|
|
|
|
} |
1681
|
|
|
|
|
|
|
|
1682
|
0
|
|
|
|
|
|
my ($atomic_numbered, $atomic_local, $atomic_cleanup); |
1683
|
|
|
|
|
|
|
|
1684
|
0
|
|
|
|
|
|
my ($rfh, $fh); |
1685
|
0
|
|
|
|
|
|
my $askoff = 0; |
1686
|
0
|
|
|
|
|
|
my $lstart = 0; |
1687
|
|
|
|
|
|
|
|
1688
|
0
|
0
|
|
|
|
|
if ($dont_save) { |
1689
|
0
|
|
|
|
|
|
$rfh = $sftp->open($remote, SSH2_FXF_READ); |
1690
|
0
|
0
|
|
|
|
|
defined $rfh or return undef; |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
else { |
1693
|
0
|
0
|
0
|
|
|
|
unless ($local_is_fh or $overwrite or $append or $resume or $numbered) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1694
|
0
|
0
|
|
|
|
|
if (-e $local) { |
1695
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS, |
1696
|
|
|
|
|
|
|
"local file $local already exists"); |
1697
|
|
|
|
|
|
|
return undef |
1698
|
0
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
} |
1700
|
|
|
|
|
|
|
|
1701
|
0
|
0
|
|
|
|
|
if ($atomic) { |
1702
|
0
|
|
|
|
|
|
$atomic_local = $local; |
1703
|
0
|
|
|
|
|
|
$local .= sprintf("(%d).tmp", rand(10000)); |
1704
|
0
|
|
|
|
|
|
$atomic_numbered = $numbered; |
1705
|
0
|
|
|
|
|
|
$numbered = 1; |
1706
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 128 and _debug("temporal local file name: $local"); |
1707
|
|
|
|
|
|
|
} |
1708
|
|
|
|
|
|
|
|
1709
|
0
|
0
|
|
|
|
|
if ($resume) { |
1710
|
0
|
0
|
|
|
|
|
if (CORE::open $fh, '+<', $local) { |
1711
|
0
|
|
|
|
|
|
binmode $fh; |
1712
|
0
|
|
|
|
|
|
CORE::seek($fh, 0, 2); |
1713
|
0
|
|
|
|
|
|
$askoff = CORE::tell $fh; |
1714
|
0
|
0
|
|
|
|
|
if ($askoff < 0) { |
1715
|
|
|
|
|
|
|
# something is going really wrong here, fall |
1716
|
|
|
|
|
|
|
# back to non-resuming mode... |
1717
|
0
|
|
|
|
|
|
$askoff = 0; |
1718
|
0
|
|
|
|
|
|
undef $fh; |
1719
|
|
|
|
|
|
|
} |
1720
|
|
|
|
|
|
|
else { |
1721
|
0
|
0
|
0
|
|
|
|
if ($size >=0 and $askoff > $size) { |
1722
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_BIGGER_THAN_REMOTE, |
1723
|
|
|
|
|
|
|
"Couldn't resume transfer, local file is bigger than remote"); |
1724
|
0
|
|
|
|
|
|
return undef; |
1725
|
|
|
|
|
|
|
} |
1726
|
0
|
0
|
|
|
|
|
$size == $askoff and return 1; |
1727
|
|
|
|
|
|
|
} |
1728
|
|
|
|
|
|
|
} |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
# we open the remote file so late in order to skip it when |
1732
|
|
|
|
|
|
|
# resuming an already completed transfer: |
1733
|
0
|
|
|
|
|
|
$rfh = $sftp->open($remote, SSH2_FXF_READ); |
1734
|
0
|
0
|
|
|
|
|
defined $rfh or return undef; |
1735
|
|
|
|
|
|
|
|
1736
|
0
|
0
|
|
|
|
|
unless (defined $fh) { |
1737
|
0
|
0
|
|
|
|
|
if ($local_is_fh) { |
1738
|
0
|
|
|
|
|
|
$fh = $local; |
1739
|
0
|
|
|
|
|
|
local ($@, $SIG{__DIE__}, $SIG{__WARN__}); |
1740
|
0
|
|
|
|
|
|
eval { $lstart = CORE::tell($fh) }; |
|
0
|
|
|
|
|
|
|
1741
|
0
|
0
|
0
|
|
|
|
$lstart = 0 unless ($lstart and $lstart > 0); |
1742
|
|
|
|
|
|
|
} |
1743
|
|
|
|
|
|
|
else { |
1744
|
0
|
|
|
|
|
|
my $flags = Fcntl::O_CREAT|Fcntl::O_WRONLY; |
1745
|
0
|
0
|
|
|
|
|
$flags |= Fcntl::O_APPEND if $append; |
1746
|
0
|
0
|
0
|
|
|
|
$flags |= Fcntl::O_EXCL if ($numbered or (!$overwrite and !$append)); |
|
|
|
0
|
|
|
|
|
1747
|
0
|
0
|
|
|
|
|
unlink $local if $overwrite; |
1748
|
0
|
0
|
|
|
|
|
my $open_perm = (defined $perm ? $perm : 0666); |
1749
|
0
|
|
|
|
|
|
my $save = _umask_save_and_set($umask); |
1750
|
0
|
0
|
|
|
|
|
$sftp->_mkpath_local($local, $open_perm|0700, 1) if $mkpath; |
1751
|
0
|
|
|
|
|
|
while (1) { |
1752
|
0
|
0
|
|
|
|
|
sysopen ($fh, $local, $flags, $open_perm) and last; |
1753
|
0
|
0
|
0
|
|
|
|
unless ($numbered and -e $local) { |
1754
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED, |
1755
|
|
|
|
|
|
|
"Can't open $local", $!); |
1756
|
0
|
|
|
|
|
|
return undef; |
1757
|
|
|
|
|
|
|
} |
1758
|
0
|
|
|
|
|
|
_inc_numbered($local); |
1759
|
|
|
|
|
|
|
} |
1760
|
0
|
0
|
|
|
|
|
$$numbered = $local if ref $numbered; |
1761
|
0
|
|
|
|
|
|
binmode $fh; |
1762
|
0
|
0
|
|
|
|
|
$lstart = sysseek($fh, 0, 2) if $append; |
1763
|
|
|
|
|
|
|
} |
1764
|
|
|
|
|
|
|
} |
1765
|
|
|
|
|
|
|
|
1766
|
0
|
0
|
|
|
|
|
if (defined $perm) { |
1767
|
0
|
|
|
|
|
|
my $error; |
1768
|
0
|
|
|
|
|
|
do { |
1769
|
0
|
|
|
|
|
|
local ($@, $SIG{__DIE__}, $SIG{__WARN__}); |
1770
|
0
|
0
|
|
|
|
|
unless (eval { CORE::chmod($perm, $local) > 0 }) { |
|
0
|
|
|
|
|
|
|
1771
|
0
|
0
|
|
|
|
|
$error = ($@ ? $@ : $!); |
1772
|
|
|
|
|
|
|
} |
1773
|
|
|
|
|
|
|
}; |
1774
|
0
|
0
|
0
|
|
|
|
if ($error and !$best_effort) { |
1775
|
0
|
0
|
0
|
|
|
|
unlink $local unless $resume or $append; |
1776
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_CHMOD_FAILED, |
1777
|
|
|
|
|
|
|
"Can't chmod $local", $error); |
1778
|
|
|
|
|
|
|
return undef |
1779
|
0
|
|
|
|
|
|
} |
1780
|
|
|
|
|
|
|
} |
1781
|
|
|
|
|
|
|
} |
1782
|
|
|
|
|
|
|
|
1783
|
0
|
|
|
|
|
|
my $converter = _gen_converter $conversion; |
1784
|
|
|
|
|
|
|
|
1785
|
0
|
|
|
|
|
|
my $rfid = $sftp->_rfid($rfh); |
1786
|
0
|
0
|
|
|
|
|
defined $rfid or die "internal error: rfid not defined"; |
1787
|
|
|
|
|
|
|
|
1788
|
0
|
|
|
|
|
|
my @msgid; |
1789
|
|
|
|
|
|
|
my @askoff; |
1790
|
0
|
|
|
|
|
|
my $loff = $askoff; |
1791
|
0
|
|
|
|
|
|
my $adjustment = 0; |
1792
|
0
|
|
|
|
|
|
local $\; |
1793
|
|
|
|
|
|
|
|
1794
|
0
|
0
|
|
|
|
|
my $slow_start = ($size == -1 ? $queue_size - 1 : 0); |
1795
|
|
|
|
|
|
|
|
1796
|
0
|
|
|
|
|
|
my $safe_block_size = $sftp->{_min_block_size} >= $block_size; |
1797
|
|
|
|
|
|
|
|
1798
|
0
|
|
|
|
|
|
do { |
1799
|
|
|
|
|
|
|
# Disable autodie here in order to do not leave unhandled |
1800
|
|
|
|
|
|
|
# responses queued on the connection in case of failure. |
1801
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
1802
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
# Again, once this point is reached, all code paths should end |
1804
|
|
|
|
|
|
|
# through the CLEANUP block. |
1805
|
|
|
|
|
|
|
|
1806
|
0
|
|
|
|
|
|
while (1) { |
1807
|
|
|
|
|
|
|
# request a new block if queue is not full |
1808
|
0
|
|
0
|
|
|
|
while (!@msgid or ( ($size == -1 or $size + $block_size > $askoff) and |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1809
|
|
|
|
|
|
|
@msgid < $queue_size - $slow_start and |
1810
|
|
|
|
|
|
|
$safe_block_size ) ) { |
1811
|
0
|
|
|
|
|
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid, |
1812
|
|
|
|
|
|
|
int64 => $askoff, int32 => $block_size); |
1813
|
0
|
|
|
|
|
|
push @msgid, $id; |
1814
|
0
|
|
|
|
|
|
push @askoff, $askoff; |
1815
|
0
|
|
|
|
|
|
$askoff += $block_size; |
1816
|
|
|
|
|
|
|
} |
1817
|
|
|
|
|
|
|
|
1818
|
0
|
0
|
|
|
|
|
$slow_start-- if $slow_start; |
1819
|
|
|
|
|
|
|
|
1820
|
0
|
|
|
|
|
|
my $eid = shift @msgid; |
1821
|
0
|
|
|
|
|
|
my $roff = shift @askoff; |
1822
|
|
|
|
|
|
|
|
1823
|
0
|
|
|
|
|
|
my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $eid, |
1824
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READ_FAILED, |
1825
|
|
|
|
|
|
|
"Couldn't read from remote file"); |
1826
|
|
|
|
|
|
|
|
1827
|
0
|
0
|
|
|
|
|
unless ($msg) { |
1828
|
0
|
0
|
|
|
|
|
$sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF; |
1829
|
0
|
|
|
|
|
|
last; |
1830
|
|
|
|
|
|
|
} |
1831
|
|
|
|
|
|
|
|
1832
|
0
|
|
|
|
|
|
my $data = $msg->get_str; |
1833
|
0
|
|
|
|
|
|
my $len = length $data; |
1834
|
|
|
|
|
|
|
|
1835
|
0
|
0
|
0
|
|
|
|
if ($roff != $loff or !$len) { |
1836
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL, |
1837
|
|
|
|
|
|
|
"remote packet received is too small" ); |
1838
|
0
|
|
|
|
|
|
last; |
1839
|
|
|
|
|
|
|
} |
1840
|
|
|
|
|
|
|
|
1841
|
0
|
|
|
|
|
|
$loff += $len; |
1842
|
0
|
0
|
|
|
|
|
unless ($safe_block_size) { |
1843
|
0
|
0
|
|
|
|
|
if ($len > $sftp->{_min_block_size}) { |
1844
|
0
|
|
|
|
|
|
$sftp->{min_block_size} = $len; |
1845
|
0
|
0
|
|
|
|
|
if ($len < $block_size) { |
1846
|
|
|
|
|
|
|
# auto-adjust block size |
1847
|
0
|
|
|
|
|
|
$block_size = $len; |
1848
|
0
|
|
|
|
|
|
$askoff = $loff; |
1849
|
|
|
|
|
|
|
} |
1850
|
|
|
|
|
|
|
} |
1851
|
0
|
|
|
|
|
|
$safe_block_size = 1; |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
|
1854
|
0
|
|
|
|
|
|
my $adjustment_before = $adjustment; |
1855
|
0
|
0
|
|
|
|
|
$adjustment += $converter->($data) if $converter; |
1856
|
|
|
|
|
|
|
|
1857
|
0
|
0
|
0
|
|
|
|
if (length($data) and defined $cb) { |
1858
|
|
|
|
|
|
|
# $size = $loff if ($loff > $size and $size != -1); |
1859
|
0
|
|
|
|
|
|
local $\; |
1860
|
0
|
|
|
|
|
|
$cb->($sftp, $data, |
1861
|
|
|
|
|
|
|
$lstart + $roff + $adjustment_before, |
1862
|
|
|
|
|
|
|
$lstart + $size + $adjustment); |
1863
|
|
|
|
|
|
|
|
1864
|
0
|
0
|
|
|
|
|
last if $sftp->{_error}; |
1865
|
|
|
|
|
|
|
} |
1866
|
|
|
|
|
|
|
|
1867
|
0
|
0
|
0
|
|
|
|
if (length($data) and !$dont_save) { |
1868
|
0
|
0
|
|
|
|
|
unless (print $fh $data) { |
1869
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED, |
1870
|
|
|
|
|
|
|
"unable to write data to local file $local", $!); |
1871
|
0
|
|
|
|
|
|
last; |
1872
|
|
|
|
|
|
|
} |
1873
|
|
|
|
|
|
|
} |
1874
|
|
|
|
|
|
|
} |
1875
|
|
|
|
|
|
|
|
1876
|
0
|
|
|
|
|
|
$sftp->_get_msg_by_id($_) for @msgid; |
1877
|
|
|
|
|
|
|
|
1878
|
0
|
0
|
|
|
|
|
goto CLEANUP if $sftp->{_error}; |
1879
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
# if a converter is in place, and aditional call has to be |
1881
|
|
|
|
|
|
|
# performed in order to flush any pending buffered data |
1882
|
0
|
0
|
|
|
|
|
if ($converter) { |
1883
|
0
|
|
|
|
|
|
my $data = ''; |
1884
|
0
|
|
|
|
|
|
my $adjustment_before = $adjustment; |
1885
|
0
|
|
|
|
|
|
$adjustment += $converter->($data); |
1886
|
|
|
|
|
|
|
|
1887
|
0
|
0
|
0
|
|
|
|
if (length($data) and defined $cb) { |
1888
|
|
|
|
|
|
|
# $size = $loff if ($loff > $size and $size != -1); |
1889
|
0
|
|
|
|
|
|
local $\; |
1890
|
0
|
|
|
|
|
|
$cb->($sftp, $data, $askoff + $adjustment_before, $size + $adjustment); |
1891
|
0
|
0
|
|
|
|
|
goto CLEANUP if $sftp->{_error}; |
1892
|
|
|
|
|
|
|
} |
1893
|
|
|
|
|
|
|
|
1894
|
0
|
0
|
0
|
|
|
|
if (length($data) and !$dont_save) { |
1895
|
0
|
0
|
|
|
|
|
unless (print $fh $data) { |
1896
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED, |
1897
|
|
|
|
|
|
|
"unable to write data to local file $local", $!); |
1898
|
0
|
|
|
|
|
|
goto CLEANUP; |
1899
|
|
|
|
|
|
|
} |
1900
|
|
|
|
|
|
|
} |
1901
|
|
|
|
|
|
|
} |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
# we call the callback one last time with an empty string; |
1904
|
0
|
0
|
|
|
|
|
if (defined $cb) { |
1905
|
0
|
|
|
|
|
|
my $data = ''; |
1906
|
0
|
|
|
|
|
|
do { |
1907
|
0
|
|
|
|
|
|
local $\; |
1908
|
0
|
|
|
|
|
|
$cb->($sftp, $data, $askoff + $adjustment, $size + $adjustment); |
1909
|
|
|
|
|
|
|
}; |
1910
|
0
|
0
|
|
|
|
|
return undef if $sftp->{_error}; |
1911
|
0
|
0
|
0
|
|
|
|
if (length($data) and !$dont_save) { |
1912
|
0
|
0
|
|
|
|
|
unless (print $fh $data) { |
1913
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED, |
1914
|
|
|
|
|
|
|
"unable to write data to local file $local", $!); |
1915
|
0
|
|
|
|
|
|
goto CLEANUP; |
1916
|
|
|
|
|
|
|
} |
1917
|
|
|
|
|
|
|
} |
1918
|
|
|
|
|
|
|
} |
1919
|
|
|
|
|
|
|
|
1920
|
0
|
0
|
|
|
|
|
unless ($dont_save) { |
1921
|
0
|
0
|
0
|
|
|
|
unless ($local_is_fh or CORE::close $fh) { |
1922
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED, |
1923
|
|
|
|
|
|
|
"unable to write data to local file $local", $!); |
1924
|
0
|
|
|
|
|
|
goto CLEANUP; |
1925
|
|
|
|
|
|
|
} |
1926
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
# we can be running on taint mode, so some checks are |
1928
|
|
|
|
|
|
|
# performed to untaint data from the remote side. |
1929
|
|
|
|
|
|
|
|
1930
|
0
|
0
|
|
|
|
|
if ($copy_time) { |
1931
|
0
|
0
|
0
|
|
|
|
unless (utime($atime, $mtime, $local) or $best_effort) { |
1932
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_UTIME_FAILED, |
1933
|
|
|
|
|
|
|
"Can't utime $local", $!); |
1934
|
0
|
|
|
|
|
|
goto CLEANUP; |
1935
|
|
|
|
|
|
|
} |
1936
|
|
|
|
|
|
|
} |
1937
|
|
|
|
|
|
|
|
1938
|
0
|
0
|
|
|
|
|
if ($atomic) { |
1939
|
0
|
0
|
|
|
|
|
if (!$overwrite) { |
1940
|
0
|
|
|
|
|
|
while (1) { |
1941
|
|
|
|
|
|
|
# performing a non-overwriting atomic rename is |
1942
|
|
|
|
|
|
|
# quite burdensome: first, link is tried, if that |
1943
|
|
|
|
|
|
|
# fails, non-overwriting is favoured over |
1944
|
|
|
|
|
|
|
# atomicity and an empty file is used to lock the |
1945
|
|
|
|
|
|
|
# path before atempting an overwriting rename. |
1946
|
0
|
0
|
|
|
|
|
if (link $local, $atomic_local) { |
1947
|
0
|
|
|
|
|
|
unlink $local; |
1948
|
0
|
|
|
|
|
|
last; |
1949
|
|
|
|
|
|
|
} |
1950
|
0
|
|
|
|
|
|
my $err = $!; |
1951
|
0
|
0
|
|
|
|
|
unless (-e $atomic_local) { |
1952
|
0
|
0
|
|
|
|
|
if (sysopen my $lock, $atomic_local, |
1953
|
|
|
|
|
|
|
Fcntl::O_CREAT|Fcntl::O_EXCL|Fcntl::O_WRONLY, |
1954
|
|
|
|
|
|
|
0600) { |
1955
|
0
|
|
|
|
|
|
$atomic_cleanup = 1; |
1956
|
0
|
|
|
|
|
|
goto OVERWRITE; |
1957
|
|
|
|
|
|
|
} |
1958
|
0
|
|
|
|
|
|
$err = $!; |
1959
|
0
|
0
|
|
|
|
|
unless (-e $atomic_local) { |
1960
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED, |
1961
|
|
|
|
|
|
|
"Can't open $local", $err); |
1962
|
0
|
|
|
|
|
|
goto CLEANUP; |
1963
|
|
|
|
|
|
|
} |
1964
|
|
|
|
|
|
|
} |
1965
|
0
|
0
|
|
|
|
|
unless ($numbered) { |
1966
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS, |
1967
|
|
|
|
|
|
|
"local file $atomic_local already exists"); |
1968
|
0
|
|
|
|
|
|
goto CLEANUP; |
1969
|
|
|
|
|
|
|
} |
1970
|
0
|
|
|
|
|
|
_inc_numbered($atomic_local); |
1971
|
|
|
|
|
|
|
} |
1972
|
|
|
|
|
|
|
} |
1973
|
|
|
|
|
|
|
else { |
1974
|
|
|
|
|
|
|
OVERWRITE: |
1975
|
0
|
0
|
|
|
|
|
unless (CORE::rename $local, $atomic_local) { |
1976
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_RENAME_FAILED, |
1977
|
|
|
|
|
|
|
"Unable to rename temporal file to its final position '$atomic_local'", $!); |
1978
|
0
|
|
|
|
|
|
goto CLEANUP; |
1979
|
|
|
|
|
|
|
} |
1980
|
|
|
|
|
|
|
} |
1981
|
0
|
0
|
|
|
|
|
$$atomic_numbered = $local if ref $atomic_numbered; |
1982
|
|
|
|
|
|
|
} |
1983
|
|
|
|
|
|
|
} |
1984
|
|
|
|
|
|
|
CLEANUP: |
1985
|
0
|
0
|
0
|
|
|
|
if ($cleanup and $sftp->{_error}) { |
1986
|
0
|
|
|
|
|
|
unlink $local; |
1987
|
0
|
0
|
|
|
|
|
unlink $atomic_local if $atomic_cleanup; |
1988
|
|
|
|
|
|
|
} |
1989
|
|
|
|
|
|
|
}; # autodie flag is restored here! |
1990
|
|
|
|
|
|
|
|
1991
|
0
|
|
|
|
|
|
$sftp->_ok_or_autodie; |
1992
|
|
|
|
|
|
|
} |
1993
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
# return file contents on success, undef on failure |
1995
|
|
|
|
|
|
|
sub get_content { |
1996
|
0
|
0
|
|
0
|
1
|
|
@_ == 2 or croak 'Usage: $sftp->get_content($remote)'; |
1997
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
1998
|
|
|
|
|
|
|
|
1999
|
0
|
|
|
|
|
|
my ($sftp, $name) = @_; |
2000
|
|
|
|
|
|
|
#$name = $sftp->_rel2abs($name); |
2001
|
0
|
|
|
|
|
|
my @data; |
2002
|
|
|
|
|
|
|
|
2003
|
0
|
0
|
|
|
|
|
my $rfh = $sftp->open($name) |
2004
|
|
|
|
|
|
|
or return undef; |
2005
|
|
|
|
|
|
|
|
2006
|
0
|
|
|
|
|
|
scalar $sftp->readline($rfh, undef); |
2007
|
|
|
|
|
|
|
} |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
sub put { |
2010
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->put($local, $remote, %opts)'; |
2011
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
2012
|
|
|
|
|
|
|
|
2013
|
0
|
|
|
|
|
|
my ($sftp, $local, $remote, %opts) = @_; |
2014
|
0
|
0
|
|
|
|
|
defined $local or croak "local file path is undefined"; |
2015
|
|
|
|
|
|
|
|
2016
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
2017
|
|
|
|
|
|
|
|
2018
|
0
|
|
0
|
|
|
|
my $local_is_fh = (ref $local and $local->isa('GLOB')); |
2019
|
0
|
0
|
|
|
|
|
unless (defined $remote) { |
2020
|
0
|
0
|
|
|
|
|
$local_is_fh and croak "unable to infer remote file name when a file handler is passed as local"; |
2021
|
0
|
|
|
|
|
|
$remote = (File::Spec->splitpath($local))[2]; |
2022
|
|
|
|
|
|
|
} |
2023
|
|
|
|
|
|
|
# $remote = $sftp->_rel2abs($remote); |
2024
|
|
|
|
|
|
|
|
2025
|
0
|
|
|
|
|
|
my $cb = delete $opts{callback}; |
2026
|
0
|
|
|
|
|
|
my $umask = delete $opts{umask}; |
2027
|
0
|
|
|
|
|
|
my $perm = delete $opts{perm}; |
2028
|
0
|
|
|
|
|
|
my $copy_perm = delete $opts{copy_perm}; |
2029
|
0
|
0
|
|
|
|
|
$copy_perm = delete $opts{copy_perms} unless defined $copy_perm; |
2030
|
0
|
|
|
|
|
|
my $copy_time = delete $opts{copy_time}; |
2031
|
0
|
|
|
|
|
|
my $overwrite = delete $opts{overwrite}; |
2032
|
0
|
|
|
|
|
|
my $resume = delete $opts{resume}; |
2033
|
0
|
|
|
|
|
|
my $append = delete $opts{append}; |
2034
|
0
|
|
0
|
|
|
|
my $block_size = delete $opts{block_size} || $sftp->{_block_size}; |
2035
|
0
|
|
0
|
|
|
|
my $queue_size = delete $opts{queue_size} || $sftp->{_queue_size}; |
2036
|
0
|
|
|
|
|
|
my $conversion = delete $opts{conversion}; |
2037
|
0
|
|
|
|
|
|
my $late_set_perm = delete $opts{late_set_perm}; |
2038
|
0
|
|
|
|
|
|
my $numbered = delete $opts{numbered}; |
2039
|
0
|
|
|
|
|
|
my $atomic = delete $opts{atomic}; |
2040
|
0
|
|
|
|
|
|
my $cleanup = delete $opts{cleanup}; |
2041
|
0
|
|
|
|
|
|
my $best_effort = delete $opts{best_effort}; |
2042
|
0
|
|
|
|
|
|
my $sparse = delete $opts{sparse}; |
2043
|
0
|
|
|
|
|
|
my $mkpath = delete $opts{mkpath}; |
2044
|
|
|
|
|
|
|
|
2045
|
0
|
0
|
0
|
|
|
|
croak "'perm' and 'umask' options can not be used simultaneously" |
2046
|
|
|
|
|
|
|
if (defined $perm and defined $umask); |
2047
|
0
|
0
|
0
|
|
|
|
croak "'perm' and 'copy_perm' options can not be used simultaneously" |
2048
|
|
|
|
|
|
|
if (defined $perm and $copy_perm); |
2049
|
0
|
0
|
0
|
|
|
|
croak "'resume' and 'append' options can not be used simultaneously" |
2050
|
|
|
|
|
|
|
if ($resume and $append); |
2051
|
0
|
0
|
0
|
|
|
|
croak "'resume' and 'overwrite' options can not be used simultaneously" |
2052
|
|
|
|
|
|
|
if ($resume and $overwrite); |
2053
|
0
|
0
|
0
|
|
|
|
croak "'numbered' can not be used with 'overwrite', 'resume' or 'append'" |
|
|
|
0
|
|
|
|
|
2054
|
|
|
|
|
|
|
if ($numbered and ($overwrite or $resume or $append)); |
2055
|
0
|
0
|
0
|
|
|
|
croak "'atomic' can not be used with 'resume' or 'append'" |
|
|
|
0
|
|
|
|
|
2056
|
|
|
|
|
|
|
if ($atomic and ($resume or $append)); |
2057
|
|
|
|
|
|
|
|
2058
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2059
|
|
|
|
|
|
|
|
2060
|
0
|
0
|
0
|
|
|
|
$overwrite = 1 unless (defined $overwrite or $numbered); |
2061
|
0
|
0
|
0
|
|
|
|
$copy_perm = 1 unless (defined $perm or defined $copy_perm or $local_is_fh); |
|
|
|
0
|
|
|
|
|
2062
|
0
|
0
|
0
|
|
|
|
$copy_time = 1 unless (defined $copy_time or $local_is_fh); |
2063
|
0
|
0
|
|
|
|
|
$late_set_perm = $sftp->{_late_set_perm} unless defined $late_set_perm; |
2064
|
0
|
0
|
0
|
|
|
|
$cleanup = ($atomic || $numbered) unless defined $cleanup; |
2065
|
0
|
0
|
|
|
|
|
$mkpath = 1 unless defined $mkpath; |
2066
|
|
|
|
|
|
|
|
2067
|
0
|
|
|
|
|
|
my $neg_umask; |
2068
|
0
|
0
|
|
|
|
|
if (defined $perm) { |
2069
|
0
|
|
|
|
|
|
$neg_umask = $perm; |
2070
|
|
|
|
|
|
|
} |
2071
|
|
|
|
|
|
|
else { |
2072
|
0
|
0
|
|
|
|
|
$umask = umask unless defined $umask; |
2073
|
0
|
|
|
|
|
|
$neg_umask = 0777 & ~$umask; |
2074
|
|
|
|
|
|
|
} |
2075
|
|
|
|
|
|
|
|
2076
|
0
|
|
|
|
|
|
my ($fh, $lmode, $lsize, $latime, $lmtime); |
2077
|
0
|
0
|
|
|
|
|
if ($local_is_fh) { |
2078
|
0
|
|
|
|
|
|
$fh = $local; |
2079
|
|
|
|
|
|
|
# we don't set binmode for the passed file handle on purpose |
2080
|
|
|
|
|
|
|
} |
2081
|
|
|
|
|
|
|
else { |
2082
|
0
|
0
|
|
|
|
|
unless (CORE::open $fh, '<', $local) { |
2083
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED, |
2084
|
|
|
|
|
|
|
"Unable to open local file '$local'", $!); |
2085
|
0
|
|
|
|
|
|
return undef; |
2086
|
|
|
|
|
|
|
} |
2087
|
0
|
|
|
|
|
|
binmode $fh; |
2088
|
|
|
|
|
|
|
} |
2089
|
|
|
|
|
|
|
|
2090
|
|
|
|
|
|
|
{ |
2091
|
|
|
|
|
|
|
# as $fh can come from the outside, it may be a tied object |
2092
|
|
|
|
|
|
|
# lacking support for some methods, so we call them wrapped |
2093
|
|
|
|
|
|
|
# inside eval blocks |
2094
|
0
|
|
|
|
|
|
local ($@, $SIG{__DIE__}, $SIG{__WARN__}); |
|
0
|
|
|
|
|
|
|
2095
|
0
|
0
|
0
|
|
|
|
if ((undef, undef, $lmode, undef, undef, |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
undef, undef, $lsize, $latime, $lmtime) = |
2097
|
|
|
|
|
|
|
eval { |
2098
|
3
|
|
|
3
|
|
62
|
no warnings; # Calling stat on a tied handler |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
19163
|
|
2099
|
|
|
|
|
|
|
# generates a warning because the op is |
2100
|
|
|
|
|
|
|
# not supported by the tie API. |
2101
|
0
|
|
|
|
|
|
CORE::stat $fh; |
2102
|
|
|
|
|
|
|
} |
2103
|
|
|
|
|
|
|
) { |
2104
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "local file size is " . (defined $lsize ? $lsize : ''); |
|
|
0
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
# $fh can point at some place inside the file, not just at the |
2107
|
|
|
|
|
|
|
# begining |
2108
|
0
|
0
|
0
|
|
|
|
if ($local_is_fh and defined $lsize) { |
2109
|
0
|
|
|
|
|
|
my $tell = eval { CORE::tell $fh }; |
|
0
|
|
|
|
|
|
|
2110
|
0
|
0
|
0
|
|
|
|
$lsize -= $tell if $tell and $tell > 0; |
2111
|
|
|
|
|
|
|
} |
2112
|
|
|
|
|
|
|
} |
2113
|
|
|
|
|
|
|
elsif ($copy_perm or $copy_time) { |
2114
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_STAT_FAILED, |
2115
|
|
|
|
|
|
|
"Couldn't stat local file '$local'", $!); |
2116
|
0
|
|
|
|
|
|
return undef; |
2117
|
|
|
|
|
|
|
} |
2118
|
|
|
|
|
|
|
elsif ($resume and $resume eq 'auto') { |
2119
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "not resuming because stat'ing the local file failed"; |
2120
|
0
|
|
|
|
|
|
undef $resume |
2121
|
|
|
|
|
|
|
} |
2122
|
|
|
|
|
|
|
} |
2123
|
|
|
|
|
|
|
|
2124
|
0
|
0
|
|
|
|
|
$perm = $lmode & $neg_umask if $copy_perm; |
2125
|
0
|
|
|
|
|
|
my $attrs = Net::SFTP::Foreign::Attributes->new; |
2126
|
0
|
0
|
|
|
|
|
$attrs->set_perm($perm) if defined $perm; |
2127
|
|
|
|
|
|
|
|
2128
|
0
|
|
|
|
|
|
my $rfh; |
2129
|
0
|
|
|
|
|
|
my $writeoff = 0; |
2130
|
0
|
|
|
|
|
|
my $converter = _gen_converter $conversion; |
2131
|
0
|
|
|
|
|
|
my $converted_input = ''; |
2132
|
0
|
|
|
|
|
|
my $rattrs; |
2133
|
|
|
|
|
|
|
|
2134
|
0
|
0
|
0
|
|
|
|
if ($resume or $append) { |
2135
|
0
|
|
|
|
|
|
$rattrs = do { |
2136
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
2137
|
0
|
|
|
|
|
|
$sftp->stat($remote); |
2138
|
|
|
|
|
|
|
}; |
2139
|
0
|
0
|
|
|
|
|
if ($rattrs) { |
2140
|
0
|
0
|
0
|
|
|
|
if ($resume and $resume eq 'auto' and $rattrs->mtime <= $lmtime) { |
|
|
|
0
|
|
|
|
|
2141
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and |
2142
|
|
|
|
|
|
|
_debug "not resuming because local file is newer, r: ".$rattrs->mtime." l: $lmtime"; |
2143
|
0
|
|
|
|
|
|
undef $resume; |
2144
|
|
|
|
|
|
|
} |
2145
|
|
|
|
|
|
|
else { |
2146
|
0
|
|
|
|
|
|
$writeoff = $rattrs->size; |
2147
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "resuming from $writeoff"; |
2148
|
|
|
|
|
|
|
} |
2149
|
|
|
|
|
|
|
} |
2150
|
|
|
|
|
|
|
else { |
2151
|
0
|
0
|
|
|
|
|
if ($append) { |
2152
|
0
|
0
|
0
|
|
|
|
$sftp->{_status} == SSH2_FX_NO_SUCH_FILE |
2153
|
|
|
|
|
|
|
or $sftp->_ok_or_autodie or return undef; |
2154
|
|
|
|
|
|
|
# no such file, no append |
2155
|
0
|
|
|
|
|
|
undef $append; |
2156
|
|
|
|
|
|
|
} |
2157
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
2158
|
|
|
|
|
|
|
} |
2159
|
|
|
|
|
|
|
} |
2160
|
|
|
|
|
|
|
|
2161
|
0
|
|
|
|
|
|
my ($atomic_numbered, $atomic_remote); |
2162
|
0
|
0
|
|
|
|
|
if ($writeoff) { |
2163
|
|
|
|
|
|
|
# one of $resume or $append is set |
2164
|
0
|
0
|
|
|
|
|
if ($resume) { |
2165
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "resuming file transfer from $writeoff"; |
2166
|
0
|
0
|
|
|
|
|
if ($converter) { |
|
|
0
|
|
|
|
|
|
2167
|
|
|
|
|
|
|
# as size could change, we have to read and convert |
2168
|
|
|
|
|
|
|
# data until we reach the given position on the local |
2169
|
|
|
|
|
|
|
# file: |
2170
|
0
|
|
|
|
|
|
my $off = 0; |
2171
|
0
|
|
|
|
|
|
my $eof_t; |
2172
|
0
|
|
|
|
|
|
while (1) { |
2173
|
0
|
|
|
|
|
|
my $len = length $converted_input; |
2174
|
0
|
|
|
|
|
|
my $delta = $writeoff - $off; |
2175
|
0
|
0
|
|
|
|
|
if ($delta <= $len) { |
2176
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "discarding $delta converted bytes"; |
2177
|
0
|
|
|
|
|
|
substr $converted_input, 0, $delta, ''; |
2178
|
0
|
|
|
|
|
|
last; |
2179
|
|
|
|
|
|
|
} |
2180
|
|
|
|
|
|
|
else { |
2181
|
0
|
|
|
|
|
|
$off += $len; |
2182
|
0
|
0
|
|
|
|
|
if ($eof_t) { |
2183
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL, |
2184
|
|
|
|
|
|
|
"Couldn't resume transfer, remote file is bigger than local"); |
2185
|
0
|
|
|
|
|
|
return undef; |
2186
|
|
|
|
|
|
|
} |
2187
|
0
|
|
|
|
|
|
my $read = CORE::read($fh, $converted_input, $block_size * 4); |
2188
|
0
|
0
|
|
|
|
|
unless (defined $read) { |
2189
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR, |
2190
|
|
|
|
|
|
|
"Couldn't read from local file '$local' to the resume point $writeoff", $!); |
2191
|
0
|
|
|
|
|
|
return undef; |
2192
|
|
|
|
|
|
|
} |
2193
|
0
|
0
|
|
|
|
|
$lsize += $converter->($converted_input) if defined $lsize; |
2194
|
0
|
0
|
|
|
|
|
utf8::downgrade($converted_input, 1) |
2195
|
|
|
|
|
|
|
or croak "converter introduced wide characters in data"; |
2196
|
0
|
0
|
|
|
|
|
$read or $eof_t = 1; |
2197
|
|
|
|
|
|
|
} |
2198
|
|
|
|
|
|
|
} |
2199
|
|
|
|
|
|
|
} |
2200
|
|
|
|
|
|
|
elsif ($local_is_fh) { |
2201
|
|
|
|
|
|
|
# as some PerlIO layer could be installed on the $fh, |
2202
|
|
|
|
|
|
|
# just seeking to the resume position will not be |
2203
|
|
|
|
|
|
|
# enough. We have to read and discard data until the |
2204
|
|
|
|
|
|
|
# desired offset is reached |
2205
|
0
|
|
|
|
|
|
my $off = $writeoff; |
2206
|
0
|
|
|
|
|
|
while ($off) { |
2207
|
0
|
0
|
|
|
|
|
my $read = CORE::read($fh, my($buf), ($off < 16384 ? $off : 16384)); |
2208
|
0
|
0
|
|
|
|
|
if ($read) { |
2209
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "discarding $read bytes"; |
2210
|
0
|
|
|
|
|
|
$off -= $read; |
2211
|
|
|
|
|
|
|
} |
2212
|
|
|
|
|
|
|
else { |
2213
|
0
|
0
|
|
|
|
|
$sftp->_set_error(defined $read |
2214
|
|
|
|
|
|
|
? ( SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL, |
2215
|
|
|
|
|
|
|
"Couldn't resume transfer, remote file is bigger than local") |
2216
|
|
|
|
|
|
|
: ( SFTP_ERR_LOCAL_READ_ERROR, |
2217
|
|
|
|
|
|
|
"Couldn't read from local file handler '$local' to the resume point $writeoff", $!)); |
2218
|
|
|
|
|
|
|
} |
2219
|
|
|
|
|
|
|
} |
2220
|
|
|
|
|
|
|
} |
2221
|
|
|
|
|
|
|
else { |
2222
|
0
|
0
|
0
|
|
|
|
if (defined $lsize and $writeoff > $lsize) { |
2223
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL, |
2224
|
|
|
|
|
|
|
"Couldn't resume transfer, remote file is bigger than local"); |
2225
|
0
|
|
|
|
|
|
return undef; |
2226
|
|
|
|
|
|
|
} |
2227
|
0
|
0
|
|
|
|
|
unless (CORE::seek($fh, $writeoff, 0)) { |
2228
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_SEEK_FAILED, |
2229
|
|
|
|
|
|
|
"seek operation on local file failed: $!"); |
2230
|
0
|
|
|
|
|
|
return undef; |
2231
|
|
|
|
|
|
|
} |
2232
|
|
|
|
|
|
|
} |
2233
|
0
|
0
|
0
|
|
|
|
if (defined $lsize and $writeoff == $lsize) { |
2234
|
0
|
0
|
0
|
|
|
|
if (defined $perm and $rattrs->perm != $perm) { |
2235
|
|
|
|
|
|
|
# FIXME: do copy_time here if required |
2236
|
0
|
|
|
|
|
|
return $sftp->_best_effort($best_effort, setstat => $remote, $attrs); |
2237
|
|
|
|
|
|
|
} |
2238
|
0
|
|
|
|
|
|
return 1; |
2239
|
|
|
|
|
|
|
} |
2240
|
|
|
|
|
|
|
} |
2241
|
0
|
0
|
|
|
|
|
$rfh = $sftp->open($remote, SSH2_FXF_WRITE) |
2242
|
|
|
|
|
|
|
or return undef; |
2243
|
|
|
|
|
|
|
} |
2244
|
|
|
|
|
|
|
else { |
2245
|
0
|
0
|
|
|
|
|
if ($atomic) { |
2246
|
|
|
|
|
|
|
# check that does not exist a file of the same name that |
2247
|
|
|
|
|
|
|
# would block the rename operation at the end |
2248
|
0
|
0
|
0
|
|
|
|
if (!($numbered or $overwrite) and |
|
|
|
0
|
|
|
|
|
2249
|
|
|
|
|
|
|
$sftp->test_e($remote)) { |
2250
|
0
|
|
|
|
|
|
$sftp->_set_status(SSH2_FX_FAILURE); |
2251
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS, |
2252
|
|
|
|
|
|
|
"Remote file '$remote' already exists"); |
2253
|
0
|
|
|
|
|
|
return undef; |
2254
|
|
|
|
|
|
|
} |
2255
|
0
|
|
|
|
|
|
$atomic_remote = $remote; |
2256
|
0
|
|
|
|
|
|
$remote .= sprintf("(%d).tmp", rand(10000)); |
2257
|
0
|
|
|
|
|
|
$atomic_numbered = $numbered; |
2258
|
0
|
|
|
|
|
|
$numbered = 1; |
2259
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 128 and _debug("temporal remote file name: $remote"); |
2260
|
|
|
|
|
|
|
} |
2261
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
2262
|
0
|
0
|
|
|
|
|
if ($numbered) { |
2263
|
0
|
|
|
|
|
|
while (1) { |
2264
|
0
|
|
|
|
|
|
$rfh = $sftp->_open_mkpath($remote, |
2265
|
|
|
|
|
|
|
$mkpath, |
2266
|
|
|
|
|
|
|
SSH2_FXF_WRITE | SSH2_FXF_CREAT | SSH2_FXF_EXCL, |
2267
|
|
|
|
|
|
|
$attrs); |
2268
|
|
|
|
|
|
|
last if ($rfh or |
2269
|
0
|
0
|
0
|
|
|
|
$sftp->{_status} != SSH2_FX_FAILURE or |
|
|
|
0
|
|
|
|
|
2270
|
|
|
|
|
|
|
!$sftp->test_e($remote)); |
2271
|
0
|
|
|
|
|
|
_inc_numbered($remote); |
2272
|
|
|
|
|
|
|
} |
2273
|
0
|
0
|
0
|
|
|
|
$$numbered = $remote if $rfh and ref $numbered; |
2274
|
|
|
|
|
|
|
} |
2275
|
|
|
|
|
|
|
else { |
2276
|
|
|
|
|
|
|
# open can fail due to a remote file with the wrong |
2277
|
|
|
|
|
|
|
# permissions being already there. We are optimistic here, |
2278
|
|
|
|
|
|
|
# first we try to open the remote file and if it fails due |
2279
|
|
|
|
|
|
|
# to a permissions error then we remove it and try again. |
2280
|
0
|
|
|
|
|
|
for my $rep (0, 1) { |
2281
|
0
|
0
|
|
|
|
|
$rfh = $sftp->_open_mkpath($remote, |
2282
|
|
|
|
|
|
|
$mkpath, |
2283
|
|
|
|
|
|
|
SSH2_FXF_WRITE | SSH2_FXF_CREAT | |
2284
|
|
|
|
|
|
|
($overwrite ? SSH2_FXF_TRUNC : SSH2_FXF_EXCL), |
2285
|
|
|
|
|
|
|
$attrs); |
2286
|
|
|
|
|
|
|
|
2287
|
0
|
0
|
0
|
|
|
|
last if $rfh or $rep or !$overwrite or $sftp->{_status} != SSH2_FX_PERMISSION_DENIED; |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2288
|
|
|
|
|
|
|
|
2289
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 2 and _debug("retrying open after removing remote file"); |
2290
|
0
|
|
|
|
|
|
local ($sftp->{_status}, $sftp->{_error}); |
2291
|
0
|
|
|
|
|
|
$sftp->remove($remote); |
2292
|
|
|
|
|
|
|
} |
2293
|
|
|
|
|
|
|
} |
2294
|
|
|
|
|
|
|
} |
2295
|
|
|
|
|
|
|
|
2296
|
0
|
0
|
|
|
|
|
$sftp->_ok_or_autodie or return undef; |
2297
|
|
|
|
|
|
|
# Once this point is reached and for the remaining of the sub, |
2298
|
|
|
|
|
|
|
# code should never return but jump into the CLEANUP block. |
2299
|
|
|
|
|
|
|
|
2300
|
0
|
|
|
|
|
|
my $last_block_was_zeros; |
2301
|
|
|
|
|
|
|
|
2302
|
0
|
|
|
|
|
|
do { |
2303
|
0
|
|
|
|
|
|
local $sftp->{autodie}; |
2304
|
|
|
|
|
|
|
|
2305
|
|
|
|
|
|
|
# In some SFTP server implementations, open does not set the |
2306
|
|
|
|
|
|
|
# attributes for existent files so we do it again. The |
2307
|
|
|
|
|
|
|
# $late_set_perm work around is for some servers that do not |
2308
|
|
|
|
|
|
|
# support changing the permissions of open files |
2309
|
0
|
0
|
0
|
|
|
|
if (defined $perm and !$late_set_perm) { |
2310
|
0
|
0
|
|
|
|
|
$sftp->_best_effort($best_effort, setstat => $rfh, $attrs) or goto CLEANUP; |
2311
|
|
|
|
|
|
|
} |
2312
|
|
|
|
|
|
|
|
2313
|
0
|
|
|
|
|
|
my $rfid = $sftp->_rfid($rfh); |
2314
|
0
|
0
|
|
|
|
|
defined $rfid or die "internal error: rfid is undef"; |
2315
|
|
|
|
|
|
|
|
2316
|
|
|
|
|
|
|
# In append mode we add the size of the remote file in |
2317
|
|
|
|
|
|
|
# writeoff, if lsize is undef, we initialize it to $writeoff: |
2318
|
0
|
0
|
0
|
|
|
|
$lsize += $writeoff if ($append or not defined $lsize); |
2319
|
|
|
|
|
|
|
|
2320
|
|
|
|
|
|
|
# when a converter is used, the EOF can become delayed by the |
2321
|
|
|
|
|
|
|
# buffering introduced, we use $eof_t to account for that. |
2322
|
0
|
|
|
|
|
|
my ($eof, $eof_t); |
2323
|
0
|
|
|
|
|
|
my @msgid; |
2324
|
0
|
|
|
|
|
|
OK: while (1) { |
2325
|
0
|
0
|
0
|
|
|
|
if (!$eof and @msgid < $queue_size) { |
2326
|
0
|
|
|
|
|
|
my ($data, $len); |
2327
|
0
|
0
|
|
|
|
|
if ($converter) { |
2328
|
0
|
|
0
|
|
|
|
while (!$eof_t and length $converted_input < $block_size) { |
2329
|
0
|
|
|
|
|
|
my $read = CORE::read($fh, my $input, $block_size * 4); |
2330
|
0
|
0
|
|
|
|
|
unless ($read) { |
2331
|
0
|
0
|
|
|
|
|
unless (defined $read) { |
2332
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR, |
2333
|
|
|
|
|
|
|
"Couldn't read from local file '$local'", $!); |
2334
|
0
|
|
|
|
|
|
last OK; |
2335
|
|
|
|
|
|
|
} |
2336
|
0
|
|
|
|
|
|
$eof_t = 1; |
2337
|
|
|
|
|
|
|
} |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
# note that the $converter is called a last time |
2340
|
|
|
|
|
|
|
# with an empty string |
2341
|
0
|
|
|
|
|
|
$lsize += $converter->($input); |
2342
|
0
|
0
|
|
|
|
|
utf8::downgrade($input, 1) |
2343
|
|
|
|
|
|
|
or croak "converter introduced wide characters in data"; |
2344
|
0
|
|
|
|
|
|
$converted_input .= $input; |
2345
|
|
|
|
|
|
|
} |
2346
|
0
|
|
|
|
|
|
$data = substr($converted_input, 0, $block_size, ''); |
2347
|
0
|
|
|
|
|
|
$len = length $data; |
2348
|
0
|
0
|
0
|
|
|
|
$eof = 1 if ($eof_t and !$len); |
2349
|
|
|
|
|
|
|
} |
2350
|
|
|
|
|
|
|
else { |
2351
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and |
2352
|
|
|
|
|
|
|
_debug "reading block at offset ".CORE::tell($fh)." block_size: $block_size"; |
2353
|
|
|
|
|
|
|
|
2354
|
0
|
|
|
|
|
|
$len = CORE::read($fh, $data, $block_size); |
2355
|
|
|
|
|
|
|
|
2356
|
0
|
0
|
|
|
|
|
if ($len) { |
2357
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "block read, size: $len"; |
2358
|
|
|
|
|
|
|
|
2359
|
0
|
0
|
|
|
|
|
utf8::downgrade($data, 1) |
2360
|
|
|
|
|
|
|
or croak "wide characters unexpectedly read from file"; |
2361
|
|
|
|
|
|
|
|
2362
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and length $data != $len and |
|
|
|
0
|
|
|
|
|
2363
|
|
|
|
|
|
|
_debug "read data changed size on downgrade to " . length($data); |
2364
|
|
|
|
|
|
|
} |
2365
|
|
|
|
|
|
|
else { |
2366
|
0
|
0
|
|
|
|
|
unless (defined $len) { |
2367
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR, |
2368
|
|
|
|
|
|
|
"Couldn't read from local file '$local'", $!); |
2369
|
0
|
|
|
|
|
|
last OK; |
2370
|
|
|
|
|
|
|
} |
2371
|
0
|
|
|
|
|
|
$eof = 1; |
2372
|
|
|
|
|
|
|
} |
2373
|
|
|
|
|
|
|
} |
2374
|
|
|
|
|
|
|
|
2375
|
0
|
|
|
|
|
|
my $nextoff = $writeoff + $len; |
2376
|
|
|
|
|
|
|
|
2377
|
0
|
0
|
|
|
|
|
if (defined $cb) { |
2378
|
0
|
0
|
|
|
|
|
$lsize = $nextoff if $nextoff > $lsize; |
2379
|
0
|
|
|
|
|
|
$cb->($sftp, $data, $writeoff, $lsize); |
2380
|
|
|
|
|
|
|
|
2381
|
0
|
0
|
|
|
|
|
last OK if $sftp->{_error}; |
2382
|
|
|
|
|
|
|
|
2383
|
0
|
0
|
|
|
|
|
utf8::downgrade($data, 1) or croak "callback introduced wide characters in data"; |
2384
|
|
|
|
|
|
|
|
2385
|
0
|
|
|
|
|
|
$len = length $data; |
2386
|
0
|
|
|
|
|
|
$nextoff = $writeoff + $len; |
2387
|
|
|
|
|
|
|
} |
2388
|
|
|
|
|
|
|
|
2389
|
0
|
0
|
|
|
|
|
if ($len) { |
2390
|
0
|
0
|
0
|
|
|
|
if ($sparse and $data =~ /^\x{00}*$/s) { |
2391
|
0
|
|
|
|
|
|
$last_block_was_zeros = 1; |
2392
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "skipping zeros block at offset $writeoff, length $len"; |
2393
|
|
|
|
|
|
|
} |
2394
|
|
|
|
|
|
|
else { |
2395
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 16384 and _debug "writing block at offset $writeoff, length $len"; |
2396
|
|
|
|
|
|
|
|
2397
|
0
|
|
|
|
|
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid, |
2398
|
|
|
|
|
|
|
int64 => $writeoff, str => $data); |
2399
|
0
|
|
|
|
|
|
push @msgid, $id; |
2400
|
0
|
|
|
|
|
|
$last_block_was_zeros = 0; |
2401
|
|
|
|
|
|
|
} |
2402
|
0
|
|
|
|
|
|
$writeoff = $nextoff; |
2403
|
|
|
|
|
|
|
} |
2404
|
|
|
|
|
|
|
} |
2405
|
|
|
|
|
|
|
|
2406
|
0
|
0
|
0
|
|
|
|
last if ($eof and !@msgid); |
2407
|
|
|
|
|
|
|
|
2408
|
0
|
0
|
0
|
|
|
|
next unless ($eof |
|
|
|
0
|
|
|
|
|
2409
|
|
|
|
|
|
|
or @msgid >= $queue_size |
2410
|
|
|
|
|
|
|
or $sftp->_do_io(0)); |
2411
|
|
|
|
|
|
|
|
2412
|
0
|
|
|
|
|
|
my $id = shift @msgid; |
2413
|
0
|
0
|
|
|
|
|
unless ($sftp->_check_status_ok($id, |
2414
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_WRITE_FAILED, |
2415
|
|
|
|
|
|
|
"Couldn't write to remote file")) { |
2416
|
0
|
|
|
|
|
|
last OK; |
2417
|
|
|
|
|
|
|
} |
2418
|
|
|
|
|
|
|
} |
2419
|
|
|
|
|
|
|
|
2420
|
0
|
0
|
|
|
|
|
CORE::close $fh unless $local_is_fh; |
2421
|
|
|
|
|
|
|
|
2422
|
0
|
|
|
|
|
|
$sftp->_get_msg_by_id($_) for @msgid; |
2423
|
|
|
|
|
|
|
|
2424
|
|
|
|
|
|
|
$sftp->truncate($rfh, $writeoff) |
2425
|
0
|
0
|
0
|
|
|
|
if $last_block_was_zeros and not $sftp->{_error}; |
2426
|
|
|
|
|
|
|
|
2427
|
0
|
|
|
|
|
|
$sftp->_close_save_status($rfh); |
2428
|
|
|
|
|
|
|
|
2429
|
0
|
0
|
|
|
|
|
goto CLEANUP if $sftp->{_error}; |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
# set perm for servers that does not support setting |
2432
|
|
|
|
|
|
|
# permissions on open files and also atime and mtime: |
2433
|
0
|
0
|
0
|
|
|
|
if ($copy_time or ($late_set_perm and defined $perm)) { |
|
|
|
0
|
|
|
|
|
2434
|
0
|
0
|
0
|
|
|
|
$attrs->set_perm unless $late_set_perm and defined $perm; |
2435
|
0
|
0
|
|
|
|
|
$attrs->set_amtime($latime, $lmtime) if $copy_time; |
2436
|
0
|
0
|
|
|
|
|
$sftp->_best_effort($best_effort, setstat => $remote, $attrs) or goto CLEANUP |
2437
|
|
|
|
|
|
|
} |
2438
|
|
|
|
|
|
|
|
2439
|
0
|
0
|
|
|
|
|
if ($atomic) { |
2440
|
0
|
0
|
|
|
|
|
$sftp->rename($remote, $atomic_remote, |
2441
|
|
|
|
|
|
|
overwrite => $overwrite, |
2442
|
|
|
|
|
|
|
numbered => $atomic_numbered) or goto CLEANUP; |
2443
|
|
|
|
|
|
|
} |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
CLEANUP: |
2446
|
0
|
0
|
0
|
|
|
|
if ($cleanup and $sftp->{_error}) { |
2447
|
0
|
|
|
|
|
|
warn "cleanup $remote"; |
2448
|
0
|
|
|
|
|
|
$sftp->_remove_save_status($remote); |
2449
|
|
|
|
|
|
|
} |
2450
|
|
|
|
|
|
|
}; |
2451
|
0
|
|
|
|
|
|
$sftp->_ok_or_autodie; |
2452
|
|
|
|
|
|
|
} |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
sub put_content { |
2455
|
0
|
0
|
|
0
|
1
|
|
@_ >= 3 or croak 'Usage: $sftp->put_content($content, $remote, %opts)'; |
2456
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
2457
|
|
|
|
|
|
|
|
2458
|
0
|
|
|
|
|
|
my ($sftp, undef, $remote, %opts) = @_; |
2459
|
0
|
|
|
|
|
|
my %put_opts = ( map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
qw(perm umask block_size queue_size overwrite conversion resume |
2461
|
|
|
|
|
|
|
numbered late_set_perm atomic best_effort mkpath)); |
2462
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2463
|
|
|
|
|
|
|
|
2464
|
0
|
|
|
|
|
|
my $fh; |
2465
|
0
|
0
|
|
|
|
|
unless (CORE::open $fh, '<', \$_[1]) { |
2466
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED, "Can't open scalar as file handle", $!); |
2467
|
0
|
|
|
|
|
|
return undef; |
2468
|
|
|
|
|
|
|
} |
2469
|
0
|
|
|
|
|
|
$sftp->put($fh, $remote, %put_opts); |
2470
|
|
|
|
|
|
|
} |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
sub ls { |
2473
|
0
|
0
|
|
0
|
1
|
|
@_ >= 1 or croak 'Usage: $sftp->ls($remote_dir, %opts)'; |
2474
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
2475
|
|
|
|
|
|
|
|
2476
|
0
|
|
|
|
|
|
my $sftp = shift; |
2477
|
0
|
0
|
|
|
|
|
my %opts = @_ & 1 ? (dir => @_) : @_; |
2478
|
|
|
|
|
|
|
|
2479
|
0
|
|
|
|
|
|
my $dir = delete $opts{dir}; |
2480
|
0
|
|
|
|
|
|
my $ordered = delete $opts{ordered}; |
2481
|
0
|
|
|
|
|
|
my $follow_links = delete $opts{follow_links}; |
2482
|
0
|
|
|
|
|
|
my $atomic_readdir = delete $opts{atomic_readdir}; |
2483
|
0
|
|
|
|
|
|
my $names_only = delete $opts{names_only}; |
2484
|
0
|
|
|
|
|
|
my $realpath = delete $opts{realpath}; |
2485
|
0
|
|
|
|
|
|
my $queue_size = delete $opts{queue_size}; |
2486
|
0
|
|
0
|
|
|
|
my $cheap = ($names_only and !$realpath); |
2487
|
0
|
|
|
|
|
|
my ($cheap_wanted, $wanted); |
2488
|
0
|
0
|
0
|
|
|
|
if ($cheap and |
|
|
|
0
|
|
|
|
|
2489
|
|
|
|
|
|
|
ref $opts{wanted} eq 'Regexp' and |
2490
|
|
|
|
|
|
|
not defined $opts{no_wanted}) { |
2491
|
|
|
|
|
|
|
$cheap_wanted = delete $opts{wanted} |
2492
|
0
|
|
|
|
|
|
} |
2493
|
|
|
|
|
|
|
else { |
2494
|
|
|
|
|
|
|
$wanted = (delete $opts{_wanted} || |
2495
|
|
|
|
|
|
|
_gen_wanted(delete $opts{wanted}, |
2496
|
0
|
|
0
|
|
|
|
delete $opts{no_wanted})); |
2497
|
0
|
0
|
|
|
|
|
undef $cheap if defined $wanted; |
2498
|
|
|
|
|
|
|
} |
2499
|
|
|
|
|
|
|
|
2500
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2501
|
|
|
|
|
|
|
|
2502
|
0
|
|
0
|
|
|
|
my $delayed_wanted = ($atomic_readdir and $wanted); |
2503
|
0
|
0
|
0
|
|
|
|
$queue_size = 1 if ($follow_links or $realpath or |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2504
|
|
|
|
|
|
|
($wanted and not $delayed_wanted)); |
2505
|
0
|
|
0
|
|
|
|
my $max_queue_size = $queue_size || $sftp->{_queue_size}; |
2506
|
0
|
0
|
0
|
|
|
|
$queue_size ||= ($max_queue_size < 2 ? $max_queue_size : 2); |
2507
|
|
|
|
|
|
|
|
2508
|
0
|
0
|
|
|
|
|
$dir = '.' unless defined $dir; |
2509
|
0
|
|
|
|
|
|
$dir = $sftp->_rel2abs($dir); |
2510
|
|
|
|
|
|
|
|
2511
|
0
|
|
|
|
|
|
my $rdh = $sftp->opendir($dir); |
2512
|
0
|
0
|
|
|
|
|
return unless defined $rdh; |
2513
|
|
|
|
|
|
|
|
2514
|
0
|
|
|
|
|
|
my $rdid = $sftp->_rdid($rdh); |
2515
|
0
|
0
|
|
|
|
|
defined $rdid or return undef; |
2516
|
|
|
|
|
|
|
|
2517
|
0
|
|
|
|
|
|
my @dir; |
2518
|
|
|
|
|
|
|
my @msgid; |
2519
|
|
|
|
|
|
|
|
2520
|
0
|
|
|
|
|
|
do { |
2521
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
2522
|
0
|
|
|
|
|
|
OK: while (1) { |
2523
|
0
|
|
|
|
|
|
push @msgid, $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid) |
2524
|
|
|
|
|
|
|
while (@msgid < $queue_size); |
2525
|
|
|
|
|
|
|
|
2526
|
0
|
|
|
|
|
|
my $id = shift @msgid; |
2527
|
0
|
0
|
|
|
|
|
my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id, |
2528
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_READDIR_FAILED, |
2529
|
|
|
|
|
|
|
"Couldn't read directory '$dir'" ) or last; |
2530
|
0
|
0
|
|
|
|
|
my $count = $msg->get_int32 or last; |
2531
|
|
|
|
|
|
|
|
2532
|
0
|
0
|
|
|
|
|
if ($cheap) { |
2533
|
0
|
|
|
|
|
|
for (1..$count) { |
2534
|
0
|
|
|
|
|
|
my $fn = $sftp->_fs_decode($msg->get_str); |
2535
|
0
|
0
|
0
|
|
|
|
push @dir, $fn if (!defined $cheap_wanted or $fn =~ $cheap_wanted); |
2536
|
0
|
|
|
|
|
|
$msg->skip_str; |
2537
|
0
|
|
|
|
|
|
Net::SFTP::Foreign::Attributes->skip_from_buffer($msg); |
2538
|
|
|
|
|
|
|
} |
2539
|
|
|
|
|
|
|
} |
2540
|
|
|
|
|
|
|
else { |
2541
|
0
|
|
|
|
|
|
for (1..$count) { |
2542
|
0
|
|
|
|
|
|
my $fn = $sftp->_fs_decode($msg->get_str); |
2543
|
0
|
|
|
|
|
|
my $ln = $sftp->_fs_decode($msg->get_str); |
2544
|
|
|
|
|
|
|
# my $a = $msg->get_attributes; |
2545
|
0
|
|
|
|
|
|
my $a = Net::SFTP::Foreign::Attributes->new_from_buffer($msg); |
2546
|
|
|
|
|
|
|
|
2547
|
0
|
|
|
|
|
|
my $entry = { filename => $fn, |
2548
|
|
|
|
|
|
|
longname => $ln, |
2549
|
|
|
|
|
|
|
a => $a }; |
2550
|
|
|
|
|
|
|
|
2551
|
0
|
0
|
0
|
|
|
|
if ($follow_links and _is_lnk($a->perm)) { |
2552
|
|
|
|
|
|
|
|
2553
|
0
|
0
|
|
|
|
|
if ($a = $sftp->stat($sftp->join($dir, $fn))) { |
2554
|
0
|
|
|
|
|
|
$entry->{a} = $a; |
2555
|
|
|
|
|
|
|
} |
2556
|
|
|
|
|
|
|
else { |
2557
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
2558
|
|
|
|
|
|
|
} |
2559
|
|
|
|
|
|
|
} |
2560
|
|
|
|
|
|
|
|
2561
|
0
|
0
|
|
|
|
|
if ($realpath) { |
2562
|
0
|
|
|
|
|
|
my $rp = $sftp->realpath($sftp->join($dir, $fn)); |
2563
|
0
|
0
|
|
|
|
|
if (defined $rp) { |
2564
|
0
|
|
|
|
|
|
$fn = $entry->{realpath} = $rp; |
2565
|
|
|
|
|
|
|
} |
2566
|
|
|
|
|
|
|
else { |
2567
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
2568
|
|
|
|
|
|
|
} |
2569
|
|
|
|
|
|
|
} |
2570
|
|
|
|
|
|
|
|
2571
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $delayed_wanted or $wanted->($sftp, $entry)) { |
|
|
|
0
|
|
|
|
|
2572
|
0
|
0
|
0
|
|
|
|
push @dir, (($names_only and !$delayed_wanted) ? $fn : $entry); |
2573
|
|
|
|
|
|
|
} |
2574
|
|
|
|
|
|
|
} |
2575
|
|
|
|
|
|
|
} |
2576
|
0
|
0
|
|
|
|
|
$queue_size++ if $queue_size < $max_queue_size; |
2577
|
|
|
|
|
|
|
} |
2578
|
0
|
0
|
|
|
|
|
$sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF; |
2579
|
0
|
|
|
|
|
|
$sftp->_get_msg_by_id($_) for @msgid; |
2580
|
0
|
0
|
|
|
|
|
$sftp->_closedir_save_status($rdh) if $rdh; |
2581
|
|
|
|
|
|
|
}; |
2582
|
0
|
0
|
|
|
|
|
unless ($sftp->{_error}) { |
2583
|
0
|
0
|
|
|
|
|
if ($delayed_wanted) { |
2584
|
0
|
|
|
|
|
|
@dir = grep { $wanted->($sftp, $_) } @dir; |
|
0
|
|
|
|
|
|
|
2585
|
0
|
0
|
|
|
|
|
@dir = map { defined $_->{realpath} |
2586
|
|
|
|
|
|
|
? $_->{realpath} |
2587
|
0
|
0
|
|
|
|
|
: $_->{filename} } @dir |
2588
|
|
|
|
|
|
|
if $names_only; |
2589
|
|
|
|
|
|
|
} |
2590
|
0
|
0
|
|
|
|
|
if ($ordered) { |
2591
|
0
|
0
|
|
|
|
|
if ($names_only) { |
2592
|
0
|
|
|
|
|
|
@dir = sort @dir; |
2593
|
|
|
|
|
|
|
} |
2594
|
|
|
|
|
|
|
else { |
2595
|
0
|
|
|
|
|
|
_sort_entries \@dir; |
2596
|
|
|
|
|
|
|
} |
2597
|
|
|
|
|
|
|
} |
2598
|
0
|
|
|
|
|
|
return \@dir; |
2599
|
|
|
|
|
|
|
} |
2600
|
0
|
0
|
|
|
|
|
croak $sftp->{_error} if $sftp->{_autodie}; |
2601
|
0
|
|
|
|
|
|
return undef; |
2602
|
|
|
|
|
|
|
} |
2603
|
|
|
|
|
|
|
|
2604
|
|
|
|
|
|
|
sub rremove { |
2605
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->rremove($dirs, %opts)'; |
2606
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
2607
|
|
|
|
|
|
|
|
2608
|
0
|
|
|
|
|
|
my ($sftp, $dirs, %opts) = @_; |
2609
|
|
|
|
|
|
|
|
2610
|
0
|
|
|
|
|
|
my $on_error = delete $opts{on_error}; |
2611
|
0
|
0
|
|
|
|
|
local $sftp->{_autodie} if $on_error; |
2612
|
|
|
|
|
|
|
my $wanted = _gen_wanted( delete $opts{wanted}, |
2613
|
0
|
|
|
|
|
|
delete $opts{no_wanted}); |
2614
|
|
|
|
|
|
|
|
2615
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2616
|
|
|
|
|
|
|
|
2617
|
0
|
|
|
|
|
|
my $count = 0; |
2618
|
|
|
|
|
|
|
|
2619
|
0
|
|
|
|
|
|
my @dirs; |
2620
|
|
|
|
|
|
|
$sftp->find( $dirs, |
2621
|
|
|
|
|
|
|
on_error => $on_error, |
2622
|
|
|
|
|
|
|
atomic_readdir => 1, |
2623
|
|
|
|
|
|
|
wanted => sub { |
2624
|
0
|
|
|
0
|
|
|
my $e = $_[1]; |
2625
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
2626
|
0
|
0
|
|
|
|
|
if (_is_dir($e->{a}->perm)) { |
2627
|
0
|
|
|
|
|
|
push @dirs, $e; |
2628
|
|
|
|
|
|
|
} |
2629
|
|
|
|
|
|
|
else { |
2630
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $wanted->($sftp, $e)) { |
2631
|
0
|
0
|
|
|
|
|
if ($sftp->remove($fn)) { |
2632
|
0
|
|
|
|
|
|
$count++; |
2633
|
|
|
|
|
|
|
} |
2634
|
|
|
|
|
|
|
else { |
2635
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
2636
|
|
|
|
|
|
|
} |
2637
|
|
|
|
|
|
|
} |
2638
|
|
|
|
|
|
|
} |
2639
|
0
|
|
|
|
|
|
} ); |
2640
|
|
|
|
|
|
|
|
2641
|
0
|
|
|
|
|
|
_sort_entries(\@dirs); |
2642
|
|
|
|
|
|
|
|
2643
|
0
|
|
|
|
|
|
while (@dirs) { |
2644
|
0
|
|
|
|
|
|
my $e = pop @dirs; |
2645
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $wanted->($sftp, $e)) { |
2646
|
0
|
0
|
|
|
|
|
if ($sftp->rmdir($e->{filename})) { |
2647
|
0
|
|
|
|
|
|
$count++; |
2648
|
|
|
|
|
|
|
} |
2649
|
|
|
|
|
|
|
else { |
2650
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
2651
|
|
|
|
|
|
|
} |
2652
|
|
|
|
|
|
|
} |
2653
|
|
|
|
|
|
|
} |
2654
|
|
|
|
|
|
|
|
2655
|
0
|
|
|
|
|
|
return $count; |
2656
|
|
|
|
|
|
|
} |
2657
|
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
|
sub get_symlink { |
2659
|
0
|
0
|
|
0
|
1
|
|
@_ >= 3 or croak 'Usage: $sftp->get_symlink($remote, $local, %opts)'; |
2660
|
0
|
|
|
|
|
|
my ($sftp, $remote, $local, %opts) = @_; |
2661
|
0
|
|
|
|
|
|
my $overwrite = delete $opts{overwrite}; |
2662
|
0
|
|
|
|
|
|
my $numbered = delete $opts{numbered}; |
2663
|
|
|
|
|
|
|
|
2664
|
0
|
0
|
0
|
|
|
|
croak "'overwrite' and 'numbered' can not be used together" |
2665
|
|
|
|
|
|
|
if ($overwrite and $numbered); |
2666
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2667
|
|
|
|
|
|
|
|
2668
|
0
|
0
|
0
|
|
|
|
$overwrite = 1 unless (defined $overwrite or $numbered); |
2669
|
|
|
|
|
|
|
|
2670
|
0
|
0
|
|
|
|
|
my $a = $sftp->lstat($remote) or return undef; |
2671
|
0
|
0
|
|
|
|
|
unless (_is_lnk($a->perm)) { |
2672
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT, |
2673
|
|
|
|
|
|
|
"Remote object '$remote' is not a symlink"); |
2674
|
0
|
|
|
|
|
|
return undef; |
2675
|
|
|
|
|
|
|
} |
2676
|
|
|
|
|
|
|
|
2677
|
0
|
0
|
|
|
|
|
my $link = $sftp->readlink($remote) or return undef; |
2678
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
# TODO: this is too weak, may contain race conditions. |
2680
|
0
|
0
|
|
|
|
|
if ($numbered) { |
|
|
0
|
|
|
|
|
|
2681
|
0
|
|
|
|
|
|
_inc_numbered($local) while -e $local; |
2682
|
|
|
|
|
|
|
} |
2683
|
|
|
|
|
|
|
elsif (-e $local) { |
2684
|
0
|
0
|
|
|
|
|
if ($overwrite) { |
2685
|
0
|
|
|
|
|
|
unlink $local; |
2686
|
|
|
|
|
|
|
} |
2687
|
|
|
|
|
|
|
else { |
2688
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS, |
2689
|
|
|
|
|
|
|
"local file $local already exists"); |
2690
|
|
|
|
|
|
|
return undef |
2691
|
0
|
|
|
|
|
|
} |
2692
|
|
|
|
|
|
|
} |
2693
|
|
|
|
|
|
|
|
2694
|
0
|
0
|
|
|
|
|
unless (eval { CORE::symlink $link, $local }) { |
|
0
|
|
|
|
|
|
|
2695
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_SYMLINK_FAILED, |
2696
|
|
|
|
|
|
|
"creation of symlink '$local' failed", $!); |
2697
|
0
|
|
|
|
|
|
return undef; |
2698
|
|
|
|
|
|
|
} |
2699
|
0
|
0
|
|
|
|
|
$$numbered = $local if ref $numbered; |
2700
|
|
|
|
|
|
|
|
2701
|
0
|
|
|
|
|
|
1; |
2702
|
|
|
|
|
|
|
} |
2703
|
|
|
|
|
|
|
|
2704
|
|
|
|
|
|
|
sub put_symlink { |
2705
|
0
|
0
|
|
0
|
1
|
|
@_ >= 3 or croak 'Usage: $sftp->put_symlink($local, $remote, %opts)'; |
2706
|
0
|
|
|
|
|
|
my ($sftp, $local, $remote, %opts) = @_; |
2707
|
0
|
|
|
|
|
|
my $overwrite = delete $opts{overwrite}; |
2708
|
0
|
|
|
|
|
|
my $numbered = delete $opts{numbered}; |
2709
|
|
|
|
|
|
|
|
2710
|
0
|
0
|
0
|
|
|
|
croak "'overwrite' and 'numbered' can not be used together" |
2711
|
|
|
|
|
|
|
if ($overwrite and $numbered); |
2712
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2713
|
|
|
|
|
|
|
|
2714
|
0
|
0
|
0
|
|
|
|
$overwrite = 1 unless (defined $overwrite or $numbered); |
2715
|
0
|
|
|
|
|
|
my $perm = (CORE::lstat $local)[2]; |
2716
|
0
|
0
|
|
|
|
|
unless (defined $perm) { |
2717
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_STAT_FAILED, |
2718
|
|
|
|
|
|
|
"Couldn't stat local file '$local'", $!); |
2719
|
0
|
|
|
|
|
|
return undef; |
2720
|
|
|
|
|
|
|
} |
2721
|
0
|
0
|
|
|
|
|
unless (_is_lnk($perm)) { |
2722
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT, |
2723
|
|
|
|
|
|
|
"Local file $local is not a symlink"); |
2724
|
0
|
|
|
|
|
|
return undef; |
2725
|
|
|
|
|
|
|
} |
2726
|
0
|
|
|
|
|
|
my $target = readlink $local; |
2727
|
0
|
0
|
|
|
|
|
unless (defined $target) { |
2728
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_READLINK_FAILED, |
2729
|
|
|
|
|
|
|
"Couldn't read link '$local'", $!); |
2730
|
0
|
|
|
|
|
|
return undef; |
2731
|
|
|
|
|
|
|
} |
2732
|
|
|
|
|
|
|
|
2733
|
0
|
|
|
|
|
|
while (1) { |
2734
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
2735
|
0
|
|
|
|
|
|
$sftp->symlink($remote, $target); |
2736
|
0
|
0
|
0
|
|
|
|
if ($sftp->{_error} and |
2737
|
|
|
|
|
|
|
$sftp->{_status} == SSH2_FX_FAILURE) { |
2738
|
0
|
0
|
0
|
|
|
|
if ($numbered and $sftp->test_e($remote)) { |
|
|
0
|
0
|
|
|
|
|
2739
|
0
|
|
|
|
|
|
_inc_numbered($remote); |
2740
|
0
|
|
|
|
|
|
redo; |
2741
|
|
|
|
|
|
|
} |
2742
|
|
|
|
|
|
|
elsif ($overwrite and $sftp->_remove_save_status($remote)) { |
2743
|
0
|
|
|
|
|
|
$overwrite = 0; |
2744
|
0
|
|
|
|
|
|
redo; |
2745
|
|
|
|
|
|
|
} |
2746
|
|
|
|
|
|
|
} |
2747
|
|
|
|
|
|
|
last |
2748
|
0
|
|
|
|
|
|
} |
2749
|
0
|
0
|
|
|
|
|
$$numbered = $remote if ref $numbered; |
2750
|
0
|
|
|
|
|
|
$sftp->_ok_or_autodie; |
2751
|
|
|
|
|
|
|
} |
2752
|
|
|
|
|
|
|
|
2753
|
|
|
|
|
|
|
sub rget { |
2754
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->rget($remote, $local, %opts)'; |
2755
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
2756
|
0
|
|
|
|
|
|
my ($sftp, $remote, $local, %opts) = @_; |
2757
|
|
|
|
|
|
|
|
2758
|
0
|
0
|
|
|
|
|
defined $remote or croak "remote file path is undefined"; |
2759
|
0
|
0
|
|
|
|
|
$local = File::Spec->curdir unless defined $local; |
2760
|
|
|
|
|
|
|
|
2761
|
|
|
|
|
|
|
# my $cb = delete $opts{callback}; |
2762
|
0
|
|
|
|
|
|
my $umask = delete $opts{umask}; |
2763
|
0
|
0
|
|
|
|
|
my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'}; |
2764
|
0
|
|
|
|
|
|
my $copy_time = delete $opts{copy_time}; |
2765
|
0
|
|
|
|
|
|
my $newer_only = delete $opts{newer_only}; |
2766
|
0
|
|
|
|
|
|
my $on_error = delete $opts{on_error}; |
2767
|
0
|
0
|
|
|
|
|
local $sftp->{_autodie} if $on_error; |
2768
|
0
|
|
|
|
|
|
my $ignore_links = delete $opts{ignore_links}; |
2769
|
0
|
|
|
|
|
|
my $mkpath = delete $opts{mkpath}; |
2770
|
|
|
|
|
|
|
|
2771
|
|
|
|
|
|
|
# my $relative_links = delete $opts{relative_links}; |
2772
|
|
|
|
|
|
|
|
2773
|
|
|
|
|
|
|
my $wanted = _gen_wanted( delete $opts{wanted}, |
2774
|
0
|
|
|
|
|
|
delete $opts{no_wanted} ); |
2775
|
|
|
|
|
|
|
|
2776
|
0
|
|
|
|
|
|
my %get_opts = (map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
2777
|
|
|
|
|
|
|
qw(block_size queue_size overwrite conversion |
2778
|
|
|
|
|
|
|
resume numbered atomic best_effort)); |
2779
|
|
|
|
|
|
|
|
2780
|
0
|
0
|
0
|
|
|
|
if ($get_opts{resume} and $get_opts{conversion}) { |
2781
|
0
|
|
|
|
|
|
carp "resume option is useless when data conversion has also been requested"; |
2782
|
0
|
|
|
|
|
|
delete $get_opts{resume}; |
2783
|
|
|
|
|
|
|
} |
2784
|
|
|
|
|
|
|
|
2785
|
0
|
|
|
|
|
|
my %get_symlink_opts = (map { $_ => $get_opts{$_} } |
|
0
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
qw(overwrite numbered)); |
2787
|
|
|
|
|
|
|
|
2788
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2789
|
|
|
|
|
|
|
|
2790
|
0
|
|
|
|
|
|
$remote = $sftp->join($remote, './'); |
2791
|
0
|
|
|
|
|
|
my $qremote = quotemeta $remote; |
2792
|
0
|
|
|
|
|
|
my $reremote = qr/^$qremote(.*)$/i; |
2793
|
|
|
|
|
|
|
|
2794
|
0
|
|
|
|
|
|
my $save = _umask_save_and_set $umask; |
2795
|
|
|
|
|
|
|
|
2796
|
0
|
0
|
|
|
|
|
$copy_perm = 1 unless defined $copy_perm; |
2797
|
0
|
0
|
|
|
|
|
$copy_time = 1 unless defined $copy_time; |
2798
|
0
|
0
|
|
|
|
|
$mkpath = 1 unless defined $mkpath; |
2799
|
|
|
|
|
|
|
|
2800
|
0
|
|
|
|
|
|
my $count = 0; |
2801
|
|
|
|
|
|
|
$sftp->find( [$remote], |
2802
|
|
|
|
|
|
|
descend => sub { |
2803
|
0
|
|
|
0
|
|
|
my $e = $_[1]; |
2804
|
|
|
|
|
|
|
# print "descend: $e->{filename}\n"; |
2805
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $wanted->($sftp, $e)) { |
2806
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
2807
|
0
|
0
|
|
|
|
|
if ($fn =~ $reremote) { |
2808
|
0
|
|
|
|
|
|
my $lpath = File::Spec->catdir($local, $1); |
2809
|
0
|
0
|
|
|
|
|
($lpath) = $lpath =~ /(.*)/ if ${^TAINT}; |
2810
|
0
|
0
|
|
|
|
|
if (-d $lpath) { |
2811
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS, |
2812
|
|
|
|
|
|
|
"directory '$lpath' already exists"); |
2813
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
2814
|
0
|
|
|
|
|
|
return 1; |
2815
|
|
|
|
|
|
|
} |
2816
|
|
|
|
|
|
|
else { |
2817
|
0
|
0
|
|
|
|
|
my $perm = ($copy_perm ? $e->{a}->perm & 0777 : 0777); |
2818
|
0
|
0
|
0
|
|
|
|
if (CORE::mkdir($lpath, $perm) or |
|
|
|
0
|
|
|
|
|
2819
|
|
|
|
|
|
|
($mkpath and $sftp->_mkpath_local($lpath, $perm))) { |
2820
|
0
|
|
|
|
|
|
$count++; |
2821
|
0
|
|
|
|
|
|
return 1; |
2822
|
|
|
|
|
|
|
} |
2823
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED, |
2824
|
|
|
|
|
|
|
"mkdir '$lpath' failed", $!); |
2825
|
|
|
|
|
|
|
} |
2826
|
|
|
|
|
|
|
} |
2827
|
|
|
|
|
|
|
else { |
2828
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_PATH, |
2829
|
|
|
|
|
|
|
"bad remote path '$fn'"); |
2830
|
|
|
|
|
|
|
} |
2831
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
2832
|
|
|
|
|
|
|
} |
2833
|
0
|
|
|
|
|
|
return undef; |
2834
|
|
|
|
|
|
|
}, |
2835
|
|
|
|
|
|
|
wanted => sub { |
2836
|
0
|
|
|
0
|
|
|
my $e = $_[1]; |
2837
|
0
|
0
|
|
|
|
|
unless (_is_dir($e->{a}->perm)) { |
2838
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $wanted->($sftp, $e)) { |
2839
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
2840
|
0
|
0
|
|
|
|
|
if ($fn =~ $reremote) { |
2841
|
0
|
0
|
|
|
|
|
my $lpath = ((length $1) ? File::Spec->catfile($local, $1) : $local); |
2842
|
|
|
|
|
|
|
# print "file fn:$e->{filename}, lpath:$lpath, re:$reremote\n"; |
2843
|
0
|
0
|
|
|
|
|
($lpath) = $lpath =~ /(.*)/ if ${^TAINT}; |
2844
|
0
|
0
|
0
|
|
|
|
if (_is_lnk($e->{a}->perm) and !$ignore_links) { |
|
|
0
|
|
|
|
|
|
2845
|
0
|
0
|
|
|
|
|
if ($sftp->get_symlink($fn, $lpath, |
2846
|
|
|
|
|
|
|
# copy_time => $copy_time, |
2847
|
|
|
|
|
|
|
%get_symlink_opts)) { |
2848
|
0
|
|
|
|
|
|
$count++; |
2849
|
0
|
|
|
|
|
|
return undef; |
2850
|
|
|
|
|
|
|
} |
2851
|
|
|
|
|
|
|
} |
2852
|
|
|
|
|
|
|
elsif (_is_reg($e->{a}->perm)) { |
2853
|
0
|
0
|
0
|
|
|
|
if ($newer_only and -e $lpath |
|
|
|
0
|
|
|
|
|
2854
|
|
|
|
|
|
|
and (CORE::stat _)[9] >= $e->{a}->mtime) { |
2855
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS, |
2856
|
|
|
|
|
|
|
"newer local file '$lpath' already exists"); |
2857
|
|
|
|
|
|
|
} |
2858
|
|
|
|
|
|
|
else { |
2859
|
0
|
0
|
|
|
|
|
if ($sftp->get($fn, $lpath, |
2860
|
|
|
|
|
|
|
copy_perm => $copy_perm, |
2861
|
|
|
|
|
|
|
copy_time => $copy_time, |
2862
|
|
|
|
|
|
|
%get_opts)) { |
2863
|
0
|
|
|
|
|
|
$count++; |
2864
|
0
|
|
|
|
|
|
return undef; |
2865
|
|
|
|
|
|
|
} |
2866
|
|
|
|
|
|
|
} |
2867
|
|
|
|
|
|
|
} |
2868
|
|
|
|
|
|
|
else { |
2869
|
0
|
0
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT, |
2870
|
|
|
|
|
|
|
( $ignore_links |
2871
|
|
|
|
|
|
|
? "remote file '$fn' is not regular file or directory" |
2872
|
|
|
|
|
|
|
: "remote file '$fn' is not regular file, directory or link")); |
2873
|
|
|
|
|
|
|
} |
2874
|
|
|
|
|
|
|
} |
2875
|
|
|
|
|
|
|
else { |
2876
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_PATH, |
2877
|
|
|
|
|
|
|
"bad remote path '$fn'"); |
2878
|
|
|
|
|
|
|
} |
2879
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
2880
|
|
|
|
|
|
|
} |
2881
|
|
|
|
|
|
|
} |
2882
|
0
|
|
|
|
|
|
return undef; |
2883
|
0
|
|
|
|
|
|
} ); |
2884
|
|
|
|
|
|
|
|
2885
|
0
|
|
|
|
|
|
return $count; |
2886
|
|
|
|
|
|
|
} |
2887
|
|
|
|
|
|
|
|
2888
|
|
|
|
|
|
|
sub rput { |
2889
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->rput($local, $remote, %opts)'; |
2890
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
2891
|
|
|
|
|
|
|
|
2892
|
0
|
|
|
|
|
|
my ($sftp, $local, $remote, %opts) = @_; |
2893
|
|
|
|
|
|
|
|
2894
|
0
|
0
|
|
|
|
|
defined $local or croak "local path is undefined"; |
2895
|
0
|
0
|
|
|
|
|
$remote = '.' unless defined $remote; |
2896
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
# my $cb = delete $opts{callback}; |
2898
|
0
|
|
|
|
|
|
my $umask = delete $opts{umask}; |
2899
|
0
|
|
|
|
|
|
my $perm = delete $opts{perm}; |
2900
|
0
|
0
|
|
|
|
|
my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'}; |
2901
|
0
|
|
|
|
|
|
my $copy_time = delete $opts{copy_time}; |
2902
|
|
|
|
|
|
|
|
2903
|
0
|
|
|
|
|
|
my $newer_only = delete $opts{newer_only}; |
2904
|
0
|
|
|
|
|
|
my $on_error = delete $opts{on_error}; |
2905
|
0
|
0
|
|
|
|
|
local $sftp->{_autodie} if $on_error; |
2906
|
0
|
|
|
|
|
|
my $ignore_links = delete $opts{ignore_links}; |
2907
|
0
|
|
|
|
|
|
my $mkpath = delete $opts{mkpath}; |
2908
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
my $wanted = _gen_wanted( delete $opts{wanted}, |
2910
|
0
|
|
|
|
|
|
delete $opts{no_wanted} ); |
2911
|
|
|
|
|
|
|
|
2912
|
0
|
|
|
|
|
|
my %put_opts = (map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
2913
|
|
|
|
|
|
|
qw(block_size queue_size overwrite |
2914
|
|
|
|
|
|
|
conversion resume numbered |
2915
|
|
|
|
|
|
|
late_set_perm atomic best_effort |
2916
|
|
|
|
|
|
|
sparse)); |
2917
|
|
|
|
|
|
|
|
2918
|
0
|
|
|
|
|
|
my %put_symlink_opts = (map { $_ => $put_opts{$_} } |
|
0
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
|
qw(overwrite numbered)); |
2920
|
|
|
|
|
|
|
|
2921
|
0
|
0
|
0
|
|
|
|
croak "'perm' and 'umask' options can not be used simultaneously" |
2922
|
|
|
|
|
|
|
if (defined $perm and defined $umask); |
2923
|
0
|
0
|
0
|
|
|
|
croak "'perm' and 'copy_perm' options can not be used simultaneously" |
2924
|
|
|
|
|
|
|
if (defined $perm and $copy_perm); |
2925
|
|
|
|
|
|
|
|
2926
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
2927
|
|
|
|
|
|
|
|
2928
|
0
|
|
|
|
|
|
require Net::SFTP::Foreign::Local; |
2929
|
0
|
|
|
|
|
|
my $lfs = Net::SFTP::Foreign::Local->new; |
2930
|
|
|
|
|
|
|
|
2931
|
0
|
|
|
|
|
|
$local = $lfs->join($local, './'); |
2932
|
0
|
|
|
|
|
|
my $relocal; |
2933
|
0
|
0
|
|
|
|
|
if ($local =~ m|^\./?$|) { |
2934
|
0
|
|
|
|
|
|
$relocal = qr/^(.*)$/; |
2935
|
|
|
|
|
|
|
} |
2936
|
|
|
|
|
|
|
else { |
2937
|
0
|
|
|
|
|
|
my $qlocal = quotemeta $local; |
2938
|
0
|
|
|
|
|
|
$relocal = qr/^$qlocal(.*)$/i; |
2939
|
|
|
|
|
|
|
} |
2940
|
|
|
|
|
|
|
|
2941
|
0
|
0
|
|
|
|
|
$copy_perm = 1 unless defined $copy_perm; |
2942
|
0
|
0
|
|
|
|
|
$copy_time = 1 unless defined $copy_time; |
2943
|
0
|
0
|
|
|
|
|
$mkpath = 1 unless defined $mkpath; |
2944
|
|
|
|
|
|
|
|
2945
|
0
|
|
|
|
|
|
my $mask; |
2946
|
0
|
0
|
|
|
|
|
if (defined $perm) { |
2947
|
0
|
|
|
|
|
|
$mask = $perm & 0777; |
2948
|
|
|
|
|
|
|
} |
2949
|
|
|
|
|
|
|
else { |
2950
|
0
|
0
|
|
|
|
|
$umask = umask unless defined $umask; |
2951
|
0
|
|
|
|
|
|
$mask = 0777 & ~$umask; |
2952
|
|
|
|
|
|
|
} |
2953
|
|
|
|
|
|
|
|
2954
|
0
|
0
|
|
|
|
|
if ($on_error) { |
2955
|
0
|
|
|
|
|
|
my $on_error1 = $on_error; |
2956
|
|
|
|
|
|
|
$on_error = sub { |
2957
|
0
|
|
|
0
|
|
|
my $lfs = shift; |
2958
|
0
|
|
|
|
|
|
$sftp->_copy_error($lfs); |
2959
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error1, @_); |
2960
|
|
|
|
|
|
|
} |
2961
|
0
|
|
|
|
|
|
} |
2962
|
|
|
|
|
|
|
|
2963
|
0
|
|
|
|
|
|
my $count = 0; |
2964
|
|
|
|
|
|
|
$lfs->find( [$local], |
2965
|
|
|
|
|
|
|
descend => sub { |
2966
|
0
|
|
|
0
|
|
|
my $e = $_[1]; |
2967
|
|
|
|
|
|
|
# print "descend: $e->{filename}\n"; |
2968
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $wanted->($lfs, $e)) { |
2969
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
2970
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 32768 and _debug "rput handling $fn"; |
2971
|
0
|
0
|
|
|
|
|
if ($fn =~ $relocal) { |
2972
|
0
|
|
|
|
|
|
my $rpath = $sftp->join($remote, File::Spec->splitdir($1)); |
2973
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 32768 and _debug "rpath: $rpath"; |
2974
|
0
|
|
|
|
|
|
my $a = Net::SFTP::Foreign::Attributes->new; |
2975
|
0
|
0
|
|
|
|
|
if (defined $perm) { |
|
|
0
|
|
|
|
|
|
2976
|
0
|
|
|
|
|
|
$a->set_perm($mask | 0300); |
2977
|
|
|
|
|
|
|
} |
2978
|
|
|
|
|
|
|
elsif ($copy_perm) { |
2979
|
0
|
|
|
|
|
|
$a->set_perm($e->{a}->perm & $mask); |
2980
|
|
|
|
|
|
|
} |
2981
|
0
|
0
|
|
|
|
|
if ($sftp->mkdir($rpath, $a)) { |
2982
|
0
|
|
|
|
|
|
$count++; |
2983
|
0
|
|
|
|
|
|
return 1; |
2984
|
|
|
|
|
|
|
} |
2985
|
0
|
0
|
0
|
|
|
|
if ($mkpath and |
2986
|
|
|
|
|
|
|
$sftp->status == SSH2_FX_NO_SUCH_FILE) { |
2987
|
0
|
|
|
|
|
|
$sftp->_clear_error_and_status; |
2988
|
0
|
0
|
|
|
|
|
if ($sftp->mkpath($rpath, $a)) { |
2989
|
0
|
|
|
|
|
|
$count++; |
2990
|
0
|
|
|
|
|
|
return 1; |
2991
|
|
|
|
|
|
|
} |
2992
|
|
|
|
|
|
|
} |
2993
|
0
|
|
|
|
|
|
$lfs->_copy_error($sftp); |
2994
|
0
|
0
|
|
|
|
|
if ($sftp->test_d($rpath)) { |
2995
|
0
|
|
|
|
|
|
$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS, |
2996
|
|
|
|
|
|
|
"Remote directory '$rpath' already exists"); |
2997
|
0
|
|
|
|
|
|
$lfs->_call_on_error($on_error, $e); |
2998
|
0
|
|
|
|
|
|
return 1; |
2999
|
|
|
|
|
|
|
} |
3000
|
|
|
|
|
|
|
} |
3001
|
|
|
|
|
|
|
else { |
3002
|
0
|
|
|
|
|
|
$lfs->_set_error(SFTP_ERR_LOCAL_BAD_PATH, |
3003
|
|
|
|
|
|
|
"Bad local path '$fn'"); |
3004
|
|
|
|
|
|
|
} |
3005
|
0
|
|
|
|
|
|
$lfs->_call_on_error($on_error, $e); |
3006
|
|
|
|
|
|
|
} |
3007
|
0
|
|
|
|
|
|
return undef; |
3008
|
|
|
|
|
|
|
}, |
3009
|
|
|
|
|
|
|
wanted => sub { |
3010
|
0
|
|
|
0
|
|
|
my $e = $_[1]; |
3011
|
|
|
|
|
|
|
# print "file fn:$e->{filename}, a:$e->{a}\n"; |
3012
|
0
|
0
|
|
|
|
|
unless (_is_dir($e->{a}->perm)) { |
3013
|
0
|
0
|
0
|
|
|
|
if (!$wanted or $wanted->($lfs, $e)) { |
3014
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
3015
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 32768 and _debug "rput handling $fn"; |
3016
|
0
|
0
|
|
|
|
|
if ($fn =~ $relocal) { |
3017
|
0
|
|
|
|
|
|
my (undef, $d, $f) = File::Spec->splitpath($1); |
3018
|
0
|
|
|
|
|
|
my $rpath = $sftp->join($remote, File::Spec->splitdir($d), $f); |
3019
|
0
|
0
|
0
|
|
|
|
if (_is_lnk($e->{a}->perm) and !$ignore_links) { |
|
|
0
|
|
|
|
|
|
3020
|
0
|
0
|
|
|
|
|
if ($sftp->put_symlink($fn, $rpath, |
3021
|
|
|
|
|
|
|
%put_symlink_opts)) { |
3022
|
0
|
|
|
|
|
|
$count++; |
3023
|
0
|
|
|
|
|
|
return undef; |
3024
|
|
|
|
|
|
|
} |
3025
|
0
|
|
|
|
|
|
$lfs->_copy_error($sftp); |
3026
|
|
|
|
|
|
|
} |
3027
|
|
|
|
|
|
|
elsif (_is_reg($e->{a}->perm)) { |
3028
|
0
|
|
|
|
|
|
my $ra; |
3029
|
0
|
0
|
0
|
|
|
|
if ( $newer_only and |
|
|
|
0
|
|
|
|
|
3030
|
|
|
|
|
|
|
$ra = $sftp->stat($rpath) and |
3031
|
|
|
|
|
|
|
$ra->mtime >= $e->{a}->mtime) { |
3032
|
0
|
|
|
|
|
|
$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS, |
3033
|
|
|
|
|
|
|
"Newer remote file '$rpath' already exists"); |
3034
|
|
|
|
|
|
|
} |
3035
|
|
|
|
|
|
|
else { |
3036
|
0
|
0
|
|
|
|
|
if ($sftp->put($fn, $rpath, |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3037
|
|
|
|
|
|
|
( defined($perm) ? (perm => $perm) |
3038
|
|
|
|
|
|
|
: $copy_perm ? (perm => $e->{a}->perm & $mask) |
3039
|
|
|
|
|
|
|
: (copy_perm => 0, umask => $umask) ), |
3040
|
|
|
|
|
|
|
copy_time => $copy_time, |
3041
|
|
|
|
|
|
|
%put_opts)) { |
3042
|
0
|
|
|
|
|
|
$count++; |
3043
|
0
|
|
|
|
|
|
return undef; |
3044
|
|
|
|
|
|
|
} |
3045
|
0
|
|
|
|
|
|
$lfs->_copy_error($sftp); |
3046
|
|
|
|
|
|
|
} |
3047
|
|
|
|
|
|
|
} |
3048
|
|
|
|
|
|
|
else { |
3049
|
0
|
0
|
|
|
|
|
$lfs->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT, |
3050
|
|
|
|
|
|
|
( $ignore_links |
3051
|
|
|
|
|
|
|
? "Local file '$fn' is not regular file or directory" |
3052
|
|
|
|
|
|
|
: "Local file '$fn' is not regular file, directory or link")); |
3053
|
|
|
|
|
|
|
} |
3054
|
|
|
|
|
|
|
} |
3055
|
|
|
|
|
|
|
else { |
3056
|
0
|
|
|
|
|
|
$lfs->_set_error(SFTP_ERR_LOCAL_BAD_PATH, |
3057
|
|
|
|
|
|
|
"Bad local path '$fn'"); |
3058
|
|
|
|
|
|
|
} |
3059
|
0
|
|
|
|
|
|
$lfs->_call_on_error($on_error, $e); |
3060
|
|
|
|
|
|
|
} |
3061
|
|
|
|
|
|
|
} |
3062
|
0
|
|
|
|
|
|
return undef; |
3063
|
0
|
|
|
|
|
|
} ); |
3064
|
|
|
|
|
|
|
|
3065
|
0
|
|
|
|
|
|
return $count; |
3066
|
|
|
|
|
|
|
} |
3067
|
|
|
|
|
|
|
|
3068
|
|
|
|
|
|
|
sub mget { |
3069
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->mget($remote, $localdir, %opts)'; |
3070
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
3071
|
|
|
|
|
|
|
|
3072
|
0
|
|
|
|
|
|
my ($sftp, $remote, $localdir, %opts) = @_; |
3073
|
|
|
|
|
|
|
|
3074
|
0
|
0
|
|
|
|
|
defined $remote or croak "remote pattern is undefined"; |
3075
|
|
|
|
|
|
|
|
3076
|
0
|
|
|
|
|
|
my $on_error = $opts{on_error}; |
3077
|
0
|
0
|
|
|
|
|
local $sftp->{_autodie} if $on_error; |
3078
|
0
|
|
|
|
|
|
my $ignore_links = delete $opts{ignore_links}; |
3079
|
|
|
|
|
|
|
|
3080
|
0
|
|
|
|
|
|
my %glob_opts = (map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
3081
|
|
|
|
|
|
|
qw(on_error follow_links ignore_case |
3082
|
|
|
|
|
|
|
wanted no_wanted strict_leading_dot)); |
3083
|
|
|
|
|
|
|
|
3084
|
0
|
|
|
|
|
|
my %get_symlink_opts = (map { $_ => $opts{$_} } |
|
0
|
|
|
|
|
|
|
3085
|
|
|
|
|
|
|
qw(overwrite numbered)); |
3086
|
|
|
|
|
|
|
|
3087
|
0
|
|
|
|
|
|
my %get_opts = (map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
3088
|
|
|
|
|
|
|
qw(umask perm copy_perm copy_time block_size queue_size |
3089
|
|
|
|
|
|
|
overwrite conversion resume numbered atomic best_effort mkpath)); |
3090
|
|
|
|
|
|
|
|
3091
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
3092
|
|
|
|
|
|
|
|
3093
|
0
|
|
|
|
|
|
my @remote = map $sftp->glob($_, %glob_opts), _ensure_list $remote; |
3094
|
|
|
|
|
|
|
|
3095
|
0
|
|
|
|
|
|
my $count = 0; |
3096
|
|
|
|
|
|
|
|
3097
|
0
|
|
|
|
|
|
require File::Spec; |
3098
|
0
|
|
|
|
|
|
for my $e (@remote) { |
3099
|
0
|
|
|
|
|
|
my $perm = $e->{a}->perm; |
3100
|
0
|
0
|
|
|
|
|
if (_is_dir($perm)) { |
3101
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT, |
3102
|
|
|
|
|
|
|
"Remote object '$e->{filename}' is a directory"); |
3103
|
|
|
|
|
|
|
} |
3104
|
|
|
|
|
|
|
else { |
3105
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
3106
|
0
|
|
|
|
|
|
my ($local) = $fn =~ m{([^\\/]*)$}; |
3107
|
|
|
|
|
|
|
|
3108
|
0
|
0
|
|
|
|
|
$local = File::Spec->catfile($localdir, $local) |
3109
|
|
|
|
|
|
|
if defined $localdir; |
3110
|
|
|
|
|
|
|
|
3111
|
0
|
0
|
|
|
|
|
if (_is_lnk($perm)) { |
3112
|
0
|
0
|
|
|
|
|
next if $ignore_links; |
3113
|
0
|
|
|
|
|
|
$sftp->get_symlink($fn, $local, %get_symlink_opts); |
3114
|
|
|
|
|
|
|
} |
3115
|
|
|
|
|
|
|
else { |
3116
|
0
|
|
|
|
|
|
$sftp->get($fn, $local, %get_opts); |
3117
|
|
|
|
|
|
|
} |
3118
|
|
|
|
|
|
|
} |
3119
|
0
|
0
|
|
|
|
|
$count++ unless $sftp->{_error}; |
3120
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
3121
|
|
|
|
|
|
|
} |
3122
|
0
|
|
|
|
|
|
$count; |
3123
|
|
|
|
|
|
|
} |
3124
|
|
|
|
|
|
|
|
3125
|
|
|
|
|
|
|
sub mput { |
3126
|
0
|
0
|
|
0
|
1
|
|
@_ >= 2 or croak 'Usage: $sftp->mput($local, $remotedir, %opts)'; |
3127
|
|
|
|
|
|
|
|
3128
|
0
|
|
|
|
|
|
my ($sftp, $local, $remotedir, %opts) = @_; |
3129
|
|
|
|
|
|
|
|
3130
|
0
|
0
|
|
|
|
|
defined $local or die "local pattern is undefined"; |
3131
|
|
|
|
|
|
|
|
3132
|
0
|
|
|
|
|
|
my $on_error = $opts{on_error}; |
3133
|
0
|
0
|
|
|
|
|
local $sftp->{_autodie} if $on_error; |
3134
|
0
|
|
|
|
|
|
my $ignore_links = delete $opts{ignore_links}; |
3135
|
|
|
|
|
|
|
|
3136
|
0
|
|
|
|
|
|
my %glob_opts = (map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
3137
|
|
|
|
|
|
|
qw(on_error follow_links ignore_case |
3138
|
|
|
|
|
|
|
wanted no_wanted strict_leading_dot)); |
3139
|
0
|
|
|
|
|
|
my %put_symlink_opts = (map { $_ => $opts{$_} } |
|
0
|
|
|
|
|
|
|
3140
|
|
|
|
|
|
|
qw(overwrite numbered)); |
3141
|
|
|
|
|
|
|
|
3142
|
0
|
|
|
|
|
|
my %put_opts = (map { $_ => delete $opts{$_} } |
|
0
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
qw(umask perm copy_perm copy_time block_size queue_size |
3144
|
|
|
|
|
|
|
overwrite conversion resume numbered late_set_perm |
3145
|
|
|
|
|
|
|
atomic best_effort sparse mkpath)); |
3146
|
|
|
|
|
|
|
|
3147
|
0
|
0
|
|
|
|
|
%opts and _croak_bad_options(keys %opts); |
3148
|
|
|
|
|
|
|
|
3149
|
0
|
|
|
|
|
|
require Net::SFTP::Foreign::Local; |
3150
|
0
|
|
|
|
|
|
my $lfs = Net::SFTP::Foreign::Local->new; |
3151
|
0
|
|
|
|
|
|
my @local = map $lfs->glob($_, %glob_opts), _ensure_list $local; |
3152
|
|
|
|
|
|
|
|
3153
|
0
|
|
|
|
|
|
my $count = 0; |
3154
|
0
|
|
|
|
|
|
require File::Spec; |
3155
|
0
|
|
|
|
|
|
for my $e (@local) { |
3156
|
0
|
|
|
|
|
|
my $perm = $e->{a}->perm; |
3157
|
0
|
0
|
|
|
|
|
if (_is_dir($perm)) { |
3158
|
0
|
|
|
|
|
|
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT, |
3159
|
|
|
|
|
|
|
"Remote object '$e->{filename}' is a directory"); |
3160
|
|
|
|
|
|
|
} |
3161
|
|
|
|
|
|
|
else { |
3162
|
0
|
|
|
|
|
|
my $fn = $e->{filename}; |
3163
|
0
|
|
|
|
|
|
my $remote = (File::Spec->splitpath($fn))[2]; |
3164
|
0
|
0
|
|
|
|
|
$remote = $sftp->join($remotedir, $remote) |
3165
|
|
|
|
|
|
|
if defined $remotedir; |
3166
|
|
|
|
|
|
|
|
3167
|
0
|
0
|
|
|
|
|
if (_is_lnk($perm)) { |
3168
|
0
|
0
|
|
|
|
|
next if $ignore_links; |
3169
|
0
|
|
|
|
|
|
$sftp->put_symlink($fn, $remote, %put_symlink_opts); |
3170
|
|
|
|
|
|
|
} |
3171
|
|
|
|
|
|
|
else { |
3172
|
0
|
|
|
|
|
|
$sftp->put($fn, $remote, %put_opts); |
3173
|
|
|
|
|
|
|
} |
3174
|
|
|
|
|
|
|
} |
3175
|
0
|
0
|
|
|
|
|
$count++ unless $sftp->{_error}; |
3176
|
0
|
|
|
|
|
|
$sftp->_call_on_error($on_error, $e); |
3177
|
|
|
|
|
|
|
} |
3178
|
0
|
|
|
|
|
|
$count; |
3179
|
|
|
|
|
|
|
} |
3180
|
|
|
|
|
|
|
|
3181
|
|
|
|
|
|
|
sub fsync { |
3182
|
0
|
0
|
|
0
|
1
|
|
@_ == 2 or croak 'Usage: $sftp->fsync($fh)'; |
3183
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
3184
|
|
|
|
|
|
|
|
3185
|
0
|
|
|
|
|
|
my ($sftp, $fh) = @_; |
3186
|
|
|
|
|
|
|
|
3187
|
0
|
|
|
|
|
|
$sftp->flush($fh, "out"); |
3188
|
0
|
0
|
|
|
|
|
$sftp->_check_extension('fsync@openssh.com' => 1, |
3189
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_FSYNC_FAILED, |
3190
|
|
|
|
|
|
|
"fsync failed, not implemented") |
3191
|
|
|
|
|
|
|
or return undef; |
3192
|
|
|
|
|
|
|
|
3193
|
0
|
|
|
|
|
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED, |
3194
|
|
|
|
|
|
|
str => 'fsync@openssh.com', |
3195
|
|
|
|
|
|
|
str => $sftp->_rid($fh)); |
3196
|
0
|
0
|
|
|
|
|
if ($sftp->_check_status_ok($id, |
3197
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_FSYNC_FAILED, |
3198
|
|
|
|
|
|
|
"Couldn't fsync remote file")) { |
3199
|
0
|
|
|
|
|
|
return 1; |
3200
|
|
|
|
|
|
|
} |
3201
|
0
|
|
|
|
|
|
return undef; |
3202
|
|
|
|
|
|
|
} |
3203
|
|
|
|
|
|
|
|
3204
|
|
|
|
|
|
|
sub statvfs { |
3205
|
0
|
0
|
|
0
|
1
|
|
@_ == 2 or croak 'Usage: $sftp->statvfs($path_or_fh)'; |
3206
|
0
|
0
|
|
|
|
|
${^TAINT} and &_catch_tainted_args; |
3207
|
|
|
|
|
|
|
|
3208
|
0
|
|
|
|
|
|
my ($sftp, $pofh) = @_; |
3209
|
0
|
0
|
0
|
|
|
|
my ($extension, $arg) = ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle')) |
3210
|
|
|
|
|
|
|
? ('fstatvfs@openssh.com', $sftp->_rid($pofh) ) |
3211
|
|
|
|
|
|
|
: ('statvfs@openssh.com' , $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ); |
3212
|
|
|
|
|
|
|
|
3213
|
0
|
0
|
|
|
|
|
$sftp->_check_extension($extension => 2, |
3214
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_STATVFS_FAILED, |
3215
|
|
|
|
|
|
|
"statvfs failed, not implemented") |
3216
|
|
|
|
|
|
|
or return undef; |
3217
|
|
|
|
|
|
|
|
3218
|
0
|
|
|
|
|
|
my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED, |
3219
|
|
|
|
|
|
|
str => $extension, |
3220
|
|
|
|
|
|
|
str => $arg); |
3221
|
|
|
|
|
|
|
|
3222
|
0
|
0
|
|
|
|
|
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_EXTENDED_REPLY, $id, |
3223
|
|
|
|
|
|
|
SFTP_ERR_REMOTE_STATVFS_FAILED, |
3224
|
|
|
|
|
|
|
"Couldn't stat remote file system")) { |
3225
|
0
|
|
|
|
|
|
my %statvfs = map { $_ => $msg->get_int64 } qw(bsize frsize blocks |
|
0
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
|
bfree bavail files ffree |
3227
|
|
|
|
|
|
|
favail fsid flag namemax); |
3228
|
0
|
|
|
|
|
|
return \%statvfs; |
3229
|
|
|
|
|
|
|
} |
3230
|
0
|
|
|
|
|
|
return undef; |
3231
|
|
|
|
|
|
|
} |
3232
|
|
|
|
|
|
|
|
3233
|
|
|
|
|
|
|
sub fstatvfs { |
3234
|
0
|
|
|
0
|
1
|
|
_deprecated "fstatvfs is deprecated and will be removed on the upcoming 2.xx series, " |
3235
|
|
|
|
|
|
|
. "statvfs method accepts now both file handlers and paths"; |
3236
|
0
|
|
|
|
|
|
goto &statvfs; |
3237
|
|
|
|
|
|
|
} |
3238
|
|
|
|
|
|
|
|
3239
|
|
|
|
|
|
|
package Net::SFTP::Foreign::Handle; |
3240
|
|
|
|
|
|
|
|
3241
|
3
|
|
|
3
|
|
1663
|
use Tie::Handle; |
|
3
|
|
|
|
|
5144
|
|
|
3
|
|
|
|
|
5204
|
|
3242
|
|
|
|
|
|
|
our @ISA = qw(Tie::Handle); |
3243
|
|
|
|
|
|
|
our @CARP_NOT = qw(Net::SFTP::Foreign Tie::Handle); |
3244
|
|
|
|
|
|
|
|
3245
|
|
|
|
|
|
|
my $gen_accessor = sub { |
3246
|
|
|
|
|
|
|
my $ix = shift; |
3247
|
|
|
|
|
|
|
sub { |
3248
|
0
|
|
|
0
|
|
|
my $st = *{shift()}{ARRAY}; |
|
0
|
|
|
|
|
|
|
3249
|
0
|
0
|
|
|
|
|
if (@_) { |
3250
|
0
|
|
|
|
|
|
$st->[$ix] = shift; |
3251
|
|
|
|
|
|
|
} |
3252
|
|
|
|
|
|
|
else { |
3253
|
0
|
|
|
|
|
|
$st->[$ix] |
3254
|
|
|
|
|
|
|
} |
3255
|
|
|
|
|
|
|
} |
3256
|
|
|
|
|
|
|
}; |
3257
|
|
|
|
|
|
|
|
3258
|
|
|
|
|
|
|
my $gen_proxy_method = sub { |
3259
|
|
|
|
|
|
|
my $method = shift; |
3260
|
|
|
|
|
|
|
sub { |
3261
|
0
|
|
|
0
|
|
|
my $self = $_[0]; |
3262
|
0
|
0
|
|
|
|
|
$self->_check |
3263
|
|
|
|
|
|
|
or return undef; |
3264
|
|
|
|
|
|
|
|
3265
|
0
|
|
|
|
|
|
my $sftp = $self->_sftp; |
3266
|
0
|
0
|
|
|
|
|
if (wantarray) { |
3267
|
0
|
|
|
|
|
|
my @ret = $sftp->$method(@_); |
3268
|
0
|
0
|
|
|
|
|
$sftp->_set_errno unless @ret; |
3269
|
0
|
|
|
|
|
|
return @ret; |
3270
|
|
|
|
|
|
|
} |
3271
|
|
|
|
|
|
|
else { |
3272
|
0
|
|
|
|
|
|
my $ret = $sftp->$method(@_); |
3273
|
0
|
0
|
|
|
|
|
$sftp->_set_errno unless defined $ret; |
3274
|
0
|
|
|
|
|
|
return $ret; |
3275
|
|
|
|
|
|
|
} |
3276
|
|
|
|
|
|
|
} |
3277
|
|
|
|
|
|
|
}; |
3278
|
|
|
|
|
|
|
|
3279
|
|
|
|
|
|
|
my $gen_not_supported = sub { |
3280
|
|
|
|
|
|
|
sub { |
3281
|
0
|
|
|
0
|
|
|
$! = Errno::ENOTSUP(); |
3282
|
|
|
|
|
|
|
undef |
3283
|
0
|
|
|
|
|
|
} |
3284
|
|
|
|
|
|
|
}; |
3285
|
|
|
|
|
|
|
|
3286
|
0
|
|
|
0
|
|
|
sub TIEHANDLE { return shift } |
3287
|
|
|
|
|
|
|
|
3288
|
|
|
|
|
|
|
# sub UNTIE {} |
3289
|
|
|
|
|
|
|
|
3290
|
|
|
|
|
|
|
sub _new_from_rid { |
3291
|
0
|
|
|
0
|
|
|
my $class = shift; |
3292
|
0
|
|
|
|
|
|
my $sftp = shift; |
3293
|
0
|
|
|
|
|
|
my $rid = shift; |
3294
|
0
|
|
0
|
|
|
|
my $flags = shift || 0; |
3295
|
|
|
|
|
|
|
|
3296
|
0
|
|
|
|
|
|
my $self = Symbol::gensym; |
3297
|
0
|
|
|
|
|
|
bless $self, $class; |
3298
|
0
|
|
|
|
|
|
*$self = [ $sftp, $rid, 0, $flags, @_]; |
3299
|
0
|
|
|
|
|
|
tie *$self, $self; |
3300
|
|
|
|
|
|
|
|
3301
|
0
|
|
|
|
|
|
$self; |
3302
|
|
|
|
|
|
|
} |
3303
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
sub _close { |
3305
|
0
|
|
|
0
|
|
|
my $self = shift; |
3306
|
0
|
|
|
|
|
|
@{*{$self}{ARRAY}} = (); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3307
|
|
|
|
|
|
|
} |
3308
|
|
|
|
|
|
|
|
3309
|
|
|
|
|
|
|
sub _check { |
3310
|
0
|
0
|
|
0
|
|
|
return 1 if defined(*{shift()}{ARRAY}[0]); |
|
0
|
|
|
|
|
|
|
3311
|
0
|
|
|
|
|
|
$! = Errno::EBADF(); |
3312
|
0
|
|
|
|
|
|
undef; |
3313
|
|
|
|
|
|
|
} |
3314
|
|
|
|
|
|
|
|
3315
|
|
|
|
|
|
|
sub FILENO { |
3316
|
0
|
|
|
0
|
|
|
my $self = shift; |
3317
|
0
|
0
|
|
|
|
|
$self->_check |
3318
|
|
|
|
|
|
|
or return undef; |
3319
|
|
|
|
|
|
|
|
3320
|
0
|
|
|
|
|
|
my $hrid = unpack 'H*' => $self->_rid; |
3321
|
0
|
|
|
|
|
|
"-1:sftp(0x$hrid)" |
3322
|
|
|
|
|
|
|
} |
3323
|
|
|
|
|
|
|
|
3324
|
0
|
|
|
0
|
|
|
sub _sftp { *{shift()}{ARRAY}[0] } |
|
0
|
|
|
|
|
|
|
3325
|
0
|
|
|
0
|
|
|
sub _rid { *{shift()}{ARRAY}[1] } |
|
0
|
|
|
|
|
|
|
3326
|
|
|
|
|
|
|
|
3327
|
|
|
|
|
|
|
* _pos = $gen_accessor->(2); |
3328
|
|
|
|
|
|
|
|
3329
|
|
|
|
|
|
|
sub _inc_pos { |
3330
|
0
|
|
|
0
|
|
|
my ($self, $inc) = @_; |
3331
|
0
|
|
|
|
|
|
*{shift()}{ARRAY}[2] += $inc; |
|
0
|
|
|
|
|
|
|
3332
|
|
|
|
|
|
|
} |
3333
|
|
|
|
|
|
|
|
3334
|
|
|
|
|
|
|
|
3335
|
|
|
|
|
|
|
my %flag_bit = (append => 0x1); |
3336
|
|
|
|
|
|
|
|
3337
|
|
|
|
|
|
|
sub _flag { |
3338
|
0
|
|
|
0
|
|
|
my $st = *{shift()}{ARRAY}; |
|
0
|
|
|
|
|
|
|
3339
|
0
|
|
|
|
|
|
my $fn = shift; |
3340
|
0
|
|
|
|
|
|
my $flag = $flag_bit{$fn}; |
3341
|
0
|
0
|
|
|
|
|
Carp::croak("unknown flag $fn") unless defined $flag; |
3342
|
0
|
0
|
|
|
|
|
if (@_) { |
3343
|
0
|
0
|
|
|
|
|
if (shift) { |
3344
|
0
|
|
|
|
|
|
$st->[3] |= $flag; |
3345
|
|
|
|
|
|
|
} |
3346
|
|
|
|
|
|
|
else { |
3347
|
0
|
|
|
|
|
|
$st->[3] &= ~$flag; |
3348
|
|
|
|
|
|
|
} |
3349
|
|
|
|
|
|
|
} |
3350
|
0
|
0
|
|
|
|
|
$st->[3] & $flag ? 1 : 0 |
3351
|
|
|
|
|
|
|
} |
3352
|
|
|
|
|
|
|
|
3353
|
|
|
|
|
|
|
sub _check_is_file { |
3354
|
0
|
|
|
0
|
|
|
Carp::croak("expecting remote file handler, got directory handler"); |
3355
|
|
|
|
|
|
|
} |
3356
|
|
|
|
|
|
|
sub _check_is_dir { |
3357
|
0
|
|
|
0
|
|
|
Carp::croak("expecting remote directory handler, got file handler"); |
3358
|
|
|
|
|
|
|
} |
3359
|
|
|
|
|
|
|
|
3360
|
|
|
|
|
|
|
my $autoloaded; |
3361
|
|
|
|
|
|
|
sub AUTOLOAD { |
3362
|
0
|
|
|
0
|
|
|
my $self = shift; |
3363
|
0
|
|
|
|
|
|
our $AUTOLOAD; |
3364
|
0
|
0
|
|
|
|
|
if ($autoloaded) { |
3365
|
0
|
|
0
|
|
|
|
my $class = ref $self || $self; |
3366
|
0
|
|
|
|
|
|
Carp::croak qq|Can't locate object method "$AUTOLOAD" via package "$class|; |
3367
|
|
|
|
|
|
|
} |
3368
|
|
|
|
|
|
|
else { |
3369
|
0
|
|
|
|
|
|
$autoloaded = 1; |
3370
|
0
|
|
|
|
|
|
require IO::File; |
3371
|
0
|
|
|
|
|
|
require IO::Dir; |
3372
|
0
|
|
|
|
|
|
my ($method) = $AUTOLOAD =~ /^.*::(.*)$/; |
3373
|
0
|
|
|
|
|
|
$self->$method(@_); |
3374
|
|
|
|
|
|
|
} |
3375
|
|
|
|
|
|
|
} |
3376
|
|
|
|
|
|
|
|
3377
|
|
|
|
|
|
|
package Net::SFTP::Foreign::FileHandle; |
3378
|
|
|
|
|
|
|
our @ISA = qw(Net::SFTP::Foreign::Handle IO::File); |
3379
|
|
|
|
|
|
|
|
3380
|
|
|
|
|
|
|
sub _new_from_rid { |
3381
|
0
|
|
|
0
|
|
|
my $class = shift; |
3382
|
0
|
|
|
|
|
|
my $sftp = shift; |
3383
|
0
|
|
|
|
|
|
my $rid = shift; |
3384
|
0
|
|
|
|
|
|
my $flags = shift; |
3385
|
|
|
|
|
|
|
|
3386
|
0
|
|
|
|
|
|
my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, '', ''); |
3387
|
|
|
|
|
|
|
} |
3388
|
|
|
|
|
|
|
|
3389
|
|
|
|
0
|
|
|
sub _check_is_file {} |
3390
|
|
|
|
|
|
|
|
3391
|
0
|
|
|
0
|
|
|
sub _bin { \(*{shift()}{ARRAY}[4]) } |
|
0
|
|
|
|
|
|
|
3392
|
0
|
|
|
0
|
|
|
sub _bout { \(*{shift()}{ARRAY}[5]) } |
|
0
|
|
|
|
|
|
|
3393
|
|
|
|
|
|
|
|
3394
|
|
|
|
|
|
|
sub WRITE { |
3395
|
0
|
|
|
0
|
|
|
my ($self, undef, $length, $offset) = @_; |
3396
|
0
|
0
|
|
|
|
|
$self->_check |
3397
|
|
|
|
|
|
|
or return undef; |
3398
|
|
|
|
|
|
|
|
3399
|
0
|
0
|
|
|
|
|
$offset = 0 unless defined $offset; |
3400
|
0
|
0
|
|
|
|
|
$offset = length $_[1] + $offset if $offset < 0; |
3401
|
0
|
0
|
|
|
|
|
$length = length $_[1] unless defined $length; |
3402
|
|
|
|
|
|
|
|
3403
|
0
|
|
|
|
|
|
my $sftp = $self->_sftp; |
3404
|
|
|
|
|
|
|
|
3405
|
0
|
|
|
|
|
|
my $ret = $sftp->write($self, substr($_[1], $offset, $length)); |
3406
|
0
|
0
|
|
|
|
|
$sftp->_set_errno unless defined $ret; |
3407
|
0
|
|
|
|
|
|
$ret; |
3408
|
|
|
|
|
|
|
} |
3409
|
|
|
|
|
|
|
|
3410
|
|
|
|
|
|
|
sub READ { |
3411
|
0
|
|
|
0
|
|
|
my ($self, undef, $len, $offset) = @_; |
3412
|
0
|
0
|
|
|
|
|
$self->_check |
3413
|
|
|
|
|
|
|
or return undef; |
3414
|
|
|
|
|
|
|
|
3415
|
0
|
0
|
|
|
|
|
$_[1] = '' unless defined $_[1]; |
3416
|
0
|
|
0
|
|
|
|
$offset ||= 0; |
3417
|
0
|
0
|
|
|
|
|
if ($offset > length $_[1]) { |
3418
|
0
|
|
|
|
|
|
$_[1] .= "\0" x ($offset - length $_[1]) |
3419
|
|
|
|
|
|
|
} |
3420
|
|
|
|
|
|
|
|
3421
|
0
|
0
|
|
|
|
|
if ($len == 0) { |
3422
|
0
|
|
|
|
|
|
substr($_[1], $offset) = ''; |
3423
|
0
|
|
|
|
|
|
return 0; |
3424
|
|
|
|
|
|
|
} |
3425
|
|
|
|
|
|
|
|
3426
|
0
|
|
|
|
|
|
my $sftp = $self->_sftp; |
3427
|
0
|
|
|
|
|
|
$sftp->_fill_read_cache($self, $len); |
3428
|
|
|
|
|
|
|
|
3429
|
0
|
|
|
|
|
|
my $bin = $self->_bin; |
3430
|
0
|
0
|
|
|
|
|
if (length $$bin) { |
3431
|
0
|
|
|
|
|
|
my $data = substr($$bin, 0, $len, ''); |
3432
|
0
|
|
|
|
|
|
$self->_inc_pos($len); |
3433
|
0
|
|
|
|
|
|
substr($_[1], $offset) = $data; |
3434
|
0
|
|
|
|
|
|
return length $data; |
3435
|
|
|
|
|
|
|
} |
3436
|
0
|
0
|
|
|
|
|
return 0 if $sftp->{_status} == $sftp->SSH2_FX_EOF; |
3437
|
0
|
|
|
|
|
|
$sftp->_set_errno; |
3438
|
0
|
|
|
|
|
|
undef; |
3439
|
|
|
|
|
|
|
} |
3440
|
|
|
|
|
|
|
|
3441
|
|
|
|
|
|
|
sub EOF { |
3442
|
0
|
|
|
0
|
|
|
my $self = $_[0]; |
3443
|
0
|
0
|
|
|
|
|
$self->_check or return undef; |
3444
|
0
|
|
|
|
|
|
my $sftp = $self->_sftp; |
3445
|
0
|
|
|
|
|
|
my $ret = $sftp->eof($self); |
3446
|
0
|
0
|
|
|
|
|
$sftp->_set_errno unless defined $ret; |
3447
|
0
|
|
|
|
|
|
$ret; |
3448
|
|
|
|
|
|
|
} |
3449
|
|
|
|
|
|
|
|
3450
|
|
|
|
|
|
|
*GETC = $gen_proxy_method->('getc'); |
3451
|
|
|
|
|
|
|
*TELL = $gen_proxy_method->('tell'); |
3452
|
|
|
|
|
|
|
*SEEK = $gen_proxy_method->('seek'); |
3453
|
|
|
|
|
|
|
*CLOSE = $gen_proxy_method->('close'); |
3454
|
|
|
|
|
|
|
|
3455
|
|
|
|
|
|
|
my $readline = $gen_proxy_method->('readline'); |
3456
|
0
|
|
|
0
|
|
|
sub READLINE { $readline->($_[0], $/) } |
3457
|
|
|
|
|
|
|
|
3458
|
|
|
|
|
|
|
sub OPEN { |
3459
|
0
|
|
|
0
|
|
|
shift->CLOSE; |
3460
|
0
|
|
|
|
|
|
undef; |
3461
|
|
|
|
|
|
|
} |
3462
|
|
|
|
|
|
|
|
3463
|
|
|
|
|
|
|
sub DESTROY { |
3464
|
0
|
|
|
0
|
|
|
local ($@, $!, $?); |
3465
|
0
|
|
|
|
|
|
my $self = shift; |
3466
|
0
|
|
|
|
|
|
my $sftp = $self->_sftp; |
3467
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")"); |
|
|
|
0
|
|
|
|
|
3468
|
0
|
0
|
0
|
|
|
|
if ($self->_check and $sftp) { |
3469
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
3470
|
0
|
|
|
|
|
|
$sftp->_close_save_status($self) |
3471
|
|
|
|
|
|
|
} |
3472
|
|
|
|
|
|
|
} |
3473
|
|
|
|
|
|
|
|
3474
|
|
|
|
|
|
|
package Net::SFTP::Foreign::DirHandle; |
3475
|
|
|
|
|
|
|
our @ISA = qw(Net::SFTP::Foreign::Handle IO::Dir); |
3476
|
|
|
|
|
|
|
|
3477
|
|
|
|
|
|
|
sub _new_from_rid { |
3478
|
0
|
|
|
0
|
|
|
my $class = shift; |
3479
|
0
|
|
|
|
|
|
my $sftp = shift; |
3480
|
0
|
|
|
|
|
|
my $rid = shift; |
3481
|
0
|
|
|
|
|
|
my $flags = shift; |
3482
|
|
|
|
|
|
|
|
3483
|
0
|
|
|
|
|
|
my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, []); |
3484
|
|
|
|
|
|
|
} |
3485
|
|
|
|
|
|
|
|
3486
|
|
|
|
|
|
|
|
3487
|
|
|
|
0
|
|
|
sub _check_is_dir {} |
3488
|
|
|
|
|
|
|
|
3489
|
0
|
|
|
0
|
|
|
sub _cache { *{shift()}{ARRAY}[4] } |
|
0
|
|
|
|
|
|
|
3490
|
|
|
|
|
|
|
|
3491
|
|
|
|
|
|
|
*CLOSEDIR = $gen_proxy_method->('closedir'); |
3492
|
|
|
|
|
|
|
*READDIR = $gen_proxy_method->('_readdir'); |
3493
|
|
|
|
|
|
|
|
3494
|
|
|
|
|
|
|
sub OPENDIR { |
3495
|
0
|
|
|
0
|
|
|
shift->CLOSEDIR; |
3496
|
0
|
|
|
|
|
|
undef; |
3497
|
|
|
|
|
|
|
} |
3498
|
|
|
|
|
|
|
|
3499
|
|
|
|
|
|
|
*REWINDDIR = $gen_not_supported->(); |
3500
|
|
|
|
|
|
|
*TELLDIR = $gen_not_supported->(); |
3501
|
|
|
|
|
|
|
*SEEKDIR = $gen_not_supported->(); |
3502
|
|
|
|
|
|
|
|
3503
|
|
|
|
|
|
|
sub DESTROY { |
3504
|
0
|
|
|
0
|
|
|
local ($@, $!, $?); |
3505
|
0
|
|
|
|
|
|
my $self = shift; |
3506
|
0
|
|
|
|
|
|
my $sftp = $self->_sftp; |
3507
|
|
|
|
|
|
|
|
3508
|
0
|
0
|
0
|
|
|
|
$debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")"); |
|
|
|
0
|
|
|
|
|
3509
|
|
|
|
|
|
|
|
3510
|
0
|
0
|
0
|
|
|
|
if ($self->_check and $sftp) { |
3511
|
0
|
|
|
|
|
|
local $sftp->{_autodie}; |
3512
|
0
|
|
|
|
|
|
$sftp->_closedir_save_status($self) |
3513
|
|
|
|
|
|
|
} |
3514
|
|
|
|
|
|
|
} |
3515
|
|
|
|
|
|
|
|
3516
|
|
|
|
|
|
|
1; |
3517
|
|
|
|
|
|
|
__END__ |