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