view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN

#!/usr/bin/env perl
# Copyright (C) 2018–2021  Alex Schroeder <alex@gnu.org>

# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.

use Modern::Perl;
use Mojo::IOLoop;
use IO::Socket::SSL;
use Test::More;
use File::Slurper qw(write_text);
use Config;

my $host = 'localhost';
my $port = Mojo::IOLoop::Server->generate_port;

my $pid = fork();

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

our $data_dir = 't';

if (!defined $pid) {
  die "Cannot fork: $!";
} elsif ($pid == 0) {
  say "This is the server listening on port $port...";
  if (not -f "t/cert.pem" or not -f "t/key.pem") {
    local $/ = undef;
    my $data = <DATA>;
    my $pos = index($data, "-----BEGIN PRIVATE KEY-----");
    write_text("t/cert.pem", substr($data, 0, $pos));
    write_text("t/key.pem", substr($data, $pos));
  }
  chdir($data_dir);
  my $perl_path = $Config{perlpath};
  exec($perl_path, "../blib/script/lupa-pona", "--host=$host", "--port=$port", "--log_level=warn")
      or die "Cannot exec: $!";
}

sub query_gemini {
  my $query = shift;
  my $socket = IO::Socket::SSL->new(
    PeerHost => $host,
    PeerService => $port,
    SSL_verify_mode => SSL_VERIFY_NONE)
      or die "Cannot construct client socket: $@";
  print $socket "$query\r\n";
  undef $/; # slurp
  return <$socket>;
}

my $total = 0;
my $ok = 0;

# What I'm seeing is that $@ is the empty string and $! is "Connection refused"
# even though I thought $@ would be set. Oh well.
say "This is the client waiting for the server to start on port $port...";
for (qw(1 1 1 1 2 2 3 4 5)) {
  if (not $total or $!) {
    diag "$!: waiting ${_}s..." if $total > 0;
    $total += $_;
    sleep $_;