← Back to branch summary

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

« back to all changes in this revision

Viewing changes to t/dhe.t

  • Committer: Bazaar Package Importer
  • Author(s): Florian Ragwitz
  • Date: 2006-09-14 16:45:35 UTC
  • mfrom: (1.2.3 upstream) (3.1.1 etch)
  • Revision ID: james.westby@ubuntu.com-20060914164535-mpktm3m2ee1oxfpt
Tags: 1.01-1
http://bugs.debian.org/383106
* New upstream release.
  + fixes depreciated and practically undocumented function
    get_peer_certificate so that LWP Net::HTTPS works again.
  + work around Bug in Net::HTTPS where it defines sub blocking
    as {}, e.g. force scalar context when calling sub blocking
    (in IO::Socket::SSL::write) (Closes: #383106).

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/dhe.t
 
1
#!perl -w
 
2
# Before `make install' is performed this script should be runnable with
 
3
# `make test'. After `make install' it should work as `perl t/dhe.t'
 
4
 
 
5
# This tests the use of Diffie Hellman Key Exchange (DHE)
 
6
# If you have only a 384bit RSA key you can not use RSA key exchange,
 
7
# but DHE is usable. For an explanation see
 
8
# http://groups.google.de/group/mailing.openssl.users/msg/d60330cfa7a6034b
 
9
# So this test simple uses a 384bit RSA key to make sure that DHE is used.
 
10
 
 
11
use Net::SSLeay;
 
12
use Socket;
 
13
use IO::Socket::SSL;
 
14
use strict;
 
15
 
 
16
 
 
17
if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
 
18
    print "1..0 # Skipped: fork not implemented on this platform\n";
 
19
    exit
 
20
}
 
21
 
 
22
$|=1;
 
23
print "1..3\n";
 
24
 
 
25
# first create simple ssl-server
 
26
my $ID = 'server';
 
27
my $addr = '127.0.0.1';
 
28
my $server = IO::Socket::SSL->new(
 
29
    LocalAddr => $addr,
 
30
    Listen => 2,
 
31
    ReuseAddr => 1,
 
32
    SSL_cert_file => "certs/server-rsa384-dh.pem",
 
33
    SSL_key_file  => "certs/server-rsa384-dh.pem",
 
34
    SSL_dh_file   => "certs/server-rsa384-dh.pem",
 
35
) || do {
 
36
    notok($!);
 
37
    exit
 
38
};
 
39
ok("Server Initialization");
 
40
 
 
41
# add server port to addr
 
42
$addr.= ':'.(sockaddr_in( getsockname( $server )))[0];
 
43
 
 
44
my $pid = fork();
 
45
if ( !defined $pid ) {
 
46
    die $!; # fork failed
 
47
 
 
48
} elsif ( !$pid ) {    ###### Client
 
49
 
 
50
    $ID = 'client';
 
51
    close($server);
 
52
    my $to_server = IO::Socket::SSL->new( $addr ) || do {
 
53
        notok( "connect failed: ".IO::Socket::SSL->errstr() );
 
54
        exit
 
55
    };
 
56
    ok( "client connected" );
 
57
 
 
58
} else {                ###### Server
 
59
 
 
60
    my $to_client = $server->accept || do {
 
61
        notok( "accept failed: ".$server->errstr() );
 
62
        kill(9,$pid);
 
63
        exit;
 
64
    };
 
65
    ok( "Server accepted" );
 
66
    wait;
 
67
}
 
68
 
 
69
sub ok { print "ok # [$ID] @_\n"; }
 
70
sub notok { print "not ok # [$ID] @_\n"; }