App-Phoebe

 view release on metacpan or  search on metacpan

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

    }
    # in the successful case, with_lock doesn't close in case there is more code
    # that needs to run, or possibly $code has closed the stream.
    rmdir($lock);
  } elsif ($count > 25) {
    $log->error("Unable to unlock $lock");
    result($stream, "40", "The wiki is locked; try again in a few seconds");
    $stream->close_gracefully();
  } else {
    $log->debug("Waiting $count...");
    Mojo::IOLoop->timer(0.2 => sub {
      with_lock($stream, $host, $space, $code, $count + 1)});
    # don't close the stream
  }
}

sub write_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;

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

}

sub serve_capsule_sharing {
  my ($stream, $host, $capsule) = @_;
  my $name = capsule_name($stream);
  return 1 unless is_my_capsule($stream, $name, $capsule, 'share');
  $log->info("Share capsule");
  my $token = capsule_name(sprintf "-------%04X%04X%04X", rand(0xffff), rand(0xffff), rand(0xffff));
  push(@capsule_tokens, [time, $token, $stream->handle->get_fingerprint()]);
  # forget old access tokens in ten minutes
  Mojo::IOLoop->timer(601 => \&capsule_token_cleanup);
  success($stream);
  $stream->write("# Share access to " . ucfirst($capsule) . "\n");
  $stream->write("This password is valid for ten minutes: $token\n");
  return 1;
}

sub is_my_capsule {
  my ($stream, $name, $capsule, $verb) = @_;
  if (not $name) {
    $log->info("Attempt to $verb a capsule without client certificate");

t/00_tls_check.t  view on Meta::CPAN

END {
  # kill server
  if ($pid) {
    kill 'KILL', $pid or warn "Could not kill server $pid";
  }
}

if (!defined $pid) {
  die "Cannot fork: $!";
} elsif ($pid == 0) {
  Mojo::IOLoop->timer(10 => sub { Mojo::IOLoop->stop() });
  start_server();
} else {
  sleep 1;
  use Test::More;
  query1("Hello1");
  query2("Hello2");
  Mojo::IOLoop->stop();
  done_testing();
}

t/locks.t  view on Meta::CPAN

Phone screens shining bright
EOT

my $page = query_gemini("$titan/raw/Haiku;size=74;mime=text/plain;token=hello", $haiku);
like($page, qr/^30 $base\/page\/Haiku\r$/, "Titan Haiku");

ok(read_text("$dir/page/Haiku.gmi") eq $haiku, "Haiku saved");

mkdir("$dir/locked");

# 1s timer
Mojo::IOLoop->timer(1 => sub {
  pass("Waiting 1s");
  ok(read_text("$dir/page/Haiku.gmi") eq $haiku, "Haiku unchanged");
  rmdir("$dir/locked")});

my $haiku2 = <<EOT;
Pink peaks and blue rocks
The sun is gone and I'm cold
The Blackbird still sings
EOT