view release on metacpan or  search on metacpan

lib/Net/SSH/Any/OS/POSIX.pm  view on Meta::CPAN

                    }
                }
                if ($cin and vec($wv1, $fnoin, 1)) {
                    my $written = syswrite($in, $data->[0], 20480);
                    $debug and $debug & 64 and _debug "stdin, bytes written: ", $written;
                    if ($written) {
                        substr($data->[0], 0, $written, '');
                        next FAST if length $data->[0];
                        shift @$data;
                        next FAST if @$data;
                        # fallback when stdin queue is exhausted
                    }
                    elsif (grep $! == $_, @retriable) {
                        next FAST;
                    }
                    close $in;
                    undef $cin;
                    $recalc_vecs = 1;
                }
            }
            else {
                next if $n < 0 and grep $! == $_, @retriable;
                $any->_set_error(SSHA_TIMEOUT_ERROR, 'slave command timed out');
                last MLOOP;
            }
        }
    }
    close $out if $cout;
    close $err if $cerr;
    close $in if $cin;

    $any->_wait_ssh_proc($proc, $timeout);

    $debug and $debug & 1024 and _debug "leaving io3()";
    return ($bout, $berr);
}

my @base_app_dirs = qw(/usr/lib /opt /usr/local);

sub find_cmd_by_app {
    my ($any, $name, $app) = @_;
    $app = $app->{POSIX} if ref $app;
    if (defined $app) {
        for my $app ($app, lc($app)) {
            for my $base (@base_app_dirs) {
                my $app_dir = "$base/$app";
                if (-d $app_dir) {
                    for my $bin (qw(bin sbin libexec .)) {
                        my $path = $any->_os_validate_cmd("$app_dir/$bin/$name");
                        defined $path and return $path;
                    }
                }
            }
        }
    }
    ()
}

sub find_user_dirs {
    my $any = shift;
    my $home = (getpwuid $<)[7];
    my @dirs;
    for my $name (@_) {
        my $posix_name = (ref $name ? $name->{POSIX} : $name);
        if (defined $posix_name and
            defined $home) {
            push @dirs, join('/', $home, $posix_name)
        }
    }
    grep -d $_, @dirs;
}

sub set_file_inherit_flag {
    my ($any, $file, $value) = @_;
    $debug and $debug & 1024 and _debug "setting inherit flag for file $file (",fileno($file),") to $value";
    my $flags = fcntl($file, Fcntl::F_GETFL(), 0);
    if ($value) {
        $flags &= ~Fcntl::FD_CLOEXEC();
    }
    else {
        $flags |= Fcntl::FD_CLOEXEC();
    }
    fcntl($file, Fcntl::F_SETFL(), $flags);
    1;
}

my $unique_ix = 0;

sub create_secret_file {
    my ($any, $name, $data) = @_;
    my $home = (getpwuid $<)[7];
    unless (defined $home) {
        $any->_os_set_error(SSHA_LOCAL_IO_ERROR, "Unable to determine user home directory: $!");
        return;
    }
    my $base = File::Spec->rel2abs('.libssh-net-any-perl', $home);
    mkdir $base, 0700 unless -d $base;
    unless (do { local $!; -d $base }) {
        $any->_or_set_error(SSHA_LOCAL_IO_ERROR, "Unable to create private directory $base: $!");
        return;
    }

    $name = File::Spec->rel2abs($name, $base);

    my $ext = '';
    if ($name =~ m|(.*)(\.[^/]*)$|) {
        $name = $1;
        $ext = $2;
    }

    while (1) {
        my $final = join("-", $name, $$, $unique_ix++, int rand 1000).$ext;
        if (sysopen(my $fh, $final,
		    Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),
		    Fcntl::S_IRUSR()|Fcntl::S_IWUSR())) {
            print {$fh} $data;
            return $final if close $fh;
            $any->_or_set_error(SSHA_LOCAL_IO_ERROR, "Unable to write secret file $final: $!");
            unlink $final;
            return;
        }
        unless ($! == Errno::EEXIST()) {
            $any->_or_set_error(SSHA_LOCAL_IO_ERROR, "Unable to create secret file $final: $!");
            return;
        }
    }
}

sub unix_path { $_[1] }

sub version { 'POSIX' }

1;