Move some Format.pm code to gruntmaster-exec

[gruntmaster-daemon.git] / lib / Gruntmaster / Daemon / Format.pm

diff --git a/lib/Gruntmaster/Daemon/Format.pm b/lib/Gruntmaster/Daemon/Format.pm
index 5132fbd7387584d0f4ab8888a526e878c5f06ca3..93035ddc9d8c1337d4919578e0b2616f955ae07e 100644 (file)
--- a/lib/Gruntmaster/Daemon/Format.pm
+++ b/lib/Gruntmaster/Daemon/Format.pm
@@ -8,28 +8,45 @@ no if $] > 5.017011, warnings => 'experimental::smartmatch';
 
 use POSIX qw//;
 use File::Basename qw/fileparse/;
-use File::Slurp qw/write_file/;
+use File::Slurp qw/read_file write_file/;
 use Gruntmaster::Daemon::Constants qw/TLE OLE DIED NZX/;
 use Time::HiRes qw/alarm/;
 use List::MoreUtils qw/natatime/;
 use Log::Log4perl qw/get_logger/;
 use IPC::Signal qw/sig_name sig_num/;
+use Try::Tiny;
 
-our $VERSION = "5999.000_002";
+our $VERSION = "5999.000_004";
 our @EXPORT_OK = qw/prepare_files/;
 
 ##################################################
 
+sub execlist {
+       my (@args) = @_;
+       my $ret = fork // die 'Cannot fork';
+       if ($ret) {
+               waitpid $ret, 0;
+               die "gruntmaster-exec died\n" if -z 'exec-result';
+               my ($excode, $exmsg) = read_file 'exec-result';
+               unlink 'exec-result';
+               chomp ($excode, $exmsg);
+               die [$excode, $exmsg] if $excode > 0;
+       } else {
+               open STDOUT, '>exec-result';
+               exec 'gruntmaster-exec', @args;
+       }
+}
+
 sub command_and_args{
        my ($format, $basename) = @_;
 
        given($format) {
-               "./$basename" when [qw/C CPP PASCAL/];
+               "./$basename" when [qw/C CPP GCCGO GOLANG HASKELL PASCAL/];
                "./$basename.exe" when 'MONO';
                java => $basename when 'JAVA';
                perl => $basename when 'PERL';
                python => $basename when 'PYTHON';
-               default { die "Don't know how to execute format $format" }
+               default { die "Don't know how to execute format $format\n" }
        }
 }
 
@@ -40,35 +57,16 @@ sub mkrun{
                my ($name, %args) = @_;
                get_logger->trace("Running $name...");
                my $basename = fileparse $name, qr/\.[^.]*/;
-               my $ret = fork // die 'Cannot fork';
-               if ($ret) {
-                       my $tle;
-                       local $SIG{ALRM} = sub { kill KILL => $ret; $tle = 1};
-                       alarm $args{timeout} if exists $args{timeout};
-                       wait;
-                       alarm 0;
-                       my $sig = $? & 127;
-                       my $signame = sig_name $sig;
-                       die [TLE, "Time Limit Exceeded"] if $tle;
-                       die [OLE, 'Output Limit Exceeded'] if $sig && $signame eq 'XFSZ';
-                       die [DIED, "Crash (SIG$signame)"] if $sig && $signame != 'PIPE';
-                       die [NZX, "Non-zero exit status: " . ($? >> 8)] if $? >> 8;
-               } else {
-                       my @fds = exists $args{fds} ? @{$args{fds}} : ();
-                       $^F = 50;
-                       POSIX::close $_ for 0 .. $^F;
-                       my $it = natatime 2, @fds;
-                       while (my ($fd, $file) = $it->()) {
-                               open my $fh, $file or die $!;
-                               my $oldfd = fileno $fh;
-                               if ($oldfd != $fd) {
-                                       POSIX::dup2 $oldfd, $fd or die $!;
-                                       POSIX::close $oldfd or die $!;
-                               }
-                       }
-                       exec 'gruntmaster-exec', $args{mlimit} // 0, $args{olimit} // 0, command_and_args($format, $basename), exists $args{args} ? @{$args{args}} : ();
-                       exit 42
+               my @args;
+               push @args, '--timeout', $args{timeout} if $args{timeout};
+               push @args, '--mlimit',  $args{mlimit}  if $args{mlimit};
+               push @args, '--olimit',  $args{olimit}  if $args{olimit};
+               my @fds = exists $args{fds} ? @{$args{fds}} : ();
+               my $it = natatime 2, @fds;
+               while (my ($fd, $file) = $it->()) {
+                       push @args, "--fd=$fd $file";
                }
+               execlist @args, command_and_args($format, $basename);
        }
 }
 
@@ -76,15 +74,21 @@ sub prepare{
        my ($name, $format) = @_;
        get_logger->trace("Preparing file $name...");
 
-       $Gruntmaster::Daemon::errors .= `gruntmaster-compile $format $name 2>&1`;
-       $Gruntmaster::Daemon::errors .= "\n";
-       die 'Compile error' if $?
+       try {
+               execlist '--fd=1 >>errors', '--fd=2 >>errors', 'gruntmaster-compile', $format, $name;
+       } catch {
+               die "Compile error\n"
+       } finally {
+               $Gruntmaster::Daemon::errors .= read_file 'errors';
+               $Gruntmaster::Daemon::errors .= "\n";
+               unlink 'errors';
+       };
 }
 
 sub prepare_files{
        my $meta = shift;
 
-       for my $file (values $meta->{files}) {
+       for my $file (values %{$meta->{files}}) {
                my ($format, $name, $content) = @{$file}{qw/format name content/};
 
                $file->{run} = mkrun($format);