Add rudimentary AVIF support.

Works with recent Chrome, and soon hopefully with Firefox.
Needs a recent aomenc and MP4BOx (gpac). AVIFs have to be added
manually and offline using the make-avif.pl script for now.

diff --git a/doc/README b/doc/README
index 42d467cebac4044c883ff89dc75fb58056999858..3b088c15f601d834fdfeec2266524c2dbf97e589 100644 (file)
--- a/doc/README
+++ b/doc/README
@@ -15,6 +15,11 @@ backend pr0n {
 sub vcl_recv {
     if (req.http.host ~ "^pr0n\.sesse\.net(:[0-9]+)?$") {
         set req.backend_hint = pr0n;
+        if (req.http.accept ~ "(^|,)image/avif($|,|;)") {
+            set req.http.accept = "image/avif,*/*";
+        } else {
+            set req.http.accept = "*/*";
+        }
         if (req.method == "PUT") {
             return (pipe);
         }

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index 04954424d41c41a0f143898431e042584204db76..8c21541287a60053d92ea08535b21546d8b86c9c 100644 (file)
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -22,6 +22,7 @@ use HTML::Entities;
 use URI::Escape;
 use File::Basename;
 use Crypt::Eksblowfish::Bcrypt;
+use File::Temp;
 
 BEGIN {
        use Exporter ();
@@ -212,10 +213,10 @@ sub get_disk_location {
 }
 
 sub get_cache_location {
-       my ($id, $width, $height) = @_;
+       my ($id, $width, $height, $format) = @_;
        my $dir = POSIX::floor($id / 256);
 
-       return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-nobox.jpg";
+       return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-nobox.$format";
 }
 
 sub get_infobox_cache_location {
@@ -572,14 +573,21 @@ sub read_original_image {
 }
 
 sub ensure_cached {
-       my ($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_;
+       my ($r, $avif_ok, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_;
 
        my $fname = get_disk_location($r, $id);
        unless (defined($xres) && (!defined($dbwidth) || !defined($dbheight) || $xres < $dbwidth || $yres < $dbheight || $xres == -1)) {
                return ($fname, undef);
        }
 
-       my $cachename = get_cache_location($id, $xres, $yres);
+       # See if we have an up-to-date AVIF to serve.
+       # (We never generate them on-the-fly, since they're so slow.)
+       my $cachename = get_cache_location($id, $xres, $yres, 'avif');
+       if ($avif_ok && -r $cachename and (-M $cachename <= -M $fname)) {
+               return ($cachename, 'image/avif');
+       }
+
+       $cachename = get_cache_location($id, $xres, $yres, 'jpg');
        if (! -r $cachename or (-M $cachename > -M $fname)) {
                # If we are in overload mode (aka Slashdot mode), refuse to generate
                # new thumbnails.
@@ -588,14 +596,14 @@ sub ensure_cached {
                        error($r, 'System is in overload mode, not doing any scaling');
                }
 
-               make_cache($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres);
+               make_cache($r, $filename, $id, $dbwidth, $dbheight, 'jpg', $xres, $yres, @otherres);
        }
 
        return ($cachename, 'image/jpeg');
 }
 
 sub make_cache {
-       my ($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_;
+       my ($r, $filename, $id, $dbwidth, $dbheight, $format, $xres, $yres, @otherres) = @_;
 
        my ($img, $new_dbwidth, $new_dbheight) = make_mipmap($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres);
 
@@ -608,7 +616,7 @@ sub make_cache {
        my $err;
        while (defined($xres) && defined($yres)) {
                my ($nxres, $nyres) = (shift @otherres, shift @otherres);
-               my $cachename = get_cache_location($id, $xres, $yres);
+               my $cachename = get_cache_location($id, $xres, $yres, $format);
                
                my $cimg;
                if (defined($nxres) && defined($nyres)) {
@@ -623,6 +631,11 @@ sub make_cache {
                my $height = $img->Get('rows');
                my ($nwidth, $nheight) = scale_aspect($width, $height, $xres, $yres);
 
+               if ($format eq 'avif') {  # AVIF uses 4:2:0.
+                       ++$nwidth if ($nwidth % 2 == 1);
+                       ++$nheight if ($nheight % 2 == 1);
+               }
+
                my $filter = 'Lanczos';
                my $quality = 87;
                my $sf = "1x1";
@@ -634,7 +647,7 @@ sub make_cache {
                # Strip EXIF tags etc.
                $cimg->Strip();
 
-               {
+               if ($format eq 'jpg') {
                        my %parms = (
                                filename => $cachename,
                                quality => $quality
@@ -647,13 +660,37 @@ sub make_cache {
                                $parms{'sampling-factor'} = $sf;
                        }
                        $err = $cimg->write(%parms);
+               } elsif ($format eq 'avif') {
+                       # ImageMagick doesn't have AVIF support until version 7,
+                       # and Debian hasn't packaged that even in unstable as of 2021.
+                       # So we'll need to do it the manual way. (We don't use /tmp, for security reasons.)
+                       (my $dirname = $cachename) =~ s,/[^/]*$,,;
+                       my ($fh, $raw_filename) = File::Temp::tempfile('tmp.XXXXXXXX', DIR => $dirname, SUFFIX => '.yuv');
+                       # Write a Y4M header, so that we get the chroma siting and color space correct.
+                       printf $fh "YUV4MPEG2 W%d H%d F25:1 Ip A1:1 C420jpeg XYSCSS=420JPEG XCOLORRANGE=FULL\nFRAME\n", $nwidth, $nheight;
+                       my %parms = (
+                               file => $fh,
+                               filename => $raw_filename,
+                               'sampling-factor' => '2x2'
+                       );
+                       $cimg->write(%parms);
+                       close($fh);
+                       my $ivf_filename;
+                       ($fh, $ivf_filename) = File::Temp::tempfile('tmp.XXXXXXXX', DIR => $dirname, SUFFIX => '.ivf');
+                       close($fh);
+                       system('aomenc', '--cpu-used=0', '--bit-depth=10', '--end-usage=q', '--cq-level=10', '--target-bitrate=0', '--good', '--aq-mode=1', '--color-primaries=bt601', '--matrix-coefficients=bt601', '-w', $nwidth, '-h', $nheight, '-o', $ivf_filename, $raw_filename);
+                       unlink($raw_filename);
+                       system('MP4Box', '-add-image', "$ivf_filename:primary", '-ab', 'avif', '-ab', 'miaf', '-new', $cachename);
+                       unlink($ivf_filename);
+               } else {
+                       die "Unknown format $format";
                }
 
                undef $cimg;
 
                ($xres, $yres) = ($nxres, $nyres);
 
-               log_info($r, "New cache: $nwidth x $nheight for $id.jpg");
+               log_info($r, "New cache: $nwidth x $nheight ($format) for $id");
        }
        
        undef $img;

diff --git a/perl/Sesse/pr0n/Image.pm b/perl/Sesse/pr0n/Image.pm
index f12a15891792ed1ba0e195e815c4c157df2d1b29..13d9ee5e3ae488d6cf7f9393fa589240c34ab0d5 100644 (file)
--- a/perl/Sesse/pr0n/Image.pm
+++ b/perl/Sesse/pr0n/Image.pm
@@ -58,16 +58,20 @@ sub handler {
        $dbwidth = $ref->{'width'};
        $dbheight = $ref->{'height'};
 
+       my $res = Plack::Response->new(200);
+
        # Scale if we need to do so
        my ($fname, $mime_type);
        if ($infobox) {
                ($fname, $mime_type) = Sesse::pr0n::Common::ensure_infobox_cached($r, $filename, $id, $dbwidth, $dbheight, $dpr, $xres, $yres);
        } else {
-               ($fname, $mime_type) = Sesse::pr0n::Common::ensure_cached($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres);
+               my $accept = $r->header('Accept');
+               my $avif_ok = (defined($accept) && $accept =~ /(^|,)image\/avif($|,|;)/);
+               ($fname, $mime_type) = Sesse::pr0n::Common::ensure_cached($r, $avif_ok, $filename, $id, $dbwidth, $dbheight, $xres, $yres);
+               $res->header('Vary' => 'Accept');
        }
 
        # Output the image to the user
-       my $res = Plack::Response->new(200);
 
        if (!defined($mime_type)) {
                $mime_type = Sesse::pr0n::Common::get_mimetype_from_filename($filename);

diff --git a/perl/make-avif.pl b/perl/make-avif.pl
new file mode 100755 (executable)
index 0000000..2db5709
--- /dev/null
+++ b/perl/make-avif.pl
@@ -0,0 +1,45 @@
+#! /usr/bin/perl
+
+use lib qw(.);
+use DBI;
+use POSIX;
+use Sesse::pr0n::Common;
+use strict;
+use warnings;
+
+use Sesse::pr0n::Config;
+eval {
+       require Sesse::pr0n::Config_local;
+};
+
+my $dbh = DBI->connect("dbi:Pg:dbname=pr0n;host=" . $Sesse::pr0n::Config::db_host,
+       $Sesse::pr0n::Config::db_username, $Sesse::pr0n::Config::db_password)
+       or die "Couldn't connect to PostgreSQL database: " . DBI->errstr;
+$dbh->{RaiseError} = 1;
+
+# TODO: Do we need to care about renders?
+for my $id (@ARGV) {
+       my $dir = POSIX::floor($id / 256);
+       my $base = $Sesse::pr0n::Config::image_base . "cache/$dir";
+       my @res = ();
+       for my $file (<$base/$id-*-nobox.jpg>) {   # TODO: --1--1.jpg, too.
+               my $fname = File::Basename::basename($file);
+               my ($width, $height) = $fname =~ /^$id-(\d+)-(\d+)-nobox\.jpg$/ or die $fname;
+               (my $avif_file = $file) =~ s/jpg$/avif/;
+               unless (-r $avif_file) {
+                       push @res, ($width, $height);
+                       print "$id to $width x $height...\n";
+               }
+       }
+       if (scalar @res > 0) {
+               my $filename = Sesse::pr0n::Common::get_disk_location({}, $id);
+
+               # Look up the width/height in the database.
+               my ($dbwidth, $dbheight);
+               my $ref = $dbh->selectrow_hashref('SELECT width,height FROM images WHERE id=?', undef, $id);
+               $dbwidth = $ref->{'width'};
+               $dbheight = $ref->{'height'};
+
+               Sesse::pr0n::Common::make_cache({}, $filename, $id, $dbwidth, $dbheight, 'avif', @res);
+       }       
+}