App-Phoebe

 view release on metacpan or  search on metacpan

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

      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();
  return 0;
}

sub handle_http_body {
  my $stream = shift;
  my $data = shift;
  $log->debug("Reading HTTP body");
  my $length = $data->{headers}->{'content-length'} || 0;
  my $actual = length($data->{buffer});
  if ($length == $actual) {
    # got the entire body
    process_http($stream, $data->{request}, $data->{headers}, $data->{buffer});
    $stream->close_gracefully();
    return;
  }
  $log->debug("Received $actual/$length bytes");
}

sub process_http {
  my $stream = shift;
  my $request = shift;
  my $headers = shift;
  my $buffer = shift;
  eval {
    local $SIG{'ALRM'} = sub {
      $log->error("Timeout processing $request");
    };
    alarm(10); # timeout
    my $hosts = host_regex();
    my $port = port($stream);
    my $spaces = space_regex();
    $log->info("Looking at $request");
    my ($host, $space, $id, $n, $filter);
    if (run_extensions($stream, $request, $headers, $buffer)) {
      # config file goes first
    } elsif ($request =~ m!^GET /default.css HTTP/1\.[01]$!
	and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_css_via_http($stream, $host);
    } elsif (($space) = $request =~ m!^GET (?:(?:/($spaces)/?)?|/) HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_main_menu_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/page/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_page_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/file/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_file_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/history/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_history_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/diff/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_diff_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/raw/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_raw_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif ($request =~ m!^GET /robots.txt(?:[#?].*)? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_raw_via_http($stream, $host, undef, 'robots');
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/changes(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_changes_via_http($stream, $host, space($stream, $host, $space), $n||100);
    } elsif (($filter, $n) = $request =~ m!^GET /do/all(?:/(latest))?/changes(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_all_changes_via_http($stream, $host, $n||100, $filter||"");
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/index HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_index_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/files HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_files_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/spaces HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_spaces_via_http($stream, $host, $port);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/rss HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_rss_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/atom HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_atom_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $n) = $request =~ m!^GET /do/all/atom HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_all_atom_via_http($stream, $host);
    } else {
      $log->debug("No http handler for $request");
      http_error($stream, "Don't know how to handle $request");
    }
    $log->debug("Done");
  };
  $log->error("Error: $@") if $@;
  alarm(0);
  $stream->close_gracefully();
}

sub serve_main_menu_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving main menu via HTTP");
  my $page = $server->{wiki_main_page};
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  if ($page) {
    $stream->write(encode_utf8 "<title>" . quote_html($page) . "</title>\n");
  } else {
    $stream->write("<title>Phoebe</title>\n");
  }
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  if ($page) {
    $stream->write(encode_utf8 to_html(text($stream, $host, $space, $page)) . "\n");
  } else {
    $stream->write("<h1>Welcome to Phoebe!</h1>\n");
  }
  blog_html($stream, $host, $space);
  $stream->write("<p>Important links:\n");
  $stream->write("<ul>\n");
  my @pages = @{$server->{wiki_page}};
  for my $id (@pages) {
    $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
  }
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Changes", "do/changes") . "\n");
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Index of all pages", "do/index") . "\n");
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Index of all files", "do/files") . "\n")
      if @{$server->{wiki_mime_type}};
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, undef, "Index of all spaces", "do/spaces") . "\n")
      if @{$server->{wiki_space}} or keys %{$server->{host}} > 1;
  # a requirement of the GNU Affero General Public License
  $stream->write("<li><a href=\"https://metacpan.org/pod/App::Phoebe\">Source</a>\n");
  $stream->write("</ul>\n");
  $stream->write("</body>\n");
  $stream->write("</html>\n");
}

sub link_html {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $title = shift;
  my $id = shift;
  if (not $id) {
    $id = "page/$title";
  }
  my $port = port($stream);
  # don't encode the slash
  return "<a href=\"https://$host:$port/"
      . ($space && $space ne $host ? uri_escape_utf8($space) . "/" : "")
      . join("/", map { uri_escape_utf8($_) } split (/\//, $id))
      . "\">"
      . quote_html($title)
      . "</a>";
}

sub blog_html {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $n = shift || 10;
  my @blog = blog_pages($stream, $host, $space, $n);
  return unless @blog;
  $stream->write("<p>Blog:\n");
  $stream->write("<ul>\n");
  # we should check for pages marked for deletion!
  for my $id (@blog[0 .. min($#blog, $n - 1)]) {
    $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
  }
  $stream->write("</ul>\n");
}

sub serve_css_via_http {
  my $stream = shift;
  $log->info("Serving CSS via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/css\r\n");
  $stream->write("Cache-Control: public, max-age=86400, immutable\r\n"); # 24h
  $stream->write("\r\n");
  $stream->write("html { max-width: 70ch; padding: 2ch; margin: auto; color: #111; background: #ffe; }\n");
  $stream->write(".del { color: rgb(222,56,43); }\n"); # diff: deleted
  $stream->write(".ins { color: rgb(57,181,74); }\n"); # diff: inserted
}

sub serve_index_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving index of all pages via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>All Pages</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>All Pages</h1>\n");
  my @pages = pages($stream, $host, $space);
  if (@pages) {
    $stream->write("<ul>\n");
    for my $id (@pages) {
      $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
    }
    $stream->write("</ul>\n");
  } else {
    $stream->write("<p>The are no pages.\n");

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

    $n,
    sub { $stream->write(encode_utf8 "<h2>" . shift . "</h2>\n") },
    sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
    sub {
      my ($host, $space, $title, $id) = @_;
      $stream->write(encode_utf8 "<br> → " . link_html($stream, $host, $space, $title, $id) . "\n");
    },
    sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
    sub {
      return unless $_ = decode_utf8($fh->readline);
      chomp;
      split(/\x1f/), $host, $space, 0 });
  return unless $more;
  $stream->write("<p>" . link_html($stream, $host, $space, "More...", "do/changes/" . 10 * $n) . "\n");
}

sub serve_all_changes_via_http {
  my $stream = shift;
  my $host = shift;
  my $n = shift;
  my $filter = shift;
  $log->info($filter ? "Serving $n all $filter changes via HTTP" : "Serving $n all changes via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>Changes for all spaces</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>Changes for all spaces</h1>\n");
  $stream->write("<ul>\n");
  $stream->write("<li>" . link_html($stream, $host, undef, "Atom feed", "do/all/atom") . "\n");
  if ($filter) { $stream->write("<li>" . link_html($stream, $host, undef, "All changes", "do/all/changes/$n") . "\n") }
  else { $stream->write("<li>" . link_html($stream, $host, undef, "Latest changes", "do/all/latest/changes/$n") . "\n") }
  $stream->write("</ul>\n");
  my $log = all_logs($stream, $host, $n);
  if (not @$log) {
    $stream->write("<p>No changes.\n");
    return;
  }
  # taking the head of the @$log to get new log entries
  $stream->write("<p>Showing up to $n $filter changes.\n");
  my $more = changes($stream,
    $n,
    sub { $stream->write("<h2>" . shift . "</h2>\n") },
    sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
    sub { $stream->write(encode_utf8 "<br> → " . link_html($stream, @_) . "\n") },
    sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
    sub { @{shift(@$log) }, 1 if @$log },
    undef,
    $filter);
  return unless $more;
  $stream->write("<p>" . link_html($stream, $host, undef, "More...", "do/all/changes/" . 10 * $n) . "\n");
}

# https://en.wikipedia.org/wiki/ANSI_escape_code#3/4_bit
sub colourize_html {
  my $stream = shift;
  my $code = shift;
  my %rgb = (
    0 => "0,0,0",
    1 => "222,56,43",
    2 => "57,181,74",
    3 => "255,199,6",
    4 => "0,111,184",
    5 => "118,38,113",
    6 => "44,181,233",
    7 => "204,204,204");
  $code = join("", map {
    "<span style=\"color: rgb($rgb{$_}); background-color: rgb($rgb{$_})\">$_</span>";
	       } split //, $code);
  return $code;
}

sub serve_rss_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving RSS via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: application/xml\r\n");
  $stream->write("\r\n");
  rss($stream, $host, $space, 'https');
}

sub serve_atom_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving Atom via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: application/xml\r\n");
  $stream->write("\r\n");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  my $fh = File::ReadBackwards->new($log);
  atom($stream, sub {
    return unless $_ = decode_utf8($fh->readline);
    chomp;
    split(/\x1f/), $host, $space, 0
  }, $host, $space, 'https');
}

sub serve_all_atom_via_http {
  my $stream = shift;
  my $host = shift;
  $log->info("Serving Atom via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: application/xml\r\n");
  $stream->write("\r\n");
  my $log = all_logs($stream, $host, 30);
  atom($stream, sub { @{shift(@$log) }, 1 if @$log }, $host, undef, 'https');
}

sub serve_raw_via_http {
  my $stream = shift;

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

sub serve_page_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serving $id as HTML via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  html_page($stream, $host, $space, $id, $revision);
}

sub serve_history_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $n = shift;
  $log->info("Serve history for $id via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write(encode_utf8 "<title>Page history for " . quote_html($id) . "</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write(encode_utf8 "<h1>Page history for " . quote_html($id) . "</h1>\n");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (not -e $log) {
    $stream->write("<p>No changes.\n");
    return;
  }
  $stream->write("<p>Showing up to $n changes.\n");
  my $fh = File::ReadBackwards->new($log);
  my $first = 1;
  my $more = changes($stream,
    $n,
    sub { $stream->write(encode_utf8 "<h2>" . shift . "</h2>\n") },
    sub { $stream->write(encode_utf8 "<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
    sub {
      my ($host, $space, $title, $id) = @_;
      $stream->write(encode_utf8 "<br> → " . link_html($stream, $host, $space, $title, $id) . "\n");
    },
    sub { "<br> → $_[0]" },
    sub {
    READ:
      return unless $_ = decode_utf8($fh->readline);
      chomp;
      my ($ts, $id_log, $revision, $code) = split(/\x1f/);
      goto READ if $id_log ne $id;
      $ts, $id_log, $revision, $code, $host, $space, 0 });
  return unless $more;
  $stream->write("<p>" . link_html($stream, $host, $space, "More...", "history/" . uri_escape_utf8($id) . "/" . 10 * $n) . "\n");
}

sub serve_file_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serve file $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/file/$id";
  my $meta = "$dir/meta/$id";
  if (not -f $file) {
    $stream->write("HTTP/1.1 404 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("File not found\r\n");
    return;
  } elsif (not -f $meta) {
    $stream->write("HTTP/1.1 500 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("Metadata not found\r\n");
    return;
  }
  my %meta = (map { split(/: /, $_, 2) } split /\n/, read_text $meta);
  if (not $meta{'content-type'}) {
    $stream->write("HTTP/1.1 500 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("Metadata corrupt\r\n");
    return;
  }
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: " . $meta{'content-type'} ."\r\n");
  $stream->write("\r\n");
  $stream->write(read_binary($file));
}