view release on metacpan or  search on metacpan

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

package Net::SFTP::Foreign::Backend::Unix;

our $VERSION = '1.88_02';

use strict;
use warnings;

use Carp;
our @CARP_NOT = qw(Net::SFTP::Foreign);

use Fcntl qw(O_NONBLOCK F_SETFL F_GETFL);
use POSIX ();
use Net::SFTP::Foreign::Helpers qw(_tcroak _ensure_list _debug _hexdump $debug);
use Net::SFTP::Foreign::Constants qw(SSH2_FX_BAD_MESSAGE
				     SFTP_ERR_REMOTE_BAD_MESSAGE);
use Time::HiRes qw(sleep time);

sub _new { shift }

sub _defaults {
   ( queue_size => 32 )
}

sub _init_transport_streams {
    my (undef, $sftp) = @_;
    for my $dir (qw(ssh_in ssh_out)) {
	binmode $sftp->{$dir};
	my $flags = fcntl($sftp->{$dir}, F_GETFL, 0);
	fcntl($sftp->{$dir}, F_SETFL, $flags | O_NONBLOCK);
    }
}

sub _open_dev_null {
    my $sftp = shift;
    my $dev_null;
    unless (open $dev_null, '>', "/dev/null") {
	$sftp->_conn_failed("Unable to redirect stderr to /dev/null");
	return;
    }
    $dev_null
}

sub _fileno_dup_over {
    my ($good_fn, $fh) = @_;
    if (defined $fh) {
        my @keep_open;
        my $fn = fileno $fh;
        for (1..5) {
            $fn >= $good_fn and return $fn;
            $fn = POSIX::dup($fn);
            push @keep_open, $fn;
        }
        POSIX::_exit(255);
    }
    undef;
}

sub _open4 {
    my $backend = shift;
    my $sftp = shift;
    my ($dad_in, $dad_out, $child_in, $child_out);
    unless (pipe ($dad_in, $child_out) and
            pipe ($child_in, $dad_out)) {
        $sftp->_conn_failed("Unable to created pipes: $!");
        return;
    }
    my $pid = fork;
    unless ($pid) {
        unless (defined $pid) {
            $sftp->_conn_failed("Unable to fork new process: $!");
            return;
        }
        close ($dad_in);
        close ($dad_out);

        shift; shift;
        my $child_err = shift;
        my $pty = shift;

        $pty->make_slave_controlling_terminal if defined $pty;

        my $child_err_fno = eval { no warnings; fileno($child_err  ? $child_err : *STDERR) };
        my $child_err_safe; # passed handler may be tied, so we
                            # duplicate it in order to get a plain OS
                            # handler.
        if (defined $child_err_fno and $child_err_fno >= 0) {
            open $child_err_safe, ">&=$child_err_fno" or POSIX::_exit(1);