t/talk-to-ourself.pl

   1 #!perl -w
   2
   3 # This program check if we are able to talk to ourself.  Misconfigured
   4 # systems that can't talk to their own 'hostname' was the most commonly
   5 # reported libwww-failure.
   6
   7 use strict;
   8 require IO::Socket;
   9
  10 if ( @ARGV >= 2 && $ARGV[0] eq "--port" )
  11 {
  12     my $port = $ARGV[1];
  13     require Sys::Hostname;
  14     my $host = Sys::Hostname::hostname();
  15     if (
  16          my $socket = IO::Socket::INET->new( PeerAddr => "$host:$port",
  17                                              Timeout  => 5 )
  18        )
  19     {
  20         require IO::Select;
  21         if ( IO::Select->new($socket)->can_read(1) )
  22         {
  23             my ( $n, $buf );
  24             if ( $n = sysread( $socket, $buf, 512 ) )
  25             {
  26                 exit if $buf eq "Hi there!\n";
  27                 die "Seems to be talking to the wrong server at $host:$port, got \"$buf\"\n";
  28             }
  29             elsif ( defined $n )
  30             {
  31                 die "Immediate EOF from server at $host:$port\n";
  32             }
  33             else
  34             {
  35                 die "Can't read from server at $host:$port: $!";
  36             }
  37         }
  38         die "No response from server at $host:$port\n";
  39     }
  40     die "Can't connect: $@\n";
  41 }
  42
  43 # server code
  44 my $socket = IO::Socket::INET->new( Listen  => 1,
  45                                     Timeout => 5 );
  46 my $port = $socket->sockport;
  47 open( CLIENT, qq("$^X" "$0" --port $port |) ) || die "Can't run $^X $0: $!\n";
  48
  49 if ( my $client = $socket->accept )
  50 {
  51     print $client "Hi there!\n";
  52     close($client) || die "Can't close socket: $!";
  53 }
  54 else
  55 {
  56     warn "Test server timeout\n";
  57 }
  58
  59 exit if close(CLIENT);
  60 die "Can't wait for client: $!" if $!;
  61 die "The can-we-talk-to-ourself test failed.\n";