view release on metacpan or  search on metacpan

t/08-certificate-verification.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(4438, inet_aton('127.0.0.1'));
my $client_local = pack_sockaddr_in(40007, inet_aton('127.0.0.1'));
my $alpn = 'net-quic-certificate-verification-test';
my $cert_file = "$FindBin::Bin/data/server-cert.pem";
my $key_file = "$FindBin::Bin/data/server-key.pem";

like(
    dies {
        Net::QUIC::Endpoint->client(
            local => $client_local,
            peer  => $server_local,
            alpn  => $alpn,
        );
    },
    qr/missing required server_name argument/,
    'verified client requires a server name',
);

like(
    dies {
        Net::QUIC::Endpoint->client(
            local       => $client_local,
            peer        => $server_local,
            alpn        => $alpn,
            server_name => 'localhost',
            ca_file     => "$FindBin::Bin/data/does-not-exist.pem",
        );
    },
    qr/unable to load client CA file/,
    'bad CA file is rejected during client construction',
);

sub run_handshake {
    my (%args) = @_;

    my $server = Net::QUIC::Endpoint->server(
        alpn             => defined($args{server_alpn}) ? $args{server_alpn} : $alpn,
        certificate_file => $cert_file,
        private_key_file => $key_file,
    );

    my %client_args = (
        local       => $client_local,
        peer        => $server_local,
        alpn        => defined($args{client_alpn}) ? $args{client_alpn} : $alpn,
        server_name => $args{server_name},
    );
    $client_args{ca_file} = $args{ca_file}
        if defined $args{ca_file};

    my $client = Net::QUIC::Endpoint->client(%client_args);
    my $server_connection;
    my $error;

    for (1 .. 300) {
        while (my $datagram = $client->next_datagram) {
            my $ok = eval {
                $server->receive_datagram(
                    $datagram->data,
                    $server_local,
                    $client_local,
                );
                1;
            };
            if (!$ok) {
                $error = $@;
                last;
            }
        }
        last if defined $error;

        $server_connection ||= $server->next_connection;

        while (my $datagram = $server->next_datagram) {
            my $ok = eval {
                $client->receive_datagram(
                    $datagram->data,
                    $client_local,
                    $server_local,
                );
                1;
            };
            if (!$ok) {
                $error = $@;
                last;
            }
        }
        last if defined $error;

        return ($client, $server_connection, undef)
            if $server_connection
            && $client->connection->ready
            && $server_connection->ready;

        return ($client, $server_connection, undef)
            if defined $client->connection->close_info
            || ($server_connection && defined $server_connection->close_info);

        my $server_after = $server->timeout_after;