]>
Commit | Line | Data |
---|---|---|
2d3ca216 | 1 | #!/usr/bin/perl |
d48b2841 | 2 | use 5.008; |
2d3ca216 JN |
3 | use strict; |
4 | use warnings; | |
5 | use IO::Pty; | |
6 | use File::Copy; | |
7 | ||
18d8c269 | 8 | # Run @$argv in the background with stdio redirected to $in, $out and $err. |
2d3ca216 | 9 | sub start_child { |
18d8c269 | 10 | my ($argv, $in, $out, $err) = @_; |
2d3ca216 JN |
11 | my $pid = fork; |
12 | if (not defined $pid) { | |
13 | die "fork failed: $!" | |
14 | } elsif ($pid == 0) { | |
18d8c269 | 15 | open STDIN, "<&", $in; |
2d3ca216 | 16 | open STDOUT, ">&", $out; |
e23f436c | 17 | open STDERR, ">&", $err; |
18d8c269 | 18 | close $in; |
2d3ca216 JN |
19 | close $out; |
20 | exec(@$argv) or die "cannot exec '$argv->[0]': $!" | |
21 | } | |
22 | return $pid; | |
23 | } | |
24 | ||
25 | # Wait for $pid to finish. | |
26 | sub finish_child { | |
27 | # Simplified from wait_or_whine() in run-command.c. | |
28 | my ($pid) = @_; | |
29 | ||
30 | my $waiting = waitpid($pid, 0); | |
31 | if ($waiting < 0) { | |
32 | die "waitpid failed: $!"; | |
33 | } elsif ($? & 127) { | |
34 | my $code = $? & 127; | |
35 | warn "died of signal $code"; | |
709ca730 | 36 | return $code + 128; |
2d3ca216 JN |
37 | } else { |
38 | return $? >> 8; | |
39 | } | |
40 | } | |
41 | ||
42 | sub xsendfile { | |
43 | my ($out, $in) = @_; | |
44 | ||
45 | # Note: the real sendfile() cannot read from a terminal. | |
46 | ||
47 | # It is unspecified by POSIX whether reads | |
48 | # from a disconnected terminal will return | |
49 | # EIO (as in AIX 4.x, IRIX, and Linux) or | |
50 | # end-of-file. Either is fine. | |
51 | copy($in, $out, 4096) or $!{EIO} or die "cannot copy from child: $!"; | |
52 | } | |
53 | ||
18d8c269 PT |
54 | sub copy_stdin { |
55 | my ($in) = @_; | |
56 | my $pid = fork; | |
57 | if (!$pid) { | |
58 | xsendfile($in, \*STDIN); | |
59 | exit 0; | |
60 | } | |
61 | close($in); | |
62 | return $pid; | |
63 | } | |
64 | ||
e23f436c JK |
65 | sub copy_stdio { |
66 | my ($out, $err) = @_; | |
67 | my $pid = fork; | |
68 | defined $pid or die "fork failed: $!"; | |
69 | if (!$pid) { | |
70 | close($out); | |
71 | xsendfile(\*STDERR, $err); | |
72 | exit 0; | |
73 | } | |
74 | close($err); | |
75 | xsendfile(\*STDOUT, $out); | |
76 | finish_child($pid) == 0 | |
77 | or exit 1; | |
78 | } | |
79 | ||
2d3ca216 JN |
80 | if ($#ARGV < 1) { |
81 | die "usage: test-terminal program args"; | |
82 | } | |
e433749d | 83 | $ENV{TERM} = 'vt100'; |
18d8c269 | 84 | my $master_in = new IO::Pty; |
e23f436c JK |
85 | my $master_out = new IO::Pty; |
86 | my $master_err = new IO::Pty; | |
18d8c269 | 87 | $master_in->set_raw(); |
a463aefa TR |
88 | $master_out->set_raw(); |
89 | $master_err->set_raw(); | |
18d8c269 | 90 | $master_in->slave->set_raw(); |
a463aefa TR |
91 | $master_out->slave->set_raw(); |
92 | $master_err->slave->set_raw(); | |
18d8c269 PT |
93 | my $pid = start_child(\@ARGV, $master_in->slave, $master_out->slave, $master_err->slave); |
94 | close $master_in->slave; | |
e23f436c JK |
95 | close $master_out->slave; |
96 | close $master_err->slave; | |
18d8c269 | 97 | my $in_pid = copy_stdin($master_in); |
e23f436c | 98 | copy_stdio($master_out, $master_err); |
18d8c269 PT |
99 | my $ret = finish_child($pid); |
100 | # If the child process terminates before our copy_stdin() process is able to | |
101 | # write all of its data to $master_in, the copy_stdin() process could stall. | |
102 | # Send SIGTERM to it to ensure it terminates. | |
103 | kill 'TERM', $in_pid; | |
104 | finish_child($in_pid); | |
105 | exit($ret); |