[1] | 1 | package LATMOS::Accounts; |
---|
| 2 | |
---|
| 3 | use 5.010000; |
---|
| 4 | use strict; |
---|
| 5 | use warnings; |
---|
[22] | 6 | use base qw(Config::IniFiles); |
---|
| 7 | use LATMOS::Accounts::Bases; |
---|
[50] | 8 | use LATMOS::Accounts::Synchro; |
---|
[56] | 9 | use LATMOS::Accounts::SynchAccess; |
---|
[255] | 10 | use LATMOS::Accounts::Log; |
---|
[320] | 11 | use LATMOS::Accounts::Acls; |
---|
[1546] | 12 | use LATMOS::Accounts::I18N; |
---|
[1] | 13 | |
---|
[1929] | 14 | our $VERSION = '5.2.9'; |
---|
[1] | 15 | |
---|
[255] | 16 | =head1 NAME |
---|
| 17 | |
---|
| 18 | LATMOS::Accounts - Core module for LATMOS account management tools |
---|
| 19 | |
---|
| 20 | =head1 DESCRITPTION |
---|
| 21 | |
---|
| 22 | =cut |
---|
| 23 | |
---|
[1041] | 24 | # Return the configuration directory according settings: |
---|
| 25 | # |
---|
[861] | 26 | sub _configdir { |
---|
| 27 | my ($self) = @_; |
---|
[1029] | 28 | $ENV{LA_CONFIG} || |
---|
| 29 | ($self || {})->{_configdir} || |
---|
| 30 | '/etc/latmos-accounts' |
---|
[861] | 31 | } |
---|
| 32 | |
---|
[255] | 33 | =head1 FUNCTION |
---|
| 34 | |
---|
[1042] | 35 | =head2 new($configdir, %options) |
---|
[255] | 36 | |
---|
| 37 | Instanciate a new LATMOS::Accounts object. |
---|
| 38 | |
---|
[1042] | 39 | C<$configdir> if defined is the directory containing files to use, |
---|
[861] | 40 | default to F</etc/latmos-accounts/>. |
---|
[255] | 41 | |
---|
[1042] | 42 | C<%options> can contains: |
---|
| 43 | |
---|
| 44 | =over 4 |
---|
| 45 | |
---|
| 46 | =item noacl |
---|
| 47 | |
---|
| 48 | If true, acls configuration are not load and code act like everything is |
---|
| 49 | allowed. |
---|
| 50 | |
---|
| 51 | This flag is usefull for administrative tools, for which no acl must apply. |
---|
| 52 | |
---|
| 53 | =back |
---|
| 54 | |
---|
[255] | 55 | =cut |
---|
| 56 | |
---|
[22] | 57 | sub new { |
---|
[457] | 58 | my ($class, $config, %options) = @_; |
---|
[1] | 59 | |
---|
[861] | 60 | $config ||= _configdir(); |
---|
[24] | 61 | |
---|
[1041] | 62 | my $configfile = join('/', $config, 'latmos-accounts.ini'); |
---|
[861] | 63 | |
---|
[22] | 64 | my $self = Config::IniFiles->new( |
---|
[861] | 65 | -file => $configfile, |
---|
[73] | 66 | '-default' => '_default_', |
---|
[861] | 67 | ) or do { |
---|
| 68 | la_log(LA_ERR, 'Can\'t open main config file %s', $configfile); |
---|
| 69 | return; |
---|
| 70 | }; |
---|
| 71 | |
---|
| 72 | $self->{_configdir} = $config; |
---|
| 73 | bless($self, $class); |
---|
| 74 | |
---|
[1042] | 75 | unless ($options{noacl}) { |
---|
| 76 | if (-f (my $aclf = join('/', $self->_configdir, 'la-acls.ini'))) { |
---|
[861] | 77 | $self->{_acls} = LATMOS::Accounts::Acls->new($aclf) or do { |
---|
| 78 | la_log(LA_ERR, 'Cannot load ACL file %s', $aclf); |
---|
| 79 | return; |
---|
| 80 | }; |
---|
| 81 | } |
---|
[320] | 82 | } |
---|
[1] | 83 | |
---|
[1042] | 84 | if (-f (my $allowf = join('/', $self->_configdir, 'la-allowed-values.ini'))) { |
---|
[683] | 85 | $self->{_allowed_values} = Config::IniFiles->new( |
---|
[861] | 86 | -file => $allowf, |
---|
| 87 | ) or do { |
---|
| 88 | la_log(LA_ERR, 'Cannot load ALLOWED VALUES %s', $allowf); |
---|
| 89 | return; |
---|
| 90 | }; |
---|
[683] | 91 | } |
---|
| 92 | |
---|
[861] | 93 | $self |
---|
[22] | 94 | } |
---|
[1] | 95 | |
---|
[1043] | 96 | =head2 list_bases |
---|
| 97 | |
---|
| 98 | Return the base list found in config file |
---|
| 99 | |
---|
| 100 | =cut |
---|
| 101 | |
---|
| 102 | sub list_bases { |
---|
| 103 | my ($self) = @_; |
---|
| 104 | grep { |
---|
| 105 | !m/^_.*_$/ && |
---|
| 106 | !m/^sync:/ |
---|
| 107 | } $self->Sections |
---|
| 108 | } |
---|
| 109 | |
---|
| 110 | =head2 default_base_name |
---|
[255] | 111 | |
---|
[1043] | 112 | Return the default base name according config file |
---|
[255] | 113 | |
---|
| 114 | =cut |
---|
| 115 | |
---|
[1043] | 116 | sub default_base_name { |
---|
[255] | 117 | my ($self) = @_; |
---|
[1043] | 118 | $self->val('_default_', 'base', ($self->list_bases)[0]); |
---|
[255] | 119 | } |
---|
| 120 | |
---|
| 121 | =head2 base($basename) |
---|
| 122 | |
---|
| 123 | Return a L<LATMOS::Accounts::Base> object over base named $basename |
---|
| 124 | defined in the config file. |
---|
| 125 | |
---|
| 126 | The base is loaded by this function. |
---|
| 127 | |
---|
| 128 | =cut |
---|
| 129 | |
---|
[22] | 130 | sub base { |
---|
| 131 | my ($self, $section) = @_; |
---|
| 132 | # this method perform a cache |
---|
[868] | 133 | $self->_load_base($section || $self->default_base_name); |
---|
[22] | 134 | } |
---|
[1] | 135 | |
---|
[22] | 136 | # do the bad work |
---|
| 137 | sub _load_base { |
---|
| 138 | my ($self, $section) = @_; |
---|
| 139 | my $type = $self->val($section, 'type') or return; |
---|
[1406] | 140 | la_log(LA_DEBUG, "Trying to load base %s", $section); |
---|
[1071] | 141 | |
---|
| 142 | my %params = |
---|
| 143 | map { $_ => ($self->val($section, $_)) } |
---|
| 144 | $self->Parameters($section); |
---|
| 145 | |
---|
| 146 | my %defattr = |
---|
| 147 | map { $_ => ($self->val('_defattr_', $_)) } |
---|
| 148 | $self->Parameters('_defattr_'); |
---|
| 149 | |
---|
[320] | 150 | my $base = LATMOS::Accounts::Bases->new( |
---|
| 151 | $type, |
---|
[1071] | 152 | { |
---|
| 153 | params => \%params, |
---|
| 154 | label => $section, |
---|
| 155 | acls => $self->{_acls}, |
---|
| 156 | allowed_values => $self->{_allowed_values}, |
---|
| 157 | configdir => $self->_configdir, |
---|
| 158 | la => $self, |
---|
| 159 | defattr => { %defattr }, |
---|
| 160 | }, |
---|
[320] | 161 | ) or do { |
---|
[255] | 162 | la_log(LA_WARN, "Cannot instanciate base $section ($type)"); |
---|
[192] | 163 | return; |
---|
| 164 | }; |
---|
[1406] | 165 | $base->load or do { |
---|
| 166 | la_log(LA_ERR, "%s didn't load", $base->label); |
---|
| 167 | return; |
---|
| 168 | }; |
---|
[34] | 169 | $base; |
---|
[22] | 170 | } |
---|
[1] | 171 | |
---|
[1043] | 172 | =head2 list_synchro |
---|
[1012] | 173 | |
---|
[1043] | 174 | List synchronisation setup in L<latmos-accounts.ini> |
---|
[1012] | 175 | |
---|
| 176 | =cut |
---|
| 177 | |
---|
[1043] | 178 | sub list_synchro { |
---|
[77] | 179 | my ($self) = @_; |
---|
[1043] | 180 | grep { $_ } map { /^sync:(.*)$/; $1 } $self->Sections |
---|
[77] | 181 | } |
---|
| 182 | |
---|
[1043] | 183 | =head2 default_synchro_name |
---|
[1012] | 184 | |
---|
[1043] | 185 | Return de default synchronisation name |
---|
[1012] | 186 | |
---|
| 187 | =cut |
---|
| 188 | |
---|
[1043] | 189 | sub default_synchro_name { |
---|
[77] | 190 | my ($self) = @_; |
---|
[1043] | 191 | $self->val('_default_', 'sync'); |
---|
[77] | 192 | } |
---|
| 193 | |
---|
[1012] | 194 | =head2 default_synchro |
---|
| 195 | |
---|
| 196 | Return a reference to default synchronisation object |
---|
| 197 | |
---|
| 198 | =cut |
---|
| 199 | |
---|
[77] | 200 | sub default_synchro { |
---|
[78] | 201 | my ($self, %options) = @_; |
---|
[317] | 202 | my $syncname = $self->default_synchro_name or do { |
---|
| 203 | la_log(LA_ERR, 'Cannot find default synchro in config'); |
---|
| 204 | return; |
---|
| 205 | }; |
---|
[78] | 206 | $self->create_synchro($syncname, %options); |
---|
[77] | 207 | } |
---|
| 208 | |
---|
[1012] | 209 | =head2 create_synchro($name, %options) |
---|
[41] | 210 | |
---|
[1012] | 211 | Return a reference to synchronisation object for C<$name> synchronisation. |
---|
| 212 | |
---|
| 213 | =cut |
---|
| 214 | |
---|
[50] | 215 | sub create_synchro { |
---|
[73] | 216 | my ($self, $name, %options) = @_; |
---|
[50] | 217 | |
---|
[73] | 218 | # taking options from config |
---|
| 219 | if ($name) { |
---|
| 220 | foreach my $param ($self->Parameters("sync:$name")) { |
---|
| 221 | if (!defined($options{$param})) { |
---|
| 222 | my @args = $self->val("sync:$name", $param); |
---|
| 223 | $options{$param} = ($args[1] || $param eq 'to') |
---|
| 224 | ? [ @args ] |
---|
| 225 | : $args[0]; |
---|
| 226 | } |
---|
| 227 | } |
---|
| 228 | } |
---|
[50] | 229 | |
---|
[1354] | 230 | my $labfrom = $options{from} ? $self->base($options{from}) : $self->base; |
---|
[50] | 231 | |
---|
[192] | 232 | my @labto = |
---|
| 233 | grep { $_ } |
---|
| 234 | map { $self->base($_) } |
---|
| 235 | @{ $options{to} || []} |
---|
[317] | 236 | or do { |
---|
| 237 | la_log(LA_ERR, "No destination base load in this synchro"); |
---|
| 238 | return; |
---|
| 239 | }; |
---|
[73] | 240 | |
---|
[50] | 241 | my $sync = LATMOS::Accounts::Synchro->new( |
---|
| 242 | $labfrom, [ @labto ], |
---|
[563] | 243 | state_dir => ($self->val('_default_', 'state_dir') || undef), |
---|
[73] | 244 | %options, |
---|
[77] | 245 | name => $name, |
---|
[50] | 246 | ); |
---|
| 247 | } |
---|
| 248 | |
---|
[1058] | 249 | sub _sync_from_name { |
---|
| 250 | my ($self, $syncname) = @_; |
---|
| 251 | return if (!$syncname); |
---|
| 252 | $self->val("sync:$syncname", 'from', $self->default_base_name); |
---|
| 253 | } |
---|
| 254 | |
---|
[1012] | 255 | =head2 sync_access($name, %options) |
---|
| 256 | |
---|
| 257 | Return a L<LATMOS::Accounts::SynchAccess> object over C<$name> synchronisation. |
---|
| 258 | |
---|
| 259 | =cut |
---|
| 260 | |
---|
[56] | 261 | sub sync_access { |
---|
[73] | 262 | my ($self, $name, %options) = @_; |
---|
| 263 | |
---|
[178] | 264 | my @obases; |
---|
| 265 | if ($name) { |
---|
| 266 | @obases = |
---|
[1058] | 267 | (map { $self->base($_) } ($self->_sync_from_name($name), $self->val("sync:$name", 'to'))); |
---|
[178] | 268 | } elsif(@{ $options{bases} || []}) { |
---|
| 269 | @obases = map { $self->base($_) } @{ $options{bases} || []}; |
---|
| 270 | } elsif (my $sname = $self->default_synchro_name) { |
---|
| 271 | @obases = (map { $self->base($_) } |
---|
[1058] | 272 | ($self->_sync_from_name($sname), $self->val("sync:$sname", 'to')) |
---|
[178] | 273 | ); |
---|
| 274 | } |
---|
| 275 | |
---|
[1405] | 276 | if (!@obases) { |
---|
| 277 | la_log(LA_ERR, "Cannot load any bases for syncronised action"); |
---|
| 278 | return; |
---|
| 279 | } |
---|
| 280 | |
---|
| 281 | la_log(LA_DEBUG, "Load databases: %s", join(', ', map { $_->label } @obases)); |
---|
| 282 | |
---|
[56] | 283 | LATMOS::Accounts::SynchAccess->new([ @obases ]); |
---|
| 284 | } |
---|
[50] | 285 | |
---|
[1047] | 286 | =head2 call_batch_sync |
---|
| 287 | |
---|
| 288 | Send signal to L<la-sync-manager> daemon to synchronize bases. |
---|
| 289 | |
---|
| 290 | =cut |
---|
| 291 | |
---|
| 292 | sub call_batch_sync { |
---|
| 293 | my ($self) = @_; |
---|
| 294 | if (my $sd = $self->val('_default_', 'state_dir')) { |
---|
| 295 | if (open(my $fh, '<', $sd . '/sync-manager.pid')) { |
---|
| 296 | my $pid = <$fh> || ''; |
---|
| 297 | chomp($pid); |
---|
| 298 | close($fh); |
---|
| 299 | if ($pid && kill 1, $pid) { |
---|
| 300 | return 1; # \o/ we succeed |
---|
| 301 | } else { |
---|
| 302 | la_log(LA_ERR, "Can send signal -1 to la-sync-manager (pid: %s, %s)", |
---|
| 303 | $pid || 'none', $!); |
---|
| 304 | return; |
---|
| 305 | } |
---|
| 306 | } else { |
---|
| 307 | la_log(LA_ERR, 'Cannot open la-sync-manager pid file'); |
---|
| 308 | return; |
---|
| 309 | } |
---|
| 310 | } else { |
---|
| 311 | la_log(LA_WARN, "No statedir setup, cannot find la-sync-manager pid file"); |
---|
| 312 | return; |
---|
| 313 | } |
---|
| 314 | } |
---|
| 315 | |
---|
[1] | 316 | 1; |
---|
[24] | 317 | |
---|
[1] | 318 | __END__ |
---|
| 319 | |
---|
| 320 | =head1 AUTHOR |
---|
| 321 | |
---|
[255] | 322 | Thauvin Olivier, E<lt>olivier.thauvin@latmos.ipsl.frE<gt> |
---|
[1] | 323 | |
---|
| 324 | =head1 COPYRIGHT AND LICENSE |
---|
| 325 | |
---|
[1018] | 326 | Copyright (C) 2009, 2010, 2011, 2012 by Thauvin Olivier |
---|
[1] | 327 | |
---|
| 328 | This library is free software; you can redistribute it and/or modify |
---|
| 329 | it under the same terms as Perl itself, either Perl version 5.10.0 or, |
---|
| 330 | at your option, any later version of Perl 5 you may have available. |
---|
| 331 | |
---|
| 332 | =cut |
---|