← Back to branch summary

~ubuntu-branches/ubuntu/wily/libio-socket-ssl-perl/wily

« back to all changes in this revision

Viewing changes to t/memleak_bad_handshake.t

  • Committer: Package Import Robot
  • Author(s): Sebastien Bacher
  • Date: 2014-01-17 11:28:23 UTC
  • mfrom: (41.1.2 trusty-proposed)
  • Revision ID: package-import@ubuntu.com-20140117112823-xemv5h0jdtms3oee
Tags: 1.965-1ubuntu1
* Resynchronize on Debian, remaining change
* Prefer the ipv6 alternatives for the recommendations.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/memleak_bad_handshake.t
1
 
#!perl -w
 
1
#!perl
2
2
# Before `make install' is performed this script should be runnable with
3
3
# `make test'. After `make install' it should work as `perl t/nonblock.t'
4
4
 
5
 
 
 
5
use strict;
 
6
use warnings;
6
7
use Net::SSLeay;
7
8
use Socket;
8
9
use IO::Socket::SSL;
9
10
use IO::Select;
10
11
use Errno qw(EAGAIN EINPROGRESS );
11
 
use strict;
12
12
 
13
13
if ( grep { $^O =~m{$_}i } qw( MacOS VOS vmesa riscos amigaos mswin32) ) {
14
14
    print "1..0 # Skipped: ps not implemented on this platform\n";
22
22
 
23
23
 
24
24
$|=1;
25
 
use vars qw( $SSL_SERVER_ADDR );
26
 
do "t/ssl_settings.req" || do "ssl_settings.req";
27
 
 
28
25
if ( ! getsize($$) ) {
29
 
        print "1..0 # Skipped: no usable ps\n";
30
 
        exit;
 
26
    print "1..0 # Skipped: no usable ps\n";
 
27
    exit;
31
28
}
32
29
 
33
30
my $server = IO::Socket::SSL->new(
34
 
        LocalAddr => $SSL_SERVER_ADDR,
35
 
        Listen => 200,
36
 
        ReuseAddr => 1,
 
31
    LocalAddr => '127.0.0.1',
 
32
    LocalPort => 0,
 
33
    Listen => 200,
 
34
    SSL_cert_file => 'certs/server-cert.pem',
 
35
    SSL_key_file => 'certs/server-key.pem',
37
36
);
38
 
my $addr = $SSL_SERVER_ADDR.':'.$server->sockport;
39
 
 
40
 
defined( my $pid = fork()) or do {
41
 
        print "1..0 # Skipped: fork failed\n";
42
 
        goto done;
43
 
};
44
 
 
 
37
 
 
38
my $saddr = $server->sockhost.':'.$server->sockport;
 
39
defined( my $pid = fork()) or die "fork failed: $!";
45
40
if ( $pid == 0 ) {
46
 
        # server
47
 
        while (1) {
48
 
                # socket accept, client handshake and client close 
49
 
                $server->accept;
50
 
        }
51
 
        goto done;
 
41
    # server
 
42
    while (1) {
 
43
        # socket accept, client handshake and client close
 
44
        $server->accept;
 
45
    }
 
46
    exit(0);
52
47
}
53
48
 
54
49
 
55
50
close($server);
56
51
# plain non-SSL connect and close w/o sending data
57
52
for(1..100) {
58
 
        IO::Socket::INET->new( $addr ) or next;
 
53
    IO::Socket::INET->new( $saddr ) or next;
59
54
}
60
55
my $size100 = getsize($pid);
61
56
if ( ! $size100 ) {
62
 
        print "1..0 # Skipped: cannot get size of child process\n";
63
 
        goto done;
 
57
    print "1..0 # Skipped: cannot get size of child process\n";
 
58
    goto done;
64
59
}
65
60
 
66
61
for(100..200) {
67
 
        IO::Socket::INET->new( $addr ) or next;
 
62
    IO::Socket::INET->new( $saddr ) or next;
68
63
}
69
64
my $size200 = getsize($pid);
70
65
 
71
66
for(200..300) {
72
 
        IO::Socket::INET->new( $addr ) or next;
 
67
    IO::Socket::INET->new( $saddr ) or next;
73
68
}
74
69
my $size300 = getsize($pid);
75
70
if ($size100>$size200 or $size200<$size300) {;
76
 
        print "1..0 # skipped  - do we measure the right thing?\n";
77
 
        goto done;
 
71
    print "1..0 # skipped  - do we measure the right thing?\n";
 
72
    goto done;
78
73
}
79
74
 
80
75
print "1..1\n";
88
83
 
89
84
 
90
85
sub getsize {
91
 
        my $pid = shift;
92
 
        open( my $ps,'-|',"ps -o vsize -p $pid 2>/dev/null" ) or return;
93
 
        $ps && <$ps> or return; # header
94
 
        return int(<$ps>); # size
 
86
    my $pid = shift;
 
87
    open( my $ps,'-|',"ps -o vsize -p $pid 2>/dev/null" ) or return;
 
88
    $ps && <$ps> or return; # header
 
89
    return int(<$ps>); # size
95
90
}
96