Base.pm 6.2 KB

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