From 614700357f0af54cdba3ac21b7420738bda2f3fe Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Wed, 5 Aug 2015 16:21:30 +0300 Subject: [PATCH] Improve Interactive runner --- Makefile.PL | 2 +- lib/Gruntmaster/Daemon/Format.pm | 57 ++++++++++++-------- lib/Gruntmaster/Daemon/Runner/Interactive.pm | 37 ++++++------- 3 files changed, 53 insertions(+), 43 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 99665a9..46c5cb5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -34,7 +34,7 @@ WriteMakefile( sigtrap 0 BSD::Resource 0 - Expect::Simple 0 + Expect 0 File::Slurp 0 Gruntmaster::Data 0 IPC::Signal 0 diff --git a/lib/Gruntmaster/Daemon/Format.pm b/lib/Gruntmaster/Daemon/Format.pm index 0a73611..4a57d6a 100644 --- a/lib/Gruntmaster/Daemon/Format.pm +++ b/lib/Gruntmaster/Daemon/Format.pm @@ -7,7 +7,7 @@ use parent qw/Exporter/; no if $] > 5.017011, warnings => 'experimental::smartmatch'; use Digest::SHA qw/sha256_hex/; -use Expect::Simple; +use Expect; use File::Basename qw/fileparse/; use File::Copy qw/cp/; use File::Slurp qw/read_file write_file/; @@ -21,7 +21,7 @@ our @EXPORT_OK = qw/prepare_files stopvms/; ################################################## -our (%vm); +our (%vm, %pid); sub runvm { my ($name, $arg) = @_; @@ -29,16 +29,36 @@ sub runvm { my $cmd = $ENV{GRUNTMASTER_VM}; $cmd .= ' ' . $arg if $arg; get_logger->trace("Starting VM $name ($cmd)"); - $vm{$name} = Expect::Simple->new({ - Cmd => $cmd, - Prompt => '# ', - DisconnectCmd => '/sbin/poweroff -fn', - RawPty => 1, - Timeout => 10, - }); + $vm{$name} = Expect->spawn($cmd); + $vm{$name}->raw_pty(1); + $vm{$name}->expect(5, '# ') or get_logger->logdie("Error while starting VM $name: ". $vm{$name}->error); } -sub stopvms { %vm = () } +sub stopvms { + kill KILL => $_->pid for values %vm; + %vm = %pid = (); +} + +sub execlist_finish { + my ($vm, $kill) = @_; + + if ($vm{$vm}) { + warn "Cannot kill VM" if $kill; + $vm{$vm}->expect(5, '# '); + } else { + kill KILL => $pid{$vm} if $kill; + waitpid $pid{$vm}, 0; + } + return if $kill; + + my $er = "exec-result-$vm"; + die "gruntmaster-exec died\n" if -z $er; + my ($excode, $exmsg) = read_file $er; + unlink $er; + chomp ($excode, $exmsg); ## no critic (ProhibitParensWithBuiltins) + get_logger->trace("Exec result from $vm: $excode $exmsg"); + die [$excode, $exmsg] if $excode; ## no critic (RequireCarping) +} sub execlist { my ($vm, @args) = @_; @@ -48,22 +68,13 @@ sub execlist { get_logger->trace("Running in VM $vm: $cmd"); $vm{$vm}->send($cmd); } else { - my $ret = fork // die "Cannot fork\n"; - if ($ret) { - waitpid $ret, 0; - } else { + $pid{$vm} = fork // die "Cannot fork\n"; + unless ($pid{$vm}) { open STDOUT, '>', $er or die "Cannot open $er\n"; get_logger->trace("Running: gruntmaster-exec @args"); exec 'gruntmaster-exec', @args; } } - - die "gruntmaster-exec died\n" if -z $er; - my ($excode, $exmsg) = read_file $er; - unlink $er; - chomp ($excode, $exmsg); ## no critic (ProhibitParensWithBuiltins) - get_logger->trace("Exec result: $excode $exmsg"); - die [$excode, $exmsg] if $excode; ## no critic (RequireCarping) } sub mkrun{ @@ -83,7 +94,8 @@ sub mkrun{ while (my ($fd, $file) = $it->()) { push @args, "--fd=$fd $file"; } - execlist $basename, @args, '--', "./$basename", @{$args{args}} + execlist $basename, @args, '--', "./$basename", @{$args{args}}; + execlist_finish $basename unless $args{nonblocking} } } @@ -93,6 +105,7 @@ sub prepare{ try { execlist prog => '--fd=1 >>errors', '--fd=2 >>errors', 'gruntmaster-compile', $format, $name; + execlist_finish 'prog'; } catch { my $exmsg = $_->[1]; die "Compile error ($exmsg)\n" diff --git a/lib/Gruntmaster/Daemon/Runner/Interactive.pm b/lib/Gruntmaster/Daemon/Runner/Interactive.pm index ed9a056..da51380 100644 --- a/lib/Gruntmaster/Daemon/Runner/Interactive.pm +++ b/lib/Gruntmaster/Daemon/Runner/Interactive.pm @@ -21,30 +21,27 @@ sub run{ mkfifo 'fifo1', 0600 or die "$!\n" unless -e 'fifo1'; mkfifo 'fifo2', 0600 or die "$!\n" unless -e 'fifo2'; - my $ret = fork // get_logger->logdie("Fork failed: $!"); - if ($ret) { - try { - my @fds = $ENV{GRUNTMASTER_VM} ? qw,0 /dev/ttyS1 1 >/dev/ttyS1, : qw/0 fifo1 1 >fifo2/; - $meta->{files}{prog}{run}->($meta->{files}{prog}{name}, fds => \@fds, map { $_ => $meta->{$_} } qw/timeout mlimit/); - } catch { - die $_ ## no critic (RequireCarping) - } finally { - waitpid $ret, 0; - }; - die [WA, 'Wrong Answer'] if $?; ## no critic (RequireCarping) - } else { - try { - my @fds = $ENV{GRUNTMASTER_VM} ? qw,1 >/dev/ttyS1 0 /dev/ttyS1, : qw/1 >fifo1 0 fifo2/; - $meta->{files}{ver}{run}->($meta->{files}{ver}{name}, fds => [@fds, qw,4 >result,], args => [$test], map { $_ => $meta->{$_} } qw/timeout mlimit/); - } catch { - exit 1; - }; - exit - } + my @fds = $ENV{GRUNTMASTER_VM} ? qw,0 /dev/ttyS1 1 >/dev/ttyS1, : qw/0 fifo1 1 >fifo2/; + $meta->{files}{prog}{run}->($meta->{files}{prog}{name}, nonblocking => 1, fds => \@fds, map { $_ => $meta->{$_} } qw/timeout mlimit/); + + my $fail; + @fds = $ENV{GRUNTMASTER_VM} ? qw,1 >/dev/ttyS1 0 /dev/ttyS1, : qw/1 >fifo1 0 fifo2/; + try { + $meta->{files}{ver}{run}->($meta->{files}{ver}{name}, fds => [@fds, qw,4 >result,], args => [$test], map { $_ => $meta->{$_} } qw/timeout mlimit/); + } catch { + $fail = [WA, 'Wrong Answer']; + }; + + try { + Gruntmaster::Daemon::Format::execlist_finish(prog => !$fail); + } catch { + $fail = $_; + }; unlink 'fifo1'; unlink 'fifo2'; + die $fail if $fail; ## no critic (RequireCarping) scalar slurp 'result' or 'Ok' } -- 2.39.2