t/lib/io_sock.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless(grep /blib/, @INC) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib' if -d '../lib';
   7     }
   8 }
   9
  10 use Config;
  11
  12 BEGIN {
  13     if (-d "lib" && -f "TEST") {
  14         if (!$Config{'d_fork'} ||
  15             (($Config{'extensions'} !~ /\bSocket\b/ ||
  16               $Config{'extensions'} !~ /\bIO\b/) &&
  17              !(($^O eq 'VMS') && $Config{d_socket}))) {
  18             print "1..0\n";
  19             exit 0;
  20         }
  21     }
  22 }
  23
  24 $| = 1;
  25 print "1..14\n";
  26
  27 use IO::Socket;
  28
  29 $listen = IO::Socket::INET->new(Listen => 2,
  30                                 Proto => 'tcp',
  31                                 Timeout => 2,
  32                                ) or die "$!";
  33
  34 print "ok 1\n";
  35
  36 # Check if can fork with dynamic extensions (bug in CRT):
  37 if ($^O eq 'os2' and
  38     system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
  39     print "ok $_ # skipped: broken fork\n" for 2..5;
  40     exit 0;
  41 }
  42
  43 $port = $listen->sockport;
  44
  45 if($pid = fork()) {
  46
  47     $sock = $listen->accept();
  48     print "ok 2\n";
  49
  50     $sock->autoflush(1);
  51     print $sock->getline();
  52
  53     print $sock "ok 4\n";
  54
  55     $sock->close;
  56
  57     waitpid($pid,0);
  58
  59     print "ok 5\n";
  60
  61 } elsif(defined $pid) {
  62
  63     # This can fail if localhost is undefined or the
  64     # special 'loopback' address 127.0.0.1 is not configured
  65     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
  66     # As a shortcut (not recommended) you could change 'localhost'
  67     # here to be the name of this machine eg 'myhost.mycompany.com'.
  68
  69     $sock = IO::Socket::INET->new(PeerPort => $port,
  70                                   Proto => 'tcp',
  71                                   PeerAddr => 'localhost'
  72                                  )
  73         or die "$! (maybe your system does not have the 'localhost' address defined)";
  74
  75     $sock->autoflush(1);
  76
  77     print $sock "ok 3\n";
  78
  79     print $sock->getline();
  80
  81     $sock->close;
  82
  83     exit;
  84 } else {
  85  die;
  86 }
  87
  88 # Test various other ways to create INET sockets that should
  89 # also work.
  90 $listen = IO::Socket::INET->new(Listen => '', Timeout => 2) or die "$!";
  91 $port = $listen->sockport;
  92
  93 if($pid = fork()) {
  94   SERVER_LOOP:
  95     while (1) {
  96        last SERVER_LOOP unless $sock = $listen->accept;
  97        while (<$sock>) {
  98            last SERVER_LOOP if /^quit/;
  99            last if /^done/;
 100            print;
 101        }
 102        $sock = undef;
 103     }
 104     $listen->close;
 105 } elsif (defined $pid) {
 106     # child, try various ways to connect
 107     $sock = IO::Socket::INET->new("localhost:$port");
 108     if ($sock) {
 109         print "not " unless $sock->connected;
 110         print "ok 6\n";
 111        $sock->print("ok 7\n");
 112        sleep(1);
 113        print "ok 8\n";
 114        $sock->print("ok 9\n");
 115        $sock->print("done\n");
 116        $sock->close;
 117     }
 118     else {
 119         print "# $@\n";
 120         print "not ok 6\n";
 121         print "not ok 7\n";
 122         print "not ok 8\n";
 123         print "not ok 9\n";
 124     }
 125
 126     # some machines seem to suffer from a race condition here
 127 #    sleep(1);
 128
 129     $sock = IO::Socket::INET->new("127.0.0.1:$port");
 130     if ($sock) {
 131        $sock->print("ok 10\n");
 132        $sock->print("done\n");
 133        $sock->close;
 134     }
 135     else {
 136         print "# $@\n";
 137         print "not ok 10\n";
 138     }
 139
 140     # some machines seem to suffer from a race condition here
 141 #    sleep(1);
 142
 143     $sock = IO::Socket->new(Domain => AF_INET,
 144                             PeerAddr => "localhost:$port");
 145     if ($sock) {
 146        $sock->print("ok 11\n");
 147        $sock->print("quit\n");
 148     }
 149     $sock = undef;
 150     sleep(1);
 151     exit;
 152 } else {
 153     die;
 154 }
 155
 156 # Then test UDP sockets
 157 $server = IO::Socket->new(Domain => AF_INET,
 158                           Proto  => 'udp',
 159                           LocalAddr => 'localhost');
 160 $port = $server->sockport;
 161
 162 if ($pid = fork()) {
 163     my $buf;
 164     $server->recv($buf, 100);
 165     print $buf;
 166 } elsif (defined($pid)) {
 167     #child
 168     $sock = IO::Socket::INET->new(Proto => 'udp',
 169                                   PeerAddr => "localhost:$port");
 170     $sock->send("ok 12\n");
 171     sleep(1);
 172     $sock->send("ok 12\n");  # send another one to be sure
 173     exit;
 174 } else {
 175     die;
 176 }
 177
 178 print "not " unless $server->blocking;
 179 print "ok 13\n";
 180
 181 $server->blocking(0);
 182 print "not " if $server->blocking;
 183 print "ok 14\n";