git

Форк
0
/t
/
test-terminal.perl 
82 строки · 1.8 Кб
1
#!/usr/bin/perl
2
use 5.008001;
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 $out and $err.
9
sub start_child {
10
	my ($argv, $out, $err) = @_;
11
	my $pid = fork;
12
	if (not defined $pid) {
13
		die "fork failed: $!"
14
	} elsif ($pid == 0) {
15
		open STDOUT, ">&", $out;
16
		open STDERR, ">&", $err;
17
		close $out;
18
		exec(@$argv) or die "cannot exec '$argv->[0]': $!"
19
	}
20
	return $pid;
21
}
22

23
# Wait for $pid to finish.
24
sub finish_child {
25
	# Simplified from wait_or_whine() in run-command.c.
26
	my ($pid) = @_;
27

28
	my $waiting = waitpid($pid, 0);
29
	if ($waiting < 0) {
30
		die "waitpid failed: $!";
31
	} elsif ($? & 127) {
32
		my $code = $? & 127;
33
		warn "died of signal $code";
34
		return $code + 128;
35
	} else {
36
		return $? >> 8;
37
	}
38
}
39

40
sub xsendfile {
41
	my ($out, $in) = @_;
42

43
	# Note: the real sendfile() cannot read from a terminal.
44

45
	# It is unspecified by POSIX whether reads
46
	# from a disconnected terminal will return
47
	# EIO (as in AIX 4.x, IRIX, and Linux) or
48
	# end-of-file.  Either is fine.
49
	copy($in, $out, 4096) or $!{EIO} or die "cannot copy from child: $!";
50
}
51

52
sub copy_stdio {
53
	my ($out, $err) = @_;
54
	my $pid = fork;
55
	defined $pid or die "fork failed: $!";
56
	if (!$pid) {
57
		close($out);
58
		xsendfile(\*STDERR, $err);
59
		exit 0;
60
	}
61
	close($err);
62
	xsendfile(\*STDOUT, $out);
63
	finish_child($pid) == 0
64
		or exit 1;
65
}
66

67
if ($#ARGV < 1) {
68
	die "usage: test-terminal program args";
69
}
70
$ENV{TERM} = 'vt100';
71
my $parent_out = new IO::Pty;
72
my $parent_err = new IO::Pty;
73
$parent_out->set_raw();
74
$parent_err->set_raw();
75
$parent_out->slave->set_raw();
76
$parent_err->slave->set_raw();
77
my $pid = start_child(\@ARGV, $parent_out->slave, $parent_err->slave);
78
close $parent_out->slave;
79
close $parent_err->slave;
80
copy_stdio($parent_out, $parent_err);
81
my $ret = finish_child($pid);
82
exit($ret);
83

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.