.ssh/config: cosmo8: Fix host->originalhost
[nethome.git] / 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";