view release on metacpan or  search on metacpan

lib/App/MBUtiny/Storage/SFTP.pm  view on Meta::CPAN

This is backend method of L<App::MBUtiny::Storage/list>

=head2 sftp_storages

    my @list = $storage->sftp_storages;

Returns list of SFTP storage nodes

=head2 put

Sends backup file to storage.
This is backend method of L<App::MBUtiny::Storage/put>

=head2 test

Storage testing.
This is backend method of L<App::MBUtiny::Storage/test>

=head1 HISTORY

See C<Changes> file

=head1 TO DO

See C<TODO> file

=head1 BUGS

* none noted

=head1 SEE ALSO

L<App::MBUtiny::Storage>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<http://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

use vars qw/ $VERSION /;
$VERSION = '1.01';

use Storable qw/dclone/;
use Fcntl ':mode';
use URI;
use List::Util qw/uniq/;
use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use App::MBUtiny::Util qw/ node2anode set2attr hide_password filesize /;

my $NET_SFTP_FOREIGN = 1; # Loaded!
my $NET_SFTP_FOREIGN_MESSAGE = "SFTP storage type is available";

eval { require Net::SFTP::Foreign; 1 } or do {
    $NET_SFTP_FOREIGN = 0;
    $NET_SFTP_FOREIGN_MESSAGE = "SFTP storage type is not available, Net::SFTP::Foreign is not installed or failed to load: $@";
};

use constant {
        STORAGE_SIGN => 'SFTP',
    };

sub init {
    my $self = shift;
    $self->maybe::next::method();
    $self->storage_status(STORAGE_SIGN, -1);
    my $usesftp = 0;

    my $sftp_nodes = dclone(node2anode(node($self->{host}, 'sftp')));
    #print explain($ftp_nodes), "\n";

    my %sftp_storages;
    foreach my $sftp_node (@$sftp_nodes) {
        my $urls = array($sftp_node, 'url') || [];
        my $gattr = set2attr($sftp_node),
        my $cmnt = value($sftp_node, 'comment') || "";
        foreach my $url (@$urls) {
            my $uri = new URI($url);
            my $url_wop = hide_password($url, 2);
            my $attr = dclone($gattr);
               $attr->{host} = $uri->host;
               $attr->{port} = $uri->port if $uri->port;
               $attr->{user} = $uri->user if $uri->user;
               $attr->{password} = $uri->password if $uri->password;
            $sftp_storages{$url} = {
                    url     => $url,
                    url_wop => $url_wop,
                    path    => $uri->path,
                    attr    => $attr,
                    comment => join("\n", grep {$_} ($url_wop, $cmnt)),
                    fixup   => value($sftp_node, 'fixup') ? 1 : 0,
                };
            $usesftp++;
        }
    }
    $self->{sftp_storages} = [(values(%sftp_storages))];

    $self->storage_status(STORAGE_SIGN, $usesftp) if $usesftp && $NET_SFTP_FOREIGN;
    #print explain($self->{sftp_storages}), "\n";
    return $self;
}
sub sftp_storages {
    my $self = shift;
    my $storages = $self->{sftp_storages} || [];
    return @$storages;
}
sub test {
    my $self = shift;
    my %params = @_; $self->maybe::next::method(%params);
    my $sign = STORAGE_SIGN;
    return $self->storage_status($sign)
        if is_void($self->sftp_storages()) && $self->storage_status($sign) <= 0; # SKIP
    unless ($NET_SFTP_FOREIGN) { # Not loaded
        $self->{test}->{$sign} = [[$NET_SFTP_FOREIGN_MESSAGE, -1]];
        return $self->storage_status($sign);
    }

    my @test = ();
    foreach my $storage ($self->sftp_storages) {
        my $url_wop = $storage->{url_wop};
        my $attr = $storage->{attr};

        # Create object
        my $sftp = new Net::SFTP::Foreign(%$attr);
        if ($sftp->error) {
            $self->storage_status($sign, 0);
            push @test, [0, $url_wop, sprintf("Can't connect to %s: %s", $url_wop, $sftp->error)];
            next;
        }

        # Change dir
        if (my $path = $storage->{path}) {
            $sftp->setcwd($path) or do {
                $self->storage_status($sign, 0);
                push @test, [0, $url_wop, sprintf("Can't change directory %s on %s: %s", $path, $url_wop, $sftp->error)];
                next;
            };
        }

        # Get pwd
        my $pwd = $sftp->cwd;
        if ($sftp->error) {
            $self->storage_status($sign, 0);
            push @test, [0, $url_wop, sprintf("Can't get cwd on %s: %s", $url_wop, $sftp->error)];