Add ProvisionedVirt: show a guest's recipe, and offer to rebuild it

A subclass of Trog::DataSource::Virt, which is the first one and shows what
subclassing a datasource is for.  can() resolves through @ISA, so the dispatcher
finds the inherited filter, lang, help, EDITABLE and CACHEABLE without this
having to restate any of them; posts() is the only thing overridden, because the
only thing that differs is what it adds.

What it adds is the other half of the story libvirt cannot tell you.  A guest on
a Troglodyne hypervisor was provisioned from recipes.d/$domain.yaml in the
provisioners repository, and rebuilding it means bin/new_config there followed by
bin/provision in trog-provisioner.  Say where the two are checked out in the
tCMS configuration and each guest shows its recipe and offers a Reprovision
button; leave them out and it degrades to a plain guest listing, which is
Trog::DataSource::Virt.

Reprovisioning is not recoverable, so it follows the discipline act() already
set, for the reasons documented there.  POST and admin only.  Refused outright
for the guest tCMS is itself running on, whatever the template chose to draw --
Virt refuses to power that one off, and rebuilding it would be worse.  The guest
name is validated as a hostname before it reaches either the filesystem or an
argument list, and every command runs through a piped open with a list, so there
is no shell between us and the program and a guest name can never be read as one.

A provision takes minutes and an HTTP worker does not have minutes, so the
lifecycle is handed to a double-forked, setsid'd process which outlives the
request, the worker and the restart a save triggers.  Nothing waits on it, so its
log is the only account there is: logs/reprovision/$domain.log, whose tail is read
back onto the page.

The passphrase is asked for per run rather than stored.  bin/new_config prompts
for it on stdin because every recipe inherits secret: values from _base, so a
button that ran unattended would need the master password for every secret the
operator holds, in a file the webserver can read.  It is piped to that one child,
deleted from the query before the request goes any further -- that hash is cloned,
logged around and handed to renderers -- and never reaches the config, the log or
the process table.

Nothing in the tests forks or executes a provisioner: _spawn is mocked
throughout, and what is asserted is what would have been run and, mostly, what is
refused before anything is.

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

Readme.md

@@ -144,8 +144,37 @@ Data Sources
 Sometimes you want to consider something else authoritative that isn't a datamodel under our control.
 
 * Virt - Talk to a libvirt HV to list guests.
+* ProvisionedVirt - Virt, plus the recipe each guest was built from and a button to build it again.
 * DirIndex - List the contents of a directory.
 
+ProvisionedVirt is a subclass of Virt, and shows what subclassing one is for: it
+inherits the libvirt half unchanged and adds the other half of the story, which is
+that a guest on a Troglodyne hypervisor was provisioned from a recipe on disk.
+Tell it where the two repositories are and it shows each guest's
+recipes.d/$domain.yaml and offers a Reprovision button running the full
+lifecycle -- bin/new_config in provisioners, then bin/provision in
+trog-provisioner:
+
+    [provisioner]
+        provisioners     = /home/you/Code/provisioners
+        trog_provisioner = /home/you/Code/trog-provisioner
+
+Leave those out and it degrades to a plain guest listing.
+
+Reprovisioning is not recoverable: it destroys the guest and builds it again, and
+whatever the recipe does not describe does not come back.  It is POST and admin
+only, it refuses outright for the guest tCMS is itself running on (as Virt already
+refuses to power that one off), and nothing it runs goes near a shell.  The
+provisioning itself is handed to a detached process and logged to
+logs/reprovision/$domain.log, whose tail is shown back on the page -- a provision
+takes minutes and an HTTP worker does not have minutes.
+
+bin/new_config asks for your KeePass passphrase on stdin, because every recipe
+inherits secret: values from _base.  The form asks you for it per run and pipes it
+to that one process; it is not written to the config, the log, or the process
+table.  The alternative would be keeping the master password for every secret you
+hold in a file the webserver can read.
+
 DirIndex is the one to copy if you are writing your own.  Point a series at a
 directory with its "Directory to index" field, build a child type in the wizard
 with DirIndex as its datasource, and every file in there becomes a post carrying

config/default.cfg

@@ -3,6 +3,12 @@
     # for moving an existing FlatFile site across.
     data_model=FlatFile
     title=tCMS
+[provisioner]
+    # Where the two repositories which own the VM provisioning lifecycle are
+    # checked out.  Only needed by Trog::DataSource::ProvisionedVirt, which
+    # degrades to a plain guest listing without them.
+    # provisioners=/home/you/Code/provisioners
+    # trog_provisioner=/home/you/Code/trog-provisioner
 [security]
     allow_embeds_from=vimeo.com *.vimeo.com youtube.com *.youtube.com www.youtube-nocookie.com
 [nginx-unit]

design.md

@@ -400,6 +400,7 @@ The contractor's cheat-sheet.
 | A reusable chunk of UI | `Trog::Component::Whatever` with `render(%args)` | a little |
 | A page listing a directory of files | a series with a directory + a wizard type using `DirIndex` | none |
 | Content from an external system | `Trog::DataSource::Whatever` with `posts($series,$query)` | some |
+| To extend one that exists | subclass it; `can()` resolves through `@ISA`, so override only what differs (`ProvisionedVirt` does this to `Virt`) | some |
 | A computed field on a type | an enrich sub, as `Trog::Enrich::Invoice` does | some |
 | A route that is not a post | add to `%Trog::Routes::HTML::routes`, or a theme's `routes.pm` | some |
 | A different place to keep posts | subclass `Trog::DataModule` | most |

lib/Trog/DataSource/ProvisionedVirt.pm

@@ -0,0 +1,329 @@
+package Trog::DataSource::ProvisionedVirt;
+
+use v5.36;
+use re '/aa';
+
+use parent qw{Trog::DataSource::Virt};
+
+use Cwd            ();
+use File::Basename ();
+use File::Path     ();
+use File::Slurper  ();
+use POSIX          ();
+
+use Trog::Config     ();
+use Trog::DataSource ();
+use Trog::DataSource::Virt();
+
+use Trog::Log qw{WARN INFO};
+
+=head1 Trog::DataSource::ProvisionedVirt
+
+Trog::DataSource::Virt, plus the recipe each guest was built from and a button to
+build it again.
+
+Everything about listing guests is inherited unchanged -- this is the same
+libvirt connection, the same posts, the same search and the same refusal to be
+cached.  What it adds is the other half of the story: a guest on a Troglodyne
+hypervisor was provisioned from a recipe, and the recipe is on disk next to the
+hypervisor rather than anywhere libvirt can tell you about.
+
+Two repositories between them own that lifecycle:
+
+    provisioners        recipes.d/$domain.yaml, and bin/new_config which turns
+                        a recipe into a configuration package
+    trog-provisioner    bin/provision, which turns that package into a machine
+
+Say where they are in the tCMS configuration and this becomes useful; leave them
+out and it degrades to plain Virt, which is what it is.
+
+    [provisioner]
+        provisioners     = /home/you/Code/provisioners
+        trog_provisioner = /home/you/Code/trog-provisioner
+
+=head1 A NOTE ON SAFETY
+
+Reprovisioning is not a recoverable operation.  It destroys the guest and builds
+it again from its recipe, and whatever was on it that the recipe does not
+describe does not come back.
+
+The discipline is the same as its parent's, and for the same reasons.  It is
+POST only and admin only; it refuses outright for the guest tCMS is itself
+running on, whatever the template chose to draw; and nothing it runs goes near a
+shell, so a guest name is an argument and can never be a command.
+
+=cut
+
+our $recipe_dir = 'recipes.d';
+our $log_dir    = 'logs/reprovision';
+
+=head1 FUNCTIONS
+
+=head2 posts($series, $query) = @posts
+
+The guests Trog::DataSource::Virt would have listed, each carrying what we know
+about how it was built:
+
+    recipe            the recipe's YAML, as text, for the page to show
+    recipe_path       where that came from
+    has_recipe        whether there was one at all
+    can_reprovision   whether the button should be drawn
+    reprovision_log   the tail of the last run, when there has been one
+
+A guest with no recipe is still listed.  Plenty of guests on a hypervisor were
+not built by this, and saying nothing about them is better than hiding them.
+
+=cut
+
+sub posts ( $series, $query ) {
+    my @guests = Trog::DataSource::Virt::posts( $series, $query );
+    my $config = _config();
+
+    return map { _with_recipe( $_, $config ) } @guests;
+}
+
+sub _with_recipe ( $post, $config ) {
+    return $post if $post->{unreachable};
+
+    my $domain = $post->{domain} // '';
+    my $path   = _recipe_path( $config, $domain );
+
+    if ($path) {
+        my $recipe = eval { File::Slurper::read_text($path) };
+        if ( defined $recipe ) {
+            $post->{recipe}      = $recipe;
+            $post->{recipe_path} = $path;
+            $post->{has_recipe}  = 1;
+        }
+        else {
+            WARN("Could not read the recipe for '$domain' at $path: $@");
+        }
+    }
+
+    # Both halves have to be there to run the lifecycle, and we will not rebuild
+    # the machine we are answering the request from -- see act() in the parent,
+    # which refuses to power that one off for the same reason.
+    $post->{can_reprovision} =
+      ( $post->{has_recipe} && $config->{provisioners} && $config->{trog_provisioner} && !$post->{is_self} ) ? 1 : 0;
+
+    $post->{reprovision_log} = _log_tail($domain);
+
+    return $post;
+}
+
+=head2 _config() = HASHREF
+
+Where the two repositories are, from the tCMS configuration.
+
+Undef for either means the feature is off rather than broken: a site which has
+not configured them gets a plain guest listing, which is what it asked for.
+
+=cut
+
+sub _config {
+    my $conf = Trog::Config::get();
+
+    my %config;
+    foreach my $key (qw{provisioners trog_provisioner}) {
+        my $dir = $conf->param("provisioner.$key");
+        next unless $dir && !ref $dir;
+
+        # Resolved, and checked to be there.  A path in a config file which does
+        # not exist is a typo, and finding that out here beats finding it out
+        # halfway through a reprovision.
+        my $absolute = Cwd::abs_path($dir);
+        if ( !$absolute || !-d $absolute ) {
+            WARN("provisioner.$key is set to '$dir', which is not a directory here");
+            next;
+        }
+
+        $config{$key} = $absolute;
+    }
+
+    return \%config;
+}
+
+# A guest name reaches the filesystem here, so it is a hostname or it is nothing.
+sub _safe_domain ($domain) {
+    return undef unless defined $domain && length($domain) && length($domain) < 254;
+    return undef if $domain =~ m/(?:^|\.)\.\.?(?:\.|$)/;
+
+    my ($safe) = $domain =~ m/^([A-Za-z0-9][A-Za-z0-9._-]*)$/;
+    return $safe;
+}
+
+sub _recipe_path ( $config, $domain ) {
+    return undef unless $config->{provisioners};
+
+    my $safe = _safe_domain($domain);
+    return undef unless $safe;
+
+    my $path = "$config->{provisioners}/$recipe_dir/$safe.yaml";
+    return -f $path ? $path : undef;    ## no critic (ProhibitFiletest_f) -- is there a recipe for this guest
+}
+
+=head2 _log_tail($domain) = STRING
+
+The last of whatever the previous reprovision said, or nothing.
+
+The run happens in a detached process which nobody is waiting on, so this file
+is the only account of it there is.
+
+=cut
+
+our $log_tail_bytes = 4096;
+
+sub _log_tail ($domain) {
+    my $safe = _safe_domain($domain);
+    return undef unless $safe;
+
+    my $path = "$log_dir/$safe.log";
+    return undef unless -f $path;    ## no critic (ProhibitFiletest_f) -- has this ever run
+
+    my $text = eval { File::Slurper::read_text($path) };
+    return undef unless defined $text;
+
+    return length($text) > $log_tail_bytes ? substr( $text, -$log_tail_bytes ) : $text;
+}
+
+=head2 reprovision(%args) = ($ok, $message)
+
+Run the full lifecycle for one guest: bin/new_config in provisioners, and then
+bin/provision in trog-provisioner.
+
+    domain      which guest.  Required, and validated as a hostname.
+    passphrase  the KeePass passphrase new_config asks for on stdin.
+    user        who asked, for the log.
+
+Returns immediately.  Provisioning a machine takes minutes and an HTTP worker
+does not have minutes, so the work is handed to a detached process and the
+caller is told it started rather than told it finished.  What happened is in
+logs/reprovision/$domain.log, which is what _log_tail reads back onto the page.
+
+The passphrase is passed down the child's stdin and is never written anywhere:
+not to the log, not to the process table, not to the configuration.  new_config
+prompts for it because every recipe inherits secret: values from _base, and the
+alternative to asking each time is keeping the master password for every secret
+the operator holds in a file the webserver can read.
+
+=cut
+
+sub reprovision (%args) {
+    my $safe = _safe_domain( $args{domain} );
+    return ( 0, 'bad guest name' ) unless $safe;
+
+    # The template does not draw the button for this guest.  This is what
+    # actually stops it: /guest/reprovision is a POST anybody holding the admin
+    # acl can craft by hand, and there would be nothing left to report to.
+    if ( Trog::DataSource::Virt::_is_self($safe) ) {
+        WARN("Refused to reprovision '$safe': that is this server");
+        return ( 0, "'$safe' is this server -- refusing to reprovision it" );
+    }
+
+    my $config = _config();
+    return ( 0, 'provisioner.provisioners is not configured' )     unless $config->{provisioners};
+    return ( 0, 'provisioner.trog_provisioner is not configured' ) unless $config->{trog_provisioner};
+
+    my $recipe = _recipe_path( $config, $safe );
+    return ( 0, "there is no recipe for '$safe' in $recipe_dir" ) unless $recipe;
+
+    return ( 0, 'a passphrase is required, as new_config asks for one' ) unless length( $args{passphrase} // '' );
+
+    my @lifecycle = (
+        [ $config->{provisioners},     "$config->{provisioners}/bin/new_config",    $safe ],
+        [ $config->{trog_provisioner}, "$config->{trog_provisioner}/bin/provision", $safe ],
+    );
+
+    foreach my $step (@lifecycle) {
+        my ( undef, $program ) = @$step;
+        return ( 0, "$program is not there to run" ) unless -x $program;    ## no critic (ProhibitFiletest_rwxRWX) -- refusing early beats finding out mid-lifecycle
+    }
+
+    INFO( "Reprovision of '$safe' requested by " . ( $args{user} // 'somebody' ) );
+
+    my ( $ok, $why ) = _spawn( $safe, $args{passphrase}, \@lifecycle, $args{user} );
+    return ( 0, $why ) unless $ok;
+
+    return ( 1, "reprovision started; watch $log_dir/$safe.log" );
+}
+
+=head2 _spawn($domain, $passphrase, $lifecycle, $user)
+
+Fork the lifecycle off where nothing is waiting for it.
+
+Double forked and setsid'd on purpose: a save signals the parent to reload the
+routing table, and a provision which died because a worker was recycled halfway
+through would leave a half-built machine.  This has to outlive the request, the
+worker, and a restart.
+
+Each step runs through open() with a list, so there is no shell between us and
+the program, and the guest name is an argument rather than a thing that could be
+read as one.
+
+=cut
+
+sub _spawn ( $domain, $passphrase, $lifecycle, $user ) {
+    my $log = "$log_dir/$domain.log";
+
+    local $@;
+    eval { File::Path::make_path($log_dir); 1 } or return ( 0, "could not make $log_dir: $@" );
+
+    my $pid = fork();
+    return ( 0, "could not fork: $!" ) unless defined $pid;
+    return ( 1, 'started' ) if $pid;
+
+    # First child: detach, fork again, and let the middle process go so that
+    # nothing is left for the worker to reap or be blocked by.
+    POSIX::setsid();
+    my $grandchild = fork();
+    POSIX::_exit(0) if !defined $grandchild || $grandchild;
+
+    # From here on we are nobody's child and nothing reads our exit status, so
+    # the log is the only way to say anything.
+    open( my $fh, '>>', $log ) or POSIX::_exit(1);
+    $fh->autoflush(1);
+
+    print {$fh} "\n=== reprovision of $domain by " . ( $user // 'somebody' ) . ' at ' . localtime() . " ===\n";
+
+    foreach my $step (@$lifecycle) {
+        my ( $dir, @command ) = @$step;
+
+        print {$fh} "\n--- $command[0] $command[1] (in $dir)\n";
+
+        if ( !chdir($dir) ) {
+            print {$fh} "could not chdir to $dir: $!\n";
+            POSIX::_exit(1);
+        }
+
+        # The child's own stdout and stderr are the log, so whatever the program
+        # says lands there without a shell redirect to get wrong.
+        open( STDOUT, '>&', $fh ) or POSIX::_exit(1);
+        open( STDERR, '>&', $fh ) or POSIX::_exit(1);
+
+        # List form on purpose, and the reason the whole thing is shaped this
+        # way: a piped open with a list never involves a shell, so the guest
+        # name is an argument and cannot be read as a command.  The single
+        # argument form of this would be the bug.
+        my $ok = open( my $stdin, '|-', @command );    ## no critic (ProhibitPipeOpen) -- list form, so no shell
+        if ( !$ok ) {
+            print {$fh} "could not run $command[0]: $!\n";
+            POSIX::_exit(1);
+        }
+
+        # What new_config prompts for.  The second step ignores it, and giving
+        # it a closed stdin instead would make anything that asks hang forever.
+        print {$stdin} "$passphrase\n";
+        close($stdin);
+
+        if ($?) {
+            my $status = $? >> 8;
+            print {$fh} "\n--- $command[0] exited $status; stopping here\n";
+            POSIX::_exit($status);
+        }
+    }
+
+    print {$fh} "\n=== finished ===\n";
+    POSIX::_exit(0);
+}
+
+1;

lib/Trog/Routes/HTML.pm

@@ -178,6 +178,13 @@ our %routes = (
         noindex  => 1,
         nocache  => 1,
     },
+    '/guest/reprovision' => {
+        method   => 'POST',
+        auth     => 1,
+        callback => \&Trog::Routes::HTML::guest_reprovision,
+        noindex  => 1,
+        nocache  => 1,
+    },
     '/admin/wyzzerdd' => {
         method   => 'GET',
         auth     => 1,
@@ -2307,6 +2314,44 @@ sub guest_act ($query) {
     return _feedback_redirect( $query, $to, $ok ? 0 : 1, "$query->{guest}: $message" );
 }
 
+=head2 guest_reprovision
+
+Implements POST /guest/reprovision.  Admin only.
+
+Rebuilding a guest from the recipe it was provisioned with: bin/new_config in
+the provisioners repository, and then bin/provision in trog-provisioner.  The
+only route which reaches Trog::DataSource::ProvisionedVirt::reprovision.
+
+This is not a recoverable operation, so read that function before changing
+anything here.  It refuses for the guest tCMS is itself running on, and the
+passphrase new_config asks for arrives with the request and is not stored.
+
+=cut
+
+sub guest_reprovision ($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} || '/';
+
+    require Trog::DataSource::ProvisionedVirt;
+
+    # 'guest' rather than 'domain', for the reason the screenshot route captures
+    # it that way: the router overwrites $query->{domain} with the request's own
+    # host, so a form field by that name never arrives.
+    my ( $ok, $message ) = Trog::DataSource::ProvisionedVirt::reprovision(
+        domain     => $query->{guest},
+        passphrase => $query->{passphrase},
+        user       => $query->{user},
+    );
+
+    # Deleted rather than merely unused: this hash is cloned, logged around and
+    # handed to renderers, and the passphrase has no business in any of that.
+    delete $query->{passphrase};
+
+    return _feedback_redirect( $query, $to, $ok ? 0 : 1, ( $query->{guest} // 'guest' ) . ": $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.

t/Trog-DataSource-ProvisionedVirt.t

@@ -0,0 +1,290 @@
+#!/usr/bin/env perl
+
+# Reprovisioning destroys a machine and builds it again, so the whole of this
+# file is about what has to be true before anything runs.  _spawn is mocked
+# throughout: nothing here forks, and nothing here executes a provisioner.
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More;
+use Test::MockModule qw{strict};
+use Test::Fatal      qw{exception};
+
+our ( $REPO, $ROOT, $OLDCWD );
+
+BEGIN {
+    require Cwd;
+    require File::Copy;
+    require File::Path;
+    require File::Temp;
+
+    $REPO   = Cwd::abs_path("$FindBin::Bin/..");
+    $OLDCWD = Cwd::getcwd();
+    $ROOT   = File::Temp::tempdir( 'tcms-provisioned-XXXXXX', TMPDIR => 1, CLEANUP => 1 );
+
+    $ENV{HOME} = $ROOT;
+    File::Path::make_path("$ROOT/$_") for qw{config logs www/assets};
+
+    # Stand-ins for the two repositories, with the two programs the lifecycle
+    # runs.  Never executed -- _spawn is mocked -- but they have to be there and
+    # executable, because reprovision() checks that before it commits to
+    # anything.
+    File::Path::make_path("$ROOT/provisioners/$_") for qw{bin recipes.d};
+    File::Path::make_path("$ROOT/trog-provisioner/bin");
+    foreach my $program ( "$ROOT/provisioners/bin/new_config", "$ROOT/trog-provisioner/bin/provision" ) {
+        open( my $fh, '>', $program ) or die $!;
+        print {$fh} "#!/bin/sh\nexit 0\n";
+        close $fh;
+        chmod( 0755, $program );
+    }
+    open( my $recipe, '>', "$ROOT/provisioners/recipes.d/guest.example.com.yaml" ) or die $!;
+    print {$recipe} "---\n_global:\n  registrar: secret:x/y/z\n";
+    close $recipe;
+
+    chdir($ROOT) or die "could not chdir to the sandbox: $!";
+}
+
+END {
+    chdir($OLDCWD) if $OLDCWD;
+}
+
+sub write_config {
+    my (%section) = @_;
+    open( my $fh, '>', "$ROOT/config/default.cfg" ) or die $!;
+    print {$fh} "[general]\n    data_model=FlatFile\n[provisioner]\n";
+    print {$fh} "    $_=$section{$_}\n" foreach sort keys %section;
+    close $fh;
+
+    # Trog::Config memoises, which is what a running server wants and a test
+    # emphatically does not.
+    no warnings qw{once redefine};
+    require Config::Simple;
+    my $conf = Config::Simple->new("$ROOT/config/default.cfg");
+    local $@;
+    *Trog::Config::get = sub { return $conf };
+    return;
+}
+
+require_ok('Trog::DataSource::ProvisionedVirt') or BAIL_OUT("Can't find SUT");
+
+my $log = Test::MockModule->new('Trog::DataSource::ProvisionedVirt');
+$log->redefine( WARN => sub { note(shift) } );
+$log->redefine( INFO => sub { note(shift) } );
+
+# Nothing in this file forks, and nothing in it runs a provisioner.
+our @SPAWNED;
+$log->redefine(
+    _spawn => sub {
+        my ( $domain, $passphrase, $lifecycle, $user ) = @_;
+        push( @SPAWNED, { domain => $domain, passphrase => $passphrase, lifecycle => $lifecycle, user => $user } );
+        return ( 1, 'started' );
+    }
+);
+
+# Nor reaches a hypervisor.
+my $virt = Test::MockModule->new('Trog::DataSource::Virt');
+$virt->redefine( _is_self => sub { return $_[0] eq 'thisserver.example.com' ? 1 : 0 } );
+
+write_config(
+    provisioners     => "$ROOT/provisioners",
+    trog_provisioner => "$ROOT/trog-provisioner",
+);
+
+sub reprovision {
+    @SPAWNED = ();
+    return Trog::DataSource::ProvisionedVirt::reprovision( passphrase => 'hunter2', user => 'admin', @_ );
+}
+
+subtest 'it is Virt, with more' => sub {
+    ok( Trog::DataSource::ProvisionedVirt->isa('Trog::DataSource::Virt'), 'it is a Virt' );
+
+    # can() resolves through @ISA, which is how the datasource dispatcher finds
+    # the halves this does not override.
+    foreach my $inherited (qw{filter lang help}) {
+        my $mine   = Trog::DataSource::ProvisionedVirt->can($inherited);
+        my $theirs = Trog::DataSource::Virt->can($inherited);
+        is( $mine, $theirs, "$inherited is the one Virt already had" );
+    }
+
+    # Virt has no order() of its own, so this correctly finds none and the
+    # dispatcher falls back to Trog::DataSource::order.
+    ok( !Trog::DataSource::ProvisionedVirt->can('order'), 'and the shared default ordering still applies' );
+
+    # posts() is the one thing it does replace.
+    isnt(
+        Trog::DataSource::ProvisionedVirt->can('posts'),
+        Trog::DataSource::Virt->can('posts'),
+        'posts() is its own, since that is where the recipe is added'
+    );
+
+    is( Trog::DataSource::ProvisionedVirt->EDITABLE,  0, 'still nothing to edit' );
+    is( Trog::DataSource::ProvisionedVirt->CACHEABLE, 0, 'and still never cached, since a guest\'s state is live' );
+};
+
+subtest 'the recipe lands on the guest' => sub {
+    $virt->redefine(
+        posts => sub {
+            return (
+                { title => 'guest.example.com',      domain      => 'guest.example.com',      is_self => 0 },
+                { title => 'norecipe.example.com',   domain      => 'norecipe.example.com',   is_self => 0 },
+                { title => 'thisserver.example.com', domain      => 'thisserver.example.com', is_self => 1 },
+                { title => 'a hypervisor',           unreachable => 1,                        state   => 'nope' },
+            );
+        }
+    );
+
+    my @posts = Trog::DataSource::ProvisionedVirt::posts( {}, {} );
+    is( scalar(@posts), 4, 'every guest Virt listed is still listed' );
+
+    my ($provisioned) = grep { ( $_->{domain} // '' ) eq 'guest.example.com' } @posts;
+    ok( $provisioned->{has_recipe}, 'the one with a recipe says so' );
+    like( $provisioned->{recipe},      qr/registrar/,                             'and carries the recipe itself' );
+    like( $provisioned->{recipe_path}, qr{recipes\.d/guest\.example\.com\.yaml$}, 'and where it came from' );
+    is( $provisioned->{can_reprovision}, 1, 'and may be reprovisioned' );
+
+    my ($bare) = grep { ( $_->{domain} // '' ) eq 'norecipe.example.com' } @posts;
+    ok( !$bare->{has_recipe}, 'a guest with no recipe says so' );
+    is( $bare->{can_reprovision}, 0, 'and may not be reprovisioned' );
+    ok( exists $bare->{title}, 'but is listed all the same, since plenty of guests were not built by this' );
+
+    my ($self) = grep { ( $_->{domain} // '' ) eq 'thisserver.example.com' } @posts;
+    is( $self->{can_reprovision}, 0, 'the server drawing the page may never be reprovisioned' );
+
+    my ($dead) = grep { $_->{unreachable} } @posts;
+    ok( !$dead->{has_recipe}, 'an unreachable hypervisor is left exactly as it was' );
+};
+
+subtest 'what it refuses to reprovision' => sub {
+    my ( $ok, $why ) = reprovision( domain => 'thisserver.example.com' );
+    is( $ok, 0, 'the server it is running on' );
+    like( $why, qr/this server/, 'and says why' );
+    is_deeply( \@SPAWNED, [], 'without running anything' );
+
+    ( $ok, $why ) = reprovision( domain => 'norecipe.example.com' );
+    is( $ok, 0, 'a guest with no recipe' );
+    like( $why, qr/no recipe/, 'and says why' );
+
+    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => '' );
+    is( $ok, 0, 'a run with no passphrase, which new_config would just hang waiting for' );
+    like( $why, qr/passphrase/, 'and says why' );
+
+    # The name reaches the filesystem and an argument list.
+    foreach my $bad ( '../../etc/passwd', 'guest;rm -rf /', 'guest example.com', '', 'a' x 300, '.hidden' ) {
+        my ( $refused, $message ) = reprovision( domain => $bad );
+        is( $refused, 0, "'$bad' is refused" );
+        like( $message, qr/bad guest name|no recipe/, '...before anything is run' );
+    }
+
+    is_deeply( \@SPAWNED, [], 'and none of that ran a provisioner' );
+};
+
+subtest 'the lifecycle it would run' => sub {
+    my ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    is( $ok, 1, 'a guest with a recipe is accepted' ) or diag($why);
+    like( $why, qr/started/, 'and reports that it started rather than that it finished' );
+
+    is( scalar(@SPAWNED), 1, 'exactly one run' );
+    my $run = $SPAWNED[0];
+    is( $run->{domain}, 'guest.example.com', 'for the guest asked about' );
+    is( $run->{user},   'admin',             'recording who asked' );
+
+    # new_config in provisioners, then provision in trog-provisioner, each in
+    # its own repository.
+    is( scalar( @{ $run->{lifecycle} } ), 2, 'two steps' );
+    my ( $first, $second ) = @{ $run->{lifecycle} };
+    is( $first->[0], "$ROOT/provisioners", 'the first runs in provisioners' );
+    like( $first->[1], qr{/bin/new_config$}, 'and is new_config' );
+    is( $first->[2],  'guest.example.com',      'passed the guest as an argument' );
+    is( $second->[0], "$ROOT/trog-provisioner", 'the second runs in trog-provisioner' );
+    like( $second->[1], qr{/bin/provision$}, 'and is provision' );
+    is( $second->[2], 'guest.example.com', 'passed the same' );
+
+    # Arguments, not a command line: there is no shell between us and these, so
+    # a guest name can never be read as one.
+    foreach my $step ( @{ $run->{lifecycle} } ) {
+        is( scalar(@$step), 3, 'a directory, a program and one argument -- nothing to be parsed' );
+    }
+};
+
+subtest 'without the repositories configured it is just Virt' => sub {
+    write_config();
+
+    my ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    is( $ok, 0, 'nothing to run' );
+    like( $why, qr/not configured/, 'and says so plainly' );
+    is_deeply( \@SPAWNED, [], 'having run nothing' );
+
+    $virt->redefine( posts => sub { return ( { title => 'guest.example.com', domain => 'guest.example.com', is_self => 0 } ) } );
+    my ($post) = Trog::DataSource::ProvisionedVirt::posts( {}, {} );
+    ok( !$post->{has_recipe}, 'the listing still works' );
+    is( $post->{can_reprovision}, 0, 'it simply offers no button' );
+
+    # A path that is not there is a typo, and better found here than halfway
+    # through a reprovision.
+    write_config( provisioners => "$ROOT/nonesuch", trog_provisioner => "$ROOT/trog-provisioner" );
+    ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    is( $ok, 0, 'a configured path which is not there is refused' );
+
+    write_config(
+        provisioners     => "$ROOT/provisioners",
+        trog_provisioner => "$ROOT/trog-provisioner",
+    );
+};
+
+subtest 'the log is read back onto the page' => sub {
+    no warnings qw{once};
+
+    File::Path::make_path("$ROOT/logs/reprovision");
+    open( my $fh, '>', "$ROOT/logs/reprovision/guest.example.com.log" ) or die $!;
+    print {$fh} ( 'x' x 9000 ) . "\n=== finished ===\n";
+    close $fh;
+
+    my $tail = Trog::DataSource::ProvisionedVirt::_log_tail('guest.example.com');
+    ok( length($tail) <= $Trog::DataSource::ProvisionedVirt::log_tail_bytes, 'only the tail of it' );
+    like( $tail, qr/=== finished ===/, 'which is the part that says how it went' );
+
+    is( Trog::DataSource::ProvisionedVirt::_log_tail('norecipe.example.com'), undef, 'nothing when it has never run' );
+    is( Trog::DataSource::ProvisionedVirt::_log_tail('../../etc/passwd'),     undef, 'and a name that is not one reads nothing' );
+};
+
+subtest 'the route' => sub {
+    no warnings qw{once};
+    require Trog::Routes::HTML;
+
+    my $route = $Trog::Routes::HTML::routes{'/guest/reprovision'};
+    ok( $route, 'is registered' );
+    is( $route->{method}, 'POST', 'POST only, since it is not a thing to do by following a link' );
+    is( $route->{auth},   1,      'and requires a login' );
+    ok( $route->{nocache}, 'and is never cached' );
+    ok( $route->{noindex}, 'nor indexed' );
+
+    my $tpsgi = bless {}, 'FakeTPSGI3';
+    {
+        no warnings qw{once};
+        *FakeTPSGI3::see_also  = sub { return [ 303, [ Location => $_[1] ], [''] ] };
+        *FakeTPSGI3::forbidden = sub { return [ 403, [], ['no'] ] };
+    }
+
+    # Admin only, like every other thing that changes a guest.
+    my $res = Trog::Routes::HTML::guest_reprovision( { user => 'bob', user_acls => ['public'], tpsgi => $tpsgi } );
+    is( $res->[0], 403, 'a non-admin is refused' );
+    is_deeply( \@SPAWNED, [], 'without running anything' );
+
+    $res = Trog::Routes::HTML::guest_reprovision( { user => '', user_acls => [], tpsgi => $tpsgi } );
+    is( $res->[0], 303, 'and somebody logged out is sent to log in' );
+
+    # The passphrase must not survive the request: this hash gets cloned, logged
+    # around and handed to renderers.
+    @SPAWNED = ();
+    my $query = { user => 'admin', user_acls => ['admin'], tpsgi => $tpsgi, guest => 'guest.example.com', passphrase => 'hunter2', to => '/vms' };
+    Trog::Routes::HTML::guest_reprovision($query);
+    is( scalar(@SPAWNED),        1,         'an admin gets their run' );
+    is( $SPAWNED[0]{passphrase}, 'hunter2', 'the passphrase reaches the lifecycle' );
+    ok( !exists $query->{passphrase}, 'and is gone from the query afterwards' );
+};
+
+done_testing();

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

@@ -0,0 +1,39 @@
+{
+   "properties": {
+      "preview": {
+         "type": "string",
+         "x-tcms-input": "text",
+         "x-tcms-label": "Console capture",
+         "x-tcms-private": true
+      },
+      "recipe": {
+         "type": "string",
+         "x-tcms-input": "textarea",
+         "x-tcms-label": "Provisioning recipe",
+         "x-tcms-private": true
+      },
+      "reprovision_log": {
+         "type": "string",
+         "x-tcms-input": "textarea",
+         "x-tcms-label": "Last reprovision",
+         "x-tcms-private": true
+      }
+   },
+   "type": "object",
+   "x-tcms-datasource": "Trog::DataSource::ProvisionedVirt",
+   "x-tcms-post-type": {
+      "body_form": "form_common.tx",
+      "generated": true,
+      "generator": "Trog::Routes::HTML::post_wizard_save",
+      "includes": [
+         "visibility.tx",
+         "acls.tx"
+      ],
+      "name": "provisioned_guests"
+   },
+   "x-tcms-relations": {
+      "hypervisors": {
+         "form": "hypervisor.tx"
+      }
+   }
+}

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

@@ -0,0 +1,87 @@
+<!-- Generated by the tCMS Post Type Wizard.  Regenerating this type will overwrite any hand edits. -->
+<div class="post <: $style :> <: $tiled ? 'tile' : '' :>">
+    : 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="tag guest-state guest-<: $post.is_active ? 'up bg-green' : 'down bg-red' :>"><: $post.state :></span>
+                : if ( $post.is_self ) {
+                <span class="guest-state guest-self tag" title="the server tCMS is running on">dom0</span>
+                : }
+                : if ( !$post.has_recipe ) {
+                <span class="tag guest-state" title="no recipes.d entry for this guest">unprovisioned</span>
+                : }
+            </h3>
+            <div class="postData responsive-text" id="postData-<: $post.id :>">
+                : # Declared private in the sidecar, so a reader who cannot edit
+                : # never receives it -- there is nothing here to remember to guard.
+                : if ( $post.preview ) {
+                    <a href="<: $post.preview :>" class="undecorated" title="console of <: $post.title :>">
+                        <img src="<: $post.preview :>" class="responsive-img guest-screenshot" alt="console of <: $post.title :>" loading="lazy" />
+                    </a>
+                    <br />
+                : }
+                on <: $post.hypervisor_title :> &mdash; <: $post.vcpus :> vCPU
+
+                : if ( $can_edit && $post.recipe ) {
+                <details class="guest-recipe">
+                    <summary>Recipe &mdash; <: $post.recipe_path :></summary>
+                    <pre class="guest-recipe-body"><: $post.recipe :></pre>
+                </details>
+                : }
+
+                : if ( $can_edit && $post.reprovision_log ) {
+                <details class="guest-reprovision-log">
+                    <summary>Last reprovision</summary>
+                    <pre class="guest-recipe-body"><: $post.reprovision_log :></pre>
+                </details>
+                : }
+
+                : 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="guest" value="<: $post.domain :>" />
+                    <input type="hidden" name="to" value="<: $route :>" />
+                    : # Trog::DataSource::Virt::act() refuses these for the
+                    : # server drawing the page.  Not offering them is not the guard.
+                    : # (A semicolon in a Kolon comment ends the statement, so do not.)
+                    : if ( !$post.is_self ) {
+                    : 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>
+                    : if ( !$post.is_self ) {
+                    <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>
+
+                : # Separate form, because this one carries a passphrase and has
+                : # no business sharing a submit with the buttons above.
+                : if ( $post.can_reprovision ) {
+                <form class="Submissions guest-reprovision" action="/guest/reprovision" method="POST" autocomplete="off">
+                    <input type="hidden" name="guest" value="<: $post.domain :>" />
+                    <input type="hidden" name="to" value="<: $route :>" />
+                    <label>
+                        Secrets passphrase
+                        <input required class="cooltext" type="password" name="passphrase" autocomplete="off"
+                               title="new_config asks for this on stdin; it is used for this run and not stored" />
+                    </label>
+                    <button class="coolbutton guest-destroy" type="submit"
+                            onclick="return confirm('Reprovision <: $post.title :>?  This destroys the guest and builds it again from its recipe.  Anything on it the recipe does not describe will not come back.');">Reprovision</button>
+                </form>
+                : }
+                : }
+            </div>
+        : }
+    : }
+</div>