t/test-terminal.perl

   1 #!/usr/bin/perl
   2 use 5.008;
   3 use strict;
   4 use warnings;
   5 use IO::Pty;
   6 use File::Copy;
   7
   8 # Run @$argv in the background with stdio redirected to $in, $out and $err.
   9 sub start_child {
  10         my ($argv, $in, $out, $err) = @_;
  11         my $pid = fork;
  12         if (not defined $pid) {
  13                 die "fork failed: $!"
  14         } elsif ($pid == 0) {
  15                 open STDIN, "<&", $in;
  16                 open STDOUT, ">&", $out;
  17                 open STDERR, ">&", $err;
  18                 close $in;
  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";
  36                 return $code + 128;
  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
  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
  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
  80 if ($#ARGV < 1) {
  81         die "usage: test-terminal program args";
  82 }
  83 $ENV{TERM} = 'vt100';
  84 my $parent_in = new IO::Pty;
  85 my $parent_out = new IO::Pty;
  86 my $parent_err = new IO::Pty;
  87 $parent_in->set_raw();
  88 $parent_out->set_raw();
  89 $parent_err->set_raw();
  90 $parent_in->slave->set_raw();
  91 $parent_out->slave->set_raw();
  92 $parent_err->slave->set_raw();
  93 my $pid = start_child(\@ARGV, $parent_in->slave, $parent_out->slave, $parent_err->slave);
  94 close $parent_in->slave;
  95 close $parent_out->slave;
  96 close $parent_err->slave;
  97 my $in_pid = copy_stdin($parent_in);
  98 copy_stdio($parent_out, $parent_err);
  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 $parent_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);