view release on metacpan or  search on metacpan

script/phoebe  view on Meta::CPAN

  if ($cert_file or $key_file) {
    die "I must have both --key_file and --cert_file\n";
  }

  # let's see if we need to generate certificates
  my $default_certs = 0;

  # if, at the end, we have some hosts but no certs and keys
  for (@host) {
    $default_certs = 1;
    $server->{host}->{$_} = 1;
    $server->{cert_file}->{$_} = 'cert.pem';
    $server->{key_file}->{$_} = 'key.pem';
  }

  # if, at the end, we had no hosts at all, the default still needs cert and key
  if (not keys %{$server->{host}}) {
    $default_certs = 1;
    $server->{host}->{localhost} = 1;
    $server->{cert_file}->{localhost} = 'cert.pem';
    $server->{key_file}->{localhost} = 'key.pem';
  }

  # if the certs don't exist, generate them
  if ($default_certs
      and (not -f 'cert.pem'
	   or not -f 'key.pem')) {
    generate_certificates();
  }
}

sub generate_certificates {
  say "The default certificate (and 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 "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);
  if ($hostname) {
    say $cmd;
    system($cmd) == 0
      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->{port} ||= [1965];
$server->{wiki_token} ||= ['hello'];
$server->{wiki_space} ||= [];
$server->{wiki_mime_type} ||= [];
$server->{wiki_dir} ||= $ENV{PHOEBE_DATA_DIR} || './wiki';
$server->{wiki_page} ||= [];
$server->{wiki_main_page} ||= '';
$server->{wiki_page_size_limit} ||= 100000;

configure();

# Reconfigure if we get SIGHUP (via kill -s SIGHUP $pid, for example)
$SIG{HUP} = sub { Mojo::IOLoop->next_tick(\&configure) };

start_servers();

sub configure {
  # config file with extra code; restart server if you change it
  my $dir = $server->{wiki_dir};
  my @config;
  push(@config, map { "$dir/conf.d/$_" } grep(/\.p[lm]$/, read_dir("$dir/conf.d"))) if -d "$dir/conf.d";
  # allow override of config files in conf.d
  push(@config, "$dir/config") if -f "$dir/config";
  for my $config (@config) {
    $log->info("Running $config");
    $log->error("$config cannot be read") unless -r $config;
    $log->warn("$config did not return a true value") unless do $config;
    $log->error("$@") if $@;
    $log->error("$!") if $!;
  }
  # summarize config results
  $log->info("PID: $$");
  $log->info("Host: " . join(" ", keys %{$server->{host}}));
  $log->info("Port: @{$server->{port}}");
    $log->info("Space: @{$server->{wiki_space}}");
  if (keys %{$server->{host}} > 1) {
    my $hosts = host_regex();
    for (grep(!/^$hosts\//, @{$server->{wiki_space}})) {
      $log->warn("Space $_ is not prefixed with a known host");
    }
  } else {
    for (grep(/\//, @{$server->{wiki_space}})) {
      $log->warn("Space $_ is prefixed with a host but we serve just one");
    }
  }
  $log->info("Token: @{$server->{wiki_token}}");
  $log->info("Main page: $server->{wiki_main_page}");
  $log->info("Pages: @{$server->{wiki_page}}");
  $log->info("MIME types: @{$server->{wiki_mime_type}}");
  $log->info("Wiki data directory: $server->{wiki_dir}");
}

sub start_servers {
  # Figure out what IP numbers we need to listen to because we need to start
  # servers for both IPv4 and IPv6. Only do this if phoebe is actually executing.
  # If it is called under a different name, it's probably just being loaded as a
  # library, in which case we don't want to start the servers.
  if ($0 eq __FILE__) {
    for my $host (keys %{$server->{host}}) {
      for my $address (get_ip_numbers($host)) {
	$server->{address}->{$address} = $host;
	for my $port (@{$server->{port}}) {
	  $log->info("$host: listening on $address:$port (Gemini)");
	  Mojo::IOLoop->server({
	    address => $address,
	    port => $port,
	    tls => 1,
	    tls_cert => $server->{cert_file},
	    tls_key  => $server->{key_file},
	    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);
	      }
	    }
	  } => sub {
	    my ($loop, $stream) = @_;
	    my $data = { buffer => '', handler => \&handle_request };
	    $stream->on(read => sub {
	      my ($stream, $bytes) = @_;
	      $log->debug("Received " . length($bytes) . " bytes");
	      $data->{buffer} .= $bytes;
	      $data->{handler}->($stream, $data)})});
	}
      }
    }

    # Start event loop if necessary
    Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
  }
}

1;

__DATA__