Archived
1
0
Fork 0

Compare commits

..

2 commits

Author SHA1 Message Date
Mercier Pierre-Olivier
ae2e6fa4ba Merge branch 'master' of ssh://forge/liblerdorf into object 2013-11-05 17:33:11 +01:00
Mercier Pierre-Olivier
3fb0b9e866 Migration: migrate also .ltx files 2013-11-04 02:26:04 +01:00
40 changed files with 534 additions and 1635 deletions

View file

@ -105,10 +105,8 @@ sub send($$$)
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);
@ -249,7 +247,8 @@ sub new ($$)
my $class = shift;
my $self = {
parsed => shift,
savValue => 0,
inStd => 0,
inResult => 0,
lastGroup => {},
values => ""
};
@ -263,10 +262,14 @@ sub start_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "student")
{
if ($element->{Name} eq "result") {
$self->{parsed}{result} = $self->{values};
$self->{inResult} = 0;
$self->{values} = "";
$self->{savValue} = 1;
}
elsif ($element->{Name} eq "student")
{
$self->{inStd} = 1;
push @{ $self->{lastGroup}{stds} }, {
id => $element->{Attributes}{"{}id"}{Value},
chief => $element->{Attributes}{"{}chief"}{Value},
@ -278,18 +281,13 @@ sub start_element
$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}) {
if ($self->{inStd}) {
$self->{values} .= $characters->{Data};
}
}
@ -298,16 +296,13 @@ sub end_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "result")
{
$self->{parsed}{result} = $self->{values};
$self->{savValue} = 0;
}
elsif ($element->{Name} eq "group")
if ($element->{Name} eq "group")
{
push @{ $self->{parsed}{groups} }, $self->{lastGroup};
$self->{lastGroup} = {};
$self->{savValue} = 0;
$self->{inStd} = 0;
$self->{values} = "";
}
elsif ($element->{Name} eq "student")
{

View file

@ -16,7 +16,7 @@ sub add($$;$)
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é";
}
@ -90,9 +90,10 @@ sub get_groups($;$)
my $res = API::Base::get('ProjectGroupHandler', $url);
if ($res->{result} ne '0') {
croak "Erreur durant la récupération : " . $res->{message};
}
#TODO: uncomment-me
#if ($res->{result} ne '0') {
# croak "Erreur durant la récupération : " . $res->{message};
#}
return $res;
}
@ -102,10 +103,7 @@ 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);
@ -122,10 +120,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);

View file

@ -134,24 +134,23 @@ sub genIds ($;$)
for my $group (@{ $self->{groups} })
{
my $cur_gid;
if (! $group->{id} || grep { $_ == $group->{id} } @ids)
if (! $group->{id} || grep { /^\Q$group->{id}\E$/ } @ids)
{
do {
$cur_gid = "def_".$def_i."g".$grp_i;
$cur_gid = "def".$def_i."g".$grp_i;
$grp_i += 1;
} while (grep {$_ eq $cur_gid} @ids);
$group->{id} = $cur_gid;
}
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)
if (! $question->{id} || grep { /^\Q$question->{id}\E$/ } @ids)
{
do {
$cur_qid = $cur_gid."q".$qst_i;
@ -161,13 +160,12 @@ sub genIds ($;$)
}
else {
$qst_i += 1;
$cur_qid = $question->{id};
}
my $ans_i = 0;
for my $answer (@{ $question->{answers} })
{
if (! $answer->{id} || grep { $_ == $answer->{id} } @ids)
if (! $answer->{id} || grep { /^\Q$answer->{id}\E$/ } @ids)
{
my $cur_aid;
do {

View file

@ -7,6 +7,8 @@ use strict;
use warnings;
use XML::LibXML;
use ACU::Tinyglob;
sub new
{
my $class = shift;
@ -109,7 +111,7 @@ sub insert ($$$)
$self->{ids}{$_[0]} = $_[1];
}
sub fill
sub fill ($$)
{
my $self = shift;
my $ids = shift;
@ -286,7 +288,6 @@ 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;
@ -339,23 +340,21 @@ sub compute ($$$;$$$)
my $login = shift;
my $ref = $self->{ref};
if ($login && $ref) {
$ref =~ s/\$LOGIN/$login/;
}
# Handle $LOGIN in ref
$ref =~ s/\$LOGIN/$login/ if ($login && $ref);
# Handle globbing in ref
if (defined $ref)
{
eval
{
if ($ref =~ /\?|\*/)
eval {
my $glob = Tinyglob::tinyglob($ref);
if ($glob ne $ref)
{
my $value = 0;
for my $r (grep { match_glob($ref, $_); } keys %$ids) {
$value += $ids->{ $r } if ($ref != $r);
for my $r (grep { /^$glob$/ } keys %$ids) {
$value += $ids->{ $r };
}
$ids->{ $ref } = $value if ($value);
log DEBUG, "New globbing identifier caculated $ref: $value";
$ids->{ $ref } = $value;
}
};
if ($@) {

View file

@ -189,16 +189,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=*)"),
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);
@ -334,7 +331,7 @@ sub search_dn($$@)
attrs => [ ],
scope => "sub"
);
return undef if ($mesg->code != 0);
croak($mesg->error) if ($mesg->code != 0);
croak("$filter not found") if ($mesg->count == 0);
croak("$filter not unique") if ($mesg->count > 1);

View file

@ -4,11 +4,8 @@ use v5.10.1;
use strict;
use warnings;
use Carp;
use utf8;
use open IO => ':utf8';
use open ':std';
use Data::Dumper;
use Email::MIME;
use Exporter 'import';
use POSIX qw(strftime);
use Term::ANSIColor qw(:constants);
@ -52,17 +49,12 @@ sub log
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);
say $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " START new logging session ";
}
if ($level <= $save_level and $log_fd)
{
local $| = 1;
print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " ";
if ($level == TRACE) {
@ -75,20 +67,13 @@ sub log
if ($mail_error && $level <= ERROR)
{
require Email::MIME;
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
require "Email::Sender::Simple";
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.
@ -104,20 +89,15 @@ Cordialement,
--
The lerdorf project",
);
sendmail($mail);
Email::Sender::Simple::sendmail($mail);
}
if ($level <= $display_level)
{
$|++; # Autoflush STDOUT
if ($level <= $display_level) {
if ($level == PENDING) {
print STDERR (leveldisp($level), @_, RESET, "\r");
} else {
say STDERR (leveldisp($level), @_, RESET);
}
$|--; # Disable autoflush
}
if ($fatal_warn && $level <= WARN){

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;
@ -83,18 +71,15 @@ sub do_work ($$$@)
return $err;
}
my $ret = "";
my $ret;
eval {
$SIG{'__WARN__'} = sub { log WARN, $_[0]; $ret .= ">>> ".$_[0 ]; };
$ret .= $subref->($given_args, $args);
$ret = $subref->($given_args, $args);
};
if ($@) {
my $err = $@;
log ERROR, $err;
$ret .= $err;
return $err;
}
return $ret;
}
@ -106,9 +91,7 @@ sub register_no_parse ($$;$)
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
{
my $ret;
@ -141,9 +124,7 @@ 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
@ -212,7 +193,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 +216,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 })

67
ACU/Tinyglob.pm Normal file
View file

@ -0,0 +1,67 @@
#! /usr/bin/env perl
package Tinyglob;
use v5.10.1;
use strict;
use warnings;
use Carp;
use Exporter 'import';
our @EXPORT = qw(tinyglob);
sub tinyglob
{
my $orig = shift;
my @str = split("", quotemeta($orig));
my $res = "";
my $metaescape = 0;
for (my $i = 0; $i <= $#str; $i++)
{
if ($str[$i] eq '\\')
{
$i += 1;
if ($str[$i] eq '\\')
{
$metaescape = ! $metaescape;
$res .= $str[$i];
}
elsif ($metaescape && ($str[$i] eq '*' || $str[$i] eq '?')) {
$res .= $str[$i];
$metaescape = 0;
}
elsif ($str[$i] eq '?') {
$res .= '.';
}
elsif ($str[$i] eq '*') {
$res .= '.*';
}
elsif ($metaescape) {
$res .= $str[$i];
$metaescape = 0;
}
else {
$res .= "\\".$str[$i];
}
}
else {
$res .= $str[$i];
}
}
return $res;
}
sub match
{
my $glob = tinyglob(shift);
my $str = shift;
say $glob;
return $str =~ /$glob/;
}
1;

View file

@ -9,15 +9,16 @@ use Carp;
use utf8;
use open qw(:encoding(UTF-8) :std);
use XML::LibXML;
use ACU::Log;
use XML::SAX::ParserFactory;
sub new
{
my $class = shift;
my $self = {
ids => {},
infos => {},
groups => [],
comments => {},
who => {},
};
bless $self, $class;
@ -32,47 +33,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 +63,113 @@ 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]};
}
sub getIds ($)
{
my $self = shift;
return $self->{ids};
}
sub addId($$;$)
{
my $self = shift;
my $key = shift;
my $value = shift // 1;
$self->{ids}{$key} = $value;
}
sub delId($$)
{
my $self = shift;
my $key = shift;
delete $self->{ids}{$key};
}
sub toString ($;$)
{
my $self = shift;
my $main_grp = shift // "bonus_malus";
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("trace");
foreach my $group (@{ $self->{groups} })
{
$root->appendChild( $group->toString($doc) );
my $group = $doc->createElement("group");
$group->addChild( $doc->createAttribute("id", $main_grp) );
for my $k (keys %{ $self->{ids} }) {
my $e = $doc->createElement("eval");
my $v = $doc->createElement("value");
$e->addChild( $doc->createAttribute("id", $k) );
$v->appendText( $self->{ids}{$k} );
$e->appendChild( $v );
$group->appendChild( $e );
}
$root->appendChild( $group );
$doc->setDocumentElement( $root );
return $doc->toString();
}
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 => []
groups => [],
parsed => shift,
inComment => "",
inEval => "",
inInfo => "",
inValue => "",
inWho => "",
values => ""
};
bless $self, $class;
@ -248,273 +177,113 @@ 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} eq "group")
{
push @{ $self->{groups} }, ($element->{Attributes}{"{}id"}{Value} // "");
}
elsif ($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;
}
if ($self->{groups}) {
my $key = @{ $self->{groups} }[$#{ $self->{groups} }];
$self->{parsed}{ids}{ $key } += $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;
}
# Remove empty identifier
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} })
elsif ($element->{Name} eq "group")
{
$gr->appendChild( $item->toString() );
my $key = pop @{ $self->{groups} };
# Remove empty identifier
delete $self->{parsed}{ids}{ $key } if ($key && !$self->{parsed}{ids}{ $key });
}
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;

View file

@ -27,7 +27,7 @@ sub init_conf(;$)
{
$git_server = $_ if (shift);
$gitolite_directory = mktemp("/tmp/git_manage_XXXX");
$gitolite_directory = mktemp("/tmp/git_manage_XXXX") unless(-d $gitolite_directory);
log INFO, "Cloning $git_user\@$git_server:$git_adminrepo to $gitolite_directory";
@ -48,7 +48,6 @@ sub save_conf(;$)
log INFO, "Saving repositories configuration";
qx(git push);
chdir("/");
remove_tree($gitolite_directory);
$gitolite_directory = undef;
}
@ -272,7 +271,7 @@ sub user_delete
{
if ($f =~ /^[0-9]/ && -d "$gitolite_directory/keydir/$f") {
log INFO, "Removing $f directory";
remove_tree("$gitolite_directory/keydir/$f");
rmtree("$gitolite_directory/keydir/$f");
}
}
else

55
ACU/t/tinyglob.t Normal file
View file

@ -0,0 +1,55 @@
use v5.10.1;
use strict;
use warnings;
use Test::More;
use lib "../";
BEGIN {
diag("Testing Tinyglob on perl $]");
use_ok('ACU::Tinyglob');
}
use ACU::Tinyglob;
is(Tinyglob::tinyglob("test"), "test");
is(Tinyglob::tinyglob("\\*"), "\\*");
is(Tinyglob::tinyglob("\\\\*"), "\\\\.*");
is(Tinyglob::tinyglob("\\?"), "\\?");
is(Tinyglob::tinyglob("\\\\?"), "\\\\.");
is(Tinyglob::tinyglob("\\."), "\\.");
is(Tinyglob::tinyglob("\\\\."), "\\\\\\.");
is(Tinyglob::tinyglob("a*b?"), "a.*b.");
ok(! Tinyglob::match("?", ""));
ok(! Tinyglob::match("b", "a"));
ok(! Tinyglob::match("b*", "a"));
ok(! Tinyglob::match("b?", "a"));
ok(Tinyglob::match("*", ""));
ok(Tinyglob::match("a", "a"));
ok(Tinyglob::match("?", "a"));
ok(Tinyglob::match("*", "a"));
ok(Tinyglob::match("ab", "ab"));
ok(Tinyglob::match("?b", "ab"));
ok(Tinyglob::match("*b", "ab"));
ok(Tinyglob::match("*", "ab"));
ok(Tinyglob::match("b?", "ba"));
ok(Tinyglob::match("b*", "ba"));
ok(Tinyglob::match("*", "abcdef"));
ok(Tinyglob::match("a?b", "acb"));
ok(Tinyglob::match("a*b", "acb"));
ok(Tinyglob::match("a*b", "acdefb"));
ok(Tinyglob::match("a*b*", "acdefblkjgd"));
ok(! Tinyglob::match("a?b*", "acdefblkjgd"));
ok(Tinyglob::match("a?b*", "acblkjgd"));
ok(Tinyglob::match("a?b*", "abblkjgd"));
ok(! Tinyglob::match("a*b?", "abblkjgd"));
ok(Tinyglob::match("a*b?", "aasdasbd"));
done_testing();

View file

@ -1,13 +1,10 @@
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
@ -20,20 +17,10 @@ install:
$(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
@ -46,16 +33,6 @@ unstall:
! 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:
$(PROVER) $(TESTDIR)

View file

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

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

View file

@ -6,7 +6,7 @@ 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"
KNOWN_ACTIONS="start stop restart update log viewlog view_log"
LOG=`mktemp`
@ -80,7 +80,7 @@ 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" ]
if [ "$ACTION" == "update" ]
then
SCP=0
for D in $SCP_LIST
@ -94,11 +94,6 @@ do
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 ..

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

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

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

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

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

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

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
{

View file

@ -11,6 +11,7 @@ my $projid = $ARGV[0];
my $year = $ARGV[1] // LDAP::get_year;
my $res = API::Projects::get_groups($projid, $year);
my $tag = "rendu-1";
map {
my $chief;
@ -25,16 +26,10 @@ map {
}
}
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";
print ' RW+ = @admins';
for my $member (@{ $_->{stds} }) {
print ' '.$member->{login};
}
say "\n R = \@chefs \@resp-$year-$projid";
} @{ $res->{groups} };

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;

View file

@ -5,7 +5,6 @@ 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";
@ -14,14 +13,13 @@ my $ip = $1 if ($ENV{'SSH_CLIENT'} =~ m/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-
exit 0 if (!$ip);
log DEBUG, "Connection by $ENV{GL_USER} with $ARGV[0] to $ENV{GL_REPO} from $ip";
log DEBUG, "Connection with $ARGV[0] to $ENV{GL_REPO} from $ip";
my $promo = qx(git config hooks.promo);
my $id_project = qx(git config hooks.idproject);
my $repo_login = qx(git config hooks.repologin);
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);
my @habitent_loin = ("abdeln_a", "amed_m", "bellev_m", "faure_n", "freima_m", "ikouna_l", "simon_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}\/.+\/.+/);
@ -50,12 +48,10 @@ if ($ip->overlaps($labnetwork) == $IP_A_IN_B_OVERLAP)
# 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");
exit 0 if (grep { /\Q$repo_login\E/ } @habitent_loin);
my $schoolnetwork = Net::IP->new('10.41.0.0/16');
my $vjschoolnetwork = Net::IP->new('10.3.0.0/16');
#my $vjschoolnetwork = Net::IP->new('10.3.0.0/16');
if (
$ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP

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;
}

View file

@ -69,7 +69,7 @@ sub check_xml
sub repository_name
{
my $repo = $ENV{GL_REPO};
$repo =~ s#subject.*/([^/]+)$#$1#;
$repo =~ s#^subjects/(.*)#$1#;
return $repo;
}
@ -97,7 +97,7 @@ sub tag_defense
my $path;
if ($_[3])
{
if ($_[3] =~ /^(?:defenses\/)?([a-zA-Z0-9_.\/-]+?)(?:.xml)?$/) {
if ($_[3] =~ /^(?:defenses\/)?([a-zA-Z0-9_.\/-]+)(?:.xml)?$/) {
$path = "defenses/".$1.".xml";
} else {
$path = $_[3];
@ -119,11 +119,12 @@ sub tag_defense
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 $defense_id;
if ($path =~ /^(?:defenses\/)?([a-zA-Z0-9\/]+)(?:.xml)?$/) {
$defense_id = $1;
} else {
log ERROR, "Déplacez votre soutenance dans le dossier defenses ou simplifiez le nom du fichier.";
}
my $year;
if ($_[4])
@ -168,7 +169,7 @@ sub tag_defense
# Generate questions and answer id
my $defense = Defense->new(\$content);
$defense->genIds($defense_id);
$defense->genIds();
# Send data to intradata
log INFO, "Attente d'un processus de publication...";
@ -306,7 +307,6 @@ sub tag_project
# 2: $year
my $project_id = repository_name();
my $flavour = "";
if ($_[1]) {
# Check on ID/flavour_id
@ -315,7 +315,6 @@ sub tag_project
}
$project_id .= "-" . $_[1];
$flavour = $_[1];
}
$project_id = lc $project_id;
$project_id =~ s/[^a-z0-9-_]/_/g;
@ -376,22 +375,17 @@ sub tag_project
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");
exists $_->{vcs} and $_->{vcs}{tag} eq $vcs->hasAttribute("tag");
} @{ $project->{submissions} };
if (@rendus == 1)
{
log DEBUG, "Use existing token: ".$rendus[0]->{vcs}{token};
if (@rendus == 1) {
log INFO, "Use existing token: ".$rendus[0]->{vcs}{token};
$vcs->setAttribute("token", substr($rendus[0]->{vcs}{token}, 2, 23));
$mod = 1;
next;
@ -425,7 +419,7 @@ sub tag_project
log INFO, "Information de l'intranet...";
# Call API
eval {
API::Projects::add($project_id, $flavour, $year);
API::Projects::add($project_id, $year);
};
if ($@)
{

View file

@ -8,7 +8,6 @@ use File::Basename;
use Net::IP;
use POSIX qw(strftime);
use Socket;
use utf8;
use ACU::API::Projects;
use ACU::API::Submission;
@ -23,11 +22,6 @@ 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; }
@ -39,68 +33,12 @@ $repo_login = $1 if (!$repo_login && $ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/);
exit(0) if (!$promo || !$id_project || !$repo_login);
if ($ref =~ m<^refs/tags/ACU-(.+)$>)
if ($ref =~ m<^refs/tags/(.+)$>)
{
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
{
# Get project informations
my $project;
eval {
$project = API::Projects::get($id_project, $promo);
@ -110,17 +48,15 @@ sub get_project_info
my $err = $@;
log TRACE, $err;
log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire.";
exit(1);
exit 1;
}
log TRACE, $project;
return $project;
}
sub check_submission_date
{
my $tokengiven = shift;
# Extract lot of data
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $tag;
} @{ $project->{submissions} };
my $glts = DateTime::Format::ISO8601->parse_datetime(
do {
@ -129,17 +65,14 @@ sub check_submission_date
$t
});
for my $rendu (@_)
chomp (my $tokengiven = `git cat-file tag $newsha 2> /dev/null | sed -e '1,/^\$/d'`);
for my $rendu (@rendus)
{
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");
}
# TODO: check exceptions by login/group
$open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l");
say "Date courante : ", $glts->strftime("%d/%m/%Y %H:%M:%S");
@ -166,5 +99,40 @@ sub check_submission_date
}
}
return 1;
if ($newsha eq '0' x 40) {
log USAGE, "Mais pour quelle raison voudriez-vous supprimer un tag ?!";
}
else
{
eval {
Process::Client::launch("send_git",
{
"year" => $promo,
"id" => $id_project,
"rendu" => $tag,
"login" => $repo_login,
# "path" => "ssh://git\@localhost/".$ENV{GL_REPO},
}, undef, 1);
};
if ($@) {
my $err = $@;
log DEBUG, "ERROR: ".$err;
}
# Send data to API
my $last_commit = `git log $newsha -1 --decorate --tags`;
eval {
API::Submission::add($promo, $id_project, $tag, $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;

View file

@ -20,26 +20,21 @@ tex2md()
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"
# BEGIN HACK! Need stacking
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"
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/\\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"
@ -51,9 +46,11 @@ tex2md()
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"
sed -Ei 's/``/"/g' "$i"
sed -Ei "s/''/\"/g" "$i"
# Special macros
sed -Ei 's/\\(file|email|command|bcode|code) *\{([^}]*)\}/\\verb+\2+/gi' "$i"
sed -Ei 's/\\(file|email|command|code|bcode) *\{([^}]*)\}/\\verb+\2+/gi' "$i"
sed -Ei 's/\\begin *\{assistant\}/\\verb+%%assistant-begin+/g' "$i"
sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i"
@ -84,7 +81,7 @@ tex2md()
git rm -f "$i" > /dev/null
fi
sed -Ei 's/`%%([a-z-]+)\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md"
sed -Ei 's/`%%([a-z-])\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md"
sed -Ei 's/\\$/\n/' "$DEST/${bi%%.tex}.md"
done
}
@ -114,7 +111,7 @@ clean_tex()
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
for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png *.cls *.sty
do
if [ -f "$f" ]
then
@ -161,7 +158,7 @@ clean_tex()
elif [ `find -mindepth 1 -maxdepth 1 -name '*.tex' | wc -l` -gt 0 ]
then
tex2md .
else
for i in *
do
@ -231,7 +228,7 @@ 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 {} \;
git rm -f moulette/DESC 2> /dev/null
@ -348,18 +345,6 @@ 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
fi
done

View file

@ -14,7 +14,6 @@ use ACU::Process;
my %master_actions =
(
"launch" => \&master_launch,
"list" => \&master_list,
"register" => \&master_register,
);
@ -24,40 +23,17 @@ sub master_register
{
my $args = shift;
if ($args->{param}{nodename})
{
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";
}
log INFO, "New node: $nodename";
push @nodes, "$nodename";
}
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;
@ -145,13 +121,13 @@ sub master_launch
}
for my $node (@lnodes) {
my @o = $ret{$node}->documentElement->getElementsByTagName("out");
if (@o) {
my $o = $ret{$node}->documentElement->getElementsByTagName("out");
if ($o) {
$output .= $o[0]->firstChild->nodeValue;
}
my @e = $ret{$node}->documentElement->getElementsByTagName("err");
if (@e) {
$e = $ret{$node}->documentElement->getElementsByTagName("err");
if ($e) {
$output .= $e[0]->firstChild->nodeValue;
}
$output .= $e[0]->firstChild->nodeValue;
@ -196,5 +172,4 @@ sub process_master
log INFO, "Starting guantanamo.pl as master process";
Process::add_server("gearmand:4730");
Process::register("guantanamo", \&process_master);

View file

@ -9,6 +9,7 @@ use File::Temp qw/tempfile tempdir/;
use IPC::Open3;
use XML::LibXML;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
@ -52,18 +53,10 @@ sub node_launch
$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($wtr, $rdr, $stderr);
my $pid = open3($wtr, $rdr, $stderr, $c->{nodeValue});
waitpid( $pid, 0 );
my $rv = $? >> 8;
my $out = $doc->createElement("out");
my $str = "";
@ -100,7 +93,7 @@ sub process_node
my $action = $args->{param}{action} // "launch";
if (! exists $node_actions{$action}) {
warn "Unknown action '$action' for guantanamo node process.";
log WARN, "Unknown action '$action' for guantanamo node process.";
}
return $node_actions{$action}($args);
}
@ -109,7 +102,7 @@ if ($#ARGV == 0)
{
log INFO, "Starting guantanamo.pl as node process";
Process::Client::launch("guantanamo", {"action" => "register", "nodename" => $ARGV[0]}, undef, 1);
Process::Client::launch("guantanamo", {"action" => "register", "nodename" => $ARGV[0]});
Process::register("guantanamo_".$ARGV[0], \&process_node);
}

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

View file

@ -8,7 +8,6 @@ use Pod::Usage;
use lib "../../";
use ACU::API::Projects;
use ACU::Log;
use ACU::LDAP;
use ACU::Grading;
@ -43,7 +42,7 @@ sub create_tree($$)
croak "No directory for year $year. Ask a root to create it." if (! -d "$basedir/$year/");
if (! -e "$basedir/$year/$project_id/") {
mkdir "$basedir/$year/$project_id/" or die $!;
mkdir "$basedir/$year/$project_id/" or croak $!;
}
}
@ -58,14 +57,11 @@ sub grades_generate
croak "No project_id given." if (! $project_id);
if (! -e "$basedir/$year/$project_id/grades/") {
mkdir "$basedir/$year/$project_id/grades/" or die $!;
mkdir "$basedir/$year/$project_id/grades/" or croak $!;
}
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})
@ -76,11 +72,22 @@ sub grades_generate
}
else
{
map {
for my $member (@{ $_->{stds} }) {
push @logins, $member->{login};
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))
{
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))
{
$login =~ s/\.xml$//;
if (! grep { /^\Q$login\E$/ } @logins) {
push @logins, $login;
}
}
} @{ $groups->{groups} };
closedir $dhm;
}
closedir $dh;
}
log TRACE, @logins;
@ -100,57 +107,27 @@ sub grades_generate
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} })
log DEBUG, "Generating grades from $dir";
if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml")
{
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;
}
open my $xmltrace, "<", "$basedir/$year/$project_id/traces/$dir/$login.xml" or croak "traces/$dir/$login.xml: $!";
binmode $xmltrace;
my $trace = Trace->new($xmltrace);
close $xmltrace;
log DEBUG, "Fill from file: traces/$dir/$login.xml";
log TRACE, $trace->getIds;
$grading->fill($trace->getIds);
}
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: $!";
open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml";
binmode $xmlgrade;
print $xmlgrade $grading->computeXML($login);
close $xmlgrade;
@ -171,12 +148,11 @@ sub grades_new_bonus
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 $!;
mkdir "$basedir/$year/$project_id/traces/" or croak $!;
}
if (! -e "$basedir/$year/$project_id/traces/bonus/") {
mkdir "$basedir/$year/$project_id/traces/bonus/" or die $!;
mkdir "$basedir/$year/$project_id/traces/bonus/" or croak $!;
}
for my $kfile (keys %{ $args->{files} })
@ -203,7 +179,7 @@ sub grades_new_bonus
for my $line (@lines)
{
if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*(-?[0-9.]+))?$/)
if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*([0-9.]+))?$/)
{
my $login = $1;
my $tvalue = $2 // $value;
@ -216,9 +192,9 @@ sub grades_new_bonus
}
if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") {
open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!;
binmode $xml;
$trace = Trace->new(join '', <$xml>);
$trace = Trace->new($xml);
close $xml;
}
elsif ($delete) {
@ -235,18 +211,17 @@ sub grades_new_bonus
$trace->delId($kbonus);
}
} else {
my $e = $trace->addId($kbonus, $tvalue);
$e->changeWho($login, "login");
$trace->addId($kbonus, $tvalue);
}
log DEBUG, "Updating $basedir/$year/$project_id/traces/bonus/$login.xml";
open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!;
print $xml $trace->toString();
close $xml;
}
else {
warn "Invalid login $line, line skiped";
log WARN, "Invalid login $line, line skiped";
}
}
}
@ -276,19 +251,19 @@ sub update_defense
log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
if (! -e "$basedir/$year/$project_id/defenses/") {
mkdir "$basedir/$year/$project_id/defenses/" or die $!;
mkdir "$basedir/$year/$project_id/defenses/" or croak $!;
}
if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or die $!;
mkdir "$basedir/$year/$project_id/traces/" or croak $!;
}
if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!;
my ($login, $pass, $uid, $gid) = getpwnam("www-data");
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/";# or die $!; #FIXME
chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!;
chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!;
}
open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or die $!;
open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or croak $!;
print $out $defense;
close $out;
@ -347,11 +322,11 @@ sub update_trace
log INFO, "Update $year/$project_id/traces/$rendu_id/$login.xml";
if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or die $!;
mkdir "$basedir/$year/$project_id/traces/" or croak $!;
}
if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") {
mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or die $!;
chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or die $!;
mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!;
chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!;
}
open my $out, ">", "$basedir/$year/$project_id/traces/$rendu_id/$login.xml" or croak("Unable to write to $rendu_id/$login.xml");

View file

@ -7,7 +7,6 @@ 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/;
@ -154,39 +153,11 @@ sub create_testsuite
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);
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2];
copy("$tempdir/tests/tests.ff", "$destdir/tests.ff") or croak "An error occurs while coping the testsuite: $!";
copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!";
chmod 0660, "$destdir/tests.ff";
# 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.";
}
chmod 0660, "$destdir/test.ft";
# Clean
remove_tree($tempdir);
@ -239,7 +210,7 @@ sub run_moulette
close $fhout;
}
copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannot copy $login.ff";
copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannont 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");

View file

@ -7,7 +7,6 @@ use v5.10;
use File::Path qw(remove_tree);
use File::Temp qw/tempfile tempdir/;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
@ -16,16 +15,11 @@ sub process
{
my ($given_args, $args) = @_;
my $year = $args->{param}{year} // LDAP::get_year();
my $year = $args->{param}{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();
@ -35,10 +29,10 @@ sub process
croak "$path is not a valid repository." if ($?);
my $tar;
open my $fh, "tar -czf - -C '$tempdir' . |" or die ("Error during tar: " . $!);
open my $fh, "tar -czf - -C '$tempdir' . |" or die ($!);
$tar .= $_ while(<$fh>);
close $fh;
die "Unable to tar: $!" if ($?);
die "Unable to untar: $!" if ($?);
# Clean
remove_tree($tempdir);
@ -48,7 +42,7 @@ sub process
"type" => "std",
"id" => $project_id,
"year" => $year,
"rendu" => $rendu_for,
"rendu" => $rendu,
"login" => $login,
"file" => "rendu.tgz"
},

View file

@ -12,17 +12,13 @@ else
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 "killall ssh-agent" | $SU intradmin
echo "ssh-agent" | $SU intradmin > "$TMP"
echo ". $TMP; ssh-add '$3'" | $SU intradmin
CMD=". $TMP; ssh-add -l; echo; $CMD"
@ -84,13 +80,10 @@ 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
;;

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-Z]+)\)$/)
{
log INFO, "Receive valid key: type $2, size $1";
if ($2 eq "RSA") {

View file

@ -7,6 +7,8 @@ use Carp;
use Pod::Usage;
use Text::ParseWords;
use lib "../../";
use ACU::Defense;
use ACU::Grading;
use ACU::Log;
@ -14,8 +16,6 @@ use ACU::LDAP;
use ACU::Process;
use ACU::Trace;
$ACU::Log::mail_error = 1;
our $basedir = "/intradata";
sub process
@ -80,7 +80,7 @@ sub process
open my $xml, "<", "$basedir/$year/$project_id/traces/$dir/$login" or die $!;
binmode $xml;
my $trace = Trace->new(join '', <$xml>);
my $trace = Trace->new($xml);
my %tids = %{ $trace->getIds() };
for my $kid (keys %tids)
@ -97,5 +97,4 @@ sub process
return $grade->toString;
}
Process::set_servers("gearmand:4730");
Process::register_no_parse("gen_grading", \&process);

View file

@ -12,8 +12,6 @@ use ACU::Log;
use ACU::LDAP;
use ACU::Process;
$ACU::Log::mail_error = 1;
our $basedir = "/intradata";
sub process
@ -25,11 +23,14 @@ sub process
my $year = shift @args // LDAP::get_year;
# Project existing?
croak "Unable to find $project_id in $year" if (! -d "$basedir/$year/$project_id");
if (! -d "$basedir/$year/$project_id")
{
log ERROR, "Unable to find $project_id in $year";
return "Unable to find $project_id in $year\n";
}
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))
@ -48,10 +49,9 @@ sub process
my $i;
for ($i = 0; $i <= $#ugrades; $i++)
{
if ($ugrades[$i] eq $grade->getAttribute("name"))
if ($ugrades[$i] == $grade->getAttribute("name"))
{
$ugrades[$i] = $grade->getAttribute("value");
$averages[$i] += $grade->getAttribute("value");
last;
}
}
@ -60,7 +60,6 @@ sub process
{
push @headers, $grade->getAttribute("name");
push @ugrades, $grade->getAttribute("value");
push @averages, $grade->getAttribute("value");
}
}
@ -71,15 +70,12 @@ sub process
# Print CSV
my $out = "login";
foreach my $header (@headers) {
for my $header (@headers) {
$out .= ",$header";
}
$out .= "\n";
my $nb = 0;
foreach my $login (keys %grades)
{
$nb += 1;
for my $login (keys %grades) {
$out .= "$login";
my @ugrades = @{ $grades{$login} };
for my $header (@headers)
@ -95,15 +91,7 @@ sub process
$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);

272
utils/lpt
View file

@ -3,11 +3,7 @@
use v5.10.1;
use strict;
use warnings;
use utf8;
use open IO => ':utf8';
use open ':std';
use Encode qw(decode);
use Digest::SHA;
use Email::MIME;
use File::Find;
@ -73,12 +69,10 @@ my %cmds =
my %cmds_account =
(
"add" => \&cmd_account_add,
"alias" => \&cmd_account_alias,
"close" => \&cmd_account_close,
"cn" => \&cmd_account_cn,
"create" => \&cmd_account_create,
"delete" => \&cmd_account_delete,
"finger" => \&cmd_account_view,
"mail" => \&cmd_account_mail,
"name" => \&cmd_account_cn,
@ -201,7 +195,7 @@ sub cmd_account_alias($@)
return cmd_account_multiple_vieworchange('mailAlias', 'alias', @_);
}
sub cmd_account_close($;@)
sub cmd_account_close($@)
{
my $login = shift;
@ -251,51 +245,12 @@ sub cmd_account_cn($@)
return cmd_account_vieworchange('cn', 'name', @_);
}
sub cmd_account_add($@)
{
my $login = shift;
my $passwd_path = shift // "./passwd";
if (! -f $passwd_path)
{
log(USAGE, "lpt account <login> add [./passwd] [nopass|passgen|password]");
return 1;
}
open my $fh, "<", $passwd_path;
my @passwd_cnt = <$fh>;
close($fh);
for my $line (grep { /^$login:x/ } @passwd_cnt)
{
if ($line =~ /^$login:x:([0-9]+):([0-9]+):([^ :]+) ?([^:]*):/)
{
my $uid = $1;
my $gid = $2;
my $firstname = ucfirst $3;
my $lastname = ucfirst $4;
if (! $noconfirm)
{
say "Add user: ", YELLOW, BOLD, "$login", RESET, ":\n\tFirstname: ", BOLD, $firstname, RESET, "\n\tLastname: ", BOLD, $lastname, RESET, "\n\tUID:\t", BOLD, $uid, RESET, "\n\tGroup:\t", BOLD, $gid, RESET;
print "Would you like to add this user? [", GREEN, "y", RESET, "/", RED, "N", RESET, "] ";
my $go = <STDIN>;
chomp $go;
next if ($go ne "y" and $go ne "yes");
}
cmd_account_create($login, $gid, $uid, $firstname, $lastname, @_);
}
}
}
sub cmd_account_create($@)
{
my $login = shift;
if ($#_ < 3) {
log(USAGE, "lpt account <login> create <year> <uid> <prénom> <nom> [nopass|passgen|password]");
log(USAGE, "lpt account <login> create <year> <uid> <prénom> <nom> [nopass|passgen|password]");
return 1;
}
@ -304,31 +259,11 @@ sub cmd_account_create($@)
log(DEBUG, "Adding dn: uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr ...");
my $ldap = LDAP::ldap_connect();
# Check if the OU exists
my $oudn = "ou=$group,ou=users";
my $ou = LDAP::get_dn($ldap, $oudn);
if (! $ou)
{
my $mesg = $ldap->add( "$oudn,dc=acu,dc=epita,dc=fr",
attrs => [
objectclass => [ "top", "organizationalUnit" ],
ou => "$group",
]
);
if ($mesg->code == 0) {
log(INFO, "New OU created: $oudn");
} else {
log(WARN, "Unable to add new OU $oudn: ", RESET, $mesg->error);
}
}
my $mesg = $ldap->add( "uid=$login,$oudn,dc=acu,dc=epita,dc=fr",
my $mesg = $ldap->add( "uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr",
attrs => [
objectclass => [ "top", "epitaAccount" ],
uidNumber => shift,
cn => ucfirst(shift(@_))." ".ucfirst(shift(@_)),
cn => shift(@_)." ".shift(@_),
mail => "$login\@epita.fr",
uid => $login,
]
@ -336,11 +271,10 @@ sub cmd_account_create($@)
#$ldap->unbind or die ("couldn't disconnect correctly");
if ($mesg->code == 0)
{
if ($mesg->code == 0) {
log(INFO, "Account added: $login");
my $pass = shift // "nopass";
return cmd_account($login, $pass, @_) if ($pass ne "nopass");
my $pass = shift;
return cmd_account($login, $pass) if ($pass ne "nopass");
return 0;
}
else {
@ -348,28 +282,6 @@ sub cmd_account_create($@)
}
}
sub cmd_account_delete($@)
{
my $login = shift;
my $ldap = LDAP::ldap_connect();
my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
log(DEBUG, "Deleting dn: $dn ...");
if (LDAP::delete_entry($ldap, $dn))
{
log DONE, "Account ", YELLOW, $login, RESET, " successfully deleted.";
return 0;
}
else
{
log ERROR, "Unable to delete account ", YELLOW, $login, RESET, ".";
return 1;
}
}
sub cmd_account_grantintra($@)
{
my $login = shift;
@ -388,58 +300,27 @@ sub cmd_account_grantintra($@)
sub cmd_account_grantlab($@)
{
my $login = shift;
my $group = shift // "";
my $group = shift;
if ($group ne "acu" && $group ne "yaka" && $group ne "ferry")
{
log(USAGE, "lpt account <login> grant-lab <acu|yaka|ferry>");
if ($group ne "acu" && $group ne "yaka") {
log(USAGE, "lpt account <login> grantlab <acu|yaka>");
return 1;
}
my $ldap = LDAP::ldap_connect();
my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
my $entry = LDAP::get_dn($ldap, $dn, "objectClass", "mail", "mailAlias", "mailAccountActive", "loginShell", "homeDirectory", "gidNumber");
if (!LDAP::get_attribute($ldap, $dn, "mail")) {
LDAP::add_attribute($ldap, $dn, "mail", "$login\@epita.fr");
}
if ($group eq "acu" || $group eq "yaka")
{
if (! grep { $_ eq "MailAccount" } @{ $entry->get_value("objectClass") })
{
$entry->replace("mailAccountActive" => [ "yes" ]);
LDAP::add_attribute($ldap, $dn, "mailAlias", "$login\@$group.epita.fr");
LDAP::update_attribute($ldap, $dn, "mailAccountActive", "yes");
LDAP::add_attribute($ldap, $dn, "objectClass", "MailAccount");
LDAP::add_attribute($ldap, $dn, "objectClass", "labAccount");
my @oc = $entry->get_value("objectClass");
push @oc, "MailAccount";
$entry->replace("objectClass" => \@oc);
my @aliases = $entry->get_value("mailAlias");
push @aliases, "$login\@$group.epita.fr";
$entry->replace("objectClass" => \@aliases);
}
$entry->replace("loginShell" => [ "/bin/zsh" ]) if ($entry->get_value("loginShell"));
$entry->replace("homeDirectory" => [ "/home/201X/$login" ]) if ($entry->get_value("homeDirectory"));
$entry->replace("gidNumber" => [ "4242" ]) if ($entry->get_value("gidNumber"));
}
elsif ($group eq "ferry")
{
$entry->replace("loginShell" => [ "/bin/noexists" ]);
$entry->replace("homeDirectory" => [ "/dev/null" ]);
$entry->replace("gidNumber" => [ "4243" ]);
}
my @oc = $entry->get_value("objectClass");
push @oc, "labAccount";
$entry->replace("objectClass" => \@oc);
my $mesg = $entry->update($ldap) or die $!;
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
log(INFO, "$login now grants to receive e-mail and connect in laboratory.") if ($group eq "acu" || $group eq "yaka");
log(INFO, "$login now grants to connect in laboratory for exam.") if ($group eq "ferry");
log(INFO, "$login now grants to receive e-mail and connect in laboratory.");
$ldap->unbind or die ("couldn't disconnect correctly");
}
@ -881,7 +762,7 @@ sub cmd_groups($@)
if ($gname && $gname =~ /^(2[0-9]{3})$/)
{
$ou = "ou=$1,$ou";
$ou = "year=$1,$ou";
$gname = shift;
}
@ -1088,7 +969,7 @@ sub cmd_group_create
log(DEBUG, "Adding dn: cn=$gname,ou=intra,ou=groups,dc=acu,dc=epita,dc=fr ...");
my $dn = "cn=$gname,$ou";
my $dn = "cn=$gname,$ou,dc=acu,dc=epita,dc=fr";
my $class;
$class = "intraGroup" if ($ou ne $group_types{system});
@ -1100,7 +981,7 @@ sub cmd_group_create
};
log(ERROR, $@) if ($@);
my $mesg = $ldap->add( $dn . ",dc=acu,dc=epita,dc=fr",
my $mesg = $ldap->add( $dn,
attrs => [
objectclass => [ "top", $class ],
cn => $gname,
@ -1124,7 +1005,7 @@ sub cmd_group_delete(@)
my $ou = shift;
my $gname = shift;
my $dn = "cn=$gname,$ou";
my $dn = "cn=$gname,$ou,dc=acu,dc=epita,dc=fr";
log(DEBUG, "Deleting dn: $dn ...");
@ -1449,7 +1330,7 @@ sub cmd_account_quota_sync($;$)
my $quotaSgoinfreBlock = $entry->get_value("quotaSgoinfreBlock") // $def_quota{block}{sgoinfre};
my $quotaSgoinfreFile = $entry->get_value("quotaSgoinfreFile") // $def_quota{file}{sgoinfre};
require Quota;
require "Quota";
if (Quota::setqlim($dev_quota{home}, $entry->get_value("uidNumber"), int(0.9 * $quotaHomeBlock), $quotaHomeBlock, int(0.9 * $quotaHomeFile), $quotaHomeFile, 1, 0) == 0 and
Quota::setqlim($dev_quota{sgoinfre}, $entry->get_value("uidNumber"), int(0.9 * $quotaSgoinfreBlock), $quotaSgoinfreBlock, int(0.9 * $quotaSgoinfreFile), $quotaSgoinfreFile, 1, 0) == 0) {
@ -1473,7 +1354,7 @@ sub cmd_account_quota_sync($;$)
sub cmd_sync_quota(@)
{
require Quota;
require "Quota";
# Set root quota
Quota::setqlim($dev_quota{home}, 0, 0, 0, 0, 0, 1, 0);
@ -1536,7 +1417,7 @@ sub get_no_strong_auth_user()
my $token = $home . "/.google_authenticator";
my $login = $entry->get_value("uid");
push @faulty_users, $entry if (! -f $token || -s $token < 90);
push @faulty_users, $entry if (! -f $token || -s $token < 100);
}
$ldap->unbind or die ("couldn't disconnect correctly");
@ -1556,8 +1437,7 @@ sub cmd_no_strong_auth_view(@)
sub cmd_no_strong_auth_warn(@)
{
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
require "Email::Sender::Simple";
for my $entry (get_no_strong_auth_user())
{
@ -1565,11 +1445,11 @@ sub cmd_no_strong_auth_warn(@)
say $entry->get_value("uid");
my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",
my $body = "Bonjour ".$entry->get_value("cn").",
Vous n'avez pas activé l'authentification forte pour SSH.
Vous n'avez pas activé l'authentification forte pour SSH.
Pour connaître la marche à suivre pour l'activer, consultez :
Pour connaître la marche à suivre pour l'activer, consultez :
https://www.acu.epita.fr/wiki/index.php?title=Ssh_double_factor_auth
Merci de rectifier la situation au plus vite ou votre compte sera mis
@ -1577,8 +1457,8 @@ en suspens.
Cordialement,
P.-S. : Ce message est généré automatiquement, les roots sont en copie.
Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr
P.-S. : Ce message est généré automatiquement, les roots sont en copie.
Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr
--
Les roots ACU";
@ -1590,21 +1470,15 @@ Les roots ACU";
Cc => 'Roots assistants <root@acu.epita.fr>',
Subject => "[PILA][AUTH-FORTE] Authentification forte SSH non active"
],
attributes => {
encoding => 'quoted-printable',
charset => 'utf-8',
format => 'flowed',
},
body_str => $body,
);
sendmail($mail);
Email::Sender::Simple::sendmail($mail);
}
}
sub cmd_no_strong_auth_close(@)
{
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
require "Email::Sender::Simple";
for my $entry (get_no_strong_auth_user())
{
@ -1612,14 +1486,12 @@ sub cmd_no_strong_auth_close(@)
say $entry->get_value("uid");
cmd_account_close($entry->get_value("uid"));
my $body = "Bonjour ".$entry->get_value("cn").",
my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",
Après plusieurs relances de notre part, vous n'avez toujours pas activé
l'authentification forte pour SSH. Votre compte a donc été suspendu.
Après plusieurs relances de notre part, vous n'avez toujours pas activé
l'authentification forte pour SSH. Votre compte a donc été suspendu.
Nous vous invitons à passer au laboratoire pour faire réactiver votre
Nous vous invitons à passer au laboratoire pour faire réactiver votre
compte.
Cordialement,
@ -1635,14 +1507,9 @@ Les roots ACU";
Cc => 'Roots assistants <root@acu.epita.fr>',
Subject => "[PILA][ACCES] Compte suspendu"
],
attributes => {
encoding => 'quoted-printable',
charset => 'utf-8',
format => 'flowed',
},
body_str => $body,
);
sendmail($mail);
Email::Sender::Simple::sendmail($mail);
}
}
@ -1764,8 +1631,7 @@ sub cmd_ssh_keys_without_passphrase_view(@)
# warn about unprotected keys
sub cmd_ssh_keys_without_passphrase_warn(@)
{
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
require "Email::Sender::Simple";
my $process = sub() {
my $entry = shift;
@ -1774,13 +1640,13 @@ sub cmd_ssh_keys_without_passphrase_warn(@)
# Display
say $entry->get_value("uid");
my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",
my $body = "Bonjour ".$entry->get_value("cn").",
Un outil automatique a découvert une clef sans passphrase sur votre compte
du laboratoire. Il est impératif de mettre une passphrase chiffrant votre
clef pour des raisons de sécurité.
Un outil automatique a découvert une clef sans passphrase sur votre compte
du laboratoire. Il est impératif de mettre une passphrase chiffrant votre
clef pour des raisons de sécurité.
Les clefs non protégées sont les suivantes :\n";
Les clefs non protégées sont les suivantes :\n";
foreach my $key (@$keys)
{
$key =~ s#^$nfsHomePrefix#$wksHomePrefix#;
@ -1789,13 +1655,13 @@ Les clefs non protégées sont les suivantes :\n";
$body .= "\nPour mettre une passphrase :
\$ ssh-keygen -p -f CHEMIN_VERS_LA_CLE_PRIVEE
Merci de rectifier la situation au plus vite ou votre clé sera supprimée et
Merci de rectifier la situation au plus vite ou votre clé sera supprimée et
votre compte sera mis en suspens.
Cordialement,
PS: Ce message est généré automatiquement, les roots sont en copie.
Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr
PS: Ce message est généré automatiquement, les roots sont en copie.
Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr
--
Les roots ACU";
@ -1806,16 +1672,11 @@ Les roots ACU";
From => "Roots assistants <admin\@acu.epita.fr>",
To => $entry->get_value("mailAlias"),
Cc => 'Roots assistants <root@acu.epita.fr>',
Subject => "[PILA][SSH-KEY] Clef SSH non protégée"
Subject => "[PILA][SSH-KEY] Clef SSH non protégée"
],
attributes => {
encoding => 'quoted-printable',
charset => 'utf-8',
format => 'flowed',
},
body_str => $body,
);
sendmail($mail);
Email::Sender::Simple::sendmail($mail);
};
cmd_ssh_keys_without_passphrase_generic(\&$process);
@ -1824,8 +1685,7 @@ Les roots ACU";
# remove unprotected keys
sub cmd_ssh_keys_without_passphrase_remove(@)
{
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
require "Email::Sender::Simple";
my $process = sub() {
my $entry = shift;
@ -1835,15 +1695,15 @@ sub cmd_ssh_keys_without_passphrase_remove(@)
say $entry->get_value("uid");
# create the message
my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",
my $body = "Bonjour ".$entry->get_value("cn").",
Un outil automatique a découvert une clef sans passphrase sur votre
Un outil automatique a découvert une clef sans passphrase sur votre
compte du laboratoire.
N'ayant pas corrigé votre situation après plusieurs relances, nous avons
désactivé votre compte et supprimé le(s) clef(s) incriminées.
N'ayant pas corrigé votre situation après plusieurs relances, nous avons
désactivé votre compte et supprimé le(s) clef(s) incriminées.
Pour information, voici l'empreinte de chacune des clefs supprimée :\n";
Pour information, voici l'empreinte de chacune des clefs supprimée :\n";
foreach my $key (@$keys)
{
open (FNGR, "ssh-keygen -l -f '$key' | cut -d ' ' -f 2 |");
@ -1861,8 +1721,8 @@ Contacter les roots pour faire reouvrir votre compte.
Cordialement,
PS: Ce message est généré automatiquement, les roots sont en copie.
Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr
PS: Ce message est généré automatiquement, les roots sont en copie.
Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr
--
Les roots ACU";
@ -1872,16 +1732,11 @@ Les roots ACU";
From => "Roots assistants <admin\@acu.epita.fr>",
To => $entry->get_value("mailAlias"),
Cc => 'Roots assistants <root@acu.epita.fr>',
Subject => "[PILA][SSH-KEY] Clef SSH non protégée supprimée"
Subject => "[PILA][SSH-KEY] Clef SSH non protégée supprimée"
],
attributes => {
encoding => 'quoted-printable',
charset => 'utf-8',
format => 'flowed',
},
body_str => $body,
);
sendmail($mail);
Email::Sender::Simple::sendmail($mail);
};
cmd_ssh_keys_without_passphrase_generic(\&$process);
@ -1990,12 +1845,6 @@ B<lpt account> <login> [I<view> [I<attribute> [I<attribute> [...]]]]
If <attribute> are given, display only those attributes.
B<lpt account> <login> I<add> [./passwd] [nopass|password|passgen]
This is used to create a new Epita account, base for intra and/or lab account.
This will use the passwd file given in argument to import information about the login.
B<lpt account> <login> I<create> <promo> <uid> <Prenom> <Nom> [nopass|password|passgen]
This is used to create a new Epita account, base for intra and/or lab account.
@ -2006,12 +1855,10 @@ B<lpt account> <login> I<grant-intra>
Give rights to the user to access the intranet.
B<lpt account> <login> I<grant-lab> <acu | yaka | ferry>
B<lpt account> <login> I<grant-lab>
Give rights to the user to access intern systems of the laboratory (SSH, Unix, ...)
If ferry is given, open an account for exam only, with restricted rights.
B<lpt account> <login> I<grant-mail>
Give rights to the user to receive e-mails.
@ -2024,11 +1871,6 @@ B<lpt account> <login> I<close>
This is used to close an existing account.
B<lpt account> <login> I<delete>
This is used to delete an existing account.
NEVER DELETE AN ACCOUNT, close it instead.
B<lpt account> <login> I<mail> [new-mail]
This is used to display, or change if [new-mail] is given, the account contact adress.