App-phoebe

 view release on metacpan or  search on metacpan

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

# (i.e. not the Phoebe server token). This only works if the Oddmuse wiki has
# just one security question (or accepts the same answer for all questions).
our %oddmuse_wiki_tokens = (
  "emacswiki.org" => "emacs" );

our $oddmuse_namespace_regex = '[\p{Uppercase}\d][\w_  ]*';

*oddmuse_old_space_regex = \&App::Phoebe::space_regex;
*App::Phoebe::space_regex = \&oddmuse_new_space_regex;

sub oddmuse_new_space_regex {
  my $spaces = oddmuse_old_space_regex();
  return "$spaces|$oddmuse_namespace_regex" if $spaces;
  return $oddmuse_namespace_regex;
}

*oddmuse_old_space = \&App::Phoebe::space;
*App::Phoebe::space = \&oddmuse_new_space;

sub oddmuse_new_space {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  if (grep { $_ eq $host } keys %oddmuse_wikis) {
    # Let Oddmuse handle namespaces
    return $space;
  }
  return oddmuse_old_space($stream, $host, $space);
}

*oddmuse_old_save_page = \&App::Phoebe::save_page;
*App::Phoebe::save_page = \&oddmuse_new_save_page;

sub oddmuse_new_save_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $type = shift;
  my $data = shift;
  my $length = shift;
  my $port = port($stream);
  if (not grep { $_ eq $host } keys %oddmuse_wikis) {
    return oddmuse_old_save_page($stream, $host, $space, $id, $type, $data, $length);
  }
  if ($type ne "text/plain") {
    $data = "#FILE $type\n" . encode_base64($data);
  } elsif (not utf8::decode($data)) {
    $log->debug("The text is invalid UTF-8");
    result($stream, "59", "The text is invalid UTF-8");
    $stream->close_gracefully();
    return;
  }
  my @tokens = @{$server->{wiki_token}};
  push(@tokens, $oddmuse_wiki_tokens{$host}) if $oddmuse_wiki_tokens{$host};
  my $token = pop(@tokens); # the oddmuse wiki token, preferrably
  my $name = ref($stream->handle) eq 'IO::Socket::SSL' && $stream->handle->peer_certificate('cn') || "";
  my $ua = Mojo::UserAgent->new;
  my $tx = $ua->post(
    $oddmuse_wikis{$host}
    => {'X-Forwarded-For' => $stream->handle->peerhost}
    => form => {
      title => $id,
      text => $data,
      ns => $space,
      answer => $token,
      username => $name,
      gemini => 1 });
  $log->debug("Got " . $tx->result->code . " response");
  if ($tx->result->code == 302) {
    my $url = "gemini://$host:$port";
    $url .= "/$space" if $space;
    result($stream, "30", "$url/page/" . uri_escape_utf8($id) . "");
  } else {
    $stream->write("59 Got HTTP code " . $tx->result->code . " " . $tx->result->message
		   . " (" . $tx->req->url->to_abs . " " . $tx->req->params . ")\r\n");
  }
  $stream->close_gracefully();
}

*oddmuse_old_valid_token = \&App::Phoebe::valid_token;
*App::Phoebe::valid_token = \&oddmuse_new_valid_token;

sub oddmuse_new_valid_token {
  my ($stream, $host, $space, $id, $params) = @_;
  my $token = $params->{token}||"";
  if ($oddmuse_wiki_tokens{$host}) {
    $log->debug("Comparing $token with $oddmuse_wiki_tokens{$host}");
  } else {
    $log->debug("There is no specific token for this Oddmuse wiki");
  }
  return 1 if $oddmuse_wiki_tokens{$host} and $oddmuse_wiki_tokens{$host} eq $token;
  return oddmuse_old_valid_token(@_);
}

push(@extensions, \&oddmuse_process_request);

sub oddmuse_process_request {
  my $stream = shift;
  my $url = shift;
  my $headers = shift;
  my $hosts = "(" . join("|", keys %oddmuse_wikis) . ")";
  my $spaces = $oddmuse_namespace_regex;
  my $reserved = reserved_regex();
  my $port = port($stream);
  my ($host, $space, $id, $query, $n, $style, $token);
  if ($url =~ m!^gemini://$hosts(?::$port)?/robots\.txt$!) {
    # must come before redirection to regular pages since it contains no slash
    oddmuse_serve_robots($stream);
  } elsif (($host, $n, $space) = $url =~ m!^gemini://$hosts(:$port)?(?:/($spaces))?/(?:$reserved)$!) {
    result($stream, "31", "gemini://$host" . ($n ? ":$port" : "") . "/" . ($space ? $space : "") . ""); # this supports "up"
  } elsif (($host, $space, $id, $n) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/page/([^/]+)(?:/(\d+))?$!
	   and $id ne $server->{wiki_main_page}) {
    oddmuse_serve_page($stream, $host, $space, free_to_normal(decode_utf8(uri_unescape($id))), $n);
  } elsif (($host, $space, $id) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/tag/([^/]+)$!) {
    oddmuse_serve_tag($stream, $host, $space, free_to_normal(decode_utf8(uri_unescape($id))));
  } elsif (($host, $space, $id) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/raw/([^/]+)$!
	   and $id ne $server->{wiki_main_page}) {
    oddmuse_serve_raw($stream, $host, $space, free_to_normal(decode_utf8(uri_unescape($id))));
  } elsif (($host, $space, $id) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/html/([^/]+)$!) {
    oddmuse_serve_html($stream, $host, $space, free_to_normal(decode_utf8(uri_unescape($id))));

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

Disallow: /do/blog/atom
Disallow: /do/new
Disallow: /do/more
Disallow: /do/match
Disallow: /do/search
# allowing /do/index!
Crawl-delay: 10
EOT
}

sub oddmuse_serve_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  # cannot use text() because we don't know if we're serving a file or plain
  # text when querying Oddmuse
  my $page = oddmuse_get_page($stream, $host, $space, $id, $revision) // return;
  if (my ($type, $data) = $page =~ /^#FILE (\S+) ?(?:\S+)?\n(.*)/s) {
    oddmuse_serve_file_page($stream, $id, $type, $data);
  } else {
    my $text = oddmuse_gemini_text($stream, $host, $space, $page);
    oddmuse_serve_gemini_page($stream, $host, $space, $id, $text, $revision);
  }
}

# this is required when combining gopher with oddmuse!
*oddmuse_text_old = \&App::Phoebe::text;
*App::Phoebe::text = \&oddmuse_text_new;

sub oddmuse_text_new {
  my ($stream, $host, $space, $id, $revision) = @_;
  if (exists $oddmuse_wikis{$host}) {
    my $text = oddmuse_get_page(@_);
    return oddmuse_gemini_text($stream, $host, $space, $text);
  } else {
    return oddmuse_text_old(@_);
  }
}

sub oddmuse_get_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  my $url = "$oddmuse_wikis{$host}";
  $url .= "/$space" if $space;
  $url .= "/raw/" . uri_escape_utf8($id);
  $url .= "?revision=$revision" if $revision;
  return oddmuse_get_raw($stream, $url);
}

# It would be cool if this were streaming...
sub oddmuse_get_raw {
  my $stream = shift;
  my $url = shift;
  $log->debug("Requesting $url");
  my $ua = Mojo::UserAgent->new;
  my $res = $ua->get($url => {'X-Forwarded-For' => $stream->handle->peerhost})->result;
  if ($res->is_success) {
    return $res->text;
  } elsif ($res->code == 404) {
    return "";
  }
  oddmuse_http_error($stream, $res->code, $res->message, $url); # false
}

sub oddmuse_http_error {
  my $stream = shift;
  my $code = shift;
  my $message = shift;
  my $url = shift;
  if ($code >= 200 and $code < 300) { $code = 20 }
  elsif ($code == 301) { $code = 31 }
  elsif ($code >= 300 and $code < 400) { $code = 30 }
  elsif ($code == 403) { $code = 60 }
  elsif ($code == 404) { $code = 51 }
  elsif ($code == 405) { $code = 59 }
  elsif ($code >= 400 and $code < 500) { $code = 50 }
  elsif ($code >= 500 and $code < 600) { $code = 40 }
  else { $code = 50 }
  $log->warn("$code $message requesting $url");
  $stream->write(encode_utf8 "$code $message\r\n");
  return; # false
}

sub oddmuse_serve_file_page {
  my $stream = shift;
  my $id = shift;
  my $type = shift;
  my $data = shift;
  $log->info("Serving $id as $type file");
  $data = decode_base64($data);
  $log->debug("Bytes: " . length($data));
  success($stream, $type);
  binmode(STDOUT, ":raw");
  $stream->write($data);
}

sub oddmuse_serve_gemini_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $text = shift;
  my $revision = shift;
  $log->info("Serve page $id");
  success($stream);
  $stream->write(encode_utf8 "# " . normal_to_free($id) . "\n");
  $stream->write(encode_utf8 $text);
  if (not $revision and $id !~ /^Comments_on_(.*)/) {
    my $comments = oddmuse_get_page($stream, $host, $space, "Comments_on_$id");
    if ($comments) {
      $stream->write("\n\n## Comments\n");
      $stream->write(encode_utf8 oddmuse_gemini_text($stream, $host, $space, $comments));
    }
  }
  $stream->write(encode_utf8 oddmuse_footer($stream, $host, $space, $id));
}

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

    $stream->write("<id>$link</id>\n");
    my $summary = quote_html(oddmuse_gemini_text($stream, $host, $space, $data->{description}));
    $stream->write(encode_utf8 "<content type=\"text\">$summary</content>\n") if $summary;
    $stream->write("<updated>$data->{'last-modified'}</updated>\n");
    $stream->write("</entry>\n");
  };
  $stream->write("</feed>\n");
}

sub oddmuse_serve_config {
  my $stream = shift;
  my $file = shift;
  $log->info("Serving Config");
  my $dir = $server->{wiki_dir};
  my @config;
  push(@config, "config") if -f "$dir/config";
  push(@config, map { "conf.d/$_" } grep(/\.p[lm]$/, read_dir("$dir/conf.d"))) if -d "$dir/conf.d";
  $log->debug("Config files found: @config");
  @config = grep(/^$file$/, @config) if $file;
  if (@config == 0) {
    if ($file) {
      result($stream, "40", "This config file does not exist");
    } else {
      result($stream, "40", "This site does not use any config files");
    }
  } elsif (@config == 1) {
    success($stream, 'text/plain');
    $stream->write(encode_utf8 read_text("$dir/" . shift @config));
  } else {
    success($stream);
    $stream->write("# Config Files\n");
    $stream->write("=> /do/config/" . join('/', map { uri_escape($_) } split('/'))
		   . " " . encode_utf8($_) . "\n") for @config;
  }
}

sub oddmuse_comment {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $query = shift; # token or comment
  my $port = port($stream);
  if (not $id) {
    $log->debug("The URL lacks a page name");
    result($stream, "59", "The URL lacks a page name");
    return;
  }
  my $name = oddmuse_fingerprint_name($stream, $host, $query);
  return unless defined $name;
  if (not $query) {
    result($stream, "10", "Short comment");
    return;
  }
  $id = "Comments_on_$id" unless $id =~ /^Comments_on_/;
  my $token = $oddmuse_wiki_tokens{$host};
  $token = $server->{wiki_token}->[0] if not $token and $server->{wiki_token};
  my $ua = Mojo::UserAgent->new;
  my $tx = $ua->post(
    $oddmuse_wikis{$host}
    => {'X-Forwarded-For' => $stream->handle->peerhost}
    => form => {
      title => $id,
      ns => $space,
      aftertext => $query,
      username => $name,
      answer => $token,
      gemini => 1 });
  $log->debug("Got " . $tx->result->code . " response");
  if ($tx->result->code == 302) {
    my $url = "gemini://$host:$port";
    $url .= "/$space" if $space;
    result($stream, "30", "$url/page/" . uri_escape_utf8($id) . "");
    return;
  }
  $stream->write("59 Got HTTP code " . $tx->result->code . " " . $tx->result->message
      . " (" . $tx->req->url->to_abs . " " . $tx->req->params . ")\r\n");
}

# If the fingerprint exists in our file, no need to ask for the $token; it
# expires after a day (24 * 60 * 60 seconds). If no fingerprint is found, ask
# for a cert.
sub oddmuse_fingerprint_name {
  my $stream = shift;
  my $host = shift;
  my $token = shift;
  # This requires SSL_verify_mode => SSL_VERIFY_PEER and SSL_verify_callback =>
  # \&verify_fingerprint (which must not reject self-signed certificates).
  my $fingerprint = $stream->handle->get_fingerprint();
  if (not $fingerprint) {
    result($stream, "60", "You need a client certificate with a common name to edit this wiki");
    return;
  }
  my $dir = $server->{wiki_dir};
  my @lines;
  my $now = time();
  # Read the known fingerprint from the file.
  my %fingerprints;
  my $file = "$dir/fingerprints";
  %fingerprints = split(/\s+/, read_text($file)) if -e $file;
  # Forget about fingerprints older than 10min.
  for my $fp (keys %fingerprints) {
    delete $fingerprints{$fp} if $fingerprints{$fp} > $now + 600;
  }
  my @tokens;
  push(@tokens, $oddmuse_wiki_tokens{$host}) if $oddmuse_wiki_tokens{$host};
  push(@tokens, @{$server->{wiki_token}}) unless @tokens;
  if (not $fingerprints{$fingerprint}) {
    if (not $token) {
      result($stream, "10", "Token required to edit this wiki");
    } elsif (not grep { $token eq $_ } @tokens) {
      result($stream, "59", "Wrong token");
    } else {
      result($stream, "10", "Short comment");
      $fingerprints{$fingerprint} = $now;
    }
    # Save new or updated fingerprint timestamp.
    write_text($file, join("\n", map { "$_ $fingerprints{$_}" } keys %fingerprints));
    # Return undefined so that the user needs to react to the message above.
    return;
  }