Base.pm 7.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178
  1. package Trog::Renderer::Base;
  2. use 5.040;
  3. use re '/aasx';
  4. use warnings FATAL => 'all';
  5. use Encode qw{encode_utf8};
  6. use IO::Compress::Gzip;
  7. use Text::Xslate;
  8. use Trog::Component ();
  9. use Trog::Themes;
  10. use Trog::Config;
  11. use Time::HiRes qw{tv_interval};
  12. =head1 Trog::Renderer::Base
  13. Basic rendering structure, subclass me.
  14. Sets up the functions which must be present for all templates: render_it, for rendering dynamic template strings coming from a post, and component, for pulling in a Trog::Component by name.
  15. =cut
  16. our %renderers;
  17. =head2 render(%options)
  18. Render a template and build the PSGI response around it.
  19. Recognized options:
  20. template => the template's filename, relative to the template dir. Required.
  21. contenttype => what we're rendering, e.g. 'text/html'. Picks the template dir.
  22. component => render a component rather than a whole page. Returns just the
  23. body string, with no headers and no compression.
  24. data => the variables handed to the template.
  25. code => HTTP status for the response.
  26. headers => extra headers, merged over the computed ones.
  27. deflate => gzip the body and set Content-Encoding.
  28. post_processor => CODEREF run over the body before headers are computed, for
  29. things like minifiers.
  30. child_processor / child_renderer => override how post bodies are rendered by
  31. the render_it() template function. Built for you if omitted.
  32. Dies unless Xslate can resolve and render the template. Returns the body
  33. string for components, and a PSGI arrayref of [ code, headers, body ] otherwise.
  34. =cut
  35. sub render (%options) {
  36. die "Templated renders require a template to be passed" unless $options{template};
  37. # Xslate resolves includes against every dir in path, first match winning,
  38. # so handing it both lets a theme override individual templates without
  39. # having to fork the ones next to them. With no theme configured this is
  40. # just the stock dir, exactly as it was.
  41. my @template_dirs = Trog::Themes::template_dirs( $options{contenttype}, $options{component} );
  42. #TODO make this work with posts all the time
  43. $options{child_processor} //= Text::Xslate->new( path => \@template_dirs );
  44. my $child_processor = $options{child_processor};
  45. $options{child_renderer} //= sub {
  46. my ( $template_string, $options ) = @_;
  47. # If it fails to render, it must be something else
  48. my $out = eval { $child_processor->render_string( $template_string, $options ) };
  49. return $out ? $out : $template_string;
  50. };
  51. # Keyed on the whole search path, not just the winning dir: two different
  52. # paths that happen to start with the same dir are not the same renderer.
  53. my $renderer_key = join( ':', @template_dirs );
  54. $renderers{$renderer_key} //= Text::Xslate->new(
  55. path => \@template_dirs,
  56. function => {
  57. render_it => $options{child_renderer},
  58. # A plain package sub rather than a closure, so the \%renderers
  59. # memoization here cannot bake in whatever the first caller for this
  60. # path happened to pass -- which it can, and does, for render_it.
  61. component => \&Trog::Component::component,
  62. },
  63. );
  64. my $code = $options{code};
  65. # Xslate resolves the template itself, against the same @template_dirs it
  66. # will actually use. There used to be a pre-flight test here, and it was
  67. # wrong twice over: it resolved through template_dir(), which returns one
  68. # winning directory rather than the search path, so it could pass on a file
  69. # Xslate would not use and name a nonexistent stock path in its error while
  70. # a good theme template existed. And the condition itself, -f $t || -s $t,
  71. # short-circuited on -f, so an empty file passed, while a *directory* passed
  72. # on -s returning its size.
  73. #
  74. # $Trog::Component::error is how a failed component() call reaches us at all:
  75. # Xslate catches an exception thrown out of a template function, warns, and
  76. # renders on with an empty string in its place, so the render below succeeds
  77. # with a hole in it. Localised here so that a nested render (a component
  78. # rendering its own template) doesn't answer for its parent's failure.
  79. my $body = eval {
  80. local $Trog::Component::error;
  81. my $out = encode_utf8( $renderers{$renderer_key}->render( $options{template}, $options{data} ) );
  82. die $Trog::Component::error if $Trog::Component::error;
  83. $out;
  84. };
  85. die "Could not render template '$options{template}' (searched @template_dirs): $@" unless defined $body;
  86. # Users can supply a post_processor to futz with the output (such as with minifiers) if they wish.
  87. $body = $options{post_processor}->($body) if $options{post_processor} && ref $options{post_processor} eq 'CODE';
  88. # Users can supply custom headers as part of the data in options.
  89. my %headers = headers( \%options, $body );
  90. return $body if $options{component};
  91. return [ $code, [%headers], [$body] ] unless $options{deflate};
  92. $headers{"Content-Encoding"} = "gzip";
  93. my $dfh;
  94. IO::Compress::Gzip::gzip( \$body => \$dfh );
  95. print $IO::Compress::Gzip::GzipError if $IO::Compress::Gzip::GzipError;
  96. $headers{"Content-Length"} = length($dfh);
  97. return [ $code, [%headers], [$dfh] ];
  98. }
  99. =head2 headers($options, $body) = %headers
  100. The response headers for a rendered body: content type and length, caching,
  101. Server-Timing, and the security headers (CSP, X-Frame-Options, HSTS when we're
  102. on https, nosniff). Anything in $options->{headers} is merged over the top.
  103. ETags are only set for logged in users, as everyone else is served out of the
  104. static render cache.
  105. =cut
  106. sub headers ( $options, $body ) {
  107. my $query = $options->{data};
  108. my $uh = ref $options->{headers} eq 'HASH' ? $options->{headers} : {};
  109. my $ct = $options->{contenttype} eq 'text/html' ? "text/html; charset=UTF-8" : "$options->{contenttype};";
  110. my %headers = (
  111. 'Content-Type' => $ct,
  112. 'Content-Length' => length($body),
  113. 'Cache-Control' => $query->{cachecontrol} // $Trog::Vars::cache_control{revalidate},
  114. 'X-Content-Type-Options' => 'nosniff',
  115. 'Vary' => 'Accept-Encoding',
  116. 'Server-Timing' => "render;dur=" . ( tv_interval( $query->{start} ) * 1000 ),
  117. %$uh,
  118. );
  119. #Disallow framing UNLESS we are in embed mode
  120. my $ancestor = $query->{domain} || 'none';
  121. $headers{"Content-Security-Policy"} = qq{frame-ancestors $ancestor} unless $query->{embed};
  122. $headers{'X-Frame-Options'} = 'DENY' unless $query->{embed};
  123. $headers{'Referrer-Policy'} = 'no-referrer-when-downgrade';
  124. #CSP. Yet another layer of 'no mixed content' plus whitelisted execution of remote resources.
  125. # Component renders (posts.tx, the bars) get a data hash built by the route
  126. # rather than the request, and it carries no scheme.
  127. my $scheme = ( $query->{scheme} // '' ) eq 'https' ? "$query->{scheme}:" : '';
  128. my $conf = Trog::Config::get();
  129. my $sites = $conf->param('security.allow_embeds_from') // '';
  130. $headers{'Content-Security-Policy'} .= ";default-src $scheme 'self' data: 'unsafe-eval' 'unsafe-inline' $sites";
  131. $headers{'Content-Security-Policy'} .= ";object-src 'none'";
  132. # Force https if we are https
  133. $headers{'Strict-Transport-Security'} = 'max-age=63072000' if ( $query->{scheme} // '' ) eq 'https';
  134. # We only set etags when users are logged in, cause we don't use statics
  135. $headers{'ETag'} = $query->{etag} if $query->{etag} && $query->{user};
  136. return %headers;
  137. }
  138. 1;