view release on metacpan or  search on metacpan

t/fuguvm/remote.t  view on Meta::CPAN

#!/usr/bin/env perl
# ex:ts=8 sw=4:
# The remote side of one running guest: the argument quoting, the
# local walk, the batching, and the failure shape of put and get.
# No test here opens a real connection: the closed-port tests prove
# the failure path, and a mock SSH object proves the batching.

use v5.36;
use Test::More;
use FindBin qw($RealBin);
use lib "$RealBin/../../lib";
use Fugu::TestLog;
use File::Path qw(make_path);
use File::Temp qw(tempdir);
use IO::Socket::INET;
use POSIX      ();

# The module depends on SSH, which requires Net::SSH2
BEGIN {
    eval { require Net::SSH2 };
    if ($@) {
	plan skip_all => 'Net::SSH2 not available';
    }
}

use_ok('App::FuguVM::Remote');

# A mock transport. The batching tests read the commands that put
# would run, without a guest.
package Mock::SSH {
    sub new ($class) {
	return bless { commands => [], writes => [] }, $class;
    }

    sub run_command ($self, $command) {
	push @{ $self->{commands} }, $command;
	return { stdout => '', stderr => '', exit_code => 0 };
    }

    sub write_file ($self, $path, $content, $mode) {
	push @{ $self->{writes} }, [ $path, $mode ];
	return 0;
    }
}

# ============================================================
# quote_argv
# ============================================================

{
    is(App::FuguVM::Remote->quote_argv('word'), "'word'",
	'a plain word gets single quotes');
    is(App::FuguVM::Remote->quote_argv('a b'), "'a b'",
	'a word with a space stays one word');
    is(App::FuguVM::Remote->quote_argv("it's"), "'it'\\''s'",
	"a single quote becomes the '\\'' form");
    is(App::FuguVM::Remote->quote_argv(''), "''",
	"an empty word becomes ''");
    is(App::FuguVM::Remote->quote_argv('a', 'b', 'c'), "'a' 'b' 'c'",
	'several words join with one space');

    # The strongest proof of the rule is a real shell. sh -c parses
    # the quoted string as the remote login shell would, and printf
    # reports each word that arrives.
    my @words = ('*', '$HOME', 'a;b', 'x&y', '`id`', "it's", 'a b', '');
    my $command =
	App::FuguVM::Remote->quote_argv('printf', '%s\n', @words);
    open my $sh, '-|', 'sh', '-c', $command
	or die "Cannot run sh: $!";
    my @lines = <$sh>;
    close $sh;
    chomp @lines;
    is_deeply(\@lines, \@words,
	'a shell splits the string at the word boundaries only,'
	    . ' with no expansion and no globbing');
}

# ============================================================
# new and run
# ============================================================

{
    my $remote = App::FuguVM::Remote->new(host => '127.0.0.1', port => 2299);
    is($remote->{port}, 2299, 'new stores the port');
    is($remote->{host}, '127.0.0.1', 'new stores the host');

    eval { App::FuguVM::Remote->new(host => '127.0.0.1') };
    like($@, qr/needs a port/, 'new dies with no port');

    eval { App::FuguVM::Remote->new(port => 2299) };
    like($@, qr/needs a host/, 'new dies with no host');

    eval { $remote->run() };
    like($@, qr/argument vector/, 'run dies on an empty vector');
}

# ============================================================