git.maemo.org Git - pkg-perl/blob - deb-src/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/core.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/core.t'
   4
   5
   6 use Net::SSLeay;
   7 use Socket;
   8 use IO::Socket::SSL;
   9 use Errno 'EAGAIN';
  10 eval {require "t/ssl_settings.req";} ||
  11 eval {require "ssl_settings.req";};
  12
  13 $GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS = eval "use 5.006; use IO::Select; return 1";
  14 $NET_SSLEAY_VERSION = $Net::SSLeay::VERSION;
  15 $OPENSSL_VERSION = 0;
  16 $OPENSSL_VERSION = &Net::SSLeay::OPENSSL_VERSION_NUMBER if ($NET_SSLEAY_VERSION>=1.19);
  17 $CAN_PEEK = ($OPENSSL_VERSION >= 0x0090601f) ? 1 : 0;
  18
  19 $numtests = 37;
  20 $|=1;
  21
  22 foreach ($^O) {
  23     if (/MacOS/ or /VOS/ or /vmesa/ or /riscos/ or /amigaos/) {
  24         print "1..0 # Skipped: fork not implemented on this platform\n";
  25         exit;
  26     }
  27 }
  28
  29 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
  30     $numtests+=5;
  31     $numtests+=4 if ($NET_SSLEAY_VERSION>=1.16)
  32 }
  33
  34 if ($NET_SSLEAY_VERSION>=1.16) {
  35     $numtests+=4;
  36 }
  37
  38 #We can only test SSL_peek if OpenSSL is v0.9.6a or better
  39 if ($CAN_PEEK) {
  40     $numtests+=3;
  41 }
  42
  43 print "1..$numtests\n";
  44
  45 %extra_options = ($Net::SSLeay::VERSION>=1.16) ?
  46     (SSL_key_file => "certs/client-key.enc", SSL_passwd_cb => sub { return "opossum" }) :
  47     (SSL_key_file => "certs/client-key.pem");
  48
  49
  50 my $server = IO::Socket::SSL->new(
  51     LocalAddr => $SSL_SERVER_ADDR,
  52     Listen => 2,
  53     Timeout => 30,
  54     ReuseAddr => 1,
  55     SSL_verify_mode => 0x00,
  56     SSL_ca_file => "certs/test-ca.pem",
  57     SSL_use_cert => 1,
  58     SSL_cert_file => "certs/client-cert.pem",
  59     SSL_version => 'TLSv1',
  60     SSL_cipher_list => 'HIGH',
  61     SSL_error_trap => \&error_trap,
  62     %extra_options
  63 );
  64
  65 if (!$server) {
  66     print "not ok\n";
  67     exit;
  68 }
  69 &ok("Server Initialization");
  70
  71 print "not " if (!defined fileno($server));
  72 &ok("Server Fileno Check");
  73
  74 my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname );
  75
  76
  77
  78 unless (fork) {
  79     close $server;
  80     %extra_options = ($Net::SSLeay::VERSION>=1.16) ?
  81         (SSL_key_file => "certs/server-key.enc", SSL_passwd_cb => sub { return "bluebell" },
  82          SSL_verify_callback => \&verify_sub) :
  83         (SSL_key_file => "certs/server-key.pem");
  84
  85
  86     my $client = new IO::Socket::INET(PeerAddr => $SSL_SERVER_ADDR,
  87                                       PeerPort => $SSL_SERVER_PORT);
  88
  89     print $client "Test\n";
  90     (<$client> eq "This server is SSL only") || print "not ";
  91     &ok("Client non-SSL connection");
  92     close $client;
  93
  94     $client = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
  95                                   PeerPort => $SSL_SERVER_PORT,
  96                                   SSL_verify_mode => 0x01,
  97                                   SSL_ca_file => "certs/test-ca.pem",
  98                                   SSL_use_cert => 1,
  99                                   SSL_cert_file => "certs/server-cert.pem",
 100                                   SSL_version => 'TLSv1',
 101                                   SSL_cipher_list => 'HIGH',
 102                                   %extra_options);
 103
 104
 105     sub verify_sub {
 106         my ($ok, $ctx_store, $cert, $error) = @_;
 107         unless ($ok && $ctx_store && $cert && !$error)
 108         { print("not ok #client failure\n") && exit; }
 109         ($cert =~ /IO::Socket::SSL Test CA/) || print "not";
 110         &ok("Client Verify-sub Check");
 111         return 1;
 112     }
 113
 114
 115     $client || (print("not ok #client failure\n") && exit);
 116     &ok("Client Initialization");
 117
 118     $client->fileno() || print "not ";
 119     &ok("Client Fileno Check");
 120
 121 #    $client->untaint() if ($HAVE_SCALAR_UTIL);  # In the future...
 122
 123     $client->dump_peer_certificate() || print "not ";
 124     &ok("Client Peer Certificate Check");
 125
 126     $client->peer_certificate("issuer") || print "not ";
 127     &ok("Client Peer Certificate Issuer Check");
 128
 129     $client->get_cipher() || print "not ";
 130     &ok("Client Cipher Check");
 131
 132     $client->syswrite('00waaaanf00', 7, 2);
 133
 134     if ($CAN_PEEK) {
 135         my $buffer;
 136         $client->read($buffer,2);
 137         print "not " if ($buffer ne 'ok');
 138         &ok("Client Peek Check");
 139     }
 140
 141     $client->print("Test\n");
 142     send($client, "Test\n", 0);
 143     $client->printf("\$%.2f\n%d\n%c\n%s", 1.0444442342, 4.0, ord("y"), "Test\nBeaver\nBeaver\n");
 144     shutdown($client, 1);
 145
 146     my $buffer="\0\0aaaaaaaaaaaaaaaaaaaa";
 147     $client->sysread($buffer, 7, 2);
 148     print "not " if ($buffer ne "\0\0waaaanf");
 149     &ok("Client Sysread Check");
 150
 151
 152 ## The future...
 153 #    if ($HAVE_SCALAR_UTIL) {
 154 #       print "not " if (is_tainted($buffer));
 155 #       &ok("client");
 156 #    }
 157
 158     my @array = $client->getline();
 159     print "not "  if (@array != 1 or $array[0] ne "Test\n");
 160     &ok("Client Getline Check");
 161
 162     print "not " if ($client->getc ne "\$");
 163     &ok("Client Getc Check");
 164
 165     @array = $client->getlines;
 166     print "not " if (@array != 6);
 167     &ok("Client Getlines Check 1");
 168
 169     print "not " if ($array[0] != "1.04\n");
 170     &ok("Client Getlines Check 2");
 171
 172     print "not " if ($array[1] ne "4\n");
 173     &ok("Client Getlines Check 3");
 174
 175     print "not " if ($array[2] ne "y\n");
 176     &ok("Client Getlines Check 4");
 177
 178     print "not " if (join("", @array[3..5]) ne "Test\nBeaver\nBeaver\n");
 179     &ok("Client Getlines Check 5");
 180
 181     print "not " if (defined(<$client>));
 182     &ok("Client Finished Reading Check");
 183
 184     $client->close(SSL_no_shutdown => 1);
 185
 186     my $client_2 = new IO::Socket::INET(PeerAddr => $SSL_SERVER_ADDR,
 187                                         PeerPort => $SSL_SERVER_PORT);
 188
 189     print "not " if (!$client_2);
 190     &ok("Second Client Initialization");
 191
 192     $client_2 = IO::Socket::SSL->new_from_fd($client_2->fileno, '+<>',
 193                                              SSL_reuse_ctx => $client,
 194                                              SSL_cipher_list => 'HIGH');
 195     print "not " if (!$client_2);
 196     &ok("Client Init from Fileno Check");
 197     $buffer = <$client_2>;
 198
 199     print "not " unless ($buffer eq "Boojums\n");
 200     &ok("Client (fileno) Readline Check");
 201
 202     $client_2->close(SSL_ctx_free => 1);
 203
 204     if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
 205         my $client_3 = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
 206                                            PeerPort => $SSL_SERVER_PORT,
 207                                            SSL_verify_mode => 0x01,
 208                                            SSL_ca_file => "certs/test-ca.pem",
 209                                            SSL_use_cert => 1,
 210                                            SSL_cert_file => "certs/server-cert.pem",
 211                                            SSL_version => 'TLSv1',
 212                                            SSL_cipher_list => 'HIGH',
 213                                            Blocking => 0,
 214                                            %extra_options);
 215
 216         print "not " if (!$client_3);
 217         &ok("Client Nonblocking Check 1");
 218         close $client_3;
 219
 220         my $client_4 = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
 221                                            PeerPort => $SSL_SERVER_PORT,
 222                                            SSL_reuse_ctx => $client_3,
 223                                            Blocking => 0,
 224                                            SSL_cipher_list => 'HIGH');
 225         print "not " if (!$client_4);
 226         &ok("Client Nonblocking Check 2");
 227         $client_3->close(SSL_ctx_free => 1);
 228     }
 229
 230     exit(0);
 231 }
 232
 233 my $client = $server->accept;
 234
 235 sub error_trap {
 236     my $self = shift;
 237     print $self "This server is SSL only";
 238     $error_trapped = 1;
 239     $self->kill_socket;
 240 }
 241
 242 $error_trapped or print "not ";
 243 &ok("Server non-SSL Client Check");
 244
 245 if ($client && $client->opened) {
 246     print "not ok # client stayed alive!\n";
 247     exit;
 248 }
 249 &ok("Server Kill-client Check");
 250
 251 ($client, $peer) = $server->accept;
 252
 253 if (!$client) {
 254     print "not ok # no client\n";
 255     exit;
 256 }
 257 &ok("Server Client Accept Check");
 258
 259 print "not " unless defined $peer;
 260 &ok("Accept returning peer address check.");
 261
 262
 263 fileno($client) || print "not ";
 264 &ok("Server Client Fileno Check");
 265
 266 my $buffer;
 267
 268 if ($CAN_PEEK) {
 269     $client->peek($buffer, 7, 2);
 270     print "not " if ($buffer ne "\0\0waaaanf");
 271     &ok("Server Peek Check");
 272
 273     print "not " if ($client->pending() != 7);
 274     &ok("Server Pending Check");
 275
 276     print $client "ok";
 277 }
 278
 279
 280
 281
 282
 283 sysread($client, $buffer, 7, 2);
 284 print "not " if ($buffer ne "\0\0waaaanf");
 285 &ok("Server Sysread Check");
 286
 287
 288 my @array = scalar <$client>;
 289 print "not "  if ($array[0] ne "Test\n");
 290 &ok("Server Getline Check");
 291
 292
 293 recv($client, my $recv_buffer, 5, 0);
 294 print "not " if ($recv_buffer ne "Test\n");
 295 &ok("Server Recv Check");
 296
 297 print "not " if (getc($client) ne "\$");
 298 &ok("Server Getc Check");
 299
 300
 301 @array = <$client>;
 302 print "not " if (@array != 6);
 303 &ok("Server Getlines Check 1");
 304
 305 print "not " if ($array[0] != "1.04\n");
 306 &ok("Server Getlines Check 2");
 307
 308 print "not " if ($array[1] ne "4\n");
 309 &ok("Server Getlines Check 3");
 310
 311 print "not " if ($array[2] ne "y\n");
 312 &ok("Server Getlines Check 4");
 313
 314 print "not " if (join("", @array[3..5]) ne "Test\nBeaver\nBeaver\n");
 315 &ok("Server Getlines Check 5");
 316
 317
 318 syswrite($client, '00waaaanf00', 7, 2);
 319 print($client "Test\n");
 320 printf $client "\$%.2f\n%d\n%c\n%s", (1.0444442342, 4.0, ord("y"), "Test\nBeaver\nBeaver\n");
 321
 322 close $client;
 323
 324 ($client, $packed) = $server->accept;
 325 &bail unless $client;
 326 print "not " unless (inet_ntoa((unpack_sockaddr_in($packed))[1]) eq "127.0.0.1");
 327 &ok("Peer address check");
 328
 329 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
 330     $client->blocking(0);
 331     $client->read($buffer, 20, 0);
 332     print "not " if $SSL_ERROR != SSL_WANT_READ;
 333     &ok("Server Nonblocking Check 1");
 334 }
 335
 336 print "not " unless ($client->opened);
 337 &ok("Server Client Opened Check 1");
 338
 339 print $client "Boojums\n";
 340
 341 close($client);
 342
 343 ${*$client}{'_SSL_opened'} = 1;
 344 print "not " if ($client->opened);
 345 &ok("Server Client Opened Check 2");
 346 ${*$client}{'_SSL_opened'} = 0;
 347
 348
 349 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
 350     $client = $server->accept;
 351     print "not " if (!$client->opened);
 352     &ok("Server Nonblocking Check 2");
 353     close $client;
 354
 355     $server->blocking(0);
 356     IO::Select->new($server)->can_read(30);
 357     $client = $server->accept;
 358     while ( ! $client ) {
 359         #DEBUG( "$!,$SSL_ERROR" );
 360         if ( $! == EAGAIN ) {
 361             if ( $SSL_ERROR == SSL_WANT_WRITE ) {
 362                 IO::Select->new( $server->opening )->can_write(30);
 363             } else {
 364                 IO::Select->new( $server->opening )->can_read(30);
 365             }
 366         } else {
 367             last
 368         }
 369         $client = $server->accept;
 370     }
 371
 372     print "not " unless ($client && $client->opened);
 373     &ok("Server Nonblocking Check 3");
 374     close $client;
 375 }
 376
 377 $server->close(SSL_ctx_free => 1);
 378 wait;
 379
 380 sub ok {
 381     print "ok #$_[0]\n";
 382 }
 383
 384 sub bail {
 385         print "Bail Out! $IO::Socket::SSL::ERROR";
 386 }
 387
 388 ## The future....
 389 #sub is_tainted {
 390 #    my $arg = shift;
 391 #    my $nada = substr($arg, 0, 0);
 392 #    local $@;
 393 #    eval {eval "# $nada"};
 394 #    return length($@);
 395 #}