package LATMOS::Accounts; use 5.010000; use strict; use warnings; use base qw(Config::IniFiles); use LATMOS::Accounts::Bases; use LATMOS::Accounts::Synchro; use LATMOS::Accounts::SynchAccess; use LATMOS::Accounts::Log; use LATMOS::Accounts::Acls; our $VERSION = '4.0.7'; =head1 NAME LATMOS::Accounts - Core module for LATMOS account management tools =head1 DESCRITPTION =cut # Return the configuration directory according settings: # sub _configdir { my ($self) = @_; $ENV{LA_CONFIG} || ($self || {})->{_configdir} || '/etc/latmos-accounts' } =head1 FUNCTION =head2 new($configdir, %options) Instanciate a new LATMOS::Accounts object. C<$configdir> if defined is the directory containing files to use, default to F. C<%options> can contains: =over 4 =item noacl If true, acls configuration are not load and code act like everything is allowed. This flag is usefull for administrative tools, for which no acl must apply. =back =cut sub new { my ($class, $config, %options) = @_; $config ||= _configdir(); my $configfile = join('/', $config, 'latmos-accounts.ini'); my $self = Config::IniFiles->new( -file => $configfile, '-default' => '_default_', ) or do { la_log(LA_ERR, 'Can\'t open main config file %s', $configfile); return; }; $self->{_configdir} = $config; bless($self, $class); unless ($options{noacl}) { if (-f (my $aclf = join('/', $self->_configdir, 'la-acls.ini'))) { $self->{_acls} = LATMOS::Accounts::Acls->new($aclf) or do { la_log(LA_ERR, 'Cannot load ACL file %s', $aclf); return; }; } } if (-f (my $allowf = join('/', $self->_configdir, 'la-allowed-values.ini'))) { $self->{_allowed_values} = Config::IniFiles->new( -file => $allowf, ) or do { la_log(LA_ERR, 'Cannot load ALLOWED VALUES %s', $allowf); return; }; } $self } =head2 list_bases Return the base list found in config file =cut sub list_bases { my ($self) = @_; grep { !m/^_.*_$/ && !m/^sync:/ } $self->Sections } =head2 default_base_name Return the default base name according config file =cut sub default_base_name { my ($self) = @_; $self->val('_default_', 'base', ($self->list_bases)[0]); } =head2 base($basename) Return a L object over base named $basename defined in the config file. The base is loaded by this function. =cut sub base { my ($self, $section) = @_; # this method perform a cache $self->_load_base($section || $self->default_base_name); } # do the bad work sub _load_base { my ($self, $section) = @_; my $type = $self->val($section, 'type') or return; my %params = map { $_ => ($self->val($section, $_)) } $self->Parameters($section); my %defattr = map { $_ => ($self->val('_defattr_', $_)) } $self->Parameters('_defattr_'); my $base = LATMOS::Accounts::Bases->new( $type, { params => \%params, label => $section, acls => $self->{_acls}, allowed_values => $self->{_allowed_values}, configdir => $self->_configdir, la => $self, defattr => { %defattr }, }, ) or do { la_log(LA_WARN, "Cannot instanciate base $section ($type)"); return; }; $base->load or return; $base; } =head2 list_synchro List synchronisation setup in L =cut sub list_synchro { my ($self) = @_; grep { $_ } map { /^sync:(.*)$/; $1 } $self->Sections } =head2 default_synchro_name Return de default synchronisation name =cut sub default_synchro_name { my ($self) = @_; $self->val('_default_', 'sync'); } =head2 default_synchro Return a reference to default synchronisation object =cut sub default_synchro { my ($self, %options) = @_; my $syncname = $self->default_synchro_name or do { la_log(LA_ERR, 'Cannot find default synchro in config'); return; }; $self->create_synchro($syncname, %options); } =head2 create_synchro($name, %options) Return a reference to synchronisation object for C<$name> synchronisation. =cut sub create_synchro { my ($self, $name, %options) = @_; # taking options from config if ($name) { foreach my $param ($self->Parameters("sync:$name")) { if (!defined($options{$param})) { my @args = $self->val("sync:$name", $param); $options{$param} = ($args[1] || $param eq 'to') ? [ @args ] : $args[0]; } } } my $labfrom = $options{from} ? $self->base($options{from}) : $self->default_base; my @labto = grep { $_ } map { $self->base($_) } @{ $options{to} || []} or do { la_log(LA_ERR, "No destination base load in this synchro"); return; }; my $sync = LATMOS::Accounts::Synchro->new( $labfrom, [ @labto ], state_dir => ($self->val('_default_', 'state_dir') || undef), %options, name => $name, ); } sub _sync_from_name { my ($self, $syncname) = @_; return if (!$syncname); $self->val("sync:$syncname", 'from', $self->default_base_name); } =head2 sync_access($name, %options) Return a L object over C<$name> synchronisation. =cut sub sync_access { my ($self, $name, %options) = @_; my @obases; if ($name) { @obases = (map { $self->base($_) } ($self->_sync_from_name($name), $self->val("sync:$name", 'to'))); } elsif(@{ $options{bases} || []}) { @obases = map { $self->base($_) } @{ $options{bases} || []}; } elsif (my $sname = $self->default_synchro_name) { @obases = (map { $self->base($_) } ($self->_sync_from_name($sname), $self->val("sync:$sname", 'to')) ); } LATMOS::Accounts::SynchAccess->new([ @obases ]); } =head2 call_batch_sync Send signal to L daemon to synchronize bases. =cut sub call_batch_sync { my ($self) = @_; if (my $sd = $self->val('_default_', 'state_dir')) { if (open(my $fh, '<', $sd . '/sync-manager.pid')) { my $pid = <$fh> || ''; chomp($pid); close($fh); if ($pid && kill 1, $pid) { return 1; # \o/ we succeed } else { la_log(LA_ERR, "Can send signal -1 to la-sync-manager (pid: %s, %s)", $pid || 'none', $!); return; } } else { la_log(LA_ERR, 'Cannot open la-sync-manager pid file'); return; } } else { la_log(LA_WARN, "No statedir setup, cannot find la-sync-manager pid file"); return; } } 1; __END__ =head1 AUTHOR Thauvin Olivier, Eolivier.thauvin@latmos.ipsl.frE =head1 COPYRIGHT AND LICENSE Copyright (C) 2009, 2010, 2011, 2012 by Thauvin Olivier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =cut