Merge branch 'master' of ssh://cpp/liblerdorf

ACU/API/Base.pm

@@ -46,6 +46,7 @@ sub parse($$)
 	$sax_handler = ProjectHandler->new($parsed);
     }
     $sax_handler = ProjectMemberHandler->new($parsed) if ($mod eq "ProjectMemberHandler");
+    $sax_handler = ProjectGroupHandler->new($parsed) if ($mod eq "ProjectGroupHandler");
 
     my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
 
@@ -234,4 +235,81 @@ sub end_element
     }
 }
 
+
+package ProjectGroupHandler;
+
+use v5.10.1;
+use strict;
+use warnings;
+
+sub new ($$)
+{
+    my $class = shift;
+    my $self = {
+	parsed => shift,
+	inStd => 0,
+	inResult => 0,
+	lastGroup => {},
+	values => ""
+    };
+
+    bless $self, $class;
+
+    return $self;
+}
+
+sub start_element
+{
+    my ($self, $element) = @_;
+
+    if ($element->{Name} eq "result") {
+	$self->{parsed}{result} = $self->{values};
+	$self->{inResult} = 0;
+	$self->{values} = "";
+    }
+    elsif ($element->{Name} eq "student")
+    {
+	$self->{inStd} = 1;
+	push @{ $self->{lastGroup}{stds} }, {
+	    id => $element->{Attributes}{"{}id"}{Value},
+	    chief => $element->{Attributes}{"{}chief"}{Value},
+	    login => "",
+	};
+    }
+    elsif ($element->{Name} eq "group")
+    {
+	$self->{lastGroup}{id} = $element->{Attributes}{"{}id"}{Value};
+	$self->{lastGroup}{stds} = [];
+    }
+}
+
+sub characters
+{
+    my ($self, $characters) = @_;
+
+    if ($self->{inStd}) {
+	$self->{values} .= $characters->{Data};
+    }
+}
+
+sub end_element
+{
+    my ($self, $element) = @_;
+
+    if ($element->{Name} eq "group")
+    {
+	push @{ $self->{parsed}{groups} }, $self->{lastGroup};
+	$self->{lastGroup} = {};
+
+	$self->{inStd} = 0;
+	$self->{values} = "";
+    }
+    elsif ($element->{Name} eq "student")
+    {
+	my $size = @{ $self->{lastGroup}{stds} };
+	(@{ $self->{lastGroup}{stds} })[$size - 1]{login} = $self->{values};
+	$self->{values} = "";
+    }
+}
+
 1;

ACU/API/Projects.pm

@@ -76,6 +76,28 @@ sub get_users($;$)
     return $res;
 }
 
+sub get_groups($;$)
+{
+    my $project_name = shift;
+    my $year = shift;
+
+    my $url;
+    if ($year) {
+	$url = "projects/groups/groups/$project_name/$year.xml";
+    } else {
+	$url = "projects/groups/groups/$project_name.xml";
+    }
+
+    my $res = API::Base::get('ProjectGroupHandler', $url);
+
+    #TODO: uncomment-me
+    #if ($res->{result} ne '0') {
+#	croak "Erreur durant la récupération : " . $res->{message};
+    #}
+
+    return $res;
+}
+
 sub add_grades($;$)
 {
     my %data = (

commands/first-install.sh

@@ -1,7 +1,7 @@
 #! /bin/bash
 
 # Install missing packages
-DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libmail-sendmail-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl"
+DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libmail-sendmail-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl"
 ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-simple perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin
 GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-Simple dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP"
 FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-Simple p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin"

commands/project/gen_git_str.pl

@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+
+use ACU::API::Projects;
+
+my $projid = $ARGV[0];
+my $year = $ARGV[1] // LDAP::get_year;
+
+my $res = API::Projects::get_groups($projid, $year);
+my $tag = "rendu-1";
+
+map {
+    my $chief;
+
+    # First, found the chief
+    for my $member (@{ $_->{stds} })
+    {
+	if ($member->{chief} eq "true" or $member->{chief} eq "1" or $member->{chief} eq "chief")
+	{
+	    $chief = $member;
+	    last;
+	}
+    }
+
+    say "repo $year/$projid/$chief->{login}";
+    print '     RW+   =   @admins';
+    for my $member (@{ $_->{stds} }) {
+	print ' '.$member->{login};
+    }
+    say "\n     R     =   \@chefs \@resp-$year-$projid";
+} @{ $res->{groups} };

process/files/intradata_get.pl

@@ -42,7 +42,7 @@ sub create_tree($$)
     croak "No directory for year $year. Ask a root to create it." if (! -d "$basedir/$year/");
 
     if (! -e "$basedir/$year/$project_id/") {
-	mkdir "$basedir/$year/$project_id/";
+	mkdir "$basedir/$year/$project_id/" or croak $!;
     }
 }
 
@@ -57,7 +57,7 @@ sub grades_generate
     croak "No project_id given." if (! $project_id);
 
     if (! -e "$basedir/$year/$project_id/grades/") {
-	mkdir "$basedir/$year/$project_id/grades/";
+	mkdir "$basedir/$year/$project_id/grades/" or croak $!;
     }
 
     log DEBUG, "Generate list of students";
@@ -149,10 +149,10 @@ sub grades_new_bonus
     croak "No project_id given" if (! $project_id);
 
     if (! -e "$basedir/$year/$project_id/traces/") {
-	mkdir "$basedir/$year/$project_id/traces/";
+	mkdir "$basedir/$year/$project_id/traces/" or croak $!;
     }
     if (! -e "$basedir/$year/$project_id/traces/bonus/") {
-	mkdir "$basedir/$year/$project_id/traces/bonus/";
+	mkdir "$basedir/$year/$project_id/traces/bonus/" or croak $!;
     }
 
     for my $kfile (keys %{ $args->{files} })
@@ -251,19 +251,19 @@ sub update_defense
     log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
 
     if (! -e "$basedir/$year/$project_id/defenses/") {
-	mkdir "$basedir/$year/$project_id/defenses/";
+	mkdir "$basedir/$year/$project_id/defenses/" or croak $!;
     }
     if (! -e "$basedir/$year/$project_id/traces/") {
-	mkdir "$basedir/$year/$project_id/traces/";
+	mkdir "$basedir/$year/$project_id/traces/" or croak $!;
     }
     if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
-	mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/";
+	mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!;
 	my ($login, $pass, $uid, $gid) = getpwnam("www-data");
-	chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/";
+	chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!;
-	chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/";
+	chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!;
     }
 
-    open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml";
+    open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or croak $!;
     print $out $defense;
     close $out;
 
@@ -322,11 +322,11 @@ sub update_trace
     log INFO, "Update $year/$project_id/traces/$rendu_id/$login.xml";
 
     if (! -e "$basedir/$year/$project_id/traces/") {
-	mkdir "$basedir/$year/$project_id/traces/";
+	mkdir "$basedir/$year/$project_id/traces/" or croak $!;
     }
     if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") {
-	mkdir "$basedir/$year/$project_id/traces/$rendu_id/";
+	mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!;
-	chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/";
+	chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!;
     }
 
     open my $out, ">", "$basedir/$year/$project_id/traces/$rendu_id/$login.xml" or croak("Unable to write to $rendu_id/$login.xml");

process/files/moulette_get.pl

@@ -4,6 +4,7 @@ use v5.10.1;
 use strict;
 use warnings;
 use threads;
+use threads::shared;
 use Carp;
 use File::Basename;
 use File::Copy;
@@ -22,8 +23,7 @@ my %actions = (
     "moulette" => \&moulette,
 );
 
-my $fm = new Sys::Gamin;
+my %monitored_dir = ();
-my %project_paths;
 
 sub jail_exec
 {
@@ -46,7 +46,7 @@ sub prepare_dir
     my $project_id = shift;
     my $rendu = shift;
 
-    my @dirs = ("/data/work/$year-$project_id-$rendu/", "/data/output/$year-$project_id-$rendu/");
+    my @dirs = ("/data/work/$year-$project_id-$rendu/", "/data/output/$year-$project_id-$rendu/", "/data/files/$year-$project_id-$rendu/");
 
     for my $dir (@dirs)
     {
@@ -82,11 +82,13 @@ sub receive_ref
     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];
+    my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2];
     copy("$tempdir/ref/ref.ff", "$destdir/ref.ff") or croak "An error occurs while coping ref.ff: $!";
 
     # Clean
     remove_tree($tempdir);
+
+    run_moulette($project_id, $year, $rendu);
 }
 
 sub receive_std
@@ -107,7 +109,7 @@ sub receive_std
 
     croak "An error occurs while extracting the tarball" if ($?);
 
-    my $destdir = ( prepare_dir($year, $project_id, $rendu) )[0];
+    my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2];
     fact_exec("package create '$tempdir' '$destdir/$login.ff'", $destdir);
     croak "Cannot create $login.ff" if ($?);
     chmod 0666, "$destdir/$login.ff";
@@ -139,7 +141,7 @@ sub create_testsuite
     jail_exec("gmake -C $tempdir/tests/");
     croak "An error occurs while making the testsuite" if ($?);
 
-    my $destdir = ( prepare_dir($year, $project_id, $rendu) )[0];
+    my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2];
     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";
@@ -158,17 +160,15 @@ sub run_moulette
     my $rendu = shift;
     my @logins = @_;
 
-    #TODO: find the right test dir, '' is most generic one
+    my ($workdir, $outputdir, $filesdir) = prepare_dir($year, $project_id, $rendu);
-    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: $!";
+	opendir(my $dh, $filesdir) or die "Can't list files in $filesdir: $!";
 	while (readdir($dh))
 	{
-	    if (/([a-zA-Z0-9_-]+).ff$/ && -f "$submitdir/$_" && ! /^tests\.ff$/) {
+	    if (/([a-zA-Z0-9_-]+).ff$/ && -f "$filesdir/$_" && ! /^tests\.ff$/) {
 		push @logins, $1;
 	    }
 	}
@@ -178,25 +178,19 @@ sub run_moulette
     for my $login (@logins)
     {
 	my $fhin;
-	if (-f "$testdir/$login.ft") {
+	if (-f "$filesdir/test.ft") {
-	    open $fhin, "<", "$testdir/$login.ft" or croak "Unable to open $testdir/$login.ft: $!";
+	    open $fhin, "<", "$filesdir/test.ft" or croak "Unable to open $filesdir/test.ft: $!";
-	} elsif (-f "$testdir/test.ft") {
-	    open $fhin, "<", "$testdir/test.ft" or croak "Unable to open $testdir/test.ft: $!";
-	}
-	#TODO: remove this
-	elsif (-f "$submit/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: $!";
+	    open my $fhout, ">", "$workdir/$login.ft" or croak "Unable to update $workdir/$login.ft file: $!";
 	    while (<$fhin>)
 	    {
 		$_ =~ s/#LOGIN_X/$login/g;
 		$_ =~ s%#GLOBAL%/data/global/%g;
-		$_ =~ s/#PROJECT/$testdir/g;
+		$_ =~ s/#PROJECT/$filesdir/g;
-		$_ =~ s/#SUBMIT/$submitdir/g;
+		$_ =~ s/#SUBMIT/$workdir/g;
 		$_ =~ s/#OUTPUT/$outputdir/g;
 		print $fhout $_;
 	    }
@@ -204,20 +198,19 @@ sub run_moulette
 	    close $fhout;
 	}
 
-	croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$submitdir/$login.ft");
+        copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannont copy $login.ff";
 
-	log WARN, "There is no ref for $project_id $rendu" if (! -f "$testdir/ref.ff");
+	croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$workdir/$login.ft");
-	log WARN, "There is no $login.ff for $project_id $rendu" if (! -f "$submitdir/$login.ff");
 
-	# Monitor the trace creation
+	log WARN, "There is no ref for $project_id $rendu" if (! -f "$filesdir/ref.ff");
-	if (! grep { $outputdir } %project_paths)
+	log WARN, "There is no $login.ff for $project_id $rendu" if (! -f "$workdir/$login.ff");
-	{
-	    $project_paths{$outputdir} = { "id" => $project_id, "year" => $year, "rendu" => $rendu };
-	    $fm->monitor($outputdir);
-	}
 
-	log INFO, "$submitdir/$login append to Fact manager";
+        unlink "$outputdir/$login.xml" if ( -f "$outputdir/$login.xml");
-	fact_exec("system manager $submitdir/$login.ft", $submitdir);
+
+        monitor_dir($outputdir, $project_id, $year, $rendu);
+
+	log INFO, "$workdir/$login.ft append to Fact manager";
+	fact_exec("system manager $workdir/$login.ft", $workdir);
 
 	log ERROR, "An error occurs while starting tests for $login on $year-$project_id-$rendu" if ($?);
     }
@@ -252,7 +245,9 @@ sub trace_send
     my $path = shift;
     my $filename = shift;
     my $login = shift;
-    my %infos = %{ $project_paths{ $path } };
+    my $id = shift;
+    my $year = shift;
+    my $rendu = shift;
 
     return if (! -f "$path/$filename");
 
@@ -268,9 +263,9 @@ sub trace_send
 	"intradata_get",
 	{ "type" => "trace",
 	  "action" => "update",
-	  "id" => $infos{id},
+	  "id" => $id,
-	  "year" => $infos{year},
+	  "year" => $year,
-	  "rendu" => $infos{rendu},
+	  "rendu" => $rendu,
 	  "login" => $login },
 	{ "$login.xml" => $file_content },
 	1
@@ -280,25 +275,42 @@ sub trace_send
     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
 {
+    my $dir = shift;
+    my $id = shift;
+    my $year = shift;
+    my $rendu = shift;
+    my $fm = new Sys::Gamin;
+    
+    log INFO, "Monitoring $dir";
+    $fm->monitor($dir);
+    while (1) {
+        my $event=$fm->next_event;
+        if (($event->type eq "create" || $event->type eq "change" || $event->type eq "exist") &&
+            $event->filename =~ /([^\/\\]+)\.xml$/ ) {
+            my $login = $event->filename;
+            $login =~ s/\.xml$//;
+            trace_send($dir, $event->filename, $login, $id, $year, $rendu);
+        }
+
+    }
+
     monitor_traces( $fm->next_event ) while (1);
 }
 
+sub monitor_dir
+{
+    my $dir = shift;
+    my $id = shift;
+    my $year = shift;
+    my $rendu = shift;
+
+    return if (exists ($monitored_dir{$dir}));
+    
+    $monitored_dir{$dir} = threads->create(\&monitor_start, $dir, $id, $year, $rendu);
+}
+
 sub process_get
 {
     my ($given_args, $args) = @_;
@@ -321,5 +333,4 @@ sub process_get
     return "Ok";
 }
 
-threads->create('monitor_start');
 Process::register("moulette_get", \&process_get);

process/launch.sh

@@ -6,7 +6,7 @@ GREP='/usr/bin/env grep -E'
 SCREEN='/usr/bin/env screen'
 SED='/usr/bin/env sed -E'
 if [ `uname -s` = "FreeBSD" ]; then
-    SU='/usr/bin/env su'
+    SU="/usr/bin/env su"
 else
     SU='/usr/bin/env su -s /bin/sh'
 fi
@@ -24,7 +24,12 @@ launch_screen()
 	CMD=". $TMP; ssh-add -l; echo; $CMD"
     fi
 
-    echo "$SCREEN -S '$1' -d -m bash -c '$CMD'" | $SU intradmin
+    if [ "$HOSTNAME" = "ksh" ]
+    then
+	$SCREEN -S "$1" -d -m sh -c "$CMD"
+    else
+	echo "$SCREEN -S '$1' -d -m sh -c '$CMD'" | $SU intradmin
+    fi
 
     if [ -f "$TMP" ]
     then

process/projects/get_csv.pl

@@ -82,7 +82,11 @@ sub process
 	{
 	    my $g = shift @ugrades;
 	    $out .= ",";
-	    $out .= $g if ($g && $g ne $header);
+	    if ($g && $g ne $header) {
+		$out .= $g;
+	    } else {
+		$out .= "0";
+	    }
 	}
 	$out .= "\n";
     }