line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::MBUtiny::Storage::SFTP; # $Id: SFTP.pm 131 2019-07-16 18:45:44Z abalama $ |
2
|
2
|
|
|
2
|
|
15
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
54
|
|
3
|
2
|
|
|
2
|
|
21
|
use utf8; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
8
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=encoding utf-8 |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 NAME |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
App::MBUtiny::Storage::SFTP - App::MBUtiny::Storage subclass for SFTP storage support |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 VIRSION |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Version 1.01 |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
FixUP on |
20
|
|
|
|
|
|
|
URL sftp://user@example.com:22/path/to/backup/dir1 |
21
|
|
|
|
|
|
|
URL sftp://user@example.com:22/path/to/backup/dir2 |
22
|
|
|
|
|
|
|
Set timeout 180 |
23
|
|
|
|
|
|
|
Set key_path /path/to/private/file.key |
24
|
|
|
|
|
|
|
Comment SFTP storage said blah-blah-blah # Optional for collector |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# . . . |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 DESCRIPTION |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
App::MBUtiny::Storage subclass for SFTP storage support |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
B For initialization SSH connection please run follow commands first: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
ssh-keygen -t rsa |
38
|
|
|
|
|
|
|
ssh-copy-id -i /path/to/private/file.pub user@example.com |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head2 del |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Removes the specified file. |
43
|
|
|
|
|
|
|
This is backend method of L |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head2 get |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Gets the backup file from storage and saves it to specified path. |
48
|
|
|
|
|
|
|
This is backend method of L |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 init |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
The method performs initialization of storage. |
53
|
|
|
|
|
|
|
This is backend method of L |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head2 list |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Gets backup file list on storage. |
58
|
|
|
|
|
|
|
This is backend method of L |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head2 sftp_storages |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my @list = $storage->sftp_storages; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Returns list of SFTP storage nodes |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head2 put |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Sends backup file to storage. |
69
|
|
|
|
|
|
|
This is backend method of L |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 test |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Storage testing. |
74
|
|
|
|
|
|
|
This is backend method of L |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 HISTORY |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
See C file |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 TO DO |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
See C file |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 BUGS |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
* none noted |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head1 SEE ALSO |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
L |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 AUTHOR |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 COPYRIGHT |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 LICENSE |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
103
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
See C file and L |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
2
|
|
|
2
|
|
67
|
use vars qw/ $VERSION /; |
|
2
|
|
|
|
|
40
|
|
|
2
|
|
|
|
|
86
|
|
110
|
|
|
|
|
|
|
$VERSION = '1.01'; |
111
|
|
|
|
|
|
|
|
112
|
2
|
|
|
2
|
|
54
|
use Storable qw/dclone/; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
88
|
|
113
|
2
|
|
|
2
|
|
12
|
use Fcntl ':mode'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
408
|
|
114
|
2
|
|
|
2
|
|
13
|
use URI; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
44
|
|
115
|
2
|
|
|
2
|
|
7
|
use List::Util qw/uniq/; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
94
|
|
116
|
2
|
|
|
2
|
|
11
|
use CTK::ConfGenUtil; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
106
|
|
117
|
2
|
|
|
2
|
|
10
|
use CTK::TFVals qw/ :ALL /; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
348
|
|
118
|
2
|
|
|
2
|
|
11
|
use App::MBUtiny::Util qw/ node2anode set2attr hide_password filesize /; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
225
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
my $NET_SFTP_FOREIGN = 1; # Loaded! |
121
|
|
|
|
|
|
|
my $NET_SFTP_FOREIGN_MESSAGE = "SFTP storage type is available"; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
eval { require Net::SFTP::Foreign; 1 } or do { |
124
|
|
|
|
|
|
|
$NET_SFTP_FOREIGN = 0; |
125
|
|
|
|
|
|
|
$NET_SFTP_FOREIGN_MESSAGE = "SFTP storage type is not available, Net::SFTP::Foreign is not installed or failed to load: $@"; |
126
|
|
|
|
|
|
|
}; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
use constant { |
129
|
2
|
|
|
|
|
3838
|
STORAGE_SIGN => 'SFTP', |
130
|
2
|
|
|
2
|
|
12
|
}; |
|
2
|
|
|
|
|
8
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub init { |
133
|
1
|
|
|
1
|
1
|
10
|
my $self = shift; |
134
|
1
|
|
|
|
|
3
|
$self->maybe::next::method(); |
135
|
1
|
|
|
|
|
4
|
$self->storage_status(STORAGE_SIGN, -1); |
136
|
1
|
|
|
|
|
2
|
my $usesftp = 0; |
137
|
|
|
|
|
|
|
|
138
|
1
|
|
|
|
|
6
|
my $sftp_nodes = dclone(node2anode(node($self->{host}, 'sftp'))); |
139
|
|
|
|
|
|
|
#print explain($ftp_nodes), "\n"; |
140
|
|
|
|
|
|
|
|
141
|
1
|
|
|
|
|
3
|
my %sftp_storages; |
142
|
1
|
|
|
|
|
2
|
foreach my $sftp_node (@$sftp_nodes) { |
143
|
0
|
|
0
|
|
|
0
|
my $urls = array($sftp_node, 'url') || []; |
144
|
0
|
|
0
|
|
|
0
|
my $gattr = set2attr($sftp_node), |
145
|
|
|
|
|
|
|
my $cmnt = value($sftp_node, 'comment') || ""; |
146
|
0
|
|
|
|
|
0
|
foreach my $url (@$urls) { |
147
|
0
|
|
|
|
|
0
|
my $uri = new URI($url); |
148
|
0
|
|
|
|
|
0
|
my $url_wop = hide_password($url, 2); |
149
|
0
|
|
|
|
|
0
|
my $attr = dclone($gattr); |
150
|
0
|
|
|
|
|
0
|
$attr->{host} = $uri->host; |
151
|
0
|
0
|
|
|
|
0
|
$attr->{port} = $uri->port if $uri->port; |
152
|
0
|
0
|
|
|
|
0
|
$attr->{user} = $uri->user if $uri->user; |
153
|
0
|
0
|
|
|
|
0
|
$attr->{password} = $uri->password if $uri->password; |
154
|
|
|
|
|
|
|
$sftp_storages{$url} = { |
155
|
|
|
|
|
|
|
url => $url, |
156
|
|
|
|
|
|
|
url_wop => $url_wop, |
157
|
|
|
|
|
|
|
path => $uri->path, |
158
|
|
|
|
|
|
|
attr => $attr, |
159
|
0
|
0
|
|
|
|
0
|
comment => join("\n", grep {$_} ($url_wop, $cmnt)), |
|
0
|
|
|
|
|
0
|
|
160
|
|
|
|
|
|
|
fixup => value($sftp_node, 'fixup') ? 1 : 0, |
161
|
|
|
|
|
|
|
}; |
162
|
0
|
|
|
|
|
0
|
$usesftp++; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
1
|
|
|
|
|
4
|
$self->{sftp_storages} = [(values(%sftp_storages))]; |
166
|
|
|
|
|
|
|
|
167
|
1
|
50
|
33
|
|
|
4
|
$self->storage_status(STORAGE_SIGN, $usesftp) if $usesftp && $NET_SFTP_FOREIGN; |
168
|
|
|
|
|
|
|
#print explain($self->{sftp_storages}), "\n"; |
169
|
1
|
|
|
|
|
3
|
return $self; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
sub sftp_storages { |
172
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
173
|
0
|
|
0
|
|
|
|
my $storages = $self->{sftp_storages} || []; |
174
|
0
|
|
|
|
|
|
return @$storages; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
sub test { |
177
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
178
|
0
|
|
|
|
|
|
my %params = @_; $self->maybe::next::method(%params); |
|
0
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
my $sign = STORAGE_SIGN; |
180
|
0
|
0
|
0
|
|
|
|
return $self->storage_status($sign) |
181
|
|
|
|
|
|
|
if is_void($self->sftp_storages()) && $self->storage_status($sign) <= 0; # SKIP |
182
|
0
|
0
|
|
|
|
|
unless ($NET_SFTP_FOREIGN) { # Not loaded |
183
|
0
|
|
|
|
|
|
$self->{test}->{$sign} = [[$NET_SFTP_FOREIGN_MESSAGE, -1]]; |
184
|
0
|
|
|
|
|
|
return $self->storage_status($sign); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
my @test = (); |
188
|
0
|
|
|
|
|
|
foreach my $storage ($self->sftp_storages) { |
189
|
0
|
|
|
|
|
|
my $url_wop = $storage->{url_wop}; |
190
|
0
|
|
|
|
|
|
my $attr = $storage->{attr}; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# Create object |
193
|
0
|
|
|
|
|
|
my $sftp = new Net::SFTP::Foreign(%$attr); |
194
|
0
|
0
|
|
|
|
|
if ($sftp->error) { |
195
|
0
|
|
|
|
|
|
$self->storage_status($sign, 0); |
196
|
0
|
|
|
|
|
|
push @test, [0, $url_wop, sprintf("Can't connect to %s: %s", $url_wop, $sftp->error)]; |
197
|
0
|
|
|
|
|
|
next; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# Change dir |
201
|
0
|
0
|
|
|
|
|
if (my $path = $storage->{path}) { |
202
|
0
|
0
|
|
|
|
|
$sftp->setcwd($path) or do { |
203
|
0
|
|
|
|
|
|
$self->storage_status($sign, 0); |
204
|
0
|
|
|
|
|
|
push @test, [0, $url_wop, sprintf("Can't change directory %s on %s: %s", $path, $url_wop, $sftp->error)]; |
205
|
0
|
|
|
|
|
|
next; |
206
|
|
|
|
|
|
|
}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Get pwd |
210
|
0
|
|
|
|
|
|
my $pwd = $sftp->cwd; |
211
|
0
|
0
|
|
|
|
|
if ($sftp->error) { |
212
|
0
|
|
|
|
|
|
$self->storage_status($sign, 0); |
213
|
0
|
|
|
|
|
|
push @test, [0, $url_wop, sprintf("Can't get cwd on %s: %s", $url_wop, $sftp->error)]; |
214
|
0
|
|
|
|
|
|
next; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# Disconnect |
218
|
0
|
|
|
|
|
|
$sftp->disconnect; |
219
|
|
|
|
|
|
|
|
220
|
0
|
|
|
|
|
|
push @test, [1, $url_wop]; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
$self->{test}->{$sign} = [@test]; |
224
|
0
|
|
|
|
|
|
return 1; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
sub put { |
227
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
228
|
0
|
|
|
|
|
|
my %params = @_; $self->maybe::next::method(%params); |
|
0
|
|
|
|
|
|
|
229
|
0
|
0
|
|
|
|
|
return $self->storage_status(STORAGE_SIGN, -1) if $self->storage_status(STORAGE_SIGN) <= 0; # SKIP and set SKIP |
230
|
0
|
|
|
|
|
|
my $status = 1; |
231
|
0
|
|
|
|
|
|
my $name = $params{name}; # File name only |
232
|
0
|
|
|
|
|
|
my $file = $params{file}; # Path to local file |
233
|
0
|
|
0
|
|
|
|
my $src_size = $params{size} || 0; |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
foreach my $storage ($self->sftp_storages) { |
236
|
0
|
|
|
|
|
|
my $url_wop = $storage->{url_wop}; |
237
|
0
|
|
|
|
|
|
my $attr = $storage->{attr}; |
238
|
0
|
|
0
|
|
|
|
my $comment = $storage->{comment} || ""; |
239
|
0
|
|
|
|
|
|
my $path = $storage->{path}; |
240
|
0
|
|
|
|
|
|
my $ostat = 1; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Create object |
243
|
0
|
|
|
|
|
|
my $sftp = new Net::SFTP::Foreign(%$attr); |
244
|
0
|
0
|
|
|
|
|
if ($sftp->error) { |
245
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't connect to %s: %s", $url_wop, $sftp->error)); |
246
|
0
|
|
|
|
|
|
$ostat = 0; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Change dir |
250
|
0
|
0
|
0
|
|
|
|
if ($ostat && length($path)) { |
251
|
0
|
0
|
|
|
|
|
$sftp->setcwd($path) or do { |
252
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't change directory %s on %s: %s", $path, $url_wop, $sftp->error)); |
253
|
0
|
|
|
|
|
|
$ostat = 0; |
254
|
|
|
|
|
|
|
}; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# Put file |
258
|
0
|
0
|
|
|
|
|
if ($ostat) { |
259
|
0
|
0
|
|
|
|
|
$sftp->put($file, $name) or do { |
260
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't put file %s to %s: %s", $name, $url_wop, $sftp->error)); |
261
|
0
|
|
|
|
|
|
$ostat = 0; |
262
|
|
|
|
|
|
|
}; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Get file size |
266
|
0
|
0
|
|
|
|
|
if ($ostat) { |
267
|
|
|
|
|
|
|
my $ls = $sftp->ls(wanted => sub { |
268
|
0
|
|
|
0
|
|
|
my $foreign = shift; |
269
|
0
|
|
|
|
|
|
my $entry = shift; |
270
|
0
|
0
|
|
|
|
|
S_ISREG($entry->{a}->perm) && $entry->{filename} eq $name; |
271
|
0
|
|
|
|
|
|
}); |
272
|
|
|
|
|
|
|
#print explain($ls), "\n"; |
273
|
0
|
0
|
0
|
|
|
|
if ($sftp->error) { |
|
|
0
|
|
|
|
|
|
274
|
0
|
|
|
|
|
|
$self->error(sprintf("The ls failed: %s", $sftp->error)); |
275
|
0
|
|
|
|
|
|
$ostat = 0; |
276
|
|
|
|
|
|
|
} elsif ($ls && is_array($ls)) { |
277
|
0
|
|
|
|
|
|
my $file = shift(@$ls); |
278
|
0
|
|
0
|
|
|
|
my $dst_size = $file->{a}->size || 0; |
279
|
0
|
0
|
|
|
|
|
unless ($src_size == $dst_size) { |
280
|
0
|
|
|
|
|
|
$self->error(sprintf("An error occurred while sending data to %s. Sizes are different: SRC=%d; DST=%d", $url_wop, $src_size, $dst_size)); |
281
|
0
|
|
|
|
|
|
$ostat = 0; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# Disconnect |
287
|
0
|
|
|
|
|
|
$sftp->disconnect; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Fixup! |
290
|
0
|
0
|
|
|
|
|
$self->fixup("put", $ostat, $comment) if $storage->{fixup}; |
291
|
0
|
0
|
|
|
|
|
$status = 0 unless $ostat; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
0
|
0
|
|
|
|
|
$self->storage_status(STORAGE_SIGN, 0) unless $status; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
sub get { |
297
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
298
|
0
|
|
|
|
|
|
my %params = @_; |
299
|
0
|
0
|
|
|
|
|
if ($self->storage_status(STORAGE_SIGN) <= 0) { # SKIP and set SKIP |
300
|
0
|
|
|
|
|
|
$self->maybe::next::method(%params); |
301
|
0
|
|
|
|
|
|
return $self->storage_status(STORAGE_SIGN, -1); |
302
|
|
|
|
|
|
|
} |
303
|
0
|
|
|
|
|
|
my $name = $params{name}; # archive name |
304
|
0
|
|
|
|
|
|
my $file = $params{file}; # destination archive file path |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
foreach my $storage ($self->sftp_storages) { |
307
|
0
|
|
|
|
|
|
my $url_wop = $storage->{url_wop}; |
308
|
0
|
|
|
|
|
|
my $attr = $storage->{attr}; |
309
|
0
|
|
|
|
|
|
my $path = $storage->{path}; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# Create object |
312
|
0
|
|
|
|
|
|
my $sftp = new Net::SFTP::Foreign(%$attr); |
313
|
0
|
0
|
|
|
|
|
if ($sftp->error) { |
314
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't connect to %s: %s", $url_wop, $sftp->error)); |
315
|
0
|
|
|
|
|
|
next; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# Change dir |
319
|
0
|
0
|
|
|
|
|
if (length($path)) { |
320
|
0
|
0
|
|
|
|
|
$sftp->setcwd($path) or do { |
321
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't change directory %s on %s: %s", $path, $url_wop, $sftp->error)); |
322
|
0
|
|
|
|
|
|
$sftp->disconnect; |
323
|
0
|
|
|
|
|
|
next; |
324
|
|
|
|
|
|
|
}; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# Get file size |
328
|
0
|
|
|
|
|
|
my $src_size = 0; |
329
|
|
|
|
|
|
|
my $ls = $sftp->ls(wanted => sub { |
330
|
0
|
|
|
0
|
|
|
my $foreign = shift; |
331
|
0
|
|
|
|
|
|
my $entry = shift; |
332
|
0
|
0
|
|
|
|
|
S_ISREG($entry->{a}->perm) && $entry->{filename} eq $name; |
333
|
0
|
|
|
|
|
|
}); |
334
|
0
|
0
|
0
|
|
|
|
if ($sftp->error) { |
|
|
0
|
|
|
|
|
|
335
|
0
|
|
|
|
|
|
$self->error(sprintf("The ls failed: %s", $sftp->error)); |
336
|
0
|
|
|
|
|
|
$sftp->disconnect; |
337
|
0
|
|
|
|
|
|
next; |
338
|
|
|
|
|
|
|
} elsif ($ls && is_array($ls)) { |
339
|
0
|
|
|
|
|
|
my $file = shift(@$ls); |
340
|
0
|
|
0
|
|
|
|
$src_size = $file->{a}->size || 0; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# Get file |
344
|
0
|
0
|
|
|
|
|
$sftp->get($name, $file) or do { |
345
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't get file %s from %s: %s", $name, $url_wop, $sftp->error)); |
346
|
0
|
|
|
|
|
|
$sftp->disconnect; |
347
|
0
|
|
|
|
|
|
next; |
348
|
|
|
|
|
|
|
}; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# Check size |
351
|
0
|
|
0
|
|
|
|
my $dst_size = filesize($file) // 0; |
352
|
0
|
0
|
|
|
|
|
unless ($src_size == $dst_size) { |
353
|
0
|
|
|
|
|
|
$self->error(sprintf("An error occurred while sending data to %s. Sizes are different: SRC=%d; DST=%d", $url_wop, $src_size, $dst_size)); |
354
|
0
|
|
|
|
|
|
$sftp->disconnect; |
355
|
0
|
|
|
|
|
|
next; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# Disconnect |
359
|
0
|
|
|
|
|
|
$sftp->disconnect; |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# Validate |
362
|
0
|
0
|
|
|
|
|
unless ($self->validate($file)) { # FAIL validation! |
363
|
0
|
|
|
|
|
|
$self->error(sprintf("SFTP storage %s failed: file %s is not valid!", $url_wop, $file)); |
364
|
|
|
|
|
|
|
next |
365
|
0
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# Done! |
368
|
0
|
|
|
|
|
|
return $self->storage_status(STORAGE_SIGN, 1); |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
|
$self->storage_status(STORAGE_SIGN, 0); |
372
|
0
|
|
|
|
|
|
$self->maybe::next::method(%params); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
sub del { |
375
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
376
|
0
|
|
|
|
|
|
my $name = shift; |
377
|
0
|
|
|
|
|
|
$self->maybe::next::method($name); |
378
|
0
|
0
|
|
|
|
|
return $self->storage_status(STORAGE_SIGN, -1) if $self->storage_status(STORAGE_SIGN) <= 0; # SKIP and set SKIP |
379
|
0
|
|
|
|
|
|
my $status = 1; |
380
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
foreach my $storage ($self->sftp_storages) { |
382
|
0
|
|
|
|
|
|
my $url_wop = $storage->{url_wop}; |
383
|
0
|
|
|
|
|
|
my $attr = $storage->{attr}; |
384
|
0
|
|
|
|
|
|
my $path = $storage->{path}; |
385
|
0
|
|
|
|
|
|
my $ostat = 1; |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# Create object |
388
|
0
|
|
|
|
|
|
my $sftp = new Net::SFTP::Foreign(%$attr); |
389
|
0
|
0
|
|
|
|
|
if ($sftp->error) { |
390
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't connect to %s: %s", $url_wop, $sftp->error)); |
391
|
0
|
|
|
|
|
|
$ostat = 0; |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
# Change dir |
395
|
0
|
0
|
0
|
|
|
|
if ($ostat && length($path)) { |
396
|
0
|
0
|
|
|
|
|
$sftp->setcwd($path) or do { |
397
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't change directory %s on %s: %s", $path, $url_wop, $sftp->error)); |
398
|
0
|
|
|
|
|
|
$ostat = 0; |
399
|
|
|
|
|
|
|
}; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Delete file |
403
|
0
|
0
|
|
|
|
|
if ($ostat) { |
404
|
|
|
|
|
|
|
my $ls = $sftp->ls(wanted => sub { |
405
|
0
|
|
|
0
|
|
|
my $foreign = shift; |
406
|
0
|
|
|
|
|
|
my $entry = shift; |
407
|
0
|
0
|
|
|
|
|
S_ISREG($entry->{a}->perm) && $entry->{filename} eq $name; |
408
|
0
|
|
|
|
|
|
}); |
409
|
|
|
|
|
|
|
#print explain($ls), "\n"; |
410
|
0
|
0
|
0
|
|
|
|
if ($sftp->error) { |
|
|
0
|
0
|
|
|
|
|
411
|
0
|
|
|
|
|
|
$self->error(sprintf("The ls failed: %s", $sftp->error)); |
412
|
0
|
|
|
|
|
|
$ostat = 0; |
413
|
|
|
|
|
|
|
} elsif ($ls && is_array($ls) && @$ls) { |
414
|
0
|
0
|
|
|
|
|
$sftp->remove($name) or do { |
415
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't delete file %s from %s: %s", $name, $url_wop, $sftp->error)); |
416
|
0
|
|
|
|
|
|
$ostat = 0; |
417
|
|
|
|
|
|
|
}; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# Disconnect |
422
|
0
|
|
|
|
|
|
$sftp->disconnect; |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Fixup! |
425
|
0
|
0
|
|
|
|
|
$self->fixup("del", $name) if $storage->{fixup}; |
426
|
0
|
0
|
|
|
|
|
$status = 0 unless $ostat; |
427
|
|
|
|
|
|
|
} |
428
|
0
|
0
|
|
|
|
|
$self->storage_status(STORAGE_SIGN, 0) unless $status; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
sub list { |
431
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
432
|
0
|
|
|
|
|
|
my %params = @_; $self->maybe::next::method(%params); |
|
0
|
|
|
|
|
|
|
433
|
0
|
0
|
|
|
|
|
return $self->storage_status(STORAGE_SIGN, -1) if $self->storage_status(STORAGE_SIGN) <= 0; # SKIP and set SKIP |
434
|
0
|
|
|
|
|
|
my $sign = STORAGE_SIGN; |
435
|
|
|
|
|
|
|
|
436
|
0
|
|
|
|
|
|
my @list = (); |
437
|
0
|
|
|
|
|
|
foreach my $storage ($self->sftp_storages) { |
438
|
0
|
|
|
|
|
|
my $url_wop = $storage->{url_wop}; |
439
|
0
|
|
|
|
|
|
my $attr = $storage->{attr}; |
440
|
0
|
|
|
|
|
|
my $path = $storage->{path}; |
441
|
0
|
|
|
|
|
|
my $ostat = 1; |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# Create object |
444
|
0
|
|
|
|
|
|
my $sftp = new Net::SFTP::Foreign(%$attr); |
445
|
0
|
0
|
|
|
|
|
if ($sftp->error) { |
446
|
0
|
|
|
|
|
|
$self->error(sprintf("Can't connect to %s: %s", $url_wop, $sftp->error)); |
447
|
0
|
|
|
|
|
|
$ostat = 0; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# Get file list |
451
|
0
|
0
|
|
|
|
|
if ($ostat) { |
452
|
|
|
|
|
|
|
my $ls = $sftp->ls($path, wanted => sub { |
453
|
0
|
|
|
0
|
|
|
my $foreign = shift; |
454
|
0
|
|
|
|
|
|
my $entry = shift; |
455
|
|
|
|
|
|
|
S_ISREG($entry->{a}->perm) |
456
|
|
|
|
|
|
|
#$entry->{filename} eq $name; |
457
|
0
|
|
|
|
|
|
}); |
|
0
|
|
|
|
|
|
|
458
|
0
|
0
|
0
|
|
|
|
if ($sftp->error) { |
|
|
0
|
|
|
|
|
|
459
|
0
|
|
|
|
|
|
$self->error(sprintf("The ls failed: %s", $sftp->error)); |
460
|
0
|
|
|
|
|
|
$ostat = 0; |
461
|
|
|
|
|
|
|
} elsif ($ls && is_array($ls)) { |
462
|
0
|
|
|
|
|
|
foreach (@$ls) { |
463
|
0
|
|
|
|
|
|
my $f = $_->{filename}; |
464
|
0
|
0
|
0
|
|
|
|
push @list, $f if defined($f) && length($f); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# Disconnect |
470
|
0
|
|
|
|
|
|
$sftp->disconnect; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
0
|
|
|
|
|
|
$self->{list}->{$sign} = [uniq(@list)]; |
474
|
0
|
|
|
|
|
|
return 1; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
1; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
__END__ |