App-SimpleBackuper

 view release on metacpan or  search on metacpan

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

    $sftp->{_write_delay} = $defs{write_delay} || $sftp->{_block_size} * 8;
    $sftp->{_autoflush} = delete $opts{autoflush};
    $sftp->{_late_set_perm} = delete $opts{late_set_perm};
    $sftp->{_dirty_cleanup} = delete $opts{dirty_cleanup};
    $sftp->{_remote_has_volumes} = delete $opts{remote_has_volumes};

    $sftp->{_timeout} = delete $opts{timeout};
    defined $sftp->{_timeout} and $sftp->{_timeout} <= 0 and croak "invalid timeout";

    $sftp->{_fs_encoding} = delete $opts{fs_encoding};
    if (defined $sftp->{_fs_encoding}) {
        $] < 5.008
            and carp "fs_encoding feature is not supported in this perl version $]";
    }
    else {
        $sftp->{_fs_encoding} = 'utf8';
    }

    $sftp->autodisconnect(delete $opts{autodisconnect});

    $backend->_init_transport($sftp, \%opts);
    %opts and _croak_bad_options(keys %opts);

    $sftp->_init unless $sftp->{_error};
    $backend->_after_init($sftp);
    $sftp
}

sub autodisconnect {
    my ($sftp, $ad) = @_;
    if (not defined $ad or $ad == 2) {
        $debug and $debug & 4 and _debug "setting disconnecting pid to $$ and thread to $thread_generation";
        $sftp->{_disconnect_by_pid} = $$;
        $sftp->{_disconnect_by_thread} = $thread_generation;
    }
    else {
        delete $sftp->{_disconnect_by_thread};
        if ($ad == 0) {
            $sftp->{_disconnect_by_pid} = -1;
        }
        elsif ($ad == 1) {
            delete $sftp->{_disconnect_by_pid};
        }
        else {
            croak "bad value '$ad' for autodisconnect";
        }
    }
    1;
}

sub disconnect {
    my $sftp = shift;
    my $pid = delete $sftp->{pid};

    $debug and $debug & 4 and _debug("$sftp->disconnect called (ssh pid: ".($pid||'').")");

    local $sftp->{_autodie};
    $sftp->_conn_lost;

    if (defined $pid) {
        close $sftp->{ssh_out} if (defined $sftp->{ssh_out} and not $sftp->{_ssh_out_is_not_dupped});
        close $sftp->{ssh_in} if defined $sftp->{ssh_in};
        if ($windows) {
	    kill KILL => $pid
                and waitpid($pid, 0);
            $debug and $debug & 4 and _debug "process $pid reaped";
        }
        else {
	    my $dirty = ( defined $sftp->{_dirty_cleanup}
                          ? $sftp->{_dirty_cleanup}
                          : $dirty_cleanup );

	    if ($dirty or not defined $dirty) {
                $debug and $debug & 4 and _debug("starting dirty cleanup of process $pid");
            OUT: for my $sig (($dirty ? () : 0), qw(TERM TERM KILL KILL)) {
                    $debug and $debug & 4 and _debug("killing process $pid with signal $sig");
		    $sig and kill $sig, $pid;

                    local ($@, $SIG{__DIE__}, $SIG{__WARN__});
                    my $deadline = Time::HiRes::time + 8;
                    my $dt = 0.01;
                    while (Time::HiRes::time < $deadline) {
                        my $wpr = waitpid($pid, POSIX::WNOHANG());
                        $debug and $debug & 4 and _debug("waitpid returned ", $wpr);
                        last OUT if $wpr or $! == Errno::ECHILD();
                        Time::HiRes::sleep($dt);
                        $dt *= 1.2;
                    }
		}
	    }
	    else {
		while (1) {
		    last if waitpid($pid, 0) > 0;
		    if ($! != Errno::EINTR()) {
			warn "internal error: unexpected error in waitpid($pid): $!"
			    if $! != Errno::ECHILD();
			last;
		    }
		}
	    }
            $debug and $debug & 4 and _debug "process $pid reaped";
        }
    }
    close $sftp->{_pty} if defined $sftp->{_pty};
    1
}

sub DESTROY {
    local ($?, $!, $@);

    my $sftp = shift;
    my $dbpid = $sftp->{_disconnect_by_pid};
    my $dbthread = $sftp->{_disconnect_by_thread};

    $debug and $debug & 4 and _debug("$sftp->DESTROY called (current pid: $$, disconnect_by_pid: " .
                                     ($dbpid || '') .
                                     "), current thread generation: $thread_generation, disconnect_by_thread: " .
                                     ($dbthread || '') . ")");

    if (!defined $dbpid or ($dbpid == $$ and $dbthread == $thread_generation)) {
        $sftp->disconnect

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

                                   str => $extension,
                                   str => $arg);

    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_EXTENDED_REPLY, $id,
                                            SFTP_ERR_REMOTE_STATVFS_FAILED,
                                            "Couldn't stat remote file system")) {
        my %statvfs = map { $_ => $msg->get_int64 } qw(bsize frsize blocks
                                                       bfree bavail files ffree
                                                       favail fsid flag namemax);
        return \%statvfs;
    }
    return undef;
}

sub fstatvfs {
    _deprecated "fstatvfs is deprecated and will be removed on the upcoming 2.xx series, "
        . "statvfs method accepts now both file handlers and paths";
    goto &statvfs;
}

package Net::SFTP::Foreign::Handle;

use Tie::Handle;
our @ISA = qw(Tie::Handle);
our @CARP_NOT = qw(Net::SFTP::Foreign Tie::Handle);

my $gen_accessor = sub {
    my $ix = shift;
    sub {
	my $st = *{shift()}{ARRAY};
	if (@_) {
	    $st->[$ix] = shift;
	}
	else {
	    $st->[$ix]
	}
    }
};

my $gen_proxy_method = sub {
    my $method = shift;
    sub {
	my $self = $_[0];
	$self->_check
	    or return undef;

	my $sftp = $self->_sftp;
	if (wantarray) {
	    my @ret = $sftp->$method(@_);
	    $sftp->_set_errno unless @ret;
	    return @ret;
	}
	else {
	    my $ret = $sftp->$method(@_);
	    $sftp->_set_errno unless defined $ret;
	    return $ret;
	}
    }
};

my $gen_not_supported = sub {
    sub {
	$! = Errno::ENOTSUP();
	undef
    }
};

sub TIEHANDLE { return shift }

# sub UNTIE {}

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift || 0;

    my $self = Symbol::gensym;
    bless $self, $class;
    *$self = [ $sftp, $rid, 0, $flags, @_];
    tie *$self, $self;

    $self;
}

sub _close {
    my $self = shift;
    @{*{$self}{ARRAY}} = ();
}

sub _check {
    return 1 if defined(*{shift()}{ARRAY}[0]);
    $! = Errno::EBADF();
    undef;
}

sub FILENO {
    my $self = shift;
    $self->_check
	or return undef;

    my $hrid = unpack 'H*' => $self->_rid;
    "-1:sftp(0x$hrid)"
}

sub _sftp { *{shift()}{ARRAY}[0] }
sub _rid { *{shift()}{ARRAY}[1] }

* _pos = $gen_accessor->(2);

sub _inc_pos {
    my ($self, $inc) = @_;
    *{shift()}{ARRAY}[2] += $inc;
}


my %flag_bit = (append => 0x1);

sub _flag {
    my $st = *{shift()}{ARRAY};
    my $fn = shift;

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

}

sub EOF {
    my $self = $_[0];
    $self->_check or return undef;
    my $sftp = $self->_sftp;
    my $ret = $sftp->eof($self);
    $sftp->_set_errno unless defined $ret;
    $ret;
}

*GETC = $gen_proxy_method->('getc');
*TELL = $gen_proxy_method->('tell');
*SEEK = $gen_proxy_method->('seek');
*CLOSE = $gen_proxy_method->('close');

my $readline = $gen_proxy_method->('readline');
sub READLINE { $readline->($_[0], $/) }

sub OPEN {
    shift->CLOSE;
    undef;
}

sub DESTROY {
    local ($@, $!, $?);
    my $self = shift;
    my $sftp = $self->_sftp;
    $debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'<undef>').")");
    if ($self->_check and $sftp) {
        local $sftp->{_autodie};
	$sftp->_close_save_status($self)
    }
}

package Net::SFTP::Foreign::DirHandle;
our @ISA = qw(Net::SFTP::Foreign::Handle IO::Dir);

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift;

    my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, []);
}


sub _check_is_dir {}

sub _cache { *{shift()}{ARRAY}[4] }

*CLOSEDIR = $gen_proxy_method->('closedir');
*READDIR = $gen_proxy_method->('_readdir');

sub OPENDIR {
    shift->CLOSEDIR;
    undef;
}

*REWINDDIR = $gen_not_supported->();
*TELLDIR = $gen_not_supported->();
*SEEKDIR = $gen_not_supported->();

sub DESTROY {
    local ($@, $!, $?);
    my $self = shift;
    my $sftp = $self->_sftp;

    $debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")");

    if ($self->_check and $sftp) {
        local $sftp->{_autodie};
	$sftp->_closedir_save_status($self)
    }
}

1;
__END__

=head1 NAME

Net::SFTP::Foreign - SSH File Transfer Protocol client

=head1 SYNOPSIS

    use Net::SFTP::Foreign;
    my $sftp = Net::SFTP::Foreign->new($host);
    $sftp->die_on_error("Unable to establish SFTP connection");

    $sftp->setcwd($path) or die "unable to change cwd: " . $sftp->error;

    $sftp->get("foo", "bar") or die "get failed: " . $sftp->error;

    $sftp->put("bar", "baz") or die "put failed: " . $sftp->error;

=head1 DESCRIPTION

SFTP stands for SSH File Transfer Protocol and is a method of
transferring files between machines over a secure, encrypted
connection (as opposed to regular FTP, which functions over an
insecure connection). The security in SFTP comes through its
integration with SSH, which provides an encrypted transport layer over
which the SFTP commands are executed.

Net::SFTP::Foreign is a Perl client for the SFTP version 3 as defined
in the SSH File Transfer Protocol IETF draft, which can be found at
L<http://www.openssh.org/txt/draft-ietf-secsh-filexfer-02.txt> (also
included on this package distribution, on the C<rfc> directory).

Net::SFTP::Foreign uses any compatible C<ssh> command installed on
the system (for instance, OpenSSH C<ssh>) to establish the secure
connection to the remote server.

A wrapper module L<Net::SFTP::Foreign::Compat> is also provided for
compatibility with L<Net::SFTP>.


=head2 Net::SFTP::Foreign Vs. Net::SFTP Vs. Net::SSH2::SFTP

Why should I prefer Net::SFTP::Foreign over L<Net::SFTP>?

Well, both modules have their pros and cons: