git.maemo.org Git - pkg-perl/blob - deb-src/libnet-ssleay-perl/libnet-ssleay-perl-1.35/t/local/07_sslecho.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More tests => 69;
   6 use Socket;
   7 use File::Spec;
   8 use Symbol qw(gensym);
   9 use Net::SSLeay;
  10
  11 my $sock;
  12 my $pid;
  13
  14 my $port = 1212;
  15 my $dest_ip = gethostbyname('localhost');
  16 my $dest_serv_params  = pack ('S n a4 x8', AF_INET, $port, $dest_ip);
  17
  18 my $msg = 'ssleay-test';
  19 my $cert_pem = File::Spec->catfile('t', 'data', 'cert.pem');
  20 my $key_pem = File::Spec->catfile('t', 'data', 'key.pem');
  21
  22 my $cert_name = '/C=PL/ST=Peoples Republic of Perl/L=Net::/O=Net::SSLeay/'
  23     . 'OU=Net::SSLeay developers/CN=127.0.0.1/emailAddress=rafl@debian.org';
  24
  25 $ENV{RND_SEED} = '1234567890123456789012345678901234567890';
  26
  27 Net::SSLeay::randomize();
  28 Net::SSLeay::load_error_strings();
  29 Net::SSLeay::ERR_load_crypto_strings();
  30 Net::SSLeay::library_init();
  31
  32 {
  33     my $ip = "\x7F\0\0\x01";
  34     my $serv_params = pack ('S n a4 x8', AF_INET, $port, $ip);
  35     $sock = gensym();
  36     socket($sock, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket: $!");
  37     bind($sock, $serv_params) or BAIL_OUT("failed to bind socket: $!");
  38     listen($sock, 3) or BAIL_OUT("failed to listen on socket: $!");
  39
  40
  41     my $ctx = Net::SSLeay::CTX_new();
  42     ok($ctx, 'CTX_new');
  43     ok(Net::SSLeay::CTX_set_cipher_list($ctx, 'ALL'), 'CTX_set_cipher_list');
  44     ok(Net::SSLeay::set_cert_and_key($ctx, $cert_pem, $key_pem), 'set_cert_and_key');
  45
  46     $pid = fork();
  47     BAIL_OUT("failed to fork: $!") unless defined $pid;
  48     if ($pid == 0) {
  49         for (1 .. 7) {
  50             my $ns = gensym();
  51             my $addr = accept($ns, $sock);
  52
  53             my $old_out = select($ns);
  54             $| = 1;
  55             select($old_out);
  56
  57             my $ssl = Net::SSLeay::new($ctx);
  58             ok($ssl, 'new');
  59
  60             ok(Net::SSLeay::set_fd($ssl, fileno($ns)), 'set_fd using fileno');
  61             ok(Net::SSLeay::accept($ssl), 'accept');
  62
  63             ok(Net::SSLeay::get_cipher($ssl), 'get_cipher');
  64
  65             my $got = Net::SSLeay::ssl_read_all($ssl);
  66             is($got, $msg, 'ssl_read_all') if $_ < 7;
  67             ok(Net::SSLeay::ssl_write_all($ssl, uc($got)), 'ssl_write_all');
  68
  69             Net::SSLeay::free($ssl);
  70             close $ns;
  71         }
  72
  73         Net::SSLeay::CTX_free($ctx);
  74         close $sock;
  75
  76         exit;
  77     }
  78 }
  79
  80 my @results;
  81 {
  82     my ($got) = Net::SSLeay::sslcat('localhost', $port, $msg);
  83     push @results, [ $got eq uc($msg), 'send and recieved correctly' ];
  84
  85 }
  86
  87 {
  88     my $s = gensym();
  89     socket($s, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket");
  90     connect($s, $dest_serv_params) or BAIL_OUT("failed to connect");
  91
  92     {
  93         my $old_out = select($s);
  94         $| = 1;
  95         select($old_out);
  96     }
  97
  98     push @results, [ my $ctx = Net::SSLeay::CTX_new(), 'CTX_new' ];
  99     push @results, [ my $ssl = Net::SSLeay::new($ctx), 'new' ];
 100
 101     push @results, [ Net::SSLeay::set_fd($ssl, $s), 'set_fd using glob ref' ];
 102     push @results, [ Net::SSLeay::connect($ssl), 'connect' ];
 103
 104     push @results, [ Net::SSLeay::get_cipher($ssl), 'get_cipher' ];
 105
 106     push @results, [ Net::SSLeay::write($ssl, $msg), 'write' ];
 107     shutdown($s, 1);
 108
 109     my ($got) = Net::SSLeay::read($ssl);
 110     push @results, [ $got eq uc($msg), 'read' ];
 111
 112     Net::SSLeay::free($ssl);
 113     Net::SSLeay::CTX_free($ctx);
 114
 115     shutdown($s, 2);
 116     close $s;
 117
 118 }
 119
 120 {
 121     my $verify_cb_1_called = 0;
 122     my $verify_cb_2_called = 0;
 123     my $verify_cb_3_called = 0;
 124     {
 125         my $cert_dir = 't/data';
 126
 127         my $ctx = Net::SSLeay::CTX_new();
 128         push @results, [ Net::SSLeay::CTX_load_verify_locations($ctx, '', $cert_dir), 'CTX_load_verify_locations' ];
 129         Net::SSLeay::CTX_set_verify($ctx, &Net::SSLeay::VERIFY_PEER, \&verify);
 130
 131         my $ctx2 = Net::SSLeay::CTX_new();
 132         Net::SSLeay::CTX_set_cert_verify_callback($ctx2, \&verify4, 1);
 133
 134         {
 135             my $s = gensym();
 136             socket($s, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket: $!");
 137             connect($s, $dest_serv_params) or BAIL_OUT("failed to connect: $!");
 138
 139             {
 140                 my $old_out = select($s);
 141                 $| = 1;
 142                 select($old_out);
 143             }
 144
 145             my $ssl = Net::SSLeay::new($ctx);
 146             Net::SSLeay::set_fd($ssl, fileno($s));
 147             Net::SSLeay::connect($ssl);
 148
 149             Net::SSLeay::write($ssl, $msg);
 150
 151             shutdown $s, 2;
 152             close $s;
 153             Net::SSLeay::free($ssl);
 154
 155             push @results, [ $verify_cb_1_called == 1, 'verify cb 1 called once' ];
 156             push @results, [ $verify_cb_2_called == 0, 'verify cb 2 wasn\'t called yet' ];
 157             push @results, [ $verify_cb_3_called == 0, 'verify cb 3 wasn\'t called yet' ];
 158         }
 159
 160         {
 161             my $s1 = gensym();
 162             socket($s1, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket: $!");
 163             connect($s1, $dest_serv_params) or BAIL_OUT("failed to connect: $!");
 164
 165             {
 166                 my $old_out = select($s1);
 167                 $| = 1;
 168                 select($old_out);
 169             }
 170
 171             my $s2 = gensym();
 172             socket($s2, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket: $!");
 173             connect($s2, $dest_serv_params) or BAIL_OUT("failed to connect: $!");
 174
 175             {
 176                 my $old_out = select($s2);
 177                 $| = 1;
 178                 select($old_out);
 179             }
 180
 181             my $s3 = gensym();
 182             socket($s3, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket: $!");
 183             connect($s3, $dest_serv_params) or BAIL_OUT("failed to connect: $!");
 184
 185             {
 186                 my $old_out = select($s3);
 187                 $| = 1;
 188                 select($old_out);
 189             }
 190
 191             my $ssl1 = Net::SSLeay::new($ctx);
 192             Net::SSLeay::set_verify($ssl1, &Net::SSLeay::VERIFY_PEER, \&verify2);
 193             Net::SSLeay::set_fd($ssl1, $s1);
 194
 195             my $ssl2 = Net::SSLeay::new($ctx);
 196             Net::SSLeay::set_verify($ssl2, &Net::SSLeay::VERIFY_PEER, \&verify3);
 197             Net::SSLeay::set_fd($ssl2, $s2);
 198
 199             my $ssl3 = Net::SSLeay::new($ctx2);
 200             Net::SSLeay::set_fd($ssl3, $s3);
 201
 202             Net::SSLeay::connect($ssl1);
 203             Net::SSLeay::write($ssl1, $msg);
 204             shutdown $s1, 2;
 205
 206             Net::SSLeay::connect($ssl2);
 207             Net::SSLeay::write($ssl2, $msg);
 208             shutdown $s2, 2;
 209
 210             Net::SSLeay::connect($ssl3);
 211             Net::SSLeay::write($ssl3, $msg);
 212             shutdown $s3, 2;
 213
 214             close $s1;
 215             close $s2;
 216             close $s3;
 217
 218             Net::SSLeay::free($ssl1);
 219             Net::SSLeay::free($ssl2);
 220             Net::SSLeay::free($ssl3);
 221
 222             push @results, [ $verify_cb_1_called == 1, 'verify cb 1 wasn\'t called again' ];
 223             push @results, [ $verify_cb_2_called == 1, 'verify cb 2 called once' ];
 224             push @results, [ $verify_cb_3_called == 1, 'verify cb 3 wasn\'t called yet' ];
 225         }
 226
 227
 228         Net::SSLeay::CTX_free($ctx);
 229         Net::SSLeay::CTX_free($ctx2);
 230     }
 231
 232     sub verify {
 233         my ($ok, $x509_store_ctx) = @_;
 234         $verify_cb_1_called++;
 235
 236         push @results, [ $ok, 'verify cb' ];
 237
 238         my $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($x509_store_ctx);
 239         push @results, [ $cert, 'verify cb cert' ];
 240
 241         my $issuer_name = Net::SSLeay::X509_get_issuer_name( $cert );
 242         my $issuer  = Net::SSLeay::X509_NAME_oneline( $issuer_name );
 243
 244         my $subject_name = Net::SSLeay::X509_get_subject_name( $cert );
 245         my $subject = Net::SSLeay::X509_NAME_oneline( $subject_name );
 246
 247         push @results, [ $issuer  eq $cert_name, 'cert issuer'  ];
 248         push @results, [ $subject eq $cert_name, 'cert subject' ];
 249
 250         return 1;
 251     }
 252
 253     sub verify2 {
 254         $verify_cb_2_called++;
 255         return 1;
 256     }
 257
 258     sub verify3 {
 259         $verify_cb_3_called++;
 260         return 1;
 261     }
 262
 263     sub verify4 {
 264         my ($cert_store, $userdata) = @_;
 265         push @results, [$userdata == 1, 'CTX_set_cert_verify_callback'];
 266         return $userdata;
 267     }
 268 }
 269
 270 {
 271     my $s = gensym();
 272     socket($s, AF_INET, SOCK_STREAM, 0) or BAIL_OUT("failed to open socket: $!");
 273     connect($s, $dest_serv_params) or BAIL_OUT("failed to connect: $!");
 274
 275     {
 276         my $old_out = select($s);
 277         $| = 1;
 278         select($old_out);
 279     }
 280
 281     my $ctx = Net::SSLeay::CTX_new();
 282     my $ssl = Net::SSLeay::new($ctx);
 283
 284     Net::SSLeay::set_fd($ssl, fileno($s));
 285     Net::SSLeay::connect($ssl);
 286
 287     my $cert = Net::SSLeay::get_peer_certificate($ssl);
 288
 289     my $subject = Net::SSLeay::X509_NAME_oneline(
 290             Net::SSLeay::X509_get_subject_name($cert)
 291     );
 292
 293     my $issuer  = Net::SSLeay::X509_NAME_oneline(
 294             Net::SSLeay::X509_get_issuer_name($cert)
 295     );
 296
 297     push @results, [ $subject eq $cert_name, 'get_peer_certificate subject' ];
 298     push @results, [ $issuer  eq $cert_name, 'get_peer_certificate issuer'  ];
 299
 300     my $data = 'a' x 1024 ** 2;
 301     my $written = Net::SSLeay::ssl_write_all($ssl, \$data);
 302     push @results, [ $written == length $data, 'ssl_write_all' ];
 303
 304     shutdown $s, 1;
 305
 306     my $got = Net::SSLeay::ssl_read_all($ssl);
 307     push @results, [ $got eq uc($data), 'ssl_read_all' ];
 308
 309     Net::SSLeay::free($ssl);
 310     Net::SSLeay::CTX_free($ctx);
 311
 312     close $s;
 313 }
 314
 315 waitpid $pid, 0;
 316 push @results, [ $? == 0, 'server exited wiht 0' ];
 317
 318 END {
 319     Test::More->builder->current_test(44);
 320     for my $t (@results) {
 321         ok( $t->[0], $t->[1] );
 322     }
 323 }