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

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

Browse source
This commit is contained in:
Root Cpp Charlie 2013-09-30 10:28:07 +02:00
commit c6b1936cb2
7 changed files with 436 additions and 122 deletions
Download patch file Download diff file Expand all files Collapse all files

202
ACU/LDAP.pm
View file

@ -5,6 +5,7 @@ package LDAP;
use v5.10.1;
use strict;
use warnings;
use Carp;
use Net::LDAPS;
use Net::LDAP::Util qw(ldap_error_text);
@ -42,7 +43,8 @@ sub ldap_connect()
log(DEBUG, "Connect to LDAP with $binddn");
if ($mesg->code) {
log(FATAL, "An error occurred: " .ldap_error_text($mesg->code));
log(ERROR, "An error occurred: " .ldap_error_text($mesg->code));
croak "An error occurred: " .ldap_error_text($mesg->code);
}
return $ldap;
@ -56,7 +58,8 @@ sub ldap_connect_anon()
log(DEBUG, "Connect to LDAP anonymously");
if ($mesg->code) {
log(FATAL, "An error occurred: " .ldap_error_text($mesg->code));
log(ERROR, "An error occurred: " .ldap_error_text($mesg->code));
croak "An error occurred: " .ldap_error_text($mesg->code);
}
return $ldap;
@ -87,29 +90,6 @@ sub add_group($$$;$)
return $dn;
}
sub delete_group($$;$)
{
my $cn = shift;
my $year = shift;
my $ou = shift // "intra"; # expected roles or intra
my $ldap = ldap_connect();
log(DEBUG, "Delete group ou=groups,dc=acu,dc=epita,dc=fr");
my $mesg = $ldap->search( # search
base => "ou=groups,dc=acu,dc=epita,dc=fr",
filter => "cn=$cn",
scope => "sub"
);
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
if ($mesg->count != 1) { log(WARN, "$cn not found or multiple entries match"); return 0; }
$ldap->delete( $mesg->entry(0)->dn );
$ldap->unbind or log(WARN, "couldn't disconnect correctly");
}
sub get_year(;$)
{
my $ldap = shift // ldap_connect_anon();
@ -117,6 +97,90 @@ sub get_year(;$)
return get_attribute($ldap, "cn=year,dc=acu,dc=epita,dc=fr", "year");
}
sub get_rights($)
{
my $login = shift;
my @rights;
my $ldap = ldap_connect_anon();
my $mesg = $ldap->search( # search
base => "ou=roles,ou=groups,dc=acu,dc=epita,dc=fr",
filter => "&(memberUid=$login)(objectClass=intraGroup)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
for my $entry ($mesg->entries)
{
for my $r ($entry->get_value('intraRight'))
{
if ($r =~ /^!(.*)$/) {
@rights = grep { $r ne $_ } @rights;
}
else {
push @rights, Right->new($r);
}
}
}
$mesg = $ldap->search( # search
base => "ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
filter => "&(memberUid=$login)(objectClass=intraGroup)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $entry ($mesg->entries)
{
for my $r ($entry->get_value('intraRight')) {
push @rights, Right->new($r);
}
}
$mesg = $ldap->search( # search
base => "ou=users,dc=acu,dc=epita,dc=fr",
filter => "&(uid=$login)(objectClass=intraAccount)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $r ($mesg->entry(0)->get_value('intraRight')) {
push @rights, Right->new($r);
}
$ldap->unbind or die ("couldn't disconnect correctly");
return @rights;
}
sub has_right($$)
{
my $login = shift;
my $right = shift;
my $ok = 0;
for my $r (get_rights($login))
{
if ($r->{right} eq $right)
{
return 0 if ($r->{negate});
$ok = $r;
}
}
return $ok;
}
## Low level functions
@ -154,7 +218,8 @@ sub add_attribute($$$@)
my @data = $entry->get_value($what);
for my $value (@_)
{
if (! grep { /^\Q$value\E$/ } @data) {
if (! grep { $value eq $_ } @data)
{
$mod = 1;
log(DEBUG, "Add attribute $value to $dn");
@ -192,10 +257,11 @@ sub delete_attribute($$$@)
my @data = $entry->get_value($what);
for my $value (@_)
{
if (grep { /^\Q$value\E$/ } @data) {
if (grep { $value eq $_ } @data)
{
log(DEBUG, "Remove attribute $what ($value) from $dn");
@data = grep { ! /^\Q$value\E$/ } @data;
@data = grep { ! $value eq $_ } @data;
$mod = 1;
}
else {
@ -310,84 +376,4 @@ sub update_attribute($$$@)
return 1;
}
sub has_right($$)
{
my $login = shift;
my $right = shift;
my $ok = 0;
for my $r (get_rights($login)) {
if ($r->{right} eq $right) {
return 0 if ($r->{negate});
$ok = $r;
}
}
return $ok;
}
sub get_rights($)
{
my $login = shift;
my @rights;
my $ldap = ldap_connect_anon();
my $mesg = $ldap->search( # search
base => "ou=roles,ou=groups,dc=acu,dc=epita,dc=fr",
filter => "&(memberUid=$login)(objectClass=intraGroup)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
for my $entry ($mesg->entries) {
for my $r ($entry->get_value('intraRight')) {
if ($r =~ /^!(.*)$/) {
@rights = grep { ! /^\Q$r\E$/ } @rights;
}
else {
push @rights, Right->new($r);
}
}
}
$mesg = $ldap->search( # search
base => "ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
filter => "&(memberUid=$login)(objectClass=intraGroup)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $entry ($mesg->entries) {
for my $r ($entry->get_value('intraRight')) {
push @rights, Right->new($r);
}
}
$mesg = $ldap->search( # search
base => "ou=users,dc=acu,dc=epita,dc=fr",
filter => "&(uid=$login)(objectClass=intraAccount)",
attrs => [ 'intraRight' ],
scope => "sub"
);
if ($mesg->code != 0) { die $mesg->error; }
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
for my $r ($mesg->entry(0)->get_value('intraRight')) {
push @rights, Right->new($r);
}
$ldap->unbind or die ("couldn't disconnect correctly");
return @rights;
}
1;

25
ACU/Process.pm
View file

@ -320,6 +320,30 @@ sub getFirstChild ($)
return $self->{children}[0];
}
sub recreateNode
{
my $self = shift;
my $doc = shift;
my $parent = shift;
my $node = $doc->createElement($self->{nodeName});
for my $attkey (keys %{ $self->{attributes} })
{
$node->addChild( $doc->createAttribute($attkey, $self->{attributes}{ $attkey }) );
}
for my $child (@{ $self->{children} })
{
$child->recreateNode($doc, $node);
}
if ($self->{nodeValue}) {
$node->appendText( $self->{nodeValue} );
}
$parent->appendChild($node);
}
package ProcessHandler;
@ -399,7 +423,6 @@ sub end_element
{
my $item = pop @{ $self->{subtreeStack} };
$item->{nodeValue} .= $self->{values};
$item->{nodeValue} =~ s/\n+/ /g;
$item->{nodeValue} =~ s/ +/ /g;
if (@{ $self->{subtreeStack} } > 0) {
push @{ $self->{subtreeStack}[-1]->{children} }, $item;

18
Makefile
View file

@ -1,12 +1,12 @@
COPY=cp -v
DEST=/usr/local/share/perl/`ls -1 /usr/lib/perl/ | tail -1`/
GIT=/usr/bin/git
GITOLITE_DEST=/usr/share/gitolite/hooks/common
MAKEDIR=mkdir
PROVER=prove -f
RM=rm
TESTDIR=t
SHELL=/bin/sh
COPY?=cp -v
DEST?=/usr/local/share/perl/`ls -1 /usr/lib/perl/ | tail -1`/
GIT?=/usr/bin/git
GITOLITE_DEST?=/usr/share/gitolite/hooks/common
MAKEDIR?=mkdir
PROVER?=prove -f
RM?=rm
TESTDIR?=t
SHELL?=/bin/sh
launch:
$(SHELL) ./process/launch.sh

26
commands/manage-server.sh
View file

@ -4,6 +4,7 @@ cd $(dirname "$0")
WKS_LIST="apl"
SRV_LIST="moore noyce hamano cpp"
SCP_LIST="ksh"
KNOWN_ACTIONS="start stop restart update log viewlog view_log"
@ -27,7 +28,7 @@ do
fi
done
for DEST in $WKS_LIST $SRV_LIST
for DEST in $WKS_LIST $SRV_LIST $SCP_LIST
do
if [ -n "$1" ] && [ "$1" == "$DEST" ]
then
@ -63,7 +64,7 @@ fi
if [ -z "$DESTS" ]
then
DESTS="$SRV_LIST $WKS_LIST"
DESTS="$SRV_LIST $WKS_LIST $SCP_LIST"
fi
OPTIONS=
@ -80,8 +81,29 @@ do
do
echo -e "\e[1;34m>>>\e[0m \e[33m$ACTION\e[0m on \e[1m$DEST\e[0m"
if [ "$ACTION" == "update" ]
then
SCP=0
for D in $SCP_LIST
do
if [ $D == $DEST ]
then
SCP=1
break
fi
done
if [ $SCP -eq 0 ]
then
ssh root@$DEST "make -C liblerdorf update upgrade"
else
cd ..
git archive -o ./liblerdorf.tbz2 master
scp ./liblerdorf.tbz2 root@$DEST:
cd -
ssh root@$DEST mkdir -p liblerdorf
ssh root@$DEST tar xf ./liblerdorf.tbz2 -C liblerdorf
ssh root@$DEST "DEST=/usr/local/lib/perl5/5.14/ACU make -C liblerdorf upgrade"
fi
elif [ "$ACTION" == "log" ] || [ "$ACTION" == "viewlog" ] || [ "$ACTION" == "view_log" ]
then
ssh root@$DEST '~'/liblerdorf/process/view_log.sh $OPTIONS

2
hooks/gl-pre-git
View file

@ -18,7 +18,7 @@ say "Votre IP est : $ip.";
$ip = Net::IP->new($ip) or die ("IP invalide");
my $schoolnetwork = Net::IP->new('192.168.0.0/16');
my $schoolnetwork = Net::IP->new('10.41.0.0/16');
if ($ip->overlaps($schoolnetwork) != $IP_A_IN_B_OVERLAP)
{

175
process/exec/guantanamo.pl Normal file
View file

@ -0,0 +1,175 @@
#!/usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Gearman::Worker;
use MIME::Base64;
use XML::LibXML;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
my %master_actions =
(
"launch" => \&master_launch,
"register" => \&master_register,
);
my @nodes;
sub master_register
{
my $args = shift;
if ($args->{param}{nodename}) {
my $nodename = $args->{param}{nodename};
log INFO, "New node: $nodename";
push @nodes, "$nodename";
}
else {
log WARN, "nodename empty, cannot register new node";
}
}
sub build_task_xml
{
my $files = shift;
my $subtree = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("guantanamo");
$doc->setDocumentElement( $root );
log TRACE, $subtree;
if ($files)
{
log TRACE, $files;
for my $key (keys %{ $files })
{
my $file = $doc->createElement("file");
$file->addChild( $doc->createAttribute("name", $key) );
$file->addChild( $doc->createAttribute("encoding", "base64") );
$file->appendText(encode_base64($files->{$key}));
$root->appendChild($file);
}
}
if ($subtree) {
$subtree->recreateNode($doc, $root);
}
my $ret = $doc->toString();
log TRACE, $ret;
return $ret;
}
sub master_launch
{
my $args = shift;
my @lnodes;
my @warn;
if ($args->{unamed})
{
for (my $i = $args->{unamed}; $i > 0; $i--)
{
if (grep { $args->{param}{$i} eq $_ } @nodes) {
push @lnodes, $args->{param}{$i};
} else {
push @warn, $args->{param}{$i}." not a currently launched architecture.";
}
}
}
else {
@lnodes = @nodes;
}
log DEBUG, "Launching nodes...";
my %ret;
my $client = Gearman::Client->new;
$client->job_servers('gearmand:4730');
my $taskset = $client->new_task_set;
for my $node (@lnodes)
{
log DEBUG, "Launching $node...";
$taskset->add_task(
"guantanamo_".$node => build_task_xml($args->{files}, $args->{subtree}),
{
on_complete => sub {
my $dom = XML::LibXML->load_xml(string => ${ $_[0] });
$ret{ $node } = $dom;
}
});
}
$taskset->wait;
if ($args->{subtree}->hasAttribute("output") && $args->{subtree}->getAttribute("output") eq "text")
{
my $output = "";
for my $w (@warn) {
$output .= $w."\n";
}
for my $node (@lnodes) {
my $o = $ret{$node}->documentElement->getElementsByTagName("out");
if ($o) {
$output .= $o[0]->firstChild->nodeValue;
}
$e = $ret{$node}->documentElement->getElementsByTagName("err");
if ($e) {
$output .= $e[0]->firstChild->nodeValue;
}
$output .= $e[0]->firstChild->nodeValue;
}
return $output;
}
else
{
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("process");
$doc->setDocumentElement( $root );
for my $w (@warn)
{
my $warning = $doc->createElement("warning");
$warning->appendText($w);
$root->appendChild($warning);
}
for my $k (keys %ret)
{
$root->appendChild($ret{ $k }->documentElement);
}
return $doc->toString();
}
}
sub process_master
{
my ($given_args, $args) = @_;
my $action = $args->{param}{action} // "launch";
if (! exists $master_actions{$action}) {
log WARN, "Unknown action '$action' for guantanamo master process.";
}
return $master_actions{$action}($args);
}
log INFO, "Starting guantanamo.pl as master process";
Process::register("guantanamo", \&process_master);

108
process/exec/guantanamo_node.pl Normal file
View file

@ -0,0 +1,108 @@
#!/usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use Carp;
use File::Path qw(make_path remove_tree);
use File::Temp qw/tempfile tempdir/;
use IPC::Open3;
use XML::LibXML;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
my %node_actions =
(
"launch" => \&node_launch,
);
sub node_launch
{
my $args = shift;
# First, create a temporary directory
my $dir = tempdir();
chdir( $dir );
# Extract all files to current directory
for my $filename (keys %{ $args->{files} })
{
open my $fh, ">", $filename or croak("$filename: $!");
print $fh $args->{files}{$filename};
close $fh;
}
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("target");
$root->addChild( $doc->createAttribute("name", $ARGV[0]) );
$doc->setDocumentElement( $root );
for my $c ($args->{subtree}->getElementsByTagName("command"))
{
if (! exists $c->{attributes}{target} ||
index($c->{attributes}{target}, $ARGV[0]) != -1) {
my $cmd = $doc->createElement("cmd");
if (! exists $c->{attributes}{hide}) {
$root->appendChild($cmd);
}
my $command = $doc->createElement("command");
$command->appendText($c->{nodeValue});
$cmd->appendChild($command);
my($wtr, $rdr, $stderr);
my $pid = open3($wtr, $rdr, $stderr, $c->{nodeValue});
waitpid( $pid, 0 );
my $rv = $? >> 8;
my $out = $doc->createElement("out");
my $str = "";
if ($rdr) {
$str .= $_ while (<$rdr>);
}
$out->appendText($str);
$cmd->appendChild($out);
my $err = $doc->createElement("err");
$str = "";
if ($stderr) {
$str .= $_ while (<$stderr>);
}
$err->appendText($str);
$cmd->appendChild($err);
my $ret = $doc->createElement("return");
$ret->appendText($rv);
$cmd->appendChild($ret);
}
}
chdir();
remove_tree( $dir );
return $doc->toString();
}
sub process_node
{
my ($given_args, $args) = @_;
my $action = $args->{param}{action} // "launch";
if (! exists $node_actions{$action}) {
log WARN, "Unknown action '$action' for guantanamo node process.";
}
return $node_actions{$action}($args);
}
if ($#ARGV == 0)
{
log INFO, "Starting guantanamo.pl as node process";
Process::Client::launch("guantanamo", {"action" => "register", "nodename" => $ARGV[0]});
Process::register("guantanamo_".$ARGV[0], \&process_node);
}