view release on metacpan or  search on metacpan

t/15-driver-loopback.t  view on Meta::CPAN

use IO::Socket::INET;
use Test2::V0;
use Time::HiRes qw(time);

use Net::QUIC::Driver;

my $alpn = 'net-quic-driver-loopback-test';
my $cert_file = "$FindBin::Bin/data/server-cert.pem";
my $key_file = "$FindBin::Bin/data/server-key.pem";

sub make_udp_socket {
    my $socket = IO::Socket::INET->new(
        LocalAddr => '127.0.0.1',
        LocalPort => 0,
        Proto     => 'udp',
    );

    die "could not create loopback UDP socket: $!"
        if !defined $socket;

    return $socket;
}

sub send_datagram {
    my ($socket, $datagram, $counter) = @_;

    my $bytes = $datagram->data;
    my $sent = send(
        $socket,
        $bytes,
        0,
        $datagram->peer,
    );

    die "loopback UDP send failed: $!"
        if !defined $sent;

    die "loopback UDP send was partial"
        if $sent != length($bytes);

    ++$$counter;
    return 1;
}

my $server_socket = make_udp_socket();
my $client_socket = make_udp_socket();

my $server_local = getsockname($server_socket);
my $client_local = getsockname($client_socket);

ok(defined($server_local), 'server UDP socket has a local address');
ok(defined($client_local), 'client UDP socket has a local address');

my ($server_deadline, $client_deadline);
my ($server_tx, $client_tx) = (0, 0);
my ($server_rx, $client_rx) = (0, 0);

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

    send => sub {
        my ($datagram) = @_;
        return send_datagram($server_socket, $datagram, \$server_tx);
    },

    set_timeout => sub {
        my ($after) = @_;
        $server_deadline = defined($after)
            ? time() + $after
            : undef;
        return;
    },
);

my $client = Net::QUIC::Driver->client(
    local       => $client_local,
    peer        => $server_local,
    alpn        => $alpn,
    server_name => 'localhost',
    ca_file     => $cert_file,

    send => sub {
        my ($datagram) = @_;
        return send_datagram($client_socket, $datagram, \$client_tx);
    },

    set_timeout => sub {
        my ($after) = @_;
        $client_deadline = defined($after)
            ? time() + $after
            : undef;
        return;
    },
);

my $client_connection = $client->connection;
my $selector = IO::Select->new($client_socket, $server_socket);

sub service_once {
    my ($hard_deadline) = @_;

    my $now = time();

    if (defined($server_deadline) && $server_deadline <= $now) {
        $server_deadline = undef;
        $server->timeout;
    }

    $now = time();

    if (defined($client_deadline) && $client_deadline <= $now) {
        $client_deadline = undef;
        $client->timeout;
    }

    $now = time();

    my $wait = 0.05;