package LATMOS::Accounts::Task::Expiredaliases; use strict; use warnings; use base qw(LATMOS::Accounts::Task); use LATMOS::Accounts; use LATMOS::Accounts::Log; use LATMOS::Accounts::Utils; =head1 NAME LATMOS::Accounts::Task::Expiredaliases - Set aliases to expired account =head1 DESCRIPTION This module set forward to expired accounts to inform people the account is closed. The forward is set to c parameter found in C =cut # Every 10 minutes sub runDelay { 10 * 60 } sub init { my ($self) = @_; my $LA = LATMOS::Accounts->new($self->{config}, noacl => 1); my $labase = $self->{base} ? $LA->base($self->{base}) : $LA->base; $labase && $labase->load or die "Cannot load base"; $self->{_la} = $LA; $self->{_base} = $labase; 1; } sub run { my ($self) = @_; # Unset aliases when user get active: my @aliases = $self->{_base}->search_objects('aliases', 'user.active=1', 'comment=EXPIREDACCOUNT'); foreach (@aliases) { $self->{_base}->log(LA_NOTICE, 'Deleting aliases %s because user is active', $_); $self->{_base}->_delete_object('aliases', $_); $self->{_base}->commit; } my $dest = $self->{syncm}->ini->val($self->{name}, 'destination') or do { $self->{_base}->log(LA_ERR, 'No destination in config, cannot run Expiredaliases'); return 1; }; my %existedAliases = map { $_ => 1 } $self->{_base}->search_objects('aliases', 'user.active=0'); foreach my $user ($self->{_base}->search_objects('user', 'status=expired')) { $existedAliases{$user} and next; # An alias existed, doing nothing $self->{_base}->log(LA_NOTICE, "Adding alias to expired user $user"); $self->{_base}->create_object('aliases', $user, comment => 'EXPIREDACCOUNT', description => "Forward because $user is expired, do not remove or change", forward => [ $dest, "\\$user" ], ); $self->{_base}->commit; } 1; } 1; __END__ =head1 SEE ALSO L, L =head1 AUTHOR Olivier Thauvin, Eolivier.thauvin@latmos.ipsl.frE =head1 COPYRIGHT AND LICENSE Copyright (C) 2012 CNRS SA/CETP/LATMOS 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