Check acls on id, title and aclname lookups too

filter() returned as soon as it had matched an id, a title or an aclname,
before the acl filter, and Trog::Data::SQLite copied that on purpose.  So
GET /posts/$id served a private post to anybody who had its id.  The POD
of get() already said an id lookup "May be subsequently filtered by ACL,
resulting in a 404", and posts() adds 'unlisted' to the acls only when it
has an id, so the acls were always meant to apply here.  No history says
why they did not: the early return goes back to tCMS 2.0.

Both models now run the same acl check on these lookups.  It is its own
sub, _filter_acls() and _acl_clause(), so the two paths share it.

Two callers relied on the old behavior:

- add() looks up the previous version of a post to bump its number.  It
  passed no acls, so it would find nothing and save every edit as version
  0.  It now asks as admin.
- series() looked the series post up with the viewer's raw user_acls,
  which for a visitor are empty.  It now adds public and unlisted, as
  posts() does, and private for an admin.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

lib/Trog/Data/SQLite.pm

@@ -187,15 +187,15 @@ sub _where ($query) {
         push( @where, 'p.id = v.latest_id' );
     }
 
-    # An id, title or aclname query is answered on its own, with no tag, acl or
-    # visibility filtering after it -- exactly as filter() returns early for
-    # these three.  It is how add() asks whether a post already exists, and how
-    # a route fetches the post it is about to render.
+    # An id, title or aclname query is answered on its own, with no tag or date
+    # filtering after it, but still only if the caller may see it -- exactly as
+    # filter() does for these three.
     foreach my $key (qw{id title aclname}) {
         next unless $query->{$key};
         my $column = $key eq 'id' ? 'p.uuid' : "p.$key";
         push( @where, "$column = ?" );
         push( @bind,  $query->{$key} );
+        _acl_clause( $query, \@where, \@bind );
         return ( \@where, \@bind );
     }
 
@@ -229,25 +229,7 @@ sub _where ($query) {
         push( @bind,  @{ $query->{exclude_tags} } );
     }
 
-    # The load bearing one: a post is only visible to a caller holding one of
-    # its tags, since visibility and acls are both stored as tags.  admin skips
-    # it, as it does in filter().
-    my $acls = ref $query->{acls} eq 'ARRAY' ? $query->{acls} : [];
-    if ( $query->{raw} ) {
-
-        # raw skips filter() altogether in the flat file model, acls included.
-        # Only bin/migrate.pl and an index rebuild ask for it.
-    }
-    elsif ( @$acls && !any { $_ eq 'admin' } @$acls ) {
-        my $binds = join( ',', map { '?' } @$acls );
-        push( @where, "p.id IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
-        push( @bind,  @$acls );
-    }
-    elsif ( !@$acls ) {
-
-        # filter() greps against an empty list here, which matches nothing.
-        push( @where, '0 = 1' );
-    }
+    _acl_clause( $query, \@where, \@bind );
 
     if ( $query->{form} ) {
         push( @where, 'COALESCE(p.form, ?) = ?' );
@@ -268,6 +250,29 @@ sub _where ($query) {
     return ( \@where, \@bind );
 }
 
+# The load bearing one: a post is only visible to a caller holding one of its
+# tags, since visibility and acls are both stored as tags.  admin skips it, as
+# it does in filter().
+sub _acl_clause ( $query, $where, $bind ) {
+    my $acls = ref $query->{acls} eq 'ARRAY' ? $query->{acls} : [];
+    if ( $query->{raw} ) {
+
+        # raw skips filter() altogether in the flat file model, acls included.
+        # Only bin/migrate.pl and an index rebuild ask for it.
+    }
+    elsif ( @$acls && !any { $_ eq 'admin' } @$acls ) {
+        my $binds = join( ',', map { '?' } @$acls );
+        push( @$where, "p.id IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
+        push( @$bind,  @$acls );
+    }
+    elsif ( !@$acls ) {
+
+        # filter() greps against an empty list here, which matches nothing.
+        push( @$where, '0 = 1' );
+    }
+    return;
+}
+
 =head2 _like_clause($term)
 
 The 'like' filter: a case insensitive substring match over a post's title and

lib/Trog/DataModule.pm

@@ -180,6 +180,19 @@ sub _filter_param ( $query, $param, @filtered ) {
     return @filtered;
 }
 
+# Visibility and acls are both stored as tags, so a caller sees a post when it
+# holds one of them.  admin sees everything.
+sub _filter_acls ( $query, @filtered ) {
+    return @filtered if grep { $_ eq 'admin' } @{ $query->{acls} };
+    return grep {
+        my $tags = $_->{tags};
+        grep {
+            my $t = $_;
+            grep { $t eq $_ } @{ $query->{acls} }
+        } @$tags
+    } @filtered;
+}
+
 =head2 filter($query, @posts) = @filtered
 
 Apply a get() request's filters to a list of posts: tags, exclude_tags, acls,
@@ -196,10 +209,11 @@ sub filter ( $self, $query, @filtered ) {
     $query->{tags}         //= [];
     $query->{exclude_tags} //= [];
 
-    # If an ID or title or acl is passed, just get that (and all it's prior versions)
+    # If an ID or title or acl is passed, just get that (and all it's prior versions),
+    # if the caller may see it.
     foreach my $key (qw{id title aclname}) {
         next unless $query->{$key};
-        return _filter_param( $query, $key, @filtered );
+        return _filter_acls( $query, _filter_param( $query, $key, @filtered ) );
     }
 
     @filtered = _dedup_versions( undef, @filtered );
@@ -233,14 +247,7 @@ sub filter ( $self, $query, @filtered ) {
         } @$tags
     } @filtered if @{ $query->{exclude_tags} };
 
-    # Filter posts without the proper ACLs
-    @filtered = grep {
-        my $tags = $_->{tags};
-        grep {
-            my $t = $_;
-            grep { $t eq $_ } @{ $query->{acls} }
-        } @$tags
-    } @filtered unless grep { $_ eq 'admin' } @{ $query->{acls} };
+    @filtered = _filter_acls( $query, @filtered );
 
     @filtered = grep { ( $_->{form} || '' ) eq $query->{form} } @filtered if $query->{form};
 
@@ -853,7 +860,7 @@ sub add ( $self, @posts ) {
         $post->{local_href} ||= "/posts/$post->{id}";
         $post->{method}     ||= 'GET';
         $post->{created} = time();
-        my @existing_posts = $self->get( id => $post->{id} );
+        my @existing_posts = $self->get( id => $post->{id}, acls => [qw{admin}] );
         if (@existing_posts) {
             my $existing_post = $existing_posts[0];
             $post->{version} = $existing_post->{version};

lib/Trog/Routes/HTML.pm

@@ -1485,7 +1485,13 @@ sub series ($query) {
     # Asking for page two of a single post gets nothing, so a series carrying a
     # ?page= in its URL could not find itself and 404'd on its own page.  Latent
     # until something started emitting page numbers -- see _paginate_offset.
-    my @posts = _post_helper( { %$query, page => 1, limit => 1 }, ['series'], $query->{user_acls} );
+    #
+    # Seen through what a viewer can actually see, as posts() does further on:
+    # the raw user_acls of a logged out visitor are empty, and match nothing.
+    # Unlisted too, since the route names this series directly.
+    my @series_acls = ( @{ $query->{user_acls} }, qw{public unlisted} );
+    push( @series_acls, 'private' ) if $is_admin;
+    my @posts = _post_helper( { %$query, page => 1, limit => 1 }, ['series'], \@series_acls );
 
     # The series post carries its *children's* relations, so that an editor
     # picker rendered on this page has something to populate from -- that is

t/Trog-Data-SQLite.t

@@ -122,27 +122,34 @@ sub ids_of {
 
 subtest 'the two models answer the same questions the same way' => sub {
     my @queries = (
-        [ 'everything an admin can see'  => { limit => 0, acls    => ['admin'] } ],
-        [ 'everything a visitor can see' => { limit => 0, acls    => ['public'] } ],
-        [ 'a visitor plus unlisted'      => { limit => 0, acls    => [qw{public unlisted}] } ],
-        [ 'no acls at all'               => { limit => 0, acls    => [] } ],
-        [ 'one tag'                      => { limit => 0, acls    => ['admin'], tags         => ['topbar'] } ],
-        [ 'several tags'                 => { limit => 0, acls    => ['admin'], tags         => [qw{topbar series}] } ],
-        [ 'a tag nothing has'            => { limit => 0, acls    => ['admin'], tags         => ['nonesuch'] } ],
-        [ 'excluding a tag'              => { limit => 0, acls    => ['admin'], exclude_tags => ['topbar'] } ],
-        [ 'tags and exclude together'    => { limit => 0, acls    => ['admin'], tags         => ['blog'], exclude_tags => ['topbar'] } ],
-        [ 'by form'                      => { limit => 0, acls    => ['admin'], form         => 'microblog.tx' } ],
-        [ 'by a form nothing has'        => { limit => 0, acls    => ['admin'], form         => 'nonesuch.tx' } ],
-        [ 'by author'                    => { limit => 0, acls    => ['admin'], author       => 'ann' } ],
-        [ 'by id'                        => { limit => 0, id      => 'p-series' } ],
-        [ 'by an id nothing has'         => { limit => 0, id      => 'p-nonesuch' } ],
-        [ 'by title'                     => { limit => 0, title   => 'A Deck' } ],
-        [ 'by aclname'                   => { limit => 0, aclname => 'aseries' } ],
-        [ 'by acl membership'            => { limit => 0, acls    => ['aseries'] } ],
-        [ 'older than'                   => { limit => 0, acls    => ['admin'],  older   => $corpus[4]{created} } ],
-        [ 'newer than'                   => { limit => 0, acls    => ['admin'],  newer   => $corpus[4]{created} } ],
-        [ 'a specific version'           => { limit => 0, id      => 'p-public', version => 0 } ],
-        [ 'the other version'            => { limit => 0, id      => 'p-public', version => 1 } ],
+        [ 'everything an admin can see'    => { limit => 0, acls => ['admin'] } ],
+        [ 'everything a visitor can see'   => { limit => 0, acls => ['public'] } ],
+        [ 'a visitor plus unlisted'        => { limit => 0, acls => [qw{public unlisted}] } ],
+        [ 'no acls at all'                 => { limit => 0, acls => [] } ],
+        [ 'one tag'                        => { limit => 0, acls => ['admin'],   tags         => ['topbar'] } ],
+        [ 'several tags'                   => { limit => 0, acls => ['admin'],   tags         => [qw{topbar series}] } ],
+        [ 'a tag nothing has'              => { limit => 0, acls => ['admin'],   tags         => ['nonesuch'] } ],
+        [ 'excluding a tag'                => { limit => 0, acls => ['admin'],   exclude_tags => ['topbar'] } ],
+        [ 'tags and exclude together'      => { limit => 0, acls => ['admin'],   tags         => ['blog'], exclude_tags => ['topbar'] } ],
+        [ 'by form'                        => { limit => 0, acls => ['admin'],   form         => 'microblog.tx' } ],
+        [ 'by a form nothing has'          => { limit => 0, acls => ['admin'],   form         => 'nonesuch.tx' } ],
+        [ 'by author'                      => { limit => 0, acls => ['admin'],   author       => 'ann' } ],
+        [ 'by id'                          => { limit => 0, acls => [qw{admin}], id           => 'p-series' } ],
+        [ 'by an id nothing has'           => { limit => 0, acls => [qw{admin}], id           => 'p-nonesuch' } ],
+        [ 'by title'                       => { limit => 0, acls => [qw{admin}], title        => 'A Deck' } ],
+        [ 'by aclname'                     => { limit => 0, acls => [qw{admin}], aclname      => 'aseries' } ],
+        [ 'by acl membership'              => { limit => 0, acls => ['aseries'] } ],
+        [ 'a private id, as a visitor'     => { limit => 0, acls => ['public'],            id      => 'p-private' } ],
+        [ 'a private title, as a visitor'  => { limit => 0, acls => ['public'],            title   => 'Members Only' } ],
+        [ 'a private id, holding its acl'  => { limit => 0, acls => ['aseries'],           id      => 'p-acl' } ],
+        [ 'an unlisted id, as a visitor'   => { limit => 0, acls => ['public'],            id      => 'p-unlisted' } ],
+        [ 'an unlisted id, by its link'    => { limit => 0, acls => [qw{public unlisted}], id      => 'p-unlisted' } ],
+        [ 'a public aclname, as a visitor' => { limit => 0, acls => ['public'],            aclname => 'aseries' } ],
+        [ 'an id with no acls at all'      => { limit => 0, acls => [],                    id      => 'p-public' } ],
+        [ 'older than'                     => { limit => 0, acls => ['admin'],             older   => $corpus[4]{created} } ],
+        [ 'newer than'                     => { limit => 0, acls => ['admin'],             newer   => $corpus[4]{created} } ],
+        [ 'a specific version'             => { limit => 0, acls => [qw{admin}],           id      => 'p-public', version => 0 } ],
+        [ 'the other version'              => { limit => 0, acls => [qw{admin}],           id      => 'p-public', version => 1 } ],
     );
 
     foreach my $case (@queries) {
@@ -180,7 +187,7 @@ subtest 'both models paginate by offset' => sub {
 subtest 'the id query really does return one post' => sub {
 
     # Guards the comparison above: two empty lists are also "the same".
-    my @found = $sqlite->get( limit => 0, id => 'p-series' );
+    my @found = $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-series' );
     is( scalar(@found),  1,           'exactly one' );
     is( $found[0]{id},   'p-series',  'and the right one' );
     is( $found[0]{form}, 'series.tx', 'decoded whole, not just its id' );
@@ -198,15 +205,33 @@ subtest 'the id query really does return one post' => sub {
     is( scalar(@plus), 6, 'and the unlisted one once they hold that too' );
 };
 
+subtest 'a direct lookup still answers only to the acls' => sub {
+    foreach my $case ( [ flatfile => $flat ], [ sqlite => $sqlite ] ) {
+        my ( $name, $model ) = @$case;
+        my $ids = sub {
+            [ sort map { $_->{id} } $model->get( limit => 0, @_ ) ]
+        };
+
+        is_deeply( $ids->( acls => ['public'],            id    => 'p-private' ),    [],             "$name: a visitor cannot fetch a private post by id" );
+        is_deeply( $ids->( acls => ['public'],            title => 'Secret Plans' ), [],             "$name: nor by title" );
+        is_deeply( $ids->( acls => [],                    id    => 'p-public' ),     [],             "$name: no acls fetch nothing, however public" );
+        is_deeply( $ids->( acls => ['admin'],             id    => 'p-private' ),    ['p-private'],  "$name: an admin can" );
+        is_deeply( $ids->( acls => ['public'],            id    => 'p-public' ),     ['p-public'],   "$name: a visitor still gets a public post" );
+        is_deeply( $ids->( acls => ['aseries'],           id    => 'p-acl' ),        ['p-acl'],      "$name: and a member the post their acl names" );
+        is_deeply( $ids->( acls => ['public'],            id    => 'p-unlisted' ),   [],             "$name: unlisted needs its own acl" );
+        is_deeply( $ids->( acls => [qw{public unlisted}], id    => 'p-unlisted' ),   ['p-unlisted'], "$name: which a link to it carries" );
+    }
+};
+
 subtest 'versions' => sub {
-    my ($latest) = $sqlite->get( limit => 0, id => 'p-public' );
+    my ($latest) = $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-public' );
     is( $latest->{version},     1,                               'the newest version is the one you get' );
     is( $latest->{title},       'The Quick Brown Fox (revised)', 'with its own content' );
     is( $latest->{version_max}, 1,                               'version_max is the newest' );
     is( $latest->{created},     $corpus[0]{created},             'created is the post birthday, not the revision' );
     is( $latest->{modified},    $corpus[-1]{created},            'modified is the revision' );
 
-    my ($first) = $sqlite->get( limit => 0, id => 'p-public', version => 0 );
+    my ($first) = $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-public', version => 0 );
     is( $first->{title},       'The Quick Brown Fox', 'an older version can still be asked for' );
     is( $first->{version_max}, 1,                     'and knows a newer one exists' );
 
@@ -285,7 +310,7 @@ subtest 'count, tags and delete' => sub {
     my $vdbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
     my ($stale) = $vdbh->selectrow_array(q{SELECT COUNT(*) FROM post_versions WHERE uuid = 'p-micro'});
     is( $stale, 0, 'and its version bookkeeping' );
-    is_deeply( [ $sqlite->get( limit => 0, id => 'p-micro' ) ], [], 'and it cannot be fetched' );
+    is_deeply( [ $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-micro' ) ], [], 'and it cannot be fetched' );
 
     # The schema's triggers own this, not the Perl.
     my $dbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
@@ -313,7 +338,7 @@ subtest 'writing' => sub {
     like( $clash, qr/Could not write post 'p-new'/, 'the same version twice is refused, loudly' );
 
     is( exception { $sqlite->write( [ post( id => 'p-new', title => 'Second Version', version => 1 ) ] ) }, undef, 'a new version is not' );
-    my ($now) = $sqlite->get( limit => 0, id => 'p-new' );
+    my ($now) = $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-new' );
     is( $now->{title}, 'Second Version', 'and wins' );
 
     like( exception { $sqlite->write( [ { title => 'No Id' } ] ) }, qr/no id/i, 'a post with no id is refused' );

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

@@ -1243,6 +1243,25 @@ subtest 'invoice' => sub {
     like( $body, qr{Due: <span class="unixtimestamp">\Q$due\E</span>}, 'due date counts from the latest edit, not the first save' );
 };
 
+subtest 'a private post is not served to a visitor who asks for it by id' => sub {
+    my $secret = _save_post(
+        'private post',
+        form       => 'blog.tx',
+        title      => 'Spec Private Post',
+        data       => 'Spec private body.',
+        visibility => 'private',
+        to         => '/posts',
+    ) or return;
+
+    my ( $code, $body ) = _render( _anon( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
+    is( $code, 404, 'a visitor gets a 404' );
+    unlike( $body, qr/Spec private body/, 'and none of the post' );
+
+    ( $code, $body ) = _render( _admin( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
+    is( $code, 200, 'an admin gets the post' );
+    like( $body, qr/Spec private body/, 'with its body' );
+};
+
 subtest 'spec_widget (the wizard-built type)' => sub {
     my $title = 'Spec Widget Series';
     _make_series( 'spec_widget', 'specwidget', 'spec_widget.tx', $title ) or return;

t/bin-migrate.t

@@ -139,12 +139,12 @@ subtest 'the two models now answer the same questions' => sub {
     my @queries = (
         [ 'everything an admin sees' => { limit => 0, acls => ['admin'] } ],
         [ 'what a visitor sees'      => { limit => 0, acls => ['public'] } ],
-        [ 'by tag'           => { limit => 0, acls => ['admin'], tags   => ['topbar'] } ],
-        [ 'by a rare tag'    => { limit => 0, acls => ['admin'], tags   => ['rare'] } ],
-        [ 'by author'        => { limit => 0, acls => ['admin'], author => 'ann' } ],
-        [ 'by id'            => { limit => 0, id   => 'p-one' } ],
-        [ 'an older version' => { limit => 0, id   => 'p-one',   version => 1 } ],
-        [ 'by form'          => { limit => 0, acls => ['admin'], form    => 'presentation.tx' } ],
+        [ 'by tag'           => { limit => 0, acls => ['admin'],   tags   => ['topbar'] } ],
+        [ 'by a rare tag'    => { limit => 0, acls => ['admin'],   tags   => ['rare'] } ],
+        [ 'by author'        => { limit => 0, acls => ['admin'],   author => 'ann' } ],
+        [ 'by id'            => { limit => 0, acls => [qw{admin}], id     => 'p-one' } ],
+        [ 'an older version' => { limit => 0, acls => [qw{admin}], id     => 'p-one', version => 1 } ],
+        [ 'by form'          => { limit => 0, acls => ['admin'],   form   => 'presentation.tx' } ],
     );
 
     foreach my $case (@queries) {
@@ -155,7 +155,7 @@ subtest 'the two models now answer the same questions' => sub {
     }
 
     # The rolled up fields have to survive the trip, not just the rows.
-    my ($current) = $sqlite->get( limit => 0, id => 'p-one' );
+    my ($current) = $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-one' );
     is( $current->{version},     2,                   'the newest version is the current one' );
     is( $current->{version_max}, 2,                   'version_max came across' );
     is( $current->{title},       'The First v3',      'with the newest content' );
@@ -185,7 +185,7 @@ subtest 'picking up what was written in between' => sub {
     is( $rc, 0, 'succeeds' ) or diag($out);
     like( $out, qr/Carried over 1 post version\(s\), skipped 6/, 'carrying over only the new one' );
 
-    my ($late) = $sqlite->get( limit => 0, id => 'p-late' );
+    my ($late) = $sqlite->get( limit => 0, acls => [qw{admin}], id => 'p-late' );
     is( $late->{title}, 'Written Later', 'which is there afterwards' );
 };