view release on metacpan or  search on metacpan

lib/Net/OpenSSH/More.pm  view on Meta::CPAN

package Net::OpenSSH::More;
$Net::OpenSSH::More::VERSION = '1.01';
#ABSTRACT: Net::OpenSSH submodule with many useful features

use strict;
use warnings;

use parent 'Net::OpenSSH';

use Data::UUID         ();
use Expect             ();
use File::HomeDir      ();
use File::Temp         ();
use Fcntl              ();
use IO::Pty            ();
use IO::Socket::INET   ();
use IO::Socket::INET6  ();
use IO::Stty           ();
use List::Util         qw{first};
use Net::DNS::Resolver ();
use Net::IP            ();
use Time::HiRes        ();
use Term::ANSIColor    ();


my %defaults = (
    'user'                 => $ENV{'USER'} || getpwuid($>),
    'port'                 => 22,
    'use_persistent_shell' => 0,
    'output_prefix'        => '',
    'home'                 => File::HomeDir->my_home,
    'retry_interval'       => 6,
    'retry_max'            => 10,
);

our %cache;
our $disable_destructor = 0;

###################
# PRIVATE METHODS #
###################

my $die_no_trace = sub {
    my ( $full_msg, $summary ) = @_;
    $summary ||= 'FATAL';
    my $carp = $INC{'Carp/Always.pm'} ? '' : ' - Use Carp::Always for full trace.';
    die "[$summary] ${full_msg}${carp}";
};

my $check_local_perms = sub {
    my ( $path, $expected_mode, $is_dir ) = @_;
    $is_dir //= 0;
    my @stat = stat($path);
    $die_no_trace->(qq{"$path" must be a directory that exists}) unless !$is_dir ^ -d _;
    $die_no_trace->(qq{"$path" must be a file that exists})      unless $is_dir ^ -f _;
    $die_no_trace->(qq{"$path" could not be read})               unless -r _;

    my $actual_mode = $stat[2] & 07777;
    $die_no_trace->( sprintf( qq{Permissions on "$path" are not correct: got=0%o, expected=0%o}, $actual_mode, $expected_mode ) ) unless $expected_mode eq $actual_mode;
    return 1;
};

my $resolve_login_method = sub {
    my ($opts) = @_;

    my $chosen = first { $opts->{$_} } qw{key_path password};
    $chosen //= '';
    undef $chosen          if $chosen eq 'key_path' && !$check_local_perms->( $opts->{'key_path'}, 0600 );
    return $chosen         if $chosen;
    return 'SSH_AUTH_SOCK' if $ENV{'SSH_AUTH_SOCK'};
    my $fallback_path = "$opts->{'home'}/.ssh/id";
    my $key_type      = first { -s "${fallback_path}_$_" } qw{ed25519 ecdsa rsa dsa};
    $opts->{'key_path'} = "${fallback_path}_${key_type}" if defined $key_type;

    $die_no_trace->('No key_path or password specified and no active SSH agent; cannot connect') if !$opts->{'key_path'};
    $check_local_perms->( $opts->{'key_path'}, 0600 )                                            if $opts->{'key_path'};

    return $opts->{'key_path'};
};

my $get_dns_record_from_hostname = sub {
    my ( $hostname, $record_type ) = @_;
    $record_type ||= 'A';

    my $reply = Net::DNS::Resolver->new()->search( $hostname, $record_type );
    return unless $reply;
    return { map { $_->type() => $_->address() } grep { $_->type eq $record_type } ( $reply->answer() ) };