|
Packit |
b893dc |
#!/usr/bin/perl
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
use strict;
|
|
Packit |
b893dc |
use warnings;
|
|
Packit |
b893dc |
use Test::More;
|
|
Packit |
b893dc |
use Socket;
|
|
Packit |
b893dc |
use File::Spec;
|
|
Packit |
b893dc |
use Net::SSLeay;
|
|
Packit |
b893dc |
use Config;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# for debugging only
|
|
Packit |
b893dc |
my $DEBUG = 0;
|
|
Packit |
b893dc |
my $PCAP = 0;
|
|
Packit |
b893dc |
require Net::PcapWriter if $PCAP;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
plan skip_all => "no support for session_ticket_ext_cb"
|
|
Packit |
b893dc |
if ! defined &Net::SSLeay::set_session_ticket_ext_cb;
|
|
Packit |
b893dc |
my $tests = 4;
|
|
Packit |
b893dc |
plan tests => $tests;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
Net::SSLeay::randomize();
|
|
Packit |
b893dc |
Net::SSLeay::load_error_strings();
|
|
Packit |
b893dc |
Net::SSLeay::ERR_load_crypto_strings();
|
|
Packit |
b893dc |
Net::SSLeay::SSLeay_add_ssl_algorithms();
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $SSL_ERROR; # set in _minSSL
|
|
Packit |
b893dc |
my %TRANSFER; # set in _handshake
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $SESSION_TICKET = "\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff";
|
|
Packit |
b893dc |
my $SESSION_TICKET_CB_DATA = "dada";
|
|
Packit |
b893dc |
my $set_session_ticket_ext_cb_run = 0;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $client = _minSSL->new();
|
|
Packit |
b893dc |
my $server = _minSSL->new( cert => [
|
|
Packit |
b893dc |
File::Spec->catfile('t','data','testcert_wildcard.crt.pem'),
|
|
Packit |
b893dc |
File::Spec->catfile('t','data','testcert_key_2048.pem')
|
|
Packit |
b893dc |
]);
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# now attach the ticket callback to server
|
|
Packit |
b893dc |
# ----------------------------------------------
|
|
Packit |
b893dc |
my $ticketcb = sub {
|
|
Packit |
b893dc |
my ($ssl, $ticket, $data) = @_;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
is(unpack('H*', $data), unpack('H*', $SESSION_TICKET_CB_DATA), 'server set callback data with set_session_ticket_ext_cb');
|
|
Packit |
b893dc |
is(unpack('H*', $ticket), unpack('H*', $SESSION_TICKET), 'client set session ticket with set_session_ticket_ext');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$set_session_ticket_ext_cb_run = 1;
|
|
Packit |
b893dc |
return 1;
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
my $set_ticket_cb = sub {
|
|
Packit |
b893dc |
Net::SSLeay::set_session_ticket_ext_cb($server->_ssl, $ticketcb, $SESSION_TICKET_CB_DATA);
|
|
Packit |
b893dc |
Net::SSLeay::set_session_ticket_ext($client->_ssl, $SESSION_TICKET);
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
is( _handshake($client,$server,$set_ticket_cb),'full',"full handshake with a ticket");
|
|
Packit |
b893dc |
ok($set_session_ticket_ext_cb_run == 1, 'server run a callback set with set_session_ticket_ext_cb');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $i;
|
|
Packit |
b893dc |
sub _handshake {
|
|
Packit |
b893dc |
my ($client,$server,$after_init) = @_;
|
|
Packit |
b893dc |
$client->state_connect;
|
|
Packit |
b893dc |
$server->state_accept;
|
|
Packit |
b893dc |
&$after_init if $after_init;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $pcap = $PCAP && do {
|
|
Packit |
b893dc |
my $fname = 'test'.(++$i).'.pcap';
|
|
Packit |
b893dc |
open(my $fh,'>',$fname);
|
|
Packit |
b893dc |
diag("pcap in $fname");
|
|
Packit |
b893dc |
$fh->autoflush;
|
|
Packit |
b893dc |
Net::PcapWriter->new($fh)->tcp_conn('1.1.1.1',1000,'2.2.2.2',443);
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my ($client_done,$server_done,@hs);
|
|
Packit |
b893dc |
%TRANSFER = ();
|
|
Packit |
b893dc |
for(my $tries = 0; $tries < 10 and !$client_done || !$server_done; $tries++ ) {
|
|
Packit |
b893dc |
$client_done ||= $client->handshake || 0;
|
|
Packit |
b893dc |
$server_done ||= $server->handshake || 0;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $transfer = 0;
|
|
Packit |
b893dc |
if (defined(my $data = $client->bio_read())) {
|
|
Packit |
b893dc |
$pcap && $pcap->write(0,$data);
|
|
Packit |
b893dc |
$DEBUG && warn "client -> server: ".length($data)." bytes\n";
|
|
Packit |
b893dc |
$server->bio_write($data);
|
|
Packit |
b893dc |
push @hs,'>';
|
|
Packit |
b893dc |
$TRANSFER{client} += length($data);
|
|
Packit |
b893dc |
$transfer++;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
if (defined(my $data = $server->bio_read())) {
|
|
Packit |
b893dc |
$pcap && $pcap->write(1,$data);
|
|
Packit |
b893dc |
$DEBUG && warn "server -> client: ".length($data)." bytes\n";
|
|
Packit |
b893dc |
$client->bio_write($data);
|
|
Packit |
b893dc |
# assume certificate was sent if length>700
|
|
Packit |
b893dc |
push @hs, length($data) > 700 ? '<[C]':'<';
|
|
Packit |
b893dc |
$TRANSFER{server} += length($data);
|
|
Packit |
b893dc |
$transfer++;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
if (!$transfer) {
|
|
Packit |
b893dc |
# no more data to transfer - assume we are done
|
|
Packit |
b893dc |
$client_done = $server_done = 1;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
return
|
|
Packit |
b893dc |
!$client_done || !$server_done ? 'failed' :
|
|
Packit |
b893dc |
"@hs" eq '> <[C] > <' ? 'full' :
|
|
Packit |
b893dc |
"@hs" eq '> < >' ? 'reuse' :
|
|
Packit |
b893dc |
"@hs";
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
package _minSSL;
|
|
Packit |
b893dc |
sub new {
|
|
Packit |
b893dc |
my ($class,%args) = @_;
|
|
Packit |
b893dc |
my $ctx = Net::SSLeay::CTX_tlsv1_new();
|
|
Packit |
b893dc |
Net::SSLeay::CTX_set_options($ctx,Net::SSLeay::OP_ALL());
|
|
Packit |
b893dc |
Net::SSLeay::CTX_set_cipher_list($ctx,'AES128-SHA');
|
|
Packit |
b893dc |
my $id = 'client';
|
|
Packit |
b893dc |
if ($args{cert}) {
|
|
Packit |
b893dc |
my ($cert,$key) = @{ delete $args{cert} };
|
|
Packit |
b893dc |
Net::SSLeay::set_cert_and_key($ctx, $cert, $key)
|
|
Packit |
b893dc |
|| die "failed to use cert file $cert,$key";
|
|
Packit |
b893dc |
$id = 'server';
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $self = bless { id => $id, ctx => $ctx }, $class;
|
|
Packit |
b893dc |
return $self;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub state_accept {
|
|
Packit |
b893dc |
my $self = shift;
|
|
Packit |
b893dc |
_reset($self);
|
|
Packit |
b893dc |
Net::SSLeay::set_accept_state($self->{ssl});
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub state_connect {
|
|
Packit |
b893dc |
my $self = shift;
|
|
Packit |
b893dc |
_reset($self);
|
|
Packit |
b893dc |
Net::SSLeay::set_connect_state($self->{ssl});
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub handshake {
|
|
Packit |
b893dc |
my $self = shift;
|
|
Packit |
b893dc |
my $rv = Net::SSLeay::do_handshake($self->{ssl});
|
|
Packit |
b893dc |
$rv = _error($self,$rv);
|
|
Packit |
b893dc |
return $rv;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub ssl_read {
|
|
Packit |
b893dc |
my ($self) = @_;
|
|
Packit |
b893dc |
my ($data,$rv) = Net::SSLeay::read($self->{ssl});
|
|
Packit |
b893dc |
return _error($self,$rv || -1) if !$rv || $rv<0;
|
|
Packit |
b893dc |
return $data;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub bio_write {
|
|
Packit |
b893dc |
my ($self,$data) = @_;
|
|
Packit |
b893dc |
defined $data and $data ne '' or return;
|
|
Packit |
b893dc |
Net::SSLeay::BIO_write($self->{rbio},$data);
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub ssl_write {
|
|
Packit |
b893dc |
my ($self,$data) = @_;
|
|
Packit |
b893dc |
my $rv = Net::SSLeay::write($self->{ssl},$data);
|
|
Packit |
b893dc |
return _error($self,$rv || -1) if !$rv || $rv<0;
|
|
Packit |
b893dc |
return $rv;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub bio_read {
|
|
Packit |
b893dc |
my ($self) = @_;
|
|
Packit |
b893dc |
return Net::SSLeay::BIO_read($self->{wbio});
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub _ssl { shift->{ssl} }
|
|
Packit |
b893dc |
sub _ctx { shift->{ctx} }
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub _reset {
|
|
Packit |
b893dc |
my $self = shift;
|
|
Packit |
b893dc |
my $ssl = Net::SSLeay::new($self->{ctx});
|
|
Packit |
b893dc |
my @bio = (
|
|
Packit |
b893dc |
Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem()),
|
|
Packit |
b893dc |
Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem()),
|
|
Packit |
b893dc |
);
|
|
Packit |
b893dc |
Net::SSLeay::set_bio($ssl,$bio[0],$bio[1]);
|
|
Packit |
b893dc |
$self->{ssl} = $ssl;
|
|
Packit |
b893dc |
$self->{rbio} = $bio[0];
|
|
Packit |
b893dc |
$self->{wbio} = $bio[1];
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub _error {
|
|
Packit |
b893dc |
my ($self,$rv) = @_;
|
|
Packit |
b893dc |
if ($rv>0) {
|
|
Packit |
b893dc |
$SSL_ERROR = undef;
|
|
Packit |
b893dc |
return $rv;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
my $err = Net::SSLeay::get_error($self->{ssl},$rv);
|
|
Packit |
b893dc |
if ($err == Net::SSLeay::ERROR_WANT_READ()
|
|
Packit |
b893dc |
|| $err == Net::SSLeay::ERROR_WANT_WRITE()) {
|
|
Packit |
b893dc |
$SSL_ERROR = $err;
|
|
Packit |
b893dc |
$DEBUG && warn "[$self->{id}] rw:$err\n";
|
|
Packit |
b893dc |
return;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
$DEBUG && warn "[$self->{id}] ".Net::SSLeay::ERR_error_string($err)."\n";
|
|
Packit |
b893dc |
return;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
}
|