view release on metacpan or  search on metacpan

t/24-preferred-address.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 $client_local = pack_sockaddr_in(40110, inet_aton('127.0.0.1'));
my $server_initial = pack_sockaddr_in(4461, inet_aton('127.0.0.1'));
my $server_preferred = pack_sockaddr_in(4462, inet_aton('127.0.0.1'));
my $alpn = 'net-quic-preferred-address-test';
my $cert_file = "$FindBin::Bin/data/server-cert.pem";
my $key_file = "$FindBin::Bin/data/server-key.pem";

my $saw_client_to_preferred = 0;
my $saw_server_from_preferred = 0;

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

my $client = Net::QUIC::Endpoint->client(
    local       => $client_local,
    peer        => $server_initial,
    alpn        => $alpn,
    server_name => 'localhost',
    ca_file     => $cert_file,
);

sub pump_pair {
    my $progress = 0;

    while (my $datagram = $server->next_datagram) {
        ++$progress;
        ++$saw_server_from_preferred
            if $datagram->local eq $server_preferred;
        $client->receive_datagram(
            $datagram->data,
            $datagram->peer,
            $datagram->local,
        );
    }

    while (my $datagram = $client->next_datagram) {
        ++$progress;
        ++$saw_client_to_preferred
            if $datagram->peer eq $server_preferred;
        $server->receive_datagram(
            $datagram->data,
            $datagram->peer,
            $datagram->local,
        );
    }

    my $client_after = $client->timeout_after;
    if (defined($client_after) && $client_after <= 0) {
        ++$progress;
        $client->handle_timeout;
    }

    my $server_after = $server->timeout_after;
    if (defined($server_after) && $server_after <= 0) {
        ++$progress;
        $server->handle_timeout;
    }

    if (!$progress) {
        my @wait = sort { $a <=> $b }
            grep { defined($_) && $_ > 0 }
            ($client_after, $server_after);

        if (@wait) {
            my $nap = $wait[0] > 0.01 ? 0.01 : $wait[0] + 0.001;
            sleep($nap);
            ++$progress;
        }
    }