Clear the filetest and substring findings

Thirty -f/-w sites and six substring findings, split three ways.

Seventeen are exempted: the test picks which of several candidate paths to
use, or filters directory entries down to the ones worth processing, and
losing the race means taking a fallback or skipping an entry.  Each carries
a reason on the line, because an exemption nobody justified is the thing
ProhibitPipeOpen was written to stop.

Ten are rewritten, because the test guards an operation on that same path
immediately afterwards.  Mostly this deletes something that was saying less
than the operation would have: unlink already returns 0 for a missing file,
and read_text already dies with the errno and the path.  Trog::Data::DUMMY
now seeds its datastore with one O_EXCL sysopen instead of a test followed
by an unchecked open, so a real failure is reported where it happens rather
than surfacing as 'print on closed filehandle' and then a die inside
read_text.  Trog::Auth plots the totp QR unconditionally; it is a pure
function of the secret, and the cached file had just been unlinked whenever
the secret changed, so the test was only ever true.

The -w in the post type wizard is gone rather than replaced.  It checks mode
bits against our uid, which says nothing about read-only mounts, ACLs or
immutable flags, and it is the files rather than the directory that get
written; the eval around spew_utf8 reports the real errno already.  The -d
stays, since refusing to mkdir a forms dir is a deliberate policy.

Five of the six substring findings are split() patterns, where the policy's
suggested index() cannot apply -- it flags any Regexp::Match token and has no
split case.  Those become bare strings, which the policy does not inspect.
Note migrate.pl's date split keeps its escape: split compiles a string
argument as a regex, so a bare '.' matches any character and hands back an
empty list.  The sixth is a real match and became index().

Three -f sites are deliberately left failing.  Clearing them is a behaviour
change, so they get their own commit.

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

bin/migrate.pl

@@ -61,11 +61,13 @@ foreach my $day (@days) {
     my @times = grep { !/^\./ } readdir $dht;
     closedir $dht;
 
-    my ( $month, $date, $year ) = split( /\./, $day );
+    # Escaped on purpose: split compiles a string argument as a regex, so a
+    # bare '.' would match any character and hand back an empty list.
+    my ( $month, $date, $year ) = split( '\.', $day );
 
     foreach my $time (@times) {
 
-        my ( $hour, $min, $sec ) = split( /:/, $time );
+        my ( $hour, $min, $sec ) = split( ':', $time );
 
         my $data;
         my $file = "$dir/$day/$time";
@@ -102,7 +104,7 @@ foreach my $day (@days) {
 $dir = "$docroot/blog";
 
 opendir( my $bh, $dir ) or die;
-my @blogs = grep { -f "$dir/$_" } readdir $bh;
+my @blogs = grep { -f "$dir/$_" } readdir $bh;    ## no critic (ProhibitFiletest_f) -- picking which entries to read
 closedir $bh;
 
 my $offset = 0;
@@ -145,7 +147,7 @@ foreach my $post (
 exit 0;
 my $vdir = "$docroot/fileshare/video";
 opendir( my $vh, $vdir ) or die;
-my @vidyas = grep { -f "$vdir/$_" && $_ =~ m/\.m4v$/ } readdir $vh;
+my @vidyas = grep { -f "$vdir/$_" && $_ =~ m/\.m4v$/ } readdir $vh;    ## no critic (ProhibitFiletest_f) -- picking which entries to read
 closedir $vh;
 
 foreach my $vid (@vidyas) {

bin/migrate2.pl

@@ -118,7 +118,7 @@ foreach my $timestamp ( keys(%posts) ) {
         }
 
         $search_info->write( [$post] );
-        unlink $file_to_kill if -f $file_to_kill;
+        unlink $file_to_kill;
     }
 }
 

bin/migrate6.pl

@@ -63,7 +63,7 @@ my $global_changes;
 opendir( my $dh, 'data/files' );
 while ( my $entry = readdir $dh ) {
     my $fname = "data/files/$entry";
-    next unless -f $fname;
+    next unless -f $fname;    ## no critic (ProhibitFiletest_f) -- skipping . and .. and any subdirs
     my $contents = File::Slurper::read_binary($fname);
     my $decoded  = JSON::MaybeXS::decode_json($contents);
     next unless List::Util::any { $_->{is_profile} } @$decoded;

lib/TCMS.pm

@@ -73,7 +73,7 @@ sub build_routes {
             log_init("$tpsgi->{log_dir}/tpsgi.log", $tpsgi->{verbose} ? 'debug' : 'info');
 
             # Let's open up our default route if needed before we bother thinking any harder
-            return $default_route->($query) unless -f "config/setup";
+            return $default_route->($query) unless -f "config/setup";    ## no critic (ProhibitFiletest_f) -- a flag file, only ever touched
 
             # Set the urchin parameters if necessary.
             %$Trog::Log::DBI::urchin = map { $_ => delete $query->{$_} } qw{utm_source utm_medium utm_campaign utm_term utm_content};

lib/Trog/Auth.pm

@@ -200,26 +200,28 @@ sub totp ( $user, $domain ) {
     my $qr = "$user\@$domain.bmp";
     if ($secret_is_generated) {
 
-        # Liquidate the QR code if it's already there
-        unlink "totp/$qr" if -f "totp/$qr";
+        # Liquidate the QR code if it's already there.  Unconditional: unlink
+        # returns 0 for a file that was never there, it does not warn or die.
+        unlink "totp/$qr";
 
         $dbh->do( "UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user ) or return ( undef, undef, 1, "Failed to store TOTP secret." );
     }
 
-    # This is subsequently served via authenticated _serve() in TCMS.pm
-    if ( !-f "totp/$qr" ) {
-        my $qrcode = Imager::QRCode->new(
-            size          => 4,
-            margin        => 3,
-            level         => 'L',
-            casesensitive => 1,
-            lightcolor    => Imager::Color->new( 255, 255, 255 ),
-            darkcolor     => Imager::Color->new( 0,   0,   0 ),
-        );
+    # This is subsequently served via authenticated _serve() in TCMS.pm.
+    # Plotted every time rather than only when the file is missing: the QR is a
+    # pure function of the secret, so rewriting it produces the same bytes, and
+    # the file was just unlinked above whenever the secret changed.
+    my $qrcode = Imager::QRCode->new(
+        size          => 4,
+        margin        => 3,
+        level         => 'L',
+        casesensitive => 1,
+        lightcolor    => Imager::Color->new( 255, 255, 255 ),
+        darkcolor     => Imager::Color->new( 0,   0,   0 ),
+    );
 
-        my $img = $qrcode->plot($uri);
-        $img->write( file => "totp/$qr", type => "bmp" ) or return ( undef, undef, 1, "Could not write totp/$qr: " . $img->errstr );
-    }
+    my $img = $qrcode->plot($uri);
+    $img->write( file => "totp/$qr", type => "bmp" ) or return ( undef, undef, 1, "Could not write totp/$qr: " . $img->errstr );
     return ( $uri, $qr, $failure, $message, $totp );
 }
 

lib/Trog/Component/EmojiPicker.pm

@@ -36,9 +36,13 @@ sub render () {
 
     if ( !%categorized ) {
         my $file = 'www/scripts/list.min.json';
-        die "Run make prereq-frontend first" unless -f $file;
 
-        my $raw    = File::Slurper::read_binary($file);
+        # One operation rather than a test and then a read, which also catches
+        # the unreadable case the test missed.  Checked with defined() rather
+        # than truthiness so that an empty file falls through to the JSON
+        # parser, which will say what is actually wrong with it.
+        my $raw = eval { File::Slurper::read_binary($file) };
+        die "Could not read $file ($@) -- run make prereq-frontend first" unless defined $raw;
         my $emojis = JSON::MaybeXS::decode_json($raw);
         foreach my $emoji ( @{ $emojis->{emojis} } ) {
             $categorized{ $emoji->{category} } //= [];

lib/Trog/Config.pm

@@ -34,7 +34,7 @@ sub get {
     state $cf;
     return $cf if $cf;
     foreach my $cfg2try ($home_cfg, $default) {
-        next unless -f $cfg2try;
+        next unless -f $cfg2try;    ## no critic (ProhibitFiletest_f) -- the instance config, else the shipped default
         $cf = Config::Simple->new($cfg2try);
         last;
     }

lib/Trog/Data/DUMMY.pm

@@ -4,6 +4,8 @@ use v5.36;
 use re '/aa';
 
 use Carp qw{confess};
+use Errno();
+use Fcntl qw{O_WRONLY O_CREAT O_EXCL};
 use JSON::MaybeXS;
 use File::Slurper;
 use List::Util qw{uniq};
@@ -23,11 +25,19 @@ sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }
 our $posts;
 
 sub read ( $self, $query = {} ) {
-    if ( !-f $datastore ) {
-        open( my $fh, '>', $datastore );
-        print $fh '[]';
+
+    # Seed an empty datastore, as one operation rather than a test followed by
+    # a create.  O_EXCL means a file that appeared in between is left alone
+    # rather than truncated, and unlike the previous unchecked open, a failure
+    # that is not EEXIST is reported here instead of surfacing as a confusing
+    # 'print on closed filehandle' followed by a die inside read_text.
+    if ( sysopen( my $fh, $datastore, O_WRONLY | O_CREAT | O_EXCL ) ) {
+        print {$fh} '[]';
         close $fh;
     }
+    elsif ( $! != Errno::EEXIST ) {
+        confess "Could not create $datastore: $!";
+    }
     my $slurped = File::Slurper::read_text($datastore);
     $posts = JSON::MaybeXS::decode_json($slurped);
 

lib/Trog/Data/FlatFile.pm

@@ -53,7 +53,7 @@ sub read ( $self, $query = {} ) {
         $posts_by_tag{$tagkey} //= [];
         @index = @{ $posts_by_tag{$tagkey} } if @{ $posts_by_tag{$tagkey} };
 
-        if ( !@index && -f 'data/posts.db' ) {
+        if ( !@index && -f 'data/posts.db' ) {    ## no critic (ProhibitFiletest_f) -- use the tag index, else fall back to _index()
             @index = map { "$datastore/$_" } Trog::SQLite::TagIndex::posts_for_tags( @{ $query->{tags} } );
             $posts_by_tag{$tagkey} = \@index;
         }
@@ -62,7 +62,6 @@ sub read ( $self, $query = {} ) {
 
     my @items;
     foreach my $item (@index) {
-        next unless -f $item;
         my $slurped = eval { File::Slurper::read_text($item) };
         if ( !$slurped ) {
             print "Failed to Read $item:\n$@\n";
@@ -97,7 +96,7 @@ sub read ( $self, $query = {} ) {
 sub _index ($self) {
     confess "Can't find datastore in $datastore !" unless -d $datastore;
     opendir( my $dh, $datastore ) or confess;
-    my @index = grep { -f } map { "$datastore/$_" } readdir $dh;
+    my @index = grep { -f } map { "$datastore/$_" } readdir $dh;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
     closedir $dh;
     return sort { $b cmp $a } @index;
 }

lib/Trog/DataModule.pm

@@ -511,7 +511,10 @@ sub schema_for ( $form = '' ) {
 }
 
 sub _read_sidecar ($path) {
-    return undef unless -f $path;
+    # -e, not -f: the question is whether a sidecar exists at all, and most
+    # post types have none.  Letting the read below fail instead would WARN
+    # about every type that simply does not have one.
+    return undef unless -e $path;
 
     local $@;
     my $spec = eval { JSON::MaybeXS::decode_json( File::Slurper::read_text($path) ) };

lib/Trog/DataSource/Virt.pm

@@ -260,7 +260,11 @@ sub screenshot ( $hypervisor, $guest_name ) {
 
     my $dir  = "$screenshot_dir/$host";
     my $path = "$dir/$safe.png";
-    return ( $path, undef ) if -f $path && ( time() - ( stat($path) )[9] ) < $screenshot_ttl;
+    # One stat rather than -f and then a second stat for the mtime.  A missing
+    # file gives the empty list, so $mtime is undef and we fall through to a
+    # fresh capture.
+    my $mtime = ( stat($path) )[9];
+    return ( $path, undef ) if $mtime && ( time() - $mtime ) < $screenshot_ttl;
 
     my ( $conn, $why ) = _connect($conn_uri);
     return ( undef, $why ) unless $conn;

lib/Trog/Routes/HTML.pm

@@ -275,7 +275,7 @@ my $theme_dir = Trog::Themes::get_dir();
 if ($theme_dir) {
 
     my $theme_mod = "$theme_dir/routes.pm";
-    if ( -f $theme_mod ) {
+    if ( -f $theme_mod ) {    ## no critic (ProhibitFiletest_f) -- theme routes, else the default theme
         use lib '.';
         require $theme_mod;
         @routes{ keys(%Theme::routes) } = values(%Theme::routes);
@@ -308,7 +308,7 @@ sub _feedback_redirect ( $query, $to, $failure, $message ) {
     $message =~ s/\s*\n+\s*/; /g;
     $message =~ s/;\s*$//;
 
-    my $sep = $to =~ m/\?/ ? '&' : '?';
+    my $sep = index( $to, '?' ) != -1 ? '&' : '?';
     my $key = $failure     ? 'savefailed' : 'saved';
     return $query->{tpsgi}->see_also( $to . $sep . $key . '=' . URI::Escape::uri_escape($message) );
 }
@@ -558,7 +558,7 @@ sub login ($query) {
     }
 
     #Check and see if we have no users.  If so we will just accept whatever creds are passed.
-    my $hasusers = -f "config/has_users";
+    my $hasusers = -f "config/has_users";    ## no critic (ProhibitFiletest_f) -- a flag file, only ever touched
     my $btnmsg   = $hasusers ? "Log In" : "Register";
 
     my $headers;
@@ -855,7 +855,7 @@ sub _get_data_models {
         my $dir = "$incdir/Trog/Data";
         next unless -d $dir;
         opendir( my $dh, $dir ) || die "Can't opendir $dir: $!";
-        my @dmods = map { s/\.pm$//g; $_ } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh);
+        my @dmods = map { s/\.pm$//g; $_ } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh);    ## no critic (ProhibitFiletest_f) -- building a menu of module names
         closedir $dh;
         return \@dmods;
     }
@@ -879,7 +879,7 @@ sub _get_datasources {
         my $dir = "$incdir/Trog/DataSource";
         next unless -d $dir;
         opendir( my $dh, $dir ) or next;
-        $found{"Trog::DataSource::$_"} = 1 foreach map { s/\.pm$//r } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh);
+        $found{"Trog::DataSource::$_"} = 1 foreach map { s/\.pm$//r } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh);    ## no critic (ProhibitFiletest_f) -- building an allowlist of names
         closedir $dh;
     }
     return [ sort keys(%found) ];
@@ -1202,7 +1202,7 @@ sub series ($query) {
     $query->{route} =~ s|^/secure||;
 
     #we are either viewed one of two ways, /post/$id or /$aclname
-    my ( undef, $aclname, $id ) = split( /\//, $query->{route} );
+    my ( undef, $aclname, $id ) = split( '/', $query->{route} );
     $query->{aclname} = $aclname if !$id;
     $query->{id}      = $id      if $id;
 
@@ -1331,7 +1331,7 @@ sub users ($query) {
     $query->{route} =~ s|^/secure||;
 
     # Capture the username
-    my ( undef, undef, $display_name ) = split( /\//, $query->{route} );
+    my ( undef, undef, $display_name ) = split( '/', $query->{route} );
     $display_name = URI::Escape::uri_unescape($display_name);
 
     my $username = Trog::Auth::display2username($display_name);
@@ -1376,7 +1376,7 @@ sub posts ( $query, $direct = 0 ) {
     # rip away /secure if present
     $query->{route} =~ s|^/secure||;
 
-    my ( undef, undef, $id ) = split( /\//, $query->{route} );
+    my ( undef, undef, $id ) = split( '/', $query->{route} );
 
     my $tags = Trog::Utils::coerce_array( $query->{tag} );
     $query->{id} = $id if $id && !$query->{in_series};
@@ -1963,7 +1963,7 @@ sub manual ($query) {
     my $infile = $query->{module} ? "$query->{module}.pm" : 'tCMS/Manual.pod';
     my $found = 0;
     foreach my $libdir (@INC) {
-        $found = $libdir if -f "$libdir/$infile";
+        $found = $libdir if -f "$libdir/$infile";    ## no critic (ProhibitFiletest_f) -- which @INC dir supplies the pod
         last if $found;
     }
     return $query->{tpsgi}->notfound($query) unless $found;
@@ -2282,7 +2282,11 @@ sub post_wizard_save ($query) {
     # otherwise.  Never mkdir it -- silently conjuring a forms/ dir inside a
     # theme is not something an admin asked for by pressing this button.
     my $dir = Trog::Themes::forms_dir();
-    return _wizard_fail( $query, "Forms directory '$dir' does not exist, or is not writable." ) unless -d $dir && -w $dir;
+    # -d only.  A -w here would check mode bits against our uid, which says
+    # nothing about read-only mounts, ACLs or immutable flags -- and it is the
+    # files, not the directory, that get written.  The eval around the two
+    # spew_utf8 calls below reports the real errno when a write actually fails.
+    return _wizard_fail( $query, "Forms directory '$dir' does not exist." ) unless -d $dir;
 
     my $tx_file   = "$dir/$name.tx";
     my $json_file = "$dir/$name.json";

lib/Trog/SQLite.pm

@@ -48,7 +48,9 @@ sub dbh {
     my $db = DBI->connect( "dbi:SQLite:dbname=$dbname", "", "" );
 
     if ($schema) {
-        die "No such schema file '$schema' !" unless -f $schema;
+
+        # No pre-flight test: read_text dies with "Cannot open <path>: <errno>",
+        # which says more than the guard did and covers unreadable as well as absent.
         my $qq = File::Slurper::read_text($schema);
         $db->{sqlite_allow_multiple_statements} = 1;
         $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;

lib/Trog/Themes.pm

@@ -29,7 +29,7 @@ serving a site with half its routes missing is worse than not starting.
 
 sub routes {
     my $rdir = get_dir();
-    return () unless -f "$rdir/routes.pm";
+    return () unless -f "$rdir/routes.pm";    ## no critic (ProhibitFiletest_f) -- theme ships routes, or it does not
 
     local $@;
     eval { require "$rdir/routes.pm"; 1; } or do {
@@ -120,13 +120,13 @@ sub template_dir ( $template, $content_type, $is_component = 0, $is_dir = 0 ) {
     if ($is_dir) {
         return $mtd && -d "$mtd/$template" ? $mtd : $mtemp;
     }
-    return $mtd && -f "$mtd/$template" ? $mtd : $mtemp;
+    return $mtd && -f "$mtd/$template" ? $mtd : $mtemp;    ## no critic (ProhibitFiletest_f) -- which dir owns the template
 }
 
 # Pick appropriate dir based on whether theme override exists
 sub _dir_for_resource ($resource) {
     my $theme_dir = get_dir();
-    return $theme_dir && -f "$theme_dir/$resource" ? $theme_dir : '';
+    return $theme_dir && -f "$theme_dir/$resource" ? $theme_dir : '';    ## no critic (ProhibitFiletest_f) -- theme override, else stock
 }
 
 =head2 themed($resource)
@@ -216,7 +216,7 @@ sub _read_dir ( $dir, $ext ) {
     return $files unless -d $dir;
     opendir( my $dh, $dir ) or return $files;
     while ( my $file = readdir($dh) ) {
-        push( @$files, $file ) if -f "$dir/$file" && $file =~ m/\.\Q$ext\E$/;
+        push( @$files, $file ) if -f "$dir/$file" && $file =~ m/\.\Q$ext\E$/;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
     }
     closedir($dh);
     return $files;
@@ -274,7 +274,7 @@ theme's copy.  Returns undef when neither has it.
 
 sub themed_file_in_dir ( $path, $file, $ct, $is_component = 0 ) {
     foreach my $dir ( grep { $_ } _template_dirs( $ct, $is_component ) ) {
-        return "$dir/$path/$file" if -f "$dir/$path/$file";
+        return "$dir/$path/$file" if -f "$dir/$path/$file";    ## no critic (ProhibitFiletest_f) -- search path, first hit wins
     }
     return undef;
 }