diff --git a/ACU/API/Base.pm b/ACU/API/Base.pm index c00643c..72d860e 100644 --- a/ACU/API/Base.pm +++ b/ACU/API/Base.pm @@ -105,10 +105,8 @@ sub send($$$) log(DEBUG, 'POST Request to ', API_URL, $url); my $req = POST API_URL . $url, shift; - my $res = $ua->request($req); - log TRACE, $res; + my $cnt = $ua->request($req)->content; - my $cnt = $res->content(); log TRACE, $cnt; return parse($next, $cnt); @@ -249,7 +247,8 @@ sub new ($$) my $class = shift; my $self = { parsed => shift, - savValue => 0, + inStd => 0, + inResult => 0, lastGroup => {}, values => "" }; @@ -263,10 +262,14 @@ sub start_element { my ($self, $element) = @_; - if ($element->{Name} eq "student") - { + if ($element->{Name} eq "result") { + $self->{parsed}{result} = $self->{values}; + $self->{inResult} = 0; $self->{values} = ""; - $self->{savValue} = 1; + } + elsif ($element->{Name} eq "student") + { + $self->{inStd} = 1; push @{ $self->{lastGroup}{stds} }, { id => $element->{Attributes}{"{}id"}{Value}, chief => $element->{Attributes}{"{}chief"}{Value}, @@ -278,18 +281,13 @@ sub start_element $self->{lastGroup}{id} = $element->{Attributes}{"{}id"}{Value}; $self->{lastGroup}{stds} = []; } - elsif ($element->{Name} eq "result") - { - $self->{values} = ""; - $self->{savValue} = 1; - } } sub characters { my ($self, $characters) = @_; - if ($self->{savValue}) { + if ($self->{inStd}) { $self->{values} .= $characters->{Data}; } } @@ -298,16 +296,13 @@ sub end_element { my ($self, $element) = @_; - if ($element->{Name} eq "result") - { - $self->{parsed}{result} = $self->{values}; - $self->{savValue} = 0; - } - elsif ($element->{Name} eq "group") + if ($element->{Name} eq "group") { push @{ $self->{parsed}{groups} }, $self->{lastGroup}; $self->{lastGroup} = {}; - $self->{savValue} = 0; + + $self->{inStd} = 0; + $self->{values} = ""; } elsif ($element->{Name} eq "student") { diff --git a/ACU/API/Projects.pm b/ACU/API/Projects.pm index 473fcc4..abb0adf 100644 --- a/ACU/API/Projects.pm +++ b/ACU/API/Projects.pm @@ -16,7 +16,7 @@ sub add($$;$) my $flavor = shift; my $year = shift; - if ($year and $year ne LDAP::get_year) { + if ($year and $year != LDAP::get_year) { croak "Impossible d'ajouter un projet d'une autre année : non implémenté"; } @@ -90,9 +90,10 @@ sub get_groups($;$) my $res = API::Base::get('ProjectGroupHandler', $url); - if ($res->{result} ne '0') { - croak "Erreur durant la récupération : " . $res->{message}; - } + #TODO: uncomment-me + #if ($res->{result} ne '0') { +# croak "Erreur durant la récupération : " . $res->{message}; + #} return $res; } @@ -102,10 +103,7 @@ sub add_grades($;$) my %data = ( project_name => shift ); - my $y = shift; - if ($y) { - $data{year} = $y; - } + $data{year} = $_ if (shift); my $res = API::Base::send('ResultHandler', "projects/notes/add.xml", \%data); @@ -122,10 +120,7 @@ sub add_traces($$;$) project_name => shift, trace_name => shift, ); - my $y = shift; - if ($y) { - $data{year} = $y; - } + $data{year} = $_ if (shift); my $res = API::Base::send('ResultHandler', "projects/traces/add.xml", \%data); diff --git a/ACU/Defense.pm b/ACU/Defense.pm index b481a19..6150716 100644 --- a/ACU/Defense.pm +++ b/ACU/Defense.pm @@ -134,24 +134,23 @@ sub genIds ($;$) for my $group (@{ $self->{groups} }) { my $cur_gid; - if (! $group->{id} || grep { $_ == $group->{id} } @ids) + if (! $group->{id} || grep { /^\Q$group->{id}\E$/ } @ids) { do { - $cur_gid = "def_".$def_i."g".$grp_i; + $cur_gid = "def".$def_i."g".$grp_i; $grp_i += 1; } while (grep {$_ eq $cur_gid} @ids); $group->{id} = $cur_gid; } else { $grp_i += 1; - $cur_gid = $group->{id}; } my $qst_i = 0; for my $question (@{ $group->{questions_list} }) { my $cur_qid; - if (! $question->{id} || grep { $_ == $question->{id} } @ids) + if (! $question->{id} || grep { /^\Q$question->{id}\E$/ } @ids) { do { $cur_qid = $cur_gid."q".$qst_i; @@ -161,13 +160,12 @@ sub genIds ($;$) } else { $qst_i += 1; - $cur_qid = $question->{id}; } my $ans_i = 0; for my $answer (@{ $question->{answers} }) { - if (! $answer->{id} || grep { $_ == $answer->{id} } @ids) + if (! $answer->{id} || grep { /^\Q$answer->{id}\E$/ } @ids) { my $cur_aid; do { diff --git a/ACU/Grading.pm b/ACU/Grading.pm index 479258f..b01693c 100644 --- a/ACU/Grading.pm +++ b/ACU/Grading.pm @@ -7,6 +7,8 @@ use strict; use warnings; use XML::LibXML; +use ACU::Tinyglob; + sub new { my $class = shift; @@ -109,7 +111,7 @@ sub insert ($$$) $self->{ids}{$_[0]} = $_[1]; } -sub fill +sub fill ($$) { my $self = shift; my $ids = shift; @@ -286,7 +288,6 @@ package Point; use v5.10.1; use strict; use warnings; -use Text::Glob qw( glob_to_regex match_glob ); use Term::ANSIColor qw(:constants); use ACU::Log; @@ -339,23 +340,21 @@ sub compute ($$$;$$$) my $login = shift; my $ref = $self->{ref}; + if ($login && $ref) { + $ref =~ s/\$LOGIN/$login/; + } - # Handle $LOGIN in ref - $ref =~ s/\$LOGIN/$login/ if ($login && $ref); - - # Handle globbing in ref if (defined $ref) { - eval - { - if ($ref =~ /\?|\*/) + eval { + my $glob = Tinyglob::tinyglob($ref); + if ($glob ne $ref) { my $value = 0; - for my $r (grep { match_glob($ref, $_); } keys %$ids) { - $value += $ids->{ $r } if ($ref != $r); + for my $r (grep { /^$glob$/ } keys %$ids) { + $value += $ids->{ $r }; } - $ids->{ $ref } = $value if ($value); - log DEBUG, "New globbing identifier caculated $ref: $value"; + $ids->{ $ref } = $value; } }; if ($@) { diff --git a/ACU/LDAP.pm b/ACU/LDAP.pm index ac90bbf..5e7e229 100644 --- a/ACU/LDAP.pm +++ b/ACU/LDAP.pm @@ -189,16 +189,13 @@ sub get_dn($$@) my $ldap = shift // ldap_connect(); my $dn = shift; - my $base = BASE_DN; - $dn = "$dn," . BASE_DN if ($dn !~ /$base$/); - my $mesg = $ldap->search( # search base => "$dn", filter => Net::LDAP::Filter->new("(objectClass=*)"), attrs => \@_, - scope => "base" + scope => "sub" ); - return undef if ($mesg->code != 0); + if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; } if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; } return $mesg->entry(0); @@ -334,7 +331,7 @@ sub search_dn($$@) attrs => [ ], scope => "sub" ); - return undef if ($mesg->code != 0); + croak($mesg->error) if ($mesg->code != 0); croak("$filter not found") if ($mesg->count == 0); croak("$filter not unique") if ($mesg->count > 1); diff --git a/ACU/Log.pm b/ACU/Log.pm index bf3f165..8c67f22 100644 --- a/ACU/Log.pm +++ b/ACU/Log.pm @@ -4,11 +4,8 @@ use v5.10.1; use strict; use warnings; use Carp; -use utf8; -use open IO => ':utf8'; -use open ':std'; - use Data::Dumper; +use Email::MIME; use Exporter 'import'; use POSIX qw(strftime); use Term::ANSIColor qw(:constants); @@ -52,17 +49,12 @@ sub log if (!$log_fd && $log_file) { open ($log_fd, ">>", $log_file) or croak("Unable to open log ($log_file) file for writing"); - - # Enable autoflush for the log file - my $previous_default = select($log_fd); - $|++; - select($previous_default); - say $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " START new logging session "; } if ($level <= $save_level and $log_fd) { + local $| = 1; print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " "; if ($level == TRACE) { @@ -75,20 +67,13 @@ sub log if ($mail_error && $level <= ERROR) { - require Email::MIME; - require Email::Sender::Simple; - Email::Sender::Simple->import(qw(sendmail)); + require "Email::Sender::Simple"; my $mail = Email::MIME->create( header_str => [ From => "Roots assistants ", To => "Roots assistants ", Subject => "[LERDORF][ERROR] ".join(' ', @_) ], - attributes => { - encoding => 'quoted-printable', - charset => 'utf-8', - format => 'flowed', - }, body_str => "Bonjour, Une erreur de niveau $level est survenue sur la machine $HOSTNAME. @@ -104,20 +89,15 @@ Cordialement, -- The lerdorf project", ); - sendmail($mail); + Email::Sender::Simple::sendmail($mail); } - if ($level <= $display_level) - { - $|++; # Autoflush STDOUT - + if ($level <= $display_level) { if ($level == PENDING) { print STDERR (leveldisp($level), @_, RESET, "\r"); } else { say STDERR (leveldisp($level), @_, RESET); } - - $|--; # Disable autoflush } if ($fatal_warn && $level <= WARN){ diff --git a/ACU/Process.pm b/ACU/Process.pm index 405365f..1c94d27 100644 --- a/ACU/Process.pm +++ b/ACU/Process.pm @@ -22,18 +22,6 @@ our $nb_cpus = 0; $nb_cpus = grep {/^processor\s/} <$cpuinfo>; close $cpuinfo; -our @servers = ("gearmand-srv:4730"); - -sub add_server -{ - push @servers, @_; -} - -sub set_servers -{ - @servers = @_; -} - sub check_load ($) { my $priority = shift; @@ -83,18 +71,15 @@ sub do_work ($$$@) return $err; } - my $ret = ""; + my $ret; eval { - $SIG{'__WARN__'} = sub { log WARN, $_[0]; $ret .= ">>> ".$_[0 ]; }; - - $ret .= $subref->($given_args, $args); + $ret = $subref->($given_args, $args); }; if ($@) { my $err = $@; log ERROR, $err; - $ret .= $err; + return $err; } - return $ret; } @@ -106,9 +91,7 @@ sub register_no_parse ($$;$) my $worker = Gearman::Worker->new; - log INFO, "Registering function $funcname on ", join(", ", @servers); - - $worker->job_servers( @servers ); + $worker->job_servers('gearmand:4730'); $worker->register_function($funcname => sub { my $ret; @@ -141,9 +124,7 @@ sub register ($$;$$) my $worker = Gearman::Worker->new; - log INFO, "Registering function $funcname on ", join(", ", @servers); - - $worker->job_servers( @servers ); + $worker->job_servers('gearmand:4730'); $worker->register_function($funcname => sub { return do_work($subref, $given_arg, $priority, @_); }); # Disable exit on warning or error @@ -212,7 +193,7 @@ sub launch ($$;$$) my $funcname = shift; my $client = Gearman::Client->new; - $client->job_servers( @servers ); + $client->job_servers('gearmand:4730'); log DEBUG, "Launching $funcname..."; @@ -235,7 +216,7 @@ sub paralaunch ($$;$) my $xml = build_task_xml(shift, shift); my $client = Gearman::Client->new; - $client->job_servers( @servers ); + $client->job_servers('gearmand:4730'); my $taskset = $client->new_task_set; for my $task (@{ $funcsname }) diff --git a/ACU/Tinyglob.pm b/ACU/Tinyglob.pm new file mode 100644 index 0000000..8db5379 --- /dev/null +++ b/ACU/Tinyglob.pm @@ -0,0 +1,67 @@ +#! /usr/bin/env perl + +package Tinyglob; + +use v5.10.1; +use strict; +use warnings; +use Carp; +use Exporter 'import'; + +our @EXPORT = qw(tinyglob); + +sub tinyglob +{ + my $orig = shift; + my @str = split("", quotemeta($orig)); + my $res = ""; + + my $metaescape = 0; + + for (my $i = 0; $i <= $#str; $i++) + { + if ($str[$i] eq '\\') + { + $i += 1; + if ($str[$i] eq '\\') + { + $metaescape = ! $metaescape; + $res .= $str[$i]; + } + elsif ($metaescape && ($str[$i] eq '*' || $str[$i] eq '?')) { + $res .= $str[$i]; + $metaescape = 0; + } + elsif ($str[$i] eq '?') { + $res .= '.'; + } + elsif ($str[$i] eq '*') { + $res .= '.*'; + } + elsif ($metaescape) { + $res .= $str[$i]; + $metaescape = 0; + } + else { + $res .= "\\".$str[$i]; + } + } + else { + $res .= $str[$i]; + } + } + + return $res; +} + +sub match +{ + my $glob = tinyglob(shift); + my $str = shift; + + say $glob; + + return $str =~ /$glob/; +} + +1; diff --git a/ACU/Trace.pm b/ACU/Trace.pm index 8abed90..fba6621 100644 --- a/ACU/Trace.pm +++ b/ACU/Trace.pm @@ -9,15 +9,16 @@ use Carp; use utf8; use open qw(:encoding(UTF-8) :std); use XML::LibXML; - -use ACU::Log; +use XML::SAX::ParserFactory; sub new { my $class = shift; my $self = { + ids => {}, infos => {}, - groups => [], + comments => {}, + who => {}, }; bless $self, $class; @@ -32,47 +33,10 @@ sub _initialize ($$) { my $self = shift; - my $dom = XML::LibXML->load_xml(string => shift); - $self->{groups} = $self->parseTrace($dom->documentElement()); - $self->{type} = $dom->documentElement()->getAttribute("type") // "mill"; - $self->{version} = $dom->documentElement()->getAttribute("version") // 1; -} + my $sax_handler = TraceHandler->new($self); + my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler ); -sub parseTrace($$) -{ - my $self = shift; - my $tree = shift; - my $ret = []; - - foreach my $node ($tree->childNodes()) - { - if ($node->nodeName eq "info") - { - my $tmp = $node->textContent; - chomp($tmp); - $self->{infos}{ $node->getAttribute("name") } = $tmp; - } - elsif ($node->nodeName eq "group") - { - my $g = Trace::Group->new( - $node->getAttribute("id"), - $node->getAttribute("name") - ); - $g->append(@{ $self->parseTrace($node) }); - push @$ret, $g; - } - elsif ($node->nodeName eq "eval") - { - my $e = Trace::Eval->new( - $node->getAttribute("id"), - $node->getAttribute("type"), - $node - ); - push @$ret, $e; - } - } - - return $ret; + $parser->parse_file(shift); } sub getVersion ($) @@ -99,148 +63,113 @@ sub getInfos ($) return $self->{infos}; } -sub addId +sub getComment ($$) { my $self = shift; - my $key = shift; - my $value = shift; - - my $e = Trace::Eval->new($key); - $e->addValue(undef, $value); - push @{ $self->{groups} }, $e; - - return $e; + return $self->{comments}{$_[0]}; } -sub delId +sub getComments ($) { my $self = shift; - my $key = shift; - my $value = shift; - - foreach my $group (@{ $self->{groups} }) - { - if ($group->{id} eq $key) - { - if (!$value || $value == $group->getValue()) - { - $self->{groups} = [ grep { $_->{id} ne $key } @{ $self->{groups} } ]; - } - last; - } - - $group->delId($key, $value); - } -} - -sub getIds -{ - my $self = shift; - my $login = shift; - my $onlyNonZero = shift // 0; - - my %ids; - foreach my $group (@{ $self->{groups} }) - { - my %tmp; - if ($self->{type} eq "defense") - { - # For a defense, we consider that this is a group grade, so don't consider login filtering - %tmp = $group->getIds(); - } else { - %tmp = $group->getIds($login); - } - - while (my ($key, $value) = each %tmp) - { - $ids{$key} = $value if !$onlyNonZero || $value; - } - } - return \%ids; -} - -sub getNonZeroIds -{ - return getIds($_[0], $_[1], 1); -} - -sub getValue -{ - my $self = shift; - my $id = shift; - my $login = shift; - - my $value = 0; - foreach my $group (@{ $self->{groups} }) - { - $value += $group->getValue($id, $login); - } - return $value; + return $self->{comments}; } sub getWho ($$) { my $self = shift; - return $self->getWhos()->{$_[0]}; + return $self->{who}{$_[0]}; } sub getFirstWho ($) { my $self = shift; - return $self->getWhos()->{def1_end_group}; + + return $self->{who}{def1_end_group}; } -sub getWhos +sub getWhos ($) { my $self = shift; - my $ret = {}; - - foreach my $group (@{ $self->{groups} }) - { - my $whos = $group->getWhos(); - foreach my $who (keys %{ $whos }) { - $ret->{ $who } = $whos->{$who}; - } - } - - return $ret; + return $self->{who}; } -sub toString ($) +sub getValue ($$) { my $self = shift; + return $self->{ids}{$_[0]}; +} + +sub getIds ($) +{ + my $self = shift; + return $self->{ids}; +} + +sub addId($$;$) +{ + my $self = shift; + my $key = shift; + my $value = shift // 1; + + $self->{ids}{$key} = $value; +} + +sub delId($$) +{ + my $self = shift; + my $key = shift; + + delete $self->{ids}{$key}; +} + +sub toString ($;$) +{ + my $self = shift; + my $main_grp = shift // "bonus_malus"; my $doc = XML::LibXML::Document->new('1.0'); my $root = $doc->createElement("trace"); - foreach my $group (@{ $self->{groups} }) - { - $root->appendChild( $group->toString($doc) ); + my $group = $doc->createElement("group"); + $group->addChild( $doc->createAttribute("id", $main_grp) ); + + for my $k (keys %{ $self->{ids} }) { + my $e = $doc->createElement("eval"); + my $v = $doc->createElement("value"); + + $e->addChild( $doc->createAttribute("id", $k) ); + $v->appendText( $self->{ids}{$k} ); + + $e->appendChild( $v ); + $group->appendChild( $e ); } + $root->appendChild( $group ); $doc->setDocumentElement( $root ); return $doc->toString(); } -package Trace::Group; +package TraceHandler; -use v5.10.1; -use strict; -use warnings; use Carp; - -use ACU::Log; +use constant NO_ID_VALUE => "__#"; sub new ($$) { my $class = shift; my $self = { - id => shift, - name => shift, - groups => [] + groups => [], + parsed => shift, + inComment => "", + inEval => "", + inInfo => "", + inValue => "", + inWho => "", + values => "" }; bless $self, $class; @@ -248,273 +177,113 @@ sub new ($$) return $self; } -sub append ($@) +sub start_element { - my $self = shift; + my ($self, $element) = @_; - push @{ $self->{groups} }, @_; + if ($element->{Name} eq "trace") { + $self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value}; + $self->{parsed}{type} = $element->{Attributes}{"{}type"}{Value}; + } + elsif ($element->{Name} eq "info") { + $self->{inInfo} = $element->{Attributes}{"{}name"}{Value}; + $self->{parsed}{infos}{ $self->{inInfo} } = 0; + $self->{values} = ""; + } + elsif ($element->{Name} eq "eval") { + my $tmp = $element->{Attributes}{"{}id"}{Value}; + if ($tmp) { + $self->{inEval} = $tmp; + $self->{parsed}{ids}{ $self->{inEval} } = 0; + } + } + elsif ($element->{Name} eq "comment" && $self->{inEval}) { + $self->{inComment} = $self->{inEval}; + $self->{values} = ""; + } + elsif ($element->{Name} eq "who" && $self->{inEval}) { + $self->{inWho} = $self->{inEval}; + $self->{values} = ""; + } + elsif ($element->{Name} eq "value") { + if ($element->{Attributes}{"{}id"}{Value}) { + $self->{inValue} = $element->{Attributes}{"{}id"}{Value}; + } else { + $self->{inValue} = NO_ID_VALUE; + } + + $self->{values} = ""; + } + elsif ($element->{Name} eq "group") + { + push @{ $self->{groups} }, ($element->{Attributes}{"{}id"}{Value} // ""); + } + elsif ($element->{Name} ne "name" && $element->{Name} ne "statut" && $element->{Name} ne "status" && $element->{Name} ne "log") { + croak "Not a valid trace XML: unknown tag ".$element->{Name}; + } } -sub delId +sub characters { - my $self = shift; - my $key = shift; - my $value = shift; + my ($self, $characters) = @_; - foreach my $group (@{ $self->{groups} }) + if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) { + $self->{values} .= $characters->{Data}; + } +} + +sub end_element +{ + my ($self, $element) = @_; + + if ($element->{Name} eq "value") { - if ($group->{id} eq $key) + if ($self->{values} =~ /([-+]?[0-9]+(.[0-9]+)?)/) { - if (!$value || $value == $group->getValue()) - { - $self->{groups} = \{ grep { $_->{id} ne $key } @{ $self->{groups} } }; + $self->{parsed}{ids}{ $self->{inEval} } += $1; + if ($self->{inValue} ne NO_ID_VALUE and $1) { + $self->{parsed}{ids}{ $self->{inValue} } = $1; + } + if ($self->{groups}) { + my $key = @{ $self->{groups} }[$#{ $self->{groups} }]; + $self->{parsed}{ids}{ $key } += $1; } - last; } - - $group->delId($key, $value); + $self->{inValue} = ""; } -} - -sub getIds -{ - my $self = shift; - my $login = shift; - - my %ids; - foreach my $group (@{ $self->{groups} }) + elsif ($element->{Name} eq "eval") { - my %tmp = $group->getIds($login); - while (my ($key, $value) = each %tmp) - { - $ids{$key} = $value; - } + # Remove empty identifier + delete $self->{parsed}{ids}{ $self->{inEval} } if (!$self->{parsed}{ids}{ $self->{inEval} }); + $self->{inEval} = ""; } - - $ids{ $self->{id} } = $self->getValue($self->{id}, $login); - - return %ids; -} - -sub getValue -{ - my $self = shift; - my $id = shift // $self->{id}; - my $login = shift; - - if ($id eq $self->{id}) + elsif ($element->{Name} eq "comment") { - my $value = 0; - foreach my $group (@{ $self->{groups} }) - { - $value += $group->getValue(undef, $login); + if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { + $self->{parsed}{comments}{ $self->{inComment} } = $1; } - return $value; + $self->{inComment} = ""; } - else + elsif ($element->{Name} eq "who") { - my $value = 0; - foreach my $group (@{ $self->{groups} }) - { - $value += $group->getValue($id, $login); + if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { + $self->{parsed}{who}{ $self->{inWho} } = $1; } - return $value; + $self->{inComment} = ""; } -} - -sub getWhos -{ - my $self = shift; - my $ret = {}; - - foreach my $group (@{ $self->{groups} }) + elsif ($element->{Name} eq "info") { - my $whos = $group->getWhos(); - foreach my $who (keys %{ $whos }) { - $ret->{ $who } = $whos->{$who}; + if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { + $self->{parsed}{infos}{ $self->{inInfo} } = $1; } + $self->{inInfo} = ""; } - - return $ret; -} - -sub toString($$) -{ - my $self = shift; - my $doc = shift; - - my $gr = $doc->createElement("group"); - - foreach my $item (@{ $self->{groups} }) + elsif ($element->{Name} eq "group") { - $gr->appendChild( $item->toString() ); + my $key = pop @{ $self->{groups} }; + # Remove empty identifier + delete $self->{parsed}{ids}{ $key } if ($key && !$self->{parsed}{ids}{ $key }); } - - return $gr; -} - - -package Trace::Eval; - -use v5.10.1; -use strict; -use warnings; -use Carp; - -use ACU::Log; - -sub new ($$;$) -{ - my $class = shift; - my $self = { - id => shift // "", - type => shift // "test", - values => {}, - logs => {}, - }; - - bless $self, $class; - if ($#_ >= 0) { - $self->parseEval(@_); - } - - return $self; -} - -sub parseEval -{ - my $self = shift; - my $tree = shift; - - foreach my $node ($tree->childNodes()) - { - my $val = $node->textContent; - chomp($val); - - if ($node->nodeName eq "value") - { - $self->addValue($node->getAttribute("id"), - $val); - } - elsif ($node->nodeName eq "name") - { - $self->{name} = $val; - } - elsif ($node->nodeName eq "status") - { - $self->{status} = $val; - } - elsif ($node->nodeName eq "log") - { - my $key = $node->getAttribute("type") // "stdout"; - - $self->{logs}{ $key } = $val; - } - elsif ($node->nodeName eq "who") - { - $self->{who} = { - login => $val, - type => $node->getAttribute("type") // "login" - }; - } - } -} - -sub delId -{ - # Do nothing here, just an abstract method -} - -sub changeWho -{ - my $self = shift; - - $self->{who} = { - login => shift, - type => shift // "login" - }; -} - -sub getIds -{ - my $self = shift; - my $login = shift; - - my %ids; - if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login) - { - while (my ($key, $value) = each %{ $self->{values} }) - { - $ids{$key} = $value if ($key); - } - - $ids{ $self->{id} } = $self->getValue($self->{id}, $login); - } - - return %ids; -} - -sub addValue -{ - my $self = shift; - my $key = shift // ""; - my $val = shift; - - $self->{values}{ $key } = 0 if (!exists $self->{values}{ $key }); - $self->{values}{ $key } += $val; -} - -sub getValue -{ - my $self = shift; - my $id = shift // $self->{id}; - my $login = shift; - - my $value = 0; - if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login) - { - foreach my $key (keys %{ $self->{values} }) - { - $value += $self->{values}{$key} if ($id eq $self->{id} || !$key || $key eq $id); - } - } - return $value; -} - -sub getWhos -{ - my $self = shift; - - return { $self->{id} => $self->{who} }; -} - -sub toString($$) -{ - my $self = shift; - my $doc = shift; - - my $e = $doc->createElement("eval"); - - $e->setAttribute("id", $self->{id}); - $e->setAttribute("type", $self->{type}); - - if (defined $self->{who}) - { - my $w = $doc->createElement("who"); - $w->setAttribute("type", $self->{who}{type}) if (defined $self->{who}{type}); - $w->appendTextNode( $self->{who}{login} ); - $e->appendChild( $w ); - } - - for my $k (keys %{ $self->{values} }) - { - my $v = $doc->createElement("value"); - $v->setAttribute("id", $k) if ($k); - $v->appendTextNode( $self->{values}{$k} ); - $e->appendChild( $v ); - } - - return $e; } 1; diff --git a/ACU/VCS/Git.pm b/ACU/VCS/Git.pm index a9ad31c..169b028 100644 --- a/ACU/VCS/Git.pm +++ b/ACU/VCS/Git.pm @@ -27,7 +27,7 @@ sub init_conf(;$) { $git_server = $_ if (shift); - $gitolite_directory = mktemp("/tmp/git_manage_XXXX"); + $gitolite_directory = mktemp("/tmp/git_manage_XXXX") unless(-d $gitolite_directory); log INFO, "Cloning $git_user\@$git_server:$git_adminrepo to $gitolite_directory"; @@ -48,7 +48,6 @@ sub save_conf(;$) log INFO, "Saving repositories configuration"; qx(git push); - chdir("/"); remove_tree($gitolite_directory); $gitolite_directory = undef; } @@ -272,7 +271,7 @@ sub user_delete { if ($f =~ /^[0-9]/ && -d "$gitolite_directory/keydir/$f") { log INFO, "Removing $f directory"; - remove_tree("$gitolite_directory/keydir/$f"); + rmtree("$gitolite_directory/keydir/$f"); } } else diff --git a/ACU/t/tinyglob.t b/ACU/t/tinyglob.t new file mode 100644 index 0000000..35f6f7b --- /dev/null +++ b/ACU/t/tinyglob.t @@ -0,0 +1,55 @@ +use v5.10.1; +use strict; +use warnings; + +use Test::More; + +use lib "../"; + +BEGIN { + diag("Testing Tinyglob on perl $]"); + use_ok('ACU::Tinyglob'); +} + +use ACU::Tinyglob; + +is(Tinyglob::tinyglob("test"), "test"); +is(Tinyglob::tinyglob("\\*"), "\\*"); +is(Tinyglob::tinyglob("\\\\*"), "\\\\.*"); +is(Tinyglob::tinyglob("\\?"), "\\?"); +is(Tinyglob::tinyglob("\\\\?"), "\\\\."); +is(Tinyglob::tinyglob("\\."), "\\."); +is(Tinyglob::tinyglob("\\\\."), "\\\\\\."); +is(Tinyglob::tinyglob("a*b?"), "a.*b."); + +ok(! Tinyglob::match("?", "")); +ok(! Tinyglob::match("b", "a")); +ok(! Tinyglob::match("b*", "a")); +ok(! Tinyglob::match("b?", "a")); +ok(Tinyglob::match("*", "")); + +ok(Tinyglob::match("a", "a")); +ok(Tinyglob::match("?", "a")); +ok(Tinyglob::match("*", "a")); + +ok(Tinyglob::match("ab", "ab")); +ok(Tinyglob::match("?b", "ab")); +ok(Tinyglob::match("*b", "ab")); +ok(Tinyglob::match("*", "ab")); + +ok(Tinyglob::match("b?", "ba")); +ok(Tinyglob::match("b*", "ba")); +ok(Tinyglob::match("*", "abcdef")); + +ok(Tinyglob::match("a?b", "acb")); +ok(Tinyglob::match("a*b", "acb")); +ok(Tinyglob::match("a*b", "acdefb")); + +ok(Tinyglob::match("a*b*", "acdefblkjgd")); +ok(! Tinyglob::match("a?b*", "acdefblkjgd")); +ok(Tinyglob::match("a?b*", "acblkjgd")); +ok(Tinyglob::match("a?b*", "abblkjgd")); +ok(! Tinyglob::match("a*b?", "abblkjgd")); +ok(Tinyglob::match("a*b?", "aasdasbd")); + +done_testing(); diff --git a/Makefile b/Makefile index 15244d4..12886aa 100644 --- a/Makefile +++ b/Makefile @@ -1,13 +1,10 @@ COPY?=cp -v -CURL?=curl DEST?=/usr/local/share/perl/`ls -1 /usr/local/share/perl/ | grep "^5." | tail -1`/ GIT?=/usr/bin/git GITOLITE_DEST?=/usr/share/gitolite/hooks/common MAKEDIR?=mkdir -PERL?=/usr/bin/env perl PROVER?=prove -f RM?=rm -RMTREE?=rm -r TESTDIR?=t SHELL?=/bin/sh @@ -20,20 +17,10 @@ install: $(COPY) -r ACU/ $(DEST) ! test -d $(GITOLITE_DEST) || $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d ! test -d $(GITOLITE_DEST) || $(COPY) hooks/gl-pre-git $(GITOLITE_DEST)/ - ! test -d $(GITOLITE_DEST) || $(COPY) hooks/post-update $(GITOLITE_DEST)/ ! test -d $(GITOLITE_DEST) || $(COPY) hooks/subjects.pl $(GITOLITE_DEST)/update.secondary.d/ ! test -d $(GITOLITE_DEST) || $(COPY) hooks/conferences.pl $(GITOLITE_DEST)/update.secondary.d/ ! test -d $(GITOLITE_DEST) || $(COPY) hooks/submissions.pl $(GITOLITE_DEST)/update.secondary.d/ -guantanamo.tar.gz: - $(MAKEDIR) -p guantanamo/ACU - $(COPY) process/exec/guantanamo_node.pl guantanamo/ - $(COPY) ACU/Log.pm ACU/Process.pm process/exec/guantanamo_node.pl guantanamo/ACU/ - $(COPY) process/exec/run.sh.not-here guantanamo/run.sh - chmod +x guantanamo/run.sh - tar czf guantanamo.tar.gz guantanamo/ - $(RMTREE) guantanamo - update: $(GIT) pull $(SHELL) commands/first-install.sh @@ -46,16 +33,6 @@ unstall: ! test -d $(GITOLITE_DEST) || $(RM) -rf $(GITOLITE_DEST)/update.secondary.d ! test -d $(GITOLITE_DEST) || $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d -regen-objects: - $(MAKEDIR) -p ACU/dtd - $(CURL) -o ACU/dtd/defense.dtd http://acu.epita.fr/dtd/defense.dtd - $(CURL) -o ACU/dtd/grading.dtd http://acu.epita.fr/dtd/grading.dtd - $(CURL) -o ACU/dtd/groups.dtd http://acu.epita.fr/dtd/groups.dtd - $(CURL) -o ACU/dtd/project.dtd http://acu.epita.fr/dtd/project.dtd - $(CURL) -o ACU/dtd/traces.dtd http://acu.epita.fr/dtd/traces.dtd - $(PERL) -I baldr baldr/Baldr.pl --import="ACU/Objects/basecode/*.pm" --path=ACU/Objects ACU/dtd/defense.dtd ACU/dtd/grading.dtd ACU/dtd/groups.dtd ACU/dtd/project.dtd ACU/dtd/traces.dtd - $(RMTREE) ACU/dtd - test: $(PROVER) $(TESTDIR) diff --git a/commands/first-install.sh b/commands/first-install.sh index 893ef6b..aefede4 100755 --- a/commands/first-install.sh +++ b/commands/first-install.sh @@ -1,10 +1,10 @@ #! /bin/bash # Install missing packages -DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl libemail-sender-perl libtext-glob-perl" -ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin aur/perl-text-glob -GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/XML-LibXML dev-perl/IO-Socket-SSL dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP dev-perl/Email-Sender dev-perl/Text-Glob" -FBSD_PACKAGES_LIST="screen p5-XML-LibXML p5-Gearman p5-IO-Socket-SSL p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin p5-Text-Glob" +DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libmail-sendmail-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl" +ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-simple perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin +GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-Simple dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP" +FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-Simple p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin" KERNEL=`uname -s` diff --git a/commands/guantanamo_list.sh b/commands/guantanamo_list.sh deleted file mode 100755 index a23aac1..0000000 --- a/commands/guantanamo_list.sh +++ /dev/null @@ -1,14 +0,0 @@ -#!/bin/sh - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -cat < - - list - -EOF diff --git a/commands/manage-server.sh b/commands/manage-server.sh index 9bb03f2..e1ea557 100755 --- a/commands/manage-server.sh +++ b/commands/manage-server.sh @@ -6,7 +6,7 @@ WKS_LIST="apl" SRV_LIST="moore noyce hamano cpp otto" SCP_LIST="ksh knuth" -KNOWN_ACTIONS="start stop restart install update log viewlog view_log" +KNOWN_ACTIONS="start stop restart update log viewlog view_log" LOG=`mktemp` @@ -80,7 +80,7 @@ do for DEST in $DESTS do echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m" - if [ "$ACTION" == "install" ] || [ "$ACTION" == "update" ] + if [ "$ACTION" == "update" ] then SCP=0 for D in $SCP_LIST @@ -94,11 +94,6 @@ do if [ $SCP -eq 0 ] then - if [ "$ACTION" == "install" ] && - ! ssh root@$DEST "mkdir -p /home/intradmin/ && git clone '$(echo `git remote -v` | cut -d " " -f 2)' /home/intradmin/liblerdorf && ln -s /home/intradmin/liblerdorf ~/liblerdorf" - then - exit 1 - fi ssh root@$DEST "make -C liblerdorf update upgrade" else cd .. diff --git a/commands/moulette/launch.sh b/commands/moulette/launch.sh deleted file mode 100755 index f77e141..0000000 --- a/commands/moulette/launch.sh +++ /dev/null @@ -1,45 +0,0 @@ -#!/bin/sh - -if [ -z "$2" ] -then - echo "Usage: $0 [year] [login ...]" - exit 1 -fi - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -if [ "x${1:0:2}" = "x20" ] -then - YEAR="$1" - shift -else - YEAR=`ldapsearch -x -b "cn=year,dc=acu,dc=epita,dc=fr" | grep "^year" | cut -d " " -f 2` -fi -PROJECT_ID=$1 -RENDU=$2 - -shift 2 - -LOGINS= -while [ $# -gt 0 ] -do - LOGINS="$LOGINS $1 -" - shift -done - -cat < - - moulette - $YEAR - $PROJECT_ID - $RENDU -$LOGINS -EOF - -echo diff --git a/commands/moulette/send_tarball.sh b/commands/moulette/send_tarball.sh deleted file mode 100755 index 77f0ec7..0000000 --- a/commands/moulette/send_tarball.sh +++ /dev/null @@ -1,83 +0,0 @@ -#!/bin/bash - -usage() -{ - echo "Usage: $0 [-d] [year] " -} - -if [ -z "$4" ] -then - usage - exit 1 -fi - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -if [ "x$1" = "x-d" ] -then - BACKGROUD= - shift -else - BACKGROUD="-b" -fi - -if [ "x${1:0:2}" = "x20" ] -then - YEAR=" $1" - shift -else - YEAR= -fi -PROJECT_ID=$1 -RENDU=$2 -LOGIN=$3 - -if ! [ -f "$4" ] -then - usage - exit 2 -fi - -MIME=`file -b -i "$4" | cut -d ';' -f 1` - -if [ "$MIME" = "application/x-bzip2" ] -then - FILE=`bzip2 --decompress --stdout "$4" | gzip --stdout | base64` - -elif [ "$MIME" = "application/x-gzip" ] -then - FILE=`gzip --decompress --stdout "$4" | gzip --stdout | base64` - -elif [ "$MIME" = "application/x-xz" ] -then - FILE=`xz --decompress --stdout "$4" | gzip --stdout | base64` - -elif [ "$MIME" = "application/x-tar" ] -then - FILE=`tar cz "$4" | base64` - -elif [ "$MIME" = "inode/directory" ] -then - FILE=`tar xf "$4" | tar cz | base64` - -else - echo "I don't know how to treat $4" >&2 - exit 3 -fi - -cat < - - std -$YEAR - $PROJECT_ID - $RENDU - $LOGIN - rendu.tgz - $FILE - -EOF diff --git a/commands/moulette/sendgit.sh b/commands/moulette/sendgit.sh deleted file mode 100755 index ec68a4c..0000000 --- a/commands/moulette/sendgit.sh +++ /dev/null @@ -1,59 +0,0 @@ -#!/bin/sh - -usage() -{ - echo "Usage: $0 [-d] [year] [login ...]" -} - -if [ -z "$3" ] -then - usage - exit 1 -fi - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -if [ "x$1" = "x-d" ] -then - BACKGROUD= - shift -else - BACKGROUD="-b" -fi - -if [ "x${1:0:2}" = "x20" ] -then - YEAR=" $1" - shift -else - YEAR= -fi -PROJECT_ID=$1 -RENDU=$2 - -shift 2 - -if [ $# -le 0 ] -then - usage - exit 1 -fi - -while [ $# -gt 0 ] -do - LOGIN=$1 - cat < - -$YEAR - $PROJECT_ID - $RENDU - $LOGIN - -EOF - shift -done diff --git a/commands/moulette/set_max_memory.sh b/commands/moulette/set_max_memory.sh deleted file mode 100644 index 48ccf1c..0000000 --- a/commands/moulette/set_max_memory.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -if [ -z "$1" ] -then - echo "Usage: $0 " - exit 1 -fi - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -cat < - - set_memory - $1 - -EOF - -echo diff --git a/commands/moulette/set_workers.sh b/commands/moulette/set_workers.sh deleted file mode 100755 index ec77cf9..0000000 --- a/commands/moulette/set_workers.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -if [ -z "$1" ] -then - echo "Usage: $0 " - exit 1 -fi - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -cat < - - set_workers - $1 - -EOF - -echo diff --git a/commands/moulette/stats.sh b/commands/moulette/stats.sh deleted file mode 100755 index 0c1ac6e..0000000 --- a/commands/moulette/stats.sh +++ /dev/null @@ -1,29 +0,0 @@ -#!/bin/sh - -if ! which gearman > /dev/null 2> /dev/null -then - echo "gearman isn't installed on this machine. Please try another one." - exit 1 -fi - -ACTION= -if [ -n "$1" ] -then - if [ "$1" = "flush" ] - then - ACTION=" flush -" - else - echo "Unknown action '$1'" - exit 1 - fi -fi - -cat < - - stats -$ACTION -EOF - -echo diff --git a/commands/project/create.pl b/commands/project/create.pl index 6dd50c9..8407a7e 100644 --- a/commands/project/create.pl +++ b/commands/project/create.pl @@ -4,13 +4,15 @@ use v5.10.1; use strict; use warnings; +use lib "../../"; + use ACU::API::Base; use ACU::API::Projects; if ($#ARGV == 0) { - API::Projects::add($ARGV[0], ""); + API::Projects::add($ARGV[0]); } else { diff --git a/commands/project/gen_git_str.pl b/commands/project/gen_git_str.pl index e825048..0a67688 100644 --- a/commands/project/gen_git_str.pl +++ b/commands/project/gen_git_str.pl @@ -11,6 +11,7 @@ my $projid = $ARGV[0]; my $year = $ARGV[1] // LDAP::get_year; my $res = API::Projects::get_groups($projid, $year); +my $tag = "rendu-1"; map { my $chief; @@ -25,16 +26,10 @@ map { } } - my @members; - for my $member (@{ $_->{stds} }) { - push @members, $member->{login}; - } - say "repo $year/$projid/$chief->{login}"; - say " - ACU-moulette = ", join(" ", @members); - say " - refs/tags/ACU- = ", join(" ", @members); - say ' RW+ = @admins ', join(" ", @members); - say ' RW ACU-moulette = @moulettes'; - say ' RW+ refs/tags/ACU- = @moulettes'; - say " R = \@chefs \@resp-$year-$projid \@soutenance-$year-$projid \@moulettes intradmin-hamano"; + print ' RW+ = @admins'; + for my $member (@{ $_->{stds} }) { + print ' '.$member->{login}; + } + say "\n R = \@chefs \@resp-$year-$projid"; } @{ $res->{groups} }; diff --git a/hooks/dump-help.pl b/hooks/dump-help.pl deleted file mode 100755 index dd8d29f..0000000 --- a/hooks/dump-help.pl +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/env perl - -use strict; -use warnings; -use v5.10; -use utf8; -use Carp; -use File::Basename; -use File::Path qw(remove_tree); -use File::Temp qw/tempfile tempdir/; - -use ACU::Log; -$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log"; -use ACU::Process; - -# First, check if the repository is dump-help -exit 0 if ($ENV{GL_REPO} ne "dump-help"); - -my ($ref, $oldsha, $newsha) = @ARGV; - -log DONE, "This is the dump-help repository!"; - -exit 0 if ($newsha eq '0' x 40); - -if ($ref eq "refs/tags/release") -{ - - my $archive = qx(git archive --format=tgz $newsha); - #qx(git clone -b release /srv/git/repositories/dump-help.git '$tempdir') or croak "It is not a valid repository."; - - Process::Client::launch("docs_compile", - { - "type" => "dump_help", - "file" => "dump-help.tgz" , - }, - { "dump-help.tgz" => $archive }); - -} - -exit 0; diff --git a/hooks/gl-pre-git b/hooks/gl-pre-git index ea1f206..5f6fd16 100755 --- a/hooks/gl-pre-git +++ b/hooks/gl-pre-git @@ -5,7 +5,6 @@ use warnings; use v5.10; use File::Basename; use Net::IP; -use utf8; use ACU::Log; $ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log"; @@ -14,14 +13,13 @@ my $ip = $1 if ($ENV{'SSH_CLIENT'} =~ m/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0- exit 0 if (!$ip); -log DEBUG, "Connection by $ENV{GL_USER} with $ARGV[0] to $ENV{GL_REPO} from $ip"; +log DEBUG, "Connection with $ARGV[0] to $ENV{GL_REPO} from $ip"; my $promo = qx(git config hooks.promo); my $id_project = qx(git config hooks.idproject); my $repo_login = qx(git config hooks.repologin); -my @apping3 = qw(saadi_n lucas_e jawhar_s france_b roux_m bamba_m boudje_s gillot_l le-pen_m gimene_a nguye_d marin_c piedno_j salmon_b); -my @habitent_loin = qw(amed_m bellev_m freima_m ikouna_l simon_j faure_n abdelm_a habri_z trang_d henrie_p verbec_y molini_v marti_o colin_j); +my @habitent_loin = ("abdeln_a", "amed_m", "bellev_m", "faure_n", "freima_m", "ikouna_l", "simon_j"); # First, check if the repository is in the YYYY/ directory exit 0 if (($promo && $id_project && $repo_login) || $ENV{GL_REPO} !~ /^2[0-9]{3}\/.+\/.+/); @@ -50,12 +48,10 @@ if ($ip->overlaps($labnetwork) == $IP_A_IN_B_OVERLAP) # exit 1; #} -exit 0 if ($id_project eq "lse-project" && $ip->ip() eq "10.224.4.1"); - -exit 0 if (grep { /\Q$ENV{GL_USER}\E/ } @habitent_loin, @apping3, "icaza_fact"); +exit 0 if (grep { /\Q$repo_login\E/ } @habitent_loin); my $schoolnetwork = Net::IP->new('10.41.0.0/16'); -my $vjschoolnetwork = Net::IP->new('10.3.0.0/16'); +#my $vjschoolnetwork = Net::IP->new('10.3.0.0/16'); if ( $ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP diff --git a/hooks/post-update b/hooks/post-update deleted file mode 100755 index f08b54d..0000000 --- a/hooks/post-update +++ /dev/null @@ -1,116 +0,0 @@ -#!/usr/bin/env perl - -use strict; -use warnings; -use v5.10; -use File::Basename; -use utf8; - -use ACU::API::Projects; -use ACU::API::Submission; -use ACU::LDAP; -use ACU::Log; -$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log"; -use ACU::Process; - -my $promo; -my $id_project; -my $repo_login; - -# First, extract information, from config then guess from repository adress -if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; } -if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; } -if (my $tmp = `git config hooks.login`) { chomp $tmp; $repo_login = $tmp; } - -$promo = $1 if (!$promo && $ENV{'GL_REPO'} =~ m/([0-9]{4}).*/); -$id_project = $1 if (!$id_project && $ENV{'GL_REPO'} =~ m/.*\/(.*)\//); -$repo_login = $1 if (!$repo_login && $ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/); - -exit(0) if (!$promo || !$id_project || !$repo_login); - -for my $ref (@ARGV) -{ - my $tag; - my $tag_for; - if ($ref =~ m<^refs/tags/(ACU-(.+))$>) - { - $tag = $1; - $tag_for = $2; - } - elsif ($ref =~ m<^refs/tags/(.+)$>) - { - $tag = $1; - $tag_for = $1; - } - else { - next; - } - - log DEBUG, "Tag $tag ($tag_for) on repository $ENV{GL_REPO} from IP $ENV{'SSH_CLIENT'} updated."; - - my $project = get_project_info($tag_for); - - # Extract matching tag - my @rendus = grep { - exists $_->{vcs} and $_->{vcs}{tag} eq $tag_for; - } @{ $project->{submissions} }; - - if (@rendus) - { - eval - { - Process::Client::launch("send_git", - { - "year" => $promo, - "id" => $id_project, - "rendu" => $tag, - "login" => $repo_login, -# "path" => "ssh://git\@localhost/".$ENV{GL_REPO}, # Optional - }, - undef, # Don't give any file - 1 # Launch in background - ); - }; - if ($@) - { - my $err = $@; - log DEBUG, "ERROR: ".$err; - } - - # Send data to API - my $last_commit = `git log "refs/tags/$tag" -1 --decorate --tags`; - eval { - API::Submission::add($promo, $id_project, $tag_for, $repo_login, $last_commit); - }; - if ($@) - { - my $err = $@; - log DEBUG, "ERROR: ".$err; - log DONE, "Tag '$tag' effectué avec succès !"; - } - else { - log DONE, "Tag '$tag' effectué avec succès ! Vérifiez-le sur l'intranet."; - } - } -} - -exit 0; - -sub get_project_info -{ - my $project; - eval { - $project = API::Projects::get($id_project, $promo); - }; - if ($@ or !$project) - { - my $err = $@; - log TRACE, $err; - log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire."; - exit(1); - } - - #log TRACE, $project; - - return $project; -} diff --git a/hooks/subjects.pl b/hooks/subjects.pl index 03ba63b..f02c04e 100755 --- a/hooks/subjects.pl +++ b/hooks/subjects.pl @@ -69,7 +69,7 @@ sub check_xml sub repository_name { my $repo = $ENV{GL_REPO}; - $repo =~ s#subject.*/([^/]+)$#$1#; + $repo =~ s#^subjects/(.*)#$1#; return $repo; } @@ -97,7 +97,7 @@ sub tag_defense my $path; if ($_[3]) { - if ($_[3] =~ /^(?:defenses\/)?([a-zA-Z0-9_.\/-]+?)(?:.xml)?$/) { + if ($_[3] =~ /^(?:defenses\/)?([a-zA-Z0-9_.\/-]+)(?:.xml)?$/) { $path = "defenses/".$1.".xml"; } else { $path = $_[3]; @@ -119,11 +119,12 @@ sub tag_defense chomp($path); } - log WARN, "Placez votre soutenance dans le dossier defenses/." if ($path !~ /^defenses/); - - my $defense_id = basename($path); - $defense_id =~ s/\.xml$//; - $defense_id =~ s/[^a-zA-Z0-9_.-]/_/g; + my $defense_id; + if ($path =~ /^(?:defenses\/)?([a-zA-Z0-9\/]+)(?:.xml)?$/) { + $defense_id = $1; + } else { + log ERROR, "Déplacez votre soutenance dans le dossier defenses ou simplifiez le nom du fichier."; + } my $year; if ($_[4]) @@ -168,7 +169,7 @@ sub tag_defense # Generate questions and answer id my $defense = Defense->new(\$content); - $defense->genIds($defense_id); + $defense->genIds(); # Send data to intradata log INFO, "Attente d'un processus de publication..."; @@ -306,7 +307,6 @@ sub tag_project # 2: $year my $project_id = repository_name(); - my $flavour = ""; if ($_[1]) { # Check on ID/flavour_id @@ -315,7 +315,6 @@ sub tag_project } $project_id .= "-" . $_[1]; - $flavour = $_[1]; } $project_id = lc $project_id; $project_id =~ s/[^a-z0-9-_]/_/g; @@ -376,22 +375,17 @@ sub tag_project my $mod = 0; for my $vcs ($dom->documentElement()->getElementsByTagName("vcs")) { - if (! $vcs->hasAttribute("tag") || $vcs->getAttribute("tag") =~ /^(ACU|YAKA)-/) { - log ERROR, "Un tag de rendu ne peut pas commencer par ACU- ou YAKA-."; # C'est réservé pour les moulettes - } - if (! $vcs->hasAttribute("token")) { if ($project) { # Looking for an old token my @rendus = grep { - exists $_->{vcs} and $_->{vcs}{tag} eq $vcs->getAttribute("tag"); + exists $_->{vcs} and $_->{vcs}{tag} eq $vcs->hasAttribute("tag"); } @{ $project->{submissions} }; - if (@rendus == 1) - { - log DEBUG, "Use existing token: ".$rendus[0]->{vcs}{token}; + if (@rendus == 1) { + log INFO, "Use existing token: ".$rendus[0]->{vcs}{token}; $vcs->setAttribute("token", substr($rendus[0]->{vcs}{token}, 2, 23)); $mod = 1; next; @@ -425,7 +419,7 @@ sub tag_project log INFO, "Information de l'intranet..."; # Call API eval { - API::Projects::add($project_id, $flavour, $year); + API::Projects::add($project_id, $year); }; if ($@) { diff --git a/hooks/submissions.pl b/hooks/submissions.pl index 9bd0b40..52d7e59 100755 --- a/hooks/submissions.pl +++ b/hooks/submissions.pl @@ -8,7 +8,6 @@ use File::Basename; use Net::IP; use POSIX qw(strftime); use Socket; -use utf8; use ACU::API::Projects; use ACU::API::Submission; @@ -23,11 +22,6 @@ my $promo; my $id_project; my $repo_login; -my @apping = qw(zinger_a zebard_w zanell_a yao_p vinois_a sraka_y soupam_j seck_a ngomsi_s morin_h milis_e menkar_m eusebe_r crief_a chhum_s boumra_n blemus_a bengan_l amasho_a); -my @expcep = qw(azerno_t baudry_v dechen_g drouin_n dupuis_a fenech_a hamdao_y lanclu_j langre_m manuel_c palson_c trang_d wajntr_a); -my @salonD = qw(aniss_i bogalh_j boulea_b cloare_l elhach_h gabrie_j kaplan_p manuel_c palson_c pizzin_a wajntr_a); -my @salonS = qw(allio_a cadet_l digius_p drouin_n dubois_d dupuis_a langre_m lim_j); - # First, extract information, from config then guess from repository adress if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; } if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; } @@ -39,68 +33,12 @@ $repo_login = $1 if (!$repo_login && $ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/); exit(0) if (!$promo || !$id_project || !$repo_login); -if ($ref =~ m<^refs/tags/ACU-(.+)$>) +if ($ref =~ m<^refs/tags/(.+)$>) { my $tag = $1; log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}"; - # Disallow no ACU - if ($ENV{GL_USER} ne "frotti_b" && $ENV{GL_USER} ne "chen_a" && $ENV{GL_USER} ne "boisse_r" && $ENV{GL_USER} ne "genite_n" && $ENV{GL_USER} ne "mercie_d") - { - log ERROR, "Vous n'êtes pas autorisé à envoyer ce tag."; - exit(9); - } - - my $project = get_project_info($tag); - - # Extract matching tag - my @rendus = grep { - exists $_->{vcs} and $_->{vcs}{tag} eq $tag; - } @{ $project->{submissions} }; - - if (! @rendus) - { - log ERROR, "$tag n'est pas un tag valide."; - exit(8); - } -} -elsif ($ref =~ m<^refs/tags/(.+)$>) -{ - my $tag = $1; - log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}"; - - my $project = get_project_info($tag); - - # Extract matching tag - my @rendus = grep { - exists $_->{vcs} and $_->{vcs}{tag} eq $tag; - } @{ $project->{submissions} }; - - if (@rendus) - { - if ($newsha eq '0' x 40) - { - log USAGE, "Mais pour quelle raison voudriez-vous supprimer un tag ?!"; - exit(7); - } - - chomp (my $tokengiven = `git cat-file tag $newsha 2> /dev/null | sed -e '1,/^\$/d'`); - if (! check_submission_date($tokengiven, @rendus)) - { - exit (9); - } - } - else - { - log ERROR, "$tag n'est pas un tag valide."; - exit(8) - } -} - -exit 0; - -sub get_project_info -{ + # Get project informations my $project; eval { $project = API::Projects::get($id_project, $promo); @@ -110,17 +48,15 @@ sub get_project_info my $err = $@; log TRACE, $err; log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire."; - exit(1); + exit 1; } log TRACE, $project; - return $project; -} - -sub check_submission_date -{ - my $tokengiven = shift; + # Extract lot of data + my @rendus = grep { + exists $_->{vcs} and $_->{vcs}{tag} eq $tag; + } @{ $project->{submissions} }; my $glts = DateTime::Format::ISO8601->parse_datetime( do { @@ -129,17 +65,14 @@ sub check_submission_date $t }); - for my $rendu (@_) + chomp (my $tokengiven = `git cat-file tag $newsha 2> /dev/null | sed -e '1,/^\$/d'`); + for my $rendu (@rendus) { my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin}); my $close = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{end}); - if (($id_project eq "bistromathique" || $id_project eq "pthl") && grep { $_ eq $repo_login } @expcep) -# if (($id_project eq "bistromathique" || $id_project eq "pthl") && "pizzin_a" eq $repo_login) - { -# $open = DateTime::Format::ISO8601->parse_datetime("2013-12-19T18:00:00"); - $close = DateTime::Format::ISO8601->parse_datetime("2013-12-22T19:42:00"); - } + # TODO: check exceptions by login/group + $open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l"); say "Date courante : ", $glts->strftime("%d/%m/%Y %H:%M:%S"); @@ -166,5 +99,40 @@ sub check_submission_date } } - return 1; + if ($newsha eq '0' x 40) { + log USAGE, "Mais pour quelle raison voudriez-vous supprimer un tag ?!"; + } + else + { + eval { + Process::Client::launch("send_git", + { + "year" => $promo, + "id" => $id_project, + "rendu" => $tag, + "login" => $repo_login, +# "path" => "ssh://git\@localhost/".$ENV{GL_REPO}, + }, undef, 1); + }; + if ($@) { + my $err = $@; + log DEBUG, "ERROR: ".$err; + } + + # Send data to API + my $last_commit = `git log $newsha -1 --decorate --tags`; + eval { + API::Submission::add($promo, $id_project, $tag, $repo_login, $last_commit); + }; + if ($@) { + my $err = $@; + log DEBUG, "ERROR: ".$err; + log DONE, "Tag '$tag' effectué avec succès !"; + } + else { + log DONE, "Tag '$tag' effectué avec succès ! Vérifiez-le sur l'intranet."; + } + } } + +exit 0; diff --git a/migration/repo.sh b/migration/repo.sh index c8fffa1..be4338a 100755 --- a/migration/repo.sh +++ b/migration/repo.sh @@ -20,26 +20,21 @@ tex2md() bi=`basename "$i"` echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m" - # BEGIN HACK! Need stacking - sed -Ei 's/\\(lstinline|class|expected|refer)[^{]*\{([^}]*)\}/\\verb+\2+/gi' "$i" + # BEGIN HACK! Need stacking sed -Ei 's/\\distribution\{\}/FreeBSD 9/gi' "$i" sed -Ei 's/\\\{/__OPEN_BRACKET_MINIROOT__/gi' "$i" sed -Ei 's/\\\}/__CLOSE_BRACKET_MINIROOT__/gi' "$i" sed -Ei 's/-\{\}-//gi' "$i" - #sed -Ei 's/\\_/_/gi' "$i" + sed -Ei 's/\\_/_/gi' "$i" # DIRTY HACK + sed -Ei 's/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i" sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\input *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\{\\include *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\{\\input *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" - sed -Ei 's/\\lstinputlisting *\{([^}]+)\}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\lstinline *\{([^}]+)}/\\verb+\1+/gi' "$i" - sed -Ei 's/\\structure\{([^}]+)}/\1/gi' "$i" - sed -Ei 's/\\struct\{([^}]+)}/\1/gi' "$i" - sed -Ei 's/\\link\{([^}]+)}/\1/gi' "$i" - sed -Ei 's/\\textasciitilde\{\}/~/gi' "$i" sed -Ei 's/\\begin *\{correction\}/\\begin\{verbatim\}/g' "$i" sed -Ei 's/\\end *\{correction\}/\\end\{verbatim\}/g' "$i" sed -Ei 's/\\begin *\{prompt\}/\\begin\{verbatim\}/g' "$i" @@ -51,9 +46,11 @@ tex2md() sed -Ei 's/\\begin *\{cartouche_nospaces\}/\\begin\{verbatim\}/g' "$i" sed -Ei 's/\\end *\{cartouche_nospaces\}/\\end\{verbatim\}/g' "$i" sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i" + sed -Ei 's/``/"/g' "$i" + sed -Ei "s/''/\"/g" "$i" # Special macros - sed -Ei 's/\\(file|email|command|bcode|code) *\{([^}]*)\}/\\verb+\2+/gi' "$i" + sed -Ei 's/\\(file|email|command|code|bcode) *\{([^}]*)\}/\\verb+\2+/gi' "$i" sed -Ei 's/\\begin *\{assistant\}/\\verb+%%assistant-begin+/g' "$i" sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i" @@ -84,7 +81,7 @@ tex2md() git rm -f "$i" > /dev/null fi - sed -Ei 's/`%%([a-z-]+)\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md" + sed -Ei 's/`%%([a-z-])\(([^)]+)\)`/%%\1(\2)/gi' "$DEST/${bi%%.tex}.md" sed -Ei 's/\\$/\n/' "$DEST/${bi%%.tex}.md" done } @@ -114,7 +111,7 @@ clean_tex() exit 1; fi - for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png images/acu_2012_logo_hd.png *.cls *.sty *.toc + for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png *.cls *.sty do if [ -f "$f" ] then @@ -161,7 +158,7 @@ clean_tex() elif [ `find -mindepth 1 -maxdepth 1 -name '*.tex' | wc -l` -gt 0 ] then tex2md . - + else for i in * do @@ -231,7 +228,7 @@ if ls | grep "moulette" then echo -e "\e[1;34m>>>\e[1;37m Creating moulette branch...\e[0m" git checkout -b moulette - + find -mindepth 1 -maxdepth 1 ! -name moulette ! -name tests ! -name .git -exec git rm -rf {} \; git rm -f moulette/DESC 2> /dev/null @@ -348,18 +345,6 @@ do git rm -rf "$f" > /dev/null fi done - - # Append Fact lines - if [ -f "Makefile" ] - then - cat <> Makefile -fact: - rm -rf ref.ff - \${FACT} package create ../ref ref.ff - \${FACT} make make ref.ff ref.ff -EOF - fi - cd - > /dev/null fi done diff --git a/process/exec/guantanamo.pl b/process/exec/guantanamo.pl index b40da88..745a120 100644 --- a/process/exec/guantanamo.pl +++ b/process/exec/guantanamo.pl @@ -14,7 +14,6 @@ use ACU::Process; my %master_actions = ( "launch" => \&master_launch, - "list" => \&master_list, "register" => \&master_register, ); @@ -24,40 +23,17 @@ sub master_register { my $args = shift; - if ($args->{param}{nodename}) - { + if ($args->{param}{nodename}) { my $nodename = $args->{param}{nodename}; - if (! grep { $_ eq $nodename } @nodes) - { - log INFO, "New node: $nodename"; - push @nodes, "$nodename"; - } - else { - log WARN, "Node $nodename alredy registered"; - } + log INFO, "New node: $nodename"; + push @nodes, "$nodename"; } else { log WARN, "nodename empty, cannot register new node"; } } -sub master_list -{ - my $doc = XML::LibXML::Document->new('1.0'); - my $root = $doc->createElement("process"); - - for my $target (@nodes) - { - my $t = $doc->createElement("target"); - $t->setAttribute("name", $target); - $root->appendChild($t); - } - - $doc->setDocumentElement( $root ); - return $doc->toString(); -} - sub build_task_xml { my $files = shift; @@ -145,13 +121,13 @@ sub master_launch } for my $node (@lnodes) { - my @o = $ret{$node}->documentElement->getElementsByTagName("out"); - if (@o) { + my $o = $ret{$node}->documentElement->getElementsByTagName("out"); + if ($o) { $output .= $o[0]->firstChild->nodeValue; } - my @e = $ret{$node}->documentElement->getElementsByTagName("err"); - if (@e) { + $e = $ret{$node}->documentElement->getElementsByTagName("err"); + if ($e) { $output .= $e[0]->firstChild->nodeValue; } $output .= $e[0]->firstChild->nodeValue; @@ -196,5 +172,4 @@ sub process_master log INFO, "Starting guantanamo.pl as master process"; -Process::add_server("gearmand:4730"); Process::register("guantanamo", \&process_master); diff --git a/process/exec/guantanamo_node.pl b/process/exec/guantanamo_node.pl index 3a8f208..0e0cdeb 100644 --- a/process/exec/guantanamo_node.pl +++ b/process/exec/guantanamo_node.pl @@ -9,6 +9,7 @@ use File::Temp qw/tempfile tempdir/; use IPC::Open3; use XML::LibXML; +use ACU::LDAP; use ACU::Log; use ACU::Process; @@ -52,18 +53,10 @@ sub node_launch $command->appendText($c->{nodeValue}); $cmd->appendChild($command); - my($wtr, $rdr, $rv); - my $stderr = ""; - eval { - my $pid = open3($wtr, $rdr, $stderr, "sh", "-c", $c->{nodeValue}); - waitpid( $pid, 0 ); - $rv = $? >> 8; - }; - if ($@) - { - $stderr = $@ . $stderr; - $rv = -1; - } + my($wtr, $rdr, $stderr); + my $pid = open3($wtr, $rdr, $stderr, $c->{nodeValue}); + waitpid( $pid, 0 ); + my $rv = $? >> 8; my $out = $doc->createElement("out"); my $str = ""; @@ -100,7 +93,7 @@ sub process_node my $action = $args->{param}{action} // "launch"; if (! exists $node_actions{$action}) { - warn "Unknown action '$action' for guantanamo node process."; + log WARN, "Unknown action '$action' for guantanamo node process."; } return $node_actions{$action}($args); } @@ -109,7 +102,7 @@ if ($#ARGV == 0) { log INFO, "Starting guantanamo.pl as node process"; - Process::Client::launch("guantanamo", {"action" => "register", "nodename" => $ARGV[0]}, undef, 1); + Process::Client::launch("guantanamo", {"action" => "register", "nodename" => $ARGV[0]}); Process::register("guantanamo_".$ARGV[0], \&process_node); } diff --git a/process/exec/run.sh.not-here b/process/exec/run.sh.not-here deleted file mode 100644 index 56d5c05..0000000 --- a/process/exec/run.sh.not-here +++ /dev/null @@ -1,138 +0,0 @@ -#!/usr/bin/env sh - -cd $(dirname "$0") - -GREP='/usr/bin/env grep -E' -SCREEN='/usr/bin/env screen' -SED='/usr/bin/env sed -E' -if [ `uname -s` = "FreeBSD" ]; then - SU="/usr/bin/env su" -else - SU='/usr/bin/env su -s /bin/sh' -fi -PERL='/usr/bin/env perl' - -# Install missing packages -DEB_PACKAGES_LIST="screen libxml-libxml-perl libgearman-client-perl" -ARCH_PACKAGES_LIST="screen" -GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/XML-LibXML" -FBSD_PACKAGES_LIST="screen p5-XML-LibXML p5-Gearman p5-Term-ANSIColor" - -KERNEL=`uname -s` - - -if [ "$KERNEL" = "FreeBSD" ] -then - - for PK in `echo $FBSD_PACKAGES_LIST` - do - if ! pkg info "$PK" > /dev/null 2> /dev/null - then - if ! PACKAGESITE="http://canon.acu.epita.fr/repo-lab" pkg install "$PK" - then - echo "Error during installation of $PK" - exit 1 - fi - fi - done - - if ! getent passwd | grep "guantanamo:" > /dev/null 2> /dev/null - then - pw useradd guantanamo -u 941 -d /home/guantanamo -s /bin/false - fi - -elif [ "$KERNEL" = "Linux" ] -then - - if [ -f "/etc/debian_version" ] - then - - if ! whereis dpkg > /dev/null 2> /dev/null - then - if ! aptitude install dpkg - then - echo "Error during installation of $PK" - exit 1 - fi - fi - - for PK in $DEB_PACKAGES_LIST - do - if ! dpkg -l | grep "^ii" | grep "$PK" > /dev/null 2> /dev/null - then - aptitude install "$PK" - fi - done - - elif [ -f "/etc/arch-release" ] - then - - for PK in $ARCH_PACKAGES_LIST - do - if ! pacman -Qi "$PK" > /dev/null 2> /dev/null - then - if ! pacman -S "$PK" - then - echo "Error during installation of $PK" - exit 1 - fi - fi - done - - elif [ -f "/etc/gentoo-release" ] - then - - for PK in $GENTOO_PACKAGES_LIST - do - if ! equery list "$PK" > /dev/null 2> /dev/null - then - if ! emerge "$PK" - then - echo "Error during installation of $PK" - exit 1 - fi - fi - done - - else - - echo "Unsupported GNU/Linux distribution :(" - exit 1; - - fi - - - # Add guantanamo user if missing - if ! getent passwd | grep "guantanamo:" > /dev/null 2> /dev/null - then - useradd --shell /bin/false --uid 941 guantanamo && - mkdir -p /home/guantanamo - fi - - chown -R guantanamo:guantanamo /home/guantanamo - -else - - echo "Unsupported operating system :(" - exit 1; - -fi - -chown -R guantanamo . - -if [ $# -gt 0 ] -then - ARCHNAME=$1 -else - echo "Expected at first argument: node name. For example: hurd-ia64" - exit 1 -fi - -CMD="$SCREEN -S 'guantanamo_$ARCHNAME' -d -m sh -c 'while true; do perl guantanamo_node.pl $ARCHNAME; done'" - -if [ "x$UID" = "x0" ] -then - echo "$CMD" | $SU guantanamo -else - $CMD -fi diff --git a/process/files/intradata_get.pl b/process/files/intradata_get.pl index e68f333..7e1eae3 100644 --- a/process/files/intradata_get.pl +++ b/process/files/intradata_get.pl @@ -8,7 +8,6 @@ use Pod::Usage; use lib "../../"; -use ACU::API::Projects; use ACU::Log; use ACU::LDAP; use ACU::Grading; @@ -43,7 +42,7 @@ sub create_tree($$) croak "No directory for year $year. Ask a root to create it." if (! -d "$basedir/$year/"); if (! -e "$basedir/$year/$project_id/") { - mkdir "$basedir/$year/$project_id/" or die $!; + mkdir "$basedir/$year/$project_id/" or croak $!; } } @@ -58,14 +57,11 @@ sub grades_generate croak "No project_id given." if (! $project_id); if (! -e "$basedir/$year/$project_id/grades/") { - mkdir "$basedir/$year/$project_id/grades/" or die $!; + mkdir "$basedir/$year/$project_id/grades/" or croak $!; } log DEBUG, "Generate list of students"; - # Get groups from the intranet - my $groups = API::Projects::get_groups($project_id, $year); - # Create list of students to generate my @logins; if ($args->{unamed}) @@ -76,11 +72,22 @@ sub grades_generate } else { - map { - for my $member (@{ $_->{stds} }) { - push @logins, $member->{login}; + opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!"; + for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh)) + { + opendir(my $dhm, "$basedir/$year/$project_id/traces/$dir") or croak "can't opendir $basedir/$year/$project_id/traces/$dir: $!"; + + for my $login (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/traces/$dir/$_" } readdir($dhm)) + { + $login =~ s/\.xml$//; + if (! grep { /^\Q$login\E$/ } @logins) { + push @logins, $login; + } } - } @{ $groups->{groups} }; + + closedir $dhm; + } + closedir $dh; } log TRACE, @logins; @@ -100,57 +107,27 @@ sub grades_generate for my $login (@logins) { - my @files; - log DEBUG, "Generating grades for $login"; for my $dir (@trace_dirs) { - log DEBUG, "Will fetch identifiers from $dir"; - - # Looking for a group traces first - for my $grp (@{ $groups->{groups} }) + log DEBUG, "Generating grades from $dir"; + if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml") { - my $this = 0; - my $chief; - for my $member (@{ $grp->{stds} }) - { - if ($member->{chief} eq "true" or $member->{chief} eq "1" or $member->{chief} eq "chief") - { - $chief = $member; - next; - } - $this = 1 if ($member->{login} eq $login); - } - if ($this && $chief) - { - if (-f "$basedir/$year/$project_id/traces/$dir/".$chief->{login}.".xml") { - push @files, "$basedir/$year/$project_id/traces/$dir/".$chief->{login}.".xml"; - } - last; - } + open my $xmltrace, "<", "$basedir/$year/$project_id/traces/$dir/$login.xml" or croak "traces/$dir/$login.xml: $!"; + binmode $xmltrace; + my $trace = Trace->new($xmltrace); + close $xmltrace; + + log DEBUG, "Fill from file: traces/$dir/$login.xml"; + log TRACE, $trace->getIds; + + $grading->fill($trace->getIds); } - - if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml") { - push @files, "$basedir/$year/$project_id/traces/$dir/$login.xml"; - } - } - - for my $path (@files) - { - open my $xmltrace, "<", "$path" or die "$path: $!"; - binmode $xmltrace; - my $trace = Trace->new(join '', <$xmltrace>); - close $xmltrace; - - log DEBUG, "Fill from file: $path"; - log TRACE, $trace->getIds($login); - - $grading->fill($trace->getNonZeroIds($login)); } log DEBUG, "Computed grades: ".$grading->compute($login); - open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml: $!"; + open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml"; binmode $xmlgrade; print $xmlgrade $grading->computeXML($login); close $xmlgrade; @@ -171,12 +148,11 @@ sub grades_new_bonus croak "No project_id given" if (! $project_id); - die "No such project $project_id in $year" if (! -d "$basedir/$year/$project_id/"); if (! -e "$basedir/$year/$project_id/traces/") { - mkdir "$basedir/$year/$project_id/traces/" or die $!; + mkdir "$basedir/$year/$project_id/traces/" or croak $!; } if (! -e "$basedir/$year/$project_id/traces/bonus/") { - mkdir "$basedir/$year/$project_id/traces/bonus/" or die $!; + mkdir "$basedir/$year/$project_id/traces/bonus/" or croak $!; } for my $kfile (keys %{ $args->{files} }) @@ -203,7 +179,7 @@ sub grades_new_bonus for my $line (@lines) { - if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*(-?[0-9.]+))?$/) + if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*([0-9.]+))?$/) { my $login = $1; my $tvalue = $2 // $value; @@ -216,9 +192,9 @@ sub grades_new_bonus } if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") { - open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!; + open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!; binmode $xml; - $trace = Trace->new(join '', <$xml>); + $trace = Trace->new($xml); close $xml; } elsif ($delete) { @@ -235,18 +211,17 @@ sub grades_new_bonus $trace->delId($kbonus); } } else { - my $e = $trace->addId($kbonus, $tvalue); - $e->changeWho($login, "login"); + $trace->addId($kbonus, $tvalue); } log DEBUG, "Updating $basedir/$year/$project_id/traces/bonus/$login.xml"; - open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or die $!; + open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!; print $xml $trace->toString(); close $xml; } else { - warn "Invalid login $line, line skiped"; + log WARN, "Invalid login $line, line skiped"; } } } @@ -276,19 +251,19 @@ sub update_defense log INFO, "Update $year/$project_id/defenses/$defense_id.xml"; if (! -e "$basedir/$year/$project_id/defenses/") { - mkdir "$basedir/$year/$project_id/defenses/" or die $!; + mkdir "$basedir/$year/$project_id/defenses/" or croak $!; } if (! -e "$basedir/$year/$project_id/traces/") { - mkdir "$basedir/$year/$project_id/traces/" or die $!; + mkdir "$basedir/$year/$project_id/traces/" or croak $!; } if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") { - mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!; + mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!; my ($login, $pass, $uid, $gid) = getpwnam("www-data"); - chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/";# or die $!; #FIXME - chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!; + chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!; + chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or croak $!; } - open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or die $!; + open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml" or croak $!; print $out $defense; close $out; @@ -347,11 +322,11 @@ sub update_trace log INFO, "Update $year/$project_id/traces/$rendu_id/$login.xml"; if (! -e "$basedir/$year/$project_id/traces/") { - mkdir "$basedir/$year/$project_id/traces/" or die $!; + mkdir "$basedir/$year/$project_id/traces/" or croak $!; } if (! -e "$basedir/$year/$project_id/traces/$rendu_id/") { - mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or die $!; - chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or die $!; + mkdir "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!; + chmod 0755, "$basedir/$year/$project_id/traces/$rendu_id/" or croak $!; } open my $out, ">", "$basedir/$year/$project_id/traces/$rendu_id/$login.xml" or croak("Unable to write to $rendu_id/$login.xml"); diff --git a/process/files/moulette_get.pl b/process/files/moulette_get.pl index 6134d34..0024071 100644 --- a/process/files/moulette_get.pl +++ b/process/files/moulette_get.pl @@ -7,7 +7,6 @@ use threads; use threads::shared; use Carp; use File::Basename; -use File::Compare; use File::Copy; use File::Path qw(remove_tree mkpath); use File::Temp qw/tempfile tempdir/; @@ -154,39 +153,11 @@ sub create_testsuite jail_exec("gmake -C $tempdir/tests/"); croak "An error occurs while making the testsuite" if ($?); - my ($workdir, $outputdir, $destdir) = prepare_dir($year, $project_id, $rendu); + my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2]; copy("$tempdir/tests/tests.ff", "$destdir/tests.ff") or croak "An error occurs while coping the testsuite: $!"; + copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!"; chmod 0660, "$destdir/tests.ff"; - - # Check if test.ft has changed - if (-f "$tempdir/tests/test.ft") - { - if (! -f "$destdir/test.ft" || compare("$tempdir/tests/test.ft", "$destdir/test.ft")) - { - log DEBUG, "test.ft has changed, UPDATE students ones."; - copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!"; - chmod 0660, "$destdir/test.ft"; - - opendir(my $dh, $workdir) or die "Can't list files in $workdir: $!"; - while (readdir($dh)) - { - if (/([a-zA-Z0-9_-]+).ft$/) - { - log DEBUG, "Remove $1.ft"; - unlink "$workdir/$1.ft"; - } - } - closedir $dh; - } - else - { - log DEBUG, "test.ft hasn't changed, KEEP students ones."; - } - } - else { - remove_tree($tempdir); - croak "tests/test.ft not found."; - } + chmod 0660, "$destdir/test.ft"; # Clean remove_tree($tempdir); @@ -239,7 +210,7 @@ sub run_moulette close $fhout; } - copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannot copy $login.ff"; + copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannont copy $login.ff"; next if ($login eq "ref" && ! -f "$workdir/$login.ft"); croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$workdir/$login.ft"); diff --git a/process/files/send_git.pl b/process/files/send_git.pl index 9fc2dd4..db2f924 100644 --- a/process/files/send_git.pl +++ b/process/files/send_git.pl @@ -7,7 +7,6 @@ use v5.10; use File::Path qw(remove_tree); use File::Temp qw/tempfile tempdir/; -use ACU::LDAP; use ACU::Log; use ACU::Process; @@ -16,16 +15,11 @@ sub process { my ($given_args, $args) = @_; - my $year = $args->{param}{year} // LDAP::get_year(); + my $year = $args->{param}{year}; my $project_id = $args->{param}{id}; my $rendu = $args->{param}{rendu}; my $login = $args->{param}{login}; - my $rendu_for = $rendu; - if ($rendu =~ /^(ACU|YAKA)-(.*)$/) { - $rendu_for = $2; - } - my $path = $args->{param}{path} // "ssh://git\@localhost/$year/$project_id/$login.git"; my $tempdir = tempdir(); @@ -35,10 +29,10 @@ sub process croak "$path is not a valid repository." if ($?); my $tar; - open my $fh, "tar -czf - -C '$tempdir' . |" or die ("Error during tar: " . $!); + open my $fh, "tar -czf - -C '$tempdir' . |" or die ($!); $tar .= $_ while(<$fh>); close $fh; - die "Unable to tar: $!" if ($?); + die "Unable to untar: $!" if ($?); # Clean remove_tree($tempdir); @@ -48,7 +42,7 @@ sub process "type" => "std", "id" => $project_id, "year" => $year, - "rendu" => $rendu_for, + "rendu" => $rendu, "login" => $login, "file" => "rendu.tgz" }, diff --git a/process/launch.sh b/process/launch.sh index 90e2ccf..fef7b54 100755 --- a/process/launch.sh +++ b/process/launch.sh @@ -12,17 +12,13 @@ else fi PERL='/usr/bin/env perl' -reset_agents() -{ - echo "killall ssh-agent" | $SU intradmin -} - launch_screen() { CMD=$2 if [ -n "$3" ] && [ -f "$3" ] then TMP=`echo mktemp | $SU intradmin` + echo "killall ssh-agent" | $SU intradmin echo "ssh-agent" | $SU intradmin > "$TMP" echo ". $TMP; ssh-add '$3'" | $SU intradmin CMD=". $TMP; ssh-add -l; echo; $CMD" @@ -84,13 +80,10 @@ then case $HOSTNAME in cpp) - launch_screen "lerdorf_process_exec_guantanamo" "while true; do $PERL ~/liblerdorf/process/exec/guantanamo.pl; done" - reset_agents launch_screen "lerdorf_process_ldap_sync_ssh_keys_forge" "while true; do $PERL ~/liblerdorf/process/ldap/sync_ssh_keys_forge.pl; done" ~intradmin/.ssh/git ;; hamano) - reset_agents launch_screen "lerdorf_process_ldap_sync_ssh_keys_git" "while true; do $PERL ~/liblerdorf/process/ldap/sync_ssh_keys_git.pl; done" ~intradmin/.ssh/git launch_screen "lerdorf_process_send_git" "while true; do $PERL ~/liblerdorf/process/files/send_git.pl; done" ~intradmin/.ssh/git ;; diff --git a/process/ldap/check_ssh_key.pl b/process/ldap/check_ssh_key.pl index 4295e53..99584a1 100644 --- a/process/ldap/check_ssh_key.pl +++ b/process/ldap/check_ssh_key.pl @@ -17,16 +17,8 @@ use ACU::Log; sub check_key($) { my $filename = shift; - - # Check file content format - open my $fh, "<", $filename; - my $fcnt = <$fh>; - close $fh; - chomp($fcnt); - # Call ssh-keygen - if ($fcnt =~ /^(ssh|ecdsa)-[a-z0-9-]+ [a-zA-Z0-9+=\/]+( .*)?$/ && - `ssh-keygen -l -f $filename 2> /dev/null` =~ /^([0-9]+) +[0-9a-f:]+ +.+ +\(([A-Z]+)\)$/) + if (`ssh-keygen -l -f $filename 2> /dev/null` =~ /^([0-9]+) +[0-9a-f:]+ +.+ +\(([A-Z]+)\)$/) { log INFO, "Receive valid key: type $2, size $1"; if ($2 eq "RSA") { diff --git a/process/projects/gen_grading.pl b/process/projects/gen_grading.pl index 0236b68..b365932 100644 --- a/process/projects/gen_grading.pl +++ b/process/projects/gen_grading.pl @@ -7,6 +7,8 @@ use Carp; use Pod::Usage; use Text::ParseWords; +use lib "../../"; + use ACU::Defense; use ACU::Grading; use ACU::Log; @@ -14,8 +16,6 @@ use ACU::LDAP; use ACU::Process; use ACU::Trace; -$ACU::Log::mail_error = 1; - our $basedir = "/intradata"; sub process @@ -80,7 +80,7 @@ sub process open my $xml, "<", "$basedir/$year/$project_id/traces/$dir/$login" or die $!; binmode $xml; - my $trace = Trace->new(join '', <$xml>); + my $trace = Trace->new($xml); my %tids = %{ $trace->getIds() }; for my $kid (keys %tids) @@ -97,5 +97,4 @@ sub process return $grade->toString; } -Process::set_servers("gearmand:4730"); Process::register_no_parse("gen_grading", \&process); diff --git a/process/projects/get_csv.pl b/process/projects/get_csv.pl index eb1f0f2..3626b2b 100644 --- a/process/projects/get_csv.pl +++ b/process/projects/get_csv.pl @@ -12,8 +12,6 @@ use ACU::Log; use ACU::LDAP; use ACU::Process; -$ACU::Log::mail_error = 1; - our $basedir = "/intradata"; sub process @@ -25,11 +23,14 @@ sub process my $year = shift @args // LDAP::get_year; # Project existing? - croak "Unable to find $project_id in $year" if (! -d "$basedir/$year/$project_id"); + if (! -d "$basedir/$year/$project_id") + { + log ERROR, "Unable to find $project_id in $year"; + return "Unable to find $project_id in $year\n"; + } my %grades; my @headers; - my @averages; opendir(my $dh, "$basedir/$year/$project_id/grades/") or croak "can't opendir $basedir/$year/$project_id/grades/: $!"; for my $gfile (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/grades/$_" } readdir($dh)) @@ -48,10 +49,9 @@ sub process my $i; for ($i = 0; $i <= $#ugrades; $i++) { - if ($ugrades[$i] eq $grade->getAttribute("name")) + if ($ugrades[$i] == $grade->getAttribute("name")) { $ugrades[$i] = $grade->getAttribute("value"); - $averages[$i] += $grade->getAttribute("value"); last; } } @@ -60,7 +60,6 @@ sub process { push @headers, $grade->getAttribute("name"); push @ugrades, $grade->getAttribute("value"); - push @averages, $grade->getAttribute("value"); } } @@ -71,15 +70,12 @@ sub process # Print CSV my $out = "login"; - foreach my $header (@headers) { + for my $header (@headers) { $out .= ",$header"; } $out .= "\n"; - my $nb = 0; - foreach my $login (keys %grades) - { - $nb += 1; + for my $login (keys %grades) { $out .= "$login"; my @ugrades = @{ $grades{$login} }; for my $header (@headers) @@ -95,15 +91,7 @@ sub process $out .= "\n"; } - $out .= "Average"; - foreach my $average (@averages) - { - $out .= ",".($average / $nb); - } - $out .= "\n"; - return $out; } -Process::set_servers("gearmand:4730"); Process::register_no_parse("get_csv", \&process); diff --git a/utils/lpt b/utils/lpt index 1042983..e760ed0 100755 --- a/utils/lpt +++ b/utils/lpt @@ -3,11 +3,7 @@ use v5.10.1; use strict; use warnings; -use utf8; -use open IO => ':utf8'; -use open ':std'; -use Encode qw(decode); use Digest::SHA; use Email::MIME; use File::Find; @@ -73,12 +69,10 @@ my %cmds = my %cmds_account = ( - "add" => \&cmd_account_add, "alias" => \&cmd_account_alias, "close" => \&cmd_account_close, "cn" => \&cmd_account_cn, "create" => \&cmd_account_create, - "delete" => \&cmd_account_delete, "finger" => \&cmd_account_view, "mail" => \&cmd_account_mail, "name" => \&cmd_account_cn, @@ -201,7 +195,7 @@ sub cmd_account_alias($@) return cmd_account_multiple_vieworchange('mailAlias', 'alias', @_); } -sub cmd_account_close($;@) +sub cmd_account_close($@) { my $login = shift; @@ -251,51 +245,12 @@ sub cmd_account_cn($@) return cmd_account_vieworchange('cn', 'name', @_); } -sub cmd_account_add($@) -{ - my $login = shift; - my $passwd_path = shift // "./passwd"; - - if (! -f $passwd_path) - { - log(USAGE, "lpt account add [./passwd] [nopass|passgen|password]"); - return 1; - } - - open my $fh, "<", $passwd_path; - my @passwd_cnt = <$fh>; - close($fh); - - for my $line (grep { /^$login:x/ } @passwd_cnt) - { - if ($line =~ /^$login:x:([0-9]+):([0-9]+):([^ :]+) ?([^:]*):/) - { - my $uid = $1; - my $gid = $2; - my $firstname = ucfirst $3; - my $lastname = ucfirst $4; - - if (! $noconfirm) - { - say "Add user: ", YELLOW, BOLD, "$login", RESET, ":\n\tFirstname: ", BOLD, $firstname, RESET, "\n\tLastname: ", BOLD, $lastname, RESET, "\n\tUID:\t", BOLD, $uid, RESET, "\n\tGroup:\t", BOLD, $gid, RESET; - - print "Would you like to add this user? [", GREEN, "y", RESET, "/", RED, "N", RESET, "] "; - my $go = ; - chomp $go; - next if ($go ne "y" and $go ne "yes"); - } - - cmd_account_create($login, $gid, $uid, $firstname, $lastname, @_); - } - } -} - sub cmd_account_create($@) { my $login = shift; if ($#_ < 3) { - log(USAGE, "lpt account create [nopass|passgen|password]"); + log(USAGE, "lpt account create [nopass|passgen|password]"); return 1; } @@ -304,31 +259,11 @@ sub cmd_account_create($@) log(DEBUG, "Adding dn: uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr ..."); my $ldap = LDAP::ldap_connect(); - - # Check if the OU exists - my $oudn = "ou=$group,ou=users"; - my $ou = LDAP::get_dn($ldap, $oudn); - - if (! $ou) - { - my $mesg = $ldap->add( "$oudn,dc=acu,dc=epita,dc=fr", - attrs => [ - objectclass => [ "top", "organizationalUnit" ], - ou => "$group", - ] - ); - if ($mesg->code == 0) { - log(INFO, "New OU created: $oudn"); - } else { - log(WARN, "Unable to add new OU $oudn: ", RESET, $mesg->error); - } - } - - my $mesg = $ldap->add( "uid=$login,$oudn,dc=acu,dc=epita,dc=fr", + my $mesg = $ldap->add( "uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr", attrs => [ objectclass => [ "top", "epitaAccount" ], uidNumber => shift, - cn => ucfirst(shift(@_))." ".ucfirst(shift(@_)), + cn => shift(@_)." ".shift(@_), mail => "$login\@epita.fr", uid => $login, ] @@ -336,11 +271,10 @@ sub cmd_account_create($@) #$ldap->unbind or die ("couldn't disconnect correctly"); - if ($mesg->code == 0) - { + if ($mesg->code == 0) { log(INFO, "Account added: $login"); - my $pass = shift // "nopass"; - return cmd_account($login, $pass, @_) if ($pass ne "nopass"); + my $pass = shift; + return cmd_account($login, $pass) if ($pass ne "nopass"); return 0; } else { @@ -348,28 +282,6 @@ sub cmd_account_create($@) } } -sub cmd_account_delete($@) -{ - my $login = shift; - - my $ldap = LDAP::ldap_connect(); - - my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login"); - - log(DEBUG, "Deleting dn: $dn ..."); - - if (LDAP::delete_entry($ldap, $dn)) - { - log DONE, "Account ", YELLOW, $login, RESET, " successfully deleted."; - return 0; - } - else - { - log ERROR, "Unable to delete account ", YELLOW, $login, RESET, "."; - return 1; - } -} - sub cmd_account_grantintra($@) { my $login = shift; @@ -388,58 +300,27 @@ sub cmd_account_grantintra($@) sub cmd_account_grantlab($@) { my $login = shift; - my $group = shift // ""; + my $group = shift; - if ($group ne "acu" && $group ne "yaka" && $group ne "ferry") - { - log(USAGE, "lpt account grant-lab "); + if ($group ne "acu" && $group ne "yaka") { + log(USAGE, "lpt account grantlab "); return 1; } my $ldap = LDAP::ldap_connect(); my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login"); - my $entry = LDAP::get_dn($ldap, $dn, "objectClass", "mail", "mailAlias", "mailAccountActive", "loginShell", "homeDirectory", "gidNumber"); if (!LDAP::get_attribute($ldap, $dn, "mail")) { LDAP::add_attribute($ldap, $dn, "mail", "$login\@epita.fr"); } - if ($group eq "acu" || $group eq "yaka") - { - if (! grep { $_ eq "MailAccount" } @{ $entry->get_value("objectClass") }) - { - $entry->replace("mailAccountActive" => [ "yes" ]); + LDAP::add_attribute($ldap, $dn, "mailAlias", "$login\@$group.epita.fr"); + LDAP::update_attribute($ldap, $dn, "mailAccountActive", "yes"); + LDAP::add_attribute($ldap, $dn, "objectClass", "MailAccount"); + LDAP::add_attribute($ldap, $dn, "objectClass", "labAccount"); - my @oc = $entry->get_value("objectClass"); - push @oc, "MailAccount"; - $entry->replace("objectClass" => \@oc); - - my @aliases = $entry->get_value("mailAlias"); - push @aliases, "$login\@$group.epita.fr"; - $entry->replace("objectClass" => \@aliases); - } - - $entry->replace("loginShell" => [ "/bin/zsh" ]) if ($entry->get_value("loginShell")); - $entry->replace("homeDirectory" => [ "/home/201X/$login" ]) if ($entry->get_value("homeDirectory")); - $entry->replace("gidNumber" => [ "4242" ]) if ($entry->get_value("gidNumber")); - } - elsif ($group eq "ferry") - { - $entry->replace("loginShell" => [ "/bin/noexists" ]); - $entry->replace("homeDirectory" => [ "/dev/null" ]); - $entry->replace("gidNumber" => [ "4243" ]); - } - - my @oc = $entry->get_value("objectClass"); - push @oc, "labAccount"; - $entry->replace("objectClass" => \@oc); - - my $mesg = $entry->update($ldap) or die $!; - if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; } - - log(INFO, "$login now grants to receive e-mail and connect in laboratory.") if ($group eq "acu" || $group eq "yaka"); - log(INFO, "$login now grants to connect in laboratory for exam.") if ($group eq "ferry"); + log(INFO, "$login now grants to receive e-mail and connect in laboratory."); $ldap->unbind or die ("couldn't disconnect correctly"); } @@ -881,7 +762,7 @@ sub cmd_groups($@) if ($gname && $gname =~ /^(2[0-9]{3})$/) { - $ou = "ou=$1,$ou"; + $ou = "year=$1,$ou"; $gname = shift; } @@ -1088,7 +969,7 @@ sub cmd_group_create log(DEBUG, "Adding dn: cn=$gname,ou=intra,ou=groups,dc=acu,dc=epita,dc=fr ..."); - my $dn = "cn=$gname,$ou"; + my $dn = "cn=$gname,$ou,dc=acu,dc=epita,dc=fr"; my $class; $class = "intraGroup" if ($ou ne $group_types{system}); @@ -1100,7 +981,7 @@ sub cmd_group_create }; log(ERROR, $@) if ($@); - my $mesg = $ldap->add( $dn . ",dc=acu,dc=epita,dc=fr", + my $mesg = $ldap->add( $dn, attrs => [ objectclass => [ "top", $class ], cn => $gname, @@ -1124,7 +1005,7 @@ sub cmd_group_delete(@) my $ou = shift; my $gname = shift; - my $dn = "cn=$gname,$ou"; + my $dn = "cn=$gname,$ou,dc=acu,dc=epita,dc=fr"; log(DEBUG, "Deleting dn: $dn ..."); @@ -1449,7 +1330,7 @@ sub cmd_account_quota_sync($;$) my $quotaSgoinfreBlock = $entry->get_value("quotaSgoinfreBlock") // $def_quota{block}{sgoinfre}; my $quotaSgoinfreFile = $entry->get_value("quotaSgoinfreFile") // $def_quota{file}{sgoinfre}; - require Quota; + require "Quota"; if (Quota::setqlim($dev_quota{home}, $entry->get_value("uidNumber"), int(0.9 * $quotaHomeBlock), $quotaHomeBlock, int(0.9 * $quotaHomeFile), $quotaHomeFile, 1, 0) == 0 and Quota::setqlim($dev_quota{sgoinfre}, $entry->get_value("uidNumber"), int(0.9 * $quotaSgoinfreBlock), $quotaSgoinfreBlock, int(0.9 * $quotaSgoinfreFile), $quotaSgoinfreFile, 1, 0) == 0) { @@ -1473,7 +1354,7 @@ sub cmd_account_quota_sync($;$) sub cmd_sync_quota(@) { - require Quota; + require "Quota"; # Set root quota Quota::setqlim($dev_quota{home}, 0, 0, 0, 0, 0, 1, 0); @@ -1536,7 +1417,7 @@ sub get_no_strong_auth_user() my $token = $home . "/.google_authenticator"; my $login = $entry->get_value("uid"); - push @faulty_users, $entry if (! -f $token || -s $token < 90); + push @faulty_users, $entry if (! -f $token || -s $token < 100); } $ldap->unbind or die ("couldn't disconnect correctly"); @@ -1556,8 +1437,7 @@ sub cmd_no_strong_auth_view(@) sub cmd_no_strong_auth_warn(@) { - require Email::Sender::Simple; - Email::Sender::Simple->import(qw(sendmail)); + require "Email::Sender::Simple"; for my $entry (get_no_strong_auth_user()) { @@ -1565,11 +1445,11 @@ sub cmd_no_strong_auth_warn(@) say $entry->get_value("uid"); - my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).", + my $body = "Bonjour ".$entry->get_value("cn").", -Vous n'avez pas activé l'authentification forte pour SSH. +Vous n'avez pas activé l'authentification forte pour SSH. -Pour connaître la marche à suivre pour l'activer, consultez : +Pour connaître la marche à suivre pour l'activer, consultez : https://www.acu.epita.fr/wiki/index.php?title=Ssh_double_factor_auth Merci de rectifier la situation au plus vite ou votre compte sera mis @@ -1577,8 +1457,8 @@ en suspens. Cordialement, -P.-S. : Ce message est généré automatiquement, les roots sont en copie. - Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr +P.-S. : Ce message est généré automatiquement, les roots sont en copie. + Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr -- Les roots ACU"; @@ -1590,21 +1470,15 @@ Les roots ACU"; Cc => 'Roots assistants ', Subject => "[PILA][AUTH-FORTE] Authentification forte SSH non active" ], - attributes => { - encoding => 'quoted-printable', - charset => 'utf-8', - format => 'flowed', - }, body_str => $body, ); - sendmail($mail); + Email::Sender::Simple::sendmail($mail); } } sub cmd_no_strong_auth_close(@) { - require Email::Sender::Simple; - Email::Sender::Simple->import(qw(sendmail)); + require "Email::Sender::Simple"; for my $entry (get_no_strong_auth_user()) { @@ -1612,14 +1486,12 @@ sub cmd_no_strong_auth_close(@) say $entry->get_value("uid"); - cmd_account_close($entry->get_value("uid")); + my $body = "Bonjour ".$entry->get_value("cn").", - my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).", +Après plusieurs relances de notre part, vous n'avez toujours pas activé +l'authentification forte pour SSH. Votre compte a donc été suspendu. -Après plusieurs relances de notre part, vous n'avez toujours pas activé -l'authentification forte pour SSH. Votre compte a donc été suspendu. - -Nous vous invitons à passer au laboratoire pour faire réactiver votre +Nous vous invitons à passer au laboratoire pour faire réactiver votre compte. Cordialement, @@ -1635,14 +1507,9 @@ Les roots ACU"; Cc => 'Roots assistants ', Subject => "[PILA][ACCES] Compte suspendu" ], - attributes => { - encoding => 'quoted-printable', - charset => 'utf-8', - format => 'flowed', - }, body_str => $body, ); - sendmail($mail); + Email::Sender::Simple::sendmail($mail); } } @@ -1764,8 +1631,7 @@ sub cmd_ssh_keys_without_passphrase_view(@) # warn about unprotected keys sub cmd_ssh_keys_without_passphrase_warn(@) { - require Email::Sender::Simple; - Email::Sender::Simple->import(qw(sendmail)); + require "Email::Sender::Simple"; my $process = sub() { my $entry = shift; @@ -1774,13 +1640,13 @@ sub cmd_ssh_keys_without_passphrase_warn(@) # Display say $entry->get_value("uid"); - my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).", + my $body = "Bonjour ".$entry->get_value("cn").", -Un outil automatique a découvert une clef sans passphrase sur votre compte -du laboratoire. Il est impératif de mettre une passphrase chiffrant votre -clef pour des raisons de sécurité. +Un outil automatique a découvert une clef sans passphrase sur votre compte +du laboratoire. Il est impératif de mettre une passphrase chiffrant votre +clef pour des raisons de sécurité. -Les clefs non protégées sont les suivantes :\n"; +Les clefs non protégées sont les suivantes :\n"; foreach my $key (@$keys) { $key =~ s#^$nfsHomePrefix#$wksHomePrefix#; @@ -1789,13 +1655,13 @@ Les clefs non protégées sont les suivantes :\n"; $body .= "\nPour mettre une passphrase : \$ ssh-keygen -p -f CHEMIN_VERS_LA_CLE_PRIVEE -Merci de rectifier la situation au plus vite ou votre clé sera supprimée et +Merci de rectifier la situation au plus vite ou votre clé sera supprimée et votre compte sera mis en suspens. Cordialement, -PS: Ce message est généré automatiquement, les roots sont en copie. - Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr +PS: Ce message est généré automatiquement, les roots sont en copie. + Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr -- Les roots ACU"; @@ -1806,16 +1672,11 @@ Les roots ACU"; From => "Roots assistants ", To => $entry->get_value("mailAlias"), Cc => 'Roots assistants ', - Subject => "[PILA][SSH-KEY] Clef SSH non protégée" + Subject => "[PILA][SSH-KEY] Clef SSH non protégée" ], - attributes => { - encoding => 'quoted-printable', - charset => 'utf-8', - format => 'flowed', - }, body_str => $body, ); - sendmail($mail); + Email::Sender::Simple::sendmail($mail); }; cmd_ssh_keys_without_passphrase_generic(\&$process); @@ -1824,8 +1685,7 @@ Les roots ACU"; # remove unprotected keys sub cmd_ssh_keys_without_passphrase_remove(@) { - require Email::Sender::Simple; - Email::Sender::Simple->import(qw(sendmail)); + require "Email::Sender::Simple"; my $process = sub() { my $entry = shift; @@ -1835,15 +1695,15 @@ sub cmd_ssh_keys_without_passphrase_remove(@) say $entry->get_value("uid"); # create the message - my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).", + my $body = "Bonjour ".$entry->get_value("cn").", -Un outil automatique a découvert une clef sans passphrase sur votre +Un outil automatique a découvert une clef sans passphrase sur votre compte du laboratoire. -N'ayant pas corrigé votre situation après plusieurs relances, nous avons -désactivé votre compte et supprimé le(s) clef(s) incriminées. +N'ayant pas corrigé votre situation après plusieurs relances, nous avons +désactivé votre compte et supprimé le(s) clef(s) incriminées. -Pour information, voici l'empreinte de chacune des clefs supprimée :\n"; +Pour information, voici l'empreinte de chacune des clefs supprimée :\n"; foreach my $key (@$keys) { open (FNGR, "ssh-keygen -l -f '$key' | cut -d ' ' -f 2 |"); @@ -1861,8 +1721,8 @@ Contacter les roots pour faire reouvrir votre compte. Cordialement, -PS: Ce message est généré automatiquement, les roots sont en copie. - Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr +PS: Ce message est généré automatiquement, les roots sont en copie. + Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr -- Les roots ACU"; @@ -1872,16 +1732,11 @@ Les roots ACU"; From => "Roots assistants ", To => $entry->get_value("mailAlias"), Cc => 'Roots assistants ', - Subject => "[PILA][SSH-KEY] Clef SSH non protégée supprimée" + Subject => "[PILA][SSH-KEY] Clef SSH non protégée supprimée" ], - attributes => { - encoding => 'quoted-printable', - charset => 'utf-8', - format => 'flowed', - }, body_str => $body, ); - sendmail($mail); + Email::Sender::Simple::sendmail($mail); }; cmd_ssh_keys_without_passphrase_generic(\&$process); @@ -1990,12 +1845,6 @@ B [I [I [I [...]]]] If are given, display only those attributes. -B I [./passwd] [nopass|password|passgen] - - This is used to create a new Epita account, base for intra and/or lab account. - - This will use the passwd file given in argument to import information about the login. - B I [nopass|password|passgen] This is used to create a new Epita account, base for intra and/or lab account. @@ -2006,12 +1855,10 @@ B I Give rights to the user to access the intranet. -B I +B I 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 I Give rights to the user to receive e-mails. @@ -2024,11 +1871,6 @@ B I This is used to close an existing account. -B I - - This is used to delete an existing account. - NEVER DELETE AN ACCOUNT, close it instead. - B I [new-mail] This is used to display, or change if [new-mail] is given, the account contact adress.