Archived
1
0
Fork 0

Compare commits

...

178 commits

Author SHA1 Message Date
Charlie Noyce Root
b8d4ff1a58 Revert "Multi-thread grades generation"
This reverts commit 2e5b2af4d8.
2014-01-17 02:17:41 +01:00
Mercier Pierre-Olivier
2e5b2af4d8 Multi-thread grades generation 2014-01-17 01:52:20 +01:00
Mercier Pierre-Olivier
8ddca7c49a Fix format of who tags 2014-01-17 00:05:44 +01:00
Mercier Pierre-Olivier
767a4f9be2 Trace printer handles <who/> tags 2014-01-16 23:32:52 +01:00
Mercier Pierre-Olivier
24df9247e7 Bonus/malus are now individual by default 2014-01-16 23:25:03 +01:00
Mercier Pierre-Olivier
4877749a76 Implement delId method for traces 2014-01-15 19:43:22 +01:00
Mercier Pierre-Olivier
b38f15b0b6 Allow negative bonus 2014-01-15 00:40:41 +01:00
Mercier Pierre-Olivier
aa3b69f5b3 Grades: fix globing exponentiation 2014-01-14 00:58:44 +01:00
Mercier Pierre-Olivier
6e70dc24ff lpt: new command account add to import account information from passwd like file. Closes #22244 2014-01-12 06:27:12 +01:00
Mercier Pierre-Olivier
e9ea5fc3a5 Solve #22243 2014-01-12 05:54:35 +01:00
Mercier Pierre-Olivier
cb9bf00da4 check_ssh_key: now check file content before type validity 2014-01-12 05:02:00 +01:00
Mercier Pierre-Olivier
6dca90348a New git_str format: allow moulettes to push tags begining by ACU- 2014-01-12 05:01:29 +01:00
Mercier Pierre-Olivier
1a25069726 New moulette command: can send a tarball (e.g.: for exam) 2014-01-12 05:00:57 +01:00
Mercier Pierre-Olivier
5e174fc053 New moulette command: can set max_memory variable 2014-01-12 05:00:24 +01:00
Mercier Pierre-Olivier
8170216edc Add debug 2014-01-09 21:44:47 +01:00
Mercier Pierre-Olivier
f5ff3c83b3 Grades from defenses are now the same for the group 2014-01-09 18:00:29 +01:00
Mercier Pierre-Olivier
ea711bc7bc Ticket #22238 2013-12-22 11:44:22 +01:00
Mercier Pierre-Olivier
c6352b8897 Set a default ID on eval without id 2013-12-20 17:35:22 +01:00
Mercier Pierre-Olivier
5b1382fc71 pizzin_a allowed to push erlear 2013-12-19 09:04:57 +01:00
Mercier Pierre-Olivier
3a5dbc55a8 Add new APPING3 for TC 2013-12-18 21:22:38 +01:00
Mercier Pierre-Olivier
3e5a587dd1 Allow LSE to connect to project-lse repo 2013-12-18 19:13:06 +01:00
Mercier Pierre-Olivier
65e2f61319 Fix connection to gearman server 2013-12-15 18:31:46 +01:00
Mercier Pierre-Olivier
929d146770 Ticket #22220: Two new habitent_loin 2013-12-15 12:17:33 +01:00
Mercier Pierre-Olivier
700002396b Add Apping2/3 to habitent_loin exception 2013-12-12 10:19:01 +01:00
Mercier Pierre-Olivier
33222d78c5 Fix defense_id generation 2013-12-12 05:42:57 +01:00
Mercier Pierre-Olivier
744c3db27c Fix account creation 2013-12-09 22:53:42 +01:00
Mercier Pierre-Olivier
531864ef8d Allow . in defense filename 2013-12-09 18:48:52 +01:00
Mercier Pierre-Olivier
cdb64f192f Mark ACU- and YAKA- as reserved tag 2013-12-08 08:28:49 +01:00
Mercier Pierre-Olivier
0e3fe1fd1c Exception, ticket #22149 2013-12-06 16:33:56 +01:00
Mercier Pierre-Olivier
737a12d443 Excpetion 2013-12-06 00:10:03 +01:00
Mercier Pierre-Olivier
eb8c74d465 Add action flush to stats 2013-12-05 07:19:20 +01:00
Mercier Pierre-Olivier
4482f47eec Fix set_workers 2013-12-05 06:48:42 +01:00
Mercier Pierre-Olivier
874c6bc482 Fix moulette/launch: can pass more than one login 2013-12-05 06:44:50 +01:00
Mercier Pierre-Olivier
4d003d6626 Add new moulette command: set_workers 2013-12-05 06:44:43 +01:00
Mercier Pierre-Olivier
3c60afe6e9 Fix stats 2013-12-05 06:05:24 +01:00
Mercier Pierre-Olivier
81150b41fe Fix stats 2013-12-05 06:03:28 +01:00
Mercier Pierre-Olivier
0e0a93789e Add new command for moulette: stats 2013-12-05 06:01:52 +01:00
Mercier Pierre-Olivier
973bc3f7b1 send_git: fix ACU- 2013-12-05 05:59:06 +01:00
Mercier Pierre-Olivier
95f945f963 send_git: ACU- 2013-12-05 05:55:35 +01:00
Mercier Pierre-Olivier
ba19732a47 post-update hook: ACU- 2013-12-05 05:00:09 +01:00
Mercier Pierre-Olivier
4af0617cae Receive ACU-* tags 2013-12-05 01:09:55 +01:00
Mercier Pierre-Olivier
d1b027a3ff Autoflush log filehandles 2013-12-05 00:54:30 +01:00
Mercier Pierre-Olivier
4e1e73f284 Add intradmin-hamano to gen_git_str for send_git process 2013-12-05 00:54:04 +01:00
Mercier Pierre-Olivier
6d294dbcf6 Save witch person push or clone to a repo 2013-12-03 01:08:47 +01:00
Mercier Pierre-Olivier
15408c1144 Remove INFO submission 2013-12-02 23:33:39 +01:00
Mercier Pierre-Olivier
45ba55a416 New hooks version: allow ACU-* tags 2013-12-02 21:11:17 +01:00
Mercier Pierre-Olivier
868324e6e2 Remove git access from VJ 2013-12-02 18:21:06 +01:00
Mercier Pierre-Olivier
f6a96399c2 New gen_git_str 2013-12-02 18:20:10 +01:00
Mercier Pierre-Olivier
2520bf59a3 Fix gearmand server destination 2013-12-01 17:37:09 +01:00
Mercier Pierre-Olivier
1e9e89656d Add DEBUG string 2013-12-01 06:16:51 +01:00
Mercier Pierre-Olivier
aef2b7d71e Add part for guantanamo.tar.gz 2013-12-01 06:12:27 +01:00
Mercier Pierre-Olivier
bbde682896 Try a fix 2013-12-01 06:04:37 +01:00
Mercier Pierre-Olivier
d077a5933f Try a fix 2013-12-01 05:58:19 +01:00
Mercier Pierre-Olivier
faf03232f4 Tiny fixes 2013-12-01 04:21:04 +01:00
Mercier Pierre-Olivier
05c7f4b9c6 Add DEBUG log 2013-12-01 03:40:12 +01:00
Mercier Pierre-Olivier
810c589ec0 Git hook exception (VJ + #22077) 2013-12-01 01:44:20 +01:00
Mercier Pierre-Olivier
24170b0b4e CPP is now the guantanamo master 2013-12-01 01:14:35 +01:00
Mercier Pierre-Olivier
415b5c81fd Use multiple Gearman servers 2013-12-01 01:12:02 +01:00
Mercier Pierre-Olivier
16f3dbfecb New guantanomo_list command 2013-11-30 22:32:21 +01:00
Mercier Pierre-Olivier
9de4ca25b0 Guantanamo: add list action to master process 2013-11-30 22:24:34 +01:00
Mercier Pierre-Olivier
971851633d Add execution right to lpt 2013-11-29 18:17:42 +01:00
Root Cpp Charlie
67d851658c Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-29 18:14:08 +01:00
Mercier Pierre-Olivier
55bec752b5 Really close account when strong-auth close 2013-11-29 17:37:52 +01:00
Mercier Pierre-Olivier
ad2748650b Guantanamo: avoid deadlock by sending register action in background 2013-11-28 20:32:49 +01:00
Mercier Pierre-Olivier
a0f9002efd Guantanamo: use sh to parse command 2013-11-28 20:28:52 +01:00
Mercier Pierre-Olivier
5fe1d4c80d Fix utf-8 2013-11-27 15:26:13 +01:00
Mercier Pierre-Olivier
dfb66035eb New hook post-update 2013-11-26 19:17:19 +01:00
Mercier Pierre-Olivier
84c34f8fea Fix guantanamo syntax 2013-11-25 19:20:03 +01:00
Root Cpp Charlie
605007fb56 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-24 01:08:20 +01:00
Mercier Pierre-Olivier
9c3ebb5139 Ok 2013-11-24 01:08:11 +01:00
Root Cpp Charlie
b69c30d3d0 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-24 01:05:32 +01:00
Mercier Pierre-Olivier
db6814f4de Only last directory is repo_name 2013-11-24 01:05:08 +01:00
Mercier Pierre-Olivier
8929aba28d Add dufour_h exception 2013-11-23 23:20:34 +01:00
Mercier Pierre-Olivier
cddafdf0ad Exceptions 2013-11-23 21:13:11 +01:00
Mercier Pierre-Olivier
3a00d6344a Faster grading 2013-11-23 20:30:20 +01:00
Mercier Pierre-Olivier
6e655751d4 Ok :) 2013-11-23 20:11:53 +01:00
Mercier Pierre-Olivier
be336da8d6 Try to fix grades 2013-11-23 20:08:03 +01:00
Mercier Pierre-Olivier
b4fc037a06 glob_to_regex 2013-11-23 17:31:16 +01:00
Mercier Pierre-Olivier
f271f36203 Use Text::Glob instead of ACU::Tinyglob 2013-11-23 17:21:46 +01:00
Mercier Pierre-Olivier
f8e5d1b5c0 Fix grades generation 2013-11-23 04:18:32 +01:00
Mercier Pierre-Olivier
37dde8ce57 Fix API::Projects::get_groups 2013-11-23 03:09:53 +01:00
Mercier Pierre-Olivier
ce15c69841 Habitent loin : molini_v 2013-11-22 21:11:36 +01:00
Mercier Pierre-Olivier
a02ed70d5d Trace: fix warnings 2013-11-21 21:28:45 +01:00
Mercier Pierre-Olivier
7f418a06fe Fix API call 2013-11-21 21:01:14 +01:00
Mercier Pierre-Olivier
44722fdd93 Fix denfense publication 2013-11-21 14:47:36 +01:00
Mercier Pierre-Olivier
b25a862650 Fix condition 2013-11-20 01:45:30 +01:00
Mercier Pierre-Olivier
1d0d92b040 Add traces for debug 2013-11-20 01:13:54 +01:00
Mercier Pierre-Olivier
26f58dcaa6 Add log 2013-11-20 01:04:30 +01:00
Mercier Pierre-Olivier
49e5dcddf4 Remove old .ft 2013-11-20 00:54:01 +01:00
Mercier Pierre-Olivier
f02f484cb8 gen_grades: better resolution of names 2013-11-18 22:28:10 +01:00
Mercier Pierre-Olivier
555c922786 send_git: Year can be omitted 2013-11-18 18:57:30 +01:00
Mercier Pierre-Olivier
dcb6033caa Add new scripts for moulettes 2013-11-16 21:45:25 +01:00
Mercier Pierre-Olivier
db62048be2 Hook: Use GL_USER instead of repo_login 2013-11-16 13:32:39 +01:00
Root Cpp Charlie
58f77270c2 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-15 12:41:49 +01:00
Mercier Pierre-Olivier
2f6b3a9812 Fix LDAP search 2013-11-15 12:40:29 +01:00
Root Cpp Charlie
3d3dfc47c0 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-15 09:22:00 +01:00
Mercier Pierre-Olivier
984cb050fa Allow .google-authenticator under 100b 2013-11-15 09:21:33 +01:00
Root Cpp Charlie
f38abe3547 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-15 09:07:31 +01:00
Mercier Pierre-Olivier
77bee709ed LDAP name convert to IPv6 2013-11-15 09:04:45 +01:00
Root Cpp Charlie
628dd6ab5c Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-15 08:50:09 +01:00
Mercier Pierre-Olivier
a809c4ff8d COnvert to UTF8 lpt 2013-11-15 08:49:59 +01:00
Root Cpp Charlie
e48f136bca Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-15 08:48:49 +01:00
Mercier Pierre-Olivier
1d5562b073 New repo.sh migration 2013-11-15 08:39:52 +01:00
Root Cpp Charlie
239a636167 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-14 20:34:20 +01:00
Mercier Pierre-Olivier
9bcf8c7c2d Update gl-pre-git exceptions 2013-11-14 20:34:12 +01:00
Root Cpp Charlie
8c50d5954b Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-14 17:35:23 +01:00
Mercier Pierre-Olivier
b959187718 Fix sendmail 2013-11-14 17:35:14 +01:00
Root Cpp Charlie
dd01b53d68 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-14 16:20:32 +01:00
Mercier Pierre-Olivier
5247d4db53 Add sendmail option 2013-11-14 16:20:13 +01:00
Mercier Pierre-Olivier
947aebd490 Add sendmail option 2013-11-14 16:09:24 +01:00
Mercier Pierre-Olivier
33e32d2916 Add charset to sended log email 2013-11-14 16:03:30 +01:00
Root Cpp Charlie
a02881f42e Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-14 15:58:34 +01:00
Mercier Pierre-Olivier
a4076fe953 Add Email::Sender::Simple as require deb pkg 2013-11-14 15:56:48 +01:00
Root Cpp Charlie
5a83714dad Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-14 15:50:54 +01:00
Mercier Pierre-Olivier
54b407fa11 Fix requires Email::Sender::Simple thanks to TIBO 2013-11-14 15:47:25 +01:00
Mercier Pierre-Olivier
e11d9082da Activate mail_error on grading script 2013-11-14 15:26:17 +01:00
Mercier Pierre-Olivier
95c6d77613 Fix gen_grading due to lastest modification 2013-11-14 14:19:45 +01:00
Mercier Pierre-Olivier
bedb084ffe Add average in cvs 2013-11-13 03:07:56 +01:00
Mercier Pierre-Olivier
e2ba0a5e38 Remove exception #21858 2013-11-13 03:00:55 +01:00
Charlie Noyce Root
ca2c0e8f13 Fix get_csv 2013-11-13 02:33:27 +01:00
Mercier Pierre-Olivier
4a66e85060 Fix warning order in process return 2013-11-13 01:29:53 +01:00
Mercier Pierre-Olivier
bdef5a3c69 New error if project doesn't exists 2013-11-13 01:15:01 +01:00
Mercier Pierre-Olivier
c5a1bf8917 Display important warnings on process return 2013-11-13 01:12:05 +01:00
Mercier Pierre-Olivier
4e35cabf62 Display warnings on process return 2013-11-13 01:01:04 +01:00
Mercier Pierre-Olivier
0e92592d17 Fixing method name 2013-11-13 00:25:36 +01:00
Mercier Pierre-Olivier
6e3cbe7f04 Fixing syntax 2013-11-13 00:22:19 +01:00
Mercier Pierre-Olivier
81fd3a04e2 Trace: can export as string, can addId 2013-11-13 00:09:54 +01:00
Mercier Pierre-Olivier
5d2b1e80fb Merge repo.sh with aurier_j version 2013-11-11 17:57:27 +01:00
Mercier Pierre-Olivier
464fcfc879 Fixing grading 2013-11-11 17:16:03 +01:00
Mercier Pierre-Olivier
74f44a836b Forgotten use 2013-11-11 16:59:14 +01:00
Mercier Pierre-Olivier
fc595e9ee4 Fix warning 2013-11-11 16:57:44 +01:00
Mercier Pierre-Olivier
62bd5f2d2a Fix warning 2013-11-11 16:37:36 +01:00
Mercier Pierre-Olivier
add1bb5db9 Change output form of getIds 2013-11-11 16:35:34 +01:00
Mercier Pierre-Olivier
81058c9c20 Change input form of Trce 2013-11-11 16:32:50 +01:00
Mercier Pierre-Olivier
ddb8788eb6 Import API 2013-11-11 16:23:23 +01:00
Mercier Pierre-Olivier
440ace2654 Fix syntax 2013-11-11 16:15:59 +01:00
Mercier Pierre-Olivier
15f89a5e39 New parser for traces 2013-11-11 16:09:53 +01:00
Mercier Pierre-Olivier
1de1b9a221 New exception 2013-11-09 17:42:59 +01:00
Mercier Pierre-Olivier
584fbf9895 Add APPING1 to exception 2013-11-08 21:05:05 +01:00
Mercier Pierre-Olivier
cda7b5b026 LPT: fix grant-lab and add delete account capability 2013-11-07 14:46:28 +01:00
Mercier Pierre-Olivier
de88e60fa5 Fix too much kill of ssh-agent 2013-11-06 18:22:07 +01:00
Mercier Pierre-Olivier
8a4b545da6 chdir before remove dir 2013-11-06 18:13:08 +01:00
Mercier Pierre-Olivier
90727e48d5 Fix errors 2013-11-06 18:11:17 +01:00
Mercier Pierre-Olivier
0af1174ca8 Replace croak by die when unexpected error 2013-11-05 18:03:54 +01:00
Mercier Pierre-Olivier
fe9cc480a1 Add install procedure into manage-server 2013-11-05 17:41:12 +01:00
Mercier Pierre-Olivier
3c0e0f09be Migration: migrate also .ltx files 2013-11-05 17:41:12 +01:00
Nicolas Geniteau
92a222d346 hook dump-help 2013-11-05 17:37:03 +01:00
Root Cpp Charlie
45bae3f39b Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-04 02:24:12 +01:00
Root Cpp Charlie
2f7839952c Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-03 01:19:26 +01:00
Root Cpp Charlie
7fc46ddbd4 Merge branch 'master' of ssh://cpp/liblerdorf 2013-11-03 00:37:04 +01:00
Root Cpp Charlie
da5683bb5c Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-31 16:16:09 +01:00
Root Cpp Charlie
9ff6402d87 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-28 15:13:24 +01:00
Root Cpp Charlie
7214b54053 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-23 06:57:22 +02:00
Root Cpp Charlie
49bbc958a5 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-18 18:33:52 +02:00
Root Cpp Charlie
6a81847871 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-18 18:31:33 +02:00
Root Cpp Charlie
578b4ac41b Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-07 20:19:31 +02:00
Root Cpp Charlie
814d3ba2ef Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-07 16:42:17 +02:00
Root Cpp Charlie
be18f40353 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-04 19:08:49 +02:00
Root Cpp Charlie
25008035eb Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-02 22:08:48 +02:00
Root Cpp Charlie
4c53e2ad06 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-02 22:02:48 +02:00
Root Cpp Charlie
5ab6774a69 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-02 20:12:53 +02:00
Root Cpp Charlie
25d57a260f Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-02 19:45:54 +02:00
Root Cpp Charlie
d3444fac41 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-02 18:31:29 +02:00
Root Cpp Charlie
f26a78b252 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-02 18:26:22 +02:00
Root Cpp Charlie
e2a3babac6 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-01 05:30:47 +02:00
Root Cpp Charlie
11812fc1f6 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-01 04:57:58 +02:00
Root Cpp Charlie
e06bfc5f72 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-01 04:37:25 +02:00
Root Cpp Charlie
e9cc885e05 Merge branch 'master' of ssh://cpp/liblerdorf 2013-10-01 00:08:52 +02:00
Root Cpp Charlie
879b6890a5 Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-30 13:13:02 +02:00
Root Cpp Charlie
757733176b Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-30 13:08:55 +02:00
Mercier Pierre-Olivier
7a192c4732 Globbing in grading is not critical 2013-09-30 13:08:38 +02:00
Root Cpp Charlie
98efe85166 Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-30 10:53:35 +02:00
Root Cpp Charlie
c6b1936cb2 Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-30 10:28:07 +02:00
Root Cpp Charlie
d29eb9a33e Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-28 19:01:40 +02:00
Root Cpp Charlie
f3cfbf6dbb Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-28 13:47:19 +02:00
Root Cpp Charlie
3fceded838 Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-28 13:44:31 +02:00
Root Cpp Charlie
ccf622c98e Merge branch 'master' of ssh://cpp/liblerdorf 2013-09-28 11:16:48 +02:00
Mercier Pierre-Olivier
a1e0e62b9c Check IP in gl-pre-git hook 2013-09-28 11:15:31 +02:00
40 changed files with 1654 additions and 532 deletions

View file

@ -105,8 +105,10 @@ sub send($$$)
log(DEBUG, 'POST Request to ', API_URL, $url); log(DEBUG, 'POST Request to ', API_URL, $url);
my $req = POST API_URL . $url, shift; my $req = POST API_URL . $url, shift;
my $cnt = $ua->request($req)->content; my $res = $ua->request($req);
log TRACE, $res;
my $cnt = $res->content();
log TRACE, $cnt; log TRACE, $cnt;
return parse($next, $cnt); return parse($next, $cnt);
@ -247,8 +249,7 @@ sub new ($$)
my $class = shift; my $class = shift;
my $self = { my $self = {
parsed => shift, parsed => shift,
inStd => 0, savValue => 0,
inResult => 0,
lastGroup => {}, lastGroup => {},
values => "" values => ""
}; };
@ -262,14 +263,10 @@ sub start_element
{ {
my ($self, $element) = @_; my ($self, $element) = @_;
if ($element->{Name} eq "result") { if ($element->{Name} eq "student")
$self->{parsed}{result} = $self->{values};
$self->{inResult} = 0;
$self->{values} = "";
}
elsif ($element->{Name} eq "student")
{ {
$self->{inStd} = 1; $self->{values} = "";
$self->{savValue} = 1;
push @{ $self->{lastGroup}{stds} }, { push @{ $self->{lastGroup}{stds} }, {
id => $element->{Attributes}{"{}id"}{Value}, id => $element->{Attributes}{"{}id"}{Value},
chief => $element->{Attributes}{"{}chief"}{Value}, chief => $element->{Attributes}{"{}chief"}{Value},
@ -281,13 +278,18 @@ sub start_element
$self->{lastGroup}{id} = $element->{Attributes}{"{}id"}{Value}; $self->{lastGroup}{id} = $element->{Attributes}{"{}id"}{Value};
$self->{lastGroup}{stds} = []; $self->{lastGroup}{stds} = [];
} }
elsif ($element->{Name} eq "result")
{
$self->{values} = "";
$self->{savValue} = 1;
}
} }
sub characters sub characters
{ {
my ($self, $characters) = @_; my ($self, $characters) = @_;
if ($self->{inStd}) { if ($self->{savValue}) {
$self->{values} .= $characters->{Data}; $self->{values} .= $characters->{Data};
} }
} }
@ -296,13 +298,16 @@ sub end_element
{ {
my ($self, $element) = @_; my ($self, $element) = @_;
if ($element->{Name} eq "group") if ($element->{Name} eq "result")
{
$self->{parsed}{result} = $self->{values};
$self->{savValue} = 0;
}
elsif ($element->{Name} eq "group")
{ {
push @{ $self->{parsed}{groups} }, $self->{lastGroup}; push @{ $self->{parsed}{groups} }, $self->{lastGroup};
$self->{lastGroup} = {}; $self->{lastGroup} = {};
$self->{savValue} = 0;
$self->{inStd} = 0;
$self->{values} = "";
} }
elsif ($element->{Name} eq "student") elsif ($element->{Name} eq "student")
{ {

View file

@ -16,7 +16,7 @@ sub add($$;$)
my $flavor = shift; my $flavor = shift;
my $year = shift; my $year = shift;
if ($year and $year != LDAP::get_year) { if ($year and $year ne LDAP::get_year) {
croak "Impossible d'ajouter un projet d'une autre année : non implémenté"; croak "Impossible d'ajouter un projet d'une autre année : non implémenté";
} }
@ -90,10 +90,9 @@ sub get_groups($;$)
my $res = API::Base::get('ProjectGroupHandler', $url); my $res = API::Base::get('ProjectGroupHandler', $url);
#TODO: uncomment-me if ($res->{result} ne '0') {
#if ($res->{result} ne '0') { croak "Erreur durant la récupération : " . $res->{message};
# croak "Erreur durant la récupération : " . $res->{message}; }
#}
return $res; return $res;
} }
@ -103,7 +102,10 @@ sub add_grades($;$)
my %data = ( my %data = (
project_name => shift project_name => shift
); );
$data{year} = $_ if (shift); my $y = shift;
if ($y) {
$data{year} = $y;
}
my $res = API::Base::send('ResultHandler', "projects/notes/add.xml", \%data); my $res = API::Base::send('ResultHandler', "projects/notes/add.xml", \%data);
@ -120,7 +122,10 @@ sub add_traces($$;$)
project_name => shift, project_name => shift,
trace_name => shift, trace_name => shift,
); );
$data{year} = $_ if (shift); my $y = shift;
if ($y) {
$data{year} = $y;
}
my $res = API::Base::send('ResultHandler', "projects/traces/add.xml", \%data); my $res = API::Base::send('ResultHandler', "projects/traces/add.xml", \%data);

View file

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

View file

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

View file

@ -189,13 +189,16 @@ sub get_dn($$@)
my $ldap = shift // ldap_connect(); my $ldap = shift // ldap_connect();
my $dn = shift; my $dn = shift;
my $base = BASE_DN;
$dn = "$dn," . BASE_DN if ($dn !~ /$base$/);
my $mesg = $ldap->search( # search my $mesg = $ldap->search( # search
base => "$dn", base => "$dn",
filter => Net::LDAP::Filter->new("(objectClass=*)"), filter => Net::LDAP::Filter->new("(objectClass=*)"),
attrs => \@_, attrs => \@_,
scope => "sub" scope => "base"
); );
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; } return undef if ($mesg->code != 0);
if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; } if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; }
return $mesg->entry(0); return $mesg->entry(0);
@ -331,7 +334,7 @@ sub search_dn($$@)
attrs => [ ], attrs => [ ],
scope => "sub" scope => "sub"
); );
croak($mesg->error) if ($mesg->code != 0); return undef if ($mesg->code != 0);
croak("$filter not found") if ($mesg->count == 0); croak("$filter not found") if ($mesg->count == 0);
croak("$filter not unique") if ($mesg->count > 1); croak("$filter not unique") if ($mesg->count > 1);

View file

@ -4,8 +4,11 @@ use v5.10.1;
use strict; use strict;
use warnings; use warnings;
use Carp; use Carp;
use utf8;
use open IO => ':utf8';
use open ':std';
use Data::Dumper; use Data::Dumper;
use Email::MIME;
use Exporter 'import'; use Exporter 'import';
use POSIX qw(strftime); use POSIX qw(strftime);
use Term::ANSIColor qw(:constants); use Term::ANSIColor qw(:constants);
@ -49,12 +52,17 @@ sub log
if (!$log_fd && $log_file) { if (!$log_fd && $log_file) {
open ($log_fd, ">>", $log_file) or croak("Unable to open log ($log_file) file for writing"); 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 "; say $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " START new logging session ";
} }
if ($level <= $save_level and $log_fd) if ($level <= $save_level and $log_fd)
{ {
local $| = 1;
print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " "; print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " ";
if ($level == TRACE) { if ($level == TRACE) {
@ -67,13 +75,20 @@ sub log
if ($mail_error && $level <= ERROR) if ($mail_error && $level <= ERROR)
{ {
require "Email::Sender::Simple"; require Email::MIME;
require Email::Sender::Simple;
Email::Sender::Simple->import(qw(sendmail));
my $mail = Email::MIME->create( my $mail = Email::MIME->create(
header_str => [ header_str => [
From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>", From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>",
To => "Roots assistants <ml-root\@acu.epita.fr>", To => "Roots assistants <ml-root\@acu.epita.fr>",
Subject => "[LERDORF][ERROR] ".join(' ', @_) Subject => "[LERDORF][ERROR] ".join(' ', @_)
], ],
attributes => {
encoding => 'quoted-printable',
charset => 'utf-8',
format => 'flowed',
},
body_str => "Bonjour, body_str => "Bonjour,
Une erreur de niveau $level est survenue sur la machine $HOSTNAME. Une erreur de niveau $level est survenue sur la machine $HOSTNAME.
@ -89,15 +104,20 @@ Cordialement,
-- --
The lerdorf project", The lerdorf project",
); );
Email::Sender::Simple::sendmail($mail); sendmail($mail);
} }
if ($level <= $display_level) { if ($level <= $display_level)
{
$|++; # Autoflush STDOUT
if ($level == PENDING) { if ($level == PENDING) {
print STDERR (leveldisp($level), @_, RESET, "\r"); print STDERR (leveldisp($level), @_, RESET, "\r");
} else { } else {
say STDERR (leveldisp($level), @_, RESET); say STDERR (leveldisp($level), @_, RESET);
} }
$|--; # Disable autoflush
} }
if ($fatal_warn && $level <= WARN){ if ($fatal_warn && $level <= WARN){

View file

@ -22,6 +22,18 @@ our $nb_cpus = 0;
$nb_cpus = grep {/^processor\s/} <$cpuinfo>; $nb_cpus = grep {/^processor\s/} <$cpuinfo>;
close $cpuinfo; close $cpuinfo;
our @servers = ("gearmand-srv:4730");
sub add_server
{
push @servers, @_;
}
sub set_servers
{
@servers = @_;
}
sub check_load ($) sub check_load ($)
{ {
my $priority = shift; my $priority = shift;
@ -71,15 +83,18 @@ sub do_work ($$$@)
return $err; return $err;
} }
my $ret; my $ret = "";
eval { eval {
$ret = $subref->($given_args, $args); $SIG{'__WARN__'} = sub { log WARN, $_[0]; $ret .= ">>> ".$_[0 ]; };
$ret .= $subref->($given_args, $args);
}; };
if ($@) { if ($@) {
my $err = $@; my $err = $@;
log ERROR, $err; log ERROR, $err;
return $err; $ret .= $err;
} }
return $ret; return $ret;
} }
@ -91,7 +106,9 @@ sub register_no_parse ($$;$)
my $worker = Gearman::Worker->new; my $worker = Gearman::Worker->new;
$worker->job_servers('gearmand:4730'); log INFO, "Registering function $funcname on ", join(", ", @servers);
$worker->job_servers( @servers );
$worker->register_function($funcname => sub $worker->register_function($funcname => sub
{ {
my $ret; my $ret;
@ -124,7 +141,9 @@ sub register ($$;$$)
my $worker = Gearman::Worker->new; my $worker = Gearman::Worker->new;
$worker->job_servers('gearmand:4730'); log INFO, "Registering function $funcname on ", join(", ", @servers);
$worker->job_servers( @servers );
$worker->register_function($funcname => sub { return do_work($subref, $given_arg, $priority, @_); }); $worker->register_function($funcname => sub { return do_work($subref, $given_arg, $priority, @_); });
# Disable exit on warning or error # Disable exit on warning or error
@ -193,7 +212,7 @@ sub launch ($$;$$)
my $funcname = shift; my $funcname = shift;
my $client = Gearman::Client->new; my $client = Gearman::Client->new;
$client->job_servers('gearmand:4730'); $client->job_servers( @servers );
log DEBUG, "Launching $funcname..."; log DEBUG, "Launching $funcname...";
@ -216,7 +235,7 @@ sub paralaunch ($$;$)
my $xml = build_task_xml(shift, shift); my $xml = build_task_xml(shift, shift);
my $client = Gearman::Client->new; my $client = Gearman::Client->new;
$client->job_servers('gearmand:4730'); $client->job_servers( @servers );
my $taskset = $client->new_task_set; my $taskset = $client->new_task_set;
for my $task (@{ $funcsname }) for my $task (@{ $funcsname })

View file

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

View file

@ -9,16 +9,15 @@ use Carp;
use utf8; use utf8;
use open qw(:encoding(UTF-8) :std); use open qw(:encoding(UTF-8) :std);
use XML::LibXML; use XML::LibXML;
use XML::SAX::ParserFactory;
use ACU::Log;
sub new sub new
{ {
my $class = shift; my $class = shift;
my $self = { my $self = {
ids => {},
infos => {}, infos => {},
comments => {}, groups => [],
who => {},
}; };
bless $self, $class; bless $self, $class;
@ -33,10 +32,47 @@ sub _initialize ($$)
{ {
my $self = shift; my $self = shift;
my $sax_handler = TraceHandler->new($self); my $dom = XML::LibXML->load_xml(string => shift);
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler ); $self->{groups} = $self->parseTrace($dom->documentElement());
$self->{type} = $dom->documentElement()->getAttribute("type") // "mill";
$self->{version} = $dom->documentElement()->getAttribute("version") // 1;
}
$parser->parse_file(shift); sub parseTrace($$)
{
my $self = shift;
my $tree = shift;
my $ret = [];
foreach my $node ($tree->childNodes())
{
if ($node->nodeName eq "info")
{
my $tmp = $node->textContent;
chomp($tmp);
$self->{infos}{ $node->getAttribute("name") } = $tmp;
}
elsif ($node->nodeName eq "group")
{
my $g = Trace::Group->new(
$node->getAttribute("id"),
$node->getAttribute("name")
);
$g->append(@{ $self->parseTrace($node) });
push @$ret, $g;
}
elsif ($node->nodeName eq "eval")
{
my $e = Trace::Eval->new(
$node->getAttribute("id"),
$node->getAttribute("type"),
$node
);
push @$ret, $e;
}
}
return $ret;
} }
sub getVersion ($) sub getVersion ($)
@ -63,113 +99,148 @@ sub getInfos ($)
return $self->{infos}; return $self->{infos};
} }
sub getComment ($$) sub addId
{ {
my $self = shift; my $self = shift;
return $self->{comments}{$_[0]}; my $key = shift;
my $value = shift;
my $e = Trace::Eval->new($key);
$e->addValue(undef, $value);
push @{ $self->{groups} }, $e;
return $e;
} }
sub getComments ($) sub delId
{ {
my $self = shift; my $self = shift;
return $self->{comments}; my $key = shift;
my $value = shift;
foreach my $group (@{ $self->{groups} })
{
if ($group->{id} eq $key)
{
if (!$value || $value == $group->getValue())
{
$self->{groups} = [ grep { $_->{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;
} }
sub getWho ($$) sub getWho ($$)
{ {
my $self = shift; my $self = shift;
return $self->{who}{$_[0]}; return $self->getWhos()->{$_[0]};
} }
sub getFirstWho ($) sub getFirstWho ($)
{ {
my $self = shift; my $self = shift;
return $self->getWhos()->{def1_end_group};
return $self->{who}{def1_end_group};
} }
sub getWhos ($) sub getWhos
{ {
my $self = shift; my $self = shift;
return $self->{who}; my $ret = {};
foreach my $group (@{ $self->{groups} })
{
my $whos = $group->getWhos();
foreach my $who (keys %{ $whos }) {
$ret->{ $who } = $whos->{$who};
}
}
return $ret;
} }
sub getValue ($$) sub toString ($)
{ {
my $self = shift; my $self = shift;
return $self->{ids}{$_[0]};
}
sub getIds ($)
{
my $self = shift;
return $self->{ids};
}
sub addId($$;$)
{
my $self = shift;
my $key = shift;
my $value = shift // 1;
$self->{ids}{$key} = $value;
}
sub delId($$)
{
my $self = shift;
my $key = shift;
delete $self->{ids}{$key};
}
sub toString ($;$)
{
my $self = shift;
my $main_grp = shift // "bonus_malus";
my $doc = XML::LibXML::Document->new('1.0'); my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("trace"); my $root = $doc->createElement("trace");
my $group = $doc->createElement("group"); foreach my $group (@{ $self->{groups} })
$group->addChild( $doc->createAttribute("id", $main_grp) ); {
$root->appendChild( $group->toString($doc) );
for my $k (keys %{ $self->{ids} }) {
my $e = $doc->createElement("eval");
my $v = $doc->createElement("value");
$e->addChild( $doc->createAttribute("id", $k) );
$v->appendText( $self->{ids}{$k} );
$e->appendChild( $v );
$group->appendChild( $e );
} }
$root->appendChild( $group );
$doc->setDocumentElement( $root ); $doc->setDocumentElement( $root );
return $doc->toString(); return $doc->toString();
} }
package TraceHandler; package Trace::Group;
use v5.10.1;
use strict;
use warnings;
use Carp; use Carp;
use constant NO_ID_VALUE => "__#";
use ACU::Log;
sub new ($$) sub new ($$)
{ {
my $class = shift; my $class = shift;
my $self = { my $self = {
groups => [], id => shift,
parsed => shift, name => shift,
inComment => "", groups => []
inEval => "",
inInfo => "",
inValue => "",
inWho => "",
values => ""
}; };
bless $self, $class; bless $self, $class;
@ -177,113 +248,273 @@ sub new ($$)
return $self; return $self;
} }
sub start_element sub append ($@)
{ {
my ($self, $element) = @_; my $self = shift;
if ($element->{Name} eq "trace") { push @{ $self->{groups} }, @_;
$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value}; }
$self->{parsed}{type} = $element->{Attributes}{"{}type"}{Value};
}
elsif ($element->{Name} eq "info") {
$self->{inInfo} = $element->{Attributes}{"{}name"}{Value};
$self->{parsed}{infos}{ $self->{inInfo} } = 0;
$self->{values} = "";
}
elsif ($element->{Name} eq "eval") {
my $tmp = $element->{Attributes}{"{}id"}{Value};
if ($tmp) {
$self->{inEval} = $tmp;
$self->{parsed}{ids}{ $self->{inEval} } = 0;
}
}
elsif ($element->{Name} eq "comment" && $self->{inEval}) {
$self->{inComment} = $self->{inEval};
$self->{values} = "";
}
elsif ($element->{Name} eq "who" && $self->{inEval}) {
$self->{inWho} = $self->{inEval};
$self->{values} = "";
}
elsif ($element->{Name} eq "value") {
if ($element->{Attributes}{"{}id"}{Value}) {
$self->{inValue} = $element->{Attributes}{"{}id"}{Value};
} else {
$self->{inValue} = NO_ID_VALUE;
}
$self->{values} = ""; sub delId
} {
elsif ($element->{Name} eq "group") my $self = shift;
my $key = shift;
my $value = shift;
foreach my $group (@{ $self->{groups} })
{ {
push @{ $self->{groups} }, ($element->{Attributes}{"{}id"}{Value} // ""); if ($group->{id} eq $key)
{
if (!$value || $value == $group->getValue())
{
$self->{groups} = \{ grep { $_->{id} ne $key } @{ $self->{groups} } };
} }
elsif ($element->{Name} ne "name" && $element->{Name} ne "statut" && $element->{Name} ne "status" && $element->{Name} ne "log") { last;
croak "Not a valid trace XML: unknown tag ".$element->{Name}; }
$group->delId($key, $value);
} }
} }
sub characters sub getIds
{ {
my ($self, $characters) = @_; my $self = shift;
my $login = shift;
if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) { my %ids;
$self->{values} .= $characters->{Data}; foreach my $group (@{ $self->{groups} })
{
my %tmp = $group->getIds($login);
while (my ($key, $value) = each %tmp)
{
$ids{$key} = $value;
}
}
$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})
{
my $value = 0;
foreach my $group (@{ $self->{groups} })
{
$value += $group->getValue(undef, $login);
}
return $value;
}
else
{
my $value = 0;
foreach my $group (@{ $self->{groups} })
{
$value += $group->getValue($id, $login);
}
return $value;
} }
} }
sub end_element sub getWhos
{ {
my ($self, $element) = @_; my $self = shift;
my $ret = {};
if ($element->{Name} eq "value") foreach my $group (@{ $self->{groups} })
{ {
if ($self->{values} =~ /([-+]?[0-9]+(.[0-9]+)?)/) my $whos = $group->getWhos();
foreach my $who (keys %{ $whos }) {
$ret->{ $who } = $whos->{$who};
}
}
return $ret;
}
sub toString($$)
{
my $self = shift;
my $doc = shift;
my $gr = $doc->createElement("group");
foreach my $item (@{ $self->{groups} })
{ {
$self->{parsed}{ids}{ $self->{inEval} } += $1; $gr->appendChild( $item->toString() );
if ($self->{inValue} ne NO_ID_VALUE and $1) {
$self->{parsed}{ids}{ $self->{inValue} } = $1;
} }
if ($self->{groups}) {
my $key = @{ $self->{groups} }[$#{ $self->{groups} }]; return $gr;
$self->{parsed}{ids}{ $key } += $1; }
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(@_);
} }
}
$self->{inValue} = ""; return $self;
} }
elsif ($element->{Name} eq "eval")
sub parseEval
{
my $self = shift;
my $tree = shift;
foreach my $node ($tree->childNodes())
{ {
# Remove empty identifier my $val = $node->textContent;
delete $self->{parsed}{ids}{ $self->{inEval} } if (!$self->{parsed}{ids}{ $self->{inEval} }); chomp($val);
$self->{inEval} = "";
} if ($node->nodeName eq "value")
elsif ($element->{Name} eq "comment")
{ {
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { $self->addValue($node->getAttribute("id"),
$self->{parsed}{comments}{ $self->{inComment} } = $1; $val);
} }
$self->{inComment} = ""; elsif ($node->nodeName eq "name")
}
elsif ($element->{Name} eq "who")
{ {
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { $self->{name} = $val;
$self->{parsed}{who}{ $self->{inWho} } = $1;
} }
$self->{inComment} = ""; elsif ($node->nodeName eq "status")
}
elsif ($element->{Name} eq "info")
{ {
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { $self->{status} = $val;
$self->{parsed}{infos}{ $self->{inInfo} } = $1;
} }
$self->{inInfo} = ""; elsif ($node->nodeName eq "log")
}
elsif ($element->{Name} eq "group")
{ {
my $key = pop @{ $self->{groups} }; my $key = $node->getAttribute("type") // "stdout";
# Remove empty identifier
delete $self->{parsed}{ids}{ $key } if ($key && !$self->{parsed}{ids}{ $key }); $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; 1;

View file

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

View file

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

View file

@ -1,10 +1,13 @@
COPY?=cp -v COPY?=cp -v
CURL?=curl
DEST?=/usr/local/share/perl/`ls -1 /usr/local/share/perl/ | grep "^5." | tail -1`/ DEST?=/usr/local/share/perl/`ls -1 /usr/local/share/perl/ | grep "^5." | tail -1`/
GIT?=/usr/bin/git GIT?=/usr/bin/git
GITOLITE_DEST?=/usr/share/gitolite/hooks/common GITOLITE_DEST?=/usr/share/gitolite/hooks/common
MAKEDIR?=mkdir MAKEDIR?=mkdir
PERL?=/usr/bin/env perl
PROVER?=prove -f PROVER?=prove -f
RM?=rm RM?=rm
RMTREE?=rm -r
TESTDIR?=t TESTDIR?=t
SHELL?=/bin/sh SHELL?=/bin/sh
@ -17,10 +20,20 @@ install:
$(COPY) -r ACU/ $(DEST) $(COPY) -r ACU/ $(DEST)
! test -d $(GITOLITE_DEST) || $(MAKEDIR) -p $(GITOLITE_DEST)/update.secondary.d ! 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/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/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/conferences.pl $(GITOLITE_DEST)/update.secondary.d/
! test -d $(GITOLITE_DEST) || $(COPY) hooks/submissions.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: update:
$(GIT) pull $(GIT) pull
$(SHELL) commands/first-install.sh $(SHELL) commands/first-install.sh
@ -33,6 +46,16 @@ unstall:
! test -d $(GITOLITE_DEST) || $(RM) -rf $(GITOLITE_DEST)/update.secondary.d ! test -d $(GITOLITE_DEST) || $(RM) -rf $(GITOLITE_DEST)/update.secondary.d
! test -d $(GITOLITE_DEST) || $(MAKEDIR) -p $(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: test:
$(PROVER) $(TESTDIR) $(PROVER) $(TESTDIR)

View file

@ -1,10 +1,10 @@
#! /bin/bash #! /bin/bash
# Install missing packages # Install missing packages
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" 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-simple perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin 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/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" 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-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" FBSD_PACKAGES_LIST="screen p5-XML-LibXML p5-Gearman p5-IO-Socket-SSL p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin p5-Text-Glob"
KERNEL=`uname -s` KERNEL=`uname -s`

14
commands/guantanamo_list.sh Executable file
View file

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

View file

@ -6,7 +6,7 @@ WKS_LIST="apl"
SRV_LIST="moore noyce hamano cpp otto" SRV_LIST="moore noyce hamano cpp otto"
SCP_LIST="ksh knuth" SCP_LIST="ksh knuth"
KNOWN_ACTIONS="start stop restart update log viewlog view_log" KNOWN_ACTIONS="start stop restart install update log viewlog view_log"
LOG=`mktemp` LOG=`mktemp`
@ -80,7 +80,7 @@ do
for DEST in $DESTS for DEST in $DESTS
do do
echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m" echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m"
if [ "$ACTION" == "update" ] if [ "$ACTION" == "install" ] || [ "$ACTION" == "update" ]
then then
SCP=0 SCP=0
for D in $SCP_LIST for D in $SCP_LIST
@ -94,6 +94,11 @@ do
if [ $SCP -eq 0 ] if [ $SCP -eq 0 ]
then then
if [ "$ACTION" == "install" ] &&
! ssh root@$DEST "mkdir -p /home/intradmin/ && git clone '$(echo `git remote -v` | cut -d " " -f 2)' /home/intradmin/liblerdorf && ln -s /home/intradmin/liblerdorf ~/liblerdorf"
then
exit 1
fi
ssh root@$DEST "make -C liblerdorf update upgrade" ssh root@$DEST "make -C liblerdorf update upgrade"
else else
cd .. cd ..

45
commands/moulette/launch.sh Executable file
View file

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

View file

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

59
commands/moulette/sendgit.sh Executable file
View file

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

View file

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

View file

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

29
commands/moulette/stats.sh Executable file
View file

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

View file

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

View file

@ -11,7 +11,6 @@ my $projid = $ARGV[0];
my $year = $ARGV[1] // LDAP::get_year; my $year = $ARGV[1] // LDAP::get_year;
my $res = API::Projects::get_groups($projid, $year); my $res = API::Projects::get_groups($projid, $year);
my $tag = "rendu-1";
map { map {
my $chief; my $chief;
@ -26,10 +25,16 @@ map {
} }
} }
say "repo $year/$projid/$chief->{login}"; my @members;
print ' RW+ = @admins';
for my $member (@{ $_->{stds} }) { for my $member (@{ $_->{stds} }) {
print ' '.$member->{login}; push @members, $member->{login};
} }
say "\n R = \@chefs \@resp-$year-$projid";
say "repo $year/$projid/$chief->{login}";
say " - ACU-moulette = ", join(" ", @members);
say " - refs/tags/ACU- = ", join(" ", @members);
say ' RW+ = @admins ', join(" ", @members);
say ' RW ACU-moulette = @moulettes';
say ' RW+ refs/tags/ACU- = @moulettes';
say " R = \@chefs \@resp-$year-$projid \@soutenance-$year-$projid \@moulettes intradmin-hamano";
} @{ $res->{groups} }; } @{ $res->{groups} };

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

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

View file

@ -5,6 +5,7 @@ use warnings;
use v5.10; use v5.10;
use File::Basename; use File::Basename;
use Net::IP; use Net::IP;
use utf8;
use ACU::Log; use ACU::Log;
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log"; $ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
@ -13,13 +14,14 @@ 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); exit 0 if (!$ip);
log DEBUG, "Connection with $ARGV[0] to $ENV{GL_REPO} from $ip"; log DEBUG, "Connection by $ENV{GL_USER} with $ARGV[0] to $ENV{GL_REPO} from $ip";
my $promo = qx(git config hooks.promo); my $promo = qx(git config hooks.promo);
my $id_project = qx(git config hooks.idproject); my $id_project = qx(git config hooks.idproject);
my $repo_login = qx(git config hooks.repologin); my $repo_login = qx(git config hooks.repologin);
my @habitent_loin = ("abdeln_a", "amed_m", "bellev_m", "faure_n", "freima_m", "ikouna_l", "simon_j"); my @apping3 = qw(saadi_n lucas_e jawhar_s france_b roux_m bamba_m boudje_s gillot_l le-pen_m gimene_a nguye_d marin_c piedno_j salmon_b);
my @habitent_loin = qw(amed_m bellev_m freima_m ikouna_l simon_j faure_n abdelm_a habri_z trang_d henrie_p verbec_y molini_v marti_o colin_j);
# First, check if the repository is in the YYYY/ directory # 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}\/.+\/.+/); exit 0 if (($promo && $id_project && $repo_login) || $ENV{GL_REPO} !~ /^2[0-9]{3}\/.+\/.+/);
@ -48,10 +50,12 @@ if ($ip->overlaps($labnetwork) == $IP_A_IN_B_OVERLAP)
# exit 1; # exit 1;
#} #}
exit 0 if (grep { /\Q$repo_login\E/ } @habitent_loin); exit 0 if ($id_project eq "lse-project" && $ip->ip() eq "10.224.4.1");
exit 0 if (grep { /\Q$ENV{GL_USER}\E/ } @habitent_loin, @apping3, "icaza_fact");
my $schoolnetwork = Net::IP->new('10.41.0.0/16'); my $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 ( if (
$ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP $ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP

116
hooks/post-update Executable file
View file

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

View file

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

View file

@ -8,6 +8,7 @@ use File::Basename;
use Net::IP; use Net::IP;
use POSIX qw(strftime); use POSIX qw(strftime);
use Socket; use Socket;
use utf8;
use ACU::API::Projects; use ACU::API::Projects;
use ACU::API::Submission; use ACU::API::Submission;
@ -22,6 +23,11 @@ my $promo;
my $id_project; my $id_project;
my $repo_login; my $repo_login;
my @apping = qw(zinger_a zebard_w zanell_a yao_p vinois_a sraka_y soupam_j seck_a ngomsi_s morin_h milis_e menkar_m eusebe_r crief_a chhum_s boumra_n blemus_a bengan_l amasho_a);
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 # First, extract information, from config then guess from repository adress
if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; } if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; }
if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; } if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; }
@ -33,12 +39,68 @@ $repo_login = $1 if (!$repo_login && $ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/);
exit(0) if (!$promo || !$id_project || !$repo_login); exit(0) if (!$promo || !$id_project || !$repo_login);
if ($ref =~ m<^refs/tags/(.+)$>) if ($ref =~ m<^refs/tags/ACU-(.+)$>)
{ {
my $tag = $1; my $tag = $1;
log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}"; log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}";
# Get project informations # Disallow no ACU
if ($ENV{GL_USER} ne "frotti_b" && $ENV{GL_USER} ne "chen_a" && $ENV{GL_USER} ne "boisse_r" && $ENV{GL_USER} ne "genite_n" && $ENV{GL_USER} ne "mercie_d")
{
log ERROR, "Vous n'êtes pas autorisé à envoyer ce tag.";
exit(9);
}
my $project = get_project_info($tag);
# Extract matching tag
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $tag;
} @{ $project->{submissions} };
if (! @rendus)
{
log ERROR, "$tag n'est pas un tag valide.";
exit(8);
}
}
elsif ($ref =~ m<^refs/tags/(.+)$>)
{
my $tag = $1;
log DEBUG, "Pushed tag for repository $ENV{GL_REPO}: $tag with IP $ENV{'SSH_CLIENT'}";
my $project = get_project_info($tag);
# Extract matching tag
my @rendus = grep {
exists $_->{vcs} and $_->{vcs}{tag} eq $tag;
} @{ $project->{submissions} };
if (@rendus)
{
if ($newsha eq '0' x 40)
{
log USAGE, "Mais pour quelle raison voudriez-vous supprimer un tag ?!";
exit(7);
}
chomp (my $tokengiven = `git cat-file tag $newsha 2> /dev/null | sed -e '1,/^\$/d'`);
if (! check_submission_date($tokengiven, @rendus))
{
exit (9);
}
}
else
{
log ERROR, "$tag n'est pas un tag valide.";
exit(8)
}
}
exit 0;
sub get_project_info
{
my $project; my $project;
eval { eval {
$project = API::Projects::get($id_project, $promo); $project = API::Projects::get($id_project, $promo);
@ -48,15 +110,17 @@ if ($ref =~ m<^refs/tags/(.+)$>)
my $err = $@; my $err = $@;
log TRACE, $err; log TRACE, $err;
log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire."; log ERROR, "Impossible d'envoyer de tags ; si le problème persiste, passez au laboratoire.";
exit 1; exit(1);
} }
log TRACE, $project; log TRACE, $project;
# Extract lot of data return $project;
my @rendus = grep { }
exists $_->{vcs} and $_->{vcs}{tag} eq $tag;
} @{ $project->{submissions} }; sub check_submission_date
{
my $tokengiven = shift;
my $glts = DateTime::Format::ISO8601->parse_datetime( my $glts = DateTime::Format::ISO8601->parse_datetime(
do { do {
@ -65,14 +129,17 @@ if ($ref =~ m<^refs/tags/(.+)$>)
$t $t
}); });
chomp (my $tokengiven = `git cat-file tag $newsha 2> /dev/null | sed -e '1,/^\$/d'`); for my $rendu (@_)
for my $rendu (@rendus)
{ {
my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin}); my $open = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{begin});
my $close = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{end}); my $close = DateTime::Format::ISO8601->parse_datetime($rendu->{period}{end});
# TODO: check exceptions by login/group if (($id_project eq "bistromathique" || $id_project eq "pthl") && grep { $_ eq $repo_login } @expcep)
$open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l"); # if (($id_project eq "bistromathique" || $id_project eq "pthl") && "pizzin_a" eq $repo_login)
{
# $open = DateTime::Format::ISO8601->parse_datetime("2013-12-19T18:00:00");
$close = DateTime::Format::ISO8601->parse_datetime("2013-12-22T19:42:00");
}
say "Date courante : ", $glts->strftime("%d/%m/%Y %H:%M:%S"); say "Date courante : ", $glts->strftime("%d/%m/%Y %H:%M:%S");
@ -99,40 +166,5 @@ if ($ref =~ m<^refs/tags/(.+)$>)
} }
} }
if ($newsha eq '0' x 40) { return 1;
log USAGE, "Mais pour quelle raison voudriez-vous supprimer un tag ?!";
}
else
{
eval {
Process::Client::launch("send_git",
{
"year" => $promo,
"id" => $id_project,
"rendu" => $tag,
"login" => $repo_login,
# "path" => "ssh://git\@localhost/".$ENV{GL_REPO},
}, undef, 1);
};
if ($@) {
my $err = $@;
log DEBUG, "ERROR: ".$err;
}
# Send data to API
my $last_commit = `git log $newsha -1 --decorate --tags`;
eval {
API::Submission::add($promo, $id_project, $tag, $repo_login, $last_commit);
};
if ($@) {
my $err = $@;
log DEBUG, "ERROR: ".$err;
log DONE, "Tag '$tag' effectué avec succès !";
}
else {
log DONE, "Tag '$tag' effectué avec succès ! Vérifiez-le sur l'intranet.";
}
}
} }
exit 0;

View file

@ -21,20 +21,25 @@ tex2md()
echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m" echo -e "\e[1;34m>>>\e[1;37m Trying to convert $i to Markdown...\e[0m"
# BEGIN HACK! Need stacking # BEGIN HACK! Need stacking
sed -Ei 's/\\(lstinline|class|expected|refer)[^{]*\{([^}]*)\}/\\verb+\2+/gi' "$i"
sed -Ei 's/\\distribution\{\}/FreeBSD 9/gi' "$i" sed -Ei 's/\\distribution\{\}/FreeBSD 9/gi' "$i"
sed -Ei 's/\\\{/__OPEN_BRACKET_MINIROOT__/gi' "$i" sed -Ei 's/\\\{/__OPEN_BRACKET_MINIROOT__/gi' "$i"
sed -Ei 's/\\\}/__CLOSE_BRACKET_MINIROOT__/gi' "$i" sed -Ei 's/\\\}/__CLOSE_BRACKET_MINIROOT__/gi' "$i"
sed -Ei 's/-\{\}-//gi' "$i" sed -Ei 's/-\{\}-//gi' "$i"
sed -Ei 's/\\_/_/gi' "$i" #sed -Ei 's/\\_/_/gi' "$i"
# DIRTY HACK # DIRTY HACK
sed -Ei 's/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i" sed -Ei 's/\\includegraphics *\{([^}]+)}/\\verb+%%image(\1)+/gi' "$i"
sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\include *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\input *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\\input *\{([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\{\\include *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\{\\include *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\{\\input *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i" sed -Ei 's/\{\\input *([^}]+)}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\lstinputlisting *\{([^}]+)\}/\\verb+%%scoped-include(\1)+/gi' "$i"
sed -Ei 's/\\lstinline *\{([^}]+)}/\\verb+\1+/gi' "$i" sed -Ei 's/\\lstinline *\{([^}]+)}/\\verb+\1+/gi' "$i"
sed -Ei 's/\\structure\{([^}]+)}/\1/gi' "$i"
sed -Ei 's/\\struct\{([^}]+)}/\1/gi' "$i"
sed -Ei 's/\\link\{([^}]+)}/\1/gi' "$i"
sed -Ei 's/\\textasciitilde\{\}/~/gi' "$i"
sed -Ei 's/\\begin *\{correction\}/\\begin\{verbatim\}/g' "$i" sed -Ei 's/\\begin *\{correction\}/\\begin\{verbatim\}/g' "$i"
sed -Ei 's/\\end *\{correction\}/\\end\{verbatim\}/g' "$i" sed -Ei 's/\\end *\{correction\}/\\end\{verbatim\}/g' "$i"
sed -Ei 's/\\begin *\{prompt\}/\\begin\{verbatim\}/g' "$i" sed -Ei 's/\\begin *\{prompt\}/\\begin\{verbatim\}/g' "$i"
@ -48,7 +53,7 @@ tex2md()
sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i" sed -Ei 's/\\verb ([^+]+) /\\verb+\1+/g' "$i"
# Special macros # Special macros
sed -Ei 's/\\(file|email|command|code|bcode) *\{([^}]*)\}/\\verb+\2+/gi' "$i" sed -Ei 's/\\(file|email|command|bcode|code) *\{([^}]*)\}/\\verb+\2+/gi' "$i"
sed -Ei 's/\\begin *\{assistant\}/\\verb+%%assistant-begin+/g' "$i" sed -Ei 's/\\begin *\{assistant\}/\\verb+%%assistant-begin+/g' "$i"
sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i" sed -Ei 's/\\end *\{assistant\}/\\verb+%%assistant-end+/g' "$i"
@ -79,7 +84,7 @@ tex2md()
git rm -f "$i" > /dev/null git rm -f "$i" > /dev/null
fi 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" sed -Ei 's/\\$/\n/' "$DEST/${bi%%.tex}.md"
done done
} }
@ -109,7 +114,7 @@ clean_tex()
exit 1; exit 1;
fi fi
for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png *.cls *.sty *.tex for f in data Makefile images/acu.pdf images/assistants.pdf images/assistants-subject.pdf images/assistants-slides.pdf images/assistants.png images/epita.pdf images/epita.png images/epita-invert.pdf images/assistants-invert.pdf images/epita-invert.png images/assistants-bg.png images/logo_epita.jpg images/acu-bottom.png images/acu-bottom.pdf images/acu-bg.pdf images/acu2011.png images/acu.png images/acu_2012_logo_hd.png *.cls *.sty *.toc
do do
if [ -f "$f" ] if [ -f "$f" ]
then then
@ -120,6 +125,11 @@ clean_tex()
fi fi
done done
for file in `find -name "*.ltx"`
do
git mv "$file" "${file%%.ltx}.tex"
done
if [ -d "include" ] if [ -d "include" ]
then then
cd include cd include
@ -130,6 +140,20 @@ clean_tex()
git mv * .. git mv * ..
fi fi
cd "$1"
tex2md .
maintex2md
rmdir include 2> /dev/null
elif [ -d "subdocs" ]
then
cd subdocs
tex2md ..
if [ `find | wc -l` -gt 1 ]
then
git mv * ..
fi
cd "$1" cd "$1"
tex2md . tex2md .
maintex2md maintex2md
@ -324,6 +348,18 @@ do
git rm -rf "$f" > /dev/null git rm -rf "$f" > /dev/null
fi fi
done done
# Append Fact lines
if [ -f "Makefile" ]
then
cat <<EOF >> Makefile
fact:
rm -rf ref.ff
\${FACT} package create ../ref ref.ff
\${FACT} make make ref.ff ref.ff
EOF
fi
cd - > /dev/null cd - > /dev/null
fi fi
done done

View file

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

View file

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

View file

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

View file

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

View file

@ -7,6 +7,7 @@ use threads;
use threads::shared; use threads::shared;
use Carp; use Carp;
use File::Basename; use File::Basename;
use File::Compare;
use File::Copy; use File::Copy;
use File::Path qw(remove_tree mkpath); use File::Path qw(remove_tree mkpath);
use File::Temp qw/tempfile tempdir/; use File::Temp qw/tempfile tempdir/;
@ -153,12 +154,40 @@ sub create_testsuite
jail_exec("gmake -C $tempdir/tests/"); jail_exec("gmake -C $tempdir/tests/");
croak "An error occurs while making the testsuite" if ($?); croak "An error occurs while making the testsuite" if ($?);
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2]; my ($workdir, $outputdir, $destdir) = prepare_dir($year, $project_id, $rendu);
copy("$tempdir/tests/tests.ff", "$destdir/tests.ff") or croak "An error occurs while coping the testsuite: $!"; 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"; 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"; chmod 0660, "$destdir/test.ft";
opendir(my $dh, $workdir) or die "Can't list files in $workdir: $!";
while (readdir($dh))
{
if (/([a-zA-Z0-9_-]+).ft$/)
{
log DEBUG, "Remove $1.ft";
unlink "$workdir/$1.ft";
}
}
closedir $dh;
}
else
{
log DEBUG, "test.ft hasn't changed, KEEP students ones.";
}
}
else {
remove_tree($tempdir);
croak "tests/test.ft not found.";
}
# Clean # Clean
remove_tree($tempdir); remove_tree($tempdir);
@ -210,7 +239,7 @@ sub run_moulette
close $fhout; close $fhout;
} }
copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannont copy $login.ff"; copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannot copy $login.ff";
next if ($login eq "ref" && ! -f "$workdir/$login.ft"); 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"); croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$workdir/$login.ft");

View file

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

View file

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

View file

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

View file

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

View file

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

272
utils/lpt
View file

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