1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
use strict;
use warnings;
use IO::Socket::SSL;
use IO::Socket::SSL::Utils;
use Test::More;
do './testlib.pl' || do './t/testlib.pl' || die "no testlib";
# create listener
IO::Socket::SSL::default_ca('certs/my-ca.pem');
my $server = IO::Socket::SSL->new(
LocalAddr => '127.0.0.1',
LocalPort => 0,
Listen => 2,
SSL_cert_file => 'certs/server-cert.pem',
SSL_key_file => 'certs/server-key.pem',
# start as plain and upgrade later
SSL_startHandshake => 0,
) || die "not ok #tcp listen failed: $!\n";
my $saddr = $server->sockhost.':'.$server->sockport;
#diag("listen at $saddr");
# fork child for server
defined( my $pid = fork() ) || die $!;
if ( ! $pid ) {
$SIG{ALRM} = sub { die "server timed out" };
while (1) {
alarm(30);
my $cl = $server->accept;
diag("server accepted new client");
#${*$cl}{_SSL_ctx} or die "accepted socket has no SSL context";
${*$cl}{_SSL_object} and die "accepted socket is already SSL";
# try to find out if we start with TLS immediatly (peek gets data from
# client hello) or have some plain data initially (peek gets these
# plain data)
diag("wait for initial data from client");
my $buf = '';
while (length($buf)<3) {
vec(my $rin='',fileno($cl),1) = 1;
my $rv = select($rin,undef,undef,10);
die "timeout waiting for data from client" if ! $rv;
die "something wrong: $!" if $rv<0;
$cl->peek($buf,3);
$buf eq '' and die "eof from client";
diag("got 0x".unpack("H*",$buf)." from client");
}
if ($buf eq "end") {
# done
diag("client requested end of tests");
exit(0);
}
if ($buf eq 'foo') {
# initial plain dialog
diag("server: got plain data at start of connection");
read($cl,$buf,3) or die "failed to read";
$buf eq 'foo' or die "read($buf) different from peek";
print $cl "bar"; # reply
}
# now we upgrade to TLS
diag("server: TLS upgrade");
$cl->accept_SSL or die "failed to SSL upgrade server side: $SSL_ERROR";
${*$cl}{_SSL_object} or die "no SSL object after accept_SSL";
read($cl,$buf,6) or die "failed to ssl read";
$buf eq 'sslfoo' or die "wrong data received from client '$buf'";
print $cl "sslbar";
# now we downgrade from TLS to plain and try to exchange some data
diag("server: TLS downgrade");
$cl->stop_SSL or die "failed to stop SSL";
${*$cl}{_SSL_object} and die "still SSL object after stop_SSL";
read($cl,$buf,3);
$buf eq 'foo' or die "wrong data received from client '$buf'";
print $cl "bar";
# now we upgrade again to TLS
diag("server: TLS upgrade#2");
$cl->accept_SSL or die "failed to SSL upgrade server side";
${*$cl}{_SSL_object} or die "no SSL object after accept_SSL";
read($cl,$buf,6) or die "failed to ssl read";
$buf eq 'sslfoo' or die "wrong data received from client '$buf'";
print $cl "sslbar";
}
}
# client
close($server); # close server in client
$SIG{ALRM} = sub { die "client timed out" };
plan tests => 15;
for my $test (
[qw(newINET start_SSL stop_SSL start_SSL)],
[qw(newSSL stop_SSL connect_SSL)],
[qw(newSSL:0 connect_SSL stop_SSL connect_SSL)],
[qw(newSSL:0 start_SSL stop_SSL connect_SSL)],
) {
my $cl;
diag("-- test: @$test");
for my $act (@$test) {
if (eval {
if ($act =~m{newSSL(?::(.*))?$} ) {
$cl = IO::Socket::SSL->new(
PeerAddr => $saddr,
defined($1) ? (SSL_startHandshake => $1):(),
) or die "failed to connect: $!|$SSL_ERROR";
if ( ! defined($1) || $1 ) {
${*$cl}{_SSL_object} or die "no SSL object";
} else {
${*$cl}{_SSL_object} and die "have SSL object";
}
} elsif ($act eq 'newINET') {
$cl = IO::Socket::INET->new($saddr)
or die "failed to connect: $!";
} elsif ($act eq 'stop_SSL') {
$cl->stop_SSL or die "stop_SSL failed: $SSL_ERROR";
${*$cl}{_SSL_object} and
die "still having SSL object after stop_SSL";
} elsif ($act eq 'connect_SSL') {
$cl->connect_SSL or die "connect_SSL failed: $SSL_ERROR";
${*$cl}{_SSL_object} or die "no SSL object after connect_SSL";
} elsif ($act eq 'start_SSL') {
IO::Socket::SSL->start_SSL($cl) or
die "start_SSL failed: $SSL_ERROR";
${*$cl}{_SSL_object} or die "no SSL object after start_SSL";
} else {
die "unknown action $act"
}
if (${*$cl}{_SSL_object}) {
print $cl "sslfoo";
read($cl, my $buf,6);
$buf eq 'sslbar' or die "wrong response with ssl: $buf";
} else {
print $cl "foo";
read($cl, my $buf,3);
$buf eq 'bar' or die "wrong response without ssl: $buf";
}
}) {
pass($act);
} else {
fail("$act: $@");
last; # slip rest
}
}
}
# make server exit
alarm(10);
my $cl = IO::Socket::INET->new($saddr);
print $cl "end" if $cl;
wait;
|
