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

Compare commits

base: epita-std:master
Branches Tags
epita-std:master
epita-std:object
epita-std:splited_intradata
epita-std:kerberos
..
compare: epita-std:kerberos
Branches Tags
epita-std:master
epita-std:object
epita-std:splited_intradata
epita-std:kerberos

1 commit
master ... kerberos

Author SHA1 Message Date
Mercier Pierre-Olivier
4405df326d Add function to get Kerberos password 2013-09-14 08:32:48 +02:00
57 changed files with 1401 additions and 6775 deletions
Download patch file Download diff file Expand all files Collapse all files

104
ACU/API/Base.pm
View file

@ -40,13 +40,7 @@ sub parse($$)
my $sax_handler;
$sax_handler = ResultHandler->new($parsed) if ($mod eq "ResultHandler");
if ($mod eq "ProjectHandler")
{
use ACU::Project;
$sax_handler = ProjectHandler->new($parsed);
}
$sax_handler = ProjectMemberHandler->new($parsed) if ($mod eq "ProjectMemberHandler");
$sax_handler = ProjectGroupHandler->new($parsed) if ($mod eq "ProjectGroupHandler");
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
@ -56,8 +50,8 @@ sub parse($$)
if ($@)
{
$parsed->{result} = 256;
$parsed->{message} = "Erreur du parser : $@";
log WARN, "Erreur du parser.";
$parsed->{message} = "Erreur du parser.";
log WARN, "Erreur du parser";
}
if (! exists $parsed->{result})
@ -76,11 +70,6 @@ sub get($$)
my $url = shift;
my $ua = LWP::UserAgent->new;
# Some old version of LWP::UserAgent doesn't support ssl_opts, this is not required
eval {
$ua->ssl_opts(SSL_ca_file => "/etc/ldap/cacert.pem");
};
log(DEBUG, 'GET Request to ', API_URL, $url);
my $req = GET API_URL . $url;
@ -97,18 +86,11 @@ sub send($$$)
my $url = shift;
my $ua = LWP::UserAgent->new;
# Some old version of LWP::UserAgent doesn't support ssl_opts, this is not required
eval {
$ua->ssl_opts(SSL_ca_file => "/etc/ldap/cacert.pem");
};
log(DEBUG, 'POST Request to ', API_URL, $url);
my $req = POST API_URL . $url, shift;
my $res = $ua->request($req);
log TRACE, $res;
my $cnt = $ua->request($req)->content;
my $cnt = $res->content();
log TRACE, $cnt;
return parse($next, $cnt);
@ -237,84 +219,4 @@ sub end_element
}
}
package ProjectGroupHandler;
use v5.10.1;
use strict;
use warnings;
sub new ($$)
{
my $class = shift;
my $self = {
parsed => shift,
savValue => 0,
lastGroup => {},
values => ""
};
bless $self, $class;
return $self;
}
sub start_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "student")
{
$self->{values} = "";
$self->{savValue} = 1;
push @{ $self->{lastGroup}{stds} }, {
id => $element->{Attributes}{"{}id"}{Value},
chief => $element->{Attributes}{"{}chief"}{Value},
login => "",
};
}
elsif ($element->{Name} eq "group")
{
$self->{lastGroup}{id} = $element->{Attributes}{"{}id"}{Value};
$self->{lastGroup}{stds} = [];
}
elsif ($element->{Name} eq "result")
{
$self->{values} = "";
$self->{savValue} = 1;
}
}
sub characters
{
my ($self, $characters) = @_;
if ($self->{savValue}) {
$self->{values} .= $characters->{Data};
}
}
sub end_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "result")
{
$self->{parsed}{result} = $self->{values};
$self->{savValue} = 0;
}
elsif ($element->{Name} eq "group")
{
push @{ $self->{parsed}{groups} }, $self->{lastGroup};
$self->{lastGroup} = {};
$self->{savValue} = 0;
}
elsif ($element->{Name} eq "student")
{
my $size = @{ $self->{lastGroup}{stds} };
(@{ $self->{lastGroup}{stds} })[$size - 1]{login} = $self->{values};
$self->{values} = "";
}
}
1;

55
ACU/API/Projects.pm
View file

@ -10,22 +10,18 @@ use Carp;
use ACU::API::Base;
use ACU::LDAP;
sub add($$;$)
sub add($;$)
{
my $project_name = shift;
my $flavor = shift;
my $year = shift;
if ($year and $year ne LDAP::get_year) {
if ($year and $year != LDAP::get_year) {
croak "Impossible d'ajouter un projet d'une autre année : non implémenté";
}
my $res = API::Base::send('ResultHandler',
"projects/projects/add.xml",
[
project_name => $project_name,
flavor => $flavor,
]);
[ project_name => $project_name ]);
if ($res->{result} ne '0') {
croak "Erreur durant l'ajout : ".$res->{message};
@ -39,17 +35,11 @@ sub get($;$)
my $project_name = shift;
my $year = shift;
my $url;
if ($year) {
$url = "projects/projects/get/$project_name/$year.xml";
} else {
$url = "projects/projects/get/$project_name.xml";
}
my $res = API::Base::get('ProjectHandler', $url);
my $res = API::Base::get('ProjectMemberHandler',
"projects/projects/get/$project_name.xml");
if ($res->{result} ne '0') {
croak "Erreur durant la récupération du projet : " . $res->{message};
croak "Erreur durant l'ajout : " . $res->{message};
}
return $res;
@ -76,38 +66,14 @@ sub get_users($;$)
return $res;
}
sub get_groups($;$)
{
my $project_name = shift;
my $year = shift;
my $url;
if ($year) {
$url = "projects/groups/groups/$project_name/$year.xml";
} else {
$url = "projects/groups/groups/$project_name.xml";
}
my $res = API::Base::get('ProjectGroupHandler', $url);
if ($res->{result} ne '0') {
croak "Erreur durant la récupération : " . $res->{message};
}
return $res;
}
sub add_grades($;$)
{
my %data = (
project_name => shift
);
my $y = shift;
if ($y) {
$data{year} = $y;
}
$data{year} = $_ if (shift);
my $res = API::Base::send('ResultHandler', "projects/notes/add.xml", \%data);
my $res = API::Base::get('ResultHandler', "projects/groups/generate.xml");
if ($res->{result} ne '0') {
croak "Erreur durant l'ajout : " . $res->{message};
@ -122,10 +88,7 @@ sub add_traces($$;$)
project_name => shift,
trace_name => shift,
);
my $y = shift;
if ($y) {
$data{year} = $y;
}
$data{year} = $_ if (shift);
my $res = API::Base::send('ResultHandler', "projects/traces/add.xml", \%data);

12
ACU/API/Submission.pm
View file

@ -5,11 +5,10 @@ package API::Submission;
use v5.10.1;
use strict;
use warnings;
use Carp;
use ACU::API::Base;
sub add
sub add($$$$$)
{
my $year = shift;
my $project = shift;
@ -19,12 +18,15 @@ sub add
my $res = API::Base::send('ResultHandler', "projects/submissions/add.xml", [ leader_login => $user, project_name => $project, year => $year, log => $log, tag => $tag ]);
if ($res->{result} != '0') {
croak "Erreur durant le rendu : ".$res->{message};
if ($res->{result} == '0') {
say "Rendu ok";
}
else {
say "Rendu non ok : retour de l'API non nul.";
}
}
sub get
sub get($$$$)
{
my $year = shift;
my $project = shift;

467
ACU/Defense.pm
View file

@ -17,16 +17,14 @@ sub new ($$)
{
my $class = shift;
my $self = {
groups => [],
ids => {},
infos => {},
comments => {},
who => {},
};
bless $self, $class;
if ($#_ >= 0) {
$self->_initialize(@_);
}
$self->_initialize(@_);
return $self;
}
@ -35,63 +33,10 @@ sub _initialize ($$)
{
my $self = shift;
my $dom = XML::LibXML->load_xml(string => shift);
$self->{groups} = $self->parseDefense($dom->documentElement());
$self->{version} = $dom->documentElement()->getAttribute("version") // "1";
$self->{duration} = $dom->documentElement()->getAttribute("duration") if $dom->documentElement()->hasAttribute("duration");
$self->{type} = $dom->documentElement()->getAttribute("type") if $dom->documentElement()->hasAttribute("type");
$self->{"strict-time"} = $dom->documentElement()->getAttribute("strict-time") if $dom->documentElement()->hasAttribute("strict-time");
$self->{"can-correct"} = $dom->documentElement()->getAttribute("can-correct") if $dom->documentElement()->hasAttribute("can-correct");
$self->{"operator"} = $dom->documentElement()->getAttribute("operator") if $dom->documentElement()->hasAttribute("operator");
}
my $sax_handler = DefenseHandler->new($self);
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
sub parseDefense ($$)
{
my $self = shift;
my $ret = [];
my $node = shift;
foreach my $group ($node->childNodes())
{
if ($group->nodeName eq "group")
{
my $g = Defense::Group->new(
$group->getAttribute("id"),
$group->getAttribute("title"),
$group->getAttribute("questions")
);
$g->addQuestion(
$g->parseQuestions($group->getElementsByTagName("question"))
);
push @$ret, $g;
}
}
return $ret;
}
sub toString ($)
{
my $self = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("defense");
$root->addChild( $doc->createAttribute("version", $self->{version}) );
$root->addChild( $doc->createAttribute("duration", $self->{duration}) );
$root->addChild( $doc->createAttribute("type", $self->{type}) ) if ($self->{type});
$root->addChild( $doc->createAttribute("strict-time", $self->{"strict-time"}) ) if ($self->{"strict-time"});
$root->addChild( $doc->createAttribute("can-correct", $self->{"can-correct"}) ) if ($self->{"can-correct"});
$root->addChild( $doc->createAttribute("operator", $self->{"operator"}) ) if ($self->{"operator"});
for my $group (@{ $self->{groups} }) {
$group->toString($doc, $root, $root);
}
$doc->setDocumentElement( $root );
return $doc->toString();
$parser->parse_file(shift);
}
sub getVersion ($)
@ -103,371 +48,71 @@ sub getVersion ($)
sub getIds ($)
{
my $self = shift;
my %ids;
for my $group (@{ $self->{groups} })
{
$ids{ $group->{id} } = 1 if ($group->{id});
for my $question (@{ $group->{questions_list} })
{
$ids{ $question->{id} } = 1 if ($question->{id});
for my $answer (@{ $question->{answers} })
{
$ids{ $answer->{id} } = $answer->{value} // 0 if ($answer->{id});
}
}
}
return \%ids;
return $self->{ids};
}
sub genIds ($;$)
{
my $self = shift;
my $def_i = shift // 1;
my @ids;
my $grp_i = 0;
for my $group (@{ $self->{groups} })
{
my $cur_gid;
if (! $group->{id} || grep { $_ == $group->{id} } @ids)
{
do {
$cur_gid = "def_".$def_i."g".$grp_i;
$grp_i += 1;
} while (grep {$_ eq $cur_gid} @ids);
$group->{id} = $cur_gid;
package DefenseHandler;
use Carp;
use constant NO_ID_VALUE => "__#";
use ACU::Log;
sub new ($$)
{
my $class = shift;
my $self = {
parsed => shift,
inComment => "",
inEval => "",
inInfo => "",
inValue => "",
inWho => "",
values => ""
};
bless $self, $class;
return $self;
}
sub start_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "defense") {
$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value};
$self->{parsed}{duration} = $element->{Attributes}{"{}duration"}{Value};
}
elsif ($element->{Name} eq "question") {
if ($element->{Attributes}{"{}id"}{Value}) {
$self->{parsed}{ids}{ $element->{Attributes}{"{}id"}{Value} } = 0;
}
else {
$grp_i += 1;
$cur_gid = $group->{id};
}
my $qst_i = 0;
for my $question (@{ $group->{questions_list} })
{
my $cur_qid;
if (! $question->{id} || grep { $_ == $question->{id} } @ids)
{
do {
$cur_qid = $cur_gid."q".$qst_i;
$qst_i += 1;
} while (grep {$_ eq $cur_qid} @ids);
$question->{id} = $cur_qid;
}
else {
$qst_i += 1;
$cur_qid = $question->{id};
}
my $ans_i = 0;
for my $answer (@{ $question->{answers} })
{
if (! $answer->{id} || grep { $_ == $answer->{id} } @ids)
{
my $cur_aid;
do {
$cur_aid = $cur_qid."a".$ans_i;
$ans_i += 1;
} while (grep {$_ eq $cur_aid} @ids);
$answer->{id} = $cur_aid;
}
else {
$ans_i += 1;
}
}
log WARN, "Question without ID!";
}
}
}
package Defense::Group;
use v5.10.1;
use strict;
use warnings;
use Carp;
sub new
{
my $class = shift;
my $self = {
id => shift,
title => shift,
questions => shift,
questions_list => []
};
return bless $self;
}
sub addQuestion($@)
{
my $self = shift;
push @{ $self->{questions_list} }, @_;
}
sub parseQuestions($@)
{
my $self = shift;
my @ret;
for my $question (@_)
{
my $expl;
$expl = @{ $question->getElementsByTagName("explanation") }[0]->textContent if $question->getElementsByTagName("explanation");
my $q = Defense::Question->new(
@{ $question->getElementsByTagName("ask") }[0]->textContent,
$expl // "",
$question->getAttribute("id"),
$question->getAttribute("title"),
$question->getAttribute("type"),
$question->getAttribute("difficulty"),
$question->getAttribute("weight"),
$question->getAttribute("imposed"),
$question->getAttribute("mandatory"),
$question->getAttribute("shuffled-answers")
);
$q->addAnswer(
$q->parseAnswers($question->getElementsByTagName("answer"))
);
$q->addInput(
$q->parseInputs($question->getElementsByTagName("input"))
);
push @ret, $q;
elsif ($element->{Name} eq "answer") {
if ($element->{Attributes}{"{}id"}{Value}) {
$self->{parsed}{ids}{ $element->{Attributes}{"{}id"}{Value} } = $element->{Attributes}{"{}value"}{Value} // $element->{Attributes}{"{}mark"}{Value} // 0;
}
else {
log WARN, "Answer without ID!";
}
}
return @ret;
}
sub toString ($$$)
{
my $self = shift;
my $doc = shift;
my $parent = shift;
my $group = $doc->createElement("group");
$group->addChild( $doc->createAttribute("id", $self->{id}) );
$group->addChild( $doc->createAttribute("title", $self->{title}) );
$group->addChild( $doc->createAttribute("questions", $self->{questions}) ) if ($self->{questions});
$parent->appendChild($group);
for my $item (@{ $self->{questions_list} }) {
$item->toString($doc, $group);
elsif ($element->{Name} ne "group" && $element->{Name} ne "ask" && $element->{Name} ne "answer" && $element->{Name} ne "explanation") {
croak "Not a valid defense XML: unknown tag ".$element->{Name};
}
}
package Defense::Question;
use v5.10.1;
use strict;
use warnings;
use Carp;
sub new
sub characters
{
my $class = shift;
my $self = {
ask => shift,
explanation => shift,
my ($self, $characters) = @_;
id => shift,
title => shift,
type => shift,
difficulty => shift,
weight => shift,
imposed => shift,
mandatory => shift,
"shuffled-answers" => shift,
answers => []
};
return bless $self;
}
sub addAnswer($@)
{
my $self = shift;
push @{ $self->{answers} }, @_;
}
sub addInput($@)
{
my $self = shift;
push @{ $self->{answers} }, @_;
}
sub parseAnswers($@)
{
my $self = shift;
my @ret;
for my $answer (@_)
{
my $a = Defense::Answer->new(
$answer->textContent,
$answer->getAttribute("id"),
$answer->getAttribute("value"),
$answer->getAttribute("next")
);
push @ret, $a;
if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
$self->{values} .= $characters->{Data};
}
return @ret;
}
sub parseInputs($@)
{
my $self = shift;
my @ret;
for my $input (@_)
{
my $a = Defense::Input->new(
$input->getAttribute("label"),
$input->getAttribute("id"),
$input->getAttribute("type"),
$input->getAttribute("value"),
$input->getAttribute("maxlength"),
$input->getAttribute("pattern"),
$input->getAttribute("placeholder"),
$input->getAttribute("min"),
$input->getAttribute("max"),
$input->getAttribute("step")
);
push @ret, $a;
}
return @ret;
}
sub toString ($$$)
{
my $self = shift;
my $doc = shift;
my $parent = shift;
my $question = $doc->createElement("question");
$question->addChild( $doc->createAttribute("id", $self->{id}) );
$question->addChild( $doc->createAttribute("title", $self->{title}) );
$question->addChild( $doc->createAttribute("type", $self->{type}) ) if ($self->{type});
$question->addChild( $doc->createAttribute("difficulty", $self->{difficulty}) ) if ($self->{difficulty});
$question->addChild( $doc->createAttribute("weight", $self->{weight}) ) if ($self->{weight});
$question->addChild( $doc->createAttribute("imposed", $self->{imposed}) ) if ($self->{imposed});
$question->addChild( $doc->createAttribute("mandatory", $self->{mandatory}) ) if ($self->{mandatory});
$question->addChild( $doc->createAttribute("shuffled-answers", $self->{"shuffled-answers"}) ) if ($self->{"shuffled-answers"});
$parent->appendChild($question);
my $ask = $doc->createElement("ask");
$ask->appendText($self->{ask});
$question->appendChild($ask);
for my $item (@{ $self->{answers} }) {
$item->toString($doc, $question);
}
if ($self->{explanation})
{
my $expl = $doc->createElement("explanation");
$expl->appendText($self->{explanation});
$question->appendChild($expl);
}
}
package Defense::Answer;
use v5.10.1;
use strict;
use warnings;
use Carp;
sub new
{
my $class = shift;
my $self = {
text => shift,
id => shift,
value => shift,
"next" => shift,
};
return bless $self;
}
sub toString ($$$)
{
my $self = shift;
my $doc = shift;
my $parent = shift;
my $answer = $doc->createElement("answer");
$answer->appendText($self->{text});
$answer->addChild( $doc->createAttribute("id", $self->{id}) );
$answer->addChild( $doc->createAttribute("value", $self->{value}) ) if ($self->{"value"});
$answer->addChild( $doc->createAttribute("next", $self->{"next"}) ) if ($self->{"next"});
$parent->appendChild($answer);
}
package Defense::Input;
use v5.10.1;
use strict;
use warnings;
use Carp;
sub new
{
my $class = shift;
my $self = {
label => shift,
id => shift,
type => shift,
value => shift,
maxlength => shift,
pattern => shift,
placeholder => shift,
min => shift,
max => shift,
step => shift
};
return bless $self;
}
sub toString ($$$)
{
my $self = shift;
my $doc = shift;
my $parent = shift;
my $answer = $doc->createElement("answer");
$answer->addChild( $doc->createAttribute("label", $self->{label}) );
$answer->addChild( $doc->createAttribute("id", $self->{id}) );
$answer->addChild( $doc->createAttribute("type", $self->{type}) ) if ($self->{"type"});
$answer->addChild( $doc->createAttribute("value", $self->{value}) ) if ($self->{"value"});
$answer->addChild( $doc->createAttribute("maxlength", $self->{maxlength}) ) if ($self->{"maxlength"});
$answer->addChild( $doc->createAttribute("pattern", $self->{pattern}) ) if ($self->{"pattern"});
$answer->addChild( $doc->createAttribute("placeholder", $self->{placeholder}) ) if ($self->{"placeholder"});
$answer->addChild( $doc->createAttribute("min", $self->{min}) ) if ($self->{"min"});
$answer->addChild( $doc->createAttribute("max", $self->{max}) ) if ($self->{"max"});
$answer->addChild( $doc->createAttribute("step", $self->{step}) ) if ($self->{"step"});
$parent->appendChild($answer);
}
1;

134
ACU/Grading.pm
View file

@ -30,25 +30,23 @@ sub _initialize
{
my $self = shift;
my $dom = XML::LibXML->load_xml(string => shift);
my $dom = XML::LibXML->load_xml(IO => shift);
$self->{tree} = $self->parseGrade($dom->documentElement());
$self->{max} = $dom->documentElement()->getAttribute("max") // "20";
}
sub create_from_ids
sub create_from_trace ($$)
{
my $self = shift;
my $trace_id = shift;
my $trace_name = shift;
my $ids = shift;
my $trace_id = $trace_name;
$trace_id =~ s/[^a-zA-Z0-9_]/_/g;
my $trace = shift;
my $g = Grade->new($trace_id, $trace_name);
for my $id (sort( keys %{ $ids } ))
for my $id (sort( keys %{ $trace->{ids} } ))
{
my $p = Point->new($ids->{$id}, $id, 0, 0);
my $p = Point->new($trace->{ids}{$id}, $id, 0, 0);
push @{ $g->{tree} }, $p;
}
@ -109,7 +107,7 @@ sub insert ($$$)
$self->{ids}{$_[0]} = $_[1];
}
sub fill
sub fill ($$)
{
my $self = shift;
my $ids = shift;
@ -119,7 +117,7 @@ sub fill
}
}
sub toString ($)
sub to_string ($)
{
my $self = shift;
@ -135,7 +133,7 @@ sub toString ($)
}
for my $grade (@{ $self->{tree} }) {
$grade->toString($doc, $root, $root);
$grade->to_string($doc, $root, $root);
}
$doc->setDocumentElement( $root );
@ -143,14 +141,13 @@ sub toString ($)
return $doc->toString();
}
sub compute ($;$)
sub compute ($)
{
my $self = shift;
my $login = shift;
my $sum = 0;
for my $grade (@{ $self->{tree} }) {
my $tmp = $grade->compute($self->{operators}, $self->{ids}, $login);
my $tmp = $grade->compute($self->{operators}, $self->{ids});
$sum += $tmp if $tmp;
}
@ -160,15 +157,20 @@ sub compute ($;$)
sub computeXML ($;$)
{
my $self = shift;
my $login = shift;
my $sum = 0;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("grading");
my $final = $doc->createElement("grade");
for my $grade (@{ $self->{tree} }) {
$grade->compute($self->{operators}, $self->{ids}, $login, $doc, $root);
my $tmp = $grade->compute($self->{operators}, $self->{ids}, $doc, $final);
}
$final->addChild( $doc->createAttribute("value", $self->compute()) );
$final->addChild( $doc->createAttribute("name", "Note finale") );
$root->appendChild( $final );
$root->addChild( $doc->createAttribute("max", $self->{max}) );
$doc->setDocumentElement( $root );
@ -199,7 +201,7 @@ sub new ($$$;$$)
return bless $self;
}
sub toString ($$$)
sub to_string ($$$)
{
my $self = shift;
my $doc = shift;
@ -213,7 +215,7 @@ sub toString ($$$)
$parent->appendChild($grade);
for my $item (@{ $self->{tree} }) {
$item->toString($doc, $grade);
$item->to_string($doc, $grade);
}
}
@ -224,12 +226,11 @@ sub append ($@)
push @{ $self->{tree} }, @_;
}
sub compute ($$$;$$$)
sub compute ($$$;$$)
{
my $self = shift;
my $operators = shift;
my $ids = shift;
my $login = shift;
my $doc = shift;
my $parent = shift;
my @current = ();
@ -239,14 +240,13 @@ sub compute ($$$;$$$)
{
$grade = $doc->createElement("grade");
$grade->addChild( $doc->createAttribute("factor", $self->{factor}) );
$grade->addChild( $doc->createAttribute("name", $self->{title}) ) if ($self->{title});
$grade->addChild( $doc->createAttribute("name", $self->{title}) );
$parent->appendChild( $grade );
}
for my $node (@{ $self->{tree} })
{
my $t = $node->compute($operators, $ids, $login, $doc, $grade);
push @current, $t if (defined $t);
for my $node (@{ $self->{tree} }) {
my $t = $node->compute($operators, $ids, $doc, $grade);
push @current, $t if $t;
}
my $res;
@ -255,11 +255,11 @@ sub compute ($$$;$$$)
my $operator = $self->{operator};
my $cpt = new Safe;
$cpt->permit_only(qw(:base_core :base_mem :base_loop padany rv2gv));
$cpt->permit_only(qw(:base_core :base_mem :base_loop padany));
$res = reduce {
$cpt->share('$a');
$cpt->share('$b');
$cpt->reval($operators->{ $operator }) // die "Safe alert: $@";
$cpt->reval($operators->{ $operator }) or die $@;
}
@current;
}
@ -273,6 +273,7 @@ sub compute ($$$;$$$)
$grade->addChild( $doc->createAttribute("value", $res) ) if ($grade);
return $grade if ($grade);
return $res;
}
@ -286,11 +287,8 @@ package Point;
use v5.10.1;
use strict;
use warnings;
use Text::Glob qw( glob_to_regex match_glob );
use Term::ANSIColor qw(:constants);
use ACU::Log;
sub new ($$$$$)
{
my $class = shift;
@ -304,7 +302,7 @@ sub new ($$$$$)
return bless $self;
}
sub toString ($$$)
sub to_string ($$$)
{
my $self = shift;
my $doc = shift;
@ -318,72 +316,47 @@ sub toString ($$$)
$parent->appendChild($point);
}
sub getValue ($$$)
sub getValue ($$;$)
{
my $self = shift;
my $ids = shift;
my $ref = shift;
my $justMatch = shift;
# Return the point node value if exists
return $self->{value} if ($self->{value} ne "");
# Else return pointed ref value
return $ids->{ $ref };
if (!$justMatch && !$ids->{ $self->{ref} } // 0) {
return 0;
}
elsif ($self->{value} eq "") {
return $ids->{ $self->{ref} } // 0;
}
else {
return $self->{value};
}
}
sub compute ($$$;$$$)
sub compute ($$$;$$)
{
my $self = shift;
my $operators = shift;
my $ids = shift;
my $login = shift;
my $ret = undef;
my $ref = $self->{ref};
if ((not $self->{ref}) || $self->{ref} ~~ $ids) {
$ret = $self->getValue( $ids );
}
# Handle $LOGIN in ref
$ref =~ s/\$LOGIN/$login/ if ($login && $ref);
# Handle globbing in ref
if (defined $ref)
{
eval
{
if ($ref =~ /\?|\*/)
{
my $value = 0;
for my $r (grep { match_glob($ref, $_); } keys %$ids) {
$value += $ids->{ $r } if ($ref != $r);
}
$ids->{ $ref } = $value if ($value);
log DEBUG, "New globbing identifier caculated $ref: $value";
}
};
if ($@) {
my $err = $@;
log ERROR, $@;
if ($self->{not}) {
if ($ret) {
$ret = undef;
} else {
$ret = $self->getValue( $ids );
}
}
my $ret = undef;
my $result = (
# No condition on refs nor qversion?
! defined $ref
# Condition on refs
|| grep { $ref eq $_ } keys %$ids
);
# Handel not
$result = !$result if ($self->{not});
# ret is valued only if all conditions passed
$ret = $self->getValue( $ids, $ref ) if ($result);
if ($main::debug)
{
my $str = "not=".($self->{not}//0).", qversion".($self->{qversion}//"*").", ref=".($ref//"").",\tvalue=".($ids->{ $ref//"" } // "undef");
if ($result) {
say GREEN, ">>>", RESET, " Matching point: ", $str, ", ", BOLD, "got=".($ret // 0), RESET;
my $str = "not=".($self->{not}//0).", qversion".($self->{qversion}//"*").", ref=".($self->{ref}//"").",\tvalue=".$self->getValue( $ids, 1 ).", got=".($ret // 0);
if ($ret) {
say GREEN, ">>>", RESET, " Matching point: ", $str;
} else {
say RED, " * ", RESET, " Skipped point: ", $str;
}
@ -392,4 +365,5 @@ sub compute ($$$;$$$)
return $ret;
}
1;

71
ACU/Jail.pm
View file

@ -1,71 +0,0 @@
#! /usr/bin/env perl
package Jail;
use v5.10.1;
use strict;
use warnings;
use Carp;
use File::Temp qw(tempdir);
use File::Path qw(remove_tree);
use File::Copy::Recursive qw(dircopy);
use ACU::Log;
use constant {
JAILS_DIR => "/jail/",
RULESET_NO => 4,
};
sub run_command
{
my $jail = shift;
my $command = shift;
my $readonly = shift;
my $work_dir = shift;
# Verifications
croak JAILS_DIR . "$jail doesn't exist." unless ( -d JAILS_DIR . $jail);
croak JAILS_DIR . "$jail/data doesn't exist." unless ( -d JAILS_DIR . "$jail/data");
my $jail_path = JAILS_DIR . $jail;
my $mounts = "";
if ($readonly) {
$jail_path = tempdir();
$mounts = "mount='" . JAILS_DIR . "$jail $jail_path nullfs ro 0 0' ";
}
$mounts .= "mount='tmpfs $jail_path/tmp tmpfs rw,mode=777 0 0' ";
my $jail_data_path = "$jail_path/data";
# Creating the working directory
if (defined ($work_dir) and $work_dir ne "") {
$mounts .= "mount='$work_dir $jail_data_path nullfs rw 0 0' ";
}
# Create and start jail
my $jail_cmd = "jail -c path='$jail_path' ";
$jail_cmd .= "persist=false ";
$jail_cmd .= "devfs_ruleset=". RULESET_NO ." ";
$jail_cmd .= "$mounts";
if (defined ($work_dir) and $work_dir ne "") {
$jail_cmd .= "exec.start='cd $jail_data_path && $command'";
} else {
$jail_cmd .= "exec.start='$command'";
}
system($jail_cmd);
croak "Error while executing '$jail_cmd'" if ($?);
# Force umount
system("umount -f $jail_path/tmp");
if (defined ($work_dir) and $work_dir ne "") {
system("umount -f $jail_data_path");
}
if ($readonly) {
system("umount -f $jail_path");
}
}
1;

260
ACU/LDAP.pm
View file

@ -5,34 +5,23 @@ package LDAP;
use v5.10.1;
use strict;
use warnings;
use Carp;
use Net::LDAPS;
use Net::LDAP::Filter;
use Net::LDAP::Util qw(ldap_error_text);
use ACU::Password;
use ACU::Right;
use ACU::Log;
use constant {
BASE_DN => "dc=acu,dc=epita,dc=fr",
YEAR_DN => "cn=year,dc=acu,dc=epita,dc=fr",
};
## Connection functions
our $ldaphost = "ldap.acu.epita.fr";
our $binddn = "cn=intra," . BASE_DN;
our $binddn = "cn=intra,dc=acu,dc=epita,dc=fr";
my $bindsecret = "";
sub ldap_get_password
{
if (`hostname` eq "apl") {
return Password::get_password "/home/2014/mercie_d/.secret_ldap";
} else {
return Password::get_password "/home/intradmin/.secret_ldap";
}
return Password::get_password "/home/2014/mercie_d/.secret_ldap";
}
our $secret_search = \&ldap_get_password;
@ -48,7 +37,9 @@ sub ldap_connect()
log(DEBUG, "Connect to LDAP with $binddn");
croak ldap_error_text($mesg->code) if ($mesg->code);
if ($mesg->code) {
log(FATAL, "An error occurred: " .ldap_error_text($mesg->code));
}
return $ldap;
}
@ -60,7 +51,9 @@ sub ldap_connect_anon()
log(DEBUG, "Connect to LDAP anonymously");
croak ldap_error_text($mesg->code) if ($mesg->code);
if ($mesg->code) {
log(FATAL, "An error occurred: " .ldap_error_text($mesg->code));
}
return $ldap;
}
@ -75,7 +68,7 @@ sub add_group($$$;$)
my $year = shift // get_year();
my $ou = shift // "intra"; # expected roles or intra
my $dn = "cn=$cn,ou=$year,ou=$ou,ou=groups," . BASE_DN;
my $dn = "cn=$cn,ou=$year,ou=$ou,ou=groups,dc=acu,dc=epita,dc=fr";
log(DEBUG, "Add group $dn");
@ -90,95 +83,34 @@ sub add_group($$$;$)
return $dn;
}
sub delete_group($$;$)
{
my $cn = shift;
my $year = shift;
my $ou = shift // "intra"; # expected roles or intra
my $ldap = ldap_connect();
log(DEBUG, "Delete group ou=groups,dc=acu,dc=epita,dc=fr");
my $mesg = $ldap->search( # search
base => "ou=groups,dc=acu,dc=epita,dc=fr",
filter => "cn=$cn",
scope => "sub"
);
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
if ($mesg->count != 1) { log(WARN, "$cn not found or multiple entries match"); return 0; }
$ldap->delete( $mesg->entry(0)->dn );
$ldap->unbind or log(WARN, "couldn't disconnect correctly");
}
sub get_year(;$)
{
my $ldap = shift // ldap_connect_anon();
return get_attribute($ldap, YEAR_DN, "year");
}
sub get_rights($)
{
my $login = shift;
my @rights;
my $ldap = ldap_connect_anon();
my $mesg = $ldap->search( # search
base => "ou=roles,ou=groups," . BASE_DN,
filter => Net::LDAP::Filter->new("&(memberUid=$login)(objectClass=intraGroup)"),
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
for my $entry ($mesg->entries)
{
for my $r ($entry->get_value('intraRight'))
{
if ($r =~ /^!(.*)$/) {
@rights = grep { $r ne $_ } @rights;
}
else {
push @rights, Right->new($r);
}
}
}
$mesg = $ldap->search( # search
base => "ou=intra,ou=groups," . BASE_DN,
filter => Net::LDAP::Filter->new("&(memberUid=$login)(objectClass=intraGroup)"),
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $entry ($mesg->entries)
{
for my $r ($entry->get_value('intraRight')) {
push @rights, Right->new($r);
}
}
$mesg = $ldap->search( # search
base => "ou=users," . BASE_DN,
filter => Net::LDAP::Filter->new("&(uid=$login)(objectClass=intraAccount)"),
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $r ($mesg->entry(0)->get_value('intraRight')) {
push @rights, Right->new($r);
}
$ldap->unbind or die ("couldn't disconnect correctly");
return @rights;
}
sub has_right($$)
{
my $login = shift;
my $right = shift;
my $ok = 0;
for my $r (get_rights($login))
{
if ($r->{right} eq $right)
{
return 0 if ($r->{negate});
$ok = $r;
}
}
return $ok;
return get_attribute($ldap, "cn=year,dc=acu,dc=epita,dc=fr", "year");
}
@ -189,16 +121,13 @@ sub get_dn($$@)
my $ldap = shift // ldap_connect();
my $dn = shift;
my $base = BASE_DN;
$dn = "$dn," . BASE_DN if ($dn !~ /$base$/);
my $mesg = $ldap->search( # search
base => "$dn",
filter => Net::LDAP::Filter->new("(objectClass=*)"),
filter => "(objectClass=*)",
attrs => \@_,
scope => "base"
scope => "sub"
);
return undef if ($mesg->code != 0);
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; }
if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; }
return $mesg->entry(0);
@ -221,8 +150,7 @@ sub add_attribute($$$@)
my @data = $entry->get_value($what);
for my $value (@_)
{
if (! grep { $value eq $_ } @data)
{
if (! grep { /^\Q$value\E$/ } @data) {
$mod = 1;
log(DEBUG, "Add attribute $value to $dn");
@ -260,11 +188,10 @@ sub delete_attribute($$$@)
my @data = $entry->get_value($what);
for my $value (@_)
{
if (grep { $value eq $_ } @data)
{
if (grep { /^\Q$value\E$/ } @data) {
log(DEBUG, "Remove attribute $what ($value) from $dn");
@data = grep { $value ne $_ } @data;
@data = grep { ! /^\Q$value\E$/ } @data;
$mod = 1;
}
else {
@ -300,7 +227,7 @@ sub flush_attribute($$@)
my $ldap = shift // ldap_connect();
my $dn = shift;
my $mesg = $ldap->modify($dn, delete => \@_);
my $mesg = $ldap->modify($dn, delete => \@_)->code;
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
@ -324,19 +251,18 @@ sub search_dn($$@)
my $base = shift;
my $filter = shift;
$base .= "," if ($base);
log (DEBUG, "Looking for $filter in $base" . BASE_DN);
if ($base) {
$base .= ","
}
my $mesg = $ldap->search( # search
base => $base . BASE_DN,
filter => Net::LDAP::Filter->new($filter),
base => $base."dc=acu,dc=epita,dc=fr",
filter => $filter,
attrs => [ ],
scope => "sub"
);
return undef if ($mesg->code != 0);
croak("$filter not found") if ($mesg->count == 0);
croak("$filter not unique") if ($mesg->count > 1);
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; }
if ($mesg->count != 1) { log(WARN, "$filter not found or multiple entries match"); return undef; }
return $mesg->entry(0)->dn;
}
@ -347,15 +273,17 @@ sub search_dns($$$@)
my $base = shift;
my $filter = shift;
$base .= "," if ($base);
if ($base) {
$base .= ","
}
my $mesg = $ldap->search( # search
base => $base . BASE_DN,
filter => Net::LDAP::Filter->new($filter),
attrs => \@_,
base => $base."dc=acu,dc=epita,dc=fr",
filter => $filter,
attrs => @_,
scope => "sub"
);
if ($mesg->code != 0) { log(WARN, $mesg->error); return []; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; }
return $mesg->entries;
}
@ -378,4 +306,84 @@ sub update_attribute($$$@)
return 1;
}
sub has_right($$)
{
my $login = shift;
my $right = shift;
my $ok = 0;
for my $r (get_rights($login)) {
if ($r->{right} eq $right) {
return 0 if ($r->{negate});
$ok = $r;
}
}
return $ok;
}
sub get_rights($)
{
my $login = shift;
my @rights;
my $ldap = ldap_connect_anon();
my $mesg = $ldap->search( # search
base => "ou=roles,ou=groups,dc=acu,dc=epita,dc=fr",
filter => "&(memberUid=$login)(objectClass=intraGroup)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
for my $entry ($mesg->entries) {
for my $r ($entry->get_value('intraRight')) {
if ($r =~ /^!(.*)$/) {
@rights = grep { ! /^\Q$r\E$/ } @rights;
}
else {
push @rights, Right->new($r);
}
}
}
$mesg = $ldap->search( # search
base => "ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
filter => "&(memberUid=$login)(objectClass=intraGroup)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $entry ($mesg->entries) {
for my $r ($entry->get_value('intraRight')) {
push @rights, Right->new($r);
}
}
$mesg = $ldap->search( # search
base => "ou=users,dc=acu,dc=epita,dc=fr",
filter => "&(uid=$login)(objectClass=intraAccount)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $r ($mesg->entry(0)->get_value('intraRight')) {
push @rights, Right->new($r);
}
$ldap->unbind or die ("couldn't disconnect correctly");
return @rights;
}
1;

118
ACU/Log.pm
View file

@ -3,11 +3,6 @@ package ACU::Log;
use v5.10.1;
use strict;
use warnings;
use Carp;
use utf8;
use open IO => ':utf8';
use open ':std';
use Data::Dumper;
use Exporter 'import';
use POSIX qw(strftime);
@ -15,120 +10,61 @@ use Term::ANSIColor qw(:constants);
use constant {
FATAL => 1,
ALERT => 2,
ERROR2 => 2,
ERROR => 3,
WARN => 4,
DONE => 5,
WARN4 => 4,
WARN => 5,
USAGE => 6,
PENDING => 6.5,
INFO => 7,
DEBUG => 8,
TRACE => 9,
};
our @EXPORT = qw(log FATAL ALERT ERROR WARN DONE USAGE PENDING INFO DEBUG TRACE);
our @EXPORT = qw(log FATAL ERROR2 ERROR WARN4 WARN USAGE INFO DEBUG TRACE);
our $display_level = 7;
our $save_level = 9;
our $fatal_error = 1;
our $fatal_warn = 0;
our $mail_error = 0;
our $log_file = $0.".log";
my $log_fd;
my $HOSTNAME = `hostname`;
chomp($HOSTNAME);
sub log
sub log($@)
{
my $level = shift;
if ($#_ < 0) { return; }
if (!$_[0]) {
$Carp::Verbose = 1;
croak "Empty log message, this should not append!";
}
if (!$log_fd && $log_file) {
open ($log_fd, ">>", $log_file) or croak("Unable to open log ($log_file) file for writing");
# Enable autoflush for the log file
my $previous_default = select($log_fd);
$|++;
select($previous_default);
open ($log_fd, ">>", $log_file) or die("Unable to open log ($log_file) file for writing");
say $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " START new logging session ";
}
if ($level <= $save_level and $log_fd)
{
if ($level <= $save_level and $log_fd) {
print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " ";
if ($level == TRACE) {
if ($level >= TRACE) {
print $log_fd Dumper(@_);
}
else {
say $log_fd @_;
}
}
if ($mail_error && $level <= ERROR)
{
require Email::MIME;
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
my $mail = Email::MIME->create(
header_str => [
From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>",
To => "Roots assistants <ml-root\@acu.epita.fr>",
Subject => "[LERDORF][ERROR] ".join(' ', @_)
],
attributes => {
encoding => 'quoted-printable',
charset => 'utf-8',
format => 'flowed',
},
body_str => "Bonjour,
Une erreur de niveau $level est survenue sur la machine $HOSTNAME.
Cette erreur est survenue lors de l'exécution du script :
$0.
Voici le contenu du message d'erreur :
".join(' ', @_)."
Cordialement,
--
The lerdorf project",
);
sendmail($mail);
}
if ($level <= $display_level)
{
$|++; # Autoflush STDOUT
if ($level == PENDING) {
print STDERR (leveldisp($level), @_, RESET, "\r");
} else {
say STDERR (leveldisp($level), @_, RESET);
}
$|--; # Disable autoflush
if ($level <= $display_level) {
say STDERR (leveldisp($level), @_, RESET);
}
if ($fatal_warn && $level <= WARN){
#TODO Thibaut
#log(INFO, "Program stopped due to warning");
exit 125;
}
elsif ($fatal_error && $level <= ERROR) {
#TODO Thibaut
#log(INFO, "Program stopped due to error");
exit 126;
}
elsif ($level <= FATAL) {
#TODO Thibaut
#log(INFO, "Program stopped due to fatal error");
exit 127;
}
@ -138,14 +74,12 @@ sub levelstr($)
{
my $level = shift;
return "FATAL" if ($level <= 1);
return "ALERT" if ($level <= 2);
return "ERROR" if ($level <= 3);
return "WARN " if ($level <= 4);
return "DONE " if ($level <= 5);
return "USAGE" if ($level <= 6);
return "INFO " if ($level <= 7);
return "DEBUG" if ($level <= 8);
return "FATAL" if ($level == 1);
return "ERROR" if ($level == 3 or $level == 2);
return "WARN " if ($level == 5 or $level == 4);
return "USAGE" if ($level == 6);
return "INFO " if ($level == 7);
return "DEBUG" if ($level == 8);
return "TRACE";
}
@ -153,15 +87,13 @@ sub leveldisp($)
{
my $level = shift;
return BOLD, ON_RED, YELLOW, "/!\\", RESET, " ", BOLD if ($level <= 1);
return BOLD, ON_RED, ">>>", RESET, " ", BOLD if ($level <= 2);
return BOLD, RED, ">>>", RESET, " ", BOLD if ($level <= 3);
return BOLD, YELLOW, ">>>", RESET, " ", BOLD if ($level <= 4);
return BOLD, GREEN, ">>>", RESET, " ", BOLD if ($level <= 5);
return BOLD, MAGENTA, " * ", RESET, " ", BOLD if ($level <= 6);
return BOLD, CYAN, ">>>", RESET, " " if ($level < 7);
return BOLD, ON_RED, YELLOW, "/!\\", RESET, " ", BOLD if ($level == 1);
return BOLD, ON_RED, ">>>", RESET, " ", BOLD if ($level == 2);
return BOLD, RED, ">>>", RESET, " ", BOLD if ($level == 3);
return BOLD, YELLOW, ">>>", RESET, " ", BOLD if ($level == 5 or $level == 4);
return BOLD, MAGENTA, " * ", RESET, " ", BOLD if ($level == 6);
return BOLD, CYAN, " * ", RESET, " " if ($level == 7);
return BOLD, BLUE, " % ", RESET, " " if ($level <= 8);
return BOLD, BLUE, " % ", RESET, " " if ($level == 8);
return BOLD, BLUE, "#", RESET, " ";
}

106
ACU/Process.pm
View file

@ -22,18 +22,6 @@ our $nb_cpus = 0;
$nb_cpus = grep {/^processor\s/} <$cpuinfo>;
close $cpuinfo;
our @servers = ("gearmand-srv:4730");
sub add_server
{
push @servers, @_;
}
sub set_servers
{
@servers = @_;
}
sub check_load ($)
{
my $priority = shift;
@ -74,62 +62,9 @@ sub do_work ($$$@)
my $sax_handler = ProcessHandler->new($args);
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
eval {
$parser->parse_string(${ $_[0]{argref} });
};
if ($@) {
my $err = "Parse error: $@";
log ERROR, $err;
return $err;
}
$parser->parse_string(${ $_[0]{argref} });
my $ret = "";
eval {
$SIG{'__WARN__'} = sub { log WARN, $_[0]; $ret .= ">>> ".$_[0 ]; };
$ret .= $subref->($given_args, $args);
};
if ($@) {
my $err = $@;
log ERROR, $err;
$ret .= $err;
}
return $ret;
}
sub register_no_parse ($$;$)
{
my $funcname = shift;
my $subref = shift;
my $given_arg = shift;
my $worker = Gearman::Worker->new;
log INFO, "Registering function $funcname on ", join(", ", @servers);
$worker->job_servers( @servers );
$worker->register_function($funcname => sub
{
my $ret;
eval {
$ret = $subref->($given_arg, $_[0]{argref});
};
if ($@) {
my $err = $@;
log ERROR, $err;
return $err;
}
return $ret;
});
# Disable exit on warning or error
$ACU::Log::fatal_warn = 0;
$ACU::Log::fatal_error = 0;
log INFO, "$funcname registered";
$worker->work while 1;
return $subref->($given_args, $args);
}
sub register ($$;$$)
@ -141,16 +76,14 @@ sub register ($$;$$)
my $worker = Gearman::Worker->new;
log INFO, "Registering function $funcname on ", join(", ", @servers);
$worker->job_servers( @servers );
$worker->job_servers('gearmand:4730');
$worker->register_function($funcname => sub { return do_work($subref, $given_arg, $priority, @_); });
# Disable exit on warning or error
$ACU::Log::fatal_warn = 0;
$ACU::Log::fatal_error = 0;
log INFO, "$funcname registered";
log DEBUG, "$funcname registered";
$worker->work while 1;
}
@ -173,7 +106,7 @@ sub build_task_xml($;$)
my $files = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("process");
my $root = $doc->createElement("sync_ssh_keys");
$doc->setDocumentElement( $root );
log TRACE, $params;
@ -212,7 +145,7 @@ sub launch ($$;$$)
my $funcname = shift;
my $client = Gearman::Client->new;
$client->job_servers( @servers );
$client->job_servers('gearmand:4730');
log DEBUG, "Launching $funcname...";
@ -235,7 +168,7 @@ sub paralaunch ($$;$)
my $xml = build_task_xml(shift, shift);
my $client = Gearman::Client->new;
$client->job_servers( @servers );
$client->job_servers('gearmand:4730');
my $taskset = $client->new_task_set;
for my $task (@{ $funcsname })
@ -339,30 +272,6 @@ sub getFirstChild ($)
return $self->{children}[0];
}
sub recreateNode
{
my $self = shift;
my $doc = shift;
my $parent = shift;
my $node = $doc->createElement($self->{nodeName});
for my $attkey (keys %{ $self->{attributes} })
{
$node->addChild( $doc->createAttribute($attkey, $self->{attributes}{ $attkey }) );
}
for my $child (@{ $self->{children} })
{
$child->recreateNode($doc, $node);
}
if ($self->{nodeValue}) {
$node->appendText( $self->{nodeValue} );
}
$parent->appendChild($node);
}
package ProcessHandler;
@ -442,6 +351,7 @@ sub end_element
{
my $item = pop @{ $self->{subtreeStack} };
$item->{nodeValue} .= $self->{values};
$item->{nodeValue} =~ s/\n+/ /g;
$item->{nodeValue} =~ s/ +/ /g;
if (@{ $self->{subtreeStack} } > 0) {
push @{ $self->{subtreeStack}[-1]->{children} }, $item;

183
ACU/Project.pm
View file

@ -1,183 +0,0 @@
#! /usr/bin/env perl
package Project;
use v5.10.1;
use strict;
use warnings;
use Carp;
use XML::LibXML;
use XML::SAX::ParserFactory;
use ACU::Log;
package ProjectHandler;
use strict;
use warnings;
use Carp;
my @stack_tags = (
"manager",
"submission",
"slides",
"subject",
"tutorial",
);
my @stackonce_tags = (
"period",
"upload",
"vcs",
"news",
"documents",
);
my @value_tags = (
"result",
"message",
"name",
"firstname",
"lastname",
"login",
"begin",
"end",
"date",
"tag",
"newsgroup"
);
sub new ($$)
{
my $class = shift;
my $self = {
parsed => shift,
saveChars => 0,
stack => [],
values => ""
};
bless $self, $class;
return $self;
}
sub start_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "project" || $element->{Name} eq "Project") {
$self->{parsed}{name} = $element->{Attributes}{"{}name"}{Value} if ($element->{Attributes}{"{}name"});
}
elsif (grep { $element->{Name} eq $_ } @stack_tags)
{
my $data = {};
$data->{name} = $element->{Attributes}{"{}name"}{Value} if ($element->{Attributes}{"{}name"});
$data->{type} = $element->{Attributes}{"{}type"}{Value} if ($element->{Attributes}{"{}type"});
$data->{written_in} = $element->{Attributes}{"{}written_in"}{Value} if ($element->{Attributes}{"{}written_in"});
push @{ $self->{stack} }, $data;
}
elsif (grep { $element->{Name} eq $_ } @value_tags) {
$self->{saveChars} = 1;
$self->{values} = "";
}
elsif ($element->{Name} eq "vcs") {
push @{ $self->{stack} }, {
url => $element->{Attributes}{"{}url"}{Value},
tag => $element->{Attributes}{"{}tag"}{Value},
token => $element->{Attributes}{"{}token"}{Value} // 0,
quota => $element->{Attributes}{"{}quota"}{Value} // 20,
type => $element->{Attributes}{"{}type"}{Value} // "git",
};
}
elsif ($element->{Name} eq "upload") {
push @{ $self->{stack} }, {
format => $element->{Attributes}{"{}format"}{Value},
url => $element->{Attributes}{"{}url"}{Value},
identifier => $element->{Attributes}{"{}identifier"}{Value},
quota => $element->{Attributes}{"{}quota"}{Value} // 10,
};
}
elsif (grep { $element->{Name} eq $_ } @stackonce_tags) {
push @{ $self->{stack} }, { };
}
}
sub characters
{
my ($self, $characters) = @_;
if ($self->{saveChars}) {
$self->{values} .= $characters->{Data};
}
}
sub end_element
{
my ($self, $element) = @_;
if ($self->{saveChars})
{
if (@{ $self->{stack} } == 0) {
$self->{parsed}{$element->{Name}} = $self->{values};
}
else {
my $pop = pop @{ $self->{stack} };
$pop->{$element->{Name}} = $self->{values};
push @{ $self->{stack} }, $pop;
}
$self->{saveChars} = 0;
}
elsif (grep { $element->{Name} eq $_ } @stack_tags)
{
my $item = pop @{ $self->{stack} };
my $pop = pop @{ $self->{stack} };
if ($element->{Name} eq "submission") {
push @{ $self->{stack} }, $pop;
$item->{doc} = "$pop->{name}";
$pop = undef;
}
if ($pop)
{
if (!exists $pop->{$element->{Name}."s"}) {
$pop->{$element->{Name}."s"} = [];
}
push @{ $pop->{$element->{Name}."s"} }, $item;
push @{ $self->{stack} }, $pop;
}
else
{
if (!exists $self->{parsed}{$element->{Name}."s"}) {
$self->{parsed}{$element->{Name}."s"} = [];
}
push @{ $self->{parsed}{$element->{Name}."s"} }, $item;
}
}
elsif (grep { $element->{Name} eq $_ } @stackonce_tags)
{
my $item = pop @{ $self->{stack} };
my $pop = pop @{ $self->{stack} };
if ($pop)
{
$pop->{$element->{Name}} = $item;
push @{ $self->{stack} }, $pop;
}
else {
$self->{parsed}{$element->{Name}} = $item;
}
}
else {
return;
}
}
1;

503
ACU/Trace.pm
View file

@ -9,21 +9,20 @@ use Carp;
use utf8;
use open qw(:encoding(UTF-8) :std);
use XML::LibXML;
use XML::SAX::ParserFactory;
use ACU::Log;
sub new
sub new ($$)
{
my $class = shift;
my $self = {
ids => {},
infos => {},
groups => [],
comments => {},
who => {},
};
bless $self, $class;
if ($#_ >= 0) {
$self->_initialize(@_);
}
$self->_initialize(@_);
return $self;
}
@ -32,47 +31,10 @@ sub _initialize ($$)
{
my $self = shift;
my $dom = XML::LibXML->load_xml(string => shift);
$self->{groups} = $self->parseTrace($dom->documentElement());
$self->{type} = $dom->documentElement()->getAttribute("type") // "mill";
$self->{version} = $dom->documentElement()->getAttribute("version") // 1;
}
my $sax_handler = TraceHandler->new($self);
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
sub parseTrace($$)
{
my $self = shift;
my $tree = shift;
my $ret = [];
foreach my $node ($tree->childNodes())
{
if ($node->nodeName eq "info")
{
my $tmp = $node->textContent;
chomp($tmp);
$self->{infos}{ $node->getAttribute("name") } = $tmp;
}
elsif ($node->nodeName eq "group")
{
my $g = Trace::Group->new(
$node->getAttribute("id"),
$node->getAttribute("name")
);
$g->append(@{ $self->parseTrace($node) });
push @$ret, $g;
}
elsif ($node->nodeName eq "eval")
{
my $e = Trace::Eval->new(
$node->getAttribute("id"),
$node->getAttribute("type"),
$node
);
push @$ret, $e;
}
}
return $ret;
$parser->parse_file(shift);
}
sub getVersion ($)
@ -99,148 +61,66 @@ sub getInfos ($)
return $self->{infos};
}
sub addId
sub getComment ($$)
{
my $self = shift;
my $key = shift;
my $value = shift;
my $e = Trace::Eval->new($key);
$e->addValue(undef, $value);
push @{ $self->{groups} }, $e;
return $e;
return $self->{comments}{$_[0]};
}
sub delId
sub getComments ($)
{
my $self = shift;
my $key = shift;
my $value = shift;
foreach my $group (@{ $self->{groups} })
{
if ($group->{id} eq $key)
{
if (!$value || $value == $group->getValue())
{
$self->{groups} = [ grep { $_->{id} ne $key } @{ $self->{groups} } ];
}
last;
}
$group->delId($key, $value);
}
}
sub getIds
{
my $self = shift;
my $login = shift;
my $onlyNonZero = shift // 0;
my %ids;
foreach my $group (@{ $self->{groups} })
{
my %tmp;
if ($self->{type} eq "defense")
{
# For a defense, we consider that this is a group grade, so don't consider login filtering
%tmp = $group->getIds();
} else {
%tmp = $group->getIds($login);
}
while (my ($key, $value) = each %tmp)
{
$ids{$key} = $value if !$onlyNonZero || $value;
}
}
return \%ids;
}
sub getNonZeroIds
{
return getIds($_[0], $_[1], 1);
}
sub getValue
{
my $self = shift;
my $id = shift;
my $login = shift;
my $value = 0;
foreach my $group (@{ $self->{groups} })
{
$value += $group->getValue($id, $login);
}
return $value;
return $self->{comments};
}
sub getWho ($$)
{
my $self = shift;
return $self->getWhos()->{$_[0]};
return $self->{who}{$_[0]};
}
sub getFirstWho ($)
{
my $self = shift;
return $self->getWhos()->{def1_end_group};
return $self->{who}{def1_end_group};
}
sub getWhos
sub getWhos ($)
{
my $self = shift;
my $ret = {};
foreach my $group (@{ $self->{groups} })
{
my $whos = $group->getWhos();
foreach my $who (keys %{ $whos }) {
$ret->{ $who } = $whos->{$who};
}
}
return $ret;
return $self->{who};
}
sub toString ($)
sub getValue ($$)
{
my $self = shift;
return $self->{ids}{$_[0]};
}
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("trace");
foreach my $group (@{ $self->{groups} })
{
$root->appendChild( $group->toString($doc) );
}
$doc->setDocumentElement( $root );
return $doc->toString();
sub getIds ($)
{
my $self = shift;
return $self->{ids};
}
package Trace::Group;
package TraceHandler;
use v5.10.1;
use strict;
use warnings;
use Carp;
use ACU::Log;
use constant NO_ID_VALUE => "__#";
sub new ($$)
{
my $class = shift;
my $self = {
id => shift,
name => shift,
groups => []
parsed => shift,
inComment => "",
inEval => "",
inInfo => "",
inValue => "",
inWho => "",
values => ""
};
bless $self, $class;
@ -248,273 +128,98 @@ sub new ($$)
return $self;
}
sub append ($@)
sub start_element
{
my $self = shift;
my ($self, $element) = @_;
push @{ $self->{groups} }, @_;
if ($element->{Name} eq "trace") {
$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value};
$self->{parsed}{type} = $element->{Attributes}{"{}type"}{Value};
}
elsif ($element->{Name} eq "info") {
$self->{inInfo} = $element->{Attributes}{"{}name"}{Value};
$self->{parsed}{infos}{ $self->{inInfo} } = 0;
$self->{values} = "";
}
elsif ($element->{Name} eq "eval") {
my $tmp = $element->{Attributes}{"{}id"}{Value};
if ($tmp) {
$self->{inEval} = $tmp;
$self->{parsed}{ids}{ $self->{inEval} } = 0;
}
}
elsif ($element->{Name} eq "comment" && $self->{inEval}) {
$self->{inComment} = $self->{inEval};
$self->{values} = "";
}
elsif ($element->{Name} eq "who" && $self->{inEval}) {
$self->{inWho} = $self->{inEval};
$self->{values} = "";
}
elsif ($element->{Name} eq "value") {
if ($element->{Attributes}{"{}id"}{Value}) {
$self->{inValue} = $element->{Attributes}{"{}id"}{Value};
} else {
$self->{inValue} = NO_ID_VALUE;
}
$self->{values} = "";
}
elsif ($element->{Name} ne "group" && $element->{Name} ne "name" && $element->{Name} ne "statut" && $element->{Name} ne "status" && $element->{Name} ne "log") {
croak "Not a valid trace XML: unknown tag ".$element->{Name};
}
}
sub delId
sub characters
{
my $self = shift;
my $key = shift;
my $value = shift;
my ($self, $characters) = @_;
foreach my $group (@{ $self->{groups} })
if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
$self->{values} .= $characters->{Data};
}
}
sub end_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "value")
{
if ($group->{id} eq $key)
if ($self->{values} =~ /(-?[0-9]+(.[0-9]+)?)/)
{
if (!$value || $value == $group->getValue())
{
$self->{groups} = \{ grep { $_->{id} ne $key } @{ $self->{groups} } };
$self->{parsed}{ids}{ $self->{inEval} } += $1;
if ($self->{inValue} ne NO_ID_VALUE and $1) {
$self->{parsed}{ids}{ $self->{inValue} } = $1;
}
last;
}
$group->delId($key, $value);
$self->{inValue} = "";
}
}
sub getIds
{
my $self = shift;
my $login = shift;
my %ids;
foreach my $group (@{ $self->{groups} })
elsif ($element->{Name} eq "eval")
{
my %tmp = $group->getIds($login);
while (my ($key, $value) = each %tmp)
{
$ids{$key} = $value;
}
#delete $self->{parsed}{ids}{ $self->{inEval} } if (!$self->{parsed}{ids}{ $self->{inEval} });
$self->{inEval} = "";
}
$ids{ $self->{id} } = $self->getValue($self->{id}, $login);
return %ids;
}
sub getValue
{
my $self = shift;
my $id = shift // $self->{id};
my $login = shift;
if ($id eq $self->{id})
elsif ($element->{Name} eq "comment")
{
my $value = 0;
foreach my $group (@{ $self->{groups} })
{
$value += $group->getValue(undef, $login);
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
$self->{parsed}{comments}{ $self->{inComment} } = $1;
}
return $value;
$self->{inComment} = "";
}
else
elsif ($element->{Name} eq "who")
{
my $value = 0;
foreach my $group (@{ $self->{groups} })
{
$value += $group->getValue($id, $login);
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
$self->{parsed}{who}{ $self->{inWho} } = $1;
}
return $value;
$self->{inComment} = "";
}
}
sub getWhos
{
my $self = shift;
my $ret = {};
foreach my $group (@{ $self->{groups} })
elsif ($element->{Name} eq "info")
{
my $whos = $group->getWhos();
foreach my $who (keys %{ $whos }) {
$ret->{ $who } = $whos->{$who};
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
$self->{parsed}{infos}{ $self->{inInfo} } = $1;
}
$self->{inInfo} = "";
}
return $ret;
}
sub toString($$)
{
my $self = shift;
my $doc = shift;
my $gr = $doc->createElement("group");
foreach my $item (@{ $self->{groups} })
{
$gr->appendChild( $item->toString() );
}
return $gr;
}
package Trace::Eval;
use v5.10.1;
use strict;
use warnings;
use Carp;
use ACU::Log;
sub new ($$;$)
{
my $class = shift;
my $self = {
id => shift // "",
type => shift // "test",
values => {},
logs => {},
};
bless $self, $class;
if ($#_ >= 0) {
$self->parseEval(@_);
}
return $self;
}
sub parseEval
{
my $self = shift;
my $tree = shift;
foreach my $node ($tree->childNodes())
{
my $val = $node->textContent;
chomp($val);
if ($node->nodeName eq "value")
{
$self->addValue($node->getAttribute("id"),
$val);
}
elsif ($node->nodeName eq "name")
{
$self->{name} = $val;
}
elsif ($node->nodeName eq "status")
{
$self->{status} = $val;
}
elsif ($node->nodeName eq "log")
{
my $key = $node->getAttribute("type") // "stdout";
$self->{logs}{ $key } = $val;
}
elsif ($node->nodeName eq "who")
{
$self->{who} = {
login => $val,
type => $node->getAttribute("type") // "login"
};
}
}
}
sub delId
{
# Do nothing here, just an abstract method
}
sub changeWho
{
my $self = shift;
$self->{who} = {
login => shift,
type => shift // "login"
};
}
sub getIds
{
my $self = shift;
my $login = shift;
my %ids;
if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
{
while (my ($key, $value) = each %{ $self->{values} })
{
$ids{$key} = $value if ($key);
}
$ids{ $self->{id} } = $self->getValue($self->{id}, $login);
}
return %ids;
}
sub addValue
{
my $self = shift;
my $key = shift // "";
my $val = shift;
$self->{values}{ $key } = 0 if (!exists $self->{values}{ $key });
$self->{values}{ $key } += $val;
}
sub getValue
{
my $self = shift;
my $id = shift // $self->{id};
my $login = shift;
my $value = 0;
if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
{
foreach my $key (keys %{ $self->{values} })
{
$value += $self->{values}{$key} if ($id eq $self->{id} || !$key || $key eq $id);
}
}
return $value;
}
sub getWhos
{
my $self = shift;
return { $self->{id} => $self->{who} };
}
sub toString($$)
{
my $self = shift;
my $doc = shift;
my $e = $doc->createElement("eval");
$e->setAttribute("id", $self->{id});
$e->setAttribute("type", $self->{type});
if (defined $self->{who})
{
my $w = $doc->createElement("who");
$w->setAttribute("type", $self->{who}{type}) if (defined $self->{who}{type});
$w->appendTextNode( $self->{who}{login} );
$e->appendChild( $w );
}
for my $k (keys %{ $self->{values} })
{
my $v = $doc->createElement("value");
$v->setAttribute("id", $k) if ($k);
$v->appendTextNode( $self->{values}{$k} );
$e->appendChild( $v );
}
return $e;
}
1;

308
ACU/VCS/Git.pm
View file

@ -1,308 +0,0 @@
#! /usr/bin/env perl
package Git;
use v5.10.1;
use strict;
use warnings;
use File::Path qw(remove_tree);
use File::Temp;
use ACU::LDAP;
use ACU::Log;
use ACU::API::Projects;
our $git_user = "git";
our $git_server;
our $git_adminrepo = "gitolite-admin.git";
our $configuration_directory = "/conf/";
our $configuration_file = "subjects.conf";
our $projects_directory = "subjects/";
my $gitolite_directory;
# General part
sub init_conf(;$)
{
$git_server = $_ if (shift);
$gitolite_directory = mktemp("/tmp/git_manage_XXXX");
log INFO, "Cloning $git_user\@$git_server:$git_adminrepo to $gitolite_directory";
qx(git clone $git_user\@$git_server:$git_adminrepo $gitolite_directory);
chdir($gitolite_directory);
return $gitolite_directory;
}
sub save_conf(;$)
{
chdir($gitolite_directory);
my $commit = shift;
qx(git commit -am '$commit') if ($commit);
log INFO, "Saving repositories configuration";
qx(git push);
chdir("/");
remove_tree($gitolite_directory);
$gitolite_directory = undef;
}
# Auth part: give to user right on repository
sub auth_add
{
my $rgroup = shift;
my $rname = shift;
my $accesss = shift;
init_conf() if (!$gitolite_directory);
say " repo $rname";
for my $access (@{ $accesss })
{
say $access->gen_string("gitolite");
#say " RW+ = \@admins \@$year-$project_name-$login";
#say " RW+ = \@chefs \@resp-$year-$project_name";
}
}
sub auth_update
{
init_conf() if (!$gitolite_directory);
}
sub auth_delete
{
init_conf() if (!$gitolite_directory);
}
sub auth_save
{
init_conf() if (!$gitolite_directory);
}
# Repository part: manage repositories
# Gitolite manage repositories only if there are associated with rights
sub repository_add
{
}
sub repository_update
{
}
sub repository_delete
{
}
sub repository_group_add
{
my $g_name = shift; #group_name
my $g_comp = shift; # complement, here respo rights
my $skip_save = shift // 0;
if ($g_name !~ /^[a-zA-Z-_.]+$/) {
log ERROR, "Group name ($g_name) does not respect expected format ; skip add.";
return 0;
}
init_conf() if (!$gitolite_directory);
if (-f $gitolite_directory.$configuration_directory.$projects_directory."/".$g_name.".conf") {
log ERROR, "Cannot add new repository group: $g_name already exists!";
return 0;
}
else {
open my $g_conf, ">", $gitolite_directory.$configuration_directory.$projects_directory."/".$g_name.".conf";
say $g_conf $g_conf;
close $g_conf;
open $g_conf, ">>", $gitolite_directory.$configuration_directory.$configuration_file;
say $g_conf "include \"$projects_directory/$g_name.conf\"";
close $g_conf;
}
save_conf("Add repositories group $g_name") unless($skip_save);
return 1;
}
sub repository_group_delete
{
my $g_name = shift; #group_name
my $skip_save = shift // 0;
if ($g_name !~ /^[a-zA-Z-_.]+$/) {
log ERROR, "Group name ($g_name) does not respect expected format ; skip add.";
return 0;
}
init_conf() if (!$gitolite_directory);
my $configuration_path = $gitolite_directory.$configuration_directory.$configuration_file;
if (-f $gitolite_directory.$configuration_directory.$projects_directory."/".$g_name.".conf") {
open my $g_conf, "<", $configuration_path;
my @contents = <$g_conf>;
close $g_conf;
@contents = grep !/^include "\Q$projects_directory\/$g_name.conf\E"$/, @contents; #";
open $g_conf, '>', $configuration_path or die $!;
print $g_conf @contents;
close $g_conf;
unlink($gitolite_directory.$configuration_directory.$projects_directory."/".$g_name.".conf");
}
else {
log WARN, "Repository group $g_name not found.";
return 0;
}
save_conf("Delete repositories group $g_name") unless($skip_save);
return 1;
}
sub repository_group_update
{
my $g_name = shift;
repository_group_delete($g_name, 1);
if (!repository_group_add($g_name, shift, 1)) {
log ERROR, "Unable to readd $g_name group repository. Configuration not saved.";
return 0;
}
# ...;
auth_add();
save_conf("Delete repositories group $g_name") unless(shift);
}
# User part: manage user authentication (password, keys, ...)
sub user_add
{
my $login = shift;
my $skip_save = shift // 0;
my $multiple = shift // 0;
if (!$login or $login !~ /^(\*|[a-zA-Z0-9._-]+)$/) {
log WARN, "Login required in user_add";
return 0;
}
init_conf() if (!$gitolite_directory);
# First, remove all user keys
user_delete($login, 1, $multiple);
# Then, extract user keys
my @entries = LDAP::search_dns(undef, "ou=users", "&(uid=$login)(sshPublicKey=*)", "uid", "sshPublicKey");
if ($#entries > 1 && !$multiple) { log WARN, "Found multiple user $login, aborting keys update."; return 0; }
for my $entry (@entries)
{
my $login = $entry->get_value("uid");
if ($login)
{
my $i = 0;
my @keys = $entry->get_value("sshPublicKey");
log INFO, "Updating ".($#keys+1)." keys for $login.";
for my $key (@keys)
{
chomp $key;
mkdir $gitolite_directory."/keydir/$i" unless (-d $gitolite_directory."/keydir/$i");
open my $kf, ">", $gitolite_directory."/keydir/$i/$login.pub";
print $kf $key;
close $kf;
qx(git add $gitolite_directory/keydir/$i/$login.pub);
$i += 1;
}
}
}
if ($multiple) {
save_conf("Update users keys from LDAP") unless ($skip_save);
}
else {
save_conf("Update $login keys from LDAP") unless ($skip_save);
}
return 1;
}
sub user_delete
{
my $login = shift;
my $skip_save = shift // 0;
my $multiple = shift // 0;
if (!$login) {
log WARN, "Login required in user_add";
return 0;
}
init_conf() if (!$gitolite_directory);
opendir(my $dh, "$gitolite_directory/keydir/") || die "can't opendir keydir: $!";
for my $f (readdir $dh)
{
if($multiple)
{
if ($f =~ /^[0-9]/ && -d "$gitolite_directory/keydir/$f") {
log INFO, "Removing $f directory";
remove_tree("$gitolite_directory/keydir/$f");
}
}
else
{
if (-f "$gitolite_directory/keydir/$f/$login.pub") {
log INFO, "Removing $f/$login.pub";
unlink("$gitolite_directory/keydir/$f/$login.pub");
}
}
}
closedir $dh;
save_conf("Remove $login keys") unless ($skip_save);
return 1;
}
sub user_update
{
return user_add(@_);
}
sub users_update
{
return user_add("*", (shift // 0), 1);
}
sub users_del
{
return user_del("*", (shift // 0), 1);
}
1;

61
Makefile
View file

@ -1,60 +1,21 @@
COPY?=cp -v
CURL?=curl
DEST?=/usr/local/share/perl/`ls -1 /usr/local/share/perl/ | grep "^5." | tail -1`/
GIT?=/usr/bin/git
GITOLITE_DEST?=/usr/share/gitolite/hooks/common
MAKEDIR?=mkdir
PERL?=/usr/bin/env perl
PROVER?=prove -f
RM?=rm
RMTREE?=rm -r
TESTDIR?=t
SHELL?=/bin/sh
launch:
$(SHELL) ./process/launch.sh
COPY=cp -v
DEST=/usr/local/share/perl/`ls -1 /usr/lib/perl/ | tail -1`/
GITOLITE_DEST=/usr/share/gitolite/hooks/common
MAKEDIR=mkdir
PROVER=prove -f
RM=rm
TESTDIR=t
install:
$(SHELL) commands/first-install.sh
$(MAKEDIR) -p $(DEST)
$(COPY) -r ACU/ $(DEST)
! test -d $(GITOLITE_DEST) || $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d
! test -d $(GITOLITE_DEST) || $(COPY) hooks/gl-pre-git $(GITOLITE_DEST)/
! test -d $(GITOLITE_DEST) || $(COPY) hooks/post-update $(GITOLITE_DEST)/
! test -d $(GITOLITE_DEST) || $(COPY) hooks/subjects.pl $(GITOLITE_DEST)/update.secondary.d/
! test -d $(GITOLITE_DEST) || $(COPY) hooks/conferences.pl $(GITOLITE_DEST)/update.secondary.d/
! test -d $(GITOLITE_DEST) || $(COPY) hooks/submissions.pl $(GITOLITE_DEST)/update.secondary.d/
guantanamo.tar.gz:
$(MAKEDIR) -p guantanamo/ACU
$(COPY) process/exec/guantanamo_node.pl guantanamo/
$(COPY) ACU/Log.pm ACU/Process.pm process/exec/guantanamo_node.pl guantanamo/ACU/
$(COPY) process/exec/run.sh.not-here guantanamo/run.sh
chmod +x guantanamo/run.sh
tar czf guantanamo.tar.gz guantanamo/
$(RMTREE) guantanamo
update:
$(GIT) pull
$(SHELL) commands/first-install.sh
upgrade: install
test -d $(GITOLITE_DEST) && $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d
test -d $(GITOLITE_DEST) && $(COPY) hooks/* $(GITOLITE_DEST)/update.secondary.d/
unstall:
$(RM) -r $(DEST)/ACU/
! test -d $(GITOLITE_DEST) || $(RM) -rf $(GITOLITE_DEST)/gl-pre-git
! test -d $(GITOLITE_DEST) || $(RM) -rf $(GITOLITE_DEST)/update.secondary.d
! test -d $(GITOLITE_DEST) || $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d
regen-objects:
$(MAKEDIR) -p ACU/dtd
$(CURL) -o ACU/dtd/defense.dtd http://acu.epita.fr/dtd/defense.dtd
$(CURL) -o ACU/dtd/grading.dtd http://acu.epita.fr/dtd/grading.dtd
$(CURL) -o ACU/dtd/groups.dtd http://acu.epita.fr/dtd/groups.dtd
$(CURL) -o ACU/dtd/project.dtd http://acu.epita.fr/dtd/project.dtd
$(CURL) -o ACU/dtd/traces.dtd http://acu.epita.fr/dtd/traces.dtd
$(PERL) -I baldr baldr/Baldr.pl --import="ACU/Objects/basecode/*.pm" --path=ACU/Objects ACU/dtd/defense.dtd ACU/dtd/grading.dtd ACU/dtd/groups.dtd ACU/dtd/project.dtd ACU/dtd/traces.dtd
$(RMTREE) ACU/dtd
test -d $(GITOLITE_DEST) && $(RM) -rf $(GITOLITE_DEST)/update.secondary.d
test -d $(GITOLITE_DEST) && $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d
test:
$(PROVER) $(TESTDIR)

93
commands/defenses/prepare_xml.pl
View file

@ -1,93 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use XML::LibXML;
use lib "../";
use ACU::Defense;
# Parse arguments
my $input; my $output;
my $help; my $man;
GetOptions ("output|O=s" => \$output,
"help|h|?" => \$help,
"man" => \$man,
"" => \$input)
or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitval => 0, -verbose => 2) if $man;
# Open defense XML file
my $xmlin;
if (defined $input || $#ARGV == -1) {
$xmlin = *STDIN;
}
else {
open $xmlin, "<", $ARGV[0] or die $!;
}
binmode $xmlin;
my $str;
$str .= $_ while(<$xmlin>);
my $defense = Defense->new($str);
close $xmlin unless $xmlin eq *STDIN;
$defense->genIds;
# Save defense XML file
my $xmlout;
if (defined $output) {
open $xmlout, '>', $output;
binmode $xmlout;
}
else {
$xmlout = *STDOUT;
}
print {$xmlout} $defense->toString();
close $xmlout unless $xmlout eq *STDOUT;
__END__
=head1 NAME
prepare_xml.pl - Prepare defense XML by adding id to groups, questions and answers
=head1 SYNOPSIS
prepare_xml.pl [options] [file]
=head1 DESCRIPTION
Parse the XML file given (or stdin if no file is given) and add id to groups, questions and answers that have any or duplicate id.
Options:
-output=file.xml save prepared XML to this location
-help brief help message
-man full documentation
=head1 OPTIONS
=over 8
=item B<-output=file.xml>
Save the prepared XML to a file instead of printing it on standard output.
=item B<-help>
Print a brief help message and exits.
=item B<-man>
Prints the manual page and exits.
=back
=cut

115
commands/first-install.sh
View file

@ -1,115 +0,0 @@
#! /bin/bash
# Install missing packages
DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl libemail-sender-perl libtext-glob-perl"
ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin aur/perl-text-glob
GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/XML-LibXML dev-perl/IO-Socket-SSL 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 dev-perl/Email-Sender dev-perl/Text-Glob"
FBSD_PACKAGES_LIST="screen p5-XML-LibXML p5-Gearman p5-IO-Socket-SSL p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin p5-Text-Glob"
KERNEL=`uname -s`
if [ "$KERNEL" = "FreeBSD" ]
then
for PK in `echo $FBSD_PACKAGES_LIST`
do
if ! pkg info "$PK" > /dev/null 2> /dev/null
then
if ! PACKAGESITE="http://canon.acu.epita.fr/repo-lab" pkg install "$PK"
then
echo "Error during installation of $PK"
exit 1
fi
fi
done
if ! getent passwd | grep "intradmin:" > /dev/null 2> /dev/null
then
pw useradd intradmin -u 942 -d /data -s /bin/false
fi
elif [ "$KERNEL" = "Linux" ]
then
if [ -f "/etc/debian_version" ]
then
if ! whereis dpkg > /dev/null 2> /dev/null
then
if ! aptitude install dpkg
then
echo "Error during installation of $PK"
exit 1
fi
fi
for PK in $DEB_PACKAGES_LIST
do
if ! dpkg -l | grep "^ii" | grep "$PK" > /dev/null 2> /dev/null
then
aptitude install "$PK"
fi
done
# Add intradmin user if missing
if ! getent passwd | grep "intradmin:" > /dev/null 2> /dev/null
then
useradd --shell /bin/false --uid 942 intradmin &&
mkdir -p /home/intradmin
fi
chown -R intradmin:intradmin /home/intradmin
elif [ -f "/etc/arch-release" ]
then
for PK in $ARCH_PACKAGES_LIST
do
if ! pacman -Qi "$PK" > /dev/null 2> /dev/null
then
if ! pacman -S "$PK"
then
echo "Error during installation of $PK"
exit 1
fi
fi
done
elif [ -f "/etc/gentoo-release" ]
then
for PK in $GENTOO_PACKAGES_LIST
do
if ! equery list "$PK" > /dev/null 2> /dev/null
then
if ! emerge "$PK"
then
echo "Error during installation of $PK"
exit 1
fi
fi
done
else
echo "Unsupported GNU/Linux distribution :("
exit 1;
fi
else
echo "Unsupported operating system :("
exit 1;
fi
# Git ?
if egrep '^git:' /etc/passwd > /dev/null
then
mkdir -p /var/log/hooks/ &&
chown git /var/log/hooks/
fi
echo "System ready!"

14
commands/gen_pass.pl
View file

@ -1,14 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Pod::Usage;
BEGIN {
push @INC, "../";
}
use ACU::Password;
say Password::gen_password($ARGV[0], $ARGV[1]);

50
commands/grades/send_bonusmalus.pl
View file

@ -1,50 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use File::Basename;
use lib "../../";
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
if ($#ARGV >= 1)
{
my $project_id = shift;
my $year = shift;
if ($year !~ /^[0-9]{4}$/)
{
unshift @_, $year;
$year = LDAP::get_year();
}
my %files;
for my $f (@_)
{
open my $input, "<", $f or die("$f: $@");
my $cnt;
$cnt .= $_ while (<$input>);
close $input unless $input eq *STDIN;
$files{ basename($f, ".txt", ".lst", ".list", ".xml") } = $cnt;
}
if (my $err = Process::Client::launch("intradata_get", { action => "new_bonus", type => "grades", id => $project_id, "year" => $year }, \%files))
{
if (${ $err } ne "Ok") {
log ERROR, "Erreur durant le processus de publication : " . ${ $err };
}
}
}
else
{
say "$0 [-d] <project_id> [project_year] <file> [files ...]";
say "\t-d: delete bonus for listed logins (matching value if given)"
}

14
commands/guantanamo_list.sh
View file

@ -1,14 +0,0 @@
#!/bin/sh
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
cat <<EOF | gearman -h gearmand -p 4730 -f guantanamo
<?xml version="1.0" encoding="UTF-8"?>
<process>
<param name="action">list</param>
</process>
EOF

14
commands/ldap/extract_students.pl
View file

@ -10,22 +10,22 @@ use lib "../../";
use ACU::Log;
use ACU::LDAP;
sub get_students
sub get_students()
{
my $ldap = LDAP::ldap_connect();
my $year = shift // LDAP::get_year($ldap);
my $year = LDAP::get_year($ldap);
return LDAP::search_dns($ldap, "ou=$year,ou=users", "objectClass=epitaAccount", "cn", "uid", "uidNumber");
}
if ($#ARGV == -1) {
log(USAGE, "$0 format");
say "format can be csv or login"
say "format can be csv"
}
elsif ($ARGV[0] eq "csv")
{
for my $student (get_students $ARGV[1])
for my $student (get_students)
{
print $student->get_value("cn");
print ",";
@ -35,9 +35,3 @@ elsif ($ARGV[0] eq "csv")
say ",Present";
}
}
elsif ($ARGV[0] eq "login")
{
for my $student (get_students $ARGV[1]) {
say $student->get_value("uid");
}
}

133
commands/manage-server.sh
View file

@ -1,133 +0,0 @@
#! /usr/bin/env bash
cd $(dirname "$0")
WKS_LIST="apl"
SRV_LIST="moore noyce hamano cpp otto"
SCP_LIST="ksh knuth"
KNOWN_ACTIONS="start stop restart install update log viewlog view_log"
LOG=`mktemp`
ACTIONS=
DESTS=
USED=1
while [ $# -gt 0 ] && [ $USED -eq 1 ]
do
USED=0
for ACT in $KNOWN_ACTIONS
do
if [ -n "$1" ] && [ "$1" == "$ACT" ]
then
ACTIONS="$ACTIONS $ACT"
USED=1
break
fi
done
for DEST in $WKS_LIST $SRV_LIST $SCP_LIST
do
if [ -n "$1" ] && [ "$1" == "$DEST" ]
then
DESTS="$DESTS $DEST"
USED=1
break
fi
done
if [ "$1" == "@srv" ]
then
DESTS="$DESTS $SRV_LIST"
USED=1
elif [ "$1" == "@wks" ]
then
DESTS="$DESTS $WKS_LIST"
USED=1
fi
if [ $USED -eq 1 ]
then
shift
fi
done
if [ -z "$ACTIONS" ]
then
echo "Usage: $0 [where] <`echo $KNOWN_ACTIONS | sed 's/ /|/g'`> [options]"
exit 1
fi
if [ -z "$DESTS" ]
then
DESTS="$SRV_LIST $WKS_LIST $SCP_LIST"
fi
OPTIONS=
while [ $# -gt 0 ]
do
OPTIONS="$OPTIONS $1"
shift
done
FAIL=0
for ACTION in $ACTIONS
do
for DEST in $DESTS
do
echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m"
if [ "$ACTION" == "install" ] || [ "$ACTION" == "update" ]
then
SCP=0
for D in $SCP_LIST
do
if [ $D == $DEST ]
then
SCP=1
break
fi
done
if [ $SCP -eq 0 ]
then
if [ "$ACTION" == "install" ] &&
! ssh root@$DEST "mkdir -p /home/intradmin/ && git clone '$(echo `git remote -v` | cut -d " " -f 2)' /home/intradmin/liblerdorf && ln -s /home/intradmin/liblerdorf ~/liblerdorf"
then
exit 1
fi
ssh root@$DEST "make -C liblerdorf update upgrade"
else
cd ..
git archive -o ./liblerdorf.tbz2 master
scp ./liblerdorf.tbz2 root@$DEST:
cd -
ssh root@$DEST rm -rf liblerdorf
ssh root@$DEST mkdir -p liblerdorf
ssh root@$DEST tar xf ./liblerdorf.tbz2 -C liblerdorf
ssh root@$DEST "DEST=/usr/local/lib/perl5/5.14/ACU make -C liblerdorf upgrade"
fi
elif [ "$ACTION" == "log" ] || [ "$ACTION" == "viewlog" ] || [ "$ACTION" == "view_log" ]
then
ssh root@$DEST '~'/liblerdorf/process/view_log.sh $OPTIONS
else
ssh root@$DEST '~'/liblerdorf/process/launch.sh "$ACTION"
fi
if [ $? -eq 0 ]
then
echo -e "\e[1;32m>>>\e[0m \e[33m$ACTION\e[0m success on \e[1m$DEST\e[0m" | tee -a "$LOG"
else
echo -e "\e[1;31m>>>\e[0m \e[33m$ACTION\e[0m fails on \e[1m$DEST\e[0m" | tee -a "$LOG"
FAIL=1
fi
echo
done
done
cat "$LOG"
exit $FAIL

45
commands/moulette/launch.sh
View file

@ -1,45 +0,0 @@
#!/bin/sh
if [ -z "$2" ]
then
echo "Usage: $0 [year] <project> <submission> [login ...]"
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
if [ "x${1:0:2}" = "x20" ]
then
YEAR="$1"
shift
else
YEAR=`ldapsearch -x -b "cn=year,dc=acu,dc=epita,dc=fr" | grep "^year" | cut -d " " -f 2`
fi
PROJECT_ID=$1
RENDU=$2
shift 2
LOGINS=
while [ $# -gt 0 ]
do
LOGINS="$LOGINS <param>$1</param>
"
shift
done
cat <<EOF | gearman -h gearmand-srv -p 4730 -f moulette_get
<?xml version="1.0" encoding="UTF-8"?>
<process>
<param name="type">moulette</param>
<param name="year">$YEAR</param>
<param name="id">$PROJECT_ID</param>
<param name="rendu">$RENDU</param>
$LOGINS</process>
EOF
echo

83
commands/moulette/send_tarball.sh
View file

@ -1,83 +0,0 @@
#!/bin/bash
usage()
{
echo "Usage: $0 [-d] [year] <project> <submission> <login> <tarball>"
}
if [ -z "$4" ]
then
usage
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
if [ "x$1" = "x-d" ]
then
BACKGROUD=
shift
else
BACKGROUD="-b"
fi
if [ "x${1:0:2}" = "x20" ]
then
YEAR=" <param name=\"year\">$1</param>"
shift
else
YEAR=
fi
PROJECT_ID=$1
RENDU=$2
LOGIN=$3
if ! [ -f "$4" ]
then
usage
exit 2
fi
MIME=`file -b -i "$4" | cut -d ';' -f 1`
if [ "$MIME" = "application/x-bzip2" ]
then
FILE=`bzip2 --decompress --stdout "$4" | gzip --stdout | base64`
elif [ "$MIME" = "application/x-gzip" ]
then
FILE=`gzip --decompress --stdout "$4" | gzip --stdout | base64`
elif [ "$MIME" = "application/x-xz" ]
then
FILE=`xz --decompress --stdout "$4" | gzip --stdout | base64`
elif [ "$MIME" = "application/x-tar" ]
then
FILE=`tar cz "$4" | base64`
elif [ "$MIME" = "inode/directory" ]
then
FILE=`tar xf "$4" | tar cz | base64`
else
echo "I don't know how to treat $4" >&2
exit 3
fi
cat <<EOF | gearman -h gearmand-srv -p 4730 -f moulette_get $BACKGROUD
<?xml version="1.0"?>
<process>
<param name="type">std</param>
$YEAR
<param name="id">$PROJECT_ID</param>
<param name="rendu">$RENDU</param>
<param name="login">$LOGIN</param>
<param name="file">rendu.tgz</param>
<file name="rendu.tgz">$FILE</file>
</process>
EOF

59
commands/moulette/sendgit.sh
View file

@ -1,59 +0,0 @@
#!/bin/sh
usage()
{
echo "Usage: $0 [-d] [year] <project> <submission> <login> [login ...]"
}
if [ -z "$3" ]
then
usage
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
if [ "x$1" = "x-d" ]
then
BACKGROUD=
shift
else
BACKGROUD="-b"
fi
if [ "x${1:0:2}" = "x20" ]
then
YEAR=" <param name=\"year\">$1</param>"
shift
else
YEAR=
fi
PROJECT_ID=$1
RENDU=$2
shift 2
if [ $# -le 0 ]
then
usage
exit 1
fi
while [ $# -gt 0 ]
do
LOGIN=$1
cat <<EOF | gearman -h gearmand -p 4730 -f send_git $BACKGROUD
<?xml version="1.0"?>
<process>
$YEAR
<param name="id">$PROJECT_ID</param>
<param name="rendu">$RENDU</param>
<param name="login">$LOGIN</param>
</process>
EOF
shift
done

23
commands/moulette/set_max_memory.sh
View file

@ -1,23 +0,0 @@
#!/bin/sh
if [ -z "$1" ]
then
echo "Usage: $0 <memory>"
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
cat <<EOF | gearman -h gearmand-srv -p 4730 -f moulette_get
<?xml version="1.0" encoding="UTF-8"?>
<process>
<param name="type">set_memory</param>
<param name="to">$1</param>
</process>
EOF
echo

23
commands/moulette/set_workers.sh
View file

@ -1,23 +0,0 @@
#!/bin/sh
if [ -z "$1" ]
then
echo "Usage: $0 <nb_worker>"
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
cat <<EOF | gearman -h gearmand-srv -p 4730 -f moulette_get
<?xml version="1.0" encoding="UTF-8"?>
<process>
<param name="type">set_workers</param>
<param name="to">$1</param>
</process>
EOF
echo

29
commands/moulette/stats.sh
View file

@ -1,29 +0,0 @@
#!/bin/sh
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
ACTION=
if [ -n "$1" ]
then
if [ "$1" = "flush" ]
then
ACTION=" <param name=\"action\">flush</param>
"
else
echo "Unknown action '$1'"
exit 1
fi
fi
cat <<EOF | gearman -h gearmand-srv -p 4730 -f moulette_get
<?xml version="1.0" encoding="UTF-8"?>
<process>
<param name="type">stats</param>
$ACTION</process>
EOF
echo

4
commands/project/create.pl
View file

@ -4,13 +4,15 @@ use v5.10.1;
use strict;
use warnings;
use lib "../../";
use ACU::API::Base;
use ACU::API::Projects;
if ($#ARGV == 0)
{
API::Projects::add($ARGV[0], "");
API::Projects::add($ARGV[0]);
}
else
{

40
commands/project/gen_git_str.pl
View file

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

6
commands/project/gen_groups.pl
View file

@ -10,11 +10,11 @@ use ACU::API::Base;
use ACU::API::Projects;
if ($#ARGV == 0 or $#ARGV == 1)
if ($#ARGV == 0)
{
API::Projects::gen_groups($ARGV[0], $ARGV[1]);
API::Projects::gen_groups($ARGV[0]);
}
else
{
say "$0 <project_id> [year]";
say "$0 <project_id>";
}

20
commands/project/pub_traces.pl
View file

@ -1,20 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use lib "../../";
use ACU::API::Base;
use ACU::API::Projects;
if ($#ARGV == 1)
{
API::Projects::add_traces($ARGV[0], $ARGV[1]);
}
else
{
say "$0 <project_id> <traces_id>";
}

39
commands/project/send_dir_to_moulette.sh
View file

@ -1,39 +0,0 @@
#!/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
View file

@ -1,50 +0,0 @@
#!/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

0
migration/defense_converter.pl → defenses/defense_converter.pl
View file

158
defenses/prepare_xml.pl Normal file
View file

@ -0,0 +1,158 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use XML::LibXML;
# Extract IDs and remove duplicates
sub extract_ids (\@@)
{
my $ids = shift @_;
foreach my $node (@_)
{
my $att = $node->getAttribute("id");
if (defined $att)
{
if (grep {$_ eq $att} @$ids) {
$node->removeAttribute("id");
}
else {
push @$ids, $att;
}
}
}
}
# Parse arguments
my $input; my $output;
my $help; my $man;
GetOptions ("output|O=s" => \$output,
"help|h|?" => \$help,
"man" => \$man,
"" => \$input)
or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitval => 0, -verbose => 2) if $man;
# Open defense XML file
my $xmlin;
if (defined $input || $#ARGV == -1) {
$xmlin = *STDIN;
}
else {
open $xmlin, "<", $ARGV[0] or die $!;
}
binmode $xmlin;
my $dom = XML::LibXML->load_xml(IO => $xmlin);
close $xmlin unless $xmlin eq *STDIN;
# First, get all existing ID and remove duplicates
my @ids;
extract_ids @ids, $dom->getElementsByTagName("group");
extract_ids @ids, $dom->getElementsByTagName("question");
extract_ids @ids, $dom->getElementsByTagName("answer");
# Then, attribute an ID to node that hasn't
my $grp_i = 0;
foreach my $group ($dom->getElementsByTagName("group"))
{
my $cur_gid = $group->getAttribute("id");
if (!defined $cur_gid) {
do {
$cur_gid = "defg".$grp_i;
$grp_i += 1;
} while (grep {$_ eq $cur_gid} @ids);
$group->setAttribute("id", $cur_gid);
}
else {
$grp_i += 1;
}
my $qst_i = 0;
foreach my $question ($group->getElementsByTagName("question"))
{
my $cur_qid = $question->getAttribute("id");
if (!defined $cur_qid) {
do {
$cur_qid = $cur_gid."q".$qst_i;
$qst_i += 1;
} while (grep {$_ eq $cur_qid} @ids);
$question->setAttribute("id", $cur_qid);
}
else {
$qst_i += 1;
}
my $ans_i = 0;
foreach my $answer ($question->getElementsByTagName("answer"))
{
my $cur_aid = $answer->getAttribute("id");
if (!defined $cur_aid) {
do {
$cur_aid = $cur_qid."a".$ans_i;
$ans_i += 1;
} while (grep {$_ eq $cur_aid} @ids);
$answer->setAttribute("id", $cur_aid);
}
else {
$ans_i += 1;
}
}
}
}
# Save defense XML file
my $xmlout;
if (defined $output) {
open $xmlout, '>', $output;
binmode $xmlout;
}
else {
$xmlout = *STDOUT;
}
print {$xmlout} $dom->toString();
close $xmlout unless $xmlout eq *STDOUT;
__END__
=head1 NAME
prepare_xml.pl - Prepare defense XML by adding id to groups, questions and answers
=head1 SYNOPSIS
prepare_xml.pl [options] [file]
=head1 DESCRIPTION
Parse the XML file given (or stdin if no file is given) and add id to groups, questions and answers that have any or duplicate id.
Options:
-output=file.xml save prepared XML to this location
-help brief help message
-man full documentation
=head1 OPTIONS
=over 8
=item B<-output=file.xml>
Save the prepared XML to a file instead of printing it on standard output.
=item B<-help>
Print a brief help message and exits.
=item B<-man>
Prints the manual page and exits.
=back
=cut

9
grades/gen_grading.pl
View file

@ -41,11 +41,8 @@ do {
open $xml, "<", $file or die $!;
binmode $xml;
my $str;
$str .= $_ while (<$xml>);
eval {
$trace = Defense->new($str);
$trace = Defense->new($xml);
};
if ($@) {
log ERROR, "Unknown file type: $file";
@ -54,8 +51,8 @@ do {
close $xml unless $xml eq *STDIN;
$grade->create_from_ids($id_name, $name, $trace);
$grade->create_from_trace($id_name, $name, $trace);
} while ($#ARGV >= 0);
print $grade->toString();
print $grade->to_string();

4
grades/generate.pl
View file

@ -34,9 +34,7 @@ else {
open $xmlgrading, "<", shift or die $!;
}
binmode $xmlgrading;
my $str;
$str .= $_ while(<$xmlgrading>);
my $grade = Grading->new($str);
my $grade = Grading->new($xmlgrading);
close $xmlgrading unless $xmlgrading eq *STDIN;
my $who = "";

49
hooks/conferences.pl
View file

@ -1,49 +0,0 @@
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use Digest::SHA qw(sha1_base64);
use File::Basename;
use utf8;
use ACU::API::Projects;
use ACU::Defense;
use ACU::LDAP;
use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
use ACU::Process;
# First, check if the repository is in the conferences/ directory
exit 0 if ($ENV{GL_REPO} !~ /^conferences\//);
my ($ref, $oldsha, $newsha) = @ARGV;
log DONE, "This is a conference repository!";
my %known_tags = (
"subject" => \&tag_document,
);
if ($ref =~ m<^refs/tags(/.+)$>)
{
my $tag = $1;
my @args;
while ($tag =~ m<[,/]([^,]*)>g) {
push @args, $1;
}
my $create = ($newsha ne '0' x 40);
if (exists $known_tags{$args[0]}) {
exit $known_tags{$args[0]}($create, @args);
}
}
exit 0;
sub tag_document
{
}

40
hooks/dump-help.pl
View file

@ -1,40 +0,0 @@
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use utf8;
use Carp;
use File::Basename;
use File::Path qw(remove_tree);
use File::Temp qw/tempfile tempdir/;
use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
use ACU::Process;
# First, check if the repository is dump-help
exit 0 if ($ENV{GL_REPO} ne "dump-help");
my ($ref, $oldsha, $newsha) = @ARGV;
log DONE, "This is the dump-help repository!";
exit 0 if ($newsha eq '0' x 40);
if ($ref eq "refs/tags/release")
{
my $archive = qx(git archive --format=tgz $newsha);
#qx(git clone -b release /srv/git/repositories/dump-help.git '$tempdir') or croak "It is not a valid repository.";
Process::Client::launch("docs_compile",
{
"type" => "dump_help",
"file" => "dump-help.tgz" ,
},
{ "dump-help.tgz" => $archive });
}
exit 0;

84
hooks/gl-pre-git
View file

@ -1,84 +0,0 @@
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use File::Basename;
use Net::IP;
use utf8;
use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
my $ip = $1 if ($ENV{'SSH_CLIENT'} =~ m/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}).*/);
exit 0 if (!$ip);
log DEBUG, "Connection by $ENV{GL_USER} 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);
my @apping3 = qw(saadi_n lucas_e jawhar_s france_b roux_m bamba_m boudje_s gillot_l le-pen_m gimene_a nguye_d marin_c piedno_j salmon_b);
my @habitent_loin = qw(amed_m bellev_m freima_m ikouna_l simon_j faure_n abdelm_a habri_z trang_d henrie_p verbec_y molini_v marti_o colin_j);
# First, check if the repository is in the YYYY/ directory
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/);
$ip = Net::IP->new($ip) or die ("IP invalide");
my $labnetwork = Net::IP->new('192.168.0.0/16');
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;
#}
exit 0 if ($id_project eq "lse-project" && $ip->ip() eq "10.224.4.1");
exit 0 if (grep { /\Q$ENV{GL_USER}\E/ } @habitent_loin, @apping3, "icaza_fact");
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;
}
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;
}
exit 0;

116
hooks/post-update
View file

@ -1,116 +0,0 @@
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use File::Basename;
use utf8;
use ACU::API::Projects;
use ACU::API::Submission;
use ACU::LDAP;
use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
use ACU::Process;
my $promo;
my $id_project;
my $repo_login;
# First, extract information, from config then guess from repository adress
if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; }
if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; }
if (my $tmp = `git config hooks.login`) { chomp $tmp; $repo_login = $tmp; }
$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/.*\/.*\/(.*)/);
exit(0) if (!$promo || !$id_project || !$repo_login);
for my $ref (@ARGV)
{
my $tag;
my $tag_for;
if ($ref =~ m<^refs/tags/(ACU-(.+))$>)
{
$tag = $1;
$tag_for = $2;
}
elsif ($ref =~ m<^refs/tags/(.+)$>)
{
$tag = $1;
$tag_for = $1;
}
else {
next;
}
log DEBUG, "Tag $tag ($tag_for) on repository $ENV{GL_REPO} from IP $ENV{'SSH_CLIENT'} updated.";
my $project = get_project_info($tag_for);
# Extract matching tag
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $tag_for;
} @{ $project->{submissions} };
if (@rendus)
{
eval
{
Process::Client::launch("send_git",
{
"year" => $promo,
"id" => $id_project,
"rendu" => $tag,
"login" => $repo_login,
# "path" => "ssh://git\@localhost/".$ENV{GL_REPO}, # Optional
},
undef, # Don't give any file
1 # Launch in background
);
};
if ($@)
{
my $err = $@;
log DEBUG, "ERROR: ".$err;
}
# Send data to API
my $last_commit = `git log "refs/tags/$tag" -1 --decorate --tags`;
eval {
API::Submission::add($promo, $id_project, $tag_for, $repo_login, $last_commit);
};
if ($@)
{
my $err = $@;
log DEBUG, "ERROR: ".$err;
log DONE, "Tag '$tag' effectué avec succès !";
}
else {
log DONE, "Tag '$tag' effectué avec succès ! Vérifiez-le sur l'intranet.";
}
}
}
exit 0;
sub get_project_info
{
my $project;
eval {
$project = API::Projects::get($id_project, $promo);
};
if ($@ or !$project)
{
my $err = $@;
log TRACE, $err;
log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire.";
exit(1);
}
#log TRACE, $project;
return $project;
}

572
hooks/subjects.pl
View file

@ -3,15 +3,11 @@
use strict;
use warnings;
use v5.10;
use Digest::SHA qw(sha1_base64);
use File::Basename;
use utf8;
use ACU::API::Projects;
use ACU::Defense;
use ACU::LDAP;
use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
$ACU::Log::log_file = undef;
use ACU::Process;
# First, check if the repository is in the subjects/ directory
@ -19,7 +15,7 @@ exit 0 if ($ENV{GL_REPO} !~ /^subjects\//);
my ($ref, $oldsha, $newsha) = @ARGV;
log DONE, "This is a subject repository!";
log WARN, "This is a subject!";
my %known_tags = (
"defense" => \&tag_defense,
@ -35,7 +31,7 @@ if ($ref =~ m<^refs/tags(/.+)$>)
my $tag = $1;
my @args;
while ($tag =~ m<[,/]([^,]*)>g) {
while ($tag =~ m<[:/]([^:]+)>g) {
push @args, $1;
}
@ -60,7 +56,7 @@ sub check_xml
else {
open $fh, "|xmllint --noout -";
}
print $fh ${ $content };
print $fh $content;
close $fh;
return $?;
@ -69,161 +65,43 @@ sub check_xml
sub repository_name
{
my $repo = $ENV{GL_REPO};
$repo =~ s#subject.*/([^/]+)$#$1#;
$repo =~ s/^subjects\\(.*)/$1/;
return $repo;
}
sub tag_defense
{
my $creation = shift;
# From here, we have:
# 0: "defense"
# 1: $version
# 2: $id
# 3: $path
# 4: $year
my $version = $_[1] // 1;
my $project_id = repository_name();
if ($_[2]) {
$project_id .= "-" . $_[2];
}
$project_id = lc $project_id;
$project_id =~ s/[^a-z0-9-_]/_/g;
my $path;
if ($_[3])
{
if ($_[3] =~ /^(?:defenses\/)?([a-zA-Z0-9_.\/-]+?)(?:.xml)?$/) {
$path = "defenses/".$1.".xml";
} else {
$path = $_[3];
}
}
else
{
# Looking for an uniq defense file in defenses/
$path = qx(git ls-tree -r --name-only $ARGV[2] defenses/ | egrep '\.xml\$');
my $nb_defenses = $path =~ tr/\n//;
if ($nb_defenses > 1) {
log ERROR, "Veuillez préciser le chemin de la soutenance à utiliser avec un tag : defense,", $_[1] // "", ",", $_[2] // "", ",file_to_use";
exit 1;
}
elsif ($nb_defenses == 0) {
log ERROR, "Aucune soutenance n'a été trouvée dans le dossier defenses/";
exit 1;
}
chomp($path);
}
log WARN, "Placez votre soutenance dans le dossier defenses/." if ($path !~ /^defenses/);
my $defense_id = basename($path);
$defense_id =~ s/\.xml$//;
$defense_id =~ s/[^a-zA-Z0-9_.-]/_/g;
my $year;
if ($_[4])
{
# Check on year
if ($_[4] !~ /^\d+$/) {
log ERROR, "project:*:* second argument is the year. Tag format: project:id:year";
}
$year = $_[4];
}
else {
$year = LDAP::get_year;
}
# Determine full tag
my $long_tag;
{
my $proj_id = $_[2] // "";
$long_tag = "defense,$version,$proj_id,$path,$year";
}
if ($creation)
{
my $newref = $ARGV[2];
log INFO, "Looking for $path...";
# Check file exists
my $content = qx(git show $newref:$path);
if ($?) {
log ERROR, "Impossible de trouver la soutenance.";
}
# Check DTD validity
if (check_xml(\$content, "http://acu.epita.fr/dtd/defense.dtd")) {
log ERROR, "Corrigez les erreurs du fichier $path avant de publier la soutenance.";
}
# TODO: check user permissions
# TODO: check presence in project.xml
# Generate questions and answer id
my $defense = Defense->new(\$content);
$defense->genIds($defense_id);
# Send data to intradata
log INFO, "Attente d'un processus de publication...";
if (my $err = Process::Client::launch("intradata_get", { action => "update", type => "defense", id => $project_id, "year" => $year, "defense_id" => $defense_id, "version" => $version }, { "$defense_id.xml" => $defense->toString() }))
{
if (${ $err } ne "Ok") {
log ERROR, "Erreur durant le processus de publication : " . ${ $err };
}
}
if ($long_tag)
{
qx(git tag -f $long_tag $newref);
if (! $?) {
log INFO, "Tag long créé : $long_tag.";
}
}
}
else
{
# Is the long tag existing
qx(git tag | egrep "^$long_tag\$");
if ($?) {
log ERROR, "Tag long correspondant introuvable : $long_tag.";
}
if ($long_tag)
{
qx(git tag -d $long_tag);
if (! $?) {
log INFO, "Tag long supprimé : $long_tag.";
}
}
}
}
sub tag_document
{
}
sub tag_grades
{
}
sub tag_project
{
my $creation = shift;
# From here, we have:
# 0: "defense"
# 1: $version
# 1: "project"
# 2: $id
# 3: $year
my $version = $_[1] // 1;
my $project_id = repository_name();
if ($_[2]) {
# Check on ID/flavour_id
if ($_[2] =~ /^\d+$/) {
log ERROR, "project:* tag can't take version. Tag format: project:id:year";
}
$project_id .= "-" . $_[2];
}
$project_id = lc $project_id;
@ -233,7 +111,7 @@ sub tag_grades
if ($_[3]) {
# Check on year
if ($_[3] !~ /^\d+$/) {
log ERROR, "grades,*,*,* second argument is the year. Tag format: grades,version,id,year";
log ERROR, "project:*:* second argument is the year. Tag format: project:id:year";
}
$year = $_[3];
@ -242,108 +120,11 @@ sub tag_grades
$year = LDAP::get_year;
}
# Determine full tag
my $long_tag;
{
my $proj_id = $_[2] // "";
$long_tag = "grades,$version,$proj_id,$year";
}
if ($creation)
{
my $newref = $ARGV[2];
# Check file exists
my $content = qx(git show $newref:grades/grades.xml);
if ($?) {
log ERROR, "Impossible de trouver le fichier de notation.";
}
# Check DTD validity
if (check_xml(\$content, "http://acu.epita.fr/dtd/grading.dtd")) {
log ERROR, "Corrigez les erreurs du fichier grades.xml avant de lancer la génération des notes.";
}
# TODO: check user permissions
# Send data to intradata
log INFO, "Attente d'un processus de publication...";
Process::Client::launch("intradata_get", { action => "generate", type => "grades", id => $project_id, "year" => $year, "version" => $version }, { "grading.xml" => $content }, 1);
if ($long_tag)
{
qx(git tag -f $long_tag $newref);
if (! $?) {
log INFO, "Tag long créé : $long_tag.";
}
}
}
else
{
# Is the long tag existing
qx(git tag | egrep "^$long_tag\$");
if ($?) {
log ERROR, "Tag long correspondant introuvable : $long_tag.";
}
if ($long_tag)
{
qx(git tag -d $long_tag);
if (! $?) {
log INFO, "Tag long supprimé : $long_tag.";
}
}
}
}
sub tag_project
{
my $creation = shift;
# From here, we have:
# 0: "project"
# 1: $id
# 2: $year
my $project_id = repository_name();
my $flavour = "";
if ($_[1]) {
# Check on ID/flavour_id
if ($_[1] =~ /^\d+$/) {
log ERROR, "project:* tag can't take version. Tag format: project:id:year";
}
$project_id .= "-" . $_[1];
$flavour = $_[1];
}
$project_id = lc $project_id;
$project_id =~ s/[^a-z0-9-_]/_/g;
my $year;
if ($_[2]) {
# Check on year
if ($_[2] !~ /^\d+$/) {
log ERROR, "project:*:* second argument is the year. Tag format: project:id:year";
}
$year = $_[2];
}
else {
$year = LDAP::get_year;
}
# Determine full tag
my $long_tag;
if (!$_[2])
{
my $proj_id = $_[1] // "";
$long_tag = "project,$proj_id,$year";
}
if ($creation)
{
my $newref = $ARGV[2];
log INFO, "Création/mise à jour du projet...";
my $content = qx(git show $newref:project.xml);
# Check file exists
@ -352,334 +133,37 @@ sub tag_project
}
# Check DTD validity
if (check_xml(\$content, "http://acu.epita.fr/dtd/project.dtd")) {
if (check_xml($content, "http://acu.epita.fr/dtd/project.dtd")) {
log ERROR, "Corrigez les erreurs du fichier project.xml avant de lancer la création du projet.";
}
# TODO: check user permissions
# Project already online?
my $project;
eval {
$project = API::Project::get($project_id, $year);
};
if ($project) {
log INFO, "Mise à jour du projet $project_id";
}
else {
log INFO, "Création du projet $project_id";
}
# Generate token for VCS submission
my $dom = XML::LibXML->load_xml(string => (\$content));
my $mod = 0;
for my $vcs ($dom->documentElement()->getElementsByTagName("vcs"))
{
if (! $vcs->hasAttribute("tag") || $vcs->getAttribute("tag") =~ /^(ACU|YAKA)-/) {
log ERROR, "Un tag de rendu ne peut pas commencer par ACU- ou YAKA-."; # C'est réservé pour les moulettes
}
if (! $vcs->hasAttribute("token"))
{
if ($project)
{
# Looking for an old token
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $vcs->getAttribute("tag");
} @{ $project->{submissions} };
if (@rendus == 1)
{
log DEBUG, "Use existing token: ".$rendus[0]->{vcs}{token};
$vcs->setAttribute("token", substr($rendus[0]->{vcs}{token}, 2, 23));
$mod = 1;
next;
}
}
my $token;
do
{
$token = sha1_base64(rand);
$token =~ s/[^a-zA-Z0-9]//g;
} while (length $token < 12);
$vcs->setAttribute("token", substr($token, 2, 23));
$mod = 1;
}
}
if ($mod) {
$content = $dom->toString();
}
# Send data to intradata
log INFO, "Attente d'un processus de publication...";
if (my $err = Process::Client::launch("intradata_get", { action => "update", type => "project", id => $project_id, "year" => $year }, { "butler.xml" => $content }))
{
if (${ $err } ne "Ok") {
log ERROR, "Erreur durant le processus de publication : " . ${ $err };
}
}
log ERROR, "Erreur durant le processus de publication : $_"
if (Process::Client::launch("intradata_get", { action => "update", type => "project", id => $project_id, "year" => $year }, { "butler.xml" => $content }));
log INFO, "Information de l'intranet...";
# Call API
eval {
API::Projects::add($project_id, $flavour, $year);
};
if ($@)
{
my $err = $@;
if ($err =~ /[pP]roject [aA]ll?ready [eE]xists/) {
log WARN, $err;
}
else {
log ERROR, $err;
}
}
log ERROR, $_ if(API::Projects::add($project_id, $year));
log DONE, "Projet créé/mis à jour avec succès.";
if ($long_tag)
{
qx(git tag -f $long_tag $newref);
if (! $?) {
log INFO, "Tag long créé : $long_tag.";
}
}
# FIXME: Remove next line after 2016 piscine: ça ne devrait pas être fait à ce moment là
log ERROR, $_ if(API::Projects::gen_groups($project_id, $year));
}
else
{
# Is the long tag existing
qx(git tag | egrep "^$long_tag\$");
if ($?) {
log ERROR, "Tag long correspondant introuvable : $long_tag.";
}
log USAGE, "Suppression du projet !";
if ($long_tag)
{
qx(git tag -d $long_tag);
if (! $?) {
log INFO, "Tag long supprimé : $long_tag.";
}
}
}
}
sub tag_ref
{
my $creation = shift;
# From here, we have:
# 0: "ref"
# 1: $id
# 2: rendu-X
# 3: $year
my $project_id = repository_name();
if ($_[1]) {
# Check on ID/flavour_id
if ($_[1] =~ /^\d+$/) {
log ERROR, "ref,* tag can't take version. Tag format: ref,id,rendu,year";
}
$project_id .= "-" . $_[1];
}
$project_id = lc $project_id;
$project_id =~ s/[^a-z0-9-_]/_/g;
my $rendu;
if ($_[2]) {
$rendu = $_[2];
}
else {
$rendu = "";
}
my $year;
if ($_[3])
{
# Check on year
if ($_[3] !~ /^\d+$/) {
log ERROR, "ref,*,*,* third argument is the year. Tag format: ref,id,rendu,year";
}
$year = $_[3];
}
else {
$year = LDAP::get_year;
}
# Determine full tag
my $long_tag;
{
my $proj_id = $_[1] // "";
$long_tag = "ref,$proj_id,$rendu,$year";
}
if ($creation)
{
my $newref = $ARGV[2];
log INFO, "Création/mise à jour de la ref...";
my $content = qx(git show $newref:ref/Makefile);
# Check file exists
if ($?) {
log ERROR, "Un fichier Makefile est requis pour pouvoir compiler et exécuter la ref.";
}
log INFO, "Création de la tarball...";
my $archive = qx(git archive --format=tgz $newref ref/);
# Send data to moulette
log INFO, "Attente d'un processus de compilation...";
if (my $err = Process::Client::launch("moulette_get", {
type => "ref",
id => $project_id,
"year" => $year,
"rendu" => $rendu,
"file" => "ref_$rendu.tgz"
}, { "ref_$rendu.tgz" => $archive }))
{
if (${ $err } ne "Ok") {
log ERROR, "Erreur durant le processus de compilation : " . ${ $err };
}
}
if ($long_tag)
{
qx(git tag -f $long_tag $newref);
if (! $?) {
log INFO, "Tag long créé : $long_tag.";
}
}
}
else
{
# Is the long tag existing
qx(git tag | egrep "^$long_tag\$");
if ($?) {
log ERROR, "Tag long correspondant introuvable : $long_tag.";
}
log USAGE, "Suppression du tag de ref !";
if ($long_tag)
{
qx(git tag -d $long_tag);
if (! $?) {
log INFO, "Tag long supprimé : $long_tag.";
}
}
}
}
sub tag_tests
{
my $creation = shift;
# From here, we have:
# 0: "tests"
# 1: $id
# 2: rendu-X
# 3: $year
my $project_id = repository_name();
if ($_[1]) {
# Check on ID/flavour_id
if ($_[1] =~ /^\d+$/) {
log ERROR, "tests,* tag can't take version. Tag format: tests,id,rendu,year";
}
$project_id .= "-" . $_[1];
}
$project_id = lc $project_id;
$project_id =~ s/[^a-z0-9-_]/_/g;
my $rendu = $_[2] // "";
my $year;
if ($_[3])
{
# Check on year
if ($_[3] !~ /^\d+$/) {
log ERROR, "tests,*,*,* third argument is the year. Tag format: tests,id,rendu,year";
}
$year = $_[3];
}
else {
$year = LDAP::get_year;
}
# Determine full tag
my $long_tag;
{
my $proj_id = $_[1] // "";
$long_tag = "tests,$proj_id,$rendu,$year";
}
if ($creation)
{
my $newref = $ARGV[2];
log INFO, "Création/mise à jour de la testsuite...";
my $content = qx(git show $newref:tests/Makefile);
# Check file exists
if ($?) {
log ERROR, "Un fichier Makefile est requis pour pouvoir compiler la testsuite.";
}
log INFO, "Création de la tarball...";
my $archive = qx(git archive --format=tgz $newref tests/);
# Send data to moulette
log INFO, "Attente d'un processus de compilation...";
if (my $err = Process::Client::launch("moulette_get", {
type => "tests",
id => $project_id,
"year" => $year,
"rendu" => $rendu,
"file" => "tests_$rendu.tgz"
}, { "tests_$rendu.tgz" => $archive }))
{
if (${ $err } ne "Ok") {
log ERROR, "Erreur durant le processus de compilation : " . ${ $err };
}
}
if ($long_tag)
{
qx(git tag -f $long_tag $newref);
if (! $?) {
log INFO, "Tag long créé : $long_tag.";
}
}
}
else
{
# Is the long tag existing
qx(git tag | egrep "^$long_tag\$");
if ($?) {
log ERROR, "Tag long correspondant introuvable : $long_tag.";
}
log USAGE, "Suppression du tag de la testsuite !";
if ($long_tag)
{
qx(git tag -d $long_tag);
if (! $?) {
log INFO, "Tag long supprimé : $long_tag.";
}
}
}
}

170
hooks/submissions.pl
View file

@ -1,170 +0,0 @@
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use DateTime::Format::ISO8601;
use File::Basename;
use Net::IP;
use POSIX qw(strftime);
use Socket;
use utf8;
use ACU::API::Projects;
use ACU::API::Submission;
use ACU::LDAP;
use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
use ACU::Process;
my ($ref, $oldsha, $newsha) = @ARGV;
my $promo;
my $id_project;
my $repo_login;
my @apping = qw(zinger_a zebard_w zanell_a yao_p vinois_a sraka_y soupam_j seck_a ngomsi_s morin_h milis_e menkar_m eusebe_r crief_a chhum_s boumra_n blemus_a bengan_l amasho_a);
my @expcep = qw(azerno_t baudry_v dechen_g drouin_n dupuis_a fenech_a hamdao_y lanclu_j langre_m manuel_c palson_c trang_d wajntr_a);
my @salonD = qw(aniss_i bogalh_j boulea_b cloare_l elhach_h gabrie_j kaplan_p manuel_c palson_c pizzin_a wajntr_a);
my @salonS = qw(allio_a cadet_l digius_p drouin_n dubois_d dupuis_a langre_m lim_j);
# First, extract information, from config then guess from repository adress
if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; }
if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; }
if (my $tmp = `git config hooks.login`) { chomp $tmp; $repo_login = $tmp; }
$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/.*\/.*\/(.*)/);
exit(0) if (!$promo || !$id_project || !$repo_login);
if ($ref =~ m<^refs/tags/ACU-(.+)$>)
{
my $tag = $1;
log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}";
# Disallow no ACU
if ($ENV{GL_USER} ne "frotti_b" && $ENV{GL_USER} ne "chen_a" && $ENV{GL_USER} ne "boisse_r" && $ENV{GL_USER} ne "genite_n" && $ENV{GL_USER} ne "mercie_d")
{
log ERROR, "Vous n'êtes pas autorisé à envoyer ce tag.";
exit(9);
}
my $project = get_project_info($tag);
# Extract matching tag
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $tag;
} @{ $project->{submissions} };
if (! @rendus)
{
log ERROR, "$tag n'est pas un tag valide.";
exit(8);
}
}
elsif ($ref =~ m<^refs/tags/(.+)$>)
{
my $tag = $1;
log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}";
my $project = get_project_info($tag);
# Extract matching tag
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $tag;
} @{ $project->{submissions} };
if (@rendus)
{
if ($newsha eq '0' x 40)
{
log USAGE, "Mais pour quelle raison voudriez-vous supprimer un tag ?!";
exit(7);
}
chomp (my $tokengiven = `git cat-file tag $newsha 2> /dev/null | sed -e '1,/^\$/d'`);
if (! check_submission_date($tokengiven, @rendus))
{
exit (9);
}
}
else
{
log ERROR, "$tag n'est pas un tag valide.";
exit(8)
}
}
exit 0;
sub get_project_info
{
my $project;
eval {
$project = API::Projects::get($id_project, $promo);
};
if ($@ or !$project)
{
my $err = $@;
log TRACE, $err;
log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire.";
exit(1);
}
log TRACE, $project;
return $project;
}
sub check_submission_date
{
my $tokengiven = shift;
my $glts = DateTime::Format::ISO8601->parse_datetime(
do {
my $t = $ENV{'GL_TS'};
$t =~ tr/./T/;
$t
});
for my $rendu (@_)
{
my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin});
my $close = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{end});
if (($id_project eq "bistromathique" || $id_project eq "pthl") && grep { $_ eq $repo_login } @expcep)
# if (($id_project eq "bistromathique" || $id_project eq "pthl") && "pizzin_a" eq $repo_login)
{
# $open = DateTime::Format::ISO8601->parse_datetime("2013-12-19T18:00:00");
$close = DateTime::Format::ISO8601->parse_datetime("2013-12-22T19:42:00");
}
say "Date courante : ", $glts->strftime("%d/%m/%Y %H:%M:%S");
if (DateTime->compare($glts, $open) == -1)
{
say "Date d'ouverture : ", $open->strftime("%d/%m/%Y %H:%M:%S");
log ERROR, "Tag rejeté : le rendu n'est pas encore ouvert.";
exit(4);
}
say "Date de fermeture : ", $close->strftime("%d/%m/%Y %H:%M:%S");
if (DateTime->compare($glts, $close) == 1)
{
log ERROR, "Tag rejeté : le rendu est clos.";
exit(5);
}
my $token = $rendu->{vcs}{token};
if ($token ne "" and $token ne $tokengiven and $newsha ne '0' x 40)
{
log ERROR, "Tag rejeté : mauvais token.";
exit(6);
}
}
return 1;
}

175
migration/repo.sh
View file

@ -6,40 +6,30 @@ then
exit 1
fi
tex2md()
clean_tex()
{
if [ -z "$1" ]
then
echo "tex2md: No argument given"
exit 2
fi
DEST="$1"
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
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"
# BEGIN HACK! Need stacking
sed -Ei 's/\\(lstinline|class|expected|refer)[^{]*\{([^}]*)\}/\\verb+\2+/gi' "$i"
sed -Ei 's/\\distribution\{\}/FreeBSD 9/gi' "$i"
sed -Ei 's/\\\{/__OPEN_BRACKET_MINIROOT__/gi' "$i"
sed -Ei 's/\\\}/__CLOSE_BRACKET_MINIROOT__/gi' "$i"
sed -Ei 's/-\{\}-//gi' "$i"
#sed -Ei 's/\\_/_/gi' "$i"
# DIRTY HACK
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"
sed -Ei 's/\{\\include *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\{\\input *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\lstinputlisting *\{([^}]+)\}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\include *\{([^}]+)}/\\verb+~include(\1)+/gi' "$i"
sed -Ei 's/\\input *\{([^}]+)}/\\verb+~include(\1)+/gi' "$i"
sed -Ei 's/\{\\include *([^}]+)}/\\verb+~include(\1)+/gi' "$i"
sed -Ei 's/\{\\input *([^}]+)}/\\verb+~include(\1)+/gi' "$i"
sed -Ei 's/\\lstinline *\{([^}]+)}/\\verb+\1+/gi' "$i"
sed -Ei 's/\\structure\{([^}]+)}/\1/gi' "$i"
sed -Ei 's/\\struct\{([^}]+)}/\1/gi' "$i"
sed -Ei 's/\\link\{([^}]+)}/\1/gi' "$i"
sed -Ei 's/\\textasciitilde\{\}/~/gi' "$i"
sed -Ei 's/\\begin *\{correction\}/\\begin\{verbatim\}/g' "$i"
sed -Ei 's/\\end *\{correction\}/\\end\{verbatim\}/g' "$i"
sed -Ei 's/\\begin *\{prompt\}/\\begin\{verbatim\}/g' "$i"
@ -50,12 +40,6 @@ tex2md()
sed -Ei 's/\\end *\{cartouche\}/\\end\{verbatim\}/g' "$i"
sed -Ei 's/\\begin *\{cartouche_nospaces\}/\\begin\{verbatim\}/g' "$i"
sed -Ei 's/\\end *\{cartouche_nospaces\}/\\end\{verbatim\}/g' "$i"
sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i"
# Special macros
sed -Ei 's/\\(file|email|command|bcode|code) *\{([^}]*)\}/\\verb+\2+/gi' "$i"
sed -Ei 's/\\begin *\{assistant\}/\\verb+%%assistant-begin+/g' "$i"
sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i"
# Convert Beamer
sed -Ei 's/\\begin\[[^]]+\]\{frame\}\{([^}]+)\}/\\subsection\{\1\}/g' "$i"
@ -73,24 +57,21 @@ tex2md()
sed -Ei 's/\\frame//g' "$i"
sed -Ei 's/\\item( *)<[^>]+>/\\item\1/g' "$i"
# END HACK!
sed -Ei 's/__OPEN_BRACKET_MINIROOT__/\{/gi' "$i"
sed -Ei 's/__CLOSE_BRACKET_MINIROOT__/\}/gi' "$i"
if pandoc -o "$DEST"/${bi%%.tex}.md $i
if pandoc -o ../${bi%%.tex}.md $i
then
git add "$DEST"/${bi%%.tex}.md
git add ../${bi%%.tex}.md
git checkout "$i"
git rm -f "$i" > /dev/null
fi
sed -Ei 's/`%%([a-z-]+)\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md"
sed -Ei 's/\\$/\n/' "$DEST/${bi%%.tex}.md"
sed -Ei 's/`~?include\(([^)]+)\)`/~include(\1)/gi' "../${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"
@ -104,76 +85,8 @@ maintex2md()
then
git mv "myTutorial.md" "main.md"
fi
}
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 images/acu_2012_logo_hd.png *.cls *.sty *.toc
do
if [ -f "$f" ]
then
git rm -f "$f" > /dev/null
elif [ -d "$f" ]
then
git rm -fr "$f" > /dev/null
fi
done
for file in `find -name "*.ltx"`
do
git mv "$file" "${file%%.ltx}.tex"
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 [ -d "subdocs" ]
then
cd subdocs
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"
rmdir include
}
TMPDIR=`mktemp -d`
@ -203,9 +116,9 @@ then
exit 4
fi
cd - > /dev/null
cd ..
mv "$1" "$1.hg"
rm -rf "$1"
git clone "$TMPDIR/repo.git" "$1"
@ -231,8 +144,8 @@ if ls | grep "moulette"
then
echo -e "\e[1;34m>>>\e[1;37m Creating moulette branch...\e[0m"
git checkout -b moulette
find -mindepth 1 -maxdepth 1 ! -name moulette ! -name tests ! -name .git -exec git rm -rf {} \;
find -mindepth 1 -maxdepth 1 ! -name moulette ! -name .git -exec git rm -rf {} \;
git rm -f moulette/DESC 2> /dev/null
git commit -am "Converting HG to Git" > /dev/null
@ -260,7 +173,6 @@ echo
echo -e "\e[1;31m##\e[1;37m Removing old and temporary files \e[1;31m##\e[0m"
git rm -f AUTHORS
git rm -f README
git rm -f UPDATE
git rm -f Makefile
git rm -f files/list
git rm -f "files/*.pdf"
@ -269,7 +181,6 @@ find -name 'ChangeLog' -exec git rm -fr {} \;
find -name 'DESC' -exec git rm -fr {} \;
find -name '*.old' -exec git rm -fr {} \;
find -name '*.bak' -exec git rm -fr {} \;
find -name '*.vrb' -exec git rm -fr {} \;
find -name '*~' -exec git rm -fr {} \;
find -name '#*#' -exec git rm -fr {} \;
echo -e "\e[1;31m## ## ## ## ##\e[0m"
@ -286,13 +197,13 @@ do
do
if [ -f "$D/template.xml" ]
then
perl `dirname $0`/defense_converter.pl -o "$D.xml" "$D/template.xml"
~/new_intra/defenses/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 - > /dev/null
cd ..
echo -e "\e[1;35m## ## ## ## ##\e[0m"
echo
@ -303,13 +214,6 @@ do
echo -e "\e[1;36m## ## ## ## ##\e[0m"
echo
elif [ "$DIR" = "tests" ]
then
echo -e "\e[1;33m##\e[1;37m Find directory $DIR for moulette \e[1;33m##\e[0m"
git rm -rf "$DIR"
echo -e "\e[1;33m## ## ## ## ##\e[0m"
echo
elif find "$DIR" -type f -name '*.yml' | grep yml > /dev/null
then
echo -e "\e[1;33m##\e[1;37m Find directory $DIR with some .yml files \e[1;33m##\e[0m"
@ -321,7 +225,8 @@ 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 `pwd` `readlink -f "$(pwd)/.."`
clean_tex "$DIR"
cd ..
echo -e "\e[1;32m## ## ## ## ##\e[0m"
echo
@ -348,19 +253,7 @@ do
git rm -rf "$f" > /dev/null
fi
done
# Append Fact lines
if [ -f "Makefile" ]
then
cat <<EOF >> Makefile
fact:
rm -rf ref.ff
\${FACT} package create ../ref ref.ff
\${FACT} make make ref.ff ref.ff
EOF
fi
cd - > /dev/null
cd ..
fi
done

200
process/exec/guantanamo.pl
View file

@ -1,200 +0,0 @@
#!/usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Gearman::Worker;
use MIME::Base64;
use XML::LibXML;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
my %master_actions =
(
"launch" => \&master_launch,
"list" => \&master_list,
"register" => \&master_register,
);
my @nodes;
sub master_register
{
my $args = shift;
if ($args->{param}{nodename})
{
my $nodename = $args->{param}{nodename};
if (! grep { $_ eq $nodename } @nodes)
{
log INFO, "New node: $nodename";
push @nodes, "$nodename";
}
else {
log WARN, "Node $nodename alredy registered";
}
}
else {
log WARN, "nodename empty, cannot register new node";
}
}
sub master_list
{
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("process");
for my $target (@nodes)
{
my $t = $doc->createElement("target");
$t->setAttribute("name", $target);
$root->appendChild($t);
}
$doc->setDocumentElement( $root );
return $doc->toString();
}
sub build_task_xml
{
my $files = shift;
my $subtree = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("guantanamo");
$doc->setDocumentElement( $root );
log TRACE, $subtree;
if ($files)
{
log TRACE, $files;
for my $key (keys %{ $files })
{
my $file = $doc->createElement("file");
$file->addChild( $doc->createAttribute("name", $key) );
$file->addChild( $doc->createAttribute("encoding", "base64") );
$file->appendText(encode_base64($files->{$key}));
$root->appendChild($file);
}
}
if ($subtree) {
$subtree->recreateNode($doc, $root);
}
my $ret = $doc->toString();
log TRACE, $ret;
return $ret;
}
sub master_launch
{
my $args = shift;
my @lnodes;
my @warn;
if ($args->{unamed})
{
for (my $i = $args->{unamed}; $i > 0; $i--)
{
if (grep { $args->{param}{$i} eq $_ } @nodes) {
push @lnodes, $args->{param}{$i};
} else {
push @warn, $args->{param}{$i}." not a currently launched architecture.";
}
}
}
else {
@lnodes = @nodes;
}
log DEBUG, "Launching nodes...";
my %ret;
my $client = Gearman::Client->new;
$client->job_servers('gearmand:4730');
my $taskset = $client->new_task_set;
for my $node (@lnodes)
{
log DEBUG, "Launching $node...";
$taskset->add_task(
"guantanamo_".$node => build_task_xml($args->{files}, $args->{subtree}),
{
on_complete => sub {
my $dom = XML::LibXML->load_xml(string => ${ $_[0] });
$ret{ $node } = $dom;
}
});
}
$taskset->wait;
if ($args->{subtree}->hasAttribute("output") && $args->{subtree}->getAttribute("output") eq "text")
{
my $output = "";
for my $w (@warn) {
$output .= $w."\n";
}
for my $node (@lnodes) {
my @o = $ret{$node}->documentElement->getElementsByTagName("out");
if (@o) {
$output .= $o[0]->firstChild->nodeValue;
}
my @e = $ret{$node}->documentElement->getElementsByTagName("err");
if (@e) {
$output .= $e[0]->firstChild->nodeValue;
}
$output .= $e[0]->firstChild->nodeValue;
}
return $output;
}
else
{
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("process");
$doc->setDocumentElement( $root );
for my $w (@warn)
{
my $warning = $doc->createElement("warning");
$warning->appendText($w);
$root->appendChild($warning);
}
for my $k (keys %ret)
{
$root->appendChild($ret{ $k }->documentElement);
}
return $doc->toString();
}
}
sub process_master
{
my ($given_args, $args) = @_;
my $action = $args->{param}{action} // "launch";
if (! exists $master_actions{$action}) {
log WARN, "Unknown action '$action' for guantanamo master process.";
}
return $master_actions{$action}($args);
}
log INFO, "Starting guantanamo.pl as master process";
Process::add_server("gearmand:4730");
Process::register("guantanamo", \&process_master);

115
process/exec/guantanamo_node.pl
View file

@ -1,115 +0,0 @@
#!/usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Carp;
use File::Path qw(make_path remove_tree);
use File::Temp qw/tempfile tempdir/;
use IPC::Open3;
use XML::LibXML;
use ACU::Log;
use ACU::Process;
my %node_actions =
(
"launch" => \&node_launch,
);
sub node_launch
{
my $args = shift;
# First, create a temporary directory
my $dir = tempdir();
chdir( $dir );
# Extract all files to current directory
for my $filename (keys %{ $args->{files} })
{
open my $fh, ">", $filename or croak("$filename: $!");
print $fh $args->{files}{$filename};
close $fh;
}
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("target");
$root->addChild( $doc->createAttribute("name", $ARGV[0]) );
$doc->setDocumentElement( $root );
for my $c ($args->{subtree}->getElementsByTagName("command"))
{
if (! exists $c->{attributes}{target} ||
index($c->{attributes}{target}, $ARGV[0]) != -1) {
my $cmd = $doc->createElement("cmd");
if (! exists $c->{attributes}{hide}) {
$root->appendChild($cmd);
}
my $command = $doc->createElement("command");
$command->appendText($c->{nodeValue});
$cmd->appendChild($command);
my($wtr, $rdr, $rv);
my $stderr = "";
eval {
my $pid = open3($wtr, $rdr, $stderr, "sh", "-c", $c->{nodeValue});
waitpid( $pid, 0 );
$rv = $? >> 8;
};
if ($@)
{
$stderr = $@ . $stderr;
$rv = -1;
}
my $out = $doc->createElement("out");
my $str = "";
if ($rdr) {
$str .= $_ while (<$rdr>);
}
$out->appendText($str);
$cmd->appendChild($out);
my $err = $doc->createElement("err");
$str = "";
if ($stderr) {
$str .= $_ while (<$stderr>);
}
$err->appendText($str);
$cmd->appendChild($err);
my $ret = $doc->createElement("return");
$ret->appendText($rv);
$cmd->appendChild($ret);
}
}
chdir();
remove_tree( $dir );
return $doc->toString();
}
sub process_node
{
my ($given_args, $args) = @_;
my $action = $args->{param}{action} // "launch";
if (! exists $node_actions{$action}) {
warn "Unknown action '$action' for guantanamo node process.";
}
return $node_actions{$action}($args);
}
if ($#ARGV == 0)
{
log INFO, "Starting guantanamo.pl as node process";
Process::Client::launch("guantanamo", {"action" => "register", "nodename" => $ARGV[0]}, undef, 1);
Process::register("guantanamo_".$ARGV[0], \&process_node);
}

138
process/exec/run.sh.not-here
View file

@ -1,138 +0,0 @@
#!/usr/bin/env sh
cd $(dirname "$0")
GREP='/usr/bin/env grep -E'
SCREEN='/usr/bin/env screen'
SED='/usr/bin/env sed -E'
if [ `uname -s` = "FreeBSD" ]; then
SU="/usr/bin/env su"
else
SU='/usr/bin/env su -s /bin/sh'
fi
PERL='/usr/bin/env perl'
# Install missing packages
DEB_PACKAGES_LIST="screen libxml-libxml-perl libgearman-client-perl"
ARCH_PACKAGES_LIST="screen"
GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/XML-LibXML"
FBSD_PACKAGES_LIST="screen p5-XML-LibXML p5-Gearman p5-Term-ANSIColor"
KERNEL=`uname -s`
if [ "$KERNEL" = "FreeBSD" ]
then
for PK in `echo $FBSD_PACKAGES_LIST`
do
if ! pkg info "$PK" > /dev/null 2> /dev/null
then
if ! PACKAGESITE="http://canon.acu.epita.fr/repo-lab" pkg install "$PK"
then
echo "Error during installation of $PK"
exit 1
fi
fi
done
if ! getent passwd | grep "guantanamo:" > /dev/null 2> /dev/null
then
pw useradd guantanamo -u 941 -d /home/guantanamo -s /bin/false
fi
elif [ "$KERNEL" = "Linux" ]
then
if [ -f "/etc/debian_version" ]
then
if ! whereis dpkg > /dev/null 2> /dev/null
then
if ! aptitude install dpkg
then
echo "Error during installation of $PK"
exit 1
fi
fi
for PK in $DEB_PACKAGES_LIST
do
if ! dpkg -l | grep "^ii" | grep "$PK" > /dev/null 2> /dev/null
then
aptitude install "$PK"
fi
done
elif [ -f "/etc/arch-release" ]
then
for PK in $ARCH_PACKAGES_LIST
do
if ! pacman -Qi "$PK" > /dev/null 2> /dev/null
then
if ! pacman -S "$PK"
then
echo "Error during installation of $PK"
exit 1
fi
fi
done
elif [ -f "/etc/gentoo-release" ]
then
for PK in $GENTOO_PACKAGES_LIST
do
if ! equery list "$PK" > /dev/null 2> /dev/null
then
if ! emerge "$PK"
then
echo "Error during installation of $PK"
exit 1
fi
fi
done
else
echo "Unsupported GNU/Linux distribution :("
exit 1;
fi
# Add guantanamo user if missing
if ! getent passwd | grep "guantanamo:" > /dev/null 2> /dev/null
then
useradd --shell /bin/false --uid 941 guantanamo &&
mkdir -p /home/guantanamo
fi
chown -R guantanamo:guantanamo /home/guantanamo
else
echo "Unsupported operating system :("
exit 1;
fi
chown -R guantanamo .
if [ $# -gt 0 ]
then
ARCHNAME=$1
else
echo "Expected at first argument: node name. For example: hurd-ia64"
exit 1
fi
CMD="$SCREEN -S 'guantanamo_$ARCHNAME' -d -m sh -c 'while true; do perl guantanamo_node.pl $ARCHNAME; done'"
if [ "x$UID" = "x0" ]
then
echo "$CMD" | $SU guantanamo
else
$CMD
fi

340
process/files/intradata_get.pl
View file

@ -3,36 +3,22 @@
use v5.10.1;
use strict;
use warnings;
use Carp;
use Pod::Usage;
use lib "../../";
use ACU::API::Projects;
use ACU::Log;
use ACU::LDAP;
use ACU::Grading;
use ACU::Process;
use ACU::Trace;
our $basedir = "/intradata";
my %actions = (
"defense" => {
"update" => \&update_defense,
},
"grades" => {
"new_bonus" => \&grades_new_bonus,
"generate" => \&grades_generate,
},
"project" => {
"create" => \&update_project,
"update" => \&update_project,
"delete" => \&delete_project,
},
"trace" => {
"update" => \&update_trace,
},
}
);
sub create_tree($$)
@ -40,261 +26,19 @@ sub create_tree($$)
my $year = shift;
my $project_id = shift;
croak "No directory for year $year. Ask a root to create it." if (! -d "$basedir/$year/");
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/") {
mkdir "$basedir/$year/$project_id/" or die $!;
mkdir "$basedir/$year/$project_id/";
}
return 0;
}
sub grades_generate
{
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);
if (! -e "$basedir/$year/$project_id/grades/") {
mkdir "$basedir/$year/$project_id/grades/" or die $!;
}
log DEBUG, "Generate list of students";
# Get groups from the intranet
my $groups = API::Projects::get_groups($project_id, $year);
# Create list of students to generate
my @logins;
if ($args->{unamed})
{
for (my $i = $args->{unamed}; $i > 0; $i--) {
push @logins, $args->{param}{$i};
}
}
else
{
map {
for my $member (@{ $_->{stds} }) {
push @logins, $member->{login};
}
} @{ $groups->{groups} };
}
log TRACE, @logins;
# Load grading file
my $grading;
if (exists $args->{files}{"grading.xml"}) {
$grading = $args->{files}{"grading.xml"};
}
croak "Invalid grading.xml received!" if (! $grading);
$grading = Grading->new($grading);
opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!";
my @trace_dirs = grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh);
closedir $dh;
for my $login (@logins)
{
my @files;
log DEBUG, "Generating grades for $login";
for my $dir (@trace_dirs)
{
log DEBUG, "Will fetch identifiers from $dir";
# Looking for a group traces first
for my $grp (@{ $groups->{groups} })
{
my $this = 0;
my $chief;
for my $member (@{ $grp->{stds} })
{
if ($member->{chief} eq "true" or $member->{chief} eq "1" or $member->{chief} eq "chief")
{
$chief = $member;
next;
}
$this = 1 if ($member->{login} eq $login);
}
if ($this && $chief)
{
if (-f "$basedir/$year/$project_id/traces/$dir/".$chief->{login}.".xml") {
push @files, "$basedir/$year/$project_id/traces/$dir/".$chief->{login}.".xml";
}
last;
}
}
if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml") {
push @files, "$basedir/$year/$project_id/traces/$dir/$login.xml";
}
}
for my $path (@files)
{
open my $xmltrace, "<", "$path" or die "$path: $!";
binmode $xmltrace;
my $trace = Trace->new(join '', <$xmltrace>);
close $xmltrace;
log DEBUG, "Fill from file: $path";
log TRACE, $trace->getIds($login);
$grading->fill($trace->getNonZeroIds($login));
}
log DEBUG, "Computed grades: ".$grading->compute($login);
open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml: $!";
binmode $xmlgrade;
print $xmlgrade $grading->computeXML($login);
close $xmlgrade;
$grading->reset();
}
return 1;
}
sub grades_new_bonus
{
my $args = shift;
my $project_id = $args->{param}{id};
my $delete = $args->{param}{delete};
my $year = $args->{param}{year} // LDAP::get_year;
croak "No project_id given" if (! $project_id);
die "No such project $project_id in $year" if (! -d "$basedir/$year/$project_id/");
if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or die $!;
}
if (! -e "$basedir/$year/$project_id/traces/bonus/") {
mkdir "$basedir/$year/$project_id/traces/bonus/" or die $!;
}
for my $kfile (keys %{ $args->{files} })
{
log DEBUG, "Reading file $kfile";
my $kbonus = $kfile;
$kbonus =~ s/[^a-zA-Z0-9_-]/_/g;
my @lines = split(/\n/, $args->{files}{$kfile});
log TRACE, $args->{files}{$kfile};
log TRACE, @lines;
my $value;
$value = 1 if (!$delete);
# Looking for a global value
if ($lines[0] =~ /^(\d+)$/) {
$value = $1;
log INFO, "Setting global value to $value";
shift @lines;
}
for my $line (@lines)
{
if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*(-?[0-9.]+))?$/)
{
my $login = $1;
my $tvalue = $2 // $value;
my $trace;
if ($delete) {
log DEBUG, "Deleting bonus for $login";
} else {
log DEBUG, "Applying bonus for $login:$tvalue";
}
if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") {
open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
binmode $xml;
$trace = Trace->new(join '', <$xml>);
close $xml;
}
elsif ($delete) {
next;
}
else {
$trace = Trace->new();
}
if ($delete) {
if ($tvalue && $tvalue == $trace->getIds($kbonus)) {
$trace->delId($kbonus);
} else {
$trace->delId($kbonus);
}
} else {
my $e = $trace->addId($kbonus, $tvalue);
$e->changeWho($login, "login");
}
log DEBUG, "Updating $basedir/$year/$project_id/traces/bonus/$login.xml";
open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
print $xml $trace->toString();
close $xml;
}
else {
warn "Invalid login $line, line skiped";
}
}
}
return 1;
}
sub update_defense
{
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 $defense_id = $args->{param}{defense_id};
croak "No defense_id given" if (! $defense_id);
my $defense;
if (exists $args->{files}{"$defense_id.xml"}) {
$defense = $args->{files}{"$defense_id.xml"};
}
croak "Invalid $defense_id.xml received!" if (! $defense);
log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
if (! -e "$basedir/$year/$project_id/defenses/") {
mkdir "$basedir/$year/$project_id/defenses/" or die $!;
}
if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or die $!;
}
if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
my ($login, $pass, $uid, $gid) = getpwnam("www-data");
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/";# or die $!; #FIXME
chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
}
open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or die $!;
print $out $defense;
close $out;
return 1;
}
sub update_project
{
my $args = shift;
@ -302,63 +46,29 @@ sub update_project
my $project_id = $args->{param}{id};
my $year = $args->{param}{year} // LDAP::get_year;
croak "No project_id given" if (! $project_id);
if (! $project_id) {
log ERROR, "No project_id given.";
return "No project_id given";
}
my $butler;
if (exists $args->{files}{"butler.xml"}) {
$butler = $args->{files}{"butler.xml"};
}
croak "Invalid butler.xml received!" if (! $butler);
if (! $butler) {
log ERROR, "Invalid butler.xml received!";
return "Invalid butler.xml received!";
}
log INFO, "Update $year/$project_id/butler.xml";
create_tree($year, $project_id);
return $_ if (create_tree($year, $project_id));
open my $out, ">", "$basedir/$year/$project_id/butler.xml";
print $out $butler;
close $out;
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/" or die $!;
}
if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") {
mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or die $!;
chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or die $!;
}
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;
return "Ok";
}
sub delete_project
@ -374,18 +84,12 @@ sub process_get
my $type = $args->{param}{type};
my $action = $args->{param}{action} // "update";
croak "Unknown action '$action' for $type." if (! exists $actions{$type}{$action});
eval {
$actions{$type}{$action}($args);
};
if ($@) {
my $err = $@;
log ERROR, $err;
return $err;
if (! exists $actions{$type}{$action}) {
log WARN, "Unknown action '$action' for $type.";
return "Unknown action '$action' for $type.";
}
return "Ok";
return $actions{$type}{$action}($args);
}
Process::register("intradata_get", \&process_get);

378
process/files/moulette_get.pl
View file

@ -1,378 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use threads;
use threads::shared;
use Carp;
use File::Basename;
use File::Compare;
use File::Copy;
use File::Path qw(remove_tree mkpath);
use File::Temp qw/tempfile tempdir/;
use Sys::Gamin;
use ACU::Log;
use ACU::Process;
my %actions = (
"std" => \&receive_std, #STuDent
"ref" => \&receive_ref,
"tests" => \&create_testsuite,
"moulette" => \&moulette,
);
my %monitored_dir = ();
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;
# Check that Fact is running
qx/pgrep mono/;
while ($?)
{
log ERROR, "Fact is not running ... waiting for respawn";
sleep(10);
qx/pgrep mono/;
}
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;
my @dirs = ("/data/work/$year-$project_id-$rendu/", "/data/output/$year-$project_id-$rendu/", "/data/files/$year-$project_id-$rendu/");
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 @dirs;
}
sub receive_ref
{
my $args = shift;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu};
my $file = $args->{param}{file};
croak "No file named '$file' given" if (!exists $args->{files}{$file});
my $tempdir = tempdir(DIR => '/data/tmp');
open my $fh, "|tar -xz -f - -C '$tempdir'";
print $fh $args->{files}{$file};
close $fh;
croak "An error occurs while extracting the tarball" if ($?);
jail_exec("gmake -C $tempdir/ref/ fact");
croak "An error occurs while making the testsuite" if ($?);
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2];
copy("$tempdir/ref/ref.ff", "$destdir/ref.ff") or croak "An error occurs while coping ref.ff: $!";
# Clean
remove_tree($tempdir);
run_moulette($project_id, $year, $rendu);
}
sub receive_std
{
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";
log INFO, "Receiving student tarball: $login, for $year-$project_id-$rendu";
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) )[2];
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;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu};
my $file = $args->{param}{file};
croak "No file named '$file' given" if (!exists $args->{files}{$file});
my $tempdir = tempdir(DIR => '/data/tmp');
open my $fh, "|tar -xz -f - -C '$tempdir'";
print $fh $args->{files}{$file};
close $fh;
croak "An error occurs while extracting the tarball" if ($?);
jail_exec("gmake -C $tempdir/tests/");
croak "An error occurs while making the testsuite" if ($?);
my ($workdir, $outputdir, $destdir) = prepare_dir($year, $project_id, $rendu);
copy("$tempdir/tests/tests.ff", "$destdir/tests.ff") or croak "An error occurs while coping the testsuite: $!";
chmod 0660, "$destdir/tests.ff";
# Check if test.ft has changed
if (-f "$tempdir/tests/test.ft")
{
if (! -f "$destdir/test.ft" || compare("$tempdir/tests/test.ft", "$destdir/test.ft"))
{
log DEBUG, "test.ft has changed, UPDATE students ones.";
copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!";
chmod 0660, "$destdir/test.ft";
opendir(my $dh, $workdir) or die "Can't list files in $workdir: $!";
while (readdir($dh))
{
if (/([a-zA-Z0-9_-]+).ft$/)
{
log DEBUG, "Remove $1.ft";
unlink "$workdir/$1.ft";
}
}
closedir $dh;
}
else
{
log DEBUG, "test.ft hasn't changed, KEEP students ones.";
}
}
else {
remove_tree($tempdir);
croak "tests/test.ft not found.";
}
# 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 = @_;
my ($workdir, $outputdir, $filesdir) = prepare_dir($year, $project_id, $rendu);
if ($#logins == -1)
{
# Get all submissions
opendir(my $dh, $filesdir) or die "Can't list files in $filesdir: $!";
while (readdir($dh))
{
if (/([a-zA-Z0-9_-]+).ff$/ && -f "$filesdir/$_" && ! /^tests\.ff$/) {
push @logins, $1;
}
}
closedir $dh;
}
for my $login (@logins)
{
my $fhin;
if (-f "$filesdir/test.ft") {
open $fhin, "<", "$filesdir/test.ft" or croak "Unable to open $filesdir/test.ft: $!";
}
if ($fhin)
{
open my $fhout, ">", "$workdir/$login.ft" or croak "Unable to update $workdir/$login.ft file: $!";
while (<$fhin>)
{
$_ =~ s/#LOGIN_X/$login/g;
$_ =~ s%#GLOBAL%/data/global/%g;
$_ =~ s/#PROJECT/$filesdir/g;
$_ =~ s/#SUBMIT/$workdir/g;
$_ =~ s/#OUTPUT/$outputdir/g;
print $fhout $_;
}
close $fhin;
close $fhout;
}
copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannot copy $login.ff";
next if ($login eq "ref" && ! -f "$workdir/$login.ft");
croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$workdir/$login.ft");
log WARN, "There is no ref for $project_id $rendu" if (! -f "$filesdir/ref.ff");
log WARN, "There is no $login.ff for $project_id $rendu" if (! -f "$workdir/$login.ff");
unlink "$outputdir/$login.xml" if ( -f "$outputdir/$login.xml");
monitor_dir($outputdir, $project_id, $year, $rendu);
log INFO, "$workdir/$login.ft append to Fact manager";
fact_exec("system manager $workdir/$login.ft", $workdir);
log ERROR, "An error occurs while starting tests for $login on $year-$project_id-$rendu" if ($?);
}
}
sub moulette
{
my $args = shift;
if ($args->{unamed} == 0)
{
# 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 $id = shift;
my $year = shift;
my $rendu = shift;
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" => $id,
"year" => $year,
"rendu" => $rendu,
"login" => $login },
{ "$login.xml" => $file_content },
1
);
# Remove transfered trace
unlink "$path/$filename";
}
sub monitor_start
{
my $dir = shift;
my $id = shift;
my $year = shift;
my $rendu = shift;
my $fm = new Sys::Gamin;
log INFO, "Monitoring $dir";
$fm->monitor($dir);
while (1) {
my $event=$fm->next_event;
if (($event->type eq "create" || $event->type eq "change" || $event->type eq "exist") &&
$event->filename =~ /([^\/\\]+)\.xml$/ ) {
my $login = $event->filename;
$login =~ s/\.xml$//;
trace_send($dir, $event->filename, $login, $id, $year, $rendu);
}
}
monitor_traces( $fm->next_event ) while (1);
}
sub monitor_dir
{
my $dir = shift;
my $id = shift;
my $year = shift;
my $rendu = shift;
return if (exists ($monitored_dir{$dir}));
$monitored_dir{$dir} = threads->create(\&monitor_start, $dir, $id, $year, $rendu);
}
sub process_get
{
my ($given_args, $args) = @_;
my $type = $args->{param}{type} // "";
if (! exists $actions{$type}) {
log WARN, "Unknown type '$type'";
return "Unknown type '$type'.";
}
eval {
$actions{$type}($args);
};
if ($@) {
my $err = $@;
log ERROR, $err;
return $err;
}
return "Ok";
}
Process::register("moulette_get", \&process_get);

60
process/files/send_git.pl
View file

@ -1,60 +0,0 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Carp;
use v5.10;
use File::Path qw(remove_tree);
use File::Temp qw/tempfile tempdir/;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
sub process
{
my ($given_args, $args) = @_;
my $year = $args->{param}{year} // LDAP::get_year();
my $project_id = $args->{param}{id};
my $rendu = $args->{param}{rendu};
my $login = $args->{param}{login};
my $rendu_for = $rendu;
if ($rendu =~ /^(ACU|YAKA)-(.*)$/) {
$rendu_for = $2;
}
my $path = $args->{param}{path} // "ssh://git\@localhost/$year/$project_id/$login.git";
my $tempdir = tempdir();
qx/git clone -b '$rendu' '$path' '$tempdir'/ or croak "$path is not a valid repository.";
croak "$path is not a valid repository." if ($?);
my $tar;
open my $fh, "tar -czf - -C '$tempdir' . |" or die ("Error during tar: " . $!);
$tar .= $_ while(<$fh>);
close $fh;
die "Unable to tar: $!" if ($?);
# Clean
remove_tree($tempdir);
return Process::Client::launch("moulette_get",
{
"type" => "std",
"id" => $project_id,
"year" => $year,
"rendu" => $rendu_for,
"login" => $login,
"file" => "rendu.tgz"
},
{
"rendu.tgz" => $tar
});
}
Process::register("send_git", \&process);

122
process/launch.sh
View file

@ -1,122 +0,0 @@
#! /bin/sh
cd $(dirname "$0")
GREP='/usr/bin/env grep -E'
SCREEN='/usr/bin/env screen'
SED='/usr/bin/env sed -E'
if [ `uname -s` = "FreeBSD" ]; then
SU="/usr/bin/env su"
else
SU='/usr/bin/env su -s /bin/sh'
fi
PERL='/usr/bin/env perl'
reset_agents()
{
echo "killall ssh-agent" | $SU intradmin
}
launch_screen()
{
CMD=$2
if [ -n "$3" ] && [ -f "$3" ]
then
TMP=`echo mktemp | $SU intradmin`
echo "ssh-agent" | $SU intradmin > "$TMP"
echo ". $TMP; ssh-add '$3'" | $SU intradmin
CMD=". $TMP; ssh-add -l; echo; $CMD"
fi
if [ "$HOSTNAME" = "ksh" ]
then
$SCREEN -S "$1" -d -m sh -c "$CMD"
else
echo "$SCREEN -S '$1' -d -m sh -c '$CMD'" | $SU intradmin
fi
if [ -f "$TMP" ]
then
sleep 1
/bin/rm "$TMP"
fi
}
if [ -z "$1" ]
then
ACTION="restart"
else
ACTION="$1"
fi
if [ -z "$2" ]
then
HOSTNAME=`/bin/hostname`
else
HOSTNAME="$2"
fi
if [ "$ACTION" = "stop" ] || [ "$ACTION" = "restart" ]
then
# Kill old liblersorf screen sessions
if [ "$HOSTNAME" = "ksh" ]
then
for i in `pgrep sh`
do
if [ "$$" != "$i" ]
then
pkill "$i"
fi
done
else
echo "$SCREEN -ls" | $SU intradmin | $GREP '[0-9]+\.lerdorf_[a-zA-Z0-9_-]+' |
while read LINE
do
SNAME=`echo $LINE | $SED "s/^[^0-9]*([0-9]+\.[^ \t]+).*$/\1/"`
echo "$SCREEN -S \"$SNAME\" -X kill" | $SU intradmin
done
fi
fi
if [ "$ACTION" = "start" ] || [ "$ACTION" = "restart" ]
then
case $HOSTNAME in
cpp)
launch_screen "lerdorf_process_exec_guantanamo" "while true; do $PERL ~/liblerdorf/process/exec/guantanamo.pl; done"
reset_agents
launch_screen "lerdorf_process_ldap_sync_ssh_keys_forge" "while true; do $PERL ~/liblerdorf/process/ldap/sync_ssh_keys_forge.pl; done" ~intradmin/.ssh/git
;;
hamano)
reset_agents
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" ~intradmin/.ssh/git
;;
moore)
launch_screen "lerdorf_process_ldap_check_ssh_key" "while true; do $PERL ~/liblerdorf/process/ldap/check_ssh_key.pl; done"
launch_screen "lerdorf_process_ldap_sync_ssh_keys" "while true; do $PERL ~/liblerdorf/process/ldap/sync_ssh_keys.pl; done"
launch_screen "lerdorf_process_ldap_update_group" "while true; do $PERL ~/liblerdorf/process/ldap/update_group.pl; done"
launch_screen "lerdorf_process_ldap_update_user" "while true; do $PERL ~/liblerdorf/process/ldap/update_user.pl; done"
#launch_screen "lerdorf_process_files_intradata_get" "while true; do $PERL ~/liblerdorf/process/files/intradata_get.pl; done"
;;
noyce)
launch_screen "lerdorf_process_files_intradata_get" "while true; do $PERL ~/liblerdorf/process/files/intradata_get.pl; done"
launch_screen "lerdorf_process_projects_gen_grading" "while true; do $PERL ~/liblerdorf/process/projects/gen_grading.pl; done"
launch_screen "lerdorf_process_projects_get_csv" "while true; do $PERL ~/liblerdorf/process/projects/get_csv.pl; done"
;;
ksh)
launch_screen "lerdorf_process_files_moulette_get" "while true; do $PERL ~/liblerdorf/process/files/moulette_get.pl; done"
;;
*)
echo "No process to launch for $HOSTNAME" >&2
exit 1
;;
esac
fi

10
process/ldap/check_ssh_key.pl
View file

@ -17,16 +17,8 @@ use ACU::Log;
sub check_key($)
{
my $filename = shift;
# Check file content format
open my $fh, "<", $filename;
my $fcnt = <$fh>;
close $fh;
chomp($fcnt);
# Call ssh-keygen
if ($fcnt =~ /^(ssh|ecdsa)-[a-z0-9-]+ [a-zA-Z0-9+=\/]+( .*)?$/ &&
`ssh-keygen -l -f $filename 2> /dev/null` =~ /^([0-9]+) +[0-9a-f:]+ +.+ +\(([A-Z]+)\)$/)
if (`ssh-keygen -l -f $filename 2> /dev/null` =~ /^([0-9]+) [0-9a-f:]+ [a-zA-Z0-9\/_-]+ \(([A-Z]+)\)$/)
{
log INFO, "Receive valid key: type $2, size $1";
if ($2 eq "RSA") {

2
process/ldap/sync_ssh_keys.pl
View file

@ -109,7 +109,7 @@ if ($0 =~ /^(?:.*\/)?sync_ssh_keys_(?:([a-zA-Z0-9]+)_)?([a-zA-Z0-9]+).pl$/) {
if ($service eq "git")
{
$Git::git_server = $2.".acu.epita.fr";
$Git::git_server = $2;
log INFO, "Start by syncing all users key...";

104
process/ldap/update_group.pl
View file

@ -3,10 +3,11 @@
use v5.10.1;
use strict;
use warnings;
use File::Basename;
use Mail::Internet;
use Pod::Usage;
use lib "../../";
use ACU::Log;
use ACU::LDAP;
use ACU::Process;
@ -120,87 +121,19 @@ sub user_update($$)
my $dn = shift;
my $args = shift;
if ($args->{param}{cn}) {
LDAP::update_attribute($ldap, $dn, "cn", $args->{param}{cn});
} elsif ($args->{param}{firstname} && $args->{param}{lastname}) {
LDAP::update_attribute($ldap, $dn, "cn", $args->{param}{firstname}." ".$args->{param}{lastname});
}
if ($args->{param}{l}) {
LDAP::update_attribute($ldap, $dn, "l", $args->{param}{l});
} else {
LDAP::flush_attribute($ldap, $dn, "l");
}
if ($args->{param}{mail}) {
LDAP::update_attribute($ldap, $dn, "mail", $args->{param}{mail});
} else {
LDAP::flush_attribute($ldap, $dn, "mail");
}
if ($args->{param}{postalAddress}) {
LDAP::update_attribute($ldap, $dn, "postalAddress", $args->{param}{postalAddress});
} elsif ($args->{param}{postaladdress}) {
LDAP::update_attribute($ldap, $dn, "postalAddress", $args->{param}{postaladdress});
} else {
LDAP::flush_attribute($ldap, $dn, "postalAddress");
}
if ($args->{param}{postalCode}) {
LDAP::update_attribute($ldap, $dn, "postalCode", $args->{param}{postalCode});
} elsif ($args->{param}{postalcode}) {
LDAP::update_attribute($ldap, $dn, "postalCode", $args->{param}{postalcode});
} else {
LDAP::flush_attribute($ldap, $dn, "postalCode");
}
if ($args->{param}{sn}) {
LDAP::update_attribute($ldap, $dn, "sn", $args->{param}{sn});
} else {
LDAP::flush_attribute($ldap, $dn, "sn");
}
if ($args->{param}{telephoneNumber}) {
LDAP::update_attribute($ldap, $dn, "telephoneNumber", $args->{param}{telephoneNumber});
} elsif ($args->{param}{telephonenumber}) {
LDAP::update_attribute($ldap, $dn, "telephoneNumber", $args->{param}{telephonenumber});
} else {
LDAP::flush_attribute($ldap, $dn, "telephoneNumber");
}
if ($args->{param}{strongAuthKey}) {
LDAP::update_attribute($ldap, $dn, "strongAuthKey", $args->{param}{strongAuthKey});
} elsif ($args->{param}{strongauthkey}) {
LDAP::update_attribute($ldap, $dn, "strongAuthKey", $args->{param}{strongauthkey});
} else {
LDAP::flush_attribute($ldap, $dn, "strongAuthKey");
}
if ($args->{param}{c}) {
LDAP::update_attribute($ldap, $dn, "c", $args->{param}{c});
} else {
LDAP::flush_attribute($ldap, $dn, "c");
}
if ($args->{param}{title}) {
LDAP::update_attribute($ldap, $dn, "title", $args->{param}{title});
} else {
LDAP::flush_attribute($ldap, $dn, "title");
}
if ($args->{param}{intraTheme}) {
LDAP::update_attribute($ldap, $dn, "intraTheme", $args->{param}{intraTheme});
} elsif ($args->{param}{intratheme}) {
LDAP::update_attribute($ldap, $dn, "intraTheme", $args->{param}{intratheme});
} else {
LDAP::flush_attribute($ldap, $dn, "intraTheme");
}
if ($args->{param}{birthdate}) {
LDAP::update_attribute($ldap, $dn, "birthdate", $args->{param}{birthdate});
} else {
LDAP::flush_attribute($ldap, $dn, "birthdate");
}
LDAP::update_attribute($ldap, $dn, "cn", $args->{param}{cn}) if ($args->{param}{cn});
LDAP::update_attribute($ldap, $dn, "cn", $args->{param}{firstname}." ".$args->{param}{lastname}) if ($args->{param}{firstname} && $args->{param}{lastname});
LDAP::update_attribute($ldap, $dn, "l", $args->{param}{l}) if ($args->{param}{l});
LDAP::update_attribute($ldap, $dn, "mail", $args->{param}{mail}) if ($args->{param}{mail});
LDAP::update_attribute($ldap, $dn, "postalAddress", $args->{param}{postalAddress}) if ($args->{param}{postalAddress});
LDAP::update_attribute($ldap, $dn, "postalCode", $args->{param}{postalCode}) if ($args->{param}{postalCode});
LDAP::update_attribute($ldap, $dn, "sn", $args->{param}{sn}) if ($args->{param}{sn});
LDAP::update_attribute($ldap, $dn, "telephoneNumber", $args->{param}{telephoneNumber}) if ($args->{param}{telephoneNumber});
LDAP::update_attribute($ldap, $dn, "strongAuthKey", $args->{param}{strongAuthKey}) if ($args->{param}{strongAuthKey});
LDAP::update_attribute($ldap, $dn, "c", $args->{param}{c}) if ($args->{param}{c});
LDAP::update_attribute($ldap, $dn, "title", $args->{param}{title}) if ($args->{param}{title});
LDAP::update_attribute($ldap, $dn, "intraTheme", $args->{param}{intraTheme}) if ($args->{param}{intraTheme});
LDAP::update_attribute($ldap, $dn, "birthdate", $args->{param}{birthdate}) if ($args->{param}{birthdate});
}
sub alert_mail($$$$@)
@ -294,9 +227,6 @@ sub user_get_type($)
elsif ($type eq "sshkeys") {
return "sshPublicKey" ;
}
elsif ($type eq "descriptions") {
return "description" ;
}
elsif ($type eq "userInfos") {
return "userInfos" ;
}
@ -363,11 +293,11 @@ sub process_user
return "Ok";
}
if (basename($0) =~ /^update_group/) {
if ($0 =~ /^update_group/) {
$_get_type = \&group_get_type;
Process::register("update_group", \&process_group);
}
elsif (basename($0) =~ /^update_user/) {
elsif ($0 =~ /^update_user/) {
$_get_type = \&user_get_type;
Process::register("update_user", \&process_user);
}

101
process/projects/gen_grading.pl
View file

@ -1,101 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Carp;
use Pod::Usage;
use Text::ParseWords;
use ACU::Defense;
use ACU::Grading;
use ACU::Log;
use ACU::LDAP;
use ACU::Process;
use ACU::Trace;
$ACU::Log::mail_error = 1;
our $basedir = "/intradata";
sub process
{
my $given_args = shift;
my @args = shellwords(${ shift() });
my $project_id = shift @args;
my $year = shift @args // LDAP::get_year;
# Project existing?
croak "Unable to find $project_id in $year" if (! -d "$basedir/$year/$project_id");
my $grade = Grading->new();
my @defenses;
if (-d "$basedir/$year/$project_id/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;
}
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(join '', <$xml>);
my %tids = %{ $trace->getIds() };
for my $kid (keys %tids)
{
$ids->{ $kid } = $tids{ $kid };
}
}
$grade->create_from_ids($dir, $ids);
}
closedir $dh;
}
return $grade->toString;
}
Process::set_servers("gearmand:4730");
Process::register_no_parse("gen_grading", \&process);

109
process/projects/get_csv.pl
View file

@ -1,109 +0,0 @@
#! /usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Carp;
use Pod::Usage;
use Text::ParseWords;
use XML::LibXML;
use ACU::Log;
use ACU::LDAP;
use ACU::Process;
$ACU::Log::mail_error = 1;
our $basedir = "/intradata";
sub process
{
my $given_args = shift;
my @args = shellwords(${ shift() });
my $project_id = shift @args;
my $year = shift @args // LDAP::get_year;
# Project existing?
croak "Unable to find $project_id in $year" if (! -d "$basedir/$year/$project_id");
my %grades;
my @headers;
my @averages;
opendir(my $dh, "$basedir/$year/$project_id/grades/") or croak "can't opendir $basedir/$year/$project_id/grades/: $!";
for my $gfile (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/grades/$_" } readdir($dh))
{
my $login;
($login = $gfile) =~ s/\.xml$//;
open my $xml, "<", "$basedir/$year/$project_id/grades/$gfile" or die $!;
binmode $xml;
my $dom = XML::LibXML->load_xml(IO => $xml);
close $xml;
my @ugrades = @headers;
for my $grade ($dom->documentElement()->getElementsByTagName("grade"))
{
my $i;
for ($i = 0; $i <= $#ugrades; $i++)
{
if ($ugrades[$i] eq $grade->getAttribute("name"))
{
$ugrades[$i] = $grade->getAttribute("value");
$averages[$i] += $grade->getAttribute("value");
last;
}
}
if ($i > $#ugrades)
{
push @headers, $grade->getAttribute("name");
push @ugrades, $grade->getAttribute("value");
push @averages, $grade->getAttribute("value");
}
}
$grades{$login} = \@ugrades;
}
closedir $dh;
# Print CSV
my $out = "login";
foreach my $header (@headers) {
$out .= ",$header";
}
$out .= "\n";
my $nb = 0;
foreach my $login (keys %grades)
{
$nb += 1;
$out .= "$login";
my @ugrades = @{ $grades{$login} };
for my $header (@headers)
{
my $g = shift @ugrades;
$out .= ",";
if ($g && $g ne $header) {
$out .= $g;
} else {
$out .= "0";
}
}
$out .= "\n";
}
$out .= "Average";
foreach my $average (@averages)
{
$out .= ",".($average / $nb);
}
$out .= "\n";
return $out;
}
Process::set_servers("gearmand:4730");
Process::register_no_parse("get_csv", \&process);

74
process/view_log.sh
View file

@ -1,74 +0,0 @@
#! /bin/sh
cd `dirname $0`/..
UN=$1
if [ "$1" = "clean" ]
then
CMD=rm
shift
elif [ "$1" = "full" ]
then
CMD=cat
shift
elif echo "$1" | grep -e '^-' > /dev/null
then
CMD="tail -n `echo $1 | cut -d '-' -f 2-`"
shift
else
CMD="tail -n 50"
fi
DIRS="./"
if [ -d "/var/log/hooks/" ]
then
DIRS="$DIRS /var/log/hooks/"
fi
if [ $# -eq 0 ]
then
for D in $DIRS
do
for I in `find "$D" -name '*.log'`
do
/bin/echo -e "`dirname ${I#$D}`/\e[1m`basename $I`\e[0m"
done
done
else
if [ `uname -s` = "FreeBSD" ]
then
LIST=`mktemp lerdorf_log_XXXXX`
else
LIST=`mktemp`
fi
find $DIRS -name '*.log' > "$LIST"
while [ $# -gt 0 ]
do
NB=`grep "/$1" "$LIST" | wc -l`
if [ $NB = 1 ]
then
$CMD `grep "/$1" "$LIST"`
echo
elif [ $NB -gt 1 ]
then
echo "Too much matching file for '$1':"
for I in `grep "$1" "$LIST" | sed -E 's#^./##'`
do
/bin/echo -e "`dirname $I`/\e[1m`basename $I`\e[0m"
done
else
echo "Unable to find '$1' log file"
exit 1
fi
shift
done
rm -rf "$LIST";
fi

1932
utils/lpt
View file

File diff suppressed because it is too large Load diff