bin/checkhello

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