Base.pm 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109
  1. package Trog::Renderer::Base;
  2. use strict;
  3. use warnings;
  4. no warnings 'experimental';
  5. use feature qw{signatures state};
  6. use Encode qw{encode_utf8};
  7. use IO::Compress::Gzip;
  8. use Text::Xslate;
  9. use Trog::Themes;
  10. use Trog::Config;
  11. =head1 Trog::Renderer::Base
  12. Basic rendering structure, subclass me.
  13. Sets up the methods which must be present for all templates, e.g. render_it for rendering dynamic template strings coming from a post.
  14. =cut
  15. our %renderers;
  16. sub render (%options) {
  17. die "Templated renders require a template to be passed" unless $options{template};
  18. my $template_dir = Trog::Themes::template_dir( $options{template}, $options{contenttype}, $options{component} );
  19. my $t = "$template_dir/$options{template}";
  20. die "Templated renders require an existing template to be passed, got $template_dir/$options{template}" unless -f $t || -s $t;
  21. #TODO make this work with posts all the time
  22. $options{child_processor} //= Text::Xslate->new( path => $template_dir );
  23. my $child_processor = $options{child_processor};
  24. $options{child_renderer} //= sub {
  25. my ( $template_string, $options ) = @_;
  26. # If it fails to render, it must be something else
  27. my $out = eval { $child_processor->render_string( $template_string, $options ) };
  28. return $out ? $out : $template_string;
  29. };
  30. $renderers{$template_dir} //= Text::Xslate->new(
  31. path => $template_dir,
  32. function => {
  33. render_it => $options{child_renderer},
  34. },
  35. );
  36. my $code = $options{code};
  37. my $body = encode_utf8( $renderers{$template_dir}->render( $options{template}, $options{data} ) );
  38. # Users can supply a post_processor to futz with the output (such as with minifiers) if they wish.
  39. $body = $options{post_processor}->($body) if $options{post_processor} && ref $options{post_processor} eq 'CODE';
  40. # Users can supply custom headers as part of the data in options.
  41. my %headers = headers( \%options, $body );
  42. return $body if $options{component};
  43. return [ $code, [%headers], [$body] ] unless $options{deflate};
  44. $headers{"Content-Encoding"} = "gzip";
  45. my $dfh;
  46. IO::Compress::Gzip::gzip( \$body => \$dfh );
  47. print $IO::Compress::Gzip::GzipError if $IO::Compress::Gzip::GzipError;
  48. $headers{"Content-Length"} = length($dfh);
  49. return [ $code, [%headers], [$dfh] ];
  50. }
  51. sub headers ( $options, $body ) {
  52. my $query = $options->{data};
  53. my $uh = ref $options->{headers} eq 'HASH' ? $options->{headers} : {};
  54. my $ct = $options->{contenttype} eq 'text/html' ? "text/html; charset=UTF-8" : "$options->{contenttype};";
  55. my %headers = (
  56. 'Content-Type' => $ct,
  57. 'Content-Length' => length($body),
  58. 'Cache-Control' => $query->{cachecontrol} // $Trog::Vars::cache_control{revalidate},
  59. 'X-Content-Type-Options' => 'nosniff',
  60. 'Vary' => 'Accept-Encoding',
  61. %$uh,
  62. );
  63. #Disallow framing UNLESS we are in embed mode
  64. my $ancestor = $query->{domain} || 'none';
  65. $headers{"Content-Security-Policy"} = qq{frame-ancestors '$ancestor'} unless $query->{embed};
  66. $headers{'X-Frame-Options'} = 'DENY' unless $query->{embed};
  67. $headers{'Referrer-Policy'} = 'no-referrer-when-downgrade';
  68. #CSP. Yet another layer of 'no mixed content' plus whitelisted execution of remote resources.
  69. my $scheme = $query->{scheme} ? "$query->{scheme}:" : '';
  70. my $conf = Trog::Config::get();
  71. my $sites = $conf->param('security.allow_embeds_from') // '';
  72. $headers{'Content-Security-Policy'} .= ";default-src $scheme 'self' 'unsafe-eval' 'unsafe-inline' $sites";
  73. $headers{'Content-Security-Policy'} .= ";object-src 'none'";
  74. # Force https if we are https
  75. $headers{'Strict-Transport-Security'} = 'max-age=63072000' if ( $query->{scheme} // '' ) eq 'https';
  76. # We only set etags when users are logged in, cause we don't use statics
  77. $headers{'ETag'} = $query->{etag} if $query->{etag} && $query->{user};
  78. return %headers;
  79. }
  80. 1;