epita-std/ACU
Archived
1
0
Fork 0
Code Releases Activity

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

Browse source
This commit is contained in:
Root Cpp Charlie 2013-10-18 18:31:33 +02:00
commit 6a81847871
14 changed files with 798 additions and 332 deletions
Download patch file Download diff file Expand all files Collapse all files

2
ACU/Process.pm
View file

@ -154,7 +154,7 @@ sub build_task_xml($;$)
my $files = shift; my $files = shift;
my $doc = XML::LibXML::Document->new('1.0'); my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("sync_ssh_keys"); my $root = $doc->createElement("process");
$doc->setDocumentElement( $root ); $doc->setDocumentElement( $root );
log TRACE, $params; log TRACE, $params;

6
commands/first-install.sh
View file

@ -1,10 +1,10 @@
#! /bin/bash #! /bin/bash
# Install missing packages # 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" 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" 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" 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` KERNEL=`uname -s`

39
commands/project/send_dir_to_moulette.sh Executable file
View 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
View 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

38
hooks/gl-pre-git
View file

@ -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); 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 # 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 $read = ($ARGV[0] =~ /R/);
my $write = ($ARGV[0] =~ /W/); my $write = ($ARGV[0] =~ /W/);
say "Votre IP est : $ip.";
$ip = Net::IP->new($ip) or die ("IP invalide"); $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é à 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); log ERROR, "Vous n'êtes pas autorisé à accéder à ce dépôt depuis cette IP." if ($read);
exit 1; 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) 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é à 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); log ERROR, "Vous n'êtes pas autorisé à accéder à ce dépôt depuis cette IP." if ($read);
exit 1; exit 1;

13
hooks/subjects.pl
View file

@ -490,7 +490,7 @@ sub tag_ref
$rendu = $_[2]; $rendu = $_[2];
} }
else { else {
$rendu = "*"; $rendu = "";
} }
my $year; my $year;
@ -533,8 +533,7 @@ sub tag_ref
# Send data to moulette # Send data to moulette
log INFO, "Attente d'un processus de compilation..."; log INFO, "Attente d'un processus de compilation...";
if (my $err = Process::Client::launch("moulette_get", { if (my $err = Process::Client::launch("moulette_get", {
type => "tar", type => "ref",
login => "ref",
id => $project_id, id => $project_id,
"year" => $year, "year" => $year,
"rendu" => $rendu, "rendu" => $rendu,
@ -597,13 +596,7 @@ sub tag_tests
$project_id = lc $project_id; $project_id = lc $project_id;
$project_id =~ s/[^a-z0-9-_]/_/g; $project_id =~ s/[^a-z0-9-_]/_/g;
my $rendu; my $rendu = $_[2];
if ($_[2]) {
$rendu = $_[2];
}
else {
$rendu = "";
}
my $year; my $year;
if ($_[3]) if ($_[3])

15
hooks/submissions.pl
View file

@ -95,6 +95,21 @@ if ($ref =~ m<^refs/tags/(.+)$>)
} }
else 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 # Send data to API
my $last_commit = `git log $newsha -1 --decorate --tags`; my $last_commit = `git log $newsha -1 --decorate --tags`;
eval { eval {

101
migration/repo.sh
View file

@ -6,25 +6,20 @@ then
exit 1 exit 1
fi 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 if [ -z "$1" ]
do then
if [ -f "$f" ] echo "tex2md: No argument given"
then exit 2
git rm -f "$f" > /dev/null fi
elif [ -d "$f" ] DEST="$1"
then
git rm -fr "$f" > /dev/null
fi
done
cd include
for i in `find -type f -name '*.tex'` for i in `find -type f -name '*.tex'`
do do
bi=`basename "$i"` bi=`basename "$i"`
echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m" 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/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i"
sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\input *\{([^}]+)}/\\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/\\frame//g' "$i"
sed -Ei 's/\\item( *)<[^>]+>/\\item\1/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 then
git add ../${bi%%.tex}.md git add "$DEST"/${bi%%.tex}.md
git checkout "$i" git checkout "$i"
git rm -f "$i" > /dev/null git rm -f "$i" > /dev/null
fi fi
sed -Ei 's/`%%([a-z-])\(([^)]+)\)`/%%\1(\2)/gi' "../${bi%%.tex}.md" sed -Ei 's/`%%([a-z-])\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md"
sed -Ei 's/\\$/\n/' "../${bi%%.tex}.md" sed -Ei 's/\\$/\n/' "$DEST/${bi%%.tex}.md"
done done
if [ `find | wc -l` -gt 1 ] }
then
git mv * ..
fi
cd ..
maintex2md()
{
if [ -f "mySubject.md" ] if [ -f "mySubject.md" ]
then then
git mv "mySubject.md" "main.md" git mv "mySubject.md" "main.md"
@ -93,8 +86,57 @@ clean_tex()
then then
git mv "myTutorial.md" "main.md" git mv "myTutorial.md" "main.md"
fi 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` TMPDIR=`mktemp -d`
@ -124,9 +166,9 @@ then
exit 4 exit 4
fi fi
cd .. cd - > /dev/null
rm -rf "$1" mv "$1" "$1.hg"
git clone "$TMPDIR/repo.git" "$1" git clone "$TMPDIR/repo.git" "$1"
@ -207,13 +249,13 @@ do
do do
if [ -f "$D/template.xml" ] if [ -f "$D/template.xml" ]
then 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" git add "$D.xml"
echo -e "\e[1;35m>>>\e[1;37m Defense converted:\e[0m $D" echo -e "\e[1;35m>>>\e[1;37m Defense converted:\e[0m $D"
fi fi
git rm -rf "$D" > /dev/null git rm -rf "$D" > /dev/null
done done
cd .. cd - > /dev/null
echo -e "\e[1;35m## ## ## ## ##\e[0m" echo -e "\e[1;35m## ## ## ## ##\e[0m"
echo echo
@ -242,8 +284,7 @@ do
then then
echo -e "\e[1;32m##\e[1;37m Find directory $DIR with some .tex files \e[1;32m##\e[0m" echo -e "\e[1;32m##\e[1;37m Find directory $DIR with some .tex files \e[1;32m##\e[0m"
cd "$DIR" cd "$DIR"
clean_tex "$DIR" clean_tex `pwd` `readlink -f "$(pwd)/.."`
cd ..
echo -e "\e[1;32m## ## ## ## ##\e[0m" echo -e "\e[1;32m## ## ## ## ##\e[0m"
echo echo
@ -270,7 +311,7 @@ do
git rm -rf "$f" > /dev/null git rm -rf "$f" > /dev/null
fi fi
done done
cd .. cd - > /dev/null
fi fi
done done

118
process/files/intradata_get.pl
View file

@ -28,7 +28,10 @@ my %actions = (
"create" => \&update_project, "create" => \&update_project,
"update" => \&update_project, "update" => \&update_project,
"delete" => \&delete_project, "delete" => \&delete_project,
} },
"trace" => {
"update" => \&update_trace,
},
); );
sub create_tree($$) sub create_tree($$)
@ -36,16 +39,11 @@ sub create_tree($$)
my $year = shift; my $year = shift;
my $project_id = shift; my $project_id = shift;
if (! -d "$basedir/$year/") { croak "No directory for year $year. Ask a root to create it." 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.";
}
if (! -e "$basedir/$year/$project_id/") { if (! -e "$basedir/$year/$project_id/") {
mkdir "$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 $project_id = $args->{param}{id};
my $year = $args->{param}{year} // LDAP::get_year; my $year = $args->{param}{year} // LDAP::get_year;
if (! $project_id) { croak "No project_id given." if (! $project_id);
log ERROR, "No project_id given.";
return "No project_id given";
}
if (! -e "$basedir/$year/$project_id/grades/") { if (! -e "$basedir/$year/$project_id/grades/") {
mkdir "$basedir/$year/$project_id/grades/"; mkdir "$basedir/$year/$project_id/grades/";
@ -102,10 +97,7 @@ sub grades_generate
if (exists $args->{files}{"grading.xml"}) { if (exists $args->{files}{"grading.xml"}) {
$grading = $args->{files}{"grading.xml"}; $grading = $args->{files}{"grading.xml"};
} }
if (! $grading) { croak "Invalid grading.xml received!" if (! $grading);
log ERROR, "Invalid grading.xml received!";
return "Invalid grading.xml received!";
}
$grading = Grading->new($grading); $grading = Grading->new($grading);
@ -143,7 +135,7 @@ sub grades_generate
$grading->reset(); $grading->reset();
} }
return "Ok"; return 1;
} }
sub grades_new_bonus sub grades_new_bonus
@ -154,10 +146,7 @@ sub grades_new_bonus
my $delete = $args->{param}{delete}; my $delete = $args->{param}{delete};
my $year = $args->{param}{year} // LDAP::get_year; my $year = $args->{param}{year} // LDAP::get_year;
if (! $project_id) { croak "No project_id given" if (! $project_id);
log ERROR, "No project_id given.";
return "No project_id given";
}
if (! -e "$basedir/$year/$project_id/traces/") { if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$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 sub update_defense
@ -247,26 +236,17 @@ sub update_defense
my $project_id = $args->{param}{id}; my $project_id = $args->{param}{id};
my $year = $args->{param}{year} // LDAP::get_year; my $year = $args->{param}{year} // LDAP::get_year;
if (! $project_id) { croak "No project_id given" if (! $project_id);
log ERROR, "No project_id given.";
return "No project_id given";
}
my $defense_id = $args->{param}{defense_id}; my $defense_id = $args->{param}{defense_id};
if (! $defense_id) { croak "No defense_id given" if (! $defense_id);
log ERROR, "No defense_id given.";
return "No defense_id given";
}
my $defense; my $defense;
if (exists $args->{files}{"$defense_id.xml"}) { if (exists $args->{files}{"$defense_id.xml"}) {
$defense = $args->{files}{"$defense_id.xml"}; $defense = $args->{files}{"$defense_id.xml"};
} }
if (! $defense) { croak "Invalid $defense_id.xml received!" if (! $defense);
log ERROR, "Invalid $defense_id.xml received!";
return "Invalid $defense_id.xml received!";
}
log INFO, "Update $year/$project_id/defenses/$defense_id.xml"; log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
@ -287,7 +267,7 @@ sub update_defense
print $out $defense; print $out $defense;
close $out; close $out;
return "Ok"; return 1;
} }
sub update_project sub update_project
@ -297,29 +277,63 @@ sub update_project
my $project_id = $args->{param}{id}; my $project_id = $args->{param}{id};
my $year = $args->{param}{year} // LDAP::get_year; my $year = $args->{param}{year} // LDAP::get_year;
if (! $project_id) { croak "No project_id given" if (! $project_id);
log ERROR, "No project_id given.";
return "No project_id given";
}
my $butler; my $butler;
if (exists $args->{files}{"butler.xml"}) { if (exists $args->{files}{"butler.xml"}) {
$butler = $args->{files}{"butler.xml"}; $butler = $args->{files}{"butler.xml"};
} }
if (! $butler) { croak "Invalid butler.xml received!" if (! $butler);
log ERROR, "Invalid butler.xml received!";
return "Invalid butler.xml received!";
}
log INFO, "Update $year/$project_id/butler.xml"; 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"; open my $out, ">", "$basedir/$year/$project_id/butler.xml";
print $out $butler; print $out $butler;
close $out; 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 sub delete_project
@ -335,12 +349,18 @@ sub process_get
my $type = $args->{param}{type}; my $type = $args->{param}{type};
my $action = $args->{param}{action} // "update"; my $action = $args->{param}{action} // "update";
if (! exists $actions{$type}{$action}) { croak "Unknown action '$action' for $type." if (! exists $actions{$type}{$action});
log WARN, "Unknown action '$action' for $type.";
return "Unknown action '$action' for $type."; 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); Process::register("intradata_get", \&process_get);

286
process/files/moulette_get.pl
View file

@ -3,91 +3,121 @@
use v5.10.1; use v5.10.1;
use strict; use strict;
use warnings; use warnings;
#use threads;
use Carp; use Carp;
use Pod::Usage; use File::Basename;
use File::Copy; use File::Copy;
use File::Path qw(remove_tree); use File::Path qw(remove_tree mkpath);
use File::Temp qw/tempfile tempdir/; use File::Temp qw/tempfile tempdir/;
use Sys::Gamin;
use ACU::Log; use ACU::Log;
use ACU::Process; use ACU::Process;
my %actions = ( my %actions = (
"tar" => \&receive_tar, "std" => \&receive_std, #STuDent
"git" => \&receive_git, "ref" => \&receive_ref,
"tests" => \&create_testsuite, "tests" => \&create_testsuite,
"moulette" => \&moulette, "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 sub prepare_dir
{ {
my $year = shift; my $year = shift;
my $project_id = shift; my $project_id = shift;
my $rendu = shift; my $rendu = shift;
# TODO: replace ~calvair by the destination directory my @dirs = ("/data/work/$year-$project_id-$rendu/", "/data/output/$year-$project_id-$rendu/");
my $dir = "~calvair/$year-$project_id-$rendu/";
if (! -d $dir) { for my $dir (@dirs)
mkpath($destdir) or croak "An error occurs while creating directory: $!"; {
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 $args = shift;
my $project_id = $args->{param}{id}; my $project_id = $args->{param}{id};
my $year = $args->{param}{year}; my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu}; my $rendu = $args->{param}{rendu};
my $file = $args->{param}{file}; my $file = $args->{param}{file};
my $login = $args->{param}{login} // "ref";
croak "No file named '$file' given" if (!exists $args->{files}{$file}); croak "No file named '$file' given" if (!exists $args->{files}{$file});
my ($fh, $filename) = tempfile(SUFFIX => $file); my $tempdir = tempdir(DIR => '/data/tmp');
binmode($fh);
print $fh $args->{files}{$file};
close $fh;
my $destdir = prepare_dir($year, $project_id, $file); open my $fh, "|tar -xz -f - -C '$tempdir'";
# 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'";
print $fh $args->{files}{$file}; print $fh $args->{files}{$file};
close $fh; close $fh;
croak "An error occurs while extracting the tarball" if ($?); croak "An error occurs while extracting the tarball" if ($?);
my $destdir = prepare_dir($year, $project_id, $file); jail_exec("gmake -C $tempdir/ref/ fact");
# TODO: Call Fact for create .ff croak "An error occurs while making the testsuite" if ($?);
# qx(Fact package create $tempdir $destdir/$login.ff)
croak "Cannot create $login.ff" 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 # Clean
remove_tree($tempdir); 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 sub create_testsuite
{ {
my $args = shift; my $args = shift;
@ -98,52 +128,173 @@ sub create_testsuite
croak "No file named '$file' given" if (!exists $args->{files}{$file}); croak "No file named '$file' given" if (!exists $args->{files}{$file});
my $tempdir = tempdir(); my $tempdir = tempdir(DIR => '/data/tmp');
open my $fh, "|tar -xz -C '$tempdir'";
open my $fh, "|tar -xz -f - -C '$tempdir'";
print $fh $args->{files}{$file}; print $fh $args->{files}{$file};
close $fh; close $fh;
croak "An error occurs while extracting the tarball" if ($?); 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 ($?); 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/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: $!"; 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 # Clean
remove_tree($tempdir); 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 sub moulette
{ {
my $args = shift; 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); if ($args->{unamed} == 0)
chdir($testdir);
for (my $i = $args->{unamed}; $i > 0; $i--)
{ {
my $login = $args->{param}{$i} # Run on all submissions
run_moulette($args->{param}{id},
open my $fhin, "<", "$testdir/test.ft"; $args->{param}{year},
open my $fhout, ">", "$testdir/$login.ft"; $args->{param}{rendu});
print $fhout s/#LOGIN_X/$login/g while (<$fhin>); }
close $fhin; else
close $fhout; {
for (my $i = $args->{unamed}; $i > 0; $i--)
# TODO: Call Fact to launch student tarball {
# qx(Fact system manager $login.ft) run_moulette($args->{param}{id},
$args->{param}{year},
log WARN, "An error occurs while starting tests for $login on $year-$project_id-$rendu" if ($?); $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 sub process_get
{ {
my ($given_args, $args) = @_; my ($given_args, $args) = @_;
@ -157,7 +308,7 @@ sub process_get
eval { eval {
$actions{$type}($args); $actions{$type}($args);
} };
if ($@) { if ($@) {
my $err = $@; my $err = $@;
log ERROR, $err; log ERROR, $err;
@ -166,4 +317,9 @@ sub process_get
return "Ok"; return "Ok";
} }
#threads->create('monitor_start');
Process::register("moulette_get", \&process_get); 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
View 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);

1
process/launch.sh
View file

@ -69,6 +69,7 @@ then
hamano) 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_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) moore)

102
process/projects/gen_grading.pl
View file

@ -36,61 +36,67 @@ sub process
my $grade = Grading->new(); my $grade = Grading->new();
my @defenses; my @defenses;
# Create defenses groups if (-d "$basedir/$year/$project_id/defenses/")
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))
{ {
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 = {}; open my $xml, "<", "$basedir/$year/$project_id/defenses/$sout" or die $!;
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; binmode $xml;
my $trace = Trace->new($xml); my $str;
$str .= $_ while (<$xml>);
my %tids = %{ $trace->getIds() }; my $defense = Defense->new($str);
for my $kid (keys %tids)
{ my $ids = $defense->getIds();
$ids->{ $kid } = $tids{ $kid };
} 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;
$grade->create_from_ids($dir, $ids); }
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; return $grade->toString;
} }

441
utils/lpt
View file

@ -76,7 +76,6 @@ my %cmds_account =
"services" => \&cmd_account_services, "services" => \&cmd_account_services,
"shell" => \&cmd_account_shell, "shell" => \&cmd_account_shell,
"view" => \&cmd_account_view, "view" => \&cmd_account_view,
"view" => \&cmd_account_view,
"grant-intra" => \&cmd_account_grantintra, "grant-intra" => \&cmd_account_grantintra,
"grant-lab" => \&cmd_account_grantlab, "grant-lab" => \&cmd_account_grantlab,
@ -85,9 +84,9 @@ my %cmds_account =
my %cmds_group = my %cmds_group =
( (
"list" => \&cmd_group_list, "view" => \&cmd_group_view,
"add" => \&cmd_group_add, "members" => \&cmd_group_members,
"remove" => \&cmd_group_remove, "rights" => \&cmd_group_rights,
"create" => \&cmd_group_create, "create" => \&cmd_group_create,
"delete" => \&cmd_group_delete "delete" => \&cmd_group_delete
); );
@ -767,9 +766,16 @@ sub cmd_account_view($@)
sub cmd_group(@) sub cmd_group(@)
{ {
my $gname = shift; my $gname = shift;
my $year;
if ($gname && $gname =~ /^(20[0-9]{2})$/)
{
$year = $1;
$gname = shift;
}
if (! $gname) { if (! $gname) {
log(USAGE, "lpt group <group-name> <command> [arguments ...]"); log(USAGE, "lpt group [year] <group-name> <command> [arguments ...]");
return 1; return 1;
} }
@ -784,209 +790,268 @@ sub cmd_group(@)
return 1; 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 $type = shift;
my $year = shift; my $typeName = shift;
my $cn = $type . $year; my $gname = shift;
my $gid; my $year = shift // LDAP::get_year();
if ($type eq "acu") { my $action = shift // "list";
$gid = $year; 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 { 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", sub cmd_group_vieworchange
attrs => [ {
objectclass => "posixGroup", my $type = shift;
gidNumber => $gid, my $typeName = shift;
cn => $cn, 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"); $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(@) sub cmd_group_delete(@)
{ {
if ($#ARGV != 1) my $gname = shift;
{ my $year = shift // LDAP::get_year();
log(USAGE, "<lpt> group delete <yaka|acu> <year>");
exit(1); 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!"; return 0;
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);
} }