Merge pull request #367 from Troglodyne-Internet-Widgets/pod-and-classes

Fix the change request token check, spell POD in American English, and name character classes

.perlcriticrc

@@ -192,9 +192,9 @@ allow = re Exporter
 [ControlStructures::ProhibitUnreachableCode]
 [ControlStructures::ProhibitUntilBlocks]
 [ControlStructures::ProhibitYadaOperator]
-#[Documentation::PodSpelling]
-#spell_command = aspell --lang=en_US list
-#stop_words_file = .pod_stopwords
+[Documentation::PodSpelling]
+spell_command = aspell --lang=en_US list
+stop_words_file = .pod_stopwords
 [Documentation::RequirePackageMatchesPodName]
 [ErrorHandling::RequireCheckingReturnValueOfEval]
 [InputOutput::ProhibitExplicitStdin]
@@ -221,7 +221,7 @@ allow = re Exporter
 #[NamingConventions::Capitalization]
 [RegularExpressions::ProhibitCaptureWithoutTest]
 #[RegularExpressions::ProhibitComplexRegexes]
-#[RegularExpressions::ProhibitEnumeratedClasses]
+[RegularExpressions::ProhibitEnumeratedClasses]
 [RegularExpressions::ProhibitFixedStringMatches]
 [RegularExpressions::ProhibitSingleCharAlternation]
 [RegularExpressions::ProhibitUnusedCapture]

.pod_stopwords

@@ -12,16 +12,23 @@
 # line.  PodSpelling reads the AUTHORS and COPYRIGHT sections that Pod::Weaver
 # generates, and a surname is in no dictionary.  The licence words below are
 # from the text weaver.ini puts in the COPYRIGHT section of every module.
-
 accessor
+accessors
 ACL
+acl
+acls
 addon
+aes
 AIO
+allowlist
 API
 arg
 args
 argv
 arrayref
+auth
+authdb
+authenticator
 autodetect
 autodetected
 autodetecting
@@ -32,7 +39,12 @@ backends
 BackPAN
 backtick
 basename
+baz
+bool
 bugtracker
+cacheable
+cfg
+checkboxes
 checksummed
 checksumming
 CHECKSUMS
@@ -51,71 +63,130 @@ chrooting
 chroots
 CIDR
 CIDRs
+ciphertext
 CLI
 codename
 coderef
+conf
 config
 configs
+contactemail
 CPAN
 cpanm
 CPUs
 cron
 crons
+csp
+css
 CVE
+datasource
+datasources
+datastore
 DDL
+decrypt
+decrypted
+deduped
 deduplicate
 deduplicated
 deduplicates
 deduplicating
 dep
 deps
+dereference
 dev
 DHCP
 dir
+dirs
+displayname
 distro
 distros
 DKIM
 DMARC
 DN
 DNS
+doctype
+dom
 dotfiles
+dropdown
 dryrun
 DSN
 dzil
 ECDSA
 ENV
 env
+etags
+favicon
+fb
 filehandle
 filesystem
 filetest
+flatfile
+footbar
 formatter
 formatters
 FQDN
+fqdn
+fred
+frontend
+FTS
+fts
+gcm
 GiB
+gitignore
 GraphQL
 greppable
+gzip
 hardcode
 hardcoded
 hardcodes
 hardcoding
 hashref
+hashrefs
 heredoc
 hostname
 hotplug
+href
+hrefs
+hsts
+html
 HTTPS
+https
+hup
+ico
+imager
 IMAP
+indexable
 INI
+ini
 init
+inkscape
+inlined
+inlining
+inotify
+ipads
+iphones
 IPs
 IPv
+journald
+js
+jsalert
 JSON
+json
+keepass
 keypair
 keyspace
 KiB
+kolon
+lang
 LDAP
 LDAPS
 LDIF
+leftbar
+libmagic
+libravatar
+libvirt
 lifecycle
+logname
 lookups
 loopback
 lowercased
@@ -123,6 +194,7 @@ lowercases
 lowercasing
 LTS
 MACs
+Makefile
 makefile
 makefiles
 memoize
@@ -132,39 +204,68 @@ memoizing
 MERCHANTABILITY
 MetaCPAN
 MiB
+midtitle
+mimetype
+minify
 misconfigure
 misconfigured
 misconfigures
 misconfiguring
 mistyped
+msg
 mtime
+mtimes
+multiline
 MX
 nameserver
 nameservers
 namespace
+nginx
+nginxproxy
 NIC
+nocache
 NONINFRINGEMENT
+nosniff
 NTP
+nullary
 OAuth
 OOM
+OpenAPIv
+openapiv
 overcommit
 overcommits
 overcommitted
 overcommitting
+paginator
+param
+params
 passwordless
+payor
 PCI
 PCIe
+pdf
+pdfs
 PEM
 perlcritic
+perlcriticrc
 perltidy
 PKI
 plaintext
+png
 POSIX
 pragmas
 preflight
+prev
+provisioner
 proxied
 proxying
+psgi
+qemu
+queryable
+quotemeta'd
+ramdisk
 readdir
+readme
 recurse
 recursed
 recurses
@@ -173,32 +274,49 @@ regenerable
 renderer
 repo
 repos
+reprovision
+reprovisioning
+requestid
+resetpass
+revalidate
+rightbar
 RPC
 RSA
+rss
 rsync
 rsynced
 rsyncing
 rsyncs
+rsyslog
 ruleset
 runtime
 scaffolded
 scp
+sessid
+setsid'd
 sftp
 SHA
+sha
 SMTP
+snapshotting
 SRV
 sshd
 SSL
+stderr
 stdin
 stdout
+stylesheet
+stylesheets
 Subclasses
 subdir
+subdirectories
 subdirectory
 sublicense
 subnet
 substring
 subtest
 sudo
+svg
 symlink
 symlinked
 symlinking
@@ -206,17 +324,33 @@ symlinks
 sysctl
 syslog
 systemd
+TCMS
+tcms
 TCP
 teardown
 templated
 templating
+textarea
+themeclone
 timestamp
 TLD
 TLDs
 TLS
+tmux
 TODO
+tokenizer
 toolchain
+topbar
+totp
+tpm
+tpsgi
+trigram
+trog
+troglodyne
+truthy
+tx
 TXT
+txt
 udev
 UDP
 UI
@@ -224,24 +358,40 @@ UID
 umask
 uncached
 unconfigured
+undecorated
 undef
 undefine
 undefines
 undefining
+unindexed
+unix
 unlink
 unlinked
 unlinking
 unlinks
+unparameterized
+unstretched
 URI
+uri
 URIs
+useradd
 UUID
+uuid
 validator
 vhost
 vhosts
+virdomainscreenshot
+virt
 VM
 VMs
 VPN
 VPNs
 WAL
+webserver
 whitespace
+wilma
+xhr
+xml
+xsl
+xslate
 YAML

lib/TCMS.pm

@@ -206,13 +206,13 @@ sub build_routes {
 
 Whether this request should be turned around and sent to /totp.
 
-Two factors or nothing.  A login is what gets you to the enrolment page -- the QR
+Two factors or nothing.  A login is what gets you to the enrollment page -- the QR
 is the shared secret, so it cannot be handed to whoever asks for it -- which
 leaves a window where somebody is logged in and has no second factor yet.  This
 is what makes that window one page wide: every route a login can reach, and no
 route a logged out visitor can, is refused until they have enrolled.
 
-The enrolment page and the QR on it say so themselves, with totp_exempt, because
+The enrollment page and the QR on it say so themselves, with totp_exempt, because
 the exemption belongs next to the route rather than in a list over here that the
 routing table knows nothing about.
 

lib/Trog/Auth.pm

@@ -193,8 +193,8 @@ sub totp ( $user, $domain ) {
     # it is given -- so one containing a slash or .. would otherwise write
     # outside totp/ entirely.  Same whitelist Trog::DataSource::Virt uses for
     # guest names.
-    my ($safe_user)   = ( $user   // '' ) =~ m/^([A-Za-z0-9._-]+)$/;
-    my ($safe_domain) = ( $domain // '' ) =~ m/^([A-Za-z0-9._-]+)$/;
+    my ($safe_user)   = ( $user   // '' ) =~ m/^([\w.-]+)$/;
+    my ($safe_domain) = ( $domain // '' ) =~ m/^([\w.-]+)$/;
     return ( undef, undef, 1, "Refusing to build a TOTP QR for unsafe username '" . ( $user // '' ) . "'." ) unless $safe_user;
     return ( undef, undef, 1, "Refusing to build a TOTP QR for unsafe domain '" . ( $domain // '' ) . "'." ) unless $safe_domain;
 
@@ -271,8 +271,8 @@ nowhere else until they have.
 
 There is no way to turn it back off.  Losing an authenticator is not a reason to
 stop having a second factor, and the answer to it is bin/totp, which re-reads a
-user their enrolment out of band -- the secret is still in the database, so it
-is the same enrolment rather than a new one.
+user their enrollment out of band -- the secret is still in the database, so it
+is the same enrollment rather than a new one.
 
 =cut
 
@@ -310,7 +310,7 @@ our $totp_period    = 30;
 our $totp_digits    = 6;
 
 sub spend_totp ( $user, $code ) {
-    return ( 0, 'no code given' ) unless defined $code && $code =~ m/^[0-9]{$totp_digits}$/;
+    return ( 0, 'no code given' ) unless defined $code && $code =~ m/^\d{$totp_digits}$/;
 
     my $dbh    = dbh();
     my $rows   = $dbh->selectall_arrayref( "SELECT totp_secret FROM user WHERE name=?", { Slice => {} }, $user );

lib/Trog/Component.pm

@@ -32,7 +32,7 @@ function call, hands them to its warn handler, and carries on with an empty
 string where the call was -- so a broken component would otherwise vanish from
 the page with nothing but a line on stderr to say so.  The failure is therefore
 also recorded in $Trog::Component::error, which Trog::Renderer::Base::render()
-localises and checks, turning it into the 500 it deserves.
+localizes and checks, turning it into the 500 it deserves.
 
 =head1 FUNCTIONS
 
@@ -54,7 +54,7 @@ my sub load ($name) {
     state %loaded;
 
     die "Component name must be given\n"   unless $name;
-    die "Invalid component name '$name'\n" unless $name =~ m/^[A-Za-z][A-Za-z0-9_]*$/;
+    die "Invalid component name '$name'\n" unless $name =~ m/^[[:alpha:]]\w*$/;
 
     my $module = "Trog::Component::$name";
     return $module if $loaded{$module};

lib/Trog/Data/SQLite.pm

@@ -174,12 +174,12 @@ my sub where ($query) {
     # version's, so older/newer have always meant the post's birthday rather
     # than the date of its most recent edit.
     if ( $query->{older} ) {
-        ( my $older = $query->{older} ) =~ s/[^0-9]//g;
+        ( my $older = $query->{older} ) =~ s/\D//g;
         push( @where, 'v.first_created < ?' );
         push( @bind,  $older );
     }
     if ( $query->{newer} ) {
-        ( my $newer = $query->{newer} ) =~ s/[^0-9]//g;
+        ( my $newer = $query->{newer} ) =~ s/\D//g;
         push( @where, 'v.first_created > ?' );
         push( @bind,  $newer );
     }
@@ -428,7 +428,7 @@ sub index_fields ( $, @fields ) {
 
     my %want;
     foreach my $field (@fields) {
-        my ($safe) = ( $field // '' ) =~ m/^([a-z][a-z0-9_]{0,31})$/;
+        my ($safe) = ( $field // '' ) =~ m/^([[:lower:]][[:lower:]\d_]{0,31})$/;
         if ( !defined $safe ) {
             WARN( "Refusing to index '" . ( $field // '' ) . "': not a field name" );
             next;

lib/Trog/DataModule.pm

@@ -72,7 +72,7 @@ Documentation for that query language, shown to the user alongside it.
 
 Every post the data model holds, as an arrayref of hashrefs.  Filtering is
 get()'s job unless your storage engine can do it more cheaply itself, in which
-case honour $query here and override get() too.
+case honor $query here and override get() too.
 
 =head2 write($posts)
 
@@ -230,11 +230,11 @@ sub filter ( $, $query, @filtered ) {
     #Filter out posts which are too old
     #Coerce older into numeric
     if ( $query->{older} ) {
-        $query->{older} =~ s/[^0-9]//g;
+        $query->{older} =~ s/\D//g;
         @filtered = grep { $_->{created} < $query->{older} } @filtered;
     }
     if ( $query->{newer} ) {
-        $query->{newer} =~ s/[^0-9]//g;
+        $query->{newer} =~ s/\D//g;
         @filtered = grep { $_->{created} > $query->{newer} } @filtered;
     }
 
@@ -454,7 +454,7 @@ my sub sidecar_generation {
 # explicitly undef form.
 my sub type_of ($form) {
     $form = '' if !defined $form || ref $form;
-    my ($type) = $form =~ m/^([A-Za-z0-9_-]+)\.tx$/;    ## no critic (RegularExpressions::ProhibitRegexToStripAffix) -- the class is the check: anything else is no type
+    my ($type) = $form =~ m/^([\w-]+)\.tx$/;    ## no critic (RegularExpressions::ProhibitRegexToStripAffix) -- the class is the check: anything else is no type
     return $type // '';
 }
 
@@ -595,7 +595,7 @@ my sub includes_of ($type) {
     # including the ones the wizard generates.  Deduped, since a template is
     # free to splice the same block in twice.
     my %seen;
-    return [ grep { !$seen{$_}++ } $template =~ m/^\s*:\s*include\s+"([A-Za-z0-9_-]+\.tx)"/gm ];
+    return [ grep { !$seen{$_}++ } $template =~ m/^\s*:\s*include\s+"([\w-]+\.tx)"/gm ];
 }
 
 =head2 includes_for($form)
@@ -819,7 +819,7 @@ spot, but it was never asked.
 
 Checks rather than filters, unlike validate().  process() adds fields the base
 schema has never heard of -- content_type, is_video, attachments -- and dropping
-what it does not recognise would throw away the work it just did.  So this looks
+what it does not recognize would throw away the work it just did.  So this looks
 only at the fields the schema actually describes, on a copy, and changes nothing.
 
 Returns the list of validation errors, empty when the post is fit to store.
@@ -1029,7 +1029,7 @@ sub delete { die 'stub' }
 =head2 routes() = HASH
 
 Returns the routes to each post.
-You should override this for performance reasons, as it's just a wrapper around get() by defualt.
+You should override this for performance reasons, as it's just a wrapper around get() by default.
 
 =cut
 
@@ -1041,7 +1041,7 @@ sub routes ($self) {
 =head2 aliases() = HASH
 
 Returns the aliases for each post, indexed by aliases.
-You should override this for performance reasons, as it's just a wrapper around get() by defualt.
+You should override this for performance reasons, as it's just a wrapper around get() by default.
 
 =cut
 

lib/Trog/DataSource.pm

@@ -112,11 +112,11 @@ sub filter ( $query, @posts ) {
     # Coerced to a number the same way Trog::DataModule::filter() does it, since
     # this arrives straight off a query string.
     if ( $query->{older} ) {
-        ( my $older = $query->{older} ) =~ s/[^0-9]//g;
+        ( my $older = $query->{older} ) =~ s/\D//g;
         @posts = grep { ( $_->{created} // 0 ) < $older } @posts if $older;
     }
     if ( $query->{newer} ) {
-        ( my $newer = $query->{newer} ) =~ s/[^0-9]//g;
+        ( my $newer = $query->{newer} ) =~ s/\D//g;
         @posts = grep { ( $_->{created} // 0 ) > $newer } @posts if $newer;
     }
 

lib/Trog/DataSource/DirIndex.pm

@@ -348,7 +348,7 @@ Ask tPSGI to tell us when the directory changes, and throw the static renders
 away when it does.
 
 These pages are cached exactly like any other: the render goes through
-Trog::Renderer, which hands anonymous, unparameterised, successful renders to
+Trog::Renderer, which hands anonymous, unparameterized, successful renders to
 tPSGI to save.  That is the whole point -- a directory listing is cheap to build
 but there is no reason to build it per request -- but a cached listing of a
 directory that has since changed is simply wrong, and nothing else would ever

lib/Trog/DataSource/ProvisionedVirt.pm

@@ -88,7 +88,7 @@ my sub safe_domain ($domain) {
     return undef if !$domain || length $domain >= 254;
     return undef if $domain =~ m/(?:^|\.)\.\.?(?:\.|$)/;
 
-    my ($safe) = $domain =~ m/^([A-Za-z0-9][A-Za-z0-9._-]*)$/;
+    my ($safe) = $domain =~ m/^([[:alnum:]][\w.-]*)$/;
     return $safe;
 }
 

lib/Trog/DataSource/Virt.pm

@@ -320,10 +320,10 @@ other's console.
 =cut
 
 sub screenshot ( $hypervisor, $guest_name ) {
-    my ($safe) = ( $guest_name // '' ) =~ m/^([A-Za-z0-9._-]+)$/;
+    my ($safe) = ( $guest_name // '' ) =~ m/^([\w.-]+)$/;
     return ( undef, 'bad guest name' ) unless $safe;
 
-    my ($host) = ( $hypervisor->{id} // '' ) =~ m/^([A-Za-z0-9._-]+)$/;
+    my ($host) = ( $hypervisor->{id} // '' ) =~ m/^([\w.-]+)$/;
     return ( undef, 'bad hypervisor id' ) unless $host;
 
     my $conn_uri = $hypervisor->{conn_uri};
@@ -380,7 +380,7 @@ 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._-]+)$/;
+    my ($safe) = $domain_name =~ m/^([\w.-]+)$/;
     return ( 0, 'bad guest name' ) unless $safe;
 
     # The template draws neither of these buttons for this guest; this is what

lib/Trog/Routes/HTML.pm

@@ -625,8 +625,8 @@ sub setup ($query) {
 Enable 2 factor auth via TOTP for the currently authenticated user.
 Returns a page with a QR code & TOTP uri for pasting into your authenticator app of choice.
 
-Every user has to enrol, so this is where a login without one lands and the only
-page it can reach until it has one.  Showing the same enrolment again is the
+Every user has to enroll, so this is where a login without one lands and the only
+page it can reach until it has one.  Showing the same enrollment again is the
 point rather than a fallback: a user who lost their authenticator scans it again
 and is back where they were.
 
@@ -975,7 +975,7 @@ Routes for user service of their authentication details.
 
 There is no route here for turning TOTP off.  Everybody has it, and losing an
 authenticator is not a reason to stop having a second factor -- bin/totp reads a
-user their existing enrolment back out of band, which is the same enrolment
+user their existing enrollment back out of band, which is the same enrollment
 rather than a new one.
 
 =cut
@@ -1428,7 +1428,7 @@ sub enrich_post ( $post, $query, $cache = {} ) {
         my $relation = $relations->{$as};
         next unless Ref::Util::is_hashref($relation);
 
-        my ($target) = ( $relation->{form} // '' ) =~ m/^([A-Za-z0-9_-]+\.tx)$/;
+        my ($target) = ( $relation->{form} // '' ) =~ m/^([\w-]+\.tx)$/;
         next unless $target;
 
         $cache->{$target} //= [ post_helper( { form => $target }, [], $query->{user_acls} ) ];
@@ -2037,7 +2037,7 @@ sub paginate_offset ( $query, $limit, @posts ) {
     # newer get, rather than int() warning its way through a word.  Past the end
     # shows the last page rather than an empty one, which is what a stale
     # bookmark deserves.
-    ( my $wanted = $query->{page} // '' ) =~ s/[^0-9]//g;
+    ( my $wanted = $query->{page} // '' ) =~ s/\D//g;
     my $page = $wanted ? int($wanted) : 1;
     $page = 1            if $page < 1;
     $page = $pages_total if $page > $pages_total;
@@ -2708,7 +2708,7 @@ land on the generation before this save.
 
 Returns the error if there was one, and nothing if all was well.  A failure to
 index is not a failure to create the post type: the type is written by this
-point, works, and is only missing an optimisation.
+point, works, and is only missing an optimization.
 
 =cut
 
@@ -2851,7 +2851,7 @@ sub post_wizard_save ($query) {
     # Anchored capture rather than a substitution, so anything containing a '/'
     # or a '..' simply fails to match instead of being silently scrubbed into
     # something that still escapes the directory.
-    my ($name) = wizard_scalar( $query->{name} ) =~ m/^([A-Za-z0-9_-]+)$/;
+    my ($name) = wizard_scalar( $query->{name} ) =~ m/^([\w-]+)$/;
     return wizard_fail( $query, "Post type names may only contain letters, numbers, '-' and '_'." ) unless $name;
 
     # Whichever forms dir is in use: the theme's if it has one, the stock one
@@ -3273,7 +3273,7 @@ sub wizard_fields ($query) {
 
     my ( @fields, %seen );
     foreach my $index ( 0 .. $#$names ) {
-        my ($fname) = lc( wizard_scalar( $names->[$index] ) ) =~ m/^([a-z][a-z0-9_]{0,31})$/;
+        my ($fname) = lc( wizard_scalar( $names->[$index] ) ) =~ m/^([[:lower:]][[:lower:]\d_]{0,31})$/;
 
         # Blank and bogus rows just get dropped.
         next unless $fname;
@@ -3288,7 +3288,7 @@ sub wizard_fields ($query) {
 
         # A relation is only a relation if it names a target type that looks
         # like one; anything else falls back to being a plain text field.
-        my ($rform) = wizard_scalar( $rforms->[$index] ) =~ m/^([A-Za-z0-9_-]+\.tx)$/;
+        my ($rform) = wizard_scalar( $rforms->[$index] ) =~ m/^([\w-]+\.tx)$/;
         my $rmode = wizard_scalar( $rmodes->[$index] ) eq 'all' ? 'all' : 'one';
         $type = 'text' if $type eq 'relation' && !$rform;
 
@@ -3414,7 +3414,7 @@ Implements the /totp/* routes.
 
 Serves the QR code generated when a user enables TOTP.  These live outside
 www/, so they go out through serve() rather than the static file handler --
-handing someone else's enrolment QR out to the world would be handing them the
+handing someone else's enrollment QR out to the world would be handing them the
 shared secret.
 
 =cut

lib/Trog/Routes/JSON.pm

@@ -35,7 +35,7 @@ our %routes = (
         callback   => \&process_auth_change_request,
         captures   => ['token'],
         parameters => {
-            token => sub { my $tok = shift; $tok =~ m/[a-f|0-9|-]+/; },
+            token => sub { my $tok = shift; $tok =~ m/\A[\da-f-]+\z/; },
         },
         noindex    => 1,
         robot_name => '/api/auth_change_request/*',
@@ -46,7 +46,7 @@ our %routes = (
         parameters => {
 
             # Same shape series.json demands of child_form.
-            form => sub { $_[0] =~ m/^[A-Za-z0-9_-]+\.tx$/ },
+            form => sub { $_[0] =~ m/^[\w-]+\.tx$/ },
         },
         callback => \&posts_of_form,
         noindex  => 1,

lib/Trog/Vault.pm

@@ -199,7 +199,7 @@ my sub derive ($salt) {
 # a row to its owner, so it is a short plain thing or it is nothing.
 my sub safe_name ($name) {
     return 0 if !$name || length $name > 64;
-    return $name =~ m/^[A-Za-z0-9][A-Za-z0-9._-]*$/ ? 1 : 0;
+    return $name =~ m/^[[:alnum:]][\w.-]*$/ ? 1 : 0;
 }
 
 # The same database the users are in, since a secret belongs to one.

t/Trog-DataSource-DirIndex.t

@@ -120,7 +120,7 @@ subtest 'ids are stable and opaque' => sub {
 
     # Pagination hands out page 2 of a list keyed on these, and a filename is
     # not a thing to put in a URL.
-    ok( $one{'report.pdf'} =~ m/^dirindex-[0-9a-f]{32}$/, 'and it is opaque rather than the name' );
+    ok( $one{'report.pdf'} =~ m/^dirindex-[\da-f]{32}$/, 'and it is opaque rather than the name' );
     isnt( $one{'report.pdf'}, $one{'notes.txt'}, 'different entries get different ids' );
 };
 

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

@@ -422,7 +422,7 @@ subtest 'registering the first admin bootstraps the install' => sub {
     is( $code, 200, 'login() rendered' ) or diag($err);
 
     my %h = @{ $headers || [] };
-    like( $h{'Set-Cookie'} // '', qr/^tcmslogin=[0-9a-f-]{36};/, 'a session cookie came back' );
+    like( $h{'Set-Cookie'} // '', qr/^tcmslogin=[\da-f-]{36};/, 'a session cookie came back' );
 
     ok( -f 'config/has_users', 'registration is now closed' );
     is_deeply( Trog::Auth::acls4user($ADMIN_USER), ['admin'], 'the new user is an admin' );

t/Trog-Routes-JSON.t

@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+use 5.040;
+use re '/aasx';
+use warnings FATAL => 'all';
+
+use Test::More;
+
+use FindBin::libs;
+
+require_ok('Trog::Routes::JSON') or BAIL_OUT("Can't find SUT");
+
+subtest 'the change request token is a uuid, and nothing else' => sub {
+    no warnings 'once';
+    my $valid = $Trog::Routes::JSON::routes{'/api/auth_change_request/(.*)'}{parameters}{token};
+
+    ok( $valid->('5bed1745-4201-40dd-b5dd-65acc0316604'), 'a uuid is a token' );
+    ok( !$valid->(q{}),                                   'nothing is not' );
+    ok( !$valid->('x;drop table user'),                   'and neither is text with a hex digit in it' );
+    ok( !$valid->("5bed1745-4201\n"),                     'nor a token with something after it' );
+    ok( !$valid->('a|b'),                                 'nor a pipe, which the class used to hold' );
+};
+
+done_testing();

t/Trog-Vault.t

@@ -59,7 +59,7 @@ Trog::Auth::useradd( 'eve', 'Eve Evilson', 'letmein', ['public'], 'eve@example.c
 subtest 'the key is taken out of the environment' => sub {
     ok( Trog::Vault::has_key(),        'the key was read' );
     ok( !exists $ENV{TPSGI_VAULT_KEY}, 'and is gone from the environment, so nothing we fork inherits it' );
-    like( Trog::Vault::key_id(), qr/^[0-9a-f]{16}$/, 'and fingerprints to something a row can name' );
+    like( Trog::Vault::key_id(), qr/^[\da-f]{16}$/, 'and fingerprints to something a row can name' );
 };
 
 subtest 'what a secret looks like on disk' => sub {