Merge branch 'master' of ssh://cpp/liblerdorf
This commit is contained in:
commit
6a81847871
|
@ -154,7 +154,7 @@ sub build_task_xml($;$)
|
|||
my $files = shift;
|
||||
|
||||
my $doc = XML::LibXML::Document->new('1.0');
|
||||
my $root = $doc->createElement("sync_ssh_keys");
|
||||
my $root = $doc->createElement("process");
|
||||
$doc->setDocumentElement( $root );
|
||||
|
||||
log TRACE, $params;
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
#! /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"
|
||||
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"
|
||||
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"
|
||||
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"
|
||||
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"
|
||||
|
||||
KERNEL=`uname -s`
|
||||
|
||||
|
|
39
commands/project/send_dir_to_moulette.sh
Executable file
39
commands/project/send_dir_to_moulette.sh
Executable file
|
@ -0,0 +1,39 @@
|
|||
#!/bin/sh
|
||||
|
||||
if [ "$#" -ne 3 ]
|
||||
then
|
||||
echo "Usage: $0 project rendu git_repo"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
project_id="$1"
|
||||
rendu="$2"
|
||||
git_repo="$3"
|
||||
|
||||
if ! whereis gearman > /dev/null 2> /dev/null
|
||||
then
|
||||
echo "gearman isn't installed on this machine. Please try another one."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ ! -d "$git_repo" ]; then
|
||||
ls "$git_repo"
|
||||
echo "$git_repo: file not found"
|
||||
exit 2
|
||||
fi
|
||||
|
||||
FILENAME=$(basename "$git_repo")
|
||||
FILE="<file name=\"$FILENAME\">$(tar -czf - -C "$git_repo" . | base64 )</file>"
|
||||
|
||||
cat <<EOF | gearman -h gearmand -p 4730 -f moulette_get
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<process>
|
||||
<param name="type">std</param>
|
||||
<param name="id">$project_id</param>
|
||||
<param name="year">2016</param>
|
||||
<param name="rendu">$rendu</param>
|
||||
<param name="login">$FILENAME</param>
|
||||
<param name="file">$FILENAME</param>
|
||||
$FILE
|
||||
</process>
|
||||
EOF
|
50
commands/project/send_trace.sh
Normal file
50
commands/project/send_trace.sh
Normal file
|
@ -0,0 +1,50 @@
|
|||
#!/bin/sh
|
||||
|
||||
if [ "$#" -ne 3 ]
|
||||
then
|
||||
echo "Usage: $0 project rendu [login] file"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
project_id="$1"
|
||||
rendu="$2"
|
||||
if [ -z "$4" ]
|
||||
then
|
||||
login=`basename $3`
|
||||
login="${login%%.xml}"
|
||||
file="$3"
|
||||
else
|
||||
login="$3"
|
||||
file="$4"
|
||||
fi
|
||||
|
||||
if ! whereis gearman > /dev/null 2> /dev/null
|
||||
then
|
||||
echo "gearman isn't installed on this machine. Please try another one."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if ! [ -f "$file" ]; then
|
||||
echo "$file: File not found"
|
||||
exit 2
|
||||
fi
|
||||
|
||||
if [ -z "$login" ]
|
||||
then
|
||||
FILENAME=$(basename "$file")
|
||||
else
|
||||
FILENAME="$login.xml"
|
||||
fi
|
||||
FILE="<file name=\"$FILENAME\">$(base64 $file)</file>"
|
||||
|
||||
cat <<EOF | gearman -h gearmand -p 4730 -f intradata_get
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<process>
|
||||
<param name="type">trace</param>
|
||||
<param name="id">$project_id</param>
|
||||
<param name="year">2016</param>
|
||||
<param name="rendu">$rendu</param>
|
||||
<param name="login">$login</param>
|
||||
$FILE
|
||||
</process>
|
||||
EOF
|
|
@ -13,23 +13,49 @@ my $ip = $1 if ($ENV{'SSH_CLIENT'} =~ m/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-
|
|||
|
||||
exit 0 if (!$ip);
|
||||
|
||||
log DEBUG, "Connection to $ENV{GL_REPO} from $ip";
|
||||
log DEBUG, "Connection with $ARGV[0] to $ENV{GL_REPO} from $ip";
|
||||
|
||||
my $promo = qx(git config hooks.promo);
|
||||
my $id_project = qx(git config hooks.idproject);
|
||||
my $repo_login = qx(git config hooks.repologin);
|
||||
|
||||
# First, check if the repository is in the YYYY/ directory
|
||||
exit 0 if ($ENV{GL_REPO} !~ /^2[0-9]{3}\/.+\/.+/);
|
||||
exit 0 if (($promo && $id_project && $repo_login) || $ENV{GL_REPO} !~ /^2[0-9]{3}\/.+\/.+/);
|
||||
|
||||
my ($ref, $oldsha, $newsha) = @ARGV;
|
||||
|
||||
$promo = $1 if (!$promo && $ENV{'GL_REPO'} =~ m/([0-9]{4}).*/);
|
||||
$id_project = $1 if (!$id_project && $ENV{'GL_REPO'} =~ m/.*\/(.*)\//);
|
||||
$repo_login = $1 if (!$repo_login && $ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/);
|
||||
|
||||
my $read = ($ARGV[0] =~ /R/);
|
||||
my $write = ($ARGV[0] =~ /W/);
|
||||
|
||||
say "Votre IP est : $ip.";
|
||||
|
||||
$ip = Net::IP->new($ip) or die ("IP invalide");
|
||||
|
||||
my $schoolnetwork = Net::IP->new('10.41.0.0/16');
|
||||
my $labnetwork = Net::IP->new('192.168.0.0/16');
|
||||
|
||||
if ($ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP)
|
||||
if ($ip->overlaps($labnetwork) == $IP_A_IN_B_OVERLAP)
|
||||
{
|
||||
exit 0;
|
||||
}
|
||||
#else
|
||||
#{
|
||||
# log ERROR, "Les dépôts Git sont en cours de maintenance, veuillez réessayer dans quelques minutes.";
|
||||
# exit 1;
|
||||
#}
|
||||
|
||||
my $schoolnetwork = Net::IP->new('10.41.0.0/16');
|
||||
#my $vjschoolnetwork = Net::IP->new('10.3.0.0/16');
|
||||
|
||||
if (
|
||||
$ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP
|
||||
# && $ip->overlaps($vjschoolnetwork) != $IP_A_IN_B_OVERLAP
|
||||
)
|
||||
{
|
||||
say "Votre IP est : ".$ip->ip();
|
||||
|
||||
log ERROR, "Vous n'êtes pas autorisé à envoyer vos modifications depuis cette IP." if ($write);
|
||||
log ERROR, "Vous n'êtes pas autorisé à accéder à ce dépôt depuis cette IP." if ($read);
|
||||
exit 1;
|
||||
|
@ -39,6 +65,8 @@ my $sshnetwork = Net::IP->new('10.41.253.0/24');
|
|||
|
||||
if ($ip->overlaps($sshnetwork) == $IP_A_IN_B_OVERLAP)
|
||||
{
|
||||
say "Votre IP est : ".$ip->ip();
|
||||
|
||||
log ERROR, "Vous n'êtes pas autorisé à envoyer vos modifications depuis cette IP." if ($write);
|
||||
log ERROR, "Vous n'êtes pas autorisé à accéder à ce dépôt depuis cette IP." if ($read);
|
||||
exit 1;
|
||||
|
|
|
@ -490,7 +490,7 @@ sub tag_ref
|
|||
$rendu = $_[2];
|
||||
}
|
||||
else {
|
||||
$rendu = "*";
|
||||
$rendu = "";
|
||||
}
|
||||
|
||||
my $year;
|
||||
|
@ -533,8 +533,7 @@ sub tag_ref
|
|||
# Send data to moulette
|
||||
log INFO, "Attente d'un processus de compilation...";
|
||||
if (my $err = Process::Client::launch("moulette_get", {
|
||||
type => "tar",
|
||||
login => "ref",
|
||||
type => "ref",
|
||||
id => $project_id,
|
||||
"year" => $year,
|
||||
"rendu" => $rendu,
|
||||
|
@ -597,13 +596,7 @@ sub tag_tests
|
|||
$project_id = lc $project_id;
|
||||
$project_id =~ s/[^a-z0-9-_]/_/g;
|
||||
|
||||
my $rendu;
|
||||
if ($_[2]) {
|
||||
$rendu = $_[2];
|
||||
}
|
||||
else {
|
||||
$rendu = "";
|
||||
}
|
||||
my $rendu = $_[2];
|
||||
|
||||
my $year;
|
||||
if ($_[3])
|
||||
|
|
|
@ -95,6 +95,21 @@ if ($ref =~ m<^refs/tags/(.+)$>)
|
|||
}
|
||||
else
|
||||
{
|
||||
eval {
|
||||
Process::Client::launch("send_git",
|
||||
{
|
||||
"year" => $promo,
|
||||
"id" => $id_project,
|
||||
"rendu" => $tag,
|
||||
"login" => $repo_login,
|
||||
"path" => $ENV{GL_REPO_BASE_ABS}."/".$ENV{GL_REPO},
|
||||
});
|
||||
};
|
||||
if ($@) {
|
||||
my $err = $@;
|
||||
log DEBUG, "ERROR: ".$err;
|
||||
}
|
||||
|
||||
# Send data to API
|
||||
my $last_commit = `git log $newsha -1 --decorate --tags`;
|
||||
eval {
|
||||
|
|
|
@ -6,25 +6,20 @@ then
|
|||
exit 1
|
||||
fi
|
||||
|
||||
clean_tex()
|
||||
tex2md()
|
||||
{
|
||||
for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png *.cls *.sty *.tex
|
||||
do
|
||||
if [ -f "$f" ]
|
||||
then
|
||||
git rm -f "$f" > /dev/null
|
||||
elif [ -d "$f" ]
|
||||
then
|
||||
git rm -fr "$f" > /dev/null
|
||||
fi
|
||||
done
|
||||
if [ -z "$1" ]
|
||||
then
|
||||
echo "tex2md: No argument given"
|
||||
exit 2
|
||||
fi
|
||||
DEST="$1"
|
||||
|
||||
cd include
|
||||
for i in `find -type f -name '*.tex'`
|
||||
do
|
||||
bi=`basename "$i"`
|
||||
echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m"
|
||||
|
||||
|
||||
sed -Ei 's/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i"
|
||||
sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
|
||||
sed -Ei 's/\\input *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
|
||||
|
@ -64,22 +59,20 @@ clean_tex()
|
|||
sed -Ei 's/\\frame//g' "$i"
|
||||
sed -Ei 's/\\item( *)<[^>]+>/\\item\1/g' "$i"
|
||||
|
||||
if pandoc -o ../${bi%%.tex}.md $i
|
||||
if pandoc -o "$DEST"/${bi%%.tex}.md $i
|
||||
then
|
||||
git add ../${bi%%.tex}.md
|
||||
git add "$DEST"/${bi%%.tex}.md
|
||||
git checkout "$i"
|
||||
git rm -f "$i" > /dev/null
|
||||
fi
|
||||
|
||||
sed -Ei 's/`%%([a-z-])\(([^)]+)\)`/%%\1(\2)/gi' "../${bi%%.tex}.md"
|
||||
sed -Ei 's/\\$/\n/' "../${bi%%.tex}.md"
|
||||
sed -Ei 's/`%%([a-z-])\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md"
|
||||
sed -Ei 's/\\$/\n/' "$DEST/${bi%%.tex}.md"
|
||||
done
|
||||
if [ `find | wc -l` -gt 1 ]
|
||||
then
|
||||
git mv * ..
|
||||
fi
|
||||
cd ..
|
||||
}
|
||||
|
||||
maintex2md()
|
||||
{
|
||||
if [ -f "mySubject.md" ]
|
||||
then
|
||||
git mv "mySubject.md" "main.md"
|
||||
|
@ -93,8 +86,57 @@ clean_tex()
|
|||
then
|
||||
git mv "myTutorial.md" "main.md"
|
||||
fi
|
||||
}
|
||||
|
||||
rmdir include
|
||||
clean_tex()
|
||||
{
|
||||
if [ -z "$1" ] || ! [ -d "$1" ]
|
||||
then
|
||||
echo "NON"
|
||||
exit 1;
|
||||
fi
|
||||
|
||||
for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png *.cls *.sty *.tex
|
||||
do
|
||||
if [ -f "$f" ]
|
||||
then
|
||||
git rm -f "$f" > /dev/null
|
||||
elif [ -d "$f" ]
|
||||
then
|
||||
git rm -fr "$f" > /dev/null
|
||||
fi
|
||||
done
|
||||
|
||||
if [ -d "include" ]
|
||||
then
|
||||
cd include
|
||||
tex2md ..
|
||||
|
||||
if [ `find | wc -l` -gt 1 ]
|
||||
then
|
||||
git mv * ..
|
||||
fi
|
||||
|
||||
cd "$1"
|
||||
tex2md .
|
||||
maintex2md
|
||||
rmdir include 2> /dev/null
|
||||
elif [ `find -mindepth 1 -maxdepth 1 -name '*.tex' | wc -l` -gt 0 ]
|
||||
then
|
||||
tex2md .
|
||||
|
||||
else
|
||||
for i in *
|
||||
do
|
||||
if [ -d "$i" ]
|
||||
then
|
||||
echo -e "\e[1;32m>>>\e[1;37m Subsubject found: $i\e[0m"
|
||||
cd "$i"
|
||||
clean_tex "$1/$i" "$1"
|
||||
fi
|
||||
done
|
||||
fi
|
||||
cd "$2"
|
||||
}
|
||||
|
||||
TMPDIR=`mktemp -d`
|
||||
|
@ -124,9 +166,9 @@ then
|
|||
exit 4
|
||||
fi
|
||||
|
||||
cd ..
|
||||
cd - > /dev/null
|
||||
|
||||
rm -rf "$1"
|
||||
mv "$1" "$1.hg"
|
||||
|
||||
git clone "$TMPDIR/repo.git" "$1"
|
||||
|
||||
|
@ -207,13 +249,13 @@ do
|
|||
do
|
||||
if [ -f "$D/template.xml" ]
|
||||
then
|
||||
`dirname $0`/defense_converter.pl -o "$D.xml" "$D/template.xml"
|
||||
perl `dirname $0`/defense_converter.pl -o "$D.xml" "$D/template.xml"
|
||||
git add "$D.xml"
|
||||
echo -e "\e[1;35m>>>\e[1;37m Defense converted:\e[0m $D"
|
||||
fi
|
||||
git rm -rf "$D" > /dev/null
|
||||
done
|
||||
cd ..
|
||||
cd - > /dev/null
|
||||
echo -e "\e[1;35m## ## ## ## ##\e[0m"
|
||||
echo
|
||||
|
||||
|
@ -242,8 +284,7 @@ do
|
|||
then
|
||||
echo -e "\e[1;32m##\e[1;37m Find directory $DIR with some .tex files \e[1;32m##\e[0m"
|
||||
cd "$DIR"
|
||||
clean_tex "$DIR"
|
||||
cd ..
|
||||
clean_tex `pwd` `readlink -f "$(pwd)/.."`
|
||||
echo -e "\e[1;32m## ## ## ## ##\e[0m"
|
||||
echo
|
||||
|
||||
|
@ -270,7 +311,7 @@ do
|
|||
git rm -rf "$f" > /dev/null
|
||||
fi
|
||||
done
|
||||
cd ..
|
||||
cd - > /dev/null
|
||||
fi
|
||||
done
|
||||
|
||||
|
|
|
@ -28,7 +28,10 @@ my %actions = (
|
|||
"create" => \&update_project,
|
||||
"update" => \&update_project,
|
||||
"delete" => \&delete_project,
|
||||
}
|
||||
},
|
||||
"trace" => {
|
||||
"update" => \&update_trace,
|
||||
},
|
||||
);
|
||||
|
||||
sub create_tree($$)
|
||||
|
@ -36,16 +39,11 @@ sub create_tree($$)
|
|||
my $year = shift;
|
||||
my $project_id = shift;
|
||||
|
||||
if (! -d "$basedir/$year/") {
|
||||
log ERROR, "No directory for year $year. Ask a root to create it.";
|
||||
return "No directory for year $year. Ask a root to create it.";
|
||||
}
|
||||
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/";
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
@ -56,10 +54,7 @@ sub grades_generate
|
|||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
if (! $project_id) {
|
||||
log ERROR, "No project_id given.";
|
||||
return "No project_id given";
|
||||
}
|
||||
croak "No project_id given." if (! $project_id);
|
||||
|
||||
if (! -e "$basedir/$year/$project_id/grades/") {
|
||||
mkdir "$basedir/$year/$project_id/grades/";
|
||||
|
@ -102,10 +97,7 @@ sub grades_generate
|
|||
if (exists $args->{files}{"grading.xml"}) {
|
||||
$grading = $args->{files}{"grading.xml"};
|
||||
}
|
||||
if (! $grading) {
|
||||
log ERROR, "Invalid grading.xml received!";
|
||||
return "Invalid grading.xml received!";
|
||||
}
|
||||
croak "Invalid grading.xml received!" if (! $grading);
|
||||
|
||||
$grading = Grading->new($grading);
|
||||
|
||||
|
@ -143,7 +135,7 @@ sub grades_generate
|
|||
$grading->reset();
|
||||
}
|
||||
|
||||
return "Ok";
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub grades_new_bonus
|
||||
|
@ -154,10 +146,7 @@ sub grades_new_bonus
|
|||
my $delete = $args->{param}{delete};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
if (! $project_id) {
|
||||
log ERROR, "No project_id given.";
|
||||
return "No project_id given";
|
||||
}
|
||||
croak "No project_id given" if (! $project_id);
|
||||
|
||||
if (! -e "$basedir/$year/$project_id/traces/") {
|
||||
mkdir "$basedir/$year/$project_id/traces/";
|
||||
|
@ -237,7 +226,7 @@ sub grades_new_bonus
|
|||
}
|
||||
}
|
||||
|
||||
return "Ok";
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub update_defense
|
||||
|
@ -247,26 +236,17 @@ sub update_defense
|
|||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
if (! $project_id) {
|
||||
log ERROR, "No project_id given.";
|
||||
return "No project_id given";
|
||||
}
|
||||
croak "No project_id given" if (! $project_id);
|
||||
|
||||
my $defense_id = $args->{param}{defense_id};
|
||||
|
||||
if (! $defense_id) {
|
||||
log ERROR, "No defense_id given.";
|
||||
return "No defense_id given";
|
||||
}
|
||||
croak "No defense_id given" if (! $defense_id);
|
||||
|
||||
my $defense;
|
||||
if (exists $args->{files}{"$defense_id.xml"}) {
|
||||
$defense = $args->{files}{"$defense_id.xml"};
|
||||
}
|
||||
if (! $defense) {
|
||||
log ERROR, "Invalid $defense_id.xml received!";
|
||||
return "Invalid $defense_id.xml received!";
|
||||
}
|
||||
croak "Invalid $defense_id.xml received!" if (! $defense);
|
||||
|
||||
log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
|
||||
|
||||
|
@ -287,7 +267,7 @@ sub update_defense
|
|||
print $out $defense;
|
||||
close $out;
|
||||
|
||||
return "Ok";
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub update_project
|
||||
|
@ -297,29 +277,63 @@ sub update_project
|
|||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
if (! $project_id) {
|
||||
log ERROR, "No project_id given.";
|
||||
return "No project_id given";
|
||||
}
|
||||
croak "No project_id given" if (! $project_id);
|
||||
|
||||
my $butler;
|
||||
if (exists $args->{files}{"butler.xml"}) {
|
||||
$butler = $args->{files}{"butler.xml"};
|
||||
}
|
||||
if (! $butler) {
|
||||
log ERROR, "Invalid butler.xml received!";
|
||||
return "Invalid butler.xml received!";
|
||||
}
|
||||
croak "Invalid butler.xml received!" if (! $butler);
|
||||
|
||||
log INFO, "Update $year/$project_id/butler.xml";
|
||||
|
||||
return $_ if (create_tree($year, $project_id));
|
||||
create_tree($year, $project_id);
|
||||
|
||||
open my $out, ">", "$basedir/$year/$project_id/butler.xml";
|
||||
print $out $butler;
|
||||
close $out;
|
||||
|
||||
return "Ok";
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub update_trace
|
||||
{
|
||||
my $args = shift;
|
||||
|
||||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
croak "No project_id given" if (! $project_id);
|
||||
|
||||
my $rendu_id = $args->{param}{rendu};
|
||||
|
||||
croak "No rendu_id given" if (! $rendu_id);
|
||||
|
||||
my $login = $args->{param}{login};
|
||||
|
||||
croak "No login given" if (! $login);
|
||||
|
||||
my $trace;
|
||||
if (exists $args->{files}{"$login.xml"}) {
|
||||
$trace = $args->{files}{"$login.xml"};
|
||||
}
|
||||
croak "Invalid $login.xml received!" if (! $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/";
|
||||
}
|
||||
if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") {
|
||||
mkdir "$basedir/$year/$project_id/traces/$rendu_id/";
|
||||
chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/";
|
||||
}
|
||||
|
||||
open my $out, ">", "$basedir/$year/$project_id/traces/$rendu_id/$login.xml" or croak("Unable to write to $rendu_id/$login.xml");
|
||||
print $out $trace;
|
||||
close $out;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub delete_project
|
||||
|
@ -335,12 +349,18 @@ sub process_get
|
|||
my $type = $args->{param}{type};
|
||||
my $action = $args->{param}{action} // "update";
|
||||
|
||||
if (! exists $actions{$type}{$action}) {
|
||||
log WARN, "Unknown action '$action' for $type.";
|
||||
return "Unknown action '$action' for $type.";
|
||||
}
|
||||
croak "Unknown action '$action' for $type." if (! exists $actions{$type}{$action});
|
||||
|
||||
eval {
|
||||
$actions{$type}{$action}($args);
|
||||
};
|
||||
if ($@) {
|
||||
my $err = $@;
|
||||
log ERROR, $err;
|
||||
return $err;
|
||||
}
|
||||
return "Ok";
|
||||
|
||||
return $actions{$type}{$action}($args);
|
||||
}
|
||||
|
||||
Process::register("intradata_get", \&process_get);
|
||||
|
|
|
@ -3,91 +3,121 @@
|
|||
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;
|
||||
|
||||
my %actions = (
|
||||
"tar" => \&receive_tar,
|
||||
"git" => \&receive_git,
|
||||
"std" => \&receive_std, #STuDent
|
||||
"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_tar
|
||||
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};
|
||||
my $login = $args->{param}{login} // "ref";
|
||||
|
||||
croak "No file named '$file' given" if (!exists $args->{files}{$file});
|
||||
|
||||
my ($fh, $filename) = tempfile(SUFFIX => $file);
|
||||
binmode($fh);
|
||||
print $fh $args->{files}{$file};
|
||||
close $fh;
|
||||
my $tempdir = tempdir(DIR => '/data/tmp');
|
||||
|
||||
my $destdir = prepare_dir($year, $project_id, $file);
|
||||
# TODO: Call Fact for create .ff
|
||||
# qx(Fact package create $filename $destdir/$login.ff)
|
||||
croak "Cannot create $login.ff" if ($?);
|
||||
|
||||
# Clean
|
||||
unlink $filename;
|
||||
}
|
||||
|
||||
sub receive_git
|
||||
{
|
||||
my $args = shift;
|
||||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year};
|
||||
my $rendu = $args->{param}{rendu};
|
||||
my $file = $args->{param}{file};
|
||||
my $login = $args->{param}{login} // "ref";
|
||||
|
||||
croak "No file named '$file' given" if (!exists $args->{files}{$file});
|
||||
|
||||
my $tempdir = tempdir();
|
||||
open my $fh, "|tar -xz -C '$tempdir'";
|
||||
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)
|
||||
croak "Cannot create $login.ff" 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_std
|
||||
{
|
||||
my $args = shift;
|
||||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year};
|
||||
my $rendu = $args->{param}{rendu};
|
||||
my $file = $args->{param}{file};
|
||||
my $login = $args->{param}{login} // "ref";
|
||||
|
||||
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 ($?);
|
||||
|
||||
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
|
||||
{
|
||||
my $args = shift;
|
||||
|
@ -98,52 +128,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 +308,7 @@ sub process_get
|
|||
|
||||
eval {
|
||||
$actions{$type}($args);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
my $err = $@;
|
||||
log ERROR, $err;
|
||||
|
@ -166,4 +317,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();
|
||||
|
|
52
process/files/send_git.pl
Normal file
52
process/files/send_git.pl
Normal file
|
@ -0,0 +1,52 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use v5.10;
|
||||
use File::Path qw(remove_tree);
|
||||
use File::Temp qw/tempfile tempdir/;
|
||||
|
||||
use ACU::Log;
|
||||
use ACU::Process;
|
||||
|
||||
|
||||
sub process
|
||||
{
|
||||
my ($given_args, $args) = @_;
|
||||
|
||||
my $year = $args->{param}{year};
|
||||
my $project_id = $args->{param}{id};
|
||||
my $rendu = $args->{param}{rendu};
|
||||
my $login = $args->{param}{login};
|
||||
|
||||
my $path = $args->{param}{path} // "/srv/git/repositories/$year/$project_id/$login.git";
|
||||
|
||||
return "$path is not a valid path." if (! -d $path);
|
||||
|
||||
my $tempdir = tempdir();
|
||||
|
||||
qx/git clone -b '$rendu' '$path' '$tempdir'/;
|
||||
|
||||
my $tar;
|
||||
open my $fh, "tar -czf - -C '$tempdir' . |";
|
||||
$tar .= $_ while(<$fh>);
|
||||
close $fh;
|
||||
|
||||
# Clean
|
||||
remove_tree($tempdir);
|
||||
|
||||
return Process::Client::launch("moulette_get",
|
||||
{
|
||||
"type" => "std",
|
||||
"id" => $project_id,
|
||||
"year" => $year,
|
||||
"rendu" => $rendu,
|
||||
"login" => $login,
|
||||
"file" => "rendu.tgz"
|
||||
},
|
||||
{
|
||||
"rendu.tgz" => $tar
|
||||
});
|
||||
}
|
||||
|
||||
Process::register("send_git", \&process);
|
|
@ -69,6 +69,7 @@ then
|
|||
|
||||
hamano)
|
||||
launch_screen "lerdorf_process_ldap_sync_ssh_keys_git" "while true; do $PERL ~/liblerdorf/process/ldap/sync_ssh_keys_git.pl; done" ~intradmin/.ssh/git
|
||||
launch_screen "lerdorf_process_send_git" "while true; do $PERL ~/liblerdorf/process/files/send_git.pl; done"
|
||||
;;
|
||||
|
||||
moore)
|
||||
|
|
|
@ -36,61 +36,67 @@ sub process
|
|||
my $grade = Grading->new();
|
||||
|
||||
my @defenses;
|
||||
# Create defenses groups
|
||||
opendir(my $dh, "$basedir/$year/$project_id/defenses/") or croak "can't opendir $basedir/$year/$project_id/defenses/: $!";
|
||||
for my $sout (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/defenses/$_" } readdir($dh))
|
||||
{
|
||||
my $sid;
|
||||
($sid = $sout) =~ s/\.xml$//;
|
||||
push @defenses, $sid;
|
||||
|
||||
open my $xml, "<", "$basedir/$year/$project_id/defenses/$sout" or die $!;
|
||||
binmode $xml;
|
||||
|
||||
my $str;
|
||||
$str .= $_ while (<$xml>);
|
||||
|
||||
my $defense = Defense->new($str);
|
||||
|
||||
my $ids = $defense->getIds();
|
||||
|
||||
my @keys = keys %$ids;
|
||||
my $def_i = $keys[0];
|
||||
$def_i =~ s/^(.+)g.*$/$1/;
|
||||
|
||||
$ids->{$def_i.'_end_$LOGIN'} = undef;
|
||||
$ids->{$def_i.'_end_group'} = undef;
|
||||
|
||||
$grade->create_from_ids($sid, $ids);
|
||||
}
|
||||
closedir $dh;
|
||||
|
||||
# Create traces groups
|
||||
opendir($dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!";
|
||||
for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh))
|
||||
if (-d "$basedir/$year/$project_id/defenses/")
|
||||
{
|
||||
next if (grep { $dir eq "defense_$_" } @defenses);
|
||||
# Create defenses groups
|
||||
opendir(my $dh, "$basedir/$year/$project_id/defenses/") or croak "can't opendir $basedir/$year/$project_id/defenses/: $!";
|
||||
for my $sout (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/defenses/$_" } readdir($dh))
|
||||
{
|
||||
my $sid;
|
||||
($sid = $sout) =~ s/\.xml$//;
|
||||
push @defenses, $sid;
|
||||
|
||||
my $ids = {};
|
||||
|
||||
opendir(my $dhm, "$basedir/$year/$project_id/traces/$dir") or croak "can't opendir $basedir/$year/$project_id/traces/$dir: $!";
|
||||
for my $login (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/traces/$dir/$_" } readdir($dhm))
|
||||
{
|
||||
open my $xml, "<", "$basedir/$year/$project_id/traces/$dir/$login" or die $!;
|
||||
open my $xml, "<", "$basedir/$year/$project_id/defenses/$sout" or die $!;
|
||||
binmode $xml;
|
||||
|
||||
my $trace = Trace->new($xml);
|
||||
my $str;
|
||||
$str .= $_ while (<$xml>);
|
||||
|
||||
my %tids = %{ $trace->getIds() };
|
||||
for my $kid (keys %tids)
|
||||
{
|
||||
$ids->{ $kid } = $tids{ $kid };
|
||||
}
|
||||
my $defense = Defense->new($str);
|
||||
|
||||
my $ids = $defense->getIds();
|
||||
|
||||
my @keys = keys %$ids;
|
||||
my $def_i = $keys[0];
|
||||
$def_i =~ s/^(.+)g.*$/$1/;
|
||||
|
||||
$ids->{$def_i.'_end_$LOGIN'} = undef;
|
||||
$ids->{$def_i.'_end_group'} = undef;
|
||||
|
||||
$grade->create_from_ids($sid, $ids);
|
||||
}
|
||||
|
||||
$grade->create_from_ids($dir, $ids);
|
||||
closedir $dh;
|
||||
}
|
||||
|
||||
if (-d "$basedir/$year/$project_id/traces/")
|
||||
{
|
||||
# Create traces groups
|
||||
opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!";
|
||||
for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh))
|
||||
{
|
||||
next if (grep { $dir eq "defense_$_" } @defenses);
|
||||
|
||||
my $ids = {};
|
||||
|
||||
opendir(my $dhm, "$basedir/$year/$project_id/traces/$dir") or croak "can't opendir $basedir/$year/$project_id/traces/$dir: $!";
|
||||
for my $login (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/traces/$dir/$_" } readdir($dhm))
|
||||
{
|
||||
open my $xml, "<", "$basedir/$year/$project_id/traces/$dir/$login" or die $!;
|
||||
binmode $xml;
|
||||
|
||||
my $trace = Trace->new($xml);
|
||||
|
||||
my %tids = %{ $trace->getIds() };
|
||||
for my $kid (keys %tids)
|
||||
{
|
||||
$ids->{ $kid } = $tids{ $kid };
|
||||
}
|
||||
}
|
||||
|
||||
$grade->create_from_ids($dir, $ids);
|
||||
}
|
||||
closedir $dh;
|
||||
}
|
||||
closedir $dh;
|
||||
|
||||
return $grade->toString;
|
||||
}
|
||||
|
|
441
utils/lpt
441
utils/lpt
|
@ -76,7 +76,6 @@ my %cmds_account =
|
|||
"services" => \&cmd_account_services,
|
||||
"shell" => \&cmd_account_shell,
|
||||
"view" => \&cmd_account_view,
|
||||
"view" => \&cmd_account_view,
|
||||
|
||||
"grant-intra" => \&cmd_account_grantintra,
|
||||
"grant-lab" => \&cmd_account_grantlab,
|
||||
|
@ -85,9 +84,9 @@ my %cmds_account =
|
|||
|
||||
my %cmds_group =
|
||||
(
|
||||
"list" => \&cmd_group_list,
|
||||
"add" => \&cmd_group_add,
|
||||
"remove" => \&cmd_group_remove,
|
||||
"view" => \&cmd_group_view,
|
||||
"members" => \&cmd_group_members,
|
||||
"rights" => \&cmd_group_rights,
|
||||
"create" => \&cmd_group_create,
|
||||
"delete" => \&cmd_group_delete
|
||||
);
|
||||
|
@ -767,9 +766,16 @@ sub cmd_account_view($@)
|
|||
sub cmd_group(@)
|
||||
{
|
||||
my $gname = shift;
|
||||
my $year;
|
||||
|
||||
if ($gname && $gname =~ /^(20[0-9]{2})$/)
|
||||
{
|
||||
$year = $1;
|
||||
$gname = shift;
|
||||
}
|
||||
|
||||
if (! $gname) {
|
||||
log(USAGE, "lpt group <group-name> <command> [arguments ...]");
|
||||
log(USAGE, "lpt group [year] <group-name> <command> [arguments ...]");
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
@ -784,209 +790,268 @@ sub cmd_group(@)
|
|||
return 1;
|
||||
}
|
||||
|
||||
return $cmds_group{$subcmd}($gname, @_);
|
||||
return $cmds_group{$subcmd}($gname, $year, @_);
|
||||
}
|
||||
|
||||
sub cmd_group_list(@)
|
||||
sub cmd_group_multiple_vieworchange
|
||||
{
|
||||
if ($#ARGV > 0)
|
||||
{
|
||||
log(USAGE, "<lpt> group list [group]");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
my $group = $ARGV[0];
|
||||
my $ldap = LDAP::ldap_connect_anon();
|
||||
if ($#ARGV == 0)
|
||||
{
|
||||
my $mesg = $ldap->search( # search a group
|
||||
base => "cn=$group,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "objectClass=posixGroup",
|
||||
attrs => ['memberUid']
|
||||
);
|
||||
$mesg->code && die $mesg->error;
|
||||
$mesg->count > 0 || return -1;
|
||||
|
||||
foreach my $entry ($mesg->sorted('memberUid'))
|
||||
{
|
||||
foreach my $user ($entry->get_value("memberUid"))
|
||||
{
|
||||
print "$user\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
my $mesg = $ldap->search( # list groups
|
||||
base => "ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "objectClass=posixGroup",
|
||||
attrs => ['cn', 'gidNumber']
|
||||
);
|
||||
|
||||
|
||||
$mesg->code && die $mesg->error;
|
||||
$mesg->count > 0 || return -1;
|
||||
|
||||
foreach my $entry ($mesg->sorted('gidNumber'))
|
||||
{
|
||||
print $entry->get_value("cn")." --->";
|
||||
print $entry->get_value("gidNumber")."\n";
|
||||
}
|
||||
}
|
||||
|
||||
$ldap->unbind; # take down session
|
||||
}
|
||||
|
||||
sub cmd_group_add(@)
|
||||
{
|
||||
my $group = shift;
|
||||
|
||||
if ($#_ < 0)
|
||||
{
|
||||
log(USAGE, "<lpt> group <group-name> add <login>");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
my $login = shift;
|
||||
|
||||
my $ldap = LDAP::ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search a group
|
||||
base => "cn=$group,ou=system,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "objectClass=posixGroup",
|
||||
attrs => ['memberUid']
|
||||
) or die $!;
|
||||
$mesg->code && die $mesg->error;
|
||||
$mesg->count > 0 || return -1;
|
||||
|
||||
foreach my $entry ($mesg->entries)
|
||||
{
|
||||
my @mem = $entry->get_value("memberUid");
|
||||
|
||||
foreach my $member (@mem)
|
||||
{
|
||||
if ($member eq $login)
|
||||
{
|
||||
log WARN, "$login est déjà dans le groupe $group";
|
||||
$ldap->unbind;
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
|
||||
push @mem, $login;
|
||||
$entry->replace("memberUid" => \@mem);
|
||||
$entry->update($ldap);
|
||||
|
||||
log INFO, "$login ajouté au groupe $group avec succès.";
|
||||
}
|
||||
$ldap->unbind; # take down session
|
||||
}
|
||||
|
||||
sub cmd_group_remove(@)
|
||||
{
|
||||
if ($#ARGV < 1)
|
||||
{
|
||||
log(USAGE, "<lpt> group remove <group> <login>");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
my $group = $ARGV[0];
|
||||
my $login = $ARGV[1];
|
||||
|
||||
my $ldap = LDAP::ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search a group
|
||||
base => "cn=$group,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "objectClass=posixGroup",
|
||||
attrs => ['memberUid']
|
||||
);
|
||||
$mesg->code && die $mesg->error;
|
||||
$mesg->count > 0 || return -1;
|
||||
|
||||
foreach my $entry ($mesg->sorted('memberUid'))
|
||||
{
|
||||
my @mem = $entry->get_value("memberUid");
|
||||
my $found = 0;
|
||||
foreach my $user (@mem)
|
||||
{
|
||||
if ($user eq $login)
|
||||
{
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
|
||||
if ($found)
|
||||
{
|
||||
@mem = grep(!/$login$/, @mem);
|
||||
$entry->replace("memberUid" => [@mem]);
|
||||
$entry->update($ldap);
|
||||
}
|
||||
else
|
||||
{
|
||||
print "$login n'est pas dans le groupe $group\n";
|
||||
}
|
||||
|
||||
print "Nouvelle liste des membres de $group :\n";
|
||||
foreach my $user (@mem)
|
||||
{
|
||||
print "$user\n";
|
||||
}
|
||||
|
||||
}
|
||||
$ldap->unbind; # take down session
|
||||
|
||||
system('service nscd restart');
|
||||
}
|
||||
|
||||
sub cmd_group_create($$)
|
||||
{
|
||||
if ($#_ != 1)
|
||||
{
|
||||
log(USAGE, "<lpt> group create <yaka|acu> <year>");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
my $type = shift;
|
||||
my $year = shift;
|
||||
my $cn = $type . $year;
|
||||
my $gid;
|
||||
if ($type eq "acu") {
|
||||
$gid = $year;
|
||||
my $typeName = shift;
|
||||
my $gname = shift;
|
||||
my $year = shift // LDAP::get_year();
|
||||
my $action = shift // "list";
|
||||
my $change = shift;
|
||||
|
||||
if (($action ne "list" and $action ne "add" and $action ne "del" and $action ne "flush") or (!$change and $action ne "list" and $action ne "flush")) {
|
||||
log(USAGE, "<lpt> group <group-name> $typeName [list|add|del|flush] [string]");
|
||||
return 1;
|
||||
}
|
||||
elsif ($type eq "yaka") {
|
||||
$gid = $year - 1000;
|
||||
|
||||
my $ldap;
|
||||
$ldap = LDAP::ldap_connect() if ($action ne "list");
|
||||
$ldap = LDAP::ldap_connect_anon() if ($action eq "list");
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "cn=$gname",
|
||||
attrs => [ $type ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) {
|
||||
log(ERROR, $mesg->error);
|
||||
}
|
||||
if ($mesg->count != 1) {
|
||||
log(ERROR, "Group $gname not found or multiple presence");
|
||||
}
|
||||
|
||||
if ($action eq "add") {
|
||||
log(INFO, "Adding $change as ".$typeName."s for $gname ...");
|
||||
|
||||
my @data = $mesg->entry(0)->get_value($type);
|
||||
|
||||
if (! grep(/^$change$/, @data)) {
|
||||
push @data, $change;
|
||||
$mesg->entry(0)->replace($type => \@data) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
log(INFO, "Done!");
|
||||
}
|
||||
else {
|
||||
log(WARN, "$gname has already $change $typeName.");
|
||||
}
|
||||
}
|
||||
elsif ($action eq "del") {
|
||||
log(INFO, "Checking if $change is a ".$typeName."s of $gname ...");
|
||||
my @data = $mesg->entry(0)->get_value($type);
|
||||
if (grep(/^$change$/, @data)) {
|
||||
log(INFO, "Deleting $change as $typeName for $gname ...");
|
||||
|
||||
@data = grep(!/$change$/, @data);
|
||||
|
||||
$mesg->entry(0)->replace($type => \@data) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
log(INFO, "Done!");
|
||||
}
|
||||
else {
|
||||
log(WARN, "$change is not a $typeName for $gname.");
|
||||
}
|
||||
}
|
||||
elsif ($action eq "flush") {
|
||||
$ldap->modify($mesg->entry(0)->dn, delete => [$type]);
|
||||
log(INFO, "$gname have no more $typeName.");
|
||||
}
|
||||
else {
|
||||
log(ERROR, "Error: type must be acu or yaka!");
|
||||
if ($mesg->entry(0)->get_value($type)) {
|
||||
log(INFO, $gname."'s ".$typeName."s are:");
|
||||
for my $val ($mesg->entry(0)->get_value($type)) {
|
||||
say " - $val";
|
||||
}
|
||||
}
|
||||
else {
|
||||
log(INFO, "$gname have no $typeName.");
|
||||
}
|
||||
}
|
||||
|
||||
my $ldap = LDAP::ldap_connect();
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $mesg = $ldap->add( "cn=$cn,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
attrs => [
|
||||
objectclass => "posixGroup",
|
||||
gidNumber => $gid,
|
||||
cn => $cn,
|
||||
]
|
||||
sub cmd_group_vieworchange
|
||||
{
|
||||
my $type = shift;
|
||||
my $typeName = shift;
|
||||
my $gname = shift;
|
||||
my $year = shift // LDAP::get_year();
|
||||
|
||||
if ($#_ > 0) {
|
||||
log(USAGE, "<lpt> group <group-name> $typeName [new_string]");
|
||||
return 1;
|
||||
}
|
||||
|
||||
my $change = shift;
|
||||
|
||||
my $ldap;
|
||||
$ldap = LDAP::ldap_connect() if ($change);
|
||||
$ldap = LDAP::ldap_connect_anon() if (!$change);
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "uid=$gname",
|
||||
attrs => [ $type ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->code != 0) {
|
||||
log(ERROR, $mesg->error);
|
||||
}
|
||||
if ($mesg->count != 1) {
|
||||
log(ERROR, "User $gname not found or multiple presence");
|
||||
}
|
||||
|
||||
if ($change) {
|
||||
log(INFO, "Setting $typeName to $change for $gname ...");
|
||||
|
||||
$mesg->entry(0)->replace($type => $change) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
log(INFO, "Done!");
|
||||
}
|
||||
elsif ($mesg->entry(0)->get_value($type)) {
|
||||
log(INFO, $gname."'s $typeName is ".$mesg->entry(0)->get_value($type).".");
|
||||
}
|
||||
else {
|
||||
log(INFO, $gname."'s has no $typeName.");
|
||||
}
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
return 0;
|
||||
}
|
||||
|
||||
log(INFO, "group added: $cn");
|
||||
sub cmd_group_view
|
||||
{
|
||||
my $gname = shift;
|
||||
my $year = shift;
|
||||
if ($year) {
|
||||
$year = "ou=$year,";
|
||||
} else {
|
||||
$year = "";
|
||||
}
|
||||
|
||||
my $ldap = LDAP::ldap_connect_anon();
|
||||
|
||||
my $mesg = $ldap->search(base => $year."ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "cn=$gname",
|
||||
attrs => ['objectClass']);
|
||||
|
||||
$mesg->code && log(ERROR, $mesg->error);
|
||||
log(ERROR, "No such group!") if ($mesg->count <= 0);
|
||||
|
||||
log(DEBUG, "objectClasses:\t" . join(', ', $mesg->entry(0)->get_value("objectClass")));
|
||||
|
||||
my @attrs = ['dn'];
|
||||
if ($#_ >= 0) {
|
||||
push @attrs, @_;
|
||||
}
|
||||
else {
|
||||
if (grep { "intraGroup" } $mesg->entry(0)->get_value("objectClass")) {
|
||||
push @attrs, 'intraRight';
|
||||
}
|
||||
if (grep { "posixGroup" } $mesg->entry(0)->get_value("objectClass")) {
|
||||
push @attrs, 'cn', 'memberUid';
|
||||
}
|
||||
}
|
||||
|
||||
log(DEBUG, "attrs to get: " . join(', ', @attrs));
|
||||
|
||||
$mesg = $ldap->search(base => $year."ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "cn=$gname",
|
||||
attrs => \@attrs);
|
||||
$mesg->code && die $mesg->error;
|
||||
|
||||
shift @attrs; # Remove dn
|
||||
my $nb = 0;
|
||||
for my $entry ($mesg->entries)
|
||||
{
|
||||
if ($nb > 0) {
|
||||
say "==";
|
||||
}
|
||||
say BOLD, YELLOW, "dn: ", RESET, YELLOW, $entry->dn, RESET;
|
||||
|
||||
for my $attr (@attrs) {
|
||||
if ($#attrs < 3) {
|
||||
for my $entry ($entry->get_value($attr)) {
|
||||
say CYAN, "$attr: ", RESET , $entry;
|
||||
}
|
||||
}
|
||||
else {
|
||||
say CYAN, "$attr: ", RESET , join(', ', $entry->get_value($attr));
|
||||
}
|
||||
}
|
||||
|
||||
$nb++;
|
||||
}
|
||||
|
||||
if ($nb > 1) {
|
||||
say "\n$nb groups displayed";
|
||||
}
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub cmd_group_members($@)
|
||||
{
|
||||
return cmd_group_multiple_vieworchange('memberUid', 'member', @_);
|
||||
}
|
||||
|
||||
sub cmd_group_rights($@)
|
||||
{
|
||||
return cmd_group_multiple_vieworchange('intraRight', 'right', @_);
|
||||
}
|
||||
|
||||
sub cmd_group_create
|
||||
{
|
||||
my $gname = shift;
|
||||
my $year = shift // LDAP::get_year();
|
||||
|
||||
log(DEBUG, "Adding dn: cn=$gname,ou=$year,ou=intra,ou=groups,dc=acu,dc=epita,dc=fr ...");
|
||||
|
||||
my $ldap = LDAP::ldap_connect();
|
||||
my $mesg = $ldap->add( "cn=$gname,ou=$year,ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
attrs => [
|
||||
objectclass => [ "top", "intraGroup" ],
|
||||
cn => $gname,
|
||||
]
|
||||
);
|
||||
|
||||
#$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
|
||||
if ($mesg->code == 0) {
|
||||
log(INFO, "Group added: $gname");
|
||||
return 0;
|
||||
}
|
||||
else {
|
||||
log(ERROR, "Unable to add: $gname: ", RESET, $mesg->error);
|
||||
}
|
||||
}
|
||||
|
||||
sub cmd_group_delete(@)
|
||||
{
|
||||
if ($#ARGV != 1)
|
||||
{
|
||||
log(USAGE, "<lpt> group delete <yaka|acu> <year>");
|
||||
exit(1);
|
||||
my $gname = shift;
|
||||
my $year = shift // LDAP::get_year();
|
||||
|
||||
my $dn = "cn=$gname,ou=$year,ou=intra,ou=groups,dc=acu,dc=epita,dc=fr";
|
||||
|
||||
log(DEBUG, "Deletinging dn: $dn ...");
|
||||
|
||||
my $ldap = LDAP::ldap_connect();
|
||||
if (LDAP::delete_entry($ldap, $dn)) {
|
||||
log DONE, "Group $gname successfully deleted.";
|
||||
} else {
|
||||
log ERROR, "Unable to delete group $gname.";
|
||||
return 1;
|
||||
}
|
||||
|
||||
print "TODO!";
|
||||
print "hint: ldapdelete -v -h ldap.acu.epita.fr -x -w \$LDAP_PASSWD -D 'cn=admin,dc=acu,dc=epita,dc=fr' 'cn=yaka2042,ou=groups,dc=acu,dc=epita,dc=fr'";
|
||||
exit(1);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
|
Reference in New Issue
Block a user