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

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

Browse source
This commit is contained in:
Root Cpp Charlie 2013-11-14 15:50:54 +01:00
commit 5a83714dad
16 changed files with 682 additions and 229 deletions
Download patch file Download diff file Expand all files Collapse all files

12
ACU/Grading.pm
View file

@ -111,7 +111,7 @@ sub insert ($$$)
$self->{ids}{$_[0]} = $_[1]; $self->{ids}{$_[0]} = $_[1];
} }
sub fill ($$) sub fill
{ {
my $self = shift; my $self = shift;
my $ids = shift; my $ids = shift;
@ -340,13 +340,15 @@ sub compute ($$$;$$$)
my $login = shift; my $login = shift;
my $ref = $self->{ref}; 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) if (defined $ref)
{ {
eval { eval
{
my $glob = Tinyglob::tinyglob($ref); my $glob = Tinyglob::tinyglob($ref);
if ($glob ne $ref) if ($glob ne $ref)
{ {

71
ACU/Jail.pm Normal file
View file

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

6
ACU/LDAP.pm
View file

@ -193,9 +193,9 @@ sub get_dn($$@)
base => "$dn", base => "$dn",
filter => Net::LDAP::Filter->new("(objectClass=*)"), filter => Net::LDAP::Filter->new("(objectClass=*)"),
attrs => \@_, attrs => \@_,
scope => "sub" scope => "base"
); );
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; } return undef if ($mesg->code != 0);
if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; } if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; }
return $mesg->entry(0); return $mesg->entry(0);
@ -331,7 +331,7 @@ sub search_dn($$@)
attrs => [ ], attrs => [ ],
scope => "sub" scope => "sub"
); );
croak($mesg->error) if ($mesg->code != 0); return undef if ($mesg->code != 0);
croak("$filter not found") if ($mesg->count == 0); croak("$filter not found") if ($mesg->count == 0);
croak("$filter not unique") if ($mesg->count > 1); croak("$filter not unique") if ($mesg->count > 1);

2
ACU/Log.pm
View file

@ -67,7 +67,7 @@ sub log
if ($mail_error && $level <= ERROR) if ($mail_error && $level <= ERROR)
{ {
require "Email::Sender::Simple"; require Email::Sender::Simple;
my $mail = Email::MIME->create( my $mail = Email::MIME->create(
header_str => [ header_str => [
From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>", From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>",

9
ACU/Process.pm
View file

@ -71,15 +71,18 @@ sub do_work ($$$@)
return $err; return $err;
} }
my $ret; my $ret = "";
eval { eval {
$ret = $subref->($given_args, $args); $SIG{'__WARN__'} = sub { log WARN, $_[0]; $ret .= ">>> ".$_[0 ]; };
$ret .= $subref->($given_args, $args);
}; };
if ($@) { if ($@) {
my $err = $@; my $err = $@;
log ERROR, $err; log ERROR, $err;
return $err; $ret .= $err;
} }
return $ret; return $ret;
} }

484
ACU/Trace.pm
View file

@ -9,16 +9,13 @@ use Carp;
use utf8; use utf8;
use open qw(:encoding(UTF-8) :std); use open qw(:encoding(UTF-8) :std);
use XML::LibXML; use XML::LibXML;
use XML::SAX::ParserFactory;
sub new sub new
{ {
my $class = shift; my $class = shift;
my $self = { my $self = {
ids => {},
infos => {}, infos => {},
comments => {}, groups => [],
who => {},
}; };
bless $self, $class; bless $self, $class;
@ -33,10 +30,47 @@ sub _initialize ($$)
{ {
my $self = shift; my $self = shift;
my $sax_handler = TraceHandler->new($self); my $dom = XML::LibXML->load_xml(string => shift);
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler ); $self->{groups} = $self->parseTrace($dom->documentElement());
$self->{type} = $dom->documentElement()->getAttribute("type") // "mill";
$self->{version} = $dom->documentElement()->getAttribute("version") // 1;
}
$parser->parse_file(shift); 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;
} }
sub getVersion ($) sub getVersion ($)
@ -63,113 +97,130 @@ sub getInfos ($)
return $self->{infos}; return $self->{infos};
} }
sub getComment ($$) sub addId
{ {
my $self = shift; my $self = shift;
return $self->{comments}{$_[0]}; my $key = shift;
my $value = shift;
my $e = Trace::Eval->new($key);
$e->addValue(undef, $value);
push @{ $self->{groups} }, $e;
} }
sub getComments ($) sub delId
{ {
my $self = shift; my $self = shift;
return $self->{comments}; my $key = shift;
my $value = shift;
foreach my $group (@{ $self->{groups} })
{
if ($group->{id} eq $key)
{
if (!$value || $value == $group->getValue())
{
#$self->{groups} = \{ grep { ! } @{ $self->{groups} } };
}
last;
}
$group->delId($key, $value);
}
}
sub getIds
{
my $self = shift;
my $login = shift;
my %ids;
foreach my $group (@{ $self->{groups} })
{
my %tmp = $group->getIds($login);
while (my ($key, $value) = each %tmp)
{
$ids{$key} = $value;
}
}
return \%ids;
}
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;
} }
sub getWho ($$) sub getWho ($$)
{ {
my $self = shift; my $self = shift;
return $self->{who}{$_[0]}; return $self->getWhos()->{$_[0]};
} }
sub getFirstWho ($) sub getFirstWho ($)
{ {
my $self = shift; my $self = shift;
return $self->getWhos()->{def1_end_group};
return $self->{who}{def1_end_group};
} }
sub getWhos ($) sub getWhos
{ {
my $self = shift; my $self = shift;
return $self->{who}; my $ret = {};
foreach my $group (@{ $self->{groups} })
{
my $whos = $group->getWhos();
foreach my $who (keys %{ $whos }) {
$ret->{ $who } = $whos->{$who};
}
}
return $ret;
} }
sub getValue ($$) sub toString ($)
{ {
my $self = shift; 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 $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("trace"); my $root = $doc->createElement("trace");
my $group = $doc->createElement("group"); foreach my $group (@{ $self->{groups} })
$group->addChild( $doc->createAttribute("id", $main_grp) ); {
$root->appendChild( $group->toString($doc) );
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 ); $doc->setDocumentElement( $root );
return $doc->toString(); return $doc->toString();
} }
package TraceHandler; package Trace::Group;
use v5.10.1;
use strict;
use warnings;
use Carp; use Carp;
use constant NO_ID_VALUE => "__#";
sub new ($$) sub new ($$)
{ {
my $class = shift; my $class = shift;
my $self = { my $self = {
groups => [], id => shift,
parsed => shift, name => shift,
inComment => "", groups => []
inEval => "",
inInfo => "",
inValue => "",
inWho => "",
values => ""
}; };
bless $self, $class; bless $self, $class;
@ -177,113 +228,240 @@ sub new ($$)
return $self; return $self;
} }
sub start_element sub append ($@)
{ {
my ($self, $element) = @_; my $self = shift;
if ($element->{Name} eq "trace") { push @{ $self->{groups} }, @_;
$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} = ""; sub delId
} {
elsif ($element->{Name} eq "group") my $self = shift;
my $key = shift;
my $value = shift;
foreach my $item (@{ $self->{groups} })
{ {
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 characters sub getIds
{ {
my ($self, $characters) = @_; my $self = shift;
my $login = shift;
if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) { my %ids;
$self->{values} .= $characters->{Data}; foreach my $group (@{ $self->{groups} })
}
}
sub end_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "value")
{ {
if ($self->{values} =~ /([-+]?[0-9]+(.[0-9]+)?)/) my %tmp = $group->getIds($login);
while (my ($key, $value) = each %tmp)
{ {
$self->{parsed}{ids}{ $self->{inEval} } += $1; $ids{$key} = $value;
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;
}
} }
$self->{inValue} = "";
} }
elsif ($element->{Name} eq "eval")
$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})
{ {
# Remove empty identifier my $value = 0;
delete $self->{parsed}{ids}{ $self->{inEval} } if (!$self->{parsed}{ids}{ $self->{inEval} }); foreach my $group (@{ $self->{groups} })
$self->{inEval} = ""; {
} $value += $group->getValue(undef, $login);
elsif ($element->{Name} eq "comment")
{
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
$self->{parsed}{comments}{ $self->{inComment} } = $1;
} }
$self->{inComment} = ""; return $value;
} }
elsif ($element->{Name} eq "who") else
{ {
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { my $value = 0;
$self->{parsed}{who}{ $self->{inWho} } = $1; foreach my $group (@{ $self->{groups} })
{
$value += $group->getValue($id, $login);
} }
$self->{inComment} = ""; return $value;
} }
elsif ($element->{Name} eq "info") }
sub getWhos
{
my $self = shift;
my $ret = {};
foreach my $group (@{ $self->{groups} })
{ {
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { my $whos = $group->getWhos();
$self->{parsed}{infos}{ $self->{inInfo} } = $1; foreach my $who (keys %{ $whos }) {
$ret->{ $who } = $whos->{$who};
} }
$self->{inInfo} = "";
} }
elsif ($element->{Name} eq "group")
return $ret;
}
sub toString($$)
{
my $self = shift;
my $doc = shift;
my $gr = $doc->createElement("group");
foreach my $item (@{ $self->{groups} })
{ {
my $key = pop @{ $self->{groups} }; $gr->appendChild( $item->toString() );
# 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 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 (%{ $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});
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; 1;

5
ACU/VCS/Git.pm
View file

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

15
commands/manage-server.sh
View file

@ -1,12 +1,12 @@
#! /bin/bash #! /usr/bin/env bash
cd $(dirname "$0") cd $(dirname "$0")
WKS_LIST="apl" WKS_LIST="apl"
SRV_LIST="moore noyce hamano cpp" SRV_LIST="moore noyce hamano cpp otto"
SCP_LIST="ksh" SCP_LIST="ksh knuth"
KNOWN_ACTIONS="start stop restart update log viewlog view_log" KNOWN_ACTIONS="start stop restart install update log viewlog view_log"
LOG=`mktemp` LOG=`mktemp`
@ -80,7 +80,7 @@ do
for DEST in $DESTS for DEST in $DESTS
do do
echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m" echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m"
if [ "$ACTION" == "update" ] if [ "$ACTION" == "install" ] || [ "$ACTION" == "update" ]
then then
SCP=0 SCP=0
for D in $SCP_LIST for D in $SCP_LIST
@ -94,6 +94,11 @@ do
if [ $SCP -eq 0 ] if [ $SCP -eq 0 ]
then 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" ssh root@$DEST "make -C liblerdorf update upgrade"
else else
cd .. cd ..

40
hooks/dump-help.pl Executable file
View file

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

8
hooks/submissions.pl
View file

@ -22,6 +22,8 @@ my $promo;
my $id_project; my $id_project;
my $repo_login; 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);
# First, extract information, from config then guess from repository adress # 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.promo`) { chomp $tmp; $promo = $tmp; }
if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; } if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; }
@ -71,6 +73,12 @@ if ($ref =~ m<^refs/tags/(.+)$>)
my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin}); my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin});
my $close = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{end}); my $close = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{end});
if ($id_project eq "myhttpd" && grep { $_ eq $repo_login } @apping)
{
$open = DateTime::Format::ISO8601->parse_datetime("2013-11-08T20:00:00");
$close = DateTime::Format::ISO8601->parse_datetime("2013-11-10T11:42:00");
}
# TODO: check exceptions by login/group # TODO: check exceptions by login/group
$open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l"); $open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l");

34
migration/repo.sh
View file

@ -20,21 +20,26 @@ tex2md()
bi=`basename "$i"` bi=`basename "$i"`
echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m" echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m"
# BEGIN HACK! Need stacking # 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/\\distribution\{\}/FreeBSD 9/gi' "$i"
sed -Ei 's/\\\{/__OPEN_BRACKET_MINIROOT__/gi' "$i" sed -Ei 's/\\\{/__OPEN_BRACKET_MINIROOT__/gi' "$i"
sed -Ei 's/\\\}/__CLOSE_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" #sed -Ei 's/\\_/_/gi' "$i"
# DIRTY HACK # DIRTY HACK
sed -Ei 's/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i" sed -Ei 's/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i"
sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\input *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\input *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\{\\include *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\{\\include *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\{\\input *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\{\\input *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\lstinputlisting *\{([^}]+)\}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\lstinline *\{([^}]+)}/\\verb+\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/\\begin *\{correction\}/\\begin\{verbatim\}/g' "$i"
sed -Ei 's/\\end *\{correction\}/\\end\{verbatim\}/g' "$i" sed -Ei 's/\\end *\{correction\}/\\end\{verbatim\}/g' "$i"
sed -Ei 's/\\begin *\{prompt\}/\\begin\{verbatim\}/g' "$i" sed -Ei 's/\\begin *\{prompt\}/\\begin\{verbatim\}/g' "$i"
@ -48,7 +53,7 @@ tex2md()
sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i" sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i"
# Special macros # Special macros
sed -Ei 's/\\(file|email|command|code|bcode) *\{([^}]*)\}/\\verb+\2+/gi' "$i" 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/\\begin *\{assistant\}/\\verb+%%assistant-begin+/g' "$i"
sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i" sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i"
@ -109,7 +114,7 @@ clean_tex()
exit 1; exit 1;
fi fi
for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png *.cls *.sty *.tex 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 do
if [ -f "$f" ] if [ -f "$f" ]
then then
@ -120,6 +125,11 @@ clean_tex()
fi fi
done done
for file in `find -name "*.ltx"`
do
git mv "$file" "${file%%.ltx}.tex"
done
if [ -d "include" ] if [ -d "include" ]
then then
cd include cd include
@ -130,6 +140,20 @@ clean_tex()
git mv * .. git mv * ..
fi 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" cd "$1"
tex2md . tex2md .
maintex2md maintex2md

100
process/files/intradata_get.pl
View file

@ -8,6 +8,7 @@ use Pod::Usage;
use lib "../../"; use lib "../../";
use ACU::API::Projects;
use ACU::Log; use ACU::Log;
use ACU::LDAP; use ACU::LDAP;
use ACU::Grading; use ACU::Grading;
@ -42,7 +43,7 @@ sub create_tree($$)
croak "No directory for year $year. Ask a root to create it." if (! -d "$basedir/$year/"); croak "No directory for year $year. Ask a root to create it." if (! -d "$basedir/$year/");
if (! -e "$basedir/$year/$project_id/") { if (! -e "$basedir/$year/$project_id/") {
mkdir "$basedir/$year/$project_id/" or croak $!; mkdir "$basedir/$year/$project_id/" or die $!;
} }
} }
@ -57,11 +58,14 @@ sub grades_generate
croak "No project_id given." if (! $project_id); croak "No project_id given." if (! $project_id);
if (! -e "$basedir/$year/$project_id/grades/") { if (! -e "$basedir/$year/$project_id/grades/") {
mkdir "$basedir/$year/$project_id/grades/" or croak $!; mkdir "$basedir/$year/$project_id/grades/" or die $!;
} }
log DEBUG, "Generate list of students"; 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 # Create list of students to generate
my @logins; my @logins;
if ($args->{unamed}) if ($args->{unamed})
@ -72,22 +76,11 @@ sub grades_generate
} }
else else
{ {
opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!"; map {
for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh)) for my $member (@{ $_->{stds} }) {
{ push @logins, $member->{login};
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; log TRACE, @logins;
@ -110,18 +103,46 @@ sub grades_generate
log DEBUG, "Generating grades for $login"; log DEBUG, "Generating grades for $login";
for my $dir (@trace_dirs) for my $dir (@trace_dirs)
{ {
log DEBUG, "Generating grades from $dir"; log DEBUG, "Fetching identifiers from $dir";
if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml")
my $tr_file = "$year/$project_id/traces/$dir/$login.xml";
# Looking for a group traces?
if (! -f "$basedir/$tr_file")
{ {
open my $xmltrace, "<", "$basedir/$year/$project_id/traces/$dir/$login.xml" or croak "traces/$dir/$login.xml: $!"; 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)
{
$tr_file = "$year/$project_id/traces/$dir/".$chief->{login}.".xml";
log DEBUG, "Using group trace: chief is ".$chief->{login};
last;
}
}
}
if (-f "$basedir/$tr_file")
{
open my $xmltrace, "<", "$basedir/$tr_file" or die "$tr_file: $!";
binmode $xmltrace; binmode $xmltrace;
my $trace = Trace->new($xmltrace); my $trace = Trace->new(join '', <$xmltrace>);
close $xmltrace; close $xmltrace;
log DEBUG, "Fill from file: traces/$dir/$login.xml"; log DEBUG, "Fill from file: $tr_file";
log TRACE, $trace->getIds; log TRACE, $trace->getIds($login);
$grading->fill($trace->getIds); $grading->fill($trace->getIds($login));
} }
} }
@ -148,11 +169,12 @@ sub grades_new_bonus
croak "No project_id given" if (! $project_id); 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/") { if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or croak $!; mkdir "$basedir/$year/$project_id/traces/" or die $!;
} }
if (! -e "$basedir/$year/$project_id/traces/bonus/") { if (! -e "$basedir/$year/$project_id/traces/bonus/") {
mkdir "$basedir/$year/$project_id/traces/bonus/" or croak $!; mkdir "$basedir/$year/$project_id/traces/bonus/" or die $!;
} }
for my $kfile (keys %{ $args->{files} }) for my $kfile (keys %{ $args->{files} })
@ -192,9 +214,9 @@ sub grades_new_bonus
} }
if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") { if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") {
open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!; open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
binmode $xml; binmode $xml;
$trace = Trace->new($xml); $trace = Trace->new(join '', <$xml>);
close $xml; close $xml;
} }
elsif ($delete) { elsif ($delete) {
@ -216,12 +238,12 @@ sub grades_new_bonus
log DEBUG, "Updating $basedir/$year/$project_id/traces/bonus/$login.xml"; log DEBUG, "Updating $basedir/$year/$project_id/traces/bonus/$login.xml";
open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!; open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
print $xml $trace->toString(); print $xml $trace->toString();
close $xml; close $xml;
} }
else { else {
log WARN, "Invalid login $line, line skiped"; warn "Invalid login $line, line skiped";
} }
} }
} }
@ -251,19 +273,19 @@ sub update_defense
log INFO, "Update $year/$project_id/defenses/$defense_id.xml"; log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
if (! -e "$basedir/$year/$project_id/defenses/") { if (! -e "$basedir/$year/$project_id/defenses/") {
mkdir "$basedir/$year/$project_id/defenses/" or croak $!; mkdir "$basedir/$year/$project_id/defenses/" or die $!;
} }
if (! -e "$basedir/$year/$project_id/traces/") { if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or croak $!; mkdir "$basedir/$year/$project_id/traces/" or die $!;
} }
if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") { if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!; mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
my ($login, $pass, $uid, $gid) = getpwnam("www-data"); my ($login, $pass, $uid, $gid) = getpwnam("www-data");
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!; chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!; chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
} }
open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or croak $!; open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or die $!;
print $out $defense; print $out $defense;
close $out; close $out;
@ -322,11 +344,11 @@ sub update_trace
log INFO, "Update $year/$project_id/traces/$rendu_id/$login.xml"; log INFO, "Update $year/$project_id/traces/$rendu_id/$login.xml";
if (! -e "$basedir/$year/$project_id/traces/") { if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/" or croak $!; mkdir "$basedir/$year/$project_id/traces/" or die $!;
} }
if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") { if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") {
mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!; mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or die $!;
chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!; 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"); open my $out, ">", "$basedir/$year/$project_id/traces/$rendu_id/$login.xml" or croak("Unable to write to $rendu_id/$login.xml");

8
process/launch.sh
View file

@ -12,13 +12,17 @@ else
fi fi
PERL='/usr/bin/env perl' PERL='/usr/bin/env perl'
reset_agents()
{
echo "killall ssh-agent" | $SU intradmin
}
launch_screen() launch_screen()
{ {
CMD=$2 CMD=$2
if [ -n "$3" ] && [ -f "$3" ] if [ -n "$3" ] && [ -f "$3" ]
then then
TMP=`echo mktemp | $SU intradmin` TMP=`echo mktemp | $SU intradmin`
echo "killall ssh-agent" | $SU intradmin
echo "ssh-agent" | $SU intradmin > "$TMP" echo "ssh-agent" | $SU intradmin > "$TMP"
echo ". $TMP; ssh-add '$3'" | $SU intradmin echo ". $TMP; ssh-add '$3'" | $SU intradmin
CMD=". $TMP; ssh-add -l; echo; $CMD" CMD=". $TMP; ssh-add -l; echo; $CMD"
@ -80,10 +84,12 @@ then
case $HOSTNAME in case $HOSTNAME in
cpp) cpp)
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 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) 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_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 launch_screen "lerdorf_process_send_git" "while true; do $PERL ~/liblerdorf/process/files/send_git.pl; done" ~intradmin/.ssh/git
;; ;;

6
process/projects/gen_grading.pl
View file

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

27
process/projects/get_csv.pl
View file

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

120
utils/lpt
View file

@ -73,6 +73,7 @@ my %cmds_account =
"close" => \&cmd_account_close, "close" => \&cmd_account_close,
"cn" => \&cmd_account_cn, "cn" => \&cmd_account_cn,
"create" => \&cmd_account_create, "create" => \&cmd_account_create,
"delete" => \&cmd_account_delete,
"finger" => \&cmd_account_view, "finger" => \&cmd_account_view,
"mail" => \&cmd_account_mail, "mail" => \&cmd_account_mail,
"name" => \&cmd_account_cn, "name" => \&cmd_account_cn,
@ -259,11 +260,31 @@ sub cmd_account_create($@)
log(DEBUG, "Adding dn: uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr ..."); log(DEBUG, "Adding dn: uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr ...");
my $ldap = LDAP::ldap_connect(); my $ldap = LDAP::ldap_connect();
my $mesg = $ldap->add( "uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr",
# Check if the OU exists
my $oudn = "ou=$group,ou=users,dc=acu,dc=epita,dc=fr";
my $ou = LDAP::get_dn($ldap, $oudn);
if (! $ou)
{
my $mesg = $ldap->add( "$oudn",
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",
attrs => [ attrs => [
objectclass => [ "top", "epitaAccount" ], objectclass => [ "top", "epitaAccount" ],
uidNumber => shift, uidNumber => shift,
cn => shift(@_)." ".shift(@_), cn => ucfirst(shift(@_))." ".ucfirst(shift(@_)),
mail => "$login\@epita.fr", mail => "$login\@epita.fr",
uid => $login, uid => $login,
] ]
@ -271,10 +292,11 @@ sub cmd_account_create($@)
#$ldap->unbind or die ("couldn't disconnect correctly"); #$ldap->unbind or die ("couldn't disconnect correctly");
if ($mesg->code == 0) { if ($mesg->code == 0)
{
log(INFO, "Account added: $login"); log(INFO, "Account added: $login");
my $pass = shift; my $pass = shift;
return cmd_account($login, $pass) if ($pass ne "nopass"); return cmd_account($login, $pass, @_) if ($pass ne "nopass");
return 0; return 0;
} }
else { else {
@ -282,6 +304,28 @@ 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($@) sub cmd_account_grantintra($@)
{ {
my $login = shift; my $login = shift;
@ -300,27 +344,58 @@ sub cmd_account_grantintra($@)
sub cmd_account_grantlab($@) sub cmd_account_grantlab($@)
{ {
my $login = shift; my $login = shift;
my $group = shift; my $group = shift // "";
if ($group ne "acu" && $group ne "yaka") { if ($group ne "acu" && $group ne "yaka" && $group ne "ferry")
log(USAGE, "lpt account <login> grantlab <acu|yaka>"); {
log(USAGE, "lpt account <login> grant-lab <acu|yaka|ferry>");
return 1; return 1;
} }
my $ldap = LDAP::ldap_connect(); my $ldap = LDAP::ldap_connect();
my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login"); 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")) { if (!LDAP::get_attribute($ldap, $dn, "mail")) {
LDAP::add_attribute($ldap, $dn, "mail", "$login\@epita.fr"); LDAP::add_attribute($ldap, $dn, "mail", "$login\@epita.fr");
} }
LDAP::add_attribute($ldap, $dn, "mailAlias", "$login\@$group.epita.fr"); if ($group eq "acu" || $group eq "yaka")
LDAP::update_attribute($ldap, $dn, "mailAccountActive", "yes"); {
LDAP::add_attribute($ldap, $dn, "objectClass", "MailAccount"); if (! grep { $_ eq "MailAccount" } @{ $entry->get_value("objectClass") })
LDAP::add_attribute($ldap, $dn, "objectClass", "labAccount"); {
$entry->replace("mailAccountActive" => [ "yes" ]);
log(INFO, "$login now grants to receive e-mail and connect in laboratory."); 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");
$ldap->unbind or die ("couldn't disconnect correctly"); $ldap->unbind or die ("couldn't disconnect correctly");
} }
@ -1330,7 +1405,7 @@ sub cmd_account_quota_sync($;$)
my $quotaSgoinfreBlock = $entry->get_value("quotaSgoinfreBlock") // $def_quota{block}{sgoinfre}; my $quotaSgoinfreBlock = $entry->get_value("quotaSgoinfreBlock") // $def_quota{block}{sgoinfre};
my $quotaSgoinfreFile = $entry->get_value("quotaSgoinfreFile") // $def_quota{file}{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 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) { Quota::setqlim($dev_quota{sgoinfre}, $entry->get_value("uidNumber"), int(0.9 * $quotaSgoinfreBlock), $quotaSgoinfreBlock, int(0.9 * $quotaSgoinfreFile), $quotaSgoinfreFile, 1, 0) == 0) {
@ -1354,7 +1429,7 @@ sub cmd_account_quota_sync($;$)
sub cmd_sync_quota(@) sub cmd_sync_quota(@)
{ {
require "Quota"; require Quota;
# Set root quota # Set root quota
Quota::setqlim($dev_quota{home}, 0, 0, 0, 0, 0, 1, 0); Quota::setqlim($dev_quota{home}, 0, 0, 0, 0, 0, 1, 0);
@ -1437,7 +1512,7 @@ sub cmd_no_strong_auth_view(@)
sub cmd_no_strong_auth_warn(@) sub cmd_no_strong_auth_warn(@)
{ {
require "Email::Sender::Simple"; require Email::Sender::Simple;
for my $entry (get_no_strong_auth_user()) for my $entry (get_no_strong_auth_user())
{ {
@ -1478,7 +1553,7 @@ Les roots ACU";
sub cmd_no_strong_auth_close(@) sub cmd_no_strong_auth_close(@)
{ {
require "Email::Sender::Simple"; require Email::Sender::Simple;
for my $entry (get_no_strong_auth_user()) for my $entry (get_no_strong_auth_user())
{ {
@ -1631,7 +1706,7 @@ sub cmd_ssh_keys_without_passphrase_view(@)
# warn about unprotected keys # warn about unprotected keys
sub cmd_ssh_keys_without_passphrase_warn(@) sub cmd_ssh_keys_without_passphrase_warn(@)
{ {
require "Email::Sender::Simple"; require Email::Sender::Simple;
my $process = sub() { my $process = sub() {
my $entry = shift; my $entry = shift;
@ -1685,7 +1760,7 @@ Les roots ACU";
# remove unprotected keys # remove unprotected keys
sub cmd_ssh_keys_without_passphrase_remove(@) sub cmd_ssh_keys_without_passphrase_remove(@)
{ {
require "Email::Sender::Simple"; require Email::Sender::Simple;
my $process = sub() { my $process = sub() {
my $entry = shift; my $entry = shift;
@ -1855,10 +1930,12 @@ B<lpt account> <login> I<grant-intra>
Give rights to the user to access the intranet. Give rights to the user to access the intranet.
B<lpt account> <login> I<grant-lab> B<lpt account> <login> I<grant-lab> <acu | yaka | ferry>
Give rights to the user to access intern systems of the laboratory (SSH, Unix, ...) 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> B<lpt account> <login> I<grant-mail>
Give rights to the user to receive e-mails. Give rights to the user to receive e-mails.
@ -1871,6 +1948,11 @@ B<lpt account> <login> I<close>
This is used to close an existing account. 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] B<lpt account> <login> I<mail> [new-mail]
This is used to display, or change if [new-mail] is given, the account contact adress. This is used to display, or change if [new-mail] is given, the account contact adress.