view release on metacpan or  search on metacpan

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

  my $token = quotemeta($params{token}||"");
  my @tokens = @{$server->{wiki_token}};
  push(@tokens, @{$server->{wiki_space_token}->{$space}})
      if $space and $server->{wiki_space_token}->{$space};
  if (@tokens) {
    if (not $token) {
      $log->info("Token required (one of @tokens)");
      http_error($stream, "Token required");
      return;
    }
    if (not grep(/^$token$/, @tokens)) {
      $log->info("Wrong token ($token)");
      http_error($stream, "Wrong token");
      return;
    }
  }
  my $text = $params{text}||"";
  $text =~ s/\r\n/\n/g; # fix DOS EOL convention
  # We don't need to close the stream because this is called via process_gemini
  # which always closes the stream in the end.
  with_lock($stream, $host, $space, sub { write_page_for_http($stream, $host, $space, $id, $text) } );
}

sub write_page_for_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $text = shift;
  $log->info("Writing page $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/page/$id.gmi";
  my $revision = 0;
  if (-e $file) {
    my $old = read_text($file);
    if ($old eq $text) {
      $log->info("$id is unchanged");
      my $message = to_url($stream, $host, $space, "page/$id", "https");
      $stream->write("HTTP/1.1 302 Found\r\n");
      $stream->write("Location: $message\r\n");
      $stream->write("\r\n");
      return;
    }
    mkdir "$dir/keep" unless -d "$dir/keep";
    if (-d "$dir/keep/$id") {
      foreach (read_dir("$dir/keep/$id")) {
	$revision = $1 if m/^(\d+)\.gmi$/ and $1 > $revision;
      }
      $revision++;
    } else {
      mkdir "$dir/keep/$id";
      $revision = 1;
    }
    rename $file, "$dir/keep/$id/$revision.gmi";
  } else {
    my $index = "$dir/index";
    if (not open(my $fh, ">>:encoding(UTF-8)", $index)) {
      $log->error("Cannot write index $index: $!");
      return http_error($stream, "Unable to write index");
    } else {
      say $fh $id;
      close($fh);
    }
  }
  my $changes = "$dir/changes.log";
  if (not open(my $fh, ">>:encoding(UTF-8)", $changes)) {
    $log->error("Cannot write log $changes: $!");
    return http_error($stream, "Unable to write log");
  } else {
    my $peerhost = $stream->handle->peerhost;
    say $fh join("\x1f", scalar(time), $id, $revision + 1, bogus_hash($peerhost));
    close($fh);
  }
  mkdir "$dir/page" unless -d "$dir/page";
  eval { write_text($file, $text) };
  if ($@) {
    $log->error("Unable to save $id: $@");
    return http_error($stream, "Unable to save $id");
  } else {
    $log->info("Wrote $id");
    my $message = to_url($stream, $host, $space, "page/$id", "https");
    $stream->write("HTTP/1.1 302 Found\r\n");
    $stream->write("Location: $message\r\n");
    $stream->write("\r\n");
  }
}