App-Phoebe
view release on metacpan or search on metacpan
- App::Gopher is new and improved; it no longer just prints the Gemini
text but does line wrapping and all that
3.00
- Add special feeds for the blog, i.e. the pages starting with an ISO
date
2.08
- Updated dependencies to Mojolicious 9.0 (because the tls_verify
parameter was replaced by a more general tls_options).
- Reduced the SSL session cache to 64 in attempt to fix a memory leak
but which I was unable to do: the solution I'm using right now is to
use memory parameters in the systemd service definition.
- Fixed colour links in /changes within wiki spaces.
- Fixed output of /robots.txt.
Makefile.PL view on Meta::CPAN
'script/spartan',
],
PREREQ_PM => {
# t/prerequisites.t is serious about all these!
'Modern::Perl' => 1.20180701, # for '2018'
'URI::Escape' => 0,
'Encode::Locale' => 0,
'Algorithm::Diff' => 0,
'File::ReadBackwards' => 0,
'File::Slurper' => 0,
'Mojolicious' => 9.00, # removed tls_verify from Mojo::IOLoop::TLS 9.0
'IO::Socket::SSL' => 2.069, # optional for Mojo::IOLoop
'Net::SSLeay' => 1.90,
'Net::IDN::Encode' => 0,
'IRI' => 0, # for script/gemini
'Text::Wrapper' => 0, # Gopher.pm
'File::MimeInfo' => 0, # Iapetus.pm, Capsules.pm
'File::MimeInfo::Magic' => 0, # WebDAV.pm
'IO::Scalar' => 0, # WebDAV.pm
'HTTP::Date' => 0, # WebDAV.pm
'XML::LibXML' => 0, # WebDAV.pm
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
. " (" . $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;
lib/App/Phoebe/Oracle.pm view on Meta::CPAN
use App::Phoebe qw($log);
use IO::Socket::SSL;
# a very simple Gemini client
sub query {
my $url = shift;
my($scheme, $authority, $path, $query, $fragment) =
$url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(\S*))?|;
my ($host, $port) = split(/:/, $authority);
my $socket = IO::Socket::SSL->new(
PeerHost => $host, PeerPort => $port||1965,
# don't verify the server certificate
SSL_verify_mode => SSL_VERIFY_NONE, );
$socket->print($url);
local $/ = undef; # slurp
return <$socket>;
}
# wrap the save_data sub in our own code
*old_save_oracle_data = \&App::Phoebe::Oracle::save_data;
*App::Phoebe::Oracle::save_data = \&new_save_oracle_data;
# call Antenna after saving
sub new_save_oracle_data {
old_save_oracle_data(@_);
script/gemini view on Meta::CPAN
warn "Contacting $host:$port" if $verbose;
# create client
Mojo::IOLoop->client({
address => $host,
port => $port,
tls => 1,
tls_cert => $cert,
tls_key => $key,
tls_options => { SSL_verify_mode => 0x00 }} => sub {
my ($loop, $err, $stream) = @_;
die $err if $err;
# 1h timeout (for chat)
$stream->timeout(3600);
my ($header, $mimetype, $encoding);
$stream->on(read => sub {
my ($stream, $bytes) = @_;
if (not $header) {
# decide how to decode the bytes
($header) = $bytes =~ /^(.*?)\r\n/;
script/gemini-chat view on Meta::CPAN
while (defined ($_ = $term->readline($prompt))) {
exit if $_ eq "quit";
# create client
my $text = uri_escape_utf8($_);
Mojo::IOLoop->client({
address => $host,
port => $port,
tls => 1,
tls_cert => $cert,
tls_key => $key,
tls_options => { SSL_verify_mode => 0x00 }} => sub {
my ($loop, $err, $stream) = @_;
die $err if $err;
$stream->on(read => sub {
my ($stream, $bytes) = @_;
if ($bytes =~ /^[123]/) {
# Do nothing
} else {
# Print server result
print "\e[31m$bytes\e[0m"; # red
}});
script/ijirait view on Meta::CPAN
sub stream {
say "Use 'Ctrl+C' to quit.";
# Start client for listening
Mojo::IOLoop->client({
address => $host,
port => $port,
tls => 1,
tls_cert => $cert,
tls_key => $key,
tls_options => { SSL_verify_mode => 0x00 }} => sub {
my ($loop, $err, $stream) = @_;
# 1h timeout (for chat)
$stream->timeout(3600);
$stream->on(read => sub {
my ($stream, $bytes) = @_;
my $text = to_text(decode_utf8($bytes));
print encode(locale => $text) });
$stream->on(close => sub {
say "Connection closed";
exit });
script/ijirait view on Meta::CPAN
$command = $1;
$shell_command = $2;
}
# create client
Mojo::IOLoop->client({
address => $host,
port => $port,
tls => 1,
tls_cert => $cert,
tls_key => $key,
tls_options => { SSL_verify_mode => 0x00 }, } => sub {
my ($loop, $err, $stream) = @_;
return say $err unless $stream;
$stream->on(read => sub {
my ($stream, $bytes) = @_;
if ($shell_command) {
open(my $fh, $shell_command)
or die "Can't run $shell_command: $!";
$bytes =~ s/^2.*\n//; # skip header
print $fh $bytes;
} else {
script/phoebe view on Meta::CPAN
or die "openssl failed: $?";
}
}
sub help {
my $parser = Pod::Text->new();
$parser->parse_file($0);
exit;
}
sub verify_fingerprint {
my ($ok, $ctx_store, $certname, $error, $cert, $depth) = @_;
return 1;
}
# defaults
$server->{wiki_token} ||= ['hello'];
$server->{wiki_space} ||= [];
$server->{wiki_mime_type} ||= [];
$server->{wiki_dir} ||= $ENV{PHOEBE_DATA_DIR} || './wiki';
$server->{wiki_page} ||= [];
script/phoebe view on Meta::CPAN
if ($args{tls_cert}->{$host} and $args{tls_key}->{$host}) {
$log->debug("$host uses $args{tls_cert}->{$host} and $args{tls_key}->{$host}");
} else {
push(@hosts_without_cert, $host);
}
}
if (@hosts_without_cert == 0) {
$msg .= " (TLS)";
$args{tls_options} = {
# request client certificates and accept them
SSL_verify_mode => SSL_VERIFY_PEER,
SSL_verify_callback => \&verify_fingerprint,
SSL_create_ctx_callback => sub {
my $ctx = shift;
Net::SSLeay::CTX_sess_set_cache_size($ctx, 64);
}
};
} elsif (@hosts_without_cert == @hosts) {
$msg .= " (no TLS)";
$args{tls} = 0;
} else {
die "Cannot mix with and without TLS on $address:$port (no cert: @hosts_without_cert)\n";
script/titan view on Meta::CPAN
my $data = <STDIN>;
my $file;
($temp_fh, $file) = tempfile();
print $temp_fh $data;
close($temp_fh);
push(@files, $file);
}
my %args = (PeerHost => $host,
PeerService => $port,
SSL_verify_mode => SSL_VERIFY_NONE);
# Default certs
$args{SSL_cert_file} = $cert;
$args{SSL_key_file} = $key;
$args{SSL_cert_file} //= 'client-cert.pem' if -f 'client-cert.pem';
$args{SSL_key_file} //= 'client-key.pem' if -f 'client-key.pem';
for my $file (@files) {
open(my $fh, '<', $file) or die "âš The file '$file' cannot be read: $!\n";
my $data = <$fh>;
close($fh);
t/00_tls_check.t view on Meta::CPAN
}
sub start_server {
say "This is the server listening on port $port...";
Mojo::IOLoop->server({
address => $address,
port => $port,
tls => 1,
tls_cert => 't/cert.pem',
tls_key => 't/key.pem',
# do ask for the client certificate, but don't verify it
tls_options => {
SSL_verify_mode => 1,
SSL_verify_callback => sub { 1 },
}
} => sub {
my ($loop, $stream) = @_;
my $data = { buffer => '', handler => \&handle_request };
$stream->on(read => sub {
my ($stream, $bytes) = @_;
my $fingerprint = $stream->handle->get_fingerprint();
$stream->write("Got '$bytes' from client $fingerprint\n");
$stream->close_gracefully();
});
t/00_tls_check.t view on Meta::CPAN
sub query1 {
my $query = shift;
# create client
Mojo::IOLoop->client({
address => $address,
port => $port,
tls => 1,
tls_cert => 't/cert.pem',
tls_key => 't/key.pem',
# don't verify the server certificate
tls_options => {SSL_verify_mode => SSL_VERIFY_NONE}
} => sub {
my ($loop, $err, $stream) = @_;
die "Client creation failed: $err\n" if $err;
$stream->timeout(3);
$stream->on(error => sub {
my ($stream, $err) = @_;
die "Stream error: $err\n" if $err });
$stream->on(read => sub {
my ($stream, $bytes) = @_;
my $fingerprint = 'sha256$0ba6ba61da1385890f611439590f2f0758760708d1375859b2184dcd8f855a00';
t/00_tls_check.t view on Meta::CPAN
$stream->write("$query")
});
# Start event loop if necessary
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
}
sub query2 {
my $query = shift;
my $socket = IO::Socket::SSL->new(
PeerHost => $address, PeerPort => $port,
# don't verify the server certificate
SSL_verify_mode => SSL_VERIFY_NONE,
SSL_cert_file => 't/cert.pem',
SSL_key_file => 't/key.pem', );
$socket->print("$query");
undef $/; # slurp
my $fingerprint = 'sha256$0ba6ba61da1385890f611439590f2f0758760708d1375859b2184dcd8f855a00';
is(<$socket>, "Got 'Hello2' from client $fingerprint\n", "IO::Socket::SSL");
}
my @tests = ("^# Welcome to localhost" => "test",
"^localhost: test" => "hallo",
"^localhost: hallo");
Mojo::IOLoop->client({
address => $host,
port => $port,
tls => 1,
tls_cert => "t/cert.pem",
tls_key => "t/key.pem",
tls_options => { SSL_verify_mode => 0x00 }} => sub {
my ($loop, $err, $stream) = @_;
$stream->on(read => sub {
my ($stream, $bytes) = @_;
my $text = encode_utf8 $bytes;
warn $text if $ENV{TEST_VERBOSE};
# test something
my $re = shift(@tests);
like($text, qr/$re/m, $re) if $re;
my $response = shift(@tests);
query_gemini("$say_url?$response") if $response;
require './t/test.pl';
sub query_gopher {
my $query = shift;
my $tls = shift;
# create client
my $socket;
if ($tls) {
$socket = IO::Socket::SSL->new(
PeerHost => $host, PeerPort => $gophers_port,
SSL_verify_mode => SSL_VERIFY_NONE)
or die "Cannot construct client socket: $@";
} else {
$socket = IO::Socket::IP->new("$host:$gopher_port")
or die "Cannot construct client socket: $@";
}
$socket->print("$query\r\n");
undef $/; # slurp
return <$socket>;
}
like(query_gopher("do/index", 1), qr/^02021-02-05\tpage\/2021-02-05\tlocalhost\t$gophers_port$/m, "Index via TLS");
# match
like(query_gopher("do/match\t05"), qr/^02021-02-05\tpage\/2021-02-05\tlocalhost\t$gopher_port$/m, "Match");
like(query_gopher("do/match\t05", 1), qr/^02021-02-05\tpage\/2021-02-05\tlocalhost\t$gophers_port$/m, "Match via TLS");
# search
like(query_gopher("do/search\tyo"), qr/^02021-02-05\tpage\/2021-02-05\tlocalhost\t$gopher_port$/m, "Search");
like(query_gopher("do/search\tyo", 1), qr/^02021-02-05\tpage\/2021-02-05\tlocalhost\t$gophers_port$/m, "Search via TLS");
# verify that gemini still works
$page = query_gemini("$base/");
like($page, qr/Welcome to Phoebe/, "Main menu via Gemini");
like($page, qr/^Blog:/m, "Main menu (Blog section) via Gemini");
like($page, qr/^=> $base\/page\/2021-02-05 2021-02-05/m, "Main menu contains 2021-02-05 via Gemini");
done_testing();
t/Iapetus.t view on Meta::CPAN
# test page
my $page = query_gemini("$base/Haiku");
like($page, qr/^51 Path not found/m, "Test page does not exist");
# upload text
sub iapetus {
my $request = shift;
my $data = shift;
my $socket = IO::Socket::SSL->new(
PeerHost => $host, PeerPort => $port,
# don't verify the server certificate
SSL_verify_mode => SSL_VERIFY_NONE,
SSL_cert_file => 't/cert.pem',
SSL_key_file => 't/key.pem', );
$socket->print($request);
is(<$socket>, "10 Continue\r\n");
$socket->print($data);
undef $/; # slurp
return <$socket>;
}
my $haiku = <<EOT;
t/Spartan.t view on Meta::CPAN
return <$socket>;
}
mkdir("$dir/localhost");
mkdir("$dir/localhost/page");
write_text("$dir/localhost/page/2021-02-05.gmi", "yo");
mkdir("$dir/localhost/alex");
mkdir("$dir/localhost/alex/page");
write_text("$dir/localhost/alex/page/2021-02-05.gmi", "lo");
# verify we get single digit errors
like(query_spartan(""), qr/^4 /, "No empty path");
my $page = query_spartan("/");
like($page, qr/^# Welcome to Phoebe/m, "Main menu");
like($page, qr/^Blog:/m, "Main menu (Blog section)");
like($page, qr(^=> spartan://localhost:$spartan_port/page/2021-02-05 2021-02-05$)m, "Main menu (Blog link)");
like($page, qr(^=> spartan://localhost:$spartan_port/do/index Index of all pages$)m, "Page index link");
$page = query_spartan("/page/2021-02-05");
t/Spartan.t view on Meta::CPAN
like($page, qr(^lo$)m, "Different Page Text in a Space (gemini)");
$page = query_spartan("/alex/raw/2021-02-05");
like($page, qr(^lo$)m, "Different Page Text in a Space (raw)");
$page = query_spartan("/alex/html/2021-02-05");
like($page, qr(^<p>lo$)m, "Different Page Text in a Space (html)");
# page list
like(query_spartan("/do/index"),
qr(^=> spartan://localhost:$spartan_port/page/2021-02-05 2021-02-05$)m, "Index");
# verify that gemini still works
$page = query_gemini("$base/");
like($page, qr/Welcome to Phoebe/, "Main menu via Gemini");
like($page, qr/^Blog:/m, "Main menu (Blog section) via Gemini");
like($page, qr/^=> $base\/page\/2021-02-05 2021-02-05/m, "Main menu contains 2021-02-05 via Gemini");
done_testing();
our @spaces = qw(test);
our $host;
our $port;
our $dir;
require './t/test.pl';
# Make sure the user agent doesn't check hostname and cert validity
my $dav = HTTP::DAV->new();
my $ua = $dav->get_user_agent();
$ua->ssl_opts(SSL_verify_mode => 0x00);
$ua->ssl_opts(verify_hostname => 0);
# Open a fresh wiki
ok($dav->open(-url => "https://$host:$port/"), "Open URL: " . $dav->message);
# Check options
for my $d (qw(/ /page /page/ /raw /raw/ /file /file/)) {
my $options = $dav->options(-url => "https://$host:$port$d");
for my $op (qw(OPTIONS PROPFIND)) {
like($options, qr/$op/, "$op supported for $d");
}
# test the main space
my $page = query_gemini("$base/");
like($page, qr/^=> $base\/page\/Alex Alex/m, "main menu contains Alex");
$page = query_gemini("$base/page/Alex");
like($page, qr/^Alex Schroeder/m, "Alex page was created");
$page = query_gemini("$base/file/alex.jpg");
like($page, qr/^20 image\/jpeg\r\n/, "alex.jpg file was created");
# verify that the alex space has different page content
$page = query_gemini("$base/alex");
like($page, qr/^=> $base\/alex\/page\/Alex Alex/m, "main menu contains Alex");
$page = query_gemini("$base/alex/page/Alex");
like($page, qr/^This page does not yet exist/m, "Alex page is empty in the alex space");
# redirect of reserved word
$page = query_gemini("$base/alex/do");
is($page, "31 $base/alex\r\n", "Redirect reserved word");
my $key_file = [undef, "t/key.pem", "t/key2.pem"]->[$cert];
my ($header, $mimetype, $encoding, $buffer);
# create client
Mojo::IOLoop->client(
{
address => "localhost",
port => $port,
tls => 1,
tls_cert => $cert_file,
tls_key => $key_file,
tls_options => { SSL_verify_mode => 0x00 },
} => sub {
my ($loop, $err, $stream) = @_;
die "Client creation failed: $err\n" if $err;
$stream->timeout(2);
$stream->on(error => sub {
my ($stream, $err) = @_;
die "Stream error: $err\n" if $err });
$stream->on(close => sub {
my ($stream) = @_;
diag "Closing stream\n" if $ENV{TEST_VERBOSE} });
( run in 2.211 seconds using v1.01-cache-2.11-cpan-73692580452 )