Add process management
This commit is contained in:
Mercier Pierre-Olivier
parent
f978072748
commit
18d9152b13
291
ACU/Process.pm
Normal file
291
ACU/Process.pm
Normal file
@ -0,0 +1,291 @@
|
|||||||
|
#! /usr/bin/env perl
|
||||||
|
|
||||||
|
package Process;
|
||||||
|
|
||||||
|
use v5.10.1;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Carp;
|
||||||
|
use Gearman::Worker;
|
||||||
|
use XML::LibXML;
|
||||||
|
use XML::SAX::ParserFactory;
|
||||||
|
use List::Util "reduce";
|
||||||
|
use Scalar::Util qw(looks_like_number);
|
||||||
|
|
||||||
|
use constant COEFF_OLD => 25;
|
||||||
|
use constant WAITING_LOAD => 2;
|
||||||
|
|
||||||
|
open(my $cpuinfo, "<", "/proc/cpuinfo");
|
||||||
|
our $nb_cpus = 0;
|
||||||
|
$nb_cpus = grep {/^processor\s/} <$cpuinfo>;
|
||||||
|
close $cpuinfo;
|
||||||
|
|
||||||
|
sub check_load ($)
|
||||||
|
{
|
||||||
|
my $priority = shift;
|
||||||
|
my $load = 0;
|
||||||
|
|
||||||
|
# Get load by parsing uptime command output
|
||||||
|
open my $fh, '-|', 'uptime';
|
||||||
|
$load = $1 if <$fh> =~ /load average: (.+?),/;
|
||||||
|
close $fh;
|
||||||
|
|
||||||
|
return (($load * 4 / $nb_cpus) < $priority);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub do_work ($$$@)
|
||||||
|
{
|
||||||
|
my $subref = shift;
|
||||||
|
my $given_args = shift;
|
||||||
|
my $priority = shift;
|
||||||
|
|
||||||
|
my $old = 0;
|
||||||
|
# Check the load isn't to high for this process
|
||||||
|
sleep WAITING_LOAD while ! check_load ($priority + (++$old / COEFF_OLD));
|
||||||
|
|
||||||
|
# Parse arguments
|
||||||
|
my $args = {
|
||||||
|
id => undef,
|
||||||
|
priority => 10,
|
||||||
|
auth => undef,
|
||||||
|
param => {},
|
||||||
|
unamed => 0,
|
||||||
|
files => {},
|
||||||
|
subtree => undef
|
||||||
|
};
|
||||||
|
|
||||||
|
my $sax_handler = ProcessHandler->new($args);
|
||||||
|
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
|
||||||
|
|
||||||
|
$parser->parse_string(${ $_[0]{argref} });
|
||||||
|
|
||||||
|
return $subref->($given_args, $args);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub register ($$;$$)
|
||||||
|
{
|
||||||
|
my $funcname = shift;
|
||||||
|
my $subref = shift;
|
||||||
|
my $given_arg = shift;
|
||||||
|
my $priority = shift // 1;
|
||||||
|
|
||||||
|
my $worker = Gearman::Worker->new;
|
||||||
|
|
||||||
|
$worker->job_servers('gearmand:4730');
|
||||||
|
$worker->register_function($funcname => sub { return do_work($subref, $given_arg, $priority, @_); });
|
||||||
|
|
||||||
|
say "$funcname registered";
|
||||||
|
|
||||||
|
$worker->work while 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
package SubtreeItem;
|
||||||
|
|
||||||
|
sub new ($$)
|
||||||
|
{
|
||||||
|
my $class = shift;
|
||||||
|
my $self = {
|
||||||
|
nodeName => shift,
|
||||||
|
attributes => {},
|
||||||
|
nodeValue => "",
|
||||||
|
children => []
|
||||||
|
};
|
||||||
|
|
||||||
|
bless $self, $class;
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getAttribute ($$)
|
||||||
|
{
|
||||||
|
my ($self, $name) = @_;
|
||||||
|
|
||||||
|
return $self->{attributes}->{$name};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub hasAttribute ($$)
|
||||||
|
{
|
||||||
|
my ($self, $name) = @_;
|
||||||
|
|
||||||
|
return exists $self->{attributes}->{$name};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getAllChildren($)
|
||||||
|
{
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
my @queue;
|
||||||
|
my @elements;
|
||||||
|
|
||||||
|
for my $child (@{ $self->{children} }) {
|
||||||
|
push @queue, $child;
|
||||||
|
}
|
||||||
|
|
||||||
|
while (@queue) {
|
||||||
|
my $child = shift @queue;
|
||||||
|
|
||||||
|
for my $child2 (@{ $child->{children} }) {
|
||||||
|
push @queue, $child2;
|
||||||
|
}
|
||||||
|
|
||||||
|
push @elements, $child;
|
||||||
|
}
|
||||||
|
|
||||||
|
return @elements;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub hasChildNodes ($)
|
||||||
|
{
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
return @{ $self->{children} } > 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getData ($)
|
||||||
|
{
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
return $self->nodeValue;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getElementsByTagName ($$)
|
||||||
|
{
|
||||||
|
my ($self, $name) = @_;
|
||||||
|
|
||||||
|
return grep { $name eq "*" or $_->{nodeName} eq $name } getAllChildren($self);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getElementById ($$)
|
||||||
|
{
|
||||||
|
my ($self, $name) = @_;
|
||||||
|
|
||||||
|
return grep { $_->{attributes}->{id} eq $name } getAllChildren($self);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getFirstChild ($)
|
||||||
|
{
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
return $self->{children}[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
package ProcessHandler;
|
||||||
|
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
sub new ($$)
|
||||||
|
{
|
||||||
|
my $class = shift;
|
||||||
|
my $self = {
|
||||||
|
parsed => shift,
|
||||||
|
fileEnc => "",
|
||||||
|
inFile => "",
|
||||||
|
inParam => "",
|
||||||
|
subtreeStack => [],
|
||||||
|
values => ""
|
||||||
|
};
|
||||||
|
|
||||||
|
bless $self, $class;
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub start_element
|
||||||
|
{
|
||||||
|
my ($self, $element) = @_;
|
||||||
|
|
||||||
|
if (@{ $self->{subtreeStack} } > 0 || $element->{Name} eq "subtree") {
|
||||||
|
my $item = SubtreeItem->new($element->{Name});
|
||||||
|
|
||||||
|
for my $attribute (keys %{ $element->{Attributes} }) {
|
||||||
|
my $attr = $attribute;
|
||||||
|
$attr =~ s/{}//;
|
||||||
|
$item->{attributes}->{$attr} = $element->{Attributes}{$attribute}{Value};
|
||||||
|
}
|
||||||
|
|
||||||
|
if (@{ $self->{subtreeStack} } > 0) {
|
||||||
|
$self->{subtreeStack}[-1]->{nodeValue} .= $self->{values};
|
||||||
|
}
|
||||||
|
push @{ $self->{subtreeStack} }, $item;
|
||||||
|
$self->{values} = "";
|
||||||
|
}
|
||||||
|
elsif ($element->{Name} eq "process") {
|
||||||
|
$self->{parsed}{auth} = $element->{Attributes}{"{}auth"}{Value};
|
||||||
|
$self->{parsed}{id} = $element->{Attributes}{"{}id"}{Value};
|
||||||
|
$self->{parsed}{priority} = $element->{Attributes}{"{}priority"}{Value};
|
||||||
|
}
|
||||||
|
elsif ($element->{Name} eq "file") {
|
||||||
|
$self->{inFile} = $element->{Attributes}{"{}name"}{Value};
|
||||||
|
$self->{fileEnc} = $element->{Attributes}{"{}encoding"}{Value} // "base64";
|
||||||
|
$self->{values} = "";
|
||||||
|
}
|
||||||
|
elsif ($element->{Name} eq "param") {
|
||||||
|
if ($element->{Attributes}{"{}name"}{Value}) {
|
||||||
|
$self->{inParam} = $element->{Attributes}{"{}name"}{Value};
|
||||||
|
} else {
|
||||||
|
$self->{inParam} = ++$self->{parsed}{unamed};
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{values} = "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub characters
|
||||||
|
{
|
||||||
|
my ($self, $characters) = @_;
|
||||||
|
|
||||||
|
if ($self->{inFile} || $self->{inParam} || @{ $self->{subtreeStack} } > 0) {
|
||||||
|
$self->{values} .= $characters->{Data};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub end_element
|
||||||
|
{
|
||||||
|
my ($self, $element) = @_;
|
||||||
|
|
||||||
|
if (@{ $self->{subtreeStack} } > 0)
|
||||||
|
{
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$self->{parsed}{subtree} = $item;
|
||||||
|
}
|
||||||
|
$self->{values} = "";
|
||||||
|
}
|
||||||
|
elsif ($element->{Name} eq "param") {
|
||||||
|
$self->{parsed}{param}{ $self->{inParam} } = $self->{values};
|
||||||
|
$self->{inParam} = "";
|
||||||
|
$self->{values} = "";
|
||||||
|
}
|
||||||
|
elsif ($element->{Name} eq "file") {
|
||||||
|
$self->{parsed}{files}{ $self->{inFile} } = decode_file($self->{values}, $self->{fileEnc});
|
||||||
|
$self->{values} = "";
|
||||||
|
$self->{inFile} = "";
|
||||||
|
$self->{fileEnc} = "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub decode_file ($$)
|
||||||
|
{
|
||||||
|
my $content = shift;
|
||||||
|
my $encoding = shift;
|
||||||
|
|
||||||
|
if ($encoding eq "base64")
|
||||||
|
{
|
||||||
|
use MIME::Base64;
|
||||||
|
|
||||||
|
return decode_base64($content);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
croak "$encoding is not a known encoding."
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
133
process/ldap/update_group.pl
Normal file
133
process/ldap/update_group.pl
Normal file
@ -0,0 +1,133 @@
|
|||||||
|
#! /usr/bin/env perl
|
||||||
|
|
||||||
|
use v5.10.1;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Pod::Usage;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
push @INC, "../../";
|
||||||
|
}
|
||||||
|
|
||||||
|
use ACU::LDAP;
|
||||||
|
use ACU::Process;
|
||||||
|
|
||||||
|
our $ou = "intra";
|
||||||
|
|
||||||
|
my %actions =
|
||||||
|
(
|
||||||
|
"new" => \&group_new,
|
||||||
|
"add" => \&group_add,
|
||||||
|
"delete" => \&group_delete,
|
||||||
|
"flush" => \&group_flush,
|
||||||
|
"remove" => \&group_remove,
|
||||||
|
"update" => \&group_update,
|
||||||
|
);
|
||||||
|
|
||||||
|
sub group_new($$)
|
||||||
|
{
|
||||||
|
my $dn = shift;
|
||||||
|
my $args = shift;
|
||||||
|
|
||||||
|
# Add group
|
||||||
|
if (LDAP::add_group($args->{param}{cn}, LDAP::get_year) eq $dn)
|
||||||
|
{
|
||||||
|
if ($args->{param}{type}) {
|
||||||
|
group_add $dn, $args
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub group_add($$)
|
||||||
|
{
|
||||||
|
my $dn = shift;
|
||||||
|
my $args = shift;
|
||||||
|
|
||||||
|
my $cnt_type = group_get_type $args->{param};
|
||||||
|
|
||||||
|
# Add content if any
|
||||||
|
for (my $i = $args->{unamed}; $i > 0; $i--) {
|
||||||
|
LDAP::add_attribute($dn, $cnt_type, $args->{param}{$i});
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub group_delete($$)
|
||||||
|
{
|
||||||
|
return LDAP::delete_entry(shift);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub group_flush($$)
|
||||||
|
{
|
||||||
|
my $dn = shift;
|
||||||
|
my $args = shift;
|
||||||
|
|
||||||
|
my $cnt_type = group_get_type $args->{param};
|
||||||
|
|
||||||
|
return LDAP::flush_attribute($dn, $cnt_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub group_remove($$)
|
||||||
|
{
|
||||||
|
my $dn = shift;
|
||||||
|
my $args = shift;
|
||||||
|
|
||||||
|
my $cnt_type = group_get_type $args->{param};
|
||||||
|
|
||||||
|
my @data;
|
||||||
|
for (my $i = $args->{unamed}; $i > 0; $i--) {
|
||||||
|
push @data, $i;
|
||||||
|
}
|
||||||
|
|
||||||
|
return LDAP::delete_attributes($dn, $cnt_type, \@data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub group_update($$)
|
||||||
|
{
|
||||||
|
my $dn = shift;
|
||||||
|
my $args = shift;
|
||||||
|
|
||||||
|
my $cnt_type = group_get_type $args->{param};
|
||||||
|
|
||||||
|
my @data;
|
||||||
|
for (my $i = $args->{unamed}; $i > 0; $i--) {
|
||||||
|
push @data, $i;
|
||||||
|
}
|
||||||
|
|
||||||
|
LDAP::update_attribute($dn, $cnt_type, \@data);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub group_get_type($)
|
||||||
|
{
|
||||||
|
my $param = shift;
|
||||||
|
|
||||||
|
# Extract data type
|
||||||
|
if ($param{type} eq "members") {
|
||||||
|
return "memberUid";
|
||||||
|
}
|
||||||
|
elsif ($param{type} eq "rights") {
|
||||||
|
return "intraRights" ;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
die ("Unknown type to add: ".$param{type});
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub process
|
||||||
|
{
|
||||||
|
my ($given_args, $args) = @_;
|
||||||
|
|
||||||
|
my $year = $param{year} // LDAP::get_year;
|
||||||
|
my $dn = "cn=".$param{cn}."ou=$year,ou=$ou,ou=groups,dc=acu,dc=epita,dc=fr";
|
||||||
|
my $action = $param{type} // "update";
|
||||||
|
|
||||||
|
# Read action
|
||||||
|
if (! exists $actions{$action}) {
|
||||||
|
return "Unknown command for update_group: ". $action;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $actions{$action}($dn, $args);
|
||||||
|
}
|
||||||
|
|
||||||
|
Process::register("update_group", \&process);
|
||||||
Reference in New Issue
Block a user