Build guest posts out of libvirt, rather than out of the datastore

A post type can now say its posts come from somewhere else:

    "x-tcms-datasource": "Trog::DataSource::Virt"

A series of that type lists the guests of whichever hypervisor posts its
relations pulled in -- so the guests type is nothing but that declaration, a
relation to hypervisor.tx, and a template. The posts are rebuilt on every view;
the guests are the source of truth and nothing is written back.

The hook in posts() is a hook and not a detour: a type declaring no datasource
takes exactly one hash lookup and keeps its own posts. What it will load is
restricted to Trog::DataSource::*, because a sidecar is a file on disk and must
not be able to make us require an arbitrary module.

Screenshots are served from their own route rather than inlined, so a page of
ten guests renders in one round trip and the browser fetches the consoles in
parallel. They are cached on disk for thirty seconds -- console captures change
slowly and cost a round trip each. qemu hands them back as PNG already, so the
image dependency we thought this needed turned out to be unnecessary.

A hypervisor we cannot reach becomes a post saying so. That is not defensive
programming for its own sake: these connections go over ssh and they do fail,
and a page that silently omits half your infrastructure is worse than one that
tells you a link is down.

On safety: libvirt forbids virDomainScreenshot on a read-only connection, so
the read path cannot protect itself by connecting read-only -- it holds a
connection perfectly capable of destroying a guest. The discipline is in the
code instead. posts() and screenshot() call nothing but accessors; everything
that changes a guest lives in act(), reached only from an explicit admin-gated
POST, and logged with the user who asked. The tests never reach a real
hypervisor: every libvirt object in them is a fake that records what was asked
of it, which is the only way to test the destructive half when the machine
running the suite is itself a guest of the hypervisor in question.

hypervisor.tx came from the wizard rather than from me, but guests.json refers
to it, so it comes along.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01U3k2hhSZpcsoe6uBmhF9nB

Makefile.PL

@@ -39,6 +39,7 @@ WriteMakefile(
     'Imager::QRCode'         => '0',
     'JSON::MaybeXS'          => '0',
     'JSON::Validator::Schema::Troglodyne' => '0',
+    'Sys::Virt'              => '0',
     'List::Util'             => '0',
     'Mojo::File'             => '0',
     'POSIX'                  => '0',

lib/Trog/DataSource/Virt.pm

@@ -0,0 +1,269 @@
+package Trog::DataSource::Virt;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw{signatures state};
+
+use File::Path();
+use Sys::Virt();
+
+use Trog::Log qw{WARN INFO};
+
+=head1 Trog::DataSource::Virt
+
+Builds posts out of libvirt guests rather than out of the datastore.
+
+A post type says it wants this by naming it in its sidecar:
+
+    "x-tcms-datasource": "Trog::DataSource::Virt"
+
+A series of that type then lists the guests of whichever hypervisor posts its
+relations pulled in, instead of listing posts somebody wrote.  Nothing here is
+ever written to the datastore -- the guests are the source of truth, and the
+posts are rebuilt from them on every view.
+
+=head2 A NOTE ON SAFETY
+
+libvirt forbids virDomainScreenshot on a read-only connection, so the read path
+cannot protect itself by connecting read-only -- it holds a connection which is
+perfectly capable of destroying a guest.
+
+The discipline is therefore in the code: posts() and screenshot() call nothing
+but accessors, and every operation that changes a guest lives in act(), which
+is reached only from an explicit admin-gated POST.  Keep it that way.
+
+=cut
+
+# How long a cached screenshot is considered fresh.  These are console
+# captures, so they change slowly and are cheap to refetch.
+our $screenshot_ttl = 30;
+
+our $screenshot_dir = 'www/assets/guests';
+
+# Reconnecting per guest would be absurd -- one ssh handshake per hypervisor
+# per process is enough.  Not a state var: a connection that has gone away
+# should be retried rather than remembered.
+sub _connect ( $uri, $cache = {} ) {
+    return $cache->{$uri} if $cache->{$uri};
+
+    local $@;
+    my $conn = eval { Sys::Virt->new( uri => $uri ) };
+    if ( !$conn ) {
+        my $why = "$@";
+        $why =~ s/\n.*//s;
+        WARN("Could not connect to hypervisor '$uri': $why");
+        return ( undef, $why );
+    }
+
+    $cache->{$uri} = $conn;
+    return $conn;
+}
+
+# libvirt's numeric domain states, in the order the constants define them.
+my @states = (
+    'no state',      'running',  'blocked', 'paused',
+    'shutting down', 'shut off', 'crashed', 'suspended',
+);
+
+sub _state_name ($state) {
+    return $states[$state] // 'unknown';
+}
+
+=head2 posts($series, $query) = @posts
+
+One post per guest, across every hypervisor the series' relations pulled in.
+
+A hypervisor we cannot reach becomes a single post saying so, rather than
+vanishing -- a page that silently omits half your infrastructure is worse than
+one that tells you the connection is broken.
+
+=cut
+
+sub posts ( $series, $query ) {
+    my $hypervisors = $series->{ $series->{'x-tcms-datasource-relation'} // 'hypervisors' };
+    return () unless ref $hypervisors eq 'ARRAY';
+
+    my $form = $series->{child_form} // '';
+    my %cache;
+    my @out;
+
+    foreach my $hypervisor (@$hypervisors) {
+        my $uri = $hypervisor->{conn_uri};
+        next unless $uri;
+
+        my ( $conn, $why ) = _connect( $uri, \%cache );
+        if ( !$conn ) {
+            push( @out, _unreachable_post( $hypervisor, $series, $form, $why ) );
+            next;
+        }
+
+        local $@;
+        my @domains = eval { $conn->list_all_domains() };
+        if ($@) {
+            my $err = "$@";
+            $err =~ s/\n.*//s;
+            push( @out, _unreachable_post( $hypervisor, $series, $form, $err ) );
+            next;
+        }
+
+        push( @out, map { _post_for( $_, $hypervisor, $series, $form ) } @domains );
+    }
+
+    return @out;
+}
+
+sub _post_for ( $domain, $hypervisor, $series, $form ) {
+    my $name = $domain->get_name();
+    my $info = $domain->get_info();
+
+    return {
+        # The guest's own UUID: stable across renders, and what the control
+        # routes look it back up by.
+        id    => $domain->get_uuid_string(),
+        title => $name,
+        form  => $form,
+        data  => '',
+
+        domain           => $name,
+        state            => _state_name( $info->{state} ),
+        is_active        => $domain->is_active() ? 1 : 0,
+        memory           => $info->{memory},
+        vcpus            => $info->{nrVirtCpu},
+        hypervisor       => $hypervisor->{id},
+        hypervisor_title => $hypervisor->{title},
+
+        # Fetched by the browser rather than inline, so ten guests don't mean
+        # ten screenshots taken serially before the page can render.
+        preview => "/guest/screenshot/$hypervisor->{id}/$name",
+
+        # Enough of a post to survive being rendered like one.
+        local_href => "/guest/$hypervisor->{id}/$name",
+        href       => '',
+        tags       => $series->{tags}       // [],
+        visibility => $series->{visibility} // 'private',
+        created    => time(),
+        version    => 0,
+        user       => $series->{user},
+        method     => 'GET',
+    };
+}
+
+sub _unreachable_post ( $hypervisor, $series, $form, $why ) {
+    return {
+        id               => "unreachable-$hypervisor->{id}",
+        title            => $hypervisor->{title} // 'hypervisor',
+        form             => $form,
+        data             => '',
+        state            => "unreachable: $why",
+        is_active        => 0,
+        unreachable      => 1,
+        hypervisor       => $hypervisor->{id},
+        hypervisor_title => $hypervisor->{title},
+        preview          => '',
+        local_href       => '',
+        href             => '',
+        tags             => $series->{tags}       // [],
+        visibility       => $series->{visibility} // 'private',
+        created          => time(),
+        version          => 0,
+        user             => $series->{user},
+        method           => 'GET',
+    };
+}
+
+=head2 screenshot($conn_uri, $domain_name) = ($path, $error)
+
+Path to a reasonably fresh PNG of the guest's console.
+
+Cached on disk, because a page of guests means one of these per guest and they
+are only interesting to about the nearest half minute.  libvirt hands back the
+mimetype; qemu gives us PNG already, so there is nothing to convert.
+
+=cut
+
+sub screenshot ( $conn_uri, $domain_name ) {
+    my ($safe) = $domain_name =~ m/^([A-Za-z0-9._-]+)$/;
+    return ( undef, 'bad domain name' ) unless $safe;
+
+    my $path = "$screenshot_dir/$safe.png";
+    return ( $path, undef ) if -f $path && ( time() - ( stat($path) )[9] ) < $screenshot_ttl;
+
+    my ( $conn, $why ) = _connect($conn_uri);
+    return ( undef, $why ) unless $conn;
+
+    local $@;
+    my $data = eval {
+        my ($domain) = grep { $_->get_name() eq $safe } $conn->list_all_domains();
+        die "no such guest\n" unless $domain;
+
+        my $stream = $conn->new_stream();
+        $domain->screenshot( $stream, 0, 0 );
+
+        my $buffer = '';
+        $stream->recv_all( sub { my ( undef, $chunk ) = @_; $buffer .= $chunk; return length($chunk) } );
+        $stream->finish();
+        $buffer;
+    };
+    if ( !$data ) {
+        my $err = "$@";
+        $err =~ s/\n.*//s;
+        return ( undef, $err );
+    }
+
+    File::Path::make_path($screenshot_dir);
+    open( my $fh, '>', $path ) or return ( undef, "could not cache the screenshot: $!" );
+    binmode $fh;
+    print {$fh} $data;
+    close $fh;
+
+    return ( $path, undef );
+}
+
+=head2 act($action, $conn_uri, $domain_name, $user) = ($ok, $message)
+
+The operations which change a guest.
+
+Deliberately the only sub here that does, and deliberately not reachable from
+the render path -- see the safety note at the top.  Everything it does is
+logged with the user who asked for it.
+
+=cut
+
+sub act ( $action, $conn_uri, $domain_name, $user ) {
+    my ($safe) = $domain_name =~ m/^([A-Za-z0-9._-]+)$/;
+    return ( 0, 'bad guest name' ) unless $safe;
+
+    my ( $conn, $why ) = _connect($conn_uri);
+    return ( 0, "could not reach the hypervisor: $why" ) unless $conn;
+
+    local $@;
+    my ($domain) = eval {
+        grep { $_->get_name() eq $safe } $conn->list_all_domains();
+    };
+    return ( 0, "no guest called '$safe' on that hypervisor" ) unless $domain;
+
+    INFO("Guest action '$action' on '$safe' requested by $user");
+
+    my %actions = (
+        poweron  => sub { $_[0]->create() },
+        poweroff => sub { $_[0]->shutdown() },
+        snapshot => sub { $_[0]->create_snapshot() },
+        destroy  => sub { $_[0]->destroy() },
+    );
+
+    my $doit = $actions{ $action // '' };
+    return ( 0, "'$action' is not something we do to a guest" ) unless $doit;
+
+    eval { $doit->($domain); 1 } or do {
+        my $err = "$@";
+        $err =~ s/\n.*//s;
+        WARN("Guest action '$action' on '$safe' failed: $err");
+        return ( 0, $err );
+    };
+
+    return ( 1, "$action: ok" );
+}
+
+1;

lib/Trog/Routes/HTML.pm

@@ -164,6 +164,21 @@ our %routes = (
         noindex  => 1,
         nocache  => 1,
     },
+    '/guest/screenshot/(.*)/(.*)' => {
+        method   => 'GET',
+        auth     => 1,
+        callback => \&Trog::Routes::HTML::guest_screenshot,
+        captures => [qw{hypervisor domain}],
+        noindex  => 1,
+        nocache  => 1,
+    },
+    '/guest/act' => {
+        method   => 'POST',
+        auth     => 1,
+        callback => \&Trog::Routes::HTML::guest_act,
+        noindex  => 1,
+        nocache  => 1,
+    },
     '/admin/wyzzerdd' => {
         method   => 'GET',
         auth     => 1,
@@ -1330,6 +1345,12 @@ sub posts ( $query, $direct = 0 ) {
         @posts = _post_helper( $query, $tags, $query->{user_acls} );
     }
 
+    # A post type can say its posts come from somewhere other than the
+    # datastore -- see Trog::DataSource::Virt, which builds them out of libvirt
+    # guests.  The series is still an ordinary post; only its children are
+    # synthesized, and they are rebuilt on every view rather than stored.
+    @posts = _datasource_posts( $query, \@posts );
+
     if ( $query->{id} ) {
         $query->{primary_post} = $posts[0] if @posts;
     }
@@ -1520,6 +1541,62 @@ sub _themed_title ($path) {
     return $Theme::paths{$path} ? $Theme::paths{$path} : $path;
 }
 
+=head2 _datasource_posts($query, $posts)
+
+Swap a series' children for whatever its datasource says they are, if its child
+type declares one.
+
+Returns the posts unchanged for every ordinary type, which is nearly all of
+them -- this is a hook, not a detour every page takes.
+
+=cut
+
+sub _datasource_posts ( $query, $posts ) {
+    my $series = $query->{primary_post};
+    return @$posts unless Ref::Util::is_hashref($series) && $series->{child_form};
+
+    my $meta   = Trog::DataModule::type_meta_for( $series->{child_form} );
+    my $source = $meta->{'x-tcms-datasource'};
+    return @$posts unless $source && !ref $source;
+
+    # Named in a sidecar, so check it rather than requiring whatever we were
+    # told to.  The namespace restriction is the point: a sidecar cannot make
+    # us load an arbitrary module.
+    if ( $source !~ m/^Trog::DataSource::\w+$/ ) {
+        WARN("Post type '$series->{child_form}' names a datasource '$source' which isn't one");
+        return @$posts;
+    }
+
+    my $modpath = $source;
+    $modpath =~ s{::}{/}g;
+    $modpath .= '.pm';
+
+    local $@;
+    eval { require $modpath; 1 } or do {
+        WARN("Datasource '$source' will not load: $@");
+        return @$posts;
+    };
+
+    no strict 'refs';
+    my $sub = "${source}::posts";
+    if ( !defined &{$sub} ) {
+        WARN("Datasource '$source' has no posts() to call");
+        return @$posts;
+    }
+
+    my @synthesized = eval { &{$sub}( $series, $query ) };
+    use strict;
+
+    if ($@) {
+        my $err = "$@";
+        $err =~ s/\n.*//s;
+        WARN("Datasource '$source' failed: $err");
+        return @$posts;
+    }
+
+    return @synthesized;
+}
+
 sub _post_helper ( $query, $tags, $acls ) {
     state $data;
     $data //= Trog::Data->new(Trog::Config::get());
@@ -1949,6 +2026,73 @@ our %wizard_field_types = (
 # Field names which aren't in %schema but would still collide with something.
 our @wizard_reserved = qw{app to form data_is_array addpost extra_tags is_image is_video is_audio is_profile content_type version};
 
+=head2 guest_screenshot
+
+Implements GET /guest/screenshot/$hypervisor/$guest.  Admin only.
+
+Served as its own route rather than inlined into the guest listing, so that a
+page of guests renders immediately and the browser fetches the console
+captures in parallel instead of us taking them one after another.
+
+=cut
+
+sub guest_screenshot ($query) {
+    return $query->{tpsgi}->see_also('/login') unless $query->{user};
+    return $query->{tpsgi}->forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+
+    my $hypervisor = _guest_hypervisor( $query, $query->{hypervisor} );
+    return $query->{tpsgi}->notfound($query) unless $hypervisor;
+
+    require Trog::DataSource::Virt;
+    my ( $path, $why ) = Trog::DataSource::Virt::screenshot( $hypervisor->{conn_uri}, $query->{domain} );
+    if ( !$path ) {
+        WARN("Could not screenshot '$query->{domain}': $why");
+        return $query->{tpsgi}->notfound($query);
+    }
+
+    return $query->{tpsgi}->serve(
+        $query->{route}, $path, $query->{start}, $query->{streaming},
+        $query->{ranges}, $query->{last_fetched}, $query->{deflate},
+    );
+}
+
+=head2 guest_act
+
+Implements POST /guest/act.  Admin only.
+
+Powering a guest on or off, snapshotting it, or destroying it.  Separate from
+everything that merely reads a guest, and the only route which reaches
+Trog::DataSource::Virt::act.
+
+=cut
+
+sub guest_act ($query) {
+    return $query->{tpsgi}->see_also('/login') unless $query->{user};
+    return $query->{tpsgi}->forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+
+    my $to = $query->{to} || '/';
+
+    my $hypervisor = _guest_hypervisor( $query, $query->{hypervisor} );
+    return _feedback_redirect( $query, $to, 1, 'No such hypervisor.' ) unless $hypervisor;
+
+    require Trog::DataSource::Virt;
+    my ( $ok, $message ) = Trog::DataSource::Virt::act(
+        $query->{action}, $hypervisor->{conn_uri}, $query->{domain}, $query->{user},
+    );
+
+    return _feedback_redirect( $query, $to, $ok ? 0 : 1, "$query->{domain}: $message" );
+}
+
+# The hypervisor post a guest route was asked about.  Looked up rather than
+# taken from the request: the connection URI is not something a form gets to
+# hand us.
+sub _guest_hypervisor ( $query, $id ) {
+    return undef unless $id;
+    my @found = _post_helper( { id => $id }, [], $query->{user_acls} );
+    return undef unless @found && ( $found[0]{conn_uri} // '' );
+    return $found[0];
+}
+
 =head2 post_wizard
 
 Implements /admin/wyzzerdd.  Admin only.

t/Trog-DataSource-Virt.t

@@ -0,0 +1,187 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::MockModule qw{strict};
+use Test::Fatal qw{exception};
+use Path::Tiny();
+use FindBin;
+
+use lib "$FindBin::Bin/../lib";
+
+# Nothing in this file may ever reach a real hypervisor.  Every libvirt object
+# here is a fake that records what was asked of it, which is the only safe way
+# to test the destructive half: the machine this suite runs on is itself a
+# guest of the hypervisor the feature talks to.
+require_ok('Trog::DataSource::Virt') or BAIL_OUT("Can't find SUT");
+
+my $logmock = Test::MockModule->new('Trog::DataSource::Virt');
+$logmock->redefine( WARN => sub { note(shift) } );
+$logmock->redefine( INFO => sub { note(shift) } );
+
+our @CALLS;
+
+{
+    package FakeDomain;
+    sub new { my ( $c, %a ) = @_; return bless {%a}, $c }
+    sub get_name        { $_[0]{name} }
+    sub get_uuid_string { $_[0]{uuid} }
+    sub is_active       { $_[0]{active} }
+    sub get_info        { { state => $_[0]{state}, memory => 1024, nrVirtCpu => 2 } }
+
+    # The operations we must never actually perform: record and return.
+    sub create        { push @main::CALLS, [ 'create',        $_[0]{name} ]; 1 }
+    sub shutdown      { push @main::CALLS, [ 'shutdown',      $_[0]{name} ]; 1 }
+    sub destroy       { push @main::CALLS, [ 'destroy',       $_[0]{name} ]; 1 }
+    sub create_snapshot { push @main::CALLS, [ 'create_snapshot', $_[0]{name} ]; 1 }
+}
+
+{
+    package FakeConn;
+    sub new { bless {}, shift }
+    sub list_all_domains {
+        return (
+            FakeDomain->new( name => 'alpha', uuid => 'uuid-alpha', active => 1, state => 1 ),
+            FakeDomain->new( name => 'beta',  uuid => 'uuid-beta',  active => 0, state => 5 ),
+        );
+    }
+}
+
+my $connect_fails = 0;
+my $virtmock = Test::MockModule->new('Sys::Virt');
+$virtmock->redefine(
+    new => sub {
+        die "libvirt error: nope\n" if $connect_fails;
+        return FakeConn->new();
+    }
+);
+
+my $series = {
+    child_form  => 'guests.tx',
+    tags        => ['guests'],
+    visibility  => 'private',
+    user        => 'specadmin',
+    hypervisors => [ { id => 'hv-1', title => 'spec-hv', conn_uri => 'test:///default' } ],
+};
+
+subtest 'guests become posts' => sub {
+    @CALLS = ();
+    my @posts = Trog::DataSource::Virt::posts( $series, { user_acls => ['admin'] } );
+
+    is( scalar @posts, 2, 'one post per guest' );
+    is( $posts[0]{title}, 'alpha',      'named after the guest' );
+    is( $posts[0]{id},    'uuid-alpha', "and identified by the guest's uuid, not ours" );
+    is( $posts[0]{form},  'guests.tx',  "wearing the series' child type" );
+    is( $posts[0]{state}, 'running',    'with a legible state' );
+    is( $posts[1]{state}, 'shut off',   '...for each of libvirt\'s numeric ones' );
+    is( $posts[0]{is_active}, 1, 'active guests are marked so' );
+    is( $posts[1]{is_active}, 0, 'and inactive ones are not' );
+
+    # The listing must not take screenshots: that is a per-guest round trip,
+    # and it is the browser's job via the preview route.
+    is( $posts[0]{preview}, '/guest/screenshot/hv-1/alpha', 'the preview is a route, not an inline capture' );
+    is_deeply( \@CALLS, [], 'and nothing was done to any guest merely by listing' );
+
+    is_deeply( $posts[0]{tags}, ['guests'], "children inherit the series' tags" );
+    is( $posts[0]{visibility}, 'private', 'and its visibility' );
+};
+
+subtest 'an unreachable hypervisor says so rather than vanishing' => sub {
+    $connect_fails = 1;
+    my @posts = Trog::DataSource::Virt::posts( $series, { user_acls => ['admin'] } );
+    $connect_fails = 0;
+
+    is( scalar @posts, 1, 'we get a post back' );
+    ok( $posts[0]{unreachable}, 'flagged as unreachable' );
+    like( $posts[0]{state}, qr/unreachable/, 'saying as much' );
+    is( $posts[0]{title}, 'spec-hv', 'named for the hypervisor we could not reach' );
+};
+
+subtest 'act() drives the right libvirt call, and only on request' => sub {
+    my %expected = (
+        poweron  => 'create',
+        poweroff => 'shutdown',
+        snapshot => 'create_snapshot',
+        destroy  => 'destroy',
+    );
+
+    foreach my $action ( sort keys %expected ) {
+        @CALLS = ();
+        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, 'test:///default', 'alpha', 'specadmin' );
+        ok( $ok, "$action succeeded" ) or diag($message);
+        is_deeply( \@CALLS, [ [ $expected{$action}, 'alpha' ] ], "$action called $expected{$action} on the named guest, once" );
+    }
+};
+
+subtest 'act() refuses what it should' => sub {
+    @CALLS = ();
+
+    my ( $ok, $message ) = Trog::DataSource::Virt::act( 'rm-rf', 'test:///default', 'alpha', 'specadmin' );
+    ok( !$ok, 'an action we do not define is refused' );
+    like( $message, qr/not something we do/, 'and says so' );
+
+    ( $ok, $message ) = Trog::DataSource::Virt::act( 'destroy', 'test:///default', '../../etc/passwd', 'specadmin' );
+    ok( !$ok, 'a guest name that is a path is refused' );
+    like( $message, qr/bad guest name/, 'before any connection is made' );
+
+    ( $ok, $message ) = Trog::DataSource::Virt::act( 'destroy', 'test:///default', 'nosuchguest', 'specadmin' );
+    ok( !$ok, 'a guest that is not there is refused' );
+    like( $message, qr/no guest called/, 'rather than acting on some other one' );
+
+    is_deeply( \@CALLS, [], 'and none of those touched a guest' );
+
+    $connect_fails = 1;
+    ( $ok, $message ) = Trog::DataSource::Virt::act( 'poweroff', 'test:///default', 'alpha', 'specadmin' );
+    $connect_fails = 0;
+    ok( !$ok, 'an unreachable hypervisor is refused' );
+    like( $message, qr/could not reach/, 'and reported' );
+    is_deeply( \@CALLS, [], 'having done nothing' );
+};
+
+subtest 'screenshot() validates the guest name before anything else' => sub {
+    my ( $path, $why ) = Trog::DataSource::Virt::screenshot( 'test:///default', '../../../etc/passwd' );
+    is( $path, undef, 'a path-shaped guest name gets no screenshot' );
+    like( $why, qr/bad domain name/, 'and is named as the reason' );
+
+    ( $path, $why ) = Trog::DataSource::Virt::screenshot( 'test:///default', 'alpha/../../beta' );
+    is( $path, undef, 'nor does one with traversal in the middle' );
+};
+
+subtest 'the datasource hook only loads what it should' => sub {
+    require Trog::Routes::HTML;
+
+    my $htmlmock = Test::MockModule->new('Trog::Routes::HTML');
+    $htmlmock->redefine( WARN => sub { note(shift) } );
+
+    my $declared;
+    my $dmmock = Test::MockModule->new('Trog::DataModule');
+    $dmmock->redefine( type_meta_for => sub { return { 'x-tcms-datasource' => $declared } } );
+
+    my @stored = ( { title => 'a stored post' } );
+    my $query  = { primary_post => { child_form => 'guests.tx' }, user_acls => ['admin'] };
+
+    # A type that declares nothing keeps its own posts -- this hook must be
+    # invisible to the overwhelming majority of pages.
+    $declared = undef;
+    is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, 'no datasource declared, posts untouched' );
+
+    # The namespace restriction is the point: a sidecar is a file on disk, and
+    # it must not be able to make us require an arbitrary module.
+    foreach my $bad ( 'Trog::Routes::HTML', 'File::Path', '../../etc/passwd', 'Trog::DataSource::Virt::act' ) {
+        $declared = $bad;
+        is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, "'$bad' is refused as a datasource" );
+    }
+
+    # One that does not exist is a warning, not a dead page.
+    $declared = 'Trog::DataSource::Nonexistent';
+    is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, 'a datasource that will not load falls back' );
+
+    # And a real one is actually used.
+    $declared = 'Trog::DataSource::Virt';
+    $query->{primary_post}{hypervisors} = [ { id => 'hv-1', title => 'spec-hv', conn_uri => 'test:///default' } ];
+    my @got = Trog::Routes::HTML::_datasource_posts( $query, \@stored );
+    is( scalar @got,   2,       'a declared datasource replaces the stored posts' );
+    is( $got[0]{title}, 'alpha', 'with what it built' );
+};
+
+done_testing();

www/templates/html/components/forms/guests.json

@@ -0,0 +1,15 @@
+{
+   "properties" : {},
+   "type" : "object",
+   "x-tcms-datasource" : "Trog::DataSource::Virt",
+   "x-tcms-post-type" : {
+      "description" : "A libvirt guest.  Not written by anyone -- built from the hypervisors this series' relations pull in, and rebuilt on every view.",
+      "generated" : false,
+      "name" : "guests"
+   },
+   "x-tcms-relations" : {
+      "hypervisors" : {
+         "form" : "hypervisor.tx"
+      }
+   }
+}

www/templates/html/components/forms/guests.tx

@@ -0,0 +1,36 @@
+<div class="post <: $style :>">
+    : if ( !$post.addpost ) {
+        : if ( $post.unreachable ) {
+            <h3 class='blogtitles'><: $post.title :></h3>
+            <div class="postData responsive-text">
+                Could not reach this hypervisor: <: $post.state :>
+            </div>
+        : } else {
+            <h3 class='blogtitles'>
+                <: $post.title :>
+                <span class="guest-state guest-<: $post.is_active ? 'up' : 'down' :>"><: $post.state :></span>
+            </h3>
+            <div class="postData responsive-text" id="postData-<: $post.id :>">
+                <img src="<: $post.preview :>" class="responsive-img guest-screenshot" alt="console of <: $post.title :>" loading="lazy" />
+                <br />
+                on <: $post.hypervisor_title :> &mdash; <: $post.vcpus :> vCPU
+                : if ( $can_edit ) {
+                <br />
+                <form class="Submissions guest-actions" action="/guest/act" method="POST">
+                    <input type="hidden" name="hypervisor" value="<: $post.hypervisor :>" />
+                    <input type="hidden" name="domain" value="<: $post.domain :>" />
+                    <input type="hidden" name="to" value="<: $route :>" />
+                    : if ( $post.is_active ) {
+                    <button class="coolbutton" type="submit" name="action" value="poweroff">Power Off</button>
+                    : } else {
+                    <button class="coolbutton" type="submit" name="action" value="poweron">Power On</button>
+                    : }
+                    <button class="coolbutton" type="submit" name="action" value="snapshot">Snapshot</button>
+                    <button class="coolbutton guest-destroy" type="submit" name="action" value="destroy"
+                            onclick="return confirm('Destroy <: $post.title :>?  This stops the guest immediately.');">Destroy</button>
+                </form>
+                : }
+            </div>
+        : }
+    : }
+</div>

www/templates/html/components/forms/hypervisor.json

@@ -0,0 +1,25 @@
+{
+   "properties" : {
+      "conn_uri" : {
+         "type" : "string",
+         "x-tcms-input" : "url",
+         "x-tcms-label" : "Libvirt Connection URI",
+         "x-tcms-placeholder" : "libvirt://localhost"
+      }
+   },
+   "required" : [
+      "conn_uri"
+   ],
+   "type" : "object",
+   "x-tcms-post-type" : {
+      "body_form" : "form_common.tx",
+      "generated" : true,
+      "generator" : "Trog::Routes::HTML::post_wizard_save",
+      "includes" : [
+         "acls.tx",
+         "tags.tx",
+         "aliases.tx"
+      ],
+      "name" : "hypervisor"
+   }
+}

www/templates/html/components/forms/hypervisor.tx

@@ -0,0 +1,28 @@
+<!-- Generated by the tCMS Post Type Wizard.  Regenerating this type will overwrite any hand edits. -->
+<div class="post <: $style :>">
+    : if ( !$post.addpost ) {
+        : include "post_title.tx";
+        : include "post_tags.tx";
+<div class="postData responsive-text">
+    Connection URI:<br />
+    <a href="<: $post.conn_uri :>"><: $post.conn_uri :></a>
+    <br />
+    <: render_it($post.data) | mark_raw :>
+</div>
+    : }
+
+    : if ( $can_edit ) {
+        <div class="postedit">
+        : include "edit_head.tx";
+        <form class="Submissions" action="/post/save" method="POST" enctype="multipart/form-data">
+            Title *<br /><input required class="cooltext" type="text" name="title" placeholder="HV Hostname" value="<: $post.title :>" />
+            Libvirt Connection URI<br /><input required class="cooltext" type="url" name="conn_uri" placeholder="libvirt://localhost" value="<: $post.conn_uri :>" />
+            : include "acls.tx";
+            : include "tags.tx";
+            : include "aliases.tx";
+            : include "form_common.tx";
+        </form>
+        : include "edit_foot.tx";
+        </div>
+    : }
+</div>