File Coverage

blib/lib/Sys/Async/Virt/Connection/SSH.pm

Criterion	Covered	Total	%
statement	26	67	38.8
branch	0	20	0.0
condition	0	12	0.0
subroutine	9	14	64.2
pod	2	4	50.0
total	37	117	31.6

####################################################################
#
#     This file was generated using XDR::Parse version v1.0.1
#                   and LibVirt version v12.1.0
#
#      Don't edit this file, use the source template instead
#
#                 ANY CHANGES HERE WILL BE LOST !
#
####################################################################


use v5.26;
use warnings;
use experimental 'signatures';
use Future::AsyncAwait;
use Object::Pad ':experimental(inherit_field)';

class Sys::Async::Virt::Connection::SSH v0.6.1;

inherit Sys::Async::Virt::Connection::Process;

use Carp qw(croak);
use Log::Any qw($log);

use Protocol::Sys::Virt::UNIXSocket v12.1.0; # imports socket_path
use Protocol::Sys::Virt::URI v12.1.0; # imports parse_url

field $_socket   :reader :param = undef;
field $_readonly :reader :param;

sub shell_escape($val) {
    if ($val !~ m/[\s!"'`$<>#&*?;\\\[\]{}()~|^]/) { # no shell chars
        return $val;
    }

    return (q|'| . ($val =~ s/'/'\\''/gr) . q|'|);
}

my $nc_proxy =
    q{if %1$s -q 2>&1 | grep "requires an argument" >/dev/null 2>&1; } .
    q{then A=-q0; } .
    q{else A=; } .
    q{fi; } .
    q{%1$s $A -U %2$s};

my $native_proxy =
    q{virt-ssh-helper %s};

my $auto_proxy =
    q{if which virt-ssh-helper >/dev/null 2>&1; } .
    q{then %s; } .
    q{else %s; } .
    q{fi};

method _command( $url ) {
    my %c = parse_url( $url );
    my @args =  ('-e', 'none');
    push @args, ('-p', $c{port}) if $c{port};
    push @args, ('-l', $c{username}) if $c{username};
    push @args, ('-i', $c{query}->{keyfile}) if $c{query}->{keyfile};
    push @args, ('-o', 'StrictHostKeyChecking=no') if $c{query}->{no_verify};
    push @args, ('-T') if $c{query}->{no_tty};

    my $remote_cmd;
    my $proxy_mode  = $c{query}->{proxy} // 'auto';
    my $socket_path = $_socket // $c{query}->{socket} //
        socket_path(readonly => $_readonly,
                    hypervisor => $c{hypervisor},
                    mode => $c{query}->{mode},
                    type => $c{type});

    my $nc_command = sprintf($nc_proxy,
                             $c{query}->{netcat} // 'nc',
                             $socket_path);
    my $native_command = 'virt-ssh-helper ';
    $native_command .= '-r ' if $_readonly;

    # $c{proxy} is the URL to use on the proxy
    $native_command .= shell_escape($c{proxy});
    if ($proxy_mode eq 'netcat') {
        $remote_cmd = sprintf(q|sh -c %s|, shell_escape($nc_command));
    }
    elsif ($proxy_mode eq 'native') {
        $remote_cmd = $native_command;
    }
    elsif ($proxy_mode eq 'auto') {
        $remote_cmd = sprintf(q|sh -c %s|,
                              shell_escape(sprintf($auto_proxy,
                                                   $native_command,
                                                   $nc_command)));
    }
    else {
        croak $log->fatal( "Unknown proxy mode '$proxy_mode'" );
    }

    $log->trace("SSH remote command: $remote_cmd");

    my $local_cmd  = $c{query}->{command} // 'ssh';
    my @cmd = ($local_cmd, @args, '--', $c{host}, $remote_cmd);

    return @cmd;
}

method is_secure() {
    return 1;
}

1;


__END__