view release on metacpan or  search on metacpan

script/lupa-pona  view on Meta::CPAN

    sudo systemctl start lupa-pona

Check the log output:

    sudo journalctl --unit lupa-pona

All the files in C</home/lupa-pona> are going to be served, if the C<lupa-pona>
user can read them.

=head2 Privacy

If you increase the log level, the server will produce more output, including
information about the connections happening, like C<2020/06/29-15:35:59 CONNECT
SSL Peer: "[::1]:52730" Local: "[::1]:1965"> and the like (in this case C<::1>
is my local address so that isn't too useful but it could also be your visitor's
IP numbers, in which case you will need to tell them about it using in order to
comply with the
L<GDPR|https://en.wikipedia.org/wiki/General_Data_Protection_Regulation>.

=cut

use Mojo::Log;
use Mojo::IOLoop;
use Getopt::Long;
use File::Slurper qw(read_binary read_dir);
use Encode qw(encode_utf8 decode_utf8);
use Modern::Perl '2018';
use File::MimeInfo qw(globs);
use URI::Escape;
use Pod::Text;
use utf8;

our $host;
our $port ||= 1965;
our $cert_file ||= "cert.pem";
our $key_file ||= "key.pem";
our $encoding ||= "UTF-8";
our $log_level ||= "warn";  # error, warn, info, debug, trace

my %args = ();
GetOptions ("host=s"          => \$host,
	    "port=i"          => \$port,
	    "cert_file=s"     => \$cert_file,
	    "key_file=s"      => \$key_file,
	    "text_encoding=s" => \$encoding,
	    "log_level=s"     => \$log_level)
    or die("Error in command line arguments\n");

my $log = Mojo::Log->new;
$log->level($log_level);

if (not -f $key_file or not -f $cert_file) {
  say "The certificate and/or key files are missing.";
  say "Do you want to create them right now?";
  say "The certificate uses eliptic curves and is valid for five years.";
  say "If so, please provide your hostname (e.g. localhost).";
  say "If not, just press Enter.";
  local $SIG{'ALRM'} = sub {
    die "Timed out!\n";
  };
  alarm(30); # timeout for the following prompt
  my $hostname = <STDIN>;
  alarm(0);  # done, no more alarm
  chomp $hostname;
  die "Some other day.\n" unless $hostname;
  die "The hostname may not contain any whitespace\n" if $hostname =~ /\s/;
  my $cmd = qq(openssl req -new -x509 -newkey ec -subj "/CN=$hostname" )
      . qq(-pkeyopt ec_paramgen_curve:prime256v1 -days 1825 -nodes -out cert.pem -keyout key.pem);
  say "$cmd ";
  system($cmd) == 0 or die "openssl failed: $?";
}

Mojo::IOLoop->server(
  {
    address => $host,
    port => $port,
    tls => 1,
    tls_cert => $cert_file,
    tls_key => $key_file,
  } => sub {
    my ($loop, $stream) = @_;
    $stream->on(read => \&serve_gemini);
  });

Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

sub serve_gemini {
  my ($stream, $url) = @_;
  return unless $url =~ s/\r\n.*//s; # needs URL and CR LF in one chunk
  my ($scheme, $authority, $path, $query, $fragment) =
      $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
  my ($url_host, $url_port) = split(/:/, $authority);
  $url_port ||= 1965;
  $log->info("Looking at $url");
  if (not $url) {
    $log->debug("The URL is empty");
    $stream->write("59 URL expected\r\n");
  } elsif (length($url) > 1024) {
    $log->debug("The URL is too long");
    $stream->write("59 The URL is too long\r\n");
  } elsif ($authority and $host and $host ne $url_host or $port ne $url_port) {
    $stream->write("53 Unsupported proxy request for $url; we just serve $host:$port\r\n");
  } elsif (not $path) {
    $stream->write("31 $url/\r\n"); # enforce trailing slash
  } elsif ($path eq "/") {
    $stream->write("20 text/gemini; charset=UTF-8\r\n");
    $stream->write("Welcome to Lupa Pona!\n");
    for (read_dir(".")) {
      next if $_ eq $cert_file;
      next if $_ eq $key_file;
      next if /~$/; # Emacs backup files
      $stream->write("=> $_\n") if -f;
    }
  } elsif ($path eq "/$cert_file" or $path eq "/$key_file") {
    $stream->write("50 Forbidden\n");
  } elsif ($path =~ m!^/([^/]+)$!) {
    my $file = decode_utf8(uri_unescape($1));
    if (-f $file) {
      my $mime = globs($file) || mime_type($file);
      $mime .= "; charset=$encoding" if $mime =~ /^text\// and $encoding;
      $stream->write("20 $mime\r\n");