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