First crack at static renders.

Has quite crude invalidation, and doesn't cover all public routes yet.

Finishing the render pipeline such that we static all components
would allow more fine-grained invalidation.

That said, this should allow making emails out of posts, good enough.

.gitignore

@@ -23,3 +23,4 @@ config/setup
 MYMETA.yml
 MYMETA.json
 node_modules/
+www/statics/

Makefile

@@ -10,6 +10,7 @@ install:
 	test -d www/themes || mkdir -p www/themes
 	test -d data/files || mkdir -p data/files
 	test -d www/assets || mkdir -p www/assets
+	test -d www/statics || mkdir -p www/statics
 	$(RM) pod2htmd.tmp;
 
 .PHONY: install-service
@@ -33,7 +34,7 @@ prereq-debs:
 	    libtext-xslate-perl libplack-perl libconfig-tiny-perl libdatetime-format-http-perl libjson-maybexs-perl          \
 	    libuuid-tiny-perl libcapture-tiny-perl libconfig-simple-perl libdbi-perl libfile-slurper-perl libfile-touch-perl \
 	    libfile-copy-recursive-perl libxml-rss-perl libmodule-install-perl libio-string-perl                             \
-	    libmoose-perl libmoosex-types-datetime-perl libxml-libxml-perl liblist-moreutils-perl libclone-perl
+	    libmoose-perl libmoosex-types-datetime-perl libxml-libxml-perl liblist-moreutils-perl libclone-perl libpath-tiny-perl
 
 .PHONY: prereq-perl
 prereq-perl:

Makefile.PL

@@ -47,6 +47,10 @@ WriteMakefile(
     'CSS::Minifier::XS'      => '0',
     'JavaScript::Minifier::XS' => '0',
     'Digest::SHA'            => '0',
+    'Path::Tiny'             => '0',
+    'IO::Compress::Brotli'   => '0',
+    'IO::Compress::Gzip'     => '0',
+    'IO::Compress::Deflate'  => '0',
   },
   test => {TESTS => 't/*.t'}
 );

lib/TCMS.pm

@@ -16,8 +16,9 @@ use Mojo::File   ();
 use DateTime::Format::HTTP();
 use CGI::Cookie ();
 use File::Basename();
-use IO::Compress::Deflate();
+use IO::Compress::Gzip();
 use Time::HiRes qw{gettimeofday tv_interval};
+use HTTP::HeaderParser::XS;
 
 #Grab our custom routes
 use lib 'lib';
@@ -73,7 +74,7 @@ sub app {
     my $env = shift;
 
     # Check eTags.  If we don't know about it, just assume it's good and lazily fill the cache
-    # XXX yes, this allows cache poisoning
+    # XXX yes, this allows cache poisoning...but only for logged in users!
     if ($env->{HTTP_IF_NONE_MATCH}) {
         return [304, [], ['']] if $env->{HTTP_IF_NONE_MATCH} eq ($etags{$env->{REQUEST_URI}} || '');
         $etags{$env->{REQUEST_URI}} = $env->{HTTP_IF_NONE_MATCH} unless exists $etags{$env->{REQUEST_URI}};
@@ -84,14 +85,27 @@ sub app {
         $last_fetch = DateTime::Format::HTTP->parse_datetime($env->{HTTP_IF_MODIFIED_SINCE})->epoch();
     }
 
+    #XXX Don't use statics anything that has a search query
+    # On one hand, I don't want to DOS the disk, but I'd also like some like ?rss...
+    # Should probably turn those into aliases.
+    my $has_query = !!$env->{QUERY_STRING};
+
     my $query = {};
     $query = URL::Encode::url_params_mixed($env->{QUERY_STRING}) if $env->{QUERY_STRING};
 
     my $path = $env->{PATH_INFO};
+    $path = '/index' if $path eq '/';
 
     # Translate alias paths into their actual path
     $path = $aliases{$path} if exists $aliases{$path};
 
+    # Figure out if we want compression or not
+    my $alist = $env->{HTTP_ACCEPT_ENCODING} || '';
+    $alist =~ s/\s//g;
+    my @accept_encodings;
+    @accept_encodings = split(/,/, $alist);
+    my $deflate = grep { 'gzip' eq $_ } @accept_encodings;
+
     # Collapse multiple slashes in the path
     $path =~ s/[\/]+/\//g;
 
@@ -107,20 +121,25 @@ sub app {
     if (exists $cookies->{tcmslogin}) {
          $active_user = Trog::Auth::session2user($cookies->{tcmslogin}->value);
     }
+    $query->{acls} = [];
+    $query->{acls} = Trog::Auth::acls4user($active_user) // [] if $active_user;
 
     #Disallow any paths that are naughty ( starman auto-removes .. up-traversal)
-    if (index($path,'/templates') == 0 || $path =~ m/.*\.psgi$/i ) {
-        return Trog::Routes::HTML::forbidden($query);
+    if (index($path,'/templates') == 0 || index($path, '/statics') == 0 || $path =~ m/.*(\.psgi|\.pm)$/i ) {
+        return _forbidden($query);
     }
 
-    # If it's just a file, serve it up
-    my $alist = $env->{HTTP_ACCEPT_ENCODING} || '';
-    $alist =~ s/\s//g;
-    my @accept_encodings;
-    @accept_encodings = split(/,/, $alist);
-    my $deflate = grep { 'deflate' eq $_ } @accept_encodings;
+    # If we have a static render, just use it instead (These will ALWAYS be correct, data saves invalidate this)
+    # TODO: make this key on admin INSTEAD of active user when we add non-admin users.
 
-    return _serve("www/$path", $start, $env->{'psgi.streaming'}, $last_fetch, $deflate) if -f "www/$path";
+    my $streaming = $env->{'psgi.streaming'};
+    $query->{streaming} = $streaming;
+    if (!$active_user && !$has_query) {
+        return _static("$path.z",$streaming) if -f "www/statics/$path.z" && $deflate;
+        return _static($path,$streaming) if -f "www/statics/$path";
+    }
+
+    return _serve("www/$path", $start, $streaming, $last_fetch, $deflate) if -f "www/$path";
 
     #Handle regex/capture routes
     if (!exists $routes{$path}) {
@@ -141,8 +160,8 @@ sub app {
     $query->{deflate} = $deflate;
     $query->{user}    = $active_user;
 
-    return Trog::Routes::HTML::notfound($query) unless exists $routes{$path};
-    return Trog::Routes::HTML::badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ($routes{$path}{method},'HEAD');
+    return _notfound($query) unless exists $routes{$path};
+    return _badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ($routes{$path}{method} || '','HEAD');
 
     @{$query}{keys(%{$routes{$path}{'data'}})} = values(%{$routes{$path}{'data'}}) if ref $routes{$path}{'data'} eq 'HASH' && %{$routes{$path}{'data'}};
 
@@ -159,15 +178,10 @@ sub app {
     }
 
     #Set various things we don't want overridden
-    $query->{acls} = [$query->{acls}] if ($query->{acls} && ref $query->{acls} ne 'ARRAY');
-    $query->{acls} = Trog::Auth::acls4user($active_user) // [] if $active_user;
-
     $query->{body}         = '';
     $query->{user}         = $active_user;
     $query->{domain}       = $env->{HTTP_X_FORWARDED_HOST} || $env->{HTTP_HOST};
     $query->{route}        = $path;
-    #$query->{route}        = $env->{REQUEST_URI};
-    #$query->{route}        =~ s/\?\Q$env->{QUERY_STRING}\E//;
     $query->{scheme}       = $env->{'psgi.url_scheme'} // 'http';
     $query->{social_meta}  = 1;
     $query->{primary_post} = {};
@@ -183,6 +197,54 @@ sub app {
     }
 };
 
+sub _generic($type, $query) {
+    return _static("$type.z",$query->{streaming}) if -f "www/statics/$type.z";
+    return _static($type, $query->{streaming}) if -f "www/statics/$type";
+    my %lookup = (
+        notfound => \&Trog::Routes::HTML::notfound,
+        forbidden => \&Trog::Routes::HTML::forbidden,
+        badrequest => \&Trog::Routes::HTML::badrequest,
+    );
+    return $lookup{$type}->($query);
+}
+
+sub _notfound ( $query ) {
+    return _generic('notfound', $query);
+}
+
+sub _forbidden($query) {
+    return _generic('forbidden', $query);
+}
+
+sub _badrequest($query) {
+    return _generic('badrequest', $query);
+}
+
+sub _static($path,$streaming=0,$last_fetch=0) {
+
+    # XXX because of psgi I can't just vomit the file directly
+    if (open(my $fh, '<', "www/statics/$path")) {
+        my $headers = '';
+        # NOTE: this is relying on while advancing the file pointer
+        while (<$fh>) {
+            last if $_ eq "\n";
+            $headers .= $_;
+        }
+        my $hdrs = HTTP::HeaderParser::XS->new(\$headers);
+        my $headers_parsed = $hdrs->getHeaders();
+
+        #XXX need to put this into the file itself
+        my $mt = (stat($fh))[9];
+        my @gm = gmtime($mt);
+        my $now_string = strftime( "%a, %d %b %Y %H:%M:%S GMT", @gm );
+        my $code = $mt > $last_fetch ? $hdrs->getStatusCode() : 304;
+        $headers_parsed->{"Last-Modified"} = $now_string;
+
+        return [$code, [%$headers_parsed], $fh];
+    }
+    return [ 403, ['Content-Type' => $Trog::Vars::content_types{plain}], ["STAY OUT YOU RED MENACE"]];
+}
+
 sub _serve ($path, $start, $streaming=0, $last_fetch=0, $deflate=0) {
     my $mf = Mojo::File->new($path);
     my $ext = '.'.$mf->extname();
@@ -232,10 +294,10 @@ sub _serve ($path, $start, $streaming=0, $last_fetch=0, $deflate=0) {
         }
 
         #Compress everything less than 1MB
-        push( @headers, "Content-Encoding" => "deflate" );
+        push( @headers, "Content-Encoding" => "gzip" );
         my $dfh;
-        IO::Compress::Deflate::deflate( $fh => \$dfh );
-        print $IO::Compress::Deflate::DeflateError if $IO::Compress::Deflate::DeflateError;
+        IO::Compress::Gzip::gzip( $fh => \$dfh );
+        print $IO::Compress::Gzip::GzipError if $IO::Compress::Gzip::GzipError;
         push( @headers, "Content-Length" => length($dfh) );
 
         # Append server-timing headers

lib/Trog/Data/DUMMY.pm

@@ -10,6 +10,7 @@ use Carp qw{confess};
 use JSON::MaybeXS;
 use File::Slurper;
 use List::Util qw{uniq};
+use Path::Tiny();
 use parent qw{Trog::DataModule};
 
 =head1 WARNING
@@ -63,6 +64,10 @@ sub delete($self, @posts) {
         @$example_posts = grep { $_->{id} ne $update->{id} } @$example_posts;
     }
     $self->write($example_posts,1);
+
+    # Gorilla cache invalidation
+    Path::Tiny::path('www/statics')->remove_tree;
+
     return 0;
 }
 

lib/Trog/Data/FlatFile.pm

@@ -11,6 +11,7 @@ use JSON::MaybeXS;
 use File::Slurper;
 use File::Copy;
 use Mojo::File;
+use Path::Tiny();
 
 use lib 'lib';
 use Trog::SQLite::TagIndex;
@@ -134,6 +135,10 @@ sub delete($self, @posts) {
         unlink "$datastore/$update->{id}" or confess;
         Trog::SQLite::TagIndex::remove_post($update);
     }
+
+    # Gorilla cache invalidation
+    Path::Tiny::path('www/statics')->remove_tree;
+
     return 0;
 }
 

lib/Trog/DataModule.pm

@@ -8,6 +8,7 @@ use List::Util;
 use File::Copy;
 use Mojo::File;
 use Plack::MIME;
+use Path::Tiny();
 
 no warnings 'experimental';
 use feature qw{signatures};
@@ -267,6 +268,9 @@ sub add ($self, @posts) {
         kill 'HUP', $parent;
     }
 
+    # Gorilla cache invalidation
+    Path::Tiny::path('www/statics')->remove_tree;
+
     return 0;
 }
 

lib/Trog/Routes/HTML.pm

@@ -14,8 +14,10 @@ use Capture::Tiny qw{capture};
 use HTML::SocialMeta;
 
 use Encode qw{encode_utf8};
-use IO::Compress::Deflate;
+use IO::Compress::Gzip;
 use CSS::Minifier::XS;
+use Path::Tiny();
+use File::Basename qw{dirname};
 
 use Trog::Utils;
 use Trog::Config;
@@ -38,16 +40,17 @@ our $topbar        = 'topbar.tx';
 our $footbar       = 'footbar.tx';
 
 # Note to maintainers: never ever remove backends from this list.
-# the auth => 1 is a crucial protection, even with forbidden() guards in these routes.
+# the auth => 1 is a crucial protection.
 our %routes = (
     default => {
         callback => \&Trog::Routes::HTML::setup,
     },
-    '/' => {
+    '/index' => {
         method   => 'GET',
         callback => \&Trog::Routes::HTML::index,
     },
     #Deal with most indexDocument directives interfering with proxied requests to /
+    #TODO replace with alias routes
     '/index.html' => {
         method   => 'GET',
         callback  => \&Trog::Routes::HTML::index,
@@ -71,7 +74,6 @@ our %routes = (
     },
     '/auth' => {
         method   => 'POST',
-        nostatic => 1,
         callback => \&Trog::Routes::HTML::login,
     },
     '/post/save' => {
@@ -300,7 +302,7 @@ Implements the 4XX status codes.  Override templates named the same for theming
 
 sub _generic_route ($rname, $code, $title, $query) {
     $query->{code} = $code;
-
+    $query->{route} //= $rname;
     $query->{title} = $title;
     my $styles = _build_themed_styles("$rname.css");
     my $content = themed_render("$rname.tx", {
@@ -308,7 +310,7 @@ sub _generic_route ($rname, $code, $title, $query) {
         route    => $query->{route},
         user     => $query->{user},
         styles   => $styles,
-    deflate  => $query->{deflate},
+        deflate  => $query->{deflate},
     });
     return Trog::Routes::HTML::index($query, $content, $styles);
 }
@@ -519,11 +521,8 @@ Renders the configuration page, or redirects you back to the login page.
 =cut
 
 sub config ($query) {
-    if (!$query->{user}) {
-        return login($query);
-    }
-    #NOTE: we are relying on this to skip the ACL check with 'admin', this may not be viable in future?
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
 
     my $css   = _build_themed_styles('config.css');
     my $js    = _build_themed_scripts('post.js');
@@ -581,7 +580,8 @@ Implements /config/save route.  Saves what little configuration we actually use
 =cut
 
 sub config_save ($query) {
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
 
     $conf->param( 'general.theme',      $query->{theme} )      if defined $query->{theme};
     $conf->param( 'general.data_model', $query->{data_model} ) if $query->{data_model};
@@ -606,7 +606,9 @@ Clone a theme by copying a directory.
 =cut
 
 sub themeclone ($query) {
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+
     my ($theme, $newtheme) = ($query->{theme},$query->{newtheme});
 
     my $themedir = 'www/themes';
@@ -628,8 +630,9 @@ Saves posts submitted via the /post pages
 =cut
 
 sub post_save ($query) {
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
 
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
     my $to = delete $query->{to};
 
     #Copy this down since it will be deleted later
@@ -657,7 +660,8 @@ Saves / updates new users.
 =cut
 
 sub profile ($query) {
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
 
     #TODO allow users to do something OTHER than be admins
     if ($query->{password}) {
@@ -678,7 +682,8 @@ deletes posts.
 =cut
 
 sub post_delete ($query) {
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
 
     $data->delete($query) and die "Could not delete post";
     return see_also($query->{to});
@@ -1167,11 +1172,12 @@ Basically a thin wrapper around Pod::Html.
 =cut
 
 sub manual ($query) {
+    return see_also('/login') unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
+
     require Pod::Html;
     require Capture::Tiny;
 
-    return forbidden($query) unless grep { $_ eq 'admin' } @{$query->{acls}};
-
     #Fix links from Pod::HTML
     $query->{module} =~ s/\.html$//g if $query->{module};
 
@@ -1282,7 +1288,7 @@ sub _themed_template ($resource) {
     return _dir_for_resource("templates/$resource")."/templates/$resource";
 }
 
-sub finish_render ($template, $vars, @headers) {
+sub finish_render ($template, $vars, %headers) {
 
     #XXX default vars that need to be pulled from config
     $vars->{dir}       //= 'ltr';
@@ -1309,30 +1315,50 @@ sub finish_render ($template, $vars, @headers) {
         $body .= themed_render('footer.tx', $vars);
         $body  = encode_utf8($body);
     }
+    #Disallow framing UNLESS we are in embed mode
+    $headers{"Content-Security-Policy"} = qq{frame-ancestors 'none'} unless $vars->{embed};
 
     my $ct = 'Content-type';
     my $cc = 'Cache-control';
-    push(@headers, $ct => $vars->{contenttype});
-    push(@headers, $cc => $vars->{cachecontrol}) if $vars->{cachecontrol};
-    push(@headers, 'ETag' => $vars->{etag}) if $vars->{etag};
+    $headers{$ct} = $vars->{contenttype};
+    $headers{$cc} = $vars->{cachecontrol} if $vars->{cachecontrol};
+    $headers{'Vary'} = 'Accept-Encoding';
+    $headers{"Content-Length"} = length($body);
+
+    # We only set etags when users are logged in, cause we don't use statics
+    $headers{'ETag'} = $vars->{etag} if $vars->{etag} && $vars->{user};
+
+    my $skip_render = !$vars->{route};
+
+    # Time to stash (and cache!) the bodies for public routes, everything else should be fine
+    save_render($vars, $body, %headers) unless $vars->{user} || $skip_render;
 
     #Return data in the event the caller does not support deflate
-    if (!$vars->{deflate}) {
-        push( @headers, "Content-Length" => length($body) );
-        return [ $vars->{code}, \@headers, [$body]];
-    }
+    return [ $vars->{code}, [%headers], [$body]] unless $vars->{deflate};
 
     #Compress
-    push( @headers, "Content-Encoding" => "deflate" );
+    $headers{"Content-Encoding"} = "gzip";
+    my $dfh;
+    IO::Compress::Gzip::gzip( \$body => \$dfh );
+    print $IO::Compress::Gzip::GzipError if $IO::Compress::Gzip::GzipError;
+    $headers{"Content-Length"} = length($dfh);
 
-    #Disallow framing UNLESS we are in embed mode
-    push( @headers, "Content-Security-Policy" => qq{frame-ancestors 'none'} ) unless $vars->{embed};
+    save_render({ route => "$vars->{route}.z", code => $vars->{code} },$dfh,%headers) unless $vars->{user} || $skip_render;
 
-    my $dfh;
-    IO::Compress::Deflate::deflate( \$body => \$dfh );
-    print $IO::Compress::Deflate::DeflateError if $IO::Compress::Deflate::DeflateError;
-    push( @headers, "Content-Length" => length($dfh) );
-    return [$vars->{code}, \@headers, [$dfh]];
+    return [$vars->{code}, [%headers], [$dfh]];
+}
+
+sub save_render ($vars, $body, %headers) {
+    Path::Tiny::path("www/statics/".dirname($vars->{route}))->mkpath;
+    my $file = "www/statics/$vars->{route}";
+    open(my $fh, '>', $file) or die "Could not open $file for writing";
+    print $fh "HTTP/1.1 $vars->{code} OK\n";
+    foreach my $h (keys(%headers)) {
+        print $fh "$h:$headers{$h}\n";
+    }
+    print $fh "\n";
+    print $fh $body;
+    close $fh;
 }
 
 1;