Add a DirIndex datasource, with inotify-driven invalidation

Trog::DataSource::DirIndex turns a directory into posts: a series names one in
its new 'directory' field, a child type built in the wizard names DirIndex as its
datasource, and every entry becomes a post carrying its name, path, size, mtime,
extension and content type.  A downloads page, a gallery or a release listing is
then a template and nothing else.

Statics work exactly as they do for stored posts, because nothing about them is
special-cased: the render goes through Trog::Renderer, which hands anonymous,
unparameterised, successful renders to tPSGI to save.  The lifecycle test asserts
that rather than inferring it from the skip-save conditions.

What was missing was invalidation.  Saving a post does not invalidate this page,
because no post is saved when somebody drops a file in a directory, so a cached
listing would simply be wrong until something unrelated happened to clear it.
posts() therefore registers a watch through tPSGI's new facility and invalidates
the html renders when the directory changes.

Two details of that API are easy to get wrong and are commented where they are
relied on.  The watch is registered under an explicit key: posts() runs per
request and builds the callback fresh each time, so the default key -- the
callback's address -- would stack another copy on every single view.  And the
callback invalidates through the tPSGI object it is handed rather than the one it
closed over, because watches are shared between workers and whichever worker
notices the change is the one that has to act.  Both are asserted.

Only directories under www/ may be indexed, and never www/assets/private.  That
is the whole security model and it is deliberate: everything under www/ is
already served to anyone who asks, so listing it discloses nothing a guessed URL
would not, whereas a listing of anywhere else hands out the names of files the
webserver would refuse to serve -- and names are frequently the interesting part.
The private asset directory is the exception under www/ because its files are
gated by the webserver rather than by us, so its names should be too.  Traversal,
absolute paths, symlinks leaving the tree and dotfiles are all covered by tests,
since that is where getting this wrong costs something.

The listing orders directories first and then by name, rather than taking the
datasource default of newest-first, because that is what every file browser does
and because it makes page two hold what page one alphabetically ran out of.

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

Readme.md

@@ -144,6 +144,16 @@ 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.
+* DirIndex - List the contents of a directory.
+
+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
+its name, path, size, mtime, extension and content type -- so a downloads page, a
+gallery or a release listing is a template and nothing else.  It will only index
+directories under www/ (which the webserver already serves, so a listing
+discloses nothing a guessed URL would not), and never www/assets/private (whose
+files are gated, so its names are too).
 
 A post type names one in its sidecar with x-tcms-datasource, and a series of that
 type then lists whatever the source builds instead of posts somebody wrote.  The
@@ -168,6 +178,22 @@ A source has to provide posts($series, $query).  It may also provide:
   building its posts from somewhere else has nothing to edit, and saying nothing
   means no.
 
+Datasource pages are cached as statics exactly like any other page, which raises
+the question of what throws that cache away -- saving a post will not, because no
+post was saved when somebody dropped a file in a directory.  A source which knows
+what it depends on should say so with tPSGI's watch facility, as DirIndex does:
+
+    $tpsgi->add_watch( $directory, sub {
+        my ( $watcher, $change ) = @_;
+        $watcher->invalidate_renders('html');
+    }, key => "something stable" );
+
+Pass an explicit key.  posts() runs per request, so a closure built there has a
+new address every time and the default key would stack another copy of the same
+callback on every view.  Use the tPSGI object the callback is handed rather than
+the one from the request that registered it: watches are shared between workers,
+and whichever worker notices the change is the one that has to act on it.
+
 Such pages paginate by page number rather than by the created cursor stored posts
 use.  A datasource has already built every post by the time the paginator sees
 them, so there is nothing to save by paging with a cursor -- and it would not

design.md

@@ -250,7 +250,10 @@ rebuilt on every view.
 
 The module provides `posts($series, $query)` and may provide `filter`, `order`,
 `lang`, `help` and `EDITABLE`. `Trog::DataSource` documents the whole contract
-and supplies the defaults.
+and supplies the defaults.  `Trog::DataSource::DirIndex` is the shortest complete
+example: a directory becomes a listing, with a hard constraint on which
+directories it will look at and an inotify watch so the cached page is thrown
+away when the directory changes.
 
 Two things about the contract are worth knowing before you write one, because
 both are places the obvious implementation is wrong:
@@ -260,6 +263,12 @@ both are places the obvious implementation is wrong:
   along with the posts it filtered. `filter()` is how the search reaches your
   posts, and you should implement it if your posts carry anything worth
   searching beyond a title.
+- **Nothing else will invalidate your page's static render.** Datasource pages
+  are cached like any other, and a post being saved does not invalidate them,
+  because no post was saved -- the thing you depend on changed instead. If you
+  can name what you depend on, register a `$tpsgi->add_watch` for it with a
+  stable `key` and invalidate through the tPSGI object your callback is *handed*,
+  not the one it closed over. `DirIndex::_watch` is four lines of this.
 - **Your posts probably all share a timestamp**, because you stamped them with
   the time you built them. Stored posts paginate by a `created` cursor, which on
   such a page cannot move -- every cursor is the same instant. Datasource pages
@@ -373,6 +382,7 @@ The contractor's cheat-sheet.
 | To restrict a section | give the series an ACL; grant it to users | none |
 | A different look | a theme directory; override the templates you care about | none |
 | 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 |
 | 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 |

lib/Trog/DataSource/DirIndex.pm

@@ -0,0 +1,349 @@
+package Trog::DataSource::DirIndex;
+
+use v5.36;
+use re '/aa';
+
+use Cwd            ();
+use Digest::SHA    qw{sha256_hex};
+use File::Basename ();
+use URI::Escape    ();
+
+use Trog::DataSource ();
+use Trog::Utils      ();
+
+use Trog::Log qw{WARN DEBUG};
+
+=head1 Trog::DataSource::DirIndex
+
+Builds posts out of the contents of a directory.
+
+A series says which directory in its C<directory> field, and its children become
+one post per entry: a file listing, a download page, a gallery, whatever the post
+type's template makes of it.  Nothing is written to the datastore -- the
+directory is the source of truth, and the posts are rebuilt from it on every
+view.
+
+    "x-tcms-datasource": "Trog::DataSource::DirIndex"
+
+Build the child type in the Post Type Wizard and pick this as its datasource.
+The fields each entry carries are listed under posts() below; a template can use
+any of them.
+
+=head2 EDITABLE
+
+False.  An entry is built from the filesystem every time the page is drawn and
+has nothing behind it to save, so a post type backed by this wants no editor:
+a form posting to /post/save would write a real post to sit alongside, and
+collide with, the synthesized ones.  Put files in the directory instead.
+
+=cut
+
+use constant EDITABLE => 0;
+
+=head1 WHAT MAY BE INDEXED
+
+Only directories under C<www/>, and never C<www/assets/private>.
+
+That is not arbitrary caution.  Everything under www/ is already served to
+anybody who asks, so listing it discloses nothing that a guessed URL would not --
+whereas a listing of anywhere else hands out the names of files the webserver
+would refuse to serve, and names are frequently the interesting part.  The one
+exception is the private asset directory, which is under www/ but gated by the
+webserver rather than by us: its files are protected, so its filenames should be
+too.
+
+Symlinks are resolved before that check, and entries which point outside the
+tree are left out of the listing rather than shown with a link that will not
+work.
+
+=cut
+
+our $root    = 'www';
+our @refused = ('www/assets/private');
+
+=head1 FUNCTIONS
+
+=head2 posts($series, $query) = @posts
+
+One post per entry in the series' directory.
+
+Each carries, beyond what every post has:
+
+    name        the entry's own name, as on disk
+    path        its path relative to www/
+    is_dir      whether it is a directory
+    size        bytes, 0 for a directory
+    size_human  the same, as a human reads it
+    mtime       last modification, which is also the post's created
+    extension   lowercased, without the dot, empty for a directory
+    is_image / is_video / is_audio    from the content type, as a stored post gets
+
+Registers an inotify watch on the directory the first time it is asked, so that
+the static render of this page is thrown away when the directory changes.  See
+_watch().
+
+=cut
+
+sub posts ( $series, $query ) {
+    my $dir = _resolve( $series->{directory} );
+    return () unless $dir;
+
+    _watch( $query, $dir->{relative} );
+
+    opendir( my $dh, $dir->{absolute} ) or do {
+        WARN("Could not read $dir->{relative}: $!");
+        return ();
+    };
+    my @entries = grep { $_ ne '.' && $_ ne '..' && index( $_, '.' ) != 0 } readdir($dh);
+    closedir($dh);
+
+    my @out;
+    foreach my $entry ( sort @entries ) {
+        my $post = _post_for( $entry, $dir, $series );
+        push( @out, $post ) if $post;
+    }
+
+    return @out;
+}
+
+# Everything this is allowed to look at, or nothing.  Returns the absolute path
+# and the path relative to the tCMS root, since the first is what we read and
+# the second is what we log and watch.
+sub _resolve ($directory) {
+    return undef unless defined $directory && length $directory;
+
+    # Before abs_path, which would happily resolve one for us.
+    if ( $directory =~ m{(?:^|/)\.\.(?:/|$)} ) {
+        WARN("Refusing to index '$directory': it walks upwards");
+        return undef;
+    }
+
+    my $base = Cwd::abs_path($root);
+    if ( !$base ) {
+        WARN("Refusing to index '$directory': there is no $root here to index under");
+        return undef;
+    }
+
+    # Relative to the tCMS root, and named with or without the www/ prefix --
+    # 'assets/pics' and 'www/assets/pics' are the same directory, and somebody
+    # writing it into a form will pick whichever occurs to them.
+    my $candidate = $directory;
+    $candidate = "$root/$candidate" unless $candidate =~ m{^\Q$root\E(?:/|$)};
+
+    my $absolute = Cwd::abs_path($candidate);
+    if ( !$absolute || !-d $absolute ) {
+        WARN("Refusing to index '$directory': it is not a directory here");
+        return undef;
+    }
+
+    if ( !_within( $absolute, $base ) ) {
+        WARN("Refusing to index '$directory': it resolves outside $root");
+        return undef;
+    }
+
+    foreach my $refused (@refused) {
+        my $forbidden = Cwd::abs_path($refused);
+        next unless $forbidden;
+        next unless _within( $absolute, $forbidden );
+
+        WARN("Refusing to index '$directory': $refused holds files the webserver gates, so its names are gated too");
+        return undef;
+    }
+
+    my $relative = $absolute;
+    $relative =~ s{^\Q$base\E/?}{};
+
+    return { absolute => $absolute, relative => length($relative) ? "$root/$relative" : $root };
+}
+
+# Path containment, done on the resolved paths rather than on the strings the
+# caller handed us: /www-backup is not inside /www, however it reads.
+sub _within ( $path, $within ) {
+    return 1 if $path eq $within;
+    return index( $path, "$within/" ) == 0;
+}
+
+sub _post_for ( $name, $dir, $series ) {
+    my $absolute = "$dir->{absolute}/$name";
+
+    # Resolved, so a symlink pointing out of the tree is left out rather than
+    # listed with a link the webserver will not honour.
+    my $real = Cwd::abs_path($absolute);
+    if ( !$real || !_within( $real, Cwd::abs_path($root) ) ) {
+        DEBUG("Skipping $name: it points outside $root");
+        return undef;
+    }
+
+    my @stat = stat($absolute);
+    return undef unless @stat;
+
+    my $is_dir = -d _    ? 1 : 0;
+    my $size   = $is_dir ? 0 : $stat[7];
+    my $mtime  = $stat[9];
+
+    # Relative to www/, which is also its URL.
+    my $path = "$dir->{relative}/$name";
+    $path =~ s{^\Q$root\E/?}{};
+
+    my ($extension) = $is_dir ? ('') : ( lc( $name =~ m/\.([^.]+)$/ ? $1 : '' ) );
+
+    my $content_type = $is_dir ? 'inode/directory' : ( Trog::Utils::mime_type($absolute) // 'application/octet-stream' );
+
+    # Escaped per segment: a filename may legally hold a space, a question mark
+    # or a hash, and none of those survive being dropped into an href as they
+    # are.  Per segment rather than wholesale, or the separators go too.
+    my $href = '/' . join( '/', map { URI::Escape::uri_escape($_) } split( '/', $path ) );
+
+    my $post = {
+
+        # Stable across renders, because pagination and page anchors need it to
+        # be, and opaque because a filename is not a thing to put in a URL.
+        id => 'dirindex-' . substr( sha256_hex($path), 0, 32 ),
+
+        title => $name,
+        name  => $name,
+        path  => $path,
+        data  => '',
+
+        # Which template renders it.  posts.tx dispatches on this, so without it
+        # the entries come out through the default form rather than the type the
+        # series named, and the page looks empty.
+        form => $series->{child_form},
+
+        is_dir     => $is_dir,
+        size       => $size,
+        size_human => _human_size($size),
+        mtime      => $mtime,
+        extension  => $extension,
+
+        content_type => $content_type,
+        is_image     => ( $content_type =~ m{^image/} ? 1 : 0 ),
+        is_video     => ( $content_type =~ m{^video/} ? 1 : 0 ),
+        is_audio     => ( $content_type =~ m{^audio/} ? 1 : 0 ),
+
+        # Where the thing actually is.  The title links to the file and so does
+        # the permalink, because for a listing they are the same thing.
+        local_href => $href,
+        href       => $href,
+
+        # Enough of a post to survive being rendered like one.  The tags and
+        # visibility come from the series, as they do for every datasource:
+        # the reader reached this page by holding the series' acls.
+        tags       => $series->{tags}       // [],
+        visibility => $series->{visibility} // 'private',
+        created    => $mtime,
+        version    => 0,
+        user       => $series->{user},
+        method     => 'GET',
+    };
+
+    return $post;
+}
+
+sub _human_size ($bytes) {
+    return '' unless defined $bytes;
+    return "$bytes B" if $bytes < 1024;
+
+    my @units = qw{KB MB GB TB PB};
+    my $size  = $bytes / 1024;
+    foreach my $unit (@units) {
+        return sprintf( '%.1f %s', $size, $unit ) if $size < 1024 || $unit eq $units[-1];
+        $size /= 1024;
+    }
+    return "$bytes B";
+}
+
+=head2 filter($query, @posts) = @posts
+
+Apply the reader's search to the listing.
+
+A listing's posts have no body, so the default -- which searches a post's title
+and body -- would only ever match the name.  Search the path and the extension
+as well, so that 'pdf' finds the PDFs and a subdirectory's name finds what is
+under it.
+
+=cut
+
+sub filter ( $query, @posts ) {
+    $query //= {};
+
+    if ( length( $query->{like} // '' ) ) {
+        my $like = $query->{like};
+        @posts = grep { Trog::DataSource::searchable_match( $like, $_->{name}, $_->{path}, $_->{extension} ) } @posts;
+    }
+
+    return Trog::DataSource::filter( { %$query, like => undef }, @posts );
+}
+
+=head2 order($query, @posts) = @posts
+
+Directories first, then by name.
+
+Not the default newest-first: this is a directory index, and the convention a
+reader expects from one is the convention every file browser has -- which also
+means page two holds what page one alphabetically ran out of, rather than
+whatever happened to be touched least recently.
+
+=cut
+
+sub order ( $query, @posts ) {
+    return sort { ( $b->{is_dir} // 0 ) <=> ( $a->{is_dir} // 0 ) || lc( $a->{name} // '' ) cmp lc( $b->{name} // '' ) || ( $a->{name} // '' ) cmp ( $b->{name} // '' ) } @posts;
+}
+
+=head2 lang() = STRING
+
+=head2 help() = STRING
+
+What the search box searches on a directory listing.
+
+=cut
+
+sub lang { 'Case insensitive substring of a file name, path or extension' }
+sub help { 'https://en.wikipedia.org/wiki/Substring' }
+
+=head2 _watch($query, $directory)
+
+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
+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
+invalidate it.  A post being saved does not invalidate this page, because no post
+was saved: somebody dropped a file in a directory.
+
+Registered under an explicit key rather than the callback's address.  posts()
+runs per request and this closure is built fresh each time, so the default key
+would stack a new copy of the same callback on every single view.
+
+The callback uses the tPSGI object it is handed rather than the one from the
+request that registered it: watches are shared between workers, so whichever
+worker notices the change is the one that must do the invalidating.
+
+=cut
+
+sub _watch ( $query, $directory ) {
+    my $tpsgi = $query->{tpsgi};
+    return 0 unless $tpsgi;
+
+    # tCMS runs under whatever tPSGI is installed, and watches arrived in it
+    # later than the rest of this.  Without them the listing is still correct,
+    # it just goes stale until something else invalidates the renders.
+    return 0 unless $tpsgi->can('add_watch');
+
+    $tpsgi->add_watch(
+        $directory,
+        sub {
+            my ( $watcher, $change ) = @_;
+            $watcher->invalidate_renders('html');
+            return 1;
+        },
+        key => "Trog::DataSource::DirIndex:$directory",
+    );
+
+    return 1;
+}
+
+1;

t/Trog-DataSource-DirIndex.t

@@ -0,0 +1,277 @@
+#!/usr/bin/env perl
+
+# A datasource which turns a directory into posts.  Most of this file is about
+# which directories it will agree to look at, because that is the part where
+# getting it wrong hands out the names of files somebody meant to keep.
+
+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-dirindex-XXXXXX', TMPDIR => 1, CLEANUP => 1 );
+    $ENV{HOME} = $ROOT;
+
+    # The paths are relative to the tCMS root, so we need one.
+    File::Path::make_path("$ROOT/$_") for qw{config www/assets/downloads www/assets/private/secrets www/statics outside};
+
+    # Trog::Routes::HTML reads the config at load time, and the last subtest
+    # loads it to check the wizard can see this datasource.
+    File::Copy::copy( "$REPO/config/default.cfg", "$ROOT/config/default.cfg" ) or die $!;
+
+    chdir($ROOT) or die "could not chdir to the sandbox: $!";
+}
+
+END {
+    chdir($OLDCWD) if $OLDCWD;
+}
+
+require_ok('Trog::DataSource::DirIndex') or BAIL_OUT("Can't find SUT");
+
+my $log = Test::MockModule->new('Trog::DataSource::DirIndex');
+$log->redefine( WARN  => sub { note(shift) } );
+$log->redefine( DEBUG => sub { note(shift) } );
+
+sub touch {
+    my ( $path, $content ) = @_;
+    open( my $fh, '>', $path ) or die "$path: $!";
+    print {$fh} ( $content // 'x' );
+    close $fh;
+    return;
+}
+
+touch( 'www/assets/downloads/report.pdf',         'pdf' x 100 );
+touch( 'www/assets/downloads/photo.jpg',          'jpg' );
+touch( 'www/assets/downloads/notes.txt',          'notes' );
+touch( 'www/assets/downloads/.hidden',            'nope' );
+touch( 'www/assets/private/secrets/salaries.csv', 'nope' );
+touch( 'outside/elsewhere.txt',                   'nope' );
+mkdir('www/assets/downloads/archive');
+
+my %series = (
+    directory  => 'assets/downloads',
+    child_form => 'spec_files.tx',
+    tags       => [qw{downloads public}],
+    visibility => 'public',
+    user       => 'bob',
+);
+
+sub names {
+    my (@posts) = @_;
+    return [ sort map { $_->{name} } @posts ];
+}
+
+subtest 'it lists a directory' => sub {
+    my @posts = Trog::DataSource::DirIndex::posts( \%series, {} );
+
+    is_deeply( names(@posts), [ sort qw{archive notes.txt photo.jpg report.pdf} ], 'every entry becomes a post' );
+
+    my ($pdf) = grep { $_->{name} eq 'report.pdf' } @posts;
+    is( $pdf->{title},      'report.pdf',                   'named after the file' );
+    is( $pdf->{path},       'assets/downloads/report.pdf',  'carrying its path relative to www' );
+    is( $pdf->{local_href}, '/assets/downloads/report.pdf', 'and a link to where it actually is' );
+    is( $pdf->{size},       300,                            'with its size' );
+    is( $pdf->{size_human}, '300 B',                        'as a human reads it' );
+    is( $pdf->{extension},  'pdf',                          'and its extension' );
+    is( $pdf->{is_dir},     0,                              'a file is not a directory' );
+    is( $pdf->{form},       'spec_files.tx',                'and it says which template renders it' );
+    ok( $pdf->{created}, 'created is its mtime, so it has a real date' );
+
+    my ($dir) = grep { $_->{name} eq 'archive' } @posts;
+    is( $dir->{is_dir},    1,  'a directory says so' );
+    is( $dir->{size},      0,  'and has no size of its own' );
+    is( $dir->{extension}, '', 'nor an extension' );
+
+    # A template wants to know what it is looking at.
+    my ($jpg) = grep { $_->{name} eq 'photo.jpg' } @posts;
+    is( $jpg->{is_image}, 1, 'an image is flagged as one' );
+    is( $pdf->{is_image}, 0, 'and a PDF is not' );
+
+    # Inherited from the series, as every datasource's posts are: the reader
+    # reached this page by holding the series' acls.
+    is_deeply( $pdf->{tags}, [qw{downloads public}], 'the series tags come along' );
+    is( $pdf->{visibility}, 'public', 'and its visibility' );
+    is( $pdf->{user},       'bob',    'and its owner' );
+};
+
+subtest 'ids are stable and opaque' => sub {
+    my @first  = Trog::DataSource::DirIndex::posts( \%series, {} );
+    my @second = Trog::DataSource::DirIndex::posts( \%series, {} );
+
+    my %one = map { $_->{name} => $_->{id} } @first;
+    my %two = map { $_->{name} => $_->{id} } @second;
+    is_deeply( \%one, \%two, 'the same entry gets the same id twice' );
+
+    # 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' );
+    isnt( $one{'report.pdf'}, $one{'notes.txt'}, 'different entries get different ids' );
+};
+
+subtest 'what it refuses to look at' => sub {
+
+    # Everything under www/ is already served to anybody who asks, so listing it
+    # discloses nothing a guessed URL would not.  Everywhere else, the names are
+    # the disclosure.
+    my %refused = (
+        'somewhere else entirely'        => 'outside',
+        'an absolute path'               => "$ROOT/outside",
+        'a walk upwards'                 => 'assets/../../outside',
+        'a sneakier walk'                => 'assets/downloads/../../../outside',
+        'the private assets'             => 'assets/private',
+        'inside the private assets'      => 'assets/private/secrets',
+        'a directory that is not there'  => 'assets/nonesuch',
+        'a file rather than a directory' => 'assets/downloads/report.pdf',
+        'nothing at all'                 => '',
+    );
+
+    foreach my $why ( sort keys %refused ) {
+        my @posts = Trog::DataSource::DirIndex::posts( { %series, directory => $refused{$why} }, {} );
+        is_deeply( \@posts, [], "refuses $why" );
+    }
+
+    my @undef = Trog::DataSource::DirIndex::posts( { %series, directory => undef }, {} );
+    is_deeply( \@undef, [], 'and a series which names no directory at all' );
+};
+
+subtest 'the www prefix is optional' => sub {
+    my @with    = Trog::DataSource::DirIndex::posts( { %series, directory => 'www/assets/downloads' }, {} );
+    my @without = Trog::DataSource::DirIndex::posts( { %series, directory => 'assets/downloads' },     {} );
+    is_deeply( names(@with), names(@without), 'either way names the same directory' );
+    ok( scalar(@with), 'and it is not simply refusing both' );
+};
+
+subtest 'dotfiles and escaping symlinks are left out' => sub {
+    my @posts = Trog::DataSource::DirIndex::posts( \%series, {} );
+    is_deeply( [ grep { $_->{name} =~ m/^\./ } @posts ], [], 'a dotfile is not listed' );
+
+  SKIP: {
+        skip( 'no symlinks here', 2 ) unless eval { symlink( "$ROOT/outside/elsewhere.txt", 'www/assets/downloads/escape.txt' ); 1 };
+
+        my @linked = Trog::DataSource::DirIndex::posts( \%series, {} );
+        is_deeply( [ grep { $_->{name} eq 'escape.txt' } @linked ], [], 'nor a symlink pointing out of the tree' );
+
+        symlink( "$ROOT/www/assets/downloads/notes.txt", 'www/assets/downloads/inside.txt' );
+        my @inside = Trog::DataSource::DirIndex::posts( \%series, {} );
+        ok( scalar( grep { $_->{name} eq 'inside.txt' } @inside ), 'while one pointing within it is fine' );
+
+        unlink('www/assets/downloads/escape.txt');
+        unlink('www/assets/downloads/inside.txt');
+    }
+};
+
+subtest 'a filename that needs escaping' => sub {
+    touch('www/assets/downloads/a file & thing #1.txt');
+
+    my @posts = Trog::DataSource::DirIndex::posts( \%series, {} );
+    my ($odd) = grep { $_->{name} eq 'a file & thing #1.txt' } @posts;
+    ok( $odd, 'it is listed under its real name' );
+
+    # A filename may legally hold a space, an ampersand or a hash, and none of
+    # those survive being dropped into an href as they are.
+    unlike( $odd->{local_href}, qr/[ #]/, 'but its link carries none of them raw' );
+    like( $odd->{local_href}, qr/^\/assets\/downloads\//, 'and still points where it should' );
+
+    unlink('www/assets/downloads/a file & thing #1.txt');
+};
+
+subtest 'searching a listing' => sub {
+    my @posts = Trog::DataSource::DirIndex::posts( \%series, {} );
+
+    is_deeply( names( Trog::DataSource::DirIndex::filter( { like => 'pdf' },       @posts ) ), ['report.pdf'], 'by extension' );
+    is_deeply( names( Trog::DataSource::DirIndex::filter( { like => 'note' },      @posts ) ), ['notes.txt'],  'by name' );
+    is_deeply( names( Trog::DataSource::DirIndex::filter( { like => 'downloads' }, @posts ) ), names(@posts),  'by path' );
+    is_deeply( names( Trog::DataSource::DirIndex::filter( { like => 'nonesuch' },  @posts ) ), [],             'and nothing matches nothing' );
+    is_deeply( names( Trog::DataSource::DirIndex::filter( {}, @posts ) ), names(@posts), 'no search filters nothing' );
+};
+
+subtest 'the order a directory index belongs in' => sub {
+    my @posts   = Trog::DataSource::DirIndex::posts( \%series, {} );
+    my @ordered = Trog::DataSource::DirIndex::order( {}, @posts );
+
+    is( $ordered[0]{name}, 'archive', 'directories come first' );
+    is_deeply(
+        [ map { $_->{name} } @ordered ],
+        [qw{archive notes.txt photo.jpg report.pdf}],
+        'and then it is by name, which is what every file browser does'
+    );
+
+    # Pagination hands out page 2 of this, so it had better not depend on what
+    # order readdir felt like today.
+    is_deeply(
+        [ map { $_->{name} } Trog::DataSource::DirIndex::order( {}, reverse @posts ) ],
+        [ map { $_->{name} } @ordered ],
+        'whatever order they arrived in'
+    );
+};
+
+subtest 'it asks to be told when the directory changes' => sub {
+    my @watches;
+
+    my $tpsgi = bless {}, 'FakeTPSGI';
+    {
+        no warnings qw{once};
+        *FakeTPSGI::add_watch = sub {
+            my ( $self, $path, $callback, %options ) = @_;
+            push( @watches, { path => $path, callback => $callback, %options } );
+            return 1;
+        };
+        *FakeTPSGI::invalidate_renders = sub { push( @{ $_[0]{invalidated} }, $_[1] ); return 1 };
+    }
+
+    Trog::DataSource::DirIndex::posts( \%series, { tpsgi => $tpsgi } );
+    is( scalar(@watches),  1,                      'a watch is registered' );
+    is( $watches[0]{path}, 'www/assets/downloads', 'on the directory it is listing' );
+    like( $watches[0]{key}, qr/DirIndex/, 'under a key naming what registered it' );
+
+    # posts() runs per request and builds this closure fresh each time, so
+    # without an explicit key the default -- the callback's address -- would
+    # stack another copy of the same callback on every single view.
+    Trog::DataSource::DirIndex::posts( \%series, { tpsgi => $tpsgi } );
+    Trog::DataSource::DirIndex::posts( \%series, { tpsgi => $tpsgi } );
+    is( scalar( keys %{ { map { $_->{key} => 1 } @watches } } ), 1, 'and it is the same key every time' );
+
+    # The callback uses the tPSGI it is handed, not the one from the request
+    # that registered it: watches are shared between workers, and whichever
+    # worker notices the change is the one that has to do the invalidating.
+    my $other = bless {}, 'FakeTPSGI';
+    $watches[0]{callback}->( $other, { path => 'www/assets/downloads/new.txt', events => ['CREATE'] } );
+    is_deeply( $other->{invalidated}, ['html'], 'and it invalidates the html renders when it fires' );
+    ok( !$tpsgi->{invalidated}, 'through the object it was handed, not the one it closed over' );
+};
+
+subtest 'no tPSGI, or one without watches, is not fatal' => sub {
+    is( exception { Trog::DataSource::DirIndex::posts( \%series, {} ) }, undef, 'no tpsgi at all is fine' );
+
+    my $old = bless {}, 'OldTPSGI';
+    is( exception { Trog::DataSource::DirIndex::posts( \%series, { tpsgi => $old } ) }, undef, 'and neither is one without add_watch' );
+
+    my @posts = Trog::DataSource::DirIndex::posts( \%series, { tpsgi => $old } );
+    ok( scalar(@posts), 'the listing still works; it just goes stale' );
+};
+
+subtest 'the wizard can find it' => sub {
+    require Trog::Routes::HTML;
+
+    my $sources = Trog::Routes::HTML::_get_datasources();
+    ok( scalar( grep { $_ eq 'Trog::DataSource::DirIndex' } @$sources ), 'it is offered as a datasource' );
+
+    is( Trog::DataSource::DirIndex->EDITABLE, 0, 'and declares it wants no editor' );
+};
+
+done_testing();

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

@@ -166,14 +166,16 @@ require Trog::Routes::JSON;
     sub new {
         my ( $class, %args ) = @_;
         return bless {
-            callbacks   => 0,
-            renders     => {},
-            invalidated => [],
-            restarts    => 0,
-            tpsgi_dir   => Cwd::getcwd(),
-            log_dir     => 'logs',
-            gid         => $),
-            verbose     => 0,
+            callbacks     => 0,
+            run_callbacks => 0,
+            renders       => {},
+            invalidated   => [],
+            watches       => [],
+            restarts      => 0,
+            tpsgi_dir     => Cwd::getcwd(),
+            log_dir       => 'logs',
+            gid           => $),
+            verbose       => 0,
             %args,
         }, $class;
     }
@@ -205,11 +207,28 @@ require Trog::Routes::JSON;
     # post_save reach save_render()/invalidate_renders().  Dropping the callback
     # on the floor is what guarantees this test never writes into www/statics,
     # whatever the renderer's own skip-save logic decides.
-    sub add_post_close_callback { $_[0]{callbacks}++; return 1 }
+    # ...unless a test explicitly asks, which is how the one test that is about
+    # what gets cached gets to see it.  Still nowhere near www/statics:
+    # save_render below only records what it was handed.
+    sub add_post_close_callback {
+        my ( $self, $callback ) = @_;
+        $self->{callbacks}++;
+        $callback->() if $self->{run_callbacks} && ref $callback eq 'CODE';
+        return 1;
+    }
 
     # The real one is `kill 'HUP', getppid`.  Under prove, that is prove.
     sub signal_restart_parent { $_[0]{restarts}++; return 1 }
 
+    # Recorded rather than inert: a datasource that watches something is
+    # supposed to register here, and the lifecycle test is where we find out
+    # whether it did through the real route.
+    sub add_watch {
+        my ( $self, $path, $callback, %options ) = @_;
+        push( @{ $self->{watches} }, { path => $path, callback => $callback, %options } );
+        return 1;
+    }
+
     sub invalidate_renders { push @{ $_[0]{invalidated} }, $_[1];              return 1 }
     sub invalidate_render  { push @{ $_[0]{invalidated} }, [ @_[ 1 .. $#_ ] ]; return 1 }
     sub save_render        { $_[0]{renders}{"$_[1]:$_[2]"} = $_[3]; return 1 }
@@ -662,6 +681,86 @@ subtest 'an ordinary series survives a page number in its URL' => sub {
     unlike( $body, qr/Page 1 of/, 'and it still pages by cursor rather than by number' );
 };
 
+subtest 'a directory index series' => sub {
+
+    # A wizard-built type drawing its posts from a directory, through the real
+    # route, on whichever data model this run is using.
+    require Trog::DataSource::DirIndex;
+
+    my ( $code, $body, $err ) = _render(
+        _admin(
+            route          => '/admin/wyzzerdd/save',
+            method         => 'POST',
+            name           => 'spec_files',
+            datasource     => 'Trog::DataSource::DirIndex',
+            body_form      => 'form_common.tx',
+            wrapper        => 1,
+            inc_post_title => 1,
+            display        => q{<div class="entry"><: $post.name :> (<: $post.size_human :>)</div>},
+        ),
+        \&Trog::Routes::HTML::post_wizard_save,
+    );
+    is( $code, 200, 'the directory-backed type was created' ) or diag($err);
+
+    File::Path::make_path('www/assets/spec_downloads');
+    foreach my $n ( 1 .. 7 ) {
+        open( my $fh, '>', "www/assets/spec_downloads/file$n.txt" ) or die $!;
+        print {$fh} ( 'x' x ( $n * 10 ) );
+        close $fh;
+    }
+
+    _reindex();
+    my $series = _make_series(
+        'spec_files', 'specfiles', 'spec_files.tx', 'Spec Files Series',
+        no_topbar => 1,
+        directory => 'assets/spec_downloads',
+    ) or return;
+
+    is( $series->{directory}, 'assets/spec_downloads', 'the series remembers which directory it indexes' );
+
+    my $names = sub {
+        my ($html) = @_;
+        return [ $html =~ m{<div class="entry">(file\d+\.txt) \(}g ];
+    };
+
+    ( $code, $body, $err ) = _render( _anon( route => '/specfiles' ), \&Trog::Routes::HTML::series );
+    is( $code, 200, 'the listing renders' ) or diag($err);
+    is_deeply( $names->($body), [ map { "file$_.txt" } 1 .. 7 ], 'listing the directory, in name order' );
+    like( $body, qr/\(10 B\)/, 'with each entry\'s size' );
+
+    # post_title.tx quotes with single quotes; the point is the target, not the quoting.
+    like( $body, qr{href=['"]/assets/spec_downloads/file1\.txt['"]}, 'and a link to the file itself' );
+
+    # It paginates like any other datasource page.
+    ( $code, $body, $err ) = _render( _anon( route => '/specfiles', limit => 3, page => 2 ), \&Trog::Routes::HTML::series );
+    is( $code, 200, 'page two renders' ) or diag($err);
+    is_deeply( $names->($body), [qw{file4.txt file5.txt file6.txt}], 'holding the next three' );
+    like( $body, qr/Page 2 of 3/, 'and saying so' );
+
+    # And searches like one.
+    ( $code, $body, $err ) = _render( _anon( route => '/specfiles', limit => 25, like => 'file3' ), \&Trog::Routes::HTML::series );
+    is_deeply( $names->($body), ['file3.txt'], 'searching the listing searches the filenames' );
+
+    # The point of the exercise: this page is cached like any other, and
+    # nothing else would ever throw that cache away, because no post is saved
+    # when somebody drops a file in a directory.
+    my $tpsgi = Test::TPSGI->new( run_callbacks => 1 );
+    _render( _anon( route => '/specfiles', tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
+
+    # And it really is cached, rather than merely being cacheable in principle:
+    # the renderer hands anonymous, unparameterised, successful renders to tPSGI
+    # to save, and a directory listing is one.
+    ok( scalar( keys %{ $tpsgi->{renders} } ),                    'the listing was handed to tPSGI to save as a static' );
+    ok( ( grep { m{^/specfiles:} } keys %{ $tpsgi->{renders} } ), 'under its own route' );
+
+    my ($watch) = grep { $_->{path} =~ m/spec_downloads/ } @{ $tpsgi->{watches} };
+    ok( $watch, 'rendering it registers a watch on the directory' );
+    like( $watch->{key}, qr/DirIndex/, 'under a stable key, so a view does not stack another' );
+
+    $watch->{callback}->( $tpsgi, { path => 'www/assets/spec_downloads/file8.txt', events => ['CREATE'] } );
+    is_deeply( $tpsgi->{invalidated}, ['html'], 'and a change to the directory invalidates the renders' );
+};
+
 subtest 'a field can be declared indexed' => sub {
     my ( $code, $body, $err ) = _render(
         _admin(
@@ -812,8 +911,11 @@ sub _make_series {
     # series whose topbar behaviour we actually care about get tagged.
     my @tags = $opt{no_topbar} ? ('series') : ( 'series', 'topbar' );
 
+    my %extra = map { $_ => $opt{$_} } grep { $_ ne 'no_topbar' } keys(%opt);
+
     my $series = _save_post(
         "$label series",
+        %extra,
         form       => 'series.tx',
         title      => $title,
         aclname    => $aclname,                       # required by series.json

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

@@ -1,42 +1,50 @@
 {
-   "x-tcms-post-type" : {
-      "name" : "series",
-      "generated" : false,
-      "description" : "A category of posts.  Owns an ACL, and dictates which post type its children use."
-   },
-   "type" : "object",
-   "required" : [ "aclname", "child_form" ],
-   "properties" : {
-      "preview" : {
-         "type" : "string",
-         "x-tcms-label" : "Preview Image"
+   "properties": {
+      "aclname": {
+         "type": "string",
+         "x-tcms-label": "ACL name"
+      },
+      "child_form": {
+         "pattern": "^[A-Za-z0-9_-]+\\.tx$",
+         "type": "string",
+         "x-tcms-label": "Content Template"
       },
-      "preview_file" : {
-         "type" : "upload",
-         "x-tcms-label" : "Preview Image",
-         "x-tcms-input" : "file"
+      "directory": {
+         "type": "string",
+         "x-tcms-label": "Directory to index",
+         "x-tcms-placeholder": "assets/downloads"
       },
-      "aclname" : {
-         "type" : "string",
-         "x-tcms-label" : "ACL name"
+      "footer": {
+         "type": "string",
+         "x-tcms-label": "Footer"
       },
-      "child_form" : {
-         "type" : "string",
-         "pattern" : "^[A-Za-z0-9_-]+\\.tx$",
-         "x-tcms-label" : "Content Template"
+      "header": {
+         "type": "string",
+         "x-tcms-label": "Header"
       },
-      "tiled" : {
-         "type" : "boolean",
-         "x-tcms-label" : "Tile Display?",
-         "x-tcms-input" : "checkbox"
+      "preview": {
+         "type": "string",
+         "x-tcms-label": "Preview Image"
       },
-      "header" : {
-         "type" : "string",
-         "x-tcms-label" : "Header"
+      "preview_file": {
+         "type": "upload",
+         "x-tcms-input": "file",
+         "x-tcms-label": "Preview Image"
       },
-      "footer" : {
-         "type" : "string",
-         "x-tcms-label" : "Footer"
+      "tiled": {
+         "type": "boolean",
+         "x-tcms-input": "checkbox",
+         "x-tcms-label": "Tile Display?"
       }
+   },
+   "required": [
+      "aclname",
+      "child_form"
+   ],
+   "type": "object",
+   "x-tcms-post-type": {
+      "description": "A category of posts.  Owns an ACL, and dictates which post type its children use.",
+      "generated": false,
+      "name": "series"
    }
 }

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

@@ -33,6 +33,8 @@
         Title *<br /><input required class="cooltext" type="text" name="title" placeholder="Iowa Man Destroys Moon" value="<: $post.title :>" />
         URL *<br /><input required class="cooltext" type="text" name="local_href" placeholder="/someurl" value="<: $post.local_href :>" />
         ACL name *<br /><input required class="cooltext" type="text" name="aclname" value="<: $post.aclname :>" />
+        <!-- Only meaningful when the child type draws its posts from a directory; see Trog::DataSource::DirIndex. -->
+        Directory to index<br /><input class="cooltext" type="text" name="directory" placeholder="assets/downloads" value="<: $post.directory :>" />
         <label for="<: $post.id :>-tiled">Tile Display?<input id="<: $post.id :>-tiled" class="coolcb" type="checkbox" name="tiled" value="1" <: if ( $post.tiled ) { "checked" } :> /></label>
         <br />
         Content Template *<br />