view release on metacpan or  search on metacpan

lib/Brackup/Target/Sftp.pm  view on Meta::CPAN

package Brackup::Target::Sftp;
use strict;
use warnings;
use base 'Brackup::Target::Filebased';
use File::Basename;
use Net::SFTP::Foreign 1.57;                    # versions <= 1.56 emit warnings
use Net::SFTP::Foreign::Constants qw(:flags);

sub new {
    my ($class, $confsec) = @_;
    my $self = $class->SUPER::new($confsec);

    $self->{path} = $confsec->value("path") or die 'No path specified';
    $self->{nocolons} = $confsec->value("no_filename_colons");
    $self->{nocolons} = $self->_default_nocolons unless defined $self->{nocolons};

    $self->{sftp_host} = $confsec->value("sftp_host") or die 'No "sftp_host"';
    $self->{sftp_port} = $confsec->value("sftp_port");
    $self->{sftp_user} = $confsec->value("sftp_user") || (getpwuid($<))[0] 
        or die "No sftp_user specified";

    $self->_common_new;

    return $self;
}

sub new_from_backup_header {
    my ($class, $header) = @_;
    my $self = bless {}, $class;

    $self->{sftp_host} = $header->{'SftpHost'};
    $self->{sftp_user} = $header->{'SftpUser'};
    $self->{sftp_port} = $header->{'SftpPort'} if $header->{'SftpPort'};
    $self->{path} = $header->{'BackupPath'} or
        die "No BackupPath specified in the backup metafile.\n";
    $self->{nocolons} = $header->{"NoColons"};
    $self->{nocolons} = $self->_default_nocolons unless defined $self->{nocolons};

    $self->_common_new;

    return $self;
}

sub _common_new {
    my ($self) = @_;
    $self->{retry_wait} = int($ENV{SFTP_RETRY_WAIT} || 10);
    $self->_connect();
}

sub backup_header {
    my ($self) = @_;
    return {
        "BackupPath" => $self->{path},
        "SftpHost" => $self->{sftp_host},
        "SftpUser" => $self->{sftp_user},
        "NoColons" => $self->nocolons,
        $self->{sftp_port} ? ("SftpPort" => $self->{sftp_port}) : (),
    };
}

sub _default_nocolons { 
    return 1;        # Can't assume remote OS allows colons
}

sub nocolons {
    my ($self) = @_;
    return defined $self->{nocolons} ? $self->{nocolons} : $self->_default_nocolons;
}

sub _connect {
    my ($self) = @_;

    $self->{sftp} = Net::SFTP::Foreign->new(
        $self->{sftp_host}, 
        user => $self->{sftp_user},
        $self->{sftp_port} ? (port => $self->{sftp_port}) : (),
    );
    $self->{sftp}->error and die $self->{sftp}->error;
}