view release on metacpan or  search on metacpan

t/06-server-endpoint.t  view on Meta::CPAN

use strict;
use warnings;

use FindBin ();
use Socket qw(inet_aton pack_sockaddr_in);
use Test2::V0;
use Time::HiRes qw(sleep);

use Net::QUIC::Endpoint;

my $server_local = pack_sockaddr_in(4436, inet_aton('127.0.0.1'));
my @client_local = (
    pack_sockaddr_in(40003, inet_aton('127.0.0.1')),
    pack_sockaddr_in(40004, inet_aton('127.0.0.1')),
);
my $alpn = 'net-quic-server-endpoint-test';
my $cert_file = "$FindBin::Bin/data/server-cert.pem";
my $key_file = "$FindBin::Bin/data/server-key.pem";

my $server = Net::QUIC::Endpoint->server(
    alpn             => $alpn,
    certificate_file => $cert_file,
    private_key_file => $key_file,
);

$server->receive_datagram(
    "not a QUIC packet",
    $server_local,
    $client_local[0],
);
ok(!defined($server->next_connection), 'invalid datagram does not create a connection');

my @client = map {
    Net::QUIC::Endpoint->client(
        local       => $_,
        peer        => $server_local,
        alpn        => $alpn,
        server_name => 'localhost',
        ca_file     => $cert_file,
    )
} @client_local;

my %client_for_peer = map {
    $client_local[$_] => $client[$_]
} 0 .. $#client;

sub pump_all {
    my $progress = 0;

    while (my $datagram = $server->next_datagram) {
        ++$progress;

        my $client = $client_for_peer{$datagram->peer};
        die "server produced datagram for unknown client"
            if !defined $client;

        $client->receive_datagram(
            $datagram->data,
            $datagram->peer,
            $server_local,
        );
    }

    for my $i (0 .. $#client) {
        while (my $datagram = $client[$i]->next_datagram) {
            ++$progress;
            $server->receive_datagram(
                $datagram->data,
                $server_local,
                $client_local[$i],
            );
        }
    }

    my @timeouts;
    my $server_after = $server->timeout_after;
    push @timeouts, [$server_after, sub { $server->handle_timeout }]
        if defined $server_after;

    for my $client (@client) {
        my $after = $client->timeout_after;
        push @timeouts, [$after, sub { $client->handle_timeout }]
            if defined $after;