view release on metacpan or  search on metacpan

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

# ex:ts=8 sw=4:
# $OpenBSD$
#
# Copyright (c) 2024 Dick Olsson <hi@senzilla.io>
#
# 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;

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

use Fugu::Log;
use Fugu::Proxy;

our @ISA = ('Fugu::Proxy');

# App::FuguVM::Proxy - the OpenBSD mirror policy over Fugu::Proxy.
#
# The generic proxy holds the serve loop, the cache and the metadata.
# This file holds only what is true of an OpenBSD mirror and of a QEMU
# guest: which URL is worth keeping, how to prune a release that is no
# longer in use, the address that the guest reaches the host by, and
# the port range.

# QEMU user-mode networking puts the host at this address. A guest
# that fetches through the proxy names it, and no other address
# reaches back out of the SLIRP network.
use constant HOST_GATEWAY => '10.0.2.2';

# $class->run_child($port, $cache_dir):
#	The entry point of the spawned child. The child builds its own
#	cache, warms the metadata, and serves until a SIGTERM.
#
#	The spawn passes a fixed argument list, so the distfile cap
#	reaches the child through the environment, which it inherits
#	from fuguvm. An absent variable means 0, and 0 turns the
#	distfile cache off.
sub run_child ( $class, $port, $cache_dir )
{
	my $log = Fugu::Log->new( mode => 'stderr', level => 'debug' );

	my $limit = $ENV{FUGUVM_DISTFILE_LIMIT} // 0;
	$limit = 0 if $limit !~ /\A[0-9]+\z/;

	my $self = bless {
		cache => App::FuguVM::Proxy::Cache->new( $cache_dir, $limit ),
		meta  => Fugu::Proxy::Meta->new,
		log   => $log,
	}, $class;

	$log->info( 'Proxy starting on port %d', $port );
	$log->info( 'Cache directory: %s',       $cache_dir );

	$self->warm;

	return $self->serve($port);
}

# $self->guest_url:
#	Return the proxy URL as the guest reaches it, through the QEMU
#	gateway. The loopback address serves the same proxy, but a
#	guest cannot reach it. The method returns undef while the
#	proxy does not run: a port that a crash left behind is not a
#	reachable proxy.
sub guest_url ($self)
{
	return if !$self->is_running;

	my $port = $self->port;
	return if !defined $port;

	return 'http://' . HOST_GATEWAY . ":$port";
}

package App::FuguVM::Proxy::Cache;
our $VERSION = '0.2.0';

use Fugu::Log;
use Fugu::Proxy;

our @ISA = ('Fugu::Proxy::Cache');

# App::FuguVM::Proxy::Cache - which parts of an OpenBSD mirror to keep.
#
# The patterns are the release tree, the packages, the syspatch sets,
# the source tarballs and the files that an installer reads. Every one
# of them is version-scoped, so nothing here outlives the release it
# belongs to. That is what makes prune safe.
#
# The distfile tree is the one exception: a distfile belongs to a
# port and not to a release, so no version scopes it and prune leaves
# it. The distfile cap of trim_distfiles is its bound instead, and
# the tree is cacheable only while the cap is above zero.

my @CACHEABLE = (
	qr{/pub/OpenBSD/\d+\.\d+/\w+/.*\.(tgz|img|gz)$},    # File sets
	qr{/pub/OpenBSD/syspatch/.*\.tgz$},                 # Patches
	qr{/pub/OpenBSD/\d+\.\d+/packages/\w+/.*\.tgz$},    # Packages
	qr{/pub/OpenBSD/\d+\.\d+/\w+/SHA256(\.sig)?$},      # Checksums
	qr{/pub/OpenBSD/\d+\.\d+/\w+/miniroot\d+\.img$},    # Miniroot images