lib/Gruntmaster/Daemon/Format/CPP.pm

   1 package Gruntmaster::Daemon::Format::CPP;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6
   7 use BSD::Resource qw/setrlimit RLIMIT_AS RLIMIT_FSIZE/;
   8 use POSIX qw//;
   9 use File::Basename qw/fileparse/;
  10 use Gruntmaster::Daemon::Constants qw/TLE OLE DIED NZX/;
  11 use Log::Log4perl qw/get_logger/;
  12 use Time::HiRes qw/alarm/;
  13 use List::MoreUtils qw/natatime/;
  14 use IPC::Signal qw/sig_name sig_num/;
  15 use IPC::Open3 qw/open3/;
  16 use File::Spec::Functions qw/devnull/;
  17 use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/;
  18
  19 our $VERSION = '0.001';
  20
  21 ##################################################
  22
  23 sub prepare{
  24   my $name = $_[0];
  25   my $basename = fileparse $name, qr/\.[^.]*/;
  26   get_logger->trace("Preparing file $name...");
  27
  28   open my $devnull, devnull;
  29   open my $errors, '>compile-error';
  30   my $ret = open3 $devnull, $errors, $errors, 'g++', '-o', $basename, $name;
  31   local $SIG{ALRM} = sub {kill KILL => $ret};
  32   alarm 5;
  33   wait;
  34   close $devnull;
  35   close $errors;
  36   die 'Compile error' if $?
  37 }
  38
  39 sub run{
  40   my ($name, %args) = @_;
  41   my $basename = fileparse $name, qr/\.[^.]*/;
  42   my $ret = fork // die 'Cannot fork';
  43   if ($ret) {
  44         my $tle;
  45         local $SIG{ALRM} = sub { kill KILL => $ret; $tle = 1};
  46         alarm $args{timeout} if exists $args{timeout};
  47         wait;
  48         alarm 0;
  49         my $sig = $? & 127;
  50         my $signame = sig_name $sig;
  51         die [TLE, "Time Limit Exceeded"] if $tle;
  52         die [OLE, 'Output Limit Exceeded'] if $sig && $signame eq 'XFSZ';
  53         die [DIED, "Crash (SIG$signame)"] if $sig;
  54         die [NZX, "Non-zero exit status: " . ($? >> 8)] if $?;
  55   } else {
  56         $^F = 50;
  57         POSIX::close $_ for 0, 1, 3 .. $^F;
  58         my @fds = exists $args{fds} ? @{$args{fds}} : ();
  59         get_logger->trace("Running $basename with fds ". join ' ', @fds);
  60         my $it = natatime 2, @fds;
  61         while (my ($fd, $file) = $it->()) {
  62           open my $fh, $file or die $!;
  63           my $oldfd = fileno $fh;
  64           if ($oldfd != $fd) {
  65                 POSIX::dup2 $oldfd, $fd or die $!;
  66                 POSIX::close $oldfd or die $!;
  67           }
  68         }
  69 #       POSIX::close 2;
  70         setrlimit RLIMIT_AS, $args{mlimit}, $args{mlimit} if exists $args{mlimit};
  71         setrlimit RLIMIT_FSIZE, $args{olimit}, $args{olimit} if exists $args{olimit};
  72         exec "./$basename", exists $args{args} ? @{$args{args}} : ();
  73   }
  74 }
  75
  76 1