view release on metacpan or  search on metacpan

lib/App/FuguVM/Remote.pm  view on Meta::CPAN

package App::FuguVM::Remote;
our $VERSION = '0.2.0';

use File::Basename;
use File::Find ();
use Fugu::File;
use Fugu::Log;
use Fugu::SSH;

# App::FuguVM::Remote - the remote side of one running guest.
#
# The module owns the Fugu::SSH object, the argument quoting, the
# local walk, and the publish order. Thus App::FuguVM::CLI keeps thin
# command bodies, and one module holds the session timeout.

use constant {

	# Seconds. Fugu::SSH bounds the connect and the channel read
	# with this one value. The value holds a guest build and a
	# large transfer, and it still ends a hang.
	SSH_TIMEOUT => 3600,

	# Bytes, for one file. write_file and read_file each hold a
	# file in memory, so the cap fails closed.
	MAX_TRANSFER_SIZE => 64 * 1024 * 1024,

	# Paths for each batched remote command, so no command line
	# grows too long.
	BATCH_PATHS => 100,
};

# The caller must give a host and a port. A missing value is a
# programming error, because App::FuguVM::CLI resolves both before it
# builds the object.
sub new ( $class, %args )
{
	die "App::FuguVM::Remote->new needs a host\n"
	    if !defined $args{host};
	die "App::FuguVM::Remote->new needs a port\n"
	    if !defined $args{port};

	my $self = bless {
		host => $args{host},
		port => $args{port},
		ssh  => Fugu::SSH->new(
			host    => $args{host},
			port    => $args{port},
			user    => 'root',
			timeout => SSH_TIMEOUT,
		),
	}, $class;

	return $self;
}

# $class_or_self->quote_argv(@argv):
#	Return one remote command string. Each word gets single
#	quotes, and a single quote inside a word becomes the '\''
#	form. An empty word becomes ''. The words join with one
#	space. So the remote shell splits the string at the word
#	boundaries only: it expands nothing, and it globs nothing.
sub quote_argv ( $, @argv )
{
	my @words;
	for my $word (@argv) {
		my $quoted = $word;
		$quoted =~ s/'/'\\''/g;
		push @words, "'$quoted'";
	}

	return join ' ', @words;
}

# $self->run(@argv):
#	Run one argument vector on the guest. The method returns the
#	hash of Fugu::SSH->run_command. An empty vector is a
#	programming error.
sub run ( $self, @argv )
{
	die "App::FuguVM::Remote->run needs an argument vector\n"
	    if !@argv;

	return $self->{ssh}->run_command( $self->quote_argv(@argv) );
}

# $self->interactive:
#	Open an interactive session. The method returns the exit code
#	of ssh(1).
sub interactive ($self)
{
	return $self->{ssh}->interactive;
}

# $self->put($local, $remote, %args):
#	Copy a local file or a local directory to $remote in the
#	guest. $remote is never a container: the content of a
#	directory arrives under $remote, with no component for the
#	source directory name. %args takes 'mode', the mode of each
#	file that the method writes. Without it each file keeps its
#	local permission bits, masked with 0777.
#
#	The method creates every remote directory first, writes each
#	file to a temporary name beside its destination, and then
#	publishes every temporary file with mv -f. A failure removes
#	every temporary file, so a failed run leaves no partial
#	destination file. The method returns 1, or undef.
sub put ( $self, $local, $remote, %args )
{
	my $entries = $self->_entries( $local, $remote, $args{mode} );
	return if !defined $entries;

	my @dirs  = grep { $_->{type} eq 'dir' } @$entries;
	my @files = grep { $_->{type} eq 'file' } @$entries;

	return if @dirs && !$self->_mkdir( map { $_->{dest} } @dirs );

	my @temps;
	for my $entry (@files) {
		my $temp = "$entry->{dest}.fuguvm.$$";

		my $content = Fugu::File->read( $entry->{source} );