Merge pull request #374 from Troglodyne-Internet-Widgets/compile-time

Enable CompileTime except for tests, and use test.test in tests

.perlcriticrc

@@ -297,4 +297,4 @@ allow_unused_subroutine_arguments = 1
 [Variables::RequireLocalizedPunctuationVars]
 [Variables::RequireNegativeIndices]
 # Extensions to perl -c
-#[CompileTime]
+[CompileTime]

git-hooks/pre-commit

@@ -130,16 +130,17 @@ then
         perlcritic --profile .perlcriticrc $lib_files || critic_failed=1
     fi
 
-    # The same profile for t/, less two policies.  A test is not a module: nobody
-    # runs perldoc on it, so requiring POD of it asks for a page no reader will
-    # ever open.  And a test sets %ENV and %INC for the whole file, in a BEGIN
-    # block before the SUT loads, where a local would end with the block.
+    # The same profile for t/, less three policies.  A test is not a module:
+    # nobody runs perldoc on it, so requiring POD of it asks for a page no
+    # reader will ever open.  And a test sets %ENV and %INC, and writes its
+    # fixtures, in a BEGIN block before the SUT loads, for the whole file: a
+    # local would end with the block, and no compiled binary is made of a test.
     # Everything else in the profile still judges it, which is more than a
     # release does -- all_critic_ok() reads lib/ and not t/, so this hook is the
     # only thing that looks at a test file at all.
     if [ -n "$test_files" ]
     then
-        perlcritic --profile .perlcriticrc --exclude Documentation::RequirePod --exclude Variables::RequireLocalizedPunctuationVars $test_files || critic_failed=1
+        perlcritic --profile .perlcriticrc --exclude Documentation::RequirePod --exclude Variables::RequireLocalizedPunctuationVars --exclude CompileTime $test_files || critic_failed=1
     fi
 
     if [ -n "$critic_failed" ]

t/Trog-Auth-libravatar.t

@@ -28,8 +28,8 @@ subtest 'users_with_emails -- no rows returned' => sub {
 
 subtest 'users_with_emails -- returns populated list' => sub {
     my $fake_rows = [
-        { name => 'alice', contact_email => 'alice@example.com' },
-        { name => 'bob',   contact_email => 'bob@example.com' },
+        { name => 'alice', contact_email => 'alice@test.test' },
+        { name => 'bob',   contact_email => 'bob@test.test' },
     ];
     my $sqlite_mock = Test::MockModule->new('Trog::SQLite');
     $sqlite_mock->redefine(
@@ -42,11 +42,11 @@ subtest 'users_with_emails -- returns populated list' => sub {
         }
     );
     my $result = Trog::Auth::users_with_emails();
-    is( ref $result,                 'ARRAY',             'returns arrayref' );
-    is( scalar @$result,             2,                   'correct number of users' );
-    is( $result->[0]{name},          'alice',             'first user name' );
-    is( $result->[0]{contact_email}, 'alice@example.com', 'first user email' );
-    is( $result->[1]{name},          'bob',               'second user name' );
+    is( ref $result,                 'ARRAY',           'returns arrayref' );
+    is( scalar @$result,             2,                 'correct number of users' );
+    is( $result->[0]{name},          'alice',           'first user name' );
+    is( $result->[0]{contact_email}, 'alice@test.test', 'first user email' );
+    is( $result->[1]{name},          'bob',             'second user name' );
 };
 
 subtest 'libravatar hash matching logic' => sub {
@@ -68,10 +68,10 @@ subtest 'libravatar hash matching logic' => sub {
 
     # Simulate the lookup: given a hash, find the matching email
     my @users = (
-        { name => 'alice', contact_email => 'alice@example.com' },
-        { name => 'bob',   contact_email => 'bob@example.com' },
+        { name => 'alice', contact_email => 'alice@test.test' },
+        { name => 'bob',   contact_email => 'bob@test.test' },
     );
-    my $target_hash = sha256_hex( lc('alice@example.com') );
+    my $target_hash = sha256_hex( lc('alice@test.test') );
     my $matched;
     for my $u (@users) {
         my $e = lc( $u->{contact_email} );
@@ -82,7 +82,7 @@ subtest 'libravatar hash matching logic' => sub {
     }
     is( $matched, 'alice', 'SHA-256 lookup finds the correct user' );
 
-    my $target_md5 = md5_hex( lc('bob@example.com') );
+    my $target_md5 = md5_hex( lc('bob@test.test') );
     $matched = undef;
     for my $u (@users) {
         my $e = lc( $u->{contact_email} );

t/Trog-Auth-totp-mandatory.t

@@ -39,7 +39,7 @@ BEGIN {
     File::Copy::copy( "$REPO/schema/$_", "$ROOT/schema/$_" ) or die $! for qw{auth.schema flatfile.schema log.schema};
 
     open( my $fh, '>', "$ROOT/config/default.cfg" ) or die $!;
-    print {$fh} "[general]\n    data_model=FlatFile\n    hostname=totp.example.com\n";
+    print {$fh} "[general]\n    data_model=FlatFile\n    hostname=totp.test.test\n";
     close($fh) or die $!;
 
     # Otherwise login() reads the instance as a fresh install and registers
@@ -58,7 +58,7 @@ require_ok('Trog::Auth') or BAIL_OUT("Can't find SUT");
 require_ok('TCMS')       or BAIL_OUT("Can't load the dispatcher");
 require_ok('Trog::Routes::HTML');
 
-Trog::Auth::useradd( 'bob', 'Bob Bobson', 'hunter2', ['admin'], 'bob@example.com' )
+Trog::Auth::useradd( 'bob', 'Bob Bobson', 'hunter2', ['admin'], 'bob@test.test' )
   or BAIL_OUT('could not make a user to test with');
 
 subtest 'a user starts out unenrolled' => sub {
@@ -82,7 +82,7 @@ subtest 'and cannot go anywhere but /totp until they enrol' => sub {
     # Nothing to enrol, and nothing to protect.
     is( TCMS::needs_enrolment( '', \%page ), 0, 'a logged out visitor is left alone' );
 
-    my ( $uri, undef, undef, $message ) = Trog::Auth::totp( 'bob', 'totp.example.com' );
+    my ( $uri, undef, undef, $message ) = Trog::Auth::totp( 'bob', 'totp.test.test' );
     ok( $uri, 'enrolling gives them a URI' ) or diag($message);
     is( Trog::Auth::has_totp('bob'), 1, 'and they are enrolled' );
 
@@ -93,8 +93,8 @@ subtest 'the enrolment does not change' => sub {
 
     # A user who lost their authenticator scans the same code into the next one,
     # which is what makes having no way to turn 2fa off a supportable position.
-    my ( $uri, $qr, $failure ) = Trog::Auth::totp( 'bob', 'totp.example.com' );
-    my ( $again, $qr2 ) = Trog::Auth::totp( 'bob', 'totp.example.com' );
+    my ( $uri, $qr, $failure ) = Trog::Auth::totp( 'bob', 'totp.test.test' );
+    my ( $again, $qr2 ) = Trog::Auth::totp( 'bob', 'totp.test.test' );
     is( $again,   $uri, 'asking again gives back the enrolment they already have' );
     is( $qr2,     $qr,  'and the same QR' );
     is( $failure, -1,   'reported as nothing new having been generated' );

t/Trog-Config.t

@@ -52,15 +52,15 @@ subtest 'a config written to home_cfg is the one that gets read back' => sub {
     my $written = Config::Simple->new( syntax => 'ini' );
     $written->param( 'general.data_model', 'FlatFile' );
     $written->param( 'general.title',      'Instance' );
-    $written->param( 'general.hostname',   'spec.example.com' );
+    $written->param( 'general.hostname',   'spec.test.test' );
     ok( $written->write($Trog::Config::home_cfg), 'wrote to home_cfg' );
 
     ok( -e 'config/main.cfg', 'which landed under config/, not the instance root' );
     ok( !-e 'main.cfg',       'and not loose in the root where nothing would read it' );
 
     my $read = Trog::Config::get();
-    is( $read->param('general.title'),    'Instance',         'get() picked up the written config' );
-    is( $read->param('general.hostname'), 'spec.example.com', 'including a key the defaults never had' );
+    is( $read->param('general.title'),    'Instance',       'get() picked up the written config' );
+    is( $read->param('general.hostname'), 'spec.test.test', 'including a key the defaults never had' );
 };
 
 subtest 'the shipped defaults are left alone' => sub {

t/Trog-DataSource-ProvisionedVirt.t

@@ -53,7 +53,7 @@ BEGIN {
     # provisioner keeps them rather than anywhere tCMS is told about.
     $ENV{TROG_PROVISIONER_CONFIG} = "$ROOT/etc";
     File::Path::make_path("$ROOT/etc/recipes.d");
-    open( my $recipe, '>', "$ROOT/etc/recipes.d/guest.example.com.yaml" ) or die $!;
+    open( my $recipe, '>', "$ROOT/etc/recipes.d/guest.test.test.yaml" ) or die $!;
     print {$recipe} "---\n_global:\n  registrar: secret:x/y/z\n";
     close($recipe) or die $!;
 
@@ -84,7 +84,7 @@ sub write_config {
 
 require_ok('Trog::DataSource::ProvisionedVirt') or BAIL_OUT("Can't find SUT");
 
-Trog::Auth::useradd( 'admin', 'The Admin', 'hunter2', ['admin'], 'admin@example.com' )
+Trog::Auth::useradd( 'admin', 'The Admin', 'hunter2', ['admin'], 'admin@test.test' )
   or BAIL_OUT('could not make a user to test with');
 
 my $log = Test::MockModule->new('Trog::DataSource::ProvisionedVirt');
@@ -103,7 +103,7 @@ $log->redefine(
 
 # 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 } );
+$virt->redefine( is_self => sub { return $_[0] eq 'thisserver.test.test' ? 1 : 0 } );
 
 write_config( trog_provisioner => "$ROOT/trog-provisioner" );
 
@@ -145,10 +145,10 @@ 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' },
+                { title => 'guest.test.test',      domain      => 'guest.test.test',      is_self => 0 },
+                { title => 'norecipe.test.test',   domain      => 'norecipe.test.test',   is_self => 0 },
+                { title => 'thisserver.test.test', domain      => 'thisserver.test.test', is_self => 1 },
+                { title => 'a hypervisor',         unreachable => 1,                      state   => 'nope' },
             );
         }
     );
@@ -156,18 +156,18 @@ subtest 'the recipe lands on the guest' => sub {
     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;
+    my ($provisioned) = grep { ( $_->{domain} // '' ) eq 'guest.test.test' } @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' );
+    like( $provisioned->{recipe},      qr/registrar/,                           'and carries the recipe itself' );
+    like( $provisioned->{recipe_path}, qr{recipes\.d/guest\.test\.test\.yaml$}, 'and where it came from' );
     is( $provisioned->{can_reprovision}, 1, 'and may be reprovisioned' );
 
-    my ($bare) = grep { ( $_->{domain} // '' ) eq 'norecipe.example.com' } @posts;
+    my ($bare) = grep { ( $_->{domain} // '' ) eq 'norecipe.test.test' } @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;
+    my ($self) = grep { ( $_->{domain} // '' ) eq 'thisserver.test.test' } @posts;
     is( $self->{can_reprovision}, 0, 'the server drawing the page may never be reprovisioned' );
 
     my ($dead) = grep { $_->{unreachable} } @posts;
@@ -175,21 +175,21 @@ subtest 'the recipe lands on the guest' => sub {
 };
 
 subtest 'what it refuses to reprovision' => sub {
-    my ( $ok, $why ) = reprovision( domain => 'thisserver.example.com' );
+    my ( $ok, $why ) = reprovision( domain => 'thisserver.test.test' );
     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' );
+    ( $ok, $why ) = reprovision( domain => 'norecipe.test.test' );
     is( $ok, 0, 'a guest with no recipe' );
     like( $why, qr/no[ ]recipe/, 'and says why' );
 
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => '' );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => '' );
     is( $ok, 0, 'a run with no passphrase, which the provisioner 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' ) {
+    foreach my $bad ( '../../etc/passwd', 'guest;rm -rf /', 'guest test.test', '', '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' );
@@ -199,21 +199,21 @@ subtest 'what it refuses to reprovision' => sub {
 };
 
 subtest 'what it would run' => sub {
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test' );
     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' );
+    is( $run->{domain}, 'guest.test.test', 'for the guest asked about' );
+    is( $run->{user},   'admin',           'recording who asked' );
 
     # One program does the whole of it now: bin/provision generates the guest's
     # configuration from its recipe and then builds the machine.
     is( $run->{dir}, "$ROOT/trog-provisioner", 'run from the checkout' );
     like( $run->{command}[0], qr{/bin/provision$}, 'and it is bin/provision' );
-    is( $run->{command}[1], '--credentials',     'told that its passwords are coming on stdin' );
-    is( $run->{command}[2], 'guest.example.com', 'and passed the guest as an argument' );
+    is( $run->{command}[1], '--credentials',   'told that its passwords are coming on stdin' );
+    is( $run->{command}[2], 'guest.test.test', 'and passed the guest as an argument' );
 
     # Arguments, not a command line: there is no shell between us and this, so a
     # guest name can never be read as one.
@@ -225,19 +225,19 @@ subtest 'a stored passphrase, and a code instead of one' => sub {
 
     # Nothing stored yet, so the form asks for the passphrase and offers to keep
     # it -- there is a vault key in this sandbox, so keeping it is on the table.
-    $virt->redefine( posts => sub { return ( { title => 'guest.example.com', domain => 'guest.example.com', is_self => 0 } ) } );
+    $virt->redefine( posts => sub { return ( { title => 'guest.test.test', domain => 'guest.test.test', is_self => 0 } ) } );
     my ($post) = Trog::DataSource::ProvisionedVirt::posts( {}, { user => 'admin' } );
     is( $post->{passphrase_remembered}, 0, 'with nothing stored the form asks for the passphrase' );
     is( $post->{can_remember},          1, 'and can offer to remember it' );
 
     # A code is worth nothing when there is nothing stored to unlock: it is
     # proof somebody is here, not a password.
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => undef, totp => '123456' );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => undef, totp => '123456' );
     is( $ok, 0, 'a code with nothing stored behind it does not provision' );
     is_deeply( \@SPAWNED, [], 'having run nothing' );
 
     # Reprovision the old way, and ask for it to be kept.
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => 'correct horse', remember => 1 );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => 'correct horse', remember => 1 );
     is( $ok,                               1,               'a typed passphrase still provisions' ) or diag($why);
     is( $SPAWNED[0]{credentials}{keepass}, 'correct horse', 'and is what reaches the provisioner' );
 
@@ -246,17 +246,17 @@ subtest 'a stored passphrase, and a code instead of one' => sub {
 
     # And now the point of all of it: a code, spent, exchanged for what was
     # stored.  Enrol first -- a code is only meaningful for somebody enrolled.
-    my ( $uri, undef, undef, $message, $totp ) = Trog::Auth::totp( 'admin', 'example.com' );
+    my ( $uri, undef, undef, $message, $totp ) = Trog::Auth::totp( 'admin', 'test.test' );
     ok( $uri, 'the user is enrolled' ) or diag($message);
     my $code = $totp->expected_totp_code( time() );
 
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => undef, totp => $code );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => undef, totp => $code );
     is( $ok,                               1,               'a code provisions' ) or diag($why);
     is( $SPAWNED[0]{credentials}{keepass}, 'correct horse', 'handing the provisioner the passphrase that was stored' );
 
     # Spent, so it is worth this one reprovision and not every reprovision
     # somebody can click inside the window.
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => undef, totp => $code );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => undef, totp => $code );
     is( $ok, 0, 'and cannot be used again' );
     like( $why, qr/already[ ]been[ ]used/, 'saying so' );
     is_deeply( \@SPAWNED, [], 'without running a second one' );
@@ -267,7 +267,7 @@ subtest 'a stored passphrase, and a code instead of one' => sub {
 subtest 'the sudo password on the hypervisor' => sub {
     no warnings qw{once};
 
-    $virt->redefine( posts => sub { return ( { title => 'guest.example.com', domain => 'guest.example.com', is_self => 0 } ) } );
+    $virt->redefine( posts => sub { return ( { title => 'guest.test.test', domain => 'guest.test.test', is_self => 0 } ) } );
     Trog::Vault::forget( 'admin', $Trog::DataSource::ProvisionedVirt::secret_name );
     Trog::Vault::forget( 'admin', $Trog::DataSource::ProvisionedVirt::sudo_name );
 
@@ -276,29 +276,29 @@ subtest 'the sudo password on the hypervisor' => sub {
 
     # The ordinary case, and the reason the field is not required: the login on
     # the hypervisor has passwordless sudo, so there is nothing to send.
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => 'correct horse' );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => 'correct horse' );
     is( $ok, 1, 'a reprovision with no sudo password still runs' ) or diag($why);
     ok( !exists $SPAWNED[0]{credentials}{sudo}, 'and sends none, rather than sending an empty one' );
 
     # And the case this is for: a hypervisor that wants one.  sudo over ssh has
     # no terminal to ask at, so the run would otherwise die minutes in.
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => 'correct horse', sudo => 'hunter2' );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => 'correct horse', sudo => 'hunter2' );
     is( $ok,                               1,               'one with a sudo password runs too' ) or diag($why);
     is( $SPAWNED[0]{credentials}{sudo},    'hunter2',       'and it reaches the provisioner' );
     is( $SPAWNED[0]{credentials}{keepass}, 'correct horse', 'alongside the passphrase, not instead of it' );
 
     # Kept, so the next run is a code and neither has to be typed again.
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => 'correct horse', sudo => 'hunter2', remember => 1 );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => 'correct horse', sudo => 'hunter2', remember => 1 );
     is( $ok, 1, 'both can be remembered' ) or diag($why);
     ($post) = Trog::DataSource::ProvisionedVirt::posts( {}, { user => 'admin' } );
     is( $post->{passphrase_remembered}, 1, 'after which the passphrase is stored' );
     is( $post->{sudo_remembered},       1, 'and so is the sudo password' );
 
-    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'admin', 'example.com' );
+    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'admin', 'test.test' );
     require Trog::SQLite;
     Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' )->do("DELETE FROM totp_spent WHERE username='admin'");
 
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => undef, totp => $totp->expected_totp_code( time() ) );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => undef, totp => $totp->expected_totp_code( time() ) );
     is( $ok,                               1,               'a code unlocks the pair' ) or diag($why);
     is( $SPAWNED[0]{credentials}{keepass}, 'correct horse', 'the passphrase' );
     is( $SPAWNED[0]{credentials}{sudo},    'hunter2',       'and the sudo password' );
@@ -306,7 +306,7 @@ subtest 'the sudo password on the hypervisor' => sub {
     # Typed beats stored: somebody typing it has a reason to, and it is usually
     # that the stored one stopped working.
     Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' )->do("DELETE FROM totp_spent WHERE username='admin'");
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => undef, sudo => 'changed it', totp => $totp->expected_totp_code( time() ) );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => undef, sudo => 'changed it', totp => $totp->expected_totp_code( time() ) );
     is( $ok,                            1,            'a code and a typed sudo password together' ) or diag($why);
     is( $SPAWNED[0]{credentials}{sudo}, 'changed it', 'send what was typed' );
 
@@ -319,12 +319,12 @@ subtest 'a password with a line break in it is refused' => sub {
     # One 'name: value' per line is the format on the far side, so a newline in
     # a value is a second line -- and the second line could name a credential
     # nobody asked us to send.
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => "correct horse\nsudo: injected" );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => "correct horse\nsudo: injected" );
     is( $ok, 0, 'a passphrase carrying a line break does not run' );
     like( $why, qr/line[ ]break/, 'saying so' );
     is_deeply( \@SPAWNED, [], 'having run nothing' );
 
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => 'correct horse', sudo => "hunter2\nkeepass: not this" );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => 'correct horse', sudo => "hunter2\nkeepass: not this" );
     is( $ok, 0, 'and neither does a sudo password carrying one' );
     like( $why, qr/line[ ]break/, 'saying so too' );
     is_deeply( \@SPAWNED, [], 'having run nothing' );
@@ -337,7 +337,7 @@ subtest 'and when the vault key has gone' => sub {
     # consequence of rebuilding one rather than a disaster.  What must not
     # happen is the page going on asking for a code it cannot honour.
     Trog::Vault::set( 'admin', $Trog::DataSource::ProvisionedVirt::secret_name, 'correct horse' );
-    $virt->redefine( posts => sub { return ( { title => 'guest.example.com', domain => 'guest.example.com', is_self => 0 } ) } );
+    $virt->redefine( posts => sub { return ( { title => 'guest.test.test', domain => 'guest.test.test', is_self => 0 } ) } );
 
     my ($post) = Trog::DataSource::ProvisionedVirt::posts( {}, { user => 'admin' } );
     is( $post->{passphrase_remembered}, 1, 'with the key here, the form asks for a code' );
@@ -350,7 +350,7 @@ subtest 'and when the vault key has gone' => sub {
 
     # Posted at directly, as somebody would from a page drawn a moment before
     # the key went away.
-    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'admin', 'example.com' );
+    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'admin', 'test.test' );
 
     # The subtest above spent this window's codes.  Standing here for thirty
     # seconds would say the same thing and cost thirty seconds.
@@ -358,7 +358,7 @@ subtest 'and when the vault key has gone' => sub {
     Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' )->do("DELETE FROM totp_spent WHERE username='admin'");
 
     my $code = $totp->expected_totp_code( time() );
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => undef, totp => $code );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => undef, totp => $code );
     is( $ok, 0, 'a code is refused rather than exploding' );
     like( $why, qr/can[ ]open/, 'saying the passphrase cannot be opened' );
     like( $why, qr{/secrets},   'and where to go about it' );
@@ -370,7 +370,7 @@ subtest 'and when the vault key has gone' => sub {
     ( $ok, $why ) = Trog::Auth::spend_totp( 'admin', $code );
     is( $ok, 1, 'the code was not spent on being told no' ) or diag($why);
 
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com', passphrase => 'typed it again', remember => 1 );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test', passphrase => 'typed it again', remember => 1 );
     is( $ok,                               1,                'and the passphrase still provisions' ) or diag($why);
     is( $SPAWNED[0]{credentials}{keepass}, 'typed it again', 'with what was typed' );
 
@@ -381,12 +381,12 @@ subtest 'and when the vault key has gone' => sub {
 subtest 'without the provisioner configured it is just Virt' => sub {
     write_config();
 
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test' );
     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 } ) } );
+    $virt->redefine( posts => sub { return ( { title => 'guest.test.test', domain => 'guest.test.test', 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' );
@@ -394,7 +394,7 @@ subtest 'without the provisioner configured it is just Virt' => sub {
     # A path that is not there is a typo, and better found here than halfway
     # through a reprovision.
     write_config( trog_provisioner => "$ROOT/nonesuch" );
-    ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    ( $ok, $why ) = reprovision( domain => 'guest.test.test' );
     is( $ok, 0, 'a configured path which is not there is refused' );
     like( $why, qr/not[ ]configured/, 'the same as never having configured one' );
 
@@ -405,23 +405,23 @@ 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 $!;
+    open( my $fh, '>', "$ROOT/logs/reprovision/guest.test.test.log" ) or die $!;
     print {$fh} ( 'x' x 9000 ) . "\n=== finished ===\n";
     close($fh) or die $!;
 
-    my $tail = Trog::DataSource::ProvisionedVirt::log_tail('guest.example.com');
+    my $tail = Trog::DataSource::ProvisionedVirt::log_tail('guest.test.test');
     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' );
+    is( Trog::DataSource::ProvisionedVirt::log_tail('norecipe.test.test'), 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 state a reprovision leaves behind' => sub {
     no warnings qw{once};
     File::Path::make_path("$ROOT/logs/reprovision");
 
-    my $status = "$ROOT/logs/reprovision/guest.example.com.status";
+    my $status = "$ROOT/logs/reprovision/guest.test.test.status";
     my $write  = sub {
         open( my $fh, '>', $status ) or die $!;
         print {$fh} join( '', map { "$_\n" } @_ );
@@ -431,18 +431,18 @@ subtest 'the state a reprovision leaves behind' => sub {
     # Nothing waits on the process which does the work, so this file is the
     # whole of what it can say for itself.
     $write->(qw{state=ok started=100 finished=200 exit=0 user=admin});
-    my $got = Trog::DataSource::ProvisionedVirt::status('guest.example.com');
+    my $got = Trog::DataSource::ProvisionedVirt::status('guest.test.test');
     is( $got->{state},    'ok',    'a finished run reads back as finished' );
     is( $got->{exit},     '0',     'with what it exited' );
     is( $got->{user},     'admin', 'and who asked for it' );
     is( $got->{finished}, '200',   'and when it stopped' );
 
     $write->(qw{state=failed exit=3 failed=/x/bin/provision});
-    is( Trog::DataSource::ProvisionedVirt::status('guest.example.com')->{state}, 'failed', 'a failed one reads back failed' );
+    is( Trog::DataSource::ProvisionedVirt::status('guest.test.test')->{state}, 'failed', 'a failed one reads back failed' );
 
     # A live pid means it really is going on.  Ours is alive by definition.
     $write->( 'state=running', "pid=$$", 'started=100', 'user=admin' );
-    is( Trog::DataSource::ProvisionedVirt::status('guest.example.com')->{state}, 'running', 'a run whose process is alive is running' );
+    is( Trog::DataSource::ProvisionedVirt::status('guest.test.test')->{state}, 'running', 'a run whose process is alive is running' );
 
     # And a dead one means it stopped without saying so, which is the case that
     # would otherwise leave the page claiming a provision forever.
@@ -450,20 +450,20 @@ subtest 'the state a reprovision leaves behind' => sub {
     $dead++ while kill( 0, $dead ) && $dead < 4194304;
     $write->( 'state=running', "pid=$dead", 'started=100' );
     is(
-        Trog::DataSource::ProvisionedVirt::status('guest.example.com')->{state},
+        Trog::DataSource::ProvisionedVirt::status('guest.test.test')->{state},
         'interrupted',
         'a run whose process is gone reads as interrupted, not as still going'
     );
 
     $write->('state=running');
-    is( Trog::DataSource::ProvisionedVirt::status('guest.example.com')->{state}, 'interrupted', 'and so does one with no pid at all' );
+    is( Trog::DataSource::ProvisionedVirt::status('guest.test.test')->{state}, 'interrupted', 'and so does one with no pid at all' );
 
     # Half a file is not a status.
     $write->('garbage');
-    is( Trog::DataSource::ProvisionedVirt::status('guest.example.com'), undef, 'an unparseable status is no status' );
+    is( Trog::DataSource::ProvisionedVirt::status('guest.test.test'), undef, 'an unparseable status is no status' );
 
-    is( Trog::DataSource::ProvisionedVirt::status('never.example.com'), undef, 'nothing for a guest that has never run' );
-    is( Trog::DataSource::ProvisionedVirt::status('../../etc/passwd'),  undef, 'and a name that is not one reads nothing' );
+    is( Trog::DataSource::ProvisionedVirt::status('never.test.test'),  undef, 'nothing for a guest that has never run' );
+    is( Trog::DataSource::ProvisionedVirt::status('../../etc/passwd'), undef, 'and a name that is not one reads nothing' );
 
     unlink($status);
 };
@@ -472,27 +472,27 @@ subtest 'the listing says what is going on' => sub {
     no warnings qw{once};
     File::Path::make_path("$ROOT/logs/reprovision");
 
-    my $status = "$ROOT/logs/reprovision/guest.example.com.status";
-    open( my $out, '>', "$ROOT/logs/reprovision/guest.example.com.log" ) or die $!;
+    my $status = "$ROOT/logs/reprovision/guest.test.test.status";
+    open( my $out, '>', "$ROOT/logs/reprovision/guest.test.test.log" ) or die $!;
     print {$out} "some output\n";
     close($out) or die $!;
 
-    $virt->redefine( posts => sub { return ( { title => 'guest.example.com', domain => 'guest.example.com', is_self => 0 } ) } );
+    $virt->redefine( posts => sub { return ( { title => 'guest.test.test', domain => 'guest.test.test', is_self => 0 } ) } );
 
     open( my $fh, '>', $status ) or die $!;
     print {$fh} "state=running\npid=$$\nstarted=100\nuser=admin\n";
     close($fh) or die $!;
 
     my ($post) = Trog::DataSource::ProvisionedVirt::posts( {}, {} );
-    is( $post->{reprovision_state},    'running',                                  'the guest says it is reprovisioning' );
-    is( $post->{reprovision_status},   'reprovisioning',                           'in words a person reads' );
-    is( $post->{is_reprovisioning},    1,                                          'and is flagged as busy' );
-    is( $post->{reprovision_by},       'admin',                                    'naming who started it' );
-    is( $post->{can_reprovision},      0,                                          'and offers no button while one is going on' );
-    is( $post->{reprovision_log_href}, '/guest/reprovision/log/guest.example.com', 'with a link to read the log' );
+    is( $post->{reprovision_state},    'running',                                'the guest says it is reprovisioning' );
+    is( $post->{reprovision_status},   'reprovisioning',                         'in words a person reads' );
+    is( $post->{is_reprovisioning},    1,                                        'and is flagged as busy' );
+    is( $post->{reprovision_by},       'admin',                                  'naming who started it' );
+    is( $post->{can_reprovision},      0,                                        'and offers no button while one is going on' );
+    is( $post->{reprovision_log_href}, '/guest/reprovision/log/guest.test.test', 'with a link to read the log' );
 
     # Starting a second one is refused for the same reason.
-    my ( $ok, $why ) = reprovision( domain => 'guest.example.com' );
+    my ( $ok, $why ) = reprovision( domain => 'guest.test.test' );
     is( $ok, 0, 'and a second run is refused while the first is going' );
     like( $why, qr/already[ ]running/, 'saying so' );
     is_deeply( \@SPAWNED, [], 'having started nothing' );
@@ -517,20 +517,20 @@ subtest 'the listing says what is going on' => sub {
 subtest 'reading the log' => sub {
     no warnings qw{once};
 
-    is( Trog::DataSource::ProvisionedVirt::log_for('never.example.com'), undef, 'nothing when there has been no run' );
-    is( Trog::DataSource::ProvisionedVirt::log_for('../../etc/passwd'),  undef, 'and a name that is not one reads nothing' );
+    is( Trog::DataSource::ProvisionedVirt::log_for('never.test.test'),  undef, 'nothing when there has been no run' );
+    is( Trog::DataSource::ProvisionedVirt::log_for('../../etc/passwd'), undef, 'and a name that is not one reads nothing' );
 
-    open( my $fh, '>', "$ROOT/logs/reprovision/guest.example.com.log" ) or die $!;
+    open( my $fh, '>', "$ROOT/logs/reprovision/guest.test.test.log" ) or die $!;
     print {$fh} "the whole log\n";
     close($fh) or die $!;
-    like( Trog::DataSource::ProvisionedVirt::log_for('guest.example.com'), qr/the[ ]whole[ ]log/, 'and the whole of it when there has' );
+    like( Trog::DataSource::ProvisionedVirt::log_for('guest.test.test'), qr/the[ ]whole[ ]log/, 'and the whole of it when there has' );
 
     # A provisioner can be chatty, and this goes out in one response.
     local $Trog::DataSource::ProvisionedVirt::log_max_bytes = 64;
-    open( $fh, '>', "$ROOT/logs/reprovision/guest.example.com.log" ) or die $!;
+    open( $fh, '>', "$ROOT/logs/reprovision/guest.test.test.log" ) or die $!;
     print {$fh} ( 'x' x 500 ) . "END\n";
     close($fh) or die $!;
-    my $capped = Trog::DataSource::ProvisionedVirt::log_for('guest.example.com');
+    my $capped = Trog::DataSource::ProvisionedVirt::log_for('guest.test.test');
     like( $capped, qr/truncated/, 'a huge one is truncated' );
     like( $capped, qr/END/,       'keeping the end, which is where the answer is' );
 };
@@ -565,7 +565,7 @@ subtest 'the route' => sub {
     # 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', sudo => 'letmein', to => '/vms' };
+    my $query = { user => 'admin', user_acls => ['admin'], tpsgi => $tpsgi, guest => 'guest.test.test', passphrase => 'hunter2', sudo => 'letmein', to => '/vms' };
     Trog::Routes::HTML::guest_reprovision($query);
     is( scalar(@SPAWNED),                  1,         'an admin gets their run' );
     is( $SPAWNED[0]{credentials}{keepass}, 'hunter2', 'the passphrase reaches the provisioner' );
@@ -585,7 +585,7 @@ subtest 'the route' => sub {
     $res = Trog::Routes::HTML::guest_reprovision_log( { user => 'bob', user_acls => ['public'], tpsgi => $tpsgi } );
     is( $res->[0], 403, 'a non-admin cannot read it' );
 
-    $res = Trog::Routes::HTML::guest_reprovision_log( { user => 'admin', user_acls => ['admin'], tpsgi => $tpsgi, guest => 'never.example.com' } );
+    $res = Trog::Routes::HTML::guest_reprovision_log( { user => 'admin', user_acls => ['admin'], tpsgi => $tpsgi, guest => 'never.test.test' } );
     is( $res->[0], 404, 'and a guest with no log is a 404 rather than an empty page' );
 };
 

t/Trog-DataSource.t

@@ -248,7 +248,7 @@ BEGIN {
         return grep { $_->{title} eq 'beta' } @p;
     }
     sub lang { return 'Picky search' }
-    sub help { return 'https://example.com/picky' }
+    sub help { return 'https://test.test/picky' }
 
     # One whose filter blows up.
     package Trog::DataSource::TestBroken;
@@ -329,7 +329,7 @@ subtest 'the search box says what it is searching' => sub {
     {
         no warnings qw{once};
         *FakeModel::lang = sub { 'Model language' };
-        *FakeModel::help = sub { 'https://example.com/model' };
+        *FakeModel::help = sub { 'https://test.test/model' };
     }
 
     my $meta = Test::MockModule->new('Trog::DataModule');
@@ -339,12 +339,12 @@ subtest 'the search box says what it is searching' => sub {
     $source = undef;
     is_deeply(
         [ Trog::Routes::HTML::search_language( { primary_post => { child_form => 'blog.tx' } } ) ],
-        [ 'Model language', 'https://example.com/model' ],
+        [ 'Model language', 'https://test.test/model' ],
         'an ordinary page advertises the data model'
     );
     is_deeply(
         [ Trog::Routes::HTML::search_language( {} ) ],
-        [ 'Model language', 'https://example.com/model' ],
+        [ 'Model language', 'https://test.test/model' ],
         'and so does a page with no series at all'
     );
 
@@ -360,7 +360,7 @@ subtest 'the search box says what it is searching' => sub {
     $source = 'Trog::DataSource::TestPicky';
     is_deeply(
         [ Trog::Routes::HTML::search_language( { primary_post => { child_form => 'fake.tx' } } ) ],
-        [ 'Picky search', 'https://example.com/picky' ],
+        [ 'Picky search', 'https://test.test/picky' ],
         'or its own, when it has one'
     );
 };

t/Trog-Routes-HTML-config.t

@@ -35,7 +35,7 @@ Path::Tiny->new('config/default.cfg')->spew_utf8(<<'CFG');
     # Which directory under www/themes to render with.
     theme=
     title=Stock
-    hostname=stock.example.com
+    hostname=stock.test.test
 [security]
     allow_embeds_from=vimeo.com *.vimeo.com youtube.com *.youtube.com www.youtube-nocookie.com
 CFG
@@ -45,7 +45,7 @@ CFG
 Path::Tiny->new('config/main.cfg')->spew_utf8(<<'CFG');
 [general]
 theme=spec
-hostname=spec.example.com
+hostname=spec.test.test
 title=
 CFG
 
@@ -71,8 +71,8 @@ subtest 'the form is the shape of the defaults' => sub {
 };
 
 subtest 'fields carry what the instance is running with' => sub {
-    is( $field{'general.hostname'}{value},   'spec.example.com', 'a setting this instance overrode shows its value' );
-    is( $field{'general.data_model'}{value}, 'FlatFile',         '...and one it never touched falls back to the default' );
+    is( $field{'general.hostname'}{value},   'spec.test.test', 'a setting this instance overrode shows its value' );
+    is( $field{'general.data_model'}{value}, 'FlatFile',       '...and one it never touched falls back to the default' );
 
     # Blanking a setting is how you turn it off, so the defaults must not creep
     # back in and get re-saved on the next commit.

t/Trog-Routes-HTML-series-lifecycle.t

@@ -249,7 +249,7 @@ our $TPSGI = Test::TPSGI->new();
 
 our $ADMIN_USER    = 'specadmin';
 our $ADMIN_DISPLAY = 'Spec Admin';
-our $ADMIN_EMAIL   = 'specadmin@example.com';
+our $ADMIN_EMAIL   = 'specadmin@test.test';
 our $ADMIN_PASS    = 'spec-password';
 
 #--------------------------------------------------------------------------
@@ -1127,7 +1127,7 @@ subtest 'microblog' => sub {
         'microblog child',
         form       => 'microblog.tx',
         title      => 'Spec Microblog Child',
-        href       => 'https://example.com/spec',
+        href       => 'https://test.test/spec',
         data       => 'Spec microblog body.',
         visibility => 'public',
         tags       => ['specmicroblog'],
@@ -1136,7 +1136,7 @@ subtest 'microblog' => sub {
 
     my $body = series_page( 'microblog', 'specmicroblog', $title, 1 ) or return;
 
-    my $link = q{href='https://example.com/spec' >Spec Microblog Child</a>};
+    my $link = q{href='https://test.test/spec' >Spec Microblog Child</a>};
     like( $body, qr{\Q$link\E},                      'title links out to href' );
     like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block rendered' );
     like( $body, qr/Spec[ ]microblog[ ]body\./,      'body text rendered' );

t/Trog-Vault.t

@@ -31,7 +31,7 @@ BEGIN {
     File::Copy::copy( "$REPO/schema/auth.schema", "$ROOT/schema/auth.schema" ) or die $!;
 
     open( my $fh, '>', "$ROOT/config/default.cfg" ) or die $!;
-    print {$fh} "[general]\n    data_model=FlatFile\n    hostname=vault.example.com\n";
+    print {$fh} "[general]\n    data_model=FlatFile\n    hostname=vault.test.test\n";
     close($fh) or die $!;
 
     # The key the way a deployment hands one over: base64, in the environment,
@@ -51,9 +51,9 @@ END {
 require_ok('Trog::Auth')  or BAIL_OUT("Can't find Trog::Auth");
 require_ok('Trog::Vault') or BAIL_OUT("Can't find SUT");
 
-Trog::Auth::useradd( 'bob', 'Bob Bobson', 'hunter2', ['admin'], 'bob@example.com' )
+Trog::Auth::useradd( 'bob', 'Bob Bobson', 'hunter2', ['admin'], 'bob@test.test' )
   or BAIL_OUT('could not make a user to test with');
-Trog::Auth::useradd( 'eve', 'Eve Evilson', 'letmein', ['public'], 'eve@example.com' )
+Trog::Auth::useradd( 'eve', 'Eve Evilson', 'letmein', ['public'], 'eve@test.test' )
   or BAIL_OUT('could not make a second user');
 
 subtest 'the key is taken out of the environment' => sub {
@@ -214,7 +214,7 @@ subtest 'the other two places a key can be' => sub {
 };
 
 subtest 'a code is worth one thing' => sub {
-    my ( $uri, undef, undef, $message, $totp ) = Trog::Auth::totp( 'bob', 'vault.example.com' );
+    my ( $uri, undef, undef, $message, $totp ) = Trog::Auth::totp( 'bob', 'vault.test.test' );
     ok( $uri, 'bob is enrolled' ) or diag($message);
 
     my $now  = time();
@@ -284,7 +284,7 @@ subtest 'passwords are argon2id, and become it' => sub {
 };
 
 subtest 'logging in spends a code' => sub {
-    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'bob', 'vault.example.com' );
+    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'bob', 'vault.test.test' );
 
     # The subtest above spent the code for the window we are standing in, and
     # the counter only walks forwards.  Standing here for thirty seconds would
@@ -422,7 +422,7 @@ subtest 'a write the database refuses is an answer, not a crash' => sub {
     $dbh->do("DELETE FROM totp_spent WHERE username='bob'");
     $dbh->do("CREATE TEMP TRIGGER refuse_spend BEFORE INSERT ON totp_spent BEGIN SELECT RAISE(ABORT, 'refused for the test'); END");
 
-    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'bob', 'vault.example.com' );
+    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'bob', 'vault.test.test' );
     ( $ok, $why ) = Trog::Auth::spend_totp( 'bob', $totp->expected_totp_code( time() ) );
     $dbh->do("DROP TRIGGER temp.refuse_spend");