"Fossies" - the Fresh Open Source Software Archive

Member "libwww-perl-6.43/talk-to-ourself" (26 Nov 2019, 1524 Bytes) of package /linux/www/libwww-perl-6.43.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

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