moulette_get: Add jexec statements, monitor filesystem to send traces to intranet
This commit is contained in:
Mercier Pierre-Olivier
parent
4bff8d88eb
commit
335b03768d
1 changed files with 225 additions and 40 deletions
|
|
@ -3,11 +3,13 @@
|
|||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
#use threads;
|
||||
use Carp;
|
||||
use Pod::Usage;
|
||||
use File::Basename;
|
||||
use File::Copy;
|
||||
use File::Path qw(remove_tree);
|
||||
use File::Path qw(remove_tree mkpath);
|
||||
use File::Temp qw/tempfile tempdir/;
|
||||
use Sys::Gamin;
|
||||
|
||||
use ACU::Log;
|
||||
use ACU::Process;
|
||||
|
|
@ -16,24 +18,76 @@ my %actions = (
|
|||
"tar" => \&receive_tar,
|
||||
"git" => \&receive_git,
|
||||
|
||||
"ref" => \&receive_ref,
|
||||
"tests" => \&create_testsuite,
|
||||
"moulette" => \&moulette,
|
||||
);
|
||||
|
||||
my $fm = new Sys::Gamin;
|
||||
my %project_paths;
|
||||
|
||||
sub jail_exec
|
||||
{
|
||||
my $cmd = shift;
|
||||
|
||||
qx(jexec moulette1 /bin/sh -c "FACT='/usr/local/bin/mono /usr/local/fact/FactExe.exe' $cmd");
|
||||
croak "Erreur while executing '$cmd'" if ($?);
|
||||
}
|
||||
|
||||
sub fact_exec
|
||||
{
|
||||
my $cmd = shift;
|
||||
my $rundir = shift;
|
||||
jail_exec("cd $rundir && /usr/local/bin/mono /usr/local/fact/FactExe.exe $cmd");
|
||||
}
|
||||
|
||||
sub prepare_dir
|
||||
{
|
||||
my $year = shift;
|
||||
my $project_id = shift;
|
||||
my $rendu = shift;
|
||||
|
||||
# TODO: replace ~calvair by the destination directory
|
||||
my $dir = "~calvair/$year-$project_id-$rendu/";
|
||||
my @dirs = ("/data/work/$year-$project_id-$rendu/", "/data/output/$year-$project_id-$rendu/");
|
||||
|
||||
if (! -d $dir) {
|
||||
mkpath($destdir) or croak "An error occurs while creating directory: $!";
|
||||
for my $dir (@dirs)
|
||||
{
|
||||
if (! -d $dir) {
|
||||
mkpath($dir) or croak "An error occurs while creating directory: $!";
|
||||
}
|
||||
my ($login, $pass, $uid, $gid) = getpwnam("intradmin");
|
||||
chown $uid, $gid, $dir;
|
||||
chmod 0770, $dir;
|
||||
}
|
||||
|
||||
return $dir;
|
||||
return @dirs;
|
||||
}
|
||||
|
||||
sub receive_ref
|
||||
{
|
||||
my $args = shift;
|
||||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year};
|
||||
my $rendu = $args->{param}{rendu};
|
||||
my $file = $args->{param}{file};
|
||||
|
||||
croak "No file named '$file' given" if (!exists $args->{files}{$file});
|
||||
|
||||
my $tempdir = tempdir(DIR => '/data/tmp');
|
||||
|
||||
open my $fh, "|tar -xz -f - -C '$tempdir'";
|
||||
print $fh $args->{files}{$file};
|
||||
close $fh;
|
||||
|
||||
croak "An error occurs while extracting the tarball" if ($?);
|
||||
|
||||
jail_exec("gmake -C $tempdir/ref/ fact");
|
||||
croak "An error occurs while making the testsuite" if ($?);
|
||||
|
||||
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[0];
|
||||
copy("$tempdir/ref/ref.ff", "$destdir/ref.ff") or croak "An error occurs while coping ref.ff: $!";
|
||||
|
||||
# Clean
|
||||
remove_tree($tempdir);
|
||||
}
|
||||
|
||||
sub receive_tar
|
||||
|
|
@ -47,18 +101,21 @@ sub receive_tar
|
|||
|
||||
croak "No file named '$file' given" if (!exists $args->{files}{$file});
|
||||
|
||||
my ($fh, $filename) = tempfile(SUFFIX => $file);
|
||||
my ($fh, $filename) = tempfile(DIR => '/data/tmp', SUFFIX => $file);
|
||||
binmode($fh);
|
||||
print $fh $args->{files}{$file};
|
||||
close $fh;
|
||||
chmod 0644, $filename;
|
||||
|
||||
my $destdir = prepare_dir($year, $project_id, $file);
|
||||
# TODO: Call Fact for create .ff
|
||||
# qx(Fact package create $filename $destdir/$login.ff)
|
||||
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[0];
|
||||
fact_exec("package create $filename $destdir/$login.ff", $destdir);
|
||||
croak "Cannot create $login.ff" if ($?);
|
||||
chmod 0666, "$destdir/$login.ff";
|
||||
|
||||
# Clean
|
||||
unlink $filename;
|
||||
|
||||
run_moulette($project_id, $year, $rendu, $login);
|
||||
}
|
||||
|
||||
sub receive_git
|
||||
|
|
@ -72,20 +129,22 @@ sub receive_git
|
|||
|
||||
croak "No file named '$file' given" if (!exists $args->{files}{$file});
|
||||
|
||||
my $tempdir = tempdir();
|
||||
open my $fh, "|tar -xz -C '$tempdir'";
|
||||
my $tempdir = tempdir(DIR => '/data/tmp');
|
||||
open my $fh, "|tar -xz -f - -C '$tempdir'";
|
||||
print $fh $args->{files}{$file};
|
||||
close $fh;
|
||||
|
||||
croak "An error occurs while extracting the tarball" if ($?);
|
||||
|
||||
my $destdir = prepare_dir($year, $project_id, $file);
|
||||
# TODO: Call Fact for create .ff
|
||||
# qx(Fact package create $tempdir $destdir/$login.ff)
|
||||
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[0];
|
||||
fact_exec("package create $tempdir $destdir/$login.ff", $destdir);
|
||||
croak "Cannot create $login.ff" if ($?);
|
||||
chmod 0666, "$destdir/$login.ff";
|
||||
|
||||
# Clean
|
||||
remove_tree($tempdir);
|
||||
|
||||
run_moulette($project_id, $year, $rendu, $login);
|
||||
}
|
||||
|
||||
sub create_testsuite
|
||||
|
|
@ -98,52 +157,173 @@ sub create_testsuite
|
|||
|
||||
croak "No file named '$file' given" if (!exists $args->{files}{$file});
|
||||
|
||||
my $tempdir = tempdir();
|
||||
open my $fh, "|tar -xz -C '$tempdir'";
|
||||
my $tempdir = tempdir(DIR => '/data/tmp');
|
||||
|
||||
open my $fh, "|tar -xz -f - -C '$tempdir'";
|
||||
print $fh $args->{files}{$file};
|
||||
close $fh;
|
||||
|
||||
croak "An error occurs while extracting the tarball" if ($?);
|
||||
|
||||
qx(make -C $tempdir/tests/);
|
||||
jail_exec("gmake -C $tempdir/tests/");
|
||||
croak "An error occurs while making the testsuite" if ($?);
|
||||
|
||||
my $destdir = prepare_dir($year, $project_id, $rendu);
|
||||
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[0];
|
||||
copy("$tempdir/tests/tests.ff", "$destdir/tests.ff") or croak "An error occurs while coping the testsuite: $!";
|
||||
copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!";
|
||||
chmod 0660, "$destdir/tests.ff";
|
||||
chmod 0660, "$destdir/test.ft";
|
||||
|
||||
# Clean
|
||||
remove_tree($tempdir);
|
||||
|
||||
run_moulette($project_id, $year, $rendu);
|
||||
}
|
||||
|
||||
sub run_moulette
|
||||
{
|
||||
my $project_id = shift;
|
||||
my $year = shift;
|
||||
my $rendu = shift;
|
||||
my @logins = @_;
|
||||
|
||||
#TODO: find the right test dir, '' is most generic one
|
||||
my $testdir = ( prepare_dir($year, $project_id, "") )[0];
|
||||
my ($submitdir, $outputdir) = prepare_dir($year, $project_id, $rendu);
|
||||
|
||||
if ($#logins == -1)
|
||||
{
|
||||
# Get all submissions
|
||||
opendir(my $dh, $submitdir) or die "Can't list files in $submitdir: $!";
|
||||
while (readdir($dh))
|
||||
{
|
||||
if (/([a-zA-Z0-9_-]+).ff$/ && -f "$submitdir/$_") {
|
||||
push @logins, $1;
|
||||
}
|
||||
}
|
||||
closedir $dh;
|
||||
}
|
||||
|
||||
for my $login (@logins)
|
||||
{
|
||||
my $fhin;
|
||||
if (-f "$testdir/$login.ft") {
|
||||
open $fhin, "<", "$testdir/$login.ft" or croak "Unable to open $testdir/$login.ft: $!";
|
||||
} elsif (-f "$testdir/test.ft") {
|
||||
open $fhin, "<", "$testdir/test.ft" or croak "Unable to open $testdir/test.ft: $!";
|
||||
}
|
||||
|
||||
if ($fhin)
|
||||
{
|
||||
open my $fhout, ">", "$submitdir/$login.ft" or croak "Unable to update $submitdir/$login.ft file: $!";
|
||||
while (<$fhin>)
|
||||
{
|
||||
$_ =~ s/#LOGIN_X/$login/g;
|
||||
$_ =~ s%#GLOBAL%/data/global/%g;
|
||||
$_ =~ s/#PROJECT/$testdir/g;
|
||||
$_ =~ s/#SUBMIT/$submitdir/g;
|
||||
$_ =~ s/#OUTPUT/$outputdir/g;
|
||||
print $fhout $_;
|
||||
}
|
||||
close $fhin;
|
||||
close $fhout;
|
||||
}
|
||||
|
||||
croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$submitdir/$login.ft");
|
||||
|
||||
log WARN, "There is no ref for $project_id $rendu" if (! -f "$testdir/ref.ff");
|
||||
log WARN, "There is no $login.ff for $project_id $rendu" if (! -f "$submitdir/$login.ff");
|
||||
|
||||
# Monitor the trace creation
|
||||
if (! grep { $outputdir } %project_paths)
|
||||
{
|
||||
$project_paths{$outputdir} = { "id" => $project_id, "year" => $year, "rendu" => $rendu };
|
||||
$fm->monitor($outputdir);
|
||||
}
|
||||
|
||||
log INFO, "$submitdir/$login append to Fact manager";
|
||||
fact_exec("system manager $submitdir/$login.ft", $submitdir);
|
||||
|
||||
log ERROR, "An error occurs while starting tests for $login on $year-$project_id-$rendu" if ($?);
|
||||
}
|
||||
}
|
||||
|
||||
sub moulette
|
||||
{
|
||||
my $args = shift;
|
||||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year};
|
||||
my $rendu = $args->{param}{rendu};
|
||||
|
||||
my $testdir = prepare_dir($year, $project_id, $rendu);
|
||||
|
||||
chdir($testdir);
|
||||
for (my $i = $args->{unamed}; $i > 0; $i--)
|
||||
if ($args->{unamed} == 0)
|
||||
{
|
||||
my $login = $args->{param}{$i}
|
||||
|
||||
open my $fhin, "<", "$testdir/test.ft";
|
||||
open my $fhout, ">", "$testdir/$login.ft";
|
||||
print $fhout s/#LOGIN_X/$login/g while (<$fhin>);
|
||||
close $fhin;
|
||||
close $fhout;
|
||||
|
||||
# TODO: Call Fact to launch student tarball
|
||||
# qx(Fact system manager $login.ft)
|
||||
|
||||
log WARN, "An error occurs while starting tests for $login on $year-$project_id-$rendu" if ($?);
|
||||
# Run on all submissions
|
||||
run_moulette($args->{param}{id},
|
||||
$args->{param}{year},
|
||||
$args->{param}{rendu});
|
||||
}
|
||||
else
|
||||
{
|
||||
for (my $i = $args->{unamed}; $i > 0; $i--)
|
||||
{
|
||||
run_moulette($args->{param}{id},
|
||||
$args->{param}{year},
|
||||
$args->{param}{rendu},
|
||||
$args->{param}{$i});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub trace_send
|
||||
{
|
||||
my $path = shift;
|
||||
my $filename = shift;
|
||||
my $login = shift;
|
||||
my %infos = %{ $project_paths{ $path } };
|
||||
|
||||
return if (! -f "$path/$filename");
|
||||
|
||||
my $file_content;
|
||||
open my $fh, "<", "$path/$filename" or croak("Unable to read $path/$filename: $!");
|
||||
$file_content .= $_ while(<$fh>);
|
||||
close $fh;
|
||||
|
||||
log INFO, "Send trace from $path/$filename to intranet ...";
|
||||
|
||||
# Send trace over Gearman
|
||||
Process::Client::launch(
|
||||
"intradata_get",
|
||||
{ "type" => "trace",
|
||||
"action" => "update",
|
||||
"id" => $infos{id},
|
||||
"year" => $infos{year},
|
||||
"rendu" => $infos{rendu},
|
||||
"login" => $login },
|
||||
{ "$login.xml" => $file_content },
|
||||
1
|
||||
);
|
||||
|
||||
# Remove transfered trace
|
||||
unlink "$path/$filename";
|
||||
}
|
||||
|
||||
sub monitor_traces
|
||||
{
|
||||
my $event = shift;
|
||||
|
||||
log DEBUG, "Pathname: ".$event->filename." Event: ".$event->type." Where: ".$fm->which($event);
|
||||
|
||||
if (($event->type eq "create" || $event->type eq "change" || $event->type eq "exist") &&
|
||||
$event->filename =~ /([^\/\\]+)\.xml$/ &&
|
||||
grep { $fm->which($event) } %project_paths)
|
||||
{
|
||||
trace_send($fm->which($event), $event->filename, $1);
|
||||
}
|
||||
}
|
||||
|
||||
sub monitor_start
|
||||
{
|
||||
monitor_traces( $fm->next_event ) while (1);
|
||||
}
|
||||
|
||||
sub process_get
|
||||
{
|
||||
my ($given_args, $args) = @_;
|
||||
|
|
@ -157,7 +337,7 @@ sub process_get
|
|||
|
||||
eval {
|
||||
$actions{$type}($args);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
my $err = $@;
|
||||
log ERROR, $err;
|
||||
|
|
@ -166,4 +346,9 @@ sub process_get
|
|||
return "Ok";
|
||||
}
|
||||
|
||||
#threads->create('monitor_start');
|
||||
Process::register("moulette_get", \&process_get);
|
||||
|
||||
#$project_paths{'/data/output/2016-exam-c-0-rendu-1'} = { "id" => "exam-c-0", "year" => "2016", "rendu" => "rendu-1" };
|
||||
#$fm->monitor('/data/output/2016-exam-c-0-rendu-1');
|
||||
#monitor_start();
|
||||
|
|
|
|||
Reference in a new issue