6 use POSIX qw/SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/;
10 use IPC::MorseSignals qw/msend mrecv mreset/;
16 die 'forked too many times' if $lives < 0;
17 pipe my $rdr, my $wtr or die "pipe() failed: $!";
20 die "fork() failed: $!";
23 close $rdr or die "close() failed: $!";
26 my $rcv = mrecv %SIG, cb => sub { print $wtr $_[1], "\n" };
28 $SIG{ALRM} = sub { alarm 1; kill SIGHUP => $ppid };
30 $SIG{HUP} = sub { alarm 0; mreset $rcv };
35 local $SIG{HUP} = sub { $ready = 1 };
37 close $wtr or die "close() failed: $!";
38 my $oldfh = select $rdr;
47 close $rdr or die "close() failed: $!";
59 my ($pid, $rdr) = spawn;
65 my @alpha = ('a' .. 'z');
66 my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
67 while (($ok < $n) && (($speed /= 2) >= 1)) {
68 print STDERR "$n sends of $l bytes at $speed bits/s";
74 local $SIG{ALRM} = sub { print STDERR "timeout\n"; die };
75 my $a = (int(100 * (3 * $l) / $speed) || 1);
78 msend $msg => $pid, speed => $speed;
81 kill SIGHUP => $pid if $@;
83 if (!defined $r) { # Something bad happened, respawn
84 print STDERR "oops\n";
87 redo TRY; # Retry this send
93 print STDERR "transfer error\n";
100 my $desc = "$l bytes sent $n times";
102 print STDERR " OK\n\n";
103 push @res, "$desc at $speed bits/s";
105 print STDERR " FAILED\n\n";
106 push @res, "$desc FAILED";
126 print STDERR "=== Summary ===\n";
127 print STDERR "$_\n" for @res;