view release on metacpan or  search on metacpan

lib/App/Phoebe/Web.pm  view on Meta::CPAN

	RewriteCond %{REQUEST_URI} !^/\.well-known/
	RewriteRule ^/(.*) https://%{HTTP_HOST}:1965/$1
    </VirtualHost>
    <VirtualHost *:443>
	ServerName transjovian.org
	RewriteEngine on
	# Do not redirect /.well-known URL
	RewriteCond %{REQUEST_URI} !^/\.well-known/
	RewriteRule ^/(.*) https://%{HTTP_HOST}:1965/$1
	SSLEngine on
	SSLCertificateFile      /var/lib/dehydrated/certs/transjovian.org/cert.pem
	SSLCertificateKeyFile   /var/lib/dehydrated/certs/transjovian.org/privkey.pem
	SSLCertificateChainFile /var/lib/dehydrated/certs/transjovian.org/chain.pem
	SSLVerifyClient None
    </VirtualHost>

Here’s an example where we wrap one the subroutines in App::Phoebe::Web in order
to change the default CSS that gets served. We keep a code reference to the
original, substitute our own, and when it gets called, it first calls the old
code to print some CSS, and then we append some CSS of our own. Also note how we
import C<$log>.

    # tested by t/example-dark-mode.t
    package App::Phoebe::DarkMode;
    use App::Phoebe qw($log);
    use App::Phoebe::Web;
    no warnings qw(redefine);

    # fully qualified because we're in a different package!
    *old_serve_css_via_http = \&App::Phoebe::Web::serve_css_via_http;
    *App::Phoebe::Web::serve_css_via_http = \&serve_css_via_http;

    sub serve_css_via_http {
      my $stream = shift;
      old_serve_css_via_http($stream);
      $log->info("Adding more CSS via HTTP (for dark mode)");
      $stream->write(<<'EOT');
    @media (prefers-color-scheme: dark) {
       body { color: #eeeee8; background-color: #333333; }
       a:link { color: #1e90ff }
       a:hover { color: #63b8ff }
       a:visited { color: #7a67ee }
    }
    EOT
    }

    1;

=cut

package App::Phoebe::Web;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(http_error handle_http_header);
use App::Phoebe qw(@request_handlers port space host_regex space_regex run_extensions text quote_html blog_pages
		   html_page to_html wiki_dir changes all_logs pages rss atom files $server $log @footer
		   space_links diff);
use File::Slurper qw(read_lines read_binary);
use Encode qw(encode_utf8 decode_utf8);
use List::Util qw(min);
use Modern::Perl;
use URI::Escape;
use utf8;

unshift(@request_handlers, '^GET .* HTTP/1\.[01]$' => \&handle_http_header);

sub handle_http_header {
  my $stream = shift;
  my $data = shift;
  # $log->debug("Reading HTTP headers");
  my @lines = split(/\r\n/, $data->{buffer}, -1); # including the empty line at the end
  foreach (@lines) {
    if (/^(\S+?): (.+?)\s*$/) {
      my $key = lc($1);
      $data->{headers}->{$key} = $2;
      my $data->{header_size} += length($_);
      # $log->debug("Header $key");
    } elsif ($_ eq "") {
      $data->{buffer} =~ s/^.*?\r\n\r\n//s; # possibly HTTP body
      # $log->debug("Handle HTTP request");
      $data->{headers}->{host} .= ":" . port($stream) if $data->{headers}->{host} and $data->{headers}->{host} !~ /:\d+$/;
      $log->debug("HTTP headers: " . join(", ", map { "$_ => '$data->{headers}->{$_}'" } keys %{$data->{headers}}));
      my $length = $data->{headers}->{'content-length'} || 0;
      return http_error($stream, "Content length invalid") if $length !~ /^\d+$/;
      return http_error($stream, "Content too long") if $length > $server->{wiki_page_size_limit};
      my $actual = length($data->{buffer});
      return http_error($stream, "Content longer than what the header says ($actual > $length):\n" . $data->{buffer}) if $actual > $length;
      if ($length == $actual) {
	# got the entire body as part of the first part
	process_http($stream, $data->{request}, $data->{headers}, $data->{buffer});
	$stream->close_gracefully();
	return;
      } elsif ($length) {
	# read body if it was sent in multiple parts
	$data->{handler} = \&handle_http_body;
	handle_http_body($stream, $data);
	return;
      }
      # otherwise wait for more header bytes
    }
    if ($data->{header_size} and $data->{header_size} > $server->{wiki_page_size_limit}) {
      $log->debug("This wiki does not allow more than $server->{wiki_page_size_limit} bytes of headers");
      result($stream, "400", "Bad request: headers too long");
      $stream->close_gracefully();
      return;
    }
  }
  # if we came here, the last line didn't match and needs more bytes
  $data->{buffer} = $lines[$#lines];
  $log->debug("Waiting for more HTTP headers ('$data->{buffer}')");
  return;
}

sub http_error {
  my $stream = shift;
  my $message = shift;
  $stream->write("HTTP/1.1 400 Bad Request\r\n");
  $stream->write("Content-Type: text/plain\r\n");
  $stream->write("\r\n");
  $stream->write("$message\n");
  $stream->close_gracefully();