view release on metacpan or  search on metacpan

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

# ex:ts=8 sw=4:
# $OpenBSD$
#
# Copyright (c) 2026 Dick Olsson <hi@dickolsson.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use v5.36;

# App::FuguVM::Autoinstall - serve one autoinstall(8) response file.
#
# The module holds the response file and the responder: a small HTTP
# child that answers that one file to one guest. The child binds the
# loopback address only, because a response file can hold the root
# password, and the guest reaches a loopback listener through the QEMU
# gateway. The module is FuguVM policy over generic parts: the file it
# serves is an installer artifact, and the address it serves to is a
# QEMU gateway. Fugu::Proxy stays a proxy, and it gains no
# origin-server mode here.

package App::FuguVM::Autoinstall;
our $VERSION = '0.3.0';

use IO::Socket::INET;
use Fugu::File;
use Fugu::Log;
use Fugu::Process;
use Fugu::Timeout;
use App::FuguVM::Proxy;

use constant {
	RESPONSE_PATH => '/install.conf',

	# One range above the proxy range, so the two children cannot
	# contend for one port.
	PORTS => [ 8181, 8280 ],

	BIND_ADDRESS  => '127.0.0.1',
	PROXY_TOKEN   => '@PROXY_URL@',
	READY_TIMEOUT => 10,

	# The bound on one request line. The guest sends one short GET,
	# so a longer line is not a request from the installer.
	MAX_REQUEST_LINE => 8192,
};

# App::FuguVM::Autoinstall->new(%args):
#	file      => $path	the response file (required)
#	pidfile   => $pidfile	a Fugu::Pidfile for the child (required)
#	store     => $store	a Fugu::StateFile that holds the port (required)
#	proxy_url => $url	replaces each PROXY_TOKEN, or undef
#	logfile   => $path	where the output of the child goes
#	log       => $logger	default: Fugu::Log->default
#
#	The constructor opens nothing.
sub new ( $class, %args )
{
	for my $required (qw(pidfile store)) {
		die "$required parameter required"
		    unless defined $args{$required};
	}

	return bless {
		file      => $args{file},
		pidfile   => $args{pidfile},
		store     => $args{store},
		proxy_url => $args{proxy_url},
		logfile   => $args{logfile} // '/dev/null',
		log       => $args{log}     // Fugu::Log->default,
		error     => undef,
	}, $class;
}

# $self->path:
#	Return the response-file path.
sub path ($self)
{
	return $self->{file};
}

# $self->error:
#	Return the reason of the last failed start, or undef.
sub error ($self)
{
	return $self->{error};
}

# $self->port:

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

		last if index( $head, "\n\n" ) >= 0;
	}
	return '' if $head eq '';
	return    if length($head) >= MAX_REQUEST_LINE;

	my $end = index( $head, "\n" );
	return if $end < 0;

	my $line = substr( $head, 0, $end );
	$line =~ s/\r\z//;

	return $line;
}

# _respond($client, $code, $text, $body, $head_only):
#	Write one complete answer. Every answer carries Content-Length
#	and Connection: close, and a HEAD answer carries the headers
#	only.
sub _respond ( $client, $code, $text, $body, $head_only = 0 )
{
	my $head =
	      "HTTP/1.1 $code $text\r\n"
	    . "Content-Type: text/plain\r\n"
	    . 'Content-Length: '
	    . length($body) . "\r\n"
	    . "Connection: close\r\n\r\n";
	$head .= $body unless $head_only;

	return Fugu::File->_write_all( $client, $head, 'client socket' );
}

# $self->_find_free_port:
#	Return the first port of the range that binds on the loopback
#	address, or undef.
sub _find_free_port ($self)
{
	my ( $first, $last ) = @{ +PORTS };

	for my $port ( $first .. $last ) {
		my $sock = IO::Socket::INET->new(
			LocalAddr => BIND_ADDRESS,
			LocalPort => $port,
			Proto     => 'tcp',
			ReuseAddr => 1,
			Listen    => 1,
		) or next;
		close $sock;
		return $port;
	}

	return;
}

# $self->_wait_ready:
#	Wait until the responder takes a connection.
sub _wait_ready ($self)
{
	my $port = $self->port;
	return 0 if !defined $port;

	my $ready = Fugu::Timeout::wait_until(
		READY_TIMEOUT,
		0.2,
		sub {
			my $sock = IO::Socket::INET->new(
				PeerAddr => BIND_ADDRESS,
				PeerPort => $port,
				Proto    => 'tcp',
				Timeout  => 1,
			) or return 0;
			close $sock;
			return 1;
		} );

	return $ready ? 1 : 0;
}

1;