← Back to branch summary

~ubuntu-branches/debian/stretch/libio-socket-ssl-perl/stretch

« back to all changes in this revision

Viewing changes to t/core.t

  • Committer: Package Import Robot
  • Author(s): Salvatore Bonaccorso
  • Date: 2015-04-28 18:31:55 UTC
  • mfrom: (47.1.12 experimental)
  • Revision ID: package-import@ubuntu.com-20150428183155-k743ul0fe37qqp2f
Tags: 2.012-2
Upload to unstable

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/core.t
7
7
use Net::SSLeay;
8
8
use Socket;
9
9
use IO::Socket::SSL;
10
 
use Errno 'EAGAIN';
 
10
use Errno 'EWOULDBLOCK';
 
11
 
11
12
do './testlib.pl' || do './t/testlib.pl' || die "no testlib";
12
13
 
13
 
$|=1;
 
14
use Test::More;
 
15
Test::More->builder->use_numbers(0);
 
16
Test::More->builder->no_ending(1);
14
17
 
15
 
my $CAN_NONBLOCK = $^O =~m{mswin32}i ? 0 : eval "use 5.006; use IO::Select; 1";
 
18
my $CAN_NONBLOCK = eval "use 5.006; use IO::Select; 1";
16
19
my $CAN_PEEK = &Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x0090601f;
17
20
 
18
21
my $numtests = 40;
26
29
        PeerPort => $us->sockport,
27
30
        Proto => 'udp'
28
31
    ) or do {
29
 
        print "1..0 # Skipped: cannot determine default peer IP\n";
30
 
        exit
 
32
        plan skip_all => "Skipped: cannot determine default peer IP";
31
33
    };
32
34
    $uc->sockhost,
33
35
};
34
36
 
35
 
print "1..$numtests\n";
36
 
 
 
37
plan tests => $numtests;
37
38
 
38
39
my $error_trapped = 0;
39
40
my $server = IO::Socket::SSL->new(
58
59
    SSL_passwd_cb => sub { return "opossum" }
59
60
);
60
61
 
61
 
if (!$server) {
62
 
    print "not ok\n";
63
 
    exit;
64
 
}
65
 
&ok("Server Initialization");
 
62
ok( $server, "Server Initialization");
 
63
$server or exit;
66
64
 
67
 
print "not " if (!defined fileno($server));
68
 
&ok("Server Fileno Check");
 
65
ok( fileno( $server), "Server Fileno Check");
69
66
 
70
67
my $saddr = $server->sockhost.':'.$server->sockport;
71
68
 
74
71
    close $server;
75
72
    my $client = IO::Socket::INET->new($saddr);
76
73
    print $client "Test\n";
77
 
    (<$client> eq "This server is SSL only") || print "not ";
78
 
    &ok("Client non-SSL connection");
 
74
    is( <$client>, "This server is SSL only", "Client non-SSL connection");
79
75
    close $client;
80
76
 
81
77
    $client = IO::Socket::SSL->new(
94
90
 
95
91
    sub verify_sub {
96
92
        my ($ok, $ctx_store, $cert, $error) = @_;
97
 
        unless ($ok && $ctx_store && $cert && !$error)
98
 
        { print("not ok #client failure\n") && exit; }
99
 
        ($cert =~ /IO::Socket::SSL Demo CA/) || print "not";
100
 
        &ok("Client Verify-sub Check");
 
93
        $ok && $ctx_store && $cert && !$error or do {
 
94
            fail("client failure in verify_sub");
 
95
            exit;
 
96
        };
 
97
        like( $cert, qr/IO::Socket::SSL Demo CA/, "Client Verify-sub Check");
101
98
        return 1;
102
99
    }
103
100
 
104
101
 
105
102
    $client || (print("not ok #client failure\n") && exit);
106
 
    &ok("Client Initialization");
 
103
    ok( $client, "Client Initialization");
107
104
 
108
105
    $client->fileno() || print "not ";
109
 
    &ok("Client Fileno Check");
 
106
    ok( $client->fileno(), "Client Fileno Check");
110
107
 
111
108
#    $client->untaint() if ($HAVE_SCALAR_UTIL);  # In the future...
112
109
 
113
 
    $client->dump_peer_certificate() || print "not ";
114
 
    &ok("Client Peer Certificate Check");
115
 
 
116
 
    $client->peer_certificate("issuer") || print "not ";
117
 
    &ok("Client Peer Certificate Issuer Check");
118
 
 
119
 
    $client->get_cipher() || print "not ";
120
 
    &ok("Client Cipher Check");
 
110
    ok( $client->dump_peer_certificate(), "Client Peer Certificate Check");
 
111
 
 
112
    ok( $client->peer_certificate("issuer"), "Client Peer Certificate Issuer Check");
 
113
 
 
114
    ok( $client->get_cipher(), "Client Cipher Check");
121
115
 
122
116
    $client->syswrite('00waaaanf00', 7, 2);
123
117
 
124
118
    if ($CAN_PEEK) {
125
119
        my $buffer;
126
120
        $client->read($buffer,2);
127
 
        print "not " if ($buffer ne 'ok');
128
 
        &ok("Client Peek Check");
 
121
        is( $buffer, "ok", "Client Peek Check");
129
122
    }
130
123
 
131
124
    $client->print("Test\n");
132
 
    $client->printf("\$%.2f\n%d\n%c\n%s", 1.0444442342, 4.0, ord("y"), "Test\nBeaver\nBeaver\n");
 
125
    $client->printf("\$%.2f\n%d\n%c\n%s",
 
126
                    1.0444442342,
 
127
                    4.0,
 
128
                    ord("y"),
 
129
                    "Test\nBeaver\nBeaver\n");
133
130
    shutdown($client, 1);
134
131
 
135
132
    my $buffer="\0\0aaaaaaaaaaaaaaaaaaaa";
136
133
    $client->sysread($buffer, 7, 2);
137
 
    print "not " if ($buffer ne "\0\0waaaanf");
138
 
    &ok("Client Sysread Check");
 
134
    is( $buffer, "\0\0waaaanf", "Client Sysread Check");
139
135
 
140
136
 
141
137
## The future...
145
141
#    }
146
142
 
147
143
    my @array = $client->getline();
148
 
    print "not "  if (@array != 1 or $array[0] ne "Test\n");
149
 
    &ok("Client Getline Check");
 
144
    is( $array[0], "Test\n", "Client Getline Check");
150
145
 
151
 
    print "not " if ($client->getc ne "\$");
152
 
    &ok("Client Getc Check");
 
146
    is( $client->getc, "\$", "Client Getc Check");
153
147
 
154
148
    @array = $client->getlines;
155
 
    print "not " if (@array != 6);
156
 
    &ok("Client Getlines Check 1");
157
 
 
158
 
    print "not " if ($array[0] != "1.04\n");
159
 
    &ok("Client Getlines Check 2");
160
 
 
161
 
    print "not " if ($array[1] ne "4\n");
162
 
    &ok("Client Getlines Check 3");
163
 
 
164
 
    print "not " if ($array[2] ne "y\n");
165
 
    &ok("Client Getlines Check 4");
166
 
 
167
 
    print "not " if (join("", @array[3..5]) ne "Test\nBeaver\nBeaver\n");
168
 
    &ok("Client Getlines Check 5");
169
 
 
170
 
    print "not " if (defined(<$client>));
171
 
    &ok("Client Finished Reading Check");
 
149
    is( scalar @array, 6, "Client Getlines Check 1");
 
150
 
 
151
    is( $array[0], "1.04\n", "Client Getlines Check 2");
 
152
 
 
153
    is( $array[1], "4\n", "Client Getlines Check 3");
 
154
 
 
155
    is( $array[2], "y\n", "Client Getlines Check 4");
 
156
 
 
157
    is( join("", @array[3..5]),
 
158
          "Test\nBeaver\nBeaver\n",
 
159
          "Client Getlines Check 5");
 
160
 
 
161
    ok( !<$client>, "Client Finished Reading Check");
172
162
 
173
163
    $client->close(SSL_no_shutdown => 1);
174
164
 
175
165
    my $client_2 = IO::Socket::INET->new($saddr);
176
 
    print "not " if (!$client_2);
177
 
    &ok("Second Client Initialization");
 
166
    ok( $client_2, "Second Client Initialization");
178
167
 
179
168
    $client_2 = IO::Socket::SSL->new_from_fd($client_2->fileno, '+<>',
180
169
                                             SSL_reuse_ctx => $client);
181
 
    print "not " if (!$client_2);
182
 
    &ok("Client Init from Fileno Check");
 
170
    ok( $client_2, "Client Init from Fileno Check");
183
171
    $buffer = <$client_2>;
184
172
 
185
 
    print "not " unless ($buffer eq "Boojums\n");
186
 
    &ok("Client (fileno) Readline Check");
 
173
    is( $buffer, "Boojums\n", "Client (fileno) Readline Check");
187
174
    $client_2->close(SSL_ctx_free => 1);
188
175
 
189
176
    if ($CAN_NONBLOCK) {
198
185
            SSL_key_file => "certs/server-key.enc",
199
186
            SSL_passwd_cb => sub { return "bluebell" },
200
187
            Blocking => 0,
201
 
        );
 
188
            );
202
189
 
203
 
        print "not " if (!$client_3);
204
 
        &ok("Client Nonblocking Check 1");
 
190
        ok( $client_3, "Client Nonblocking Check 1");
205
191
        close $client_3;
206
192
 
207
193
        my $client_4 = IO::Socket::SSL->new(
208
194
            PeerAddr => $saddr,
209
195
            SSL_reuse_ctx => $client_3,
210
196
            Blocking => 0
211
 
        );
212
 
        print "not " if (!$client_4);
213
 
        &ok("Client Nonblocking Check 2");
 
197
            );
 
198
        ok( $client_4, "Client Nonblocking Check 2");
214
199
        $client_3->close(SSL_ctx_free => 1);
215
200
    }
216
201
 
219
204
 
220
205
my $client = $server->accept;
221
206
 
222
 
$error_trapped or print "not ";
223
 
&ok("Server non-SSL Client Check");
 
207
ok( $error_trapped, "Server non-SSL Client Check");
224
208
 
225
209
if ($client && $client->opened) {
226
 
    print "not ok # client stayed alive!\n";
 
210
    fail("client stayed alive");
227
211
    exit;
228
212
}
229
 
&ok("Server Kill-client Check");
 
213
ok( !$client, "Server Kill-client Check");
230
214
 
231
215
($client, my $peer) = $server->accept;
232
 
if (!$client) {
233
 
    print "not ok # no client\n";
234
 
    exit;
235
 
}
236
 
&ok("Server Client Accept Check");
237
 
 
238
 
print "not " unless defined $peer;
239
 
&ok("Accept returning peer address check.");
240
 
 
241
 
 
242
 
fileno($client) || print "not ";
243
 
&ok("Server Client Fileno Check");
 
216
ok( $client, "Server Client Accept Check");
 
217
$client or exit;
 
218
 
 
219
ok( $peer, "Accept returning peer address check.");
 
220
 
 
221
ok( fileno($client), "Server Client Fileno Check");
244
222
 
245
223
my $buffer;
246
224
 
247
225
if ($CAN_PEEK) {
248
226
    $client->peek($buffer, 7, 2);
249
 
    print "not " if ($buffer ne "\0\0waaaanf");
250
 
    &ok("Server Peek Check");
 
227
    is( $buffer, "\0\0waaaanf","Server Peek Check");
251
228
 
252
 
    print "not " if ($client->pending() != 7);
253
 
    &ok("Server Pending Check");
 
229
    is( $client->pending(), 7, "Server Pending Check");
254
230
 
255
231
    print $client "ok";
256
232
}
257
233
 
258
 
 
259
 
 
260
 
 
261
 
 
262
234
sysread($client, $buffer, 7, 2);
263
 
print "not " if ($buffer ne "\0\0waaaanf");
264
 
&ok("Server Sysread Check");
265
 
 
 
235
is( $buffer, "\0\0waaaanf", "Server Sysread Check");
266
236
 
267
237
my @array = scalar <$client>;
268
 
print "not "  if ($array[0] ne "Test\n");
269
 
&ok("Server Getline Check");
270
 
 
271
 
 
272
 
print "not " if (getc($client) ne "\$");
273
 
&ok("Server Getc Check");
274
 
 
 
238
is( $array[0], "Test\n", "Server Getline Check");
 
239
 
 
240
is( getc($client), "\$", "Server Getc Check");
275
241
 
276
242
@array = <$client>;
277
 
print "not " if (@array != 6);
278
 
&ok("Server Getlines Check 1");
279
 
 
280
 
print "not " if ($array[0] != "1.04\n");
281
 
&ok("Server Getlines Check 2");
282
 
 
283
 
print "not " if ($array[1] ne "4\n");
284
 
&ok("Server Getlines Check 3");
285
 
 
286
 
print "not " if ($array[2] ne "y\n");
287
 
&ok("Server Getlines Check 4");
288
 
 
289
 
print "not " if (join("", @array[3..5]) ne "Test\nBeaver\nBeaver\n");
290
 
&ok("Server Getlines Check 5");
291
 
 
 
243
is( scalar @array, 6, "Server Getlines Check 1");
 
244
 
 
245
is( $array[0], "1.04\n", "Server Getlines Check 2");
 
246
 
 
247
is( $array[1], "4\n", "Server Getlines Check 3");
 
248
 
 
249
is( $array[2], "y\n", "Server Getlines Check 4");
 
250
 
 
251
is( join("", @array[3..5]), "Test\nBeaver\nBeaver\n", "Server Getlines Check 5");
292
252
 
293
253
syswrite($client, '00waaaanf00', 7, 2);
294
254
print($client "Test\n");
296
256
 
297
257
close $client;
298
258
 
299
 
($client, $peer) = $server->accept;
300
 
&bail unless $client;
301
 
print "not " unless (inet_ntoa((unpack_sockaddr_in($peer))[1]) eq $expected_peer);
302
 
&ok("Peer address check");
 
259
($client, $peer) = $server->accept or do {
 
260
    fail("client creation failed");
 
261
    exit;
 
262
};
 
263
is( inet_ntoa((unpack_sockaddr_in($peer))[1]), $expected_peer, "Peer address check");
303
264
 
304
265
if ($CAN_NONBLOCK) {
305
266
    $client->blocking(0);
306
267
    $client->read($buffer, 20, 0);
307
 
    print "not " if $SSL_ERROR != SSL_WANT_READ;
308
 
    &ok("Server Nonblocking Check 1");
 
268
    is( $SSL_ERROR, SSL_WANT_READ, "Server Nonblocking Check 1");
309
269
}
310
270
 
311
 
print "not " unless ($client->opened);
312
 
&ok("Server Client Opened Check 1");
 
271
ok( $client->opened, "Server Client Opened Check 1");
313
272
 
314
273
print $client "Boojums\n";
315
274
 
316
275
close($client);
317
276
 
318
277
${*$client}{'_SSL_opened'} = 1;
319
 
print "not " if ($client->opened);
320
 
&ok("Server Client Opened Check 2");
 
278
ok( !$client->opened, "Server Client Opened Check 2");
321
279
${*$client}{'_SSL_opened'} = 0;
322
280
 
323
 
 
324
281
if ($CAN_NONBLOCK) {
325
282
    $client = $server->accept;
326
 
    print "not " if (!$client->opened);
327
 
    &ok("Server Nonblocking Check 2");
 
283
    ok( $client->opened, "Server Nonblocking Check 2");
328
284
    close $client;
329
285
 
330
286
    $server->blocking(0);
332
288
    $client = $server->accept;
333
289
    while ( ! $client ) {
334
290
        #DEBUG( "$!,$SSL_ERROR" );
335
 
        if ( $! == EAGAIN ) {
 
291
        if ( $! == EWOULDBLOCK ) {
336
292
            if ( $SSL_ERROR == SSL_WANT_WRITE ) {
337
293
                IO::Select->new( $server->opening )->can_write(30);
338
294
            } else {
344
300
        $client = $server->accept;
345
301
    }
346
302
 
347
 
    print "not " unless ($client && $client->opened);
348
 
    &ok("Server Nonblocking Check 3");
 
303
    ok( $client->opened, "Server Nonblocking Check 3");
349
304
    close $client;
350
305
}
351
306
 
352
307
$server->close(SSL_ctx_free => 1);
353
308
wait;
354
309
 
355
 
sub ok {
356
 
    print "ok #$_[0]\n";
357
 
}
358
 
 
359
 
sub bail {
360
 
        print "Bail Out! $IO::Socket::SSL::ERROR";
361
 
}
362
310
 
363
311
## The future....
364
312
#sub is_tainted {