Use immutable hashed urls for /play/#/cover and /play/#/full_cover

IFComp/lib/IFComp/Controller/Entry.pm

@@ -289,6 +289,7 @@ sub _process_form {
                     $entry->web_cover_file->remove;
                     $entry->clear_web_cover_file;
                     $entry->remove_web_cover_geometry_file;
+                    $entry->remove_cover_hash_file;
                 }
             }
 

IFComp/lib/IFComp/Controller/Play.pm

@@ -109,25 +109,56 @@ sub transcribe : Chained('fetch_entry') : Args(0) {
 
 }
 
-sub cover : Chained('fetch_entry') : PathPart('cover') : Args(0) {
+sub cover : Chained('fetch_entry') : PathPart('cover') : Args(1) {
+    my ( $self, $c, $hash ) = @_;
+
+    return $self->_cover( $c, 'web_cover_file', 'web_cover_hash', $hash,
+        'cover' );
+}
+
+sub cover_unhashed : Chained('fetch_entry') : PathPart('cover') : Args(0) {
     my ( $self, $c ) = @_;
 
-    return $self->_cover( $c, 'web_cover_file' );
+    return $self->_cover( $c, 'web_cover_file', 'web_cover_hash', undef,
+        'cover' );
+}
+
+sub full_cover : Chained('fetch_entry') : PathPart('full_cover') : Args(1) {
+    my ( $self, $c, $hash ) = @_;
+
+    return $self->_cover( $c, 'cover_file', 'cover_hash', $hash,
+        'full_cover' );
 }
 
-sub full_cover : Chained('fetch_entry') : PathPart('full_cover') : Args(0) {
+sub full_cover_unhashed : Chained('fetch_entry') : PathPart('full_cover') :
+    Args(0) {
     my ( $self, $c ) = @_;
 
-    return $self->_cover( $c, 'cover_file' );
+    return $self->_cover( $c, 'cover_file', 'cover_hash', undef,
+        'full_cover' );
 }
 
 sub _cover {
-    my ( $self, $c, $method ) = @_;
+    my ( $self, $c, $file_method, $hash_method, $provided_hash, $action ) =
+        @_;
 
-    my $file = $c->stash->{entry}->$method;
+    my $entry = $c->stash->{entry};
+    my $file  = $entry->$file_method;
     if ( -e $file ) {
+        my $correct_hash = $entry->$hash_method;
+        if ( !defined $provided_hash || $provided_hash ne $correct_hash ) {
+            $c->res->redirect(
+                $c->uri_for_action(
+                    "/play/$action", [ $entry->id, $correct_hash ]
+                ),
+                301
+            );
+            return;
+        }
+
         my $image_data = $file->slurp;
-        $c->res->headers->header( 'Cache-Control' => 'max-age=86400' );
+        $c->res->headers->header(
+            'Cache-Control' => 'public, max-age=31536000, immutable' );
         if ( $file->basename =~ /png$/ ) {
             $c->res->content_type('image/png');
         }

IFComp/lib/IFComp/Schema/Result/Entry.pm

@@ -553,6 +553,7 @@ use File::Copy;
 use Imager;
 use String::Random;
 use Digest::MD5 ('md5_hex');
+use Digest::SHA ('sha256_hex');
 
 use v5.10;
 
@@ -572,6 +573,8 @@ Readonly my @DEFAULT_INFORM_CONTENT => qw(
 # (measured in CSS pixels) allowed by the ballot page for cover art.
 Readonly my $MAX_COVER_HEIGHT            => 700;
 Readonly my $WEB_COVER_GEOMETRY_FILENAME => 'geometry.txt';
+Readonly my $COVER_HASH_FILENAME         => 'hash.txt';
+Readonly my $CONTENT_HASH_LENGTH         => 16;
 
 has 'sort_title' => (
     is         => 'ro',
@@ -779,7 +782,11 @@ sub _build_walkthrough_file {
 sub _build_cover_file {
     my $self = shift;
 
-    return ( $self->cover_directory->children( no_hidden => 1 ) )[0];
+    my ($cover_file) =
+        grep { $_->basename ne $COVER_HASH_FILENAME }
+        $self->cover_directory->children( no_hidden => 1 );
+
+    return $cover_file;
 }
 
 sub _build_web_cover_file {
@@ -962,31 +969,49 @@ sub web_cover_geometry_file {
     return $self->web_cover_directory->file($WEB_COVER_GEOMETRY_FILENAME);
 }
 
+sub cover_hash_file {
+    my $self = shift;
+
+    return $self->cover_directory->file($COVER_HASH_FILENAME);
+}
+
+sub _content_hash_for_file {
+    my ( $self, $file ) = @_;
+
+    return unless defined $file && -e $file;
+
+    my $digest = sha256_hex( $file->slurp( iomode => '<:raw' ) );
+    return substr( $digest, 0, $CONTENT_HASH_LENGTH );
+}
+
 sub _read_web_cover_geometry {
     my $self = shift;
 
     my $file = $self->web_cover_geometry_file;
     return unless -e $file;
 
     my @lines = $file->slurp( chomp => 1 );
-    return unless @lines >= 2;
+    return unless @lines >= 3;
 
-    my ( $width, $height ) = @lines[ 0, 1 ];
-    return unless $width =~ /^\d+$/ && $height =~ /^\d+$/;
+    my ( $width, $height, $hash ) = @lines[ 0, 1, 2 ];
+    return
+           unless $width =~ /^\d+$/
+        && $height       =~ /^\d+$/
+        && $hash         =~ /^[0-9a-f]{$CONTENT_HASH_LENGTH}$/;
 
-    return ( $width, $height );
+    return ( $width, $height, $hash );
 }
 
 sub _write_web_cover_geometry {
-    my ( $self, $width, $height ) = @_;
+    my ( $self, $width, $height, $hash ) = @_;
 
     my $geometry_file = $self->web_cover_geometry_file;
 
     # write atomically to ensure workers don't read half-written files
     my $temp_file =
         $geometry_file->dir->file( sprintf '.geometry.%s.tmp', $$ );
 
-    $temp_file->spew("$width\n$height\n");
+    $temp_file->spew("$width\n$height\n$hash\n");
     rename $temp_file->stringify, $geometry_file->stringify
         or die "Could not write web cover geometry for entry "
         . $self->id . ": $!";
@@ -999,6 +1024,39 @@ sub remove_web_cover_geometry_file {
     $file->remove if -e $file;
 }
 
+sub _read_cover_hash {
+    my $self = shift;
+
+    my $file = $self->cover_hash_file;
+    return unless -e $file;
+
+    my ($hash) = $file->slurp( chomp => 1 );
+    return
+        unless defined $hash && $hash =~ /^[0-9a-f]{$CONTENT_HASH_LENGTH}$/;
+
+    return $hash;
+}
+
+sub _write_cover_hash {
+    my ( $self, $hash ) = @_;
+
+    my $hash_file = $self->cover_hash_file;
+
+    # write atomically to ensure workers don't read half-written files
+    my $temp_file = $hash_file->dir->file( sprintf '.hash.%s.tmp', $$ );
+
+    $temp_file->spew("$hash\n");
+    rename $temp_file->stringify, $hash_file->stringify
+        or die "Could not write cover hash for entry " . $self->id . ": $!";
+}
+
+sub remove_cover_hash_file {
+    my $self = shift;
+
+    my $file = $self->cover_hash_file;
+    $file->remove if -e $file;
+}
+
 sub web_cover_geometry {
     my $self = shift;
 
@@ -1007,18 +1065,19 @@ sub web_cover_geometry {
     my $web_cover_file = $self->web_cover_file;
     return unless defined $web_cover_file && -e $web_cover_file;
 
-    if ( my @dims = $self->_read_web_cover_geometry ) {
-        return @dims;
+    if ( my @meta = $self->_read_web_cover_geometry ) {
+        return @meta;
     }
 
     my $image = Imager->new( file => $web_cover_file );
     return unless $image;
 
     my $width  = $image->getwidth;
     my $height = $image->getheight;
-    $self->_write_web_cover_geometry( $width, $height );
+    my $hash   = $self->_content_hash_for_file($web_cover_file);
+    $self->_write_web_cover_geometry( $width, $height, $hash );
 
-    return ( $width, $height );
+    return ( $width, $height, $hash );
 }
 
 sub web_cover_width {
@@ -1035,6 +1094,31 @@ sub web_cover_height {
     return $height;
 }
 
+sub web_cover_hash {
+    my $self = shift;
+
+    my ( undef, undef, $hash ) = $self->web_cover_geometry;
+    return $hash;
+}
+
+sub cover_hash {
+    my $self = shift;
+
+    return unless $self->cover_exists;
+
+    my $cover_file = $self->cover_file;
+    return unless defined $cover_file && -e $cover_file;
+
+    if ( my $hash = $self->_read_cover_hash ) {
+        return $hash;
+    }
+
+    my $hash = $self->_content_hash_for_file($cover_file);
+    $self->_write_cover_hash($hash);
+
+    return $hash;
+}
+
 sub create_web_cover_file {
     my $self = shift;
 
@@ -1043,6 +1127,7 @@ sub create_web_cover_file {
     }
     $self->clear_web_cover_file;
     $self->remove_web_cover_geometry_file;
+    $self->remove_cover_hash_file;
 
     return unless $self->cover_exists;
 
@@ -1060,7 +1145,10 @@ sub create_web_cover_file {
         $height = $image->getheight;
     }
 
-    $self->_write_web_cover_geometry( $width, $height );
+    my $web_hash = $self->_content_hash_for_file( $self->web_cover_file );
+    $self->_write_web_cover_geometry( $width, $height, $web_hash );
+    $self->_write_cover_hash(
+        $self->_content_hash_for_file( $self->cover_file ) );
 }
 
 # update_content_directory: Clean up (and possibly create) the content directory,

IFComp/root/src/_current_entry_row.tt

@@ -3,7 +3,7 @@
     [% IF entry.cover_exists %]
     <div class="col-sm-4">
         <div itemprop="image" itemscope itemtype="https://schema.org/ImageObject">
-            <a itemprop="contentUrl" href="[% c.uri_for_action( '/play/full_cover', [ entry.id ] ) %]" target="_blank"><img itemprop="thumbnailUrl" class="img-fluid" src="[% c.uri_for_action( '/play/cover', [ entry.id ] ) %]" alt="Cover art for [% entry.title %]" height="[% entry.web_cover_height %]" width="[% entry.web_cover_width %]" loading="lazy"></a>
+            <a itemprop="contentUrl" href="[% c.uri_for_action( '/play/full_cover', [ entry.id, entry.cover_hash ] ) %]" target="_blank"><img itemprop="thumbnailUrl" class="img-fluid" src="[% c.uri_for_action( '/play/cover', [ entry.id, entry.web_cover_hash ] ) %]" alt="Cover art for [% entry.title %]" height="[% entry.web_cover_height %]" width="[% entry.web_cover_width %]" loading="lazy"></a>
 	    [% IF (entry.genai_state / 2) % 2 == 1 %]
 		<span style="font-size: smaller;" itemprop="genai_cover"><em>Generative artificial intelligence was used to make this cover art.</em></span>
 	    [% END %]

IFComp/t/controller_Entry.t

@@ -104,6 +104,9 @@ is( $entry->web_cover_width,
     $web_cover_image->getwidth,
     "Cached web-cover width is correct."
 );
+ok( $entry->web_cover_hash,            "Cached web-cover hash is present." );
+ok( $entry->cover_hash,                "Cached full-cover hash is present." );
+ok( -e "$comp_dir/$id/cover/hash.txt", "Full-cover hash file created." );
 
 ######
 # Modify entry, changing to a smaller cover image
@@ -134,6 +137,10 @@ is( $entry->web_cover_width,
     $web_cover_image->getwidth,
     "Cached web-cover width is updated."
 );
+my $web_hash   = $entry->web_cover_hash;
+my $cover_hash = $entry->cover_hash;
+ok( $web_hash,   "Cached web-cover hash is updated." );
+ok( $cover_hash, "Cached full-cover hash is updated." );
 
 unlink "$comp_dir/$id/web_cover/geometry.txt"
     or die "Could not remove geometry cache: $!";
@@ -142,6 +149,14 @@ is( $entry->web_cover_height, 200,
 ok( -e "$comp_dir/$id/web_cover/geometry.txt",
     "Regenerated web-cover geometry file."
 );
+is( $entry->web_cover_hash, $web_hash,
+    "Regenerated web-cover hash matches prior hash." );
+
+unlink "$comp_dir/$id/cover/hash.txt"
+    or die "Could not remove cover hash cache: $!";
+is( $entry->cover_hash, $cover_hash,
+    "Missing cover hash cache is regenerated on read." );
+ok( -e "$comp_dir/$id/cover/hash.txt", "Regenerated cover hash file." );
 
 ######
 # Modify an entry, removing cover files
@@ -161,6 +176,7 @@ ok( not( -e "$comp_dir/$id/web_cover/tiny_cover.png" ),
     "Web cover deleted." );
 ok( not( -e "$comp_dir/$id/web_cover/geometry.txt" ),
     "Web-cover geometry file deleted." );
+ok( not( -e "$comp_dir/$id/cover/hash.txt" ), "Cover hash file deleted." );
 
 ######
 # Modify an entry, trying to upload a bogus image

IFComp/t/controller_Play.t

@@ -87,13 +87,53 @@ note('Testing cover art...');
 {
     my $entry = $schema->resultset('Entry')->find(100);
 
-    $mech->get_ok('http://localhost/play/100/cover');
+    my $web_hash   = $entry->web_cover_hash;
+    my $cover_hash = $entry->cover_hash;
+    ok( $web_hash,   'Web cover hash is available' );
+    ok( $cover_hash, 'Full cover hash is available' );
+
+    $mech->get_ok("http://localhost/play/100/cover/$web_hash");
     $mech->header_is( 'Content-Type',   'image/png' );
     $mech->header_is( 'Content-Length', 19242 );
+    $mech->header_is( 'Cache-Control',
+        'public, max-age=31536000, immutable' );
 
-    $mech->get_ok('http://localhost/play/100/full_cover');
+    $mech->get_ok("http://localhost/play/100/full_cover/$cover_hash");
     $mech->header_is( 'Content-Type',   'image/png' );
     $mech->header_is( 'Content-Length', 35185 );
+    $mech->header_is( 'Cache-Control',
+        'public, max-age=31536000, immutable' );
+
+    # Missing or stale hashes permanently redirect to the current hash URL.
+    $mech->max_redirect(0);
+    $mech->get('http://localhost/play/100/cover');
+    is( $mech->status, 301, 'Cover without hash redirects' );
+    is( $mech->response->header('Location'),
+        "http://localhost/play/100/cover/$web_hash",
+        'Cover redirect points at current hash'
+    );
+
+    $mech->get('http://localhost/play/100/cover/deadbeefdeadbeef');
+    is( $mech->status, 301, 'Cover with wrong hash redirects' );
+    is( $mech->response->header('Location'),
+        "http://localhost/play/100/cover/$web_hash",
+        'Wrong cover hash redirects to current hash'
+    );
+
+    $mech->get('http://localhost/play/100/full_cover');
+    is( $mech->status, 301, 'Full cover without hash redirects' );
+    is( $mech->response->header('Location'),
+        "http://localhost/play/100/full_cover/$cover_hash",
+        'Full cover redirect points at current hash'
+    );
+
+    $mech->get('http://localhost/play/100/full_cover/deadbeefdeadbeef');
+    is( $mech->status, 301, 'Full cover with wrong hash redirects' );
+    is( $mech->response->header('Location'),
+        "http://localhost/play/100/full_cover/$cover_hash",
+        'Wrong full cover hash redirects to current hash'
+    );
+    $mech->max_redirect(7);
 }
 
 done_testing();