bin/checkhello

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use IO::Socket::INET6;
   5 use Time::HiRes qw(sleep);
   6 use POSIX;
   7 @ARGV==5 or die "$0 <hostname> <port> <string> <timeout> <tries>";
   8 my($hostname,$port,$string,$timeout,$tries)=@ARGV;
   9 our $try;
  10 sub ts() {
  11   return localtime()." PID=$$ #$try: ";
  12 }
  13 for $try (1..$tries) {
  14   warn ts()."connect($hostname,$port)...\n";
  15   my $sock=IO::Socket::INET6->new(
  16       "Proto"   =>"tcp",
  17       "PeerAddr"=>$hostname,
  18       "PeerPort"=>$port,
  19       "Timeout"=>$timeout,
  20   );
  21   if (!$sock) {
  22     my $e=$!+0;
  23     warn ts()."connect($hostname,$port)=$e=$!";
  24     sleep $timeout if $e!=ETIMEDOUT;
  25     next;
  26   }
  27   warn ts()."connect($hostname,$port): done.\n";
  28   my $buf="";
  29   my $remains=$timeout;
  30   while ($remains>0) {
  31     my $rin="";
  32     vec($rin,fileno($sock),1)=1;
  33     my($nfound,$timeleft)=select($rin,"",$rin,$remains);
  34     die "select nfound=$nfound: $!" if $nfound<0;
  35     die "select timeleft=$timeleft" if $timeleft<0;
  36     $remains=$timeleft;
  37     if (!$nfound) {
  38       $remains==0 or die "remains=$remains";
  39       last;
  40     }
  41     my $c;
  42     my $got=sysread $sock,$c,1;
  43     my $fail;
  44     if (!defined $got) {
  45       warn ts()."sysread: $!";
  46       $fail=1;
  47     }
  48     if ($got==0) {
  49       warn ts()."sysread: EOF";
  50       $fail=1;
  51     }
  52     if (!$fail) {
  53       $got==1 or die "sysread=$got!=1";
  54       length($c)==1 or die "sysread->c=".length($c)."!=1";
  55       $buf.=$c;
  56     }
  57     last if length($buf)>=length($string);
  58 #    warn ts()."remains=<$remains> buf=<$buf>\n";
  59     last if $fail;
  60   }
  61   close $sock or warn ts()."close: $!";
  62   if ($buf eq $string) {
  63     warn ts()."PASS\n";
  64     print "PASS\n";
  65     exit 0;
  66   }
  67   warn ts()."buf=<$buf>, sleep $remains";
  68   sleep $remains or warn ts()."sleep=$!";
  69 }
  70 $try=$tries;
  71 warn ts()."FAIL\n";
  72 print "FAIL\n";