#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Socket;
use File::Spec;
use Net::SSLeay;
use Config;
# for debugging only
my $DEBUG = 0;
my $PCAP = 0;
require Net::PcapWriter if $PCAP;
my @set_list = (
defined &Net::SSLeay::CTX_set1_groups_list ? (\&Net::SSLeay::CTX_set1_groups_list) : (),
defined &Net::SSLeay::CTX_set1_curves_list ? (\&Net::SSLeay::CTX_set1_curves_list) : (),
);
plan skip_all => "no support for CTX_set_curves_list" if ! @set_list;
my $tests = 4*@set_list;
plan tests => $tests;
Net::SSLeay::randomize();
Net::SSLeay::load_error_strings();
Net::SSLeay::ERR_load_crypto_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
my $SSL_ERROR; # set in _minSSL
my %TRANSFER; # set in _handshake
my $client = _minSSL->new();
my $server = _minSSL->new( cert => [
File::Spec->catfile('t','data','testcert_wildcard.crt.pem'),
File::Spec->catfile('t','data','testcert_key_2048.pem')
]);
my $set_curves;
while ($set_curves = shift @set_list) {
ok(_handshake($client,$server,'P-521:P-384','P-521',1), 'first curve');
ok(_handshake($client,$server,'P-521:P-384','P-384',1), 'second curve');
ok(_handshake($client,$server,'P-521:P-384','P-256',0), 'wrong curve failed');
ok(_handshake($client,$server,'P-521:P-384','P-384:P-521',1), 'both curve');
}
my $i;
sub _handshake {
my ($client,$server,$server_curve,$client_curve,$expect_ok) = @_;
$client->state_connect($client_curve);
$server->state_accept($server_curve);
my $pcap = $PCAP && do {
my $fname = 'test'.(++$i).'.pcap';
open(my $fh,'>',$fname);
diag("pcap in $fname");
$fh->autoflush;
Net::PcapWriter->new($fh)->tcp_conn('1.1.1.1',1000,'2.2.2.2',443);
};
my ($client_done,$server_done,@hs);
%TRANSFER = ();
for(my $tries = 0; $tries < 10 and !$client_done || !$server_done; $tries++ ) {
$client_done ||= $client->handshake || 0;
$server_done ||= $server->handshake || 0;
my $transfer = 0;
if (defined(my $data = $client->bio_read())) {
$pcap && $pcap->write(0,$data);
$DEBUG && warn "client -> server: ".length($data)." bytes\n";
$server->bio_write($data);
push @hs,'>';
$TRANSFER{client} += length($data);
$transfer++;
}
if (defined(my $data = $server->bio_read())) {
$pcap && $pcap->write(1,$data);
$DEBUG && warn "server -> client: ".length($data)." bytes\n";
$client->bio_write($data);
# assume certificate was sent if length>700
push @hs, length($data) > 700 ? '<[C]':'<';
$TRANSFER{server} += length($data);
$transfer++;
}
if (!$transfer) {
# no more data to transfer - assume we are done
$client_done = $server_done = 1;
}
}
my $result = "$client_done - $server_done - @hs";
return $result eq '1 - 1 - > <[C] > <' if $expect_ok;
return 1 if $result eq '1 - 1 - > <'; # failed connect with OpenSSL >= 1.1.0
return 1 if $result =~ qr{^\Q0 - 0 - > < < <}; # OpenSSL 1.0.2, LibreSSL
return 0; # unexpected result
}
{
package _minSSL;
sub new {
my ($class,%args) = @_;
my $ctx = Net::SSLeay::CTX_tlsv1_new();
Net::SSLeay::CTX_set_options($ctx,Net::SSLeay::OP_ALL());
Net::SSLeay::CTX_set_cipher_list($ctx,'ECDHE');
Net::SSLeay::CTX_set_ecdh_auto($ctx,1)
if defined &Net::SSLeay::CTX_set_ecdh_auto;
my $id = 'client';
if ($args{cert}) {
my ($cert,$key) = @{ delete $args{cert} };
Net::SSLeay::set_cert_and_key($ctx, $cert, $key)
|| die "failed to use cert file $cert,$key";
$id = 'server';
}
my $self = bless { id => $id, ctx => $ctx }, $class;
return $self;
}
sub state_accept {
my ($self,$curve) = @_;
_reset($self,$curve);
Net::SSLeay::set_accept_state($self->{ssl});
}
sub state_connect {
my ($self,$curve) = @_;
_reset($self,$curve);
Net::SSLeay::set_connect_state($self->{ssl});
}
sub handshake {
my $self = shift;
my $rv = Net::SSLeay::do_handshake($self->{ssl});
$rv = _error($self,$rv);
return $rv;
}
sub ssl_read {
my ($self) = @_;
my ($data,$rv) = Net::SSLeay::read($self->{ssl});
return _error($self,$rv || -1) if !$rv || $rv<0;
return $data;
}
sub bio_write {
my ($self,$data) = @_;
defined $data and $data ne '' or return;
Net::SSLeay::BIO_write($self->{rbio},$data);
}
sub ssl_write {
my ($self,$data) = @_;
my $rv = Net::SSLeay::write($self->{ssl},$data);
return _error($self,$rv || -1) if !$rv || $rv<0;
return $rv;
}
sub bio_read {
my ($self) = @_;
return Net::SSLeay::BIO_read($self->{wbio});
}
sub _ssl { shift->{ssl} }
sub _ctx { shift->{ctx} }
sub _reset {
my ($self,$curve) = @_;
$set_curves->($self->{ctx},$curve) if $curve;
my $ssl = Net::SSLeay::new($self->{ctx});
my @bio = (
Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem()),
Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem()),
);
Net::SSLeay::set_bio($ssl,$bio[0],$bio[1]);
$self->{ssl} = $ssl;
$self->{rbio} = $bio[0];
$self->{wbio} = $bio[1];
}
sub _error {
my ($self,$rv) = @_;
if ($rv>0) {
$SSL_ERROR = undef;
return $rv;
}
my $err = Net::SSLeay::get_error($self->{ssl},$rv);
if ($err == Net::SSLeay::ERROR_WANT_READ()
|| $err == Net::SSLeay::ERROR_WANT_WRITE()) {
$SSL_ERROR = $err;
$DEBUG && warn "[$self->{id}] rw:$err\n";
return;
}
$DEBUG && warn "[$self->{id}] ".Net::SSLeay::ERR_error_string($err)."\n";
return;
}
}