vcs.maemo.org Git - pkg-perl/blob - deb-src/libnet-ssleay-perl/libnet-ssleay-perl-1.35/t/local/06_tcpecho.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More tests => 4;
   6 use Socket;
   7 use Symbol qw(gensym);
   8 use Net::SSLeay;
   9
  10 my $sock;
  11 my $pid;
  12
  13 my $port = 1211;
  14 my $msg = 'ssleay-tcp-test';
  15
  16 {
  17     my $ip = "\x7F\0\0\x01";
  18     my $serv_params = pack('S n a4 x8', AF_INET, $port, $ip);
  19     $sock = gensym();
  20     socket($sock, AF_INET, SOCK_STREAM, 0) or die;
  21     bind($sock, $serv_params) or die;
  22     listen($sock, 2) or die;
  23 }
  24
  25 {
  26     $pid = fork();
  27     die unless defined $pid;
  28     if ($pid == 0) {
  29         my $addr = accept(Net::SSLeay::SSLCAT_S, $sock) or die;
  30
  31         my $old_out = select(Net::SSLeay::SSLCAT_S);
  32         $| = 1;
  33         select($old_out);
  34
  35         my $got = Net::SSLeay::tcp_read_all();
  36         is($got, $msg, 'tcp_read_all');
  37
  38         ok(Net::SSLeay::tcp_write_all(uc($got)), 'tcp_write_all');
  39
  40         close Net::SSLeay::SSLCAT_S;
  41         close $sock;
  42
  43         exit;
  44     }
  45 }
  46
  47 my @results;
  48 {
  49     my ($got) = Net::SSLeay::tcpcat('localhost', $port, $msg);
  50     push @results, [ $got eq uc($msg), 'sent and recieved correctly' ];
  51 }
  52
  53 waitpid $pid, 0;
  54 push @results, [ $? == 0, 'server exited with 0' ];
  55
  56 END {
  57     Test::More->builder->current_test(2);
  58     for my $t (@results) {
  59         ok( $t->[0], $t->[1] );
  60     }
  61 }