Merge branch 'master' of ssh://cpp/liblerdorf
This commit is contained in:
commit
5a83714dad
16 changed files with 700 additions and 247 deletions
|
@ -111,7 +111,7 @@ sub insert ($$$)
|
|||
$self->{ids}{$_[0]} = $_[1];
|
||||
}
|
||||
|
||||
sub fill ($$)
|
||||
sub fill
|
||||
{
|
||||
my $self = shift;
|
||||
my $ids = shift;
|
||||
|
@ -340,13 +340,15 @@ 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 {
|
||||
eval
|
||||
{
|
||||
my $glob = Tinyglob::tinyglob($ref);
|
||||
if ($glob ne $ref)
|
||||
{
|
||||
|
|
71
ACU/Jail.pm
Normal file
71
ACU/Jail.pm
Normal 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;
|
|
@ -193,9 +193,9 @@ sub get_dn($$@)
|
|||
base => "$dn",
|
||||
filter => Net::LDAP::Filter->new("(objectClass=*)"),
|
||||
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; }
|
||||
|
||||
return $mesg->entry(0);
|
||||
|
@ -331,7 +331,7 @@ sub search_dn($$@)
|
|||
attrs => [ ],
|
||||
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 unique") if ($mesg->count > 1);
|
||||
|
||||
|
|
|
@ -67,7 +67,7 @@ sub log
|
|||
|
||||
if ($mail_error && $level <= ERROR)
|
||||
{
|
||||
require "Email::Sender::Simple";
|
||||
require Email::Sender::Simple;
|
||||
my $mail = Email::MIME->create(
|
||||
header_str => [
|
||||
From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>",
|
||||
|
|
|
@ -71,15 +71,18 @@ sub do_work ($$$@)
|
|||
return $err;
|
||||
}
|
||||
|
||||
my $ret;
|
||||
my $ret = "";
|
||||
eval {
|
||||
$ret = $subref->($given_args, $args);
|
||||
$SIG{'__WARN__'} = sub { log WARN, $_[0]; $ret .= ">>> ".$_[0 ]; };
|
||||
|
||||
$ret .= $subref->($given_args, $args);
|
||||
};
|
||||
if ($@) {
|
||||
my $err = $@;
|
||||
log ERROR, $err;
|
||||
return $err;
|
||||
$ret .= $err;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
|
484
ACU/Trace.pm
484
ACU/Trace.pm
|
@ -9,16 +9,13 @@ use Carp;
|
|||
use utf8;
|
||||
use open qw(:encoding(UTF-8) :std);
|
||||
use XML::LibXML;
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
ids => {},
|
||||
infos => {},
|
||||
comments => {},
|
||||
who => {},
|
||||
groups => [],
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
|
@ -33,10 +30,47 @@ sub _initialize ($$)
|
|||
{
|
||||
my $self = shift;
|
||||
|
||||
my $sax_handler = TraceHandler->new($self);
|
||||
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
|
||||
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;
|
||||
}
|
||||
|
||||
$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 ($)
|
||||
|
@ -63,113 +97,130 @@ sub getInfos ($)
|
|||
return $self->{infos};
|
||||
}
|
||||
|
||||
sub getComment ($$)
|
||||
sub addId
|
||||
{
|
||||
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;
|
||||
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 ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{who}{$_[0]};
|
||||
return $self->getWhos()->{$_[0]};
|
||||
}
|
||||
|
||||
sub getFirstWho ($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
return $self->{who}{def1_end_group};
|
||||
return $self->getWhos()->{def1_end_group};
|
||||
}
|
||||
|
||||
sub getWhos ($)
|
||||
sub getWhos
|
||||
{
|
||||
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;
|
||||
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");
|
||||
|
||||
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 );
|
||||
foreach my $group (@{ $self->{groups} })
|
||||
{
|
||||
$root->appendChild( $group->toString($doc) );
|
||||
}
|
||||
|
||||
$root->appendChild( $group );
|
||||
$doc->setDocumentElement( $root );
|
||||
|
||||
return $doc->toString();
|
||||
}
|
||||
|
||||
|
||||
package TraceHandler;
|
||||
package Trace::Group;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use constant NO_ID_VALUE => "__#";
|
||||
|
||||
sub new ($$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
groups => [],
|
||||
parsed => shift,
|
||||
inComment => "",
|
||||
inEval => "",
|
||||
inInfo => "",
|
||||
inValue => "",
|
||||
inWho => "",
|
||||
values => ""
|
||||
id => shift,
|
||||
name => shift,
|
||||
groups => []
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
|
@ -177,113 +228,240 @@ sub new ($$)
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub start_element
|
||||
sub append ($@)
|
||||
{
|
||||
my ($self, $element) = @_;
|
||||
my $self = shift;
|
||||
|
||||
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;
|
||||
}
|
||||
push @{ $self->{groups} }, @_;
|
||||
}
|
||||
|
||||
$self->{values} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "group")
|
||||
sub delId
|
||||
{
|
||||
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}) {
|
||||
$self->{values} .= $characters->{Data};
|
||||
}
|
||||
}
|
||||
|
||||
sub end_element
|
||||
{
|
||||
my ($self, $element) = @_;
|
||||
|
||||
if ($element->{Name} eq "value")
|
||||
my %ids;
|
||||
foreach my $group (@{ $self->{groups} })
|
||||
{
|
||||
if ($self->{values} =~ /([-+]?[0-9]+(.[0-9]+)?)/)
|
||||
my %tmp = $group->getIds($login);
|
||||
while (my ($key, $value) = each %tmp)
|
||||
{
|
||||
$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;
|
||||
}
|
||||
$ids{$key} = $value;
|
||||
}
|
||||
$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
|
||||
delete $self->{parsed}{ids}{ $self->{inEval} } if (!$self->{parsed}{ids}{ $self->{inEval} });
|
||||
$self->{inEval} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "comment")
|
||||
{
|
||||
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
|
||||
$self->{parsed}{comments}{ $self->{inComment} } = $1;
|
||||
my $value = 0;
|
||||
foreach my $group (@{ $self->{groups} })
|
||||
{
|
||||
$value += $group->getValue(undef, $login);
|
||||
}
|
||||
$self->{inComment} = "";
|
||||
return $value;
|
||||
}
|
||||
elsif ($element->{Name} eq "who")
|
||||
else
|
||||
{
|
||||
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
|
||||
$self->{parsed}{who}{ $self->{inWho} } = $1;
|
||||
my $value = 0;
|
||||
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])/) {
|
||||
$self->{parsed}{infos}{ $self->{inInfo} } = $1;
|
||||
my $whos = $group->getWhos();
|
||||
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} };
|
||||
# Remove empty identifier
|
||||
delete $self->{parsed}{ids}{ $key } if ($key && !$self->{parsed}{ids}{ $key });
|
||||
$gr->appendChild( $item->toString() );
|
||||
}
|
||||
|
||||
return $gr;
|
||||
}
|
||||
|
||||
|
||||
package Trace::Eval;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
use ACU::Log;
|
||||
|
||||
sub new ($$;$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
id => shift,
|
||||
type => shift // "test",
|
||||
values => {},
|
||||
logs => {},
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
if ($#_ >= 0) {
|
||||
$self->parseEval(@_);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub parseEval
|
||||
{
|
||||
my $self = shift;
|
||||
my $tree = shift;
|
||||
|
||||
foreach my $node ($tree->childNodes())
|
||||
{
|
||||
my $val = $node->textContent;
|
||||
chomp($val);
|
||||
|
||||
if ($node->nodeName eq "value")
|
||||
{
|
||||
$self->addValue($node->getAttribute("id"),
|
||||
$val);
|
||||
}
|
||||
elsif ($node->nodeName eq "name")
|
||||
{
|
||||
$self->{name} = $val;
|
||||
}
|
||||
elsif ($node->nodeName eq "status")
|
||||
{
|
||||
$self->{status} = $val;
|
||||
}
|
||||
elsif ($node->nodeName eq "log")
|
||||
{
|
||||
my $key = $node->getAttribute("type") // "stdout";
|
||||
|
||||
$self->{logs}{ $key } = $val;
|
||||
}
|
||||
elsif ($node->nodeName eq "who")
|
||||
{
|
||||
$self->{who} = {
|
||||
login => $val,
|
||||
type => $node->getAttribute("type") // "login"
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub 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;
|
||||
|
|
|
@ -27,7 +27,7 @@ sub init_conf(;$)
|
|||
{
|
||||
$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";
|
||||
|
||||
|
@ -48,6 +48,7 @@ sub save_conf(;$)
|
|||
log INFO, "Saving repositories configuration";
|
||||
|
||||
qx(git push);
|
||||
chdir("/");
|
||||
remove_tree($gitolite_directory);
|
||||
$gitolite_directory = undef;
|
||||
}
|
||||
|
@ -271,7 +272,7 @@ sub user_delete
|
|||
{
|
||||
if ($f =~ /^[0-9]/ && -d "$gitolite_directory/keydir/$f") {
|
||||
log INFO, "Removing $f directory";
|
||||
rmtree("$gitolite_directory/keydir/$f");
|
||||
remove_tree("$gitolite_directory/keydir/$f");
|
||||
}
|
||||
}
|
||||
else
|
||||
|
|
|
@ -1,12 +1,12 @@
|
|||
#! /bin/bash
|
||||
#! /usr/bin/env bash
|
||||
|
||||
cd $(dirname "$0")
|
||||
|
||||
WKS_LIST="apl"
|
||||
SRV_LIST="moore noyce hamano cpp"
|
||||
SCP_LIST="ksh"
|
||||
SRV_LIST="moore noyce hamano cpp otto"
|
||||
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`
|
||||
|
||||
|
@ -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" == "update" ]
|
||||
if [ "$ACTION" == "install" ] || [ "$ACTION" == "update" ]
|
||||
then
|
||||
SCP=0
|
||||
for D in $SCP_LIST
|
||||
|
@ -94,6 +94,11 @@ 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 ..
|
||||
|
|
40
hooks/dump-help.pl
Executable file
40
hooks/dump-help.pl
Executable 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;
|
|
@ -22,6 +22,8 @@ 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);
|
||||
|
||||
# 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; }
|
||||
|
@ -71,6 +73,12 @@ if ($ref =~ m<^refs/tags/(.+)$>)
|
|||
my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin});
|
||||
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
|
||||
$open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l");
|
||||
|
||||
|
|
|
@ -20,21 +20,26 @@ tex2md()
|
|||
bi=`basename "$i"`
|
||||
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/\\\{/__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"
|
||||
|
@ -48,7 +53,7 @@ tex2md()
|
|||
sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i"
|
||||
|
||||
# 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/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i"
|
||||
|
||||
|
@ -109,7 +114,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 *.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
|
||||
if [ -f "$f" ]
|
||||
then
|
||||
|
@ -120,6 +125,11 @@ clean_tex()
|
|||
fi
|
||||
done
|
||||
|
||||
for file in `find -name "*.ltx"`
|
||||
do
|
||||
git mv "$file" "${file%%.ltx}.tex"
|
||||
done
|
||||
|
||||
if [ -d "include" ]
|
||||
then
|
||||
cd include
|
||||
|
@ -130,6 +140,20 @@ clean_tex()
|
|||
git mv * ..
|
||||
fi
|
||||
|
||||
cd "$1"
|
||||
tex2md .
|
||||
maintex2md
|
||||
rmdir include 2> /dev/null
|
||||
elif [ -d "subdocs" ]
|
||||
then
|
||||
cd subdocs
|
||||
tex2md ..
|
||||
|
||||
if [ `find | wc -l` -gt 1 ]
|
||||
then
|
||||
git mv * ..
|
||||
fi
|
||||
|
||||
cd "$1"
|
||||
tex2md .
|
||||
maintex2md
|
||||
|
|
|
@ -8,6 +8,7 @@ use Pod::Usage;
|
|||
|
||||
use lib "../../";
|
||||
|
||||
use ACU::API::Projects;
|
||||
use ACU::Log;
|
||||
use ACU::LDAP;
|
||||
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/");
|
||||
|
||||
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);
|
||||
|
||||
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";
|
||||
|
||||
# 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})
|
||||
|
@ -72,22 +76,11 @@ sub grades_generate
|
|||
}
|
||||
else
|
||||
{
|
||||
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;
|
||||
}
|
||||
map {
|
||||
for my $member (@{ $_->{stds} }) {
|
||||
push @logins, $member->{login};
|
||||
}
|
||||
|
||||
closedir $dhm;
|
||||
}
|
||||
closedir $dh;
|
||||
} @{ $groups->{groups} };
|
||||
}
|
||||
|
||||
log TRACE, @logins;
|
||||
|
@ -110,18 +103,46 @@ sub grades_generate
|
|||
log DEBUG, "Generating grades for $login";
|
||||
for my $dir (@trace_dirs)
|
||||
{
|
||||
log DEBUG, "Generating grades from $dir";
|
||||
if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml")
|
||||
log DEBUG, "Fetching identifiers from $dir";
|
||||
|
||||
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;
|
||||
my $trace = Trace->new($xmltrace);
|
||||
my $trace = Trace->new(join '', <$xmltrace>);
|
||||
close $xmltrace;
|
||||
|
||||
log DEBUG, "Fill from file: traces/$dir/$login.xml";
|
||||
log TRACE, $trace->getIds;
|
||||
log DEBUG, "Fill from file: $tr_file";
|
||||
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);
|
||||
|
||||
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 croak $!;
|
||||
mkdir "$basedir/$year/$project_id/traces/" or die $!;
|
||||
}
|
||||
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} })
|
||||
|
@ -192,9 +214,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 croak $!;
|
||||
open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!;
|
||||
binmode $xml;
|
||||
$trace = Trace->new($xml);
|
||||
$trace = Trace->new(join '', <$xml>);
|
||||
close $xml;
|
||||
}
|
||||
elsif ($delete) {
|
||||
|
@ -216,12 +238,12 @@ sub grades_new_bonus
|
|||
|
||||
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();
|
||||
close $xml;
|
||||
}
|
||||
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";
|
||||
|
||||
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/") {
|
||||
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/") {
|
||||
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");
|
||||
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 $!;
|
||||
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
|
||||
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;
|
||||
close $out;
|
||||
|
||||
|
@ -322,11 +344,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 croak $!;
|
||||
mkdir "$basedir/$year/$project_id/traces/" or die $!;
|
||||
}
|
||||
if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") {
|
||||
mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!;
|
||||
chmod 0755, "$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 die $!;
|
||||
}
|
||||
|
||||
open my $out, ">", "$basedir/$year/$project_id/traces/$rendu_id/$login.xml" or croak("Unable to write to $rendu_id/$login.xml");
|
||||
|
|
|
@ -12,13 +12,17 @@ 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"
|
||||
|
@ -80,10 +84,12 @@ then
|
|||
case $HOSTNAME in
|
||||
|
||||
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
|
||||
;;
|
||||
|
||||
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
|
||||
;;
|
||||
|
|
|
@ -7,8 +7,6 @@ use Carp;
|
|||
use Pod::Usage;
|
||||
use Text::ParseWords;
|
||||
|
||||
use lib "../../";
|
||||
|
||||
use ACU::Defense;
|
||||
use ACU::Grading;
|
||||
use ACU::Log;
|
||||
|
@ -16,6 +14,8 @@ 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($xml);
|
||||
my $trace = Trace->new(join '', <$xml>);
|
||||
|
||||
my %tids = %{ $trace->getIds() };
|
||||
for my $kid (keys %tids)
|
||||
|
|
|
@ -12,6 +12,8 @@ use ACU::Log;
|
|||
use ACU::LDAP;
|
||||
use ACU::Process;
|
||||
|
||||
$ACU::Log::mail_error = 1;
|
||||
|
||||
our $basedir = "/intradata";
|
||||
|
||||
sub process
|
||||
|
@ -23,14 +25,11 @@ sub process
|
|||
my $year = shift @args // LDAP::get_year;
|
||||
|
||||
# Project existing?
|
||||
if (! -d "$basedir/$year/$project_id")
|
||||
{
|
||||
log ERROR, "Unable to find $project_id in $year";
|
||||
return "Unable to find $project_id in $year\n";
|
||||
}
|
||||
croak "Unable to find $project_id in $year" if (! -d "$basedir/$year/$project_id");
|
||||
|
||||
my %grades;
|
||||
my @headers;
|
||||
my @averages;
|
||||
|
||||
opendir(my $dh, "$basedir/$year/$project_id/grades/") or croak "can't opendir $basedir/$year/$project_id/grades/: $!";
|
||||
for my $gfile (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/grades/$_" } readdir($dh))
|
||||
|
@ -49,9 +48,10 @@ sub process
|
|||
my $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");
|
||||
$averages[$i] += $grade->getAttribute("value");
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
@ -60,6 +60,7 @@ sub process
|
|||
{
|
||||
push @headers, $grade->getAttribute("name");
|
||||
push @ugrades, $grade->getAttribute("value");
|
||||
push @averages, $grade->getAttribute("value");
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -70,12 +71,15 @@ sub process
|
|||
# Print CSV
|
||||
my $out = "login";
|
||||
|
||||
for my $header (@headers) {
|
||||
foreach my $header (@headers) {
|
||||
$out .= ",$header";
|
||||
}
|
||||
$out .= "\n";
|
||||
|
||||
for my $login (keys %grades) {
|
||||
my $nb = 0;
|
||||
foreach my $login (keys %grades)
|
||||
{
|
||||
$nb += 1;
|
||||
$out .= "$login";
|
||||
my @ugrades = @{ $grades{$login} };
|
||||
for my $header (@headers)
|
||||
|
@ -91,6 +95,13 @@ sub process
|
|||
$out .= "\n";
|
||||
}
|
||||
|
||||
$out .= "Average";
|
||||
foreach my $average (@averages)
|
||||
{
|
||||
$out .= ",".($average / $nb);
|
||||
}
|
||||
$out .= "\n";
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
|
|
120
utils/lpt
120
utils/lpt
|
@ -73,6 +73,7 @@ my %cmds_account =
|
|||
"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,
|
||||
|
@ -259,11 +260,31 @@ 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();
|
||||
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 => [
|
||||
objectclass => [ "top", "epitaAccount" ],
|
||||
uidNumber => shift,
|
||||
cn => shift(@_)." ".shift(@_),
|
||||
cn => ucfirst(shift(@_))." ".ucfirst(shift(@_)),
|
||||
mail => "$login\@epita.fr",
|
||||
uid => $login,
|
||||
]
|
||||
|
@ -271,10 +292,11 @@ 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;
|
||||
return cmd_account($login, $pass) if ($pass ne "nopass");
|
||||
return cmd_account($login, $pass, @_) if ($pass ne "nopass");
|
||||
return 0;
|
||||
}
|
||||
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($@)
|
||||
{
|
||||
my $login = shift;
|
||||
|
@ -300,27 +344,58 @@ sub cmd_account_grantintra($@)
|
|||
sub cmd_account_grantlab($@)
|
||||
{
|
||||
my $login = shift;
|
||||
my $group = shift;
|
||||
my $group = shift // "";
|
||||
|
||||
if ($group ne "acu" && $group ne "yaka") {
|
||||
log(USAGE, "lpt account <login> grantlab <acu|yaka>");
|
||||
if ($group ne "acu" && $group ne "yaka" && $group ne "ferry")
|
||||
{
|
||||
log(USAGE, "lpt account <login> grant-lab <acu|yaka|ferry>");
|
||||
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");
|
||||
}
|
||||
|
||||
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");
|
||||
if ($group eq "acu" || $group eq "yaka")
|
||||
{
|
||||
if (! grep { $_ eq "MailAccount" } @{ $entry->get_value("objectClass") })
|
||||
{
|
||||
$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");
|
||||
}
|
||||
|
@ -1330,7 +1405,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) {
|
||||
|
@ -1354,7 +1429,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);
|
||||
|
@ -1437,7 +1512,7 @@ sub cmd_no_strong_auth_view(@)
|
|||
|
||||
sub cmd_no_strong_auth_warn(@)
|
||||
{
|
||||
require "Email::Sender::Simple";
|
||||
require Email::Sender::Simple;
|
||||
|
||||
for my $entry (get_no_strong_auth_user())
|
||||
{
|
||||
|
@ -1478,7 +1553,7 @@ Les roots ACU";
|
|||
|
||||
sub cmd_no_strong_auth_close(@)
|
||||
{
|
||||
require "Email::Sender::Simple";
|
||||
require Email::Sender::Simple;
|
||||
|
||||
for my $entry (get_no_strong_auth_user())
|
||||
{
|
||||
|
@ -1631,7 +1706,7 @@ sub cmd_ssh_keys_without_passphrase_view(@)
|
|||
# warn about unprotected keys
|
||||
sub cmd_ssh_keys_without_passphrase_warn(@)
|
||||
{
|
||||
require "Email::Sender::Simple";
|
||||
require Email::Sender::Simple;
|
||||
|
||||
my $process = sub() {
|
||||
my $entry = shift;
|
||||
|
@ -1685,7 +1760,7 @@ Les roots ACU";
|
|||
# remove unprotected keys
|
||||
sub cmd_ssh_keys_without_passphrase_remove(@)
|
||||
{
|
||||
require "Email::Sender::Simple";
|
||||
require Email::Sender::Simple;
|
||||
|
||||
my $process = sub() {
|
||||
my $entry = shift;
|
||||
|
@ -1855,10 +1930,12 @@ B<lpt account> <login> I<grant-intra>
|
|||
|
||||
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, ...)
|
||||
|
||||
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.
|
||||
|
@ -1871,6 +1948,11 @@ 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.
|
||||
|
|
Reference in a new issue