use
5.014000;
no
if
$] > 5.017011,
warnings
=>
'experimental::smartmatch'
;
our
$VERSION
=
'5999.000_005'
;
our
@EXPORT_OK
=
qw/prepare_files stopvms/
;
our
(
%vm
,
%pid
);
sub
runvm {
my
(
$name
,
$arg
) =
@_
;
return
unless
$ENV
{GRUNTMASTER_VM};
my
$cmd
=
$ENV
{GRUNTMASTER_VM};
$cmd
.=
' '
.
$arg
if
$arg
;
get_logger->trace(
"Starting VM $name ($cmd)"
);
$vm
{
$name
} = Expect->new;
$vm
{
$name
}->raw_pty(1);
$vm
{
$name
}->log_stdout(0);
$vm
{
$name
}->spawn(
$cmd
);
$vm
{
$name
}->expect(5,
'# '
) or get_logger->logdie(
"Error while starting VM $name: "
.
$vm
{
$name
}->error);
}
sub
stopvms {
kill
KILL
=>
$_
->pid
for
values
%vm
;
%vm
=
%pid
= ();
}
sub
execlist_finish {
my
(
$vm
,
$kill
) =
@_
;
if
(
$vm
{
$vm
}) {
warn
"Cannot kill VM\n"
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
);
get_logger->trace(
"Exec result from $vm: $excode $exmsg"
);
die
[
$excode
,
$exmsg
]
if
$excode
;
}
sub
execlist {
my
(
$vm
,
@args
) =
@_
;
my
$er
=
"exec-result-$vm"
;
if
(
$vm
{
$vm
}) {
my
$cmd
=
">$er "
. shell_quote
'gruntmaster-exec'
,
@args
;
get_logger->trace(
"Running in VM $vm: $cmd"
);
$vm
{
$vm
}->
send
(
$cmd
,
"\n"
);
}
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
;
}
}
}
sub
mkrun{
my
$format
=
shift
;
sub
{
local
*__ANON__
=
'mkrun_runner'
;
my
(
$name
,
%args
) =
@_
;
get_logger->trace(
"Running $name..."
);
my
$basename
= fileparse
$name
,
qr/[.][^.]*/
s;
my
@args
= (
'--sudo'
);
push
@args
,
'--keep-stderr'
if
$ENV
{TEST_VERBOSE};
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
$basename
,
@args
,
'--'
,
"./$basename"
, @{
$args
{args}};
execlist_finish
$basename
unless
$args
{nonblocking}
}
}
sub
prepare{
my
(
$name
,
$format
) =
@_
;
get_logger->trace(
"Preparing file $name..."
);
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"
}
finally
{
$Gruntmaster::Daemon::errors
.= read_file
'errors'
;
$Gruntmaster::Daemon::errors
.=
"\n"
if
-s
'errors'
;
unlink
'errors'
;
};
}
sub
prepare_files{
my
$meta
=
shift
;
if
(
$meta
->{runner} eq
'Interactive'
) {
runvm
ver
=>
'-serial unix:vm.sock,nowait,server'
;
runvm
prog
=>
'-serial unix:vm.sock,nowait'
;
}
else
{
runvm
$_
for
keys
%{
$meta
->{files}};
}
for
my
$file
(
values
%{
$meta
->{files}}) {
my
(
$format
,
$name
,
$content
) = @{
$file
}{
qw/format name content/
};
$file
->{run} = mkrun(
$format
);
write_file
$name
,
$content
;
if
(
$ENV
{GRUNTMASTER_CCACHE}) {
my
$key
=
lc
sha256_hex(
$content
) .
'-'
.
$format
;
my
$cachefn
=
"$ENV{GRUNTMASTER_CCACHE}/$key"
;
my
$exefn
= fileparse
$name
,
qr/[.][^.]*/
s;
if
(cp
$cachefn
,
$exefn
) {
get_logger->trace(
"File $name found in compilation cache"
)
}
else
{
prepare
$name
,
$format
;
cp
$exefn
,
$cachefn
}
}
else
{
prepare
$name
,
$format
}
}
}
1;