git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/talk-to-ourself

   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     my $port = $ARGV[1];
  12     require Sys::Hostname;
  13     my $host = Sys::Hostname::hostname();
  14     if (my $socket = IO::Socket::INET->new(PeerAddr => "$host:$port", Timeout => 5)) {
  15         require IO::Select;
  16         if (IO::Select->new($socket)->can_read(1)) {
  17             my($n, $buf);
  18             if ($n = sysread($socket, $buf, 512)) {
  19                 exit if $buf eq "Hi there!\n";
  20                 die "Seems to be talking to the wrong server at $host:$port, got \"$buf\"\n";
  21             }
  22             elsif (defined $n) {
  23                 die "Immediate EOF from server at $host:$port\n";
  24             }
  25             else {
  26                 die "Can't read from server at $host:$port: $!";
  27             }
  28         }
  29         die "No response from server at $host:$port\n";
  30     }
  31     die "Can't connect: $@\n";
  32 }
  33
  34 # server code
  35 my $socket = IO::Socket::INET->new(Listen => 1, Timeout => 5);
  36 my $port = $socket->sockport;
  37 open(CLIENT, qq("$^X" "$0" --port $port |)) || die "Can't run $^X $0: $!\n";
  38
  39 if (my $client = $socket->accept) {
  40     print $client "Hi there!\n";
  41     close($client) || die "Can't close socket: $!";
  42 }
  43 else {
  44     warn "Test server timeout\n";
  45 }
  46
  47 exit if close(CLIENT);
  48 die "Can't wait for client: $!" if $!;
  49 die "The can-we-talk-to-ourself test failed.\n";