Commit 3a42544a authored by Guillaume Huard's avatar Guillaume Huard
Browse files

Rewrite of command execution and IO collection

parent be274a9d
......@@ -3,6 +3,9 @@ use strict;
use File::Slurp;
use Data::Dumper;
use Errno;
use IPC::Open3;
use Symbol 'gensym';
use Fcntl;
our %mode;
our %colors = (
......@@ -81,26 +84,48 @@ sub get_value($$$) {
}
# Reads a file up to a given limit, -1 if no limit
sub bounded_read_file($$) {
my $name = shift;
my $bound = shift;
my $size = ($bound == -1) ? 1024 : $bound;
open(my $fh, "<", $name) || error("Cannot read $name");
my $data;
my $offset = 0;
while ((my $number = read($fh, $data, $size, $offset)) != 0) {
if (defined($number)) {
$size -= $number if $bound != -1;
$offset += $number;
} else {
if (! $!{EINTR}) {
error("Error $! when reading");
}
}
}
close($fh);
return ($data, $size == 0);
}
# sub bounded_read_file($$) {
# my $name = shift;
# my $bound = shift;
# my $size = ($bound == -1) ? 1024 : $bound;
# open(my $fh, "<", $name) || error("Cannot read $name");
# my $data;
# my $offset = 0;
# while ((my $number = read($fh, $data, $size, $offset)) != 0) {
# if (defined($number)) {
# $size -= $number if $bound != -1;
# $offset += $number;
# } else {
# if (! $!{EINTR}) {
# error("Error $! when reading");
# }
# }
# }
# close($fh);
# return ($data, $size == 0);
# }
# Reads a file up to a given limit, -1 if no limit
# sub write_file($$) {
# my $name = shift;
# my $bound = shift;
# my $size = ($bound == -1) ? 1024 : $bound;
# open(my $fh, "<", $name) || error("Cannot read $name");
# my $data;
# my $offset = 0;
# while ((my $number = read($fh, $data, $size, $offset)) != 0) {
# if (defined($number)) {
# $size -= $number if $bound != -1;
# $offset += $number;
# } else {
# if (! $!{EINTR}) {
# error("Error $! when reading");
# }
# }
# }
# close($fh);
# return ($data, $size == 0);
# }
# Runs a command associated to a test with a given input, returns a hash that holds the content of standard output and error as well as exit code
# Looks at outputs_limit, timeout, debug, args and input in the test to find out how to run it (but they are not necessarily expected to exist)
......@@ -109,43 +134,125 @@ sub run_command($$$$) {
my $command = shift;
my $test = shift;
my $has_limits = shift;
my $arguments = " ";
my @arguments = ();
my $timeout;
chmod(0755, "$command") || error("Cannot make $command executable : $!".
(exists($test->{compile})?"":" (and no 'compile' directive found)"));
if (exists($test->{args})) {
for my $arg (@{$test->{args}}) {
$arg =~ s/"/\\"/g;
$arguments .= '"'.$arg.'" ';
}
@arguments = @{$test->{args}};
# for my $arg (@{$test->{args}}) {
# $arg =~ s/"/\\"/g;
# $arguments .= '"'.$arg.'" ';
# }
}
my $data = {};
my $input = get_value($test, 'input', "");
write_file(".internal_input.txt", $input) || error("Cannot write input file");
my $output_limit = -1;
my $error_limit = -1;
my $command_line = "$command$arguments >.internal_output.txt 2>.internal_error.txt <.internal_input.txt";
debug("Executing $command");
if ($has_limits) {
$output_limit = get_value($test, 'output_limit', 10*1024);
$error_limit = get_value($test, 'error_limit', 10*1024);
my $timeout = get_value($test, 'timeout', 10);
debug(" with output limited to ${output_limit} bytes, error limited to ${error_limit} bytes ".
$timeout = get_value($test, 'timeout', 10);
unshift @arguments, '-s9', $timeout, $command;
$command = 'timeout';
}
# create the process with open3 in order to store its outputs/errors in memory
my $child = {};
# error has to exists otherwise open3 merge output and error into the same stream
$child->{error} = gensym;
my $pid = open3($child->{input}, $child->{output}, $child->{error}, $command, @arguments) || error("Cannot exec $command, error $!\n");
my $remaining = {};
my $done = {};
my $data = {};
# We require non blocking IO to avoid deadlocks
for my $part ('input', 'output', 'error') {
# using select, it should not be necessary to make the file descriptor non blocking
# fcntl($child->{$part}, F_SETFL, O_NONBLOCK) || error("Cannot make $part descriptor non blocking");
if ($has_limits) {
$remaining->{$part} = get_value($test, "${part}_limit", 10*1024);
} else {
$remaining->{$part} = -1;
}
$done->{$part} = 0;
$data->{$part} = '';
}
$data->{input} = get_value($test, 'input', "");
$remaining->{input} = length($data->{input});
if ($has_limits) {
debug(" with output limited to $remaining->{output} bytes, error limited to $remaining->{error} bytes ".
"and timeout at ${timeout}s");
# $output_limit *= 1024 if $output_limit != -1;
# $error_limit *= 1024 if $error_limit != -1;
$command_line = "exec timeout -s9 $timeout $command_line";
}
debug("\n");
# debug("Executing: $command_line\n");
# we use select to perform I/Os with the child (still in order to avoid deadlocks)
my $sets = {};
my $left = 3;
$sets->{read} = $sets->{write} = $sets->{except} = '';
vec($sets->{write}, fileno($child->{input}), 1) = 1;
vec($sets->{read}, fileno($child->{output}), 1) = 1;
vec($sets->{read}, fileno($child->{error}), 1) = 1;
$sets->{except} = $sets->{read} | $sets->{write};
while ($left) {
my $avail = {};
my $nfound = select($avail->{read} = $sets->{read}, $avail->{write} = $sets->{write}, $avail->{except} = $sets->{except}, undef);
for my $part (keys(%$child)) {
my $fd = fileno($child->{$part});
my $set;
if ($part eq 'input') {
$set = 'write';
} else {
$set = 'read';
}
if (vec($avail->{$set}, $fd, 1) == 1) {
my $number;
my $size = $remaining->{$part};
$size = 1024 if $size == -1;
if ($part eq 'input') {
$number = syswrite($child->{$part}, $data->{$part}, $size, $done->{$part});
} else {
$number = sysread($child->{$part}, $data->{$part}, $size, $done->{$part});
}
if (!defined($number)) {
if ($!{EINTR} || $!{EAGAIN} || $!{EWOULDBLOCK}) {
debug("$set access to command temporarily failed for reason $!\n");
} else {
debug("Error $! during $set access to command $part through file descriptor $fd\n");
vec($sets->{$set}, $fd, 1) = 0;
$left--;
close($child->{$part});
delete($child->{$part});
}
} else {
if ($number) {
$remaining->{$part} -= $number unless $remaining->{$part} == -1;
$done->{$part} += $number;
}
if (!$number || !$remaining->{$part}) {
vec($sets->{$set}, $fd, 1) = 0;
$left--;
# debug("Closing $fd in set $set for part $part\n");
close($child->{$part});
delete($child->{$part});
}
if (!$remaining->{$part}) {
$data->{"${part}_bounded"} = 1;
}
}
}
# Actually in exceptional condition on OSX, better left ignored
# if (vec($avail->{except}, $fd, 1) == 1) {
# debug("Unexpected exceptionnal condition on command file descriptor for $part\n");
# }
}
}
delete($data->{input});
delete($data->{input_bounded});
waitpid($pid, 0) >= 0 || error("Wait for command termination failed\n");
# One should use the POSIX macros WIFEXITED, WEXITSTATUS, and so on, but it's too cumbersome
$data->{failure} = system($command_line);
$data->{failure} = $?;
$data->{signal} = $data->{failure} & 0xFF;
$data->{code} = $data->{failure} >> 8;
($data->{output}, $data->{output_bounded}) = bounded_read_file(".internal_output.txt", $output_limit);
($data->{error}, $data->{error_bounded}) = bounded_read_file(".internal_error.txt", $error_limit);
# debug("Result : ".Dumper($data));
remove(".internal_input.txt", ".internal_output.txt", ".internal_error.txt");
return $data;
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment