File Coverage

blib/lib/App/MBUtiny/Storage/SFTP.pm
Criterion Covered Total %
statement 43 242 17.7
branch 1 106 0.9
condition 1 46 2.1
subroutine 12 22 54.5
pod 7 7 100.0
total 64 423 15.1


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__