source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Task/Delexpiredusers.pm @ 1886

package LATMOS::Accounts::Task::Delexpiredusers;

use strict;
use warnings;
use base qw(LATMOS::Accounts::Task);
use LATMOS::Accounts;
use LATMOS::Accounts::Log;
use LATMOS::Accounts::Utils;
use DateTime;

=head1 NAME

LATMOS::Accounts::Task::Expiredusers - Warn and unexport expired user

=head1 DESCRIPTION

This module unexport user when they are expired since a given delay.

Before deleting a warning can be sent to the manager.

=head1 PARAMETER

=head2 warndelay

The number of days before warning manager the user will be unexported.

If unset the warning is disable.

=head2 unexportdelay

The number of days after C<warndelay> the user is effectivelly unexported.

If unset no user are unexported.

=head2 modifdelay

The time to wait in minutes after user modification before unexporting it.

This time avoid the module deleting a user in the same time an administrator
is trying to reactivate it.

Default is 60 minutes.

=head2 test

If set only log are emitted but changes are not done and mail not really sent

=head2 cc

A copy of warning are sent to this email address

=head2 summary

If set, send a summmary to this address

=head2 to

Instead sending mail to manager mail are sent to this email address.

=head1 warndelay/unexportdelay example

Unexporting user immediatly /o any warning:

    # warndelay = 0
    unexportdelay = 0

Warning manager with immediate unexport:

    warndelay = 0
    unexportdelay = 0

Warning manager immediatelly but unexporting user 15 days later

    warndelay = 0
    unexportdelay = 15

Wait 6 month after expiration, unexport user 15 days after warning:

    warndelay = 180
    unexportdelay = 15

=cut

# Run every 2 hours
sub runDelay { 2 * 60 * 60 }

# Wait 30 minutes
sub waitDelay { 30 * 60 }

sub _DATEFLAG { 'expireText' }

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) = @_;

    $self->_unexport;

    $self->_send_warning;

    1;
}

sub _send_warning {
    my ($self) = @_;

    my $test = $self->{syncm}->ini->val($self->{name}, 'test');
    my $warnDelay = $self->{syncm}->ini->val($self->{name}, 'warndelay');

    my $modifDelay = $self->{syncm}->ini->val($self->{name}, 'modifdelay', 60);
    my $waitAfterModif = DateTime->now->subtract( minutes => $modifDelay  )->iso8601;
       
    defined($warnDelay)  or do {
        $self->{_base}->log(LA_DEBUG, "Don't warning manager because no warndelay given");
        return;
    };

    my $expiredDate = DateTime->now()->subtract(days => $warnDelay);

    my %expired;

    foreach my $user ($self->{_base}->search_objects('user',
            'exported=1',
            'expire<' . $expiredDate->ymd('-'),
            'date<' . $waitAfterModif,
            'oalias=NULL'
        )) {
        my $ouser = $self->{_base}->get_object('user', $user) or next;

        if ($ouser->get_attributes('nextEmployment')) {
            # This user has expire account but a futur employement is coming
            next;
        }

        if (my $val = $self->{_base}->get_global_value("expiredWarning.user.$user")) {
            if ($val eq $ouser->get_attributes(_DATEFLAG)) {
                # Warning has been already sent
                next;
            }
        }

        my $manager = $ouser->get_attributes('manager') || 'N/A';

        $self->{_base}->log(
            $test ? LA_DEBUG : LA_NOTICE,
            "%sUser %s is expired (%s), sending warning to %s",
            $test ? 'Test: ' : '',
            $user,
            $ouser->get_attributes('expireText'),
            $manager,
        );
            
        $expired{$manager} ||= { users => [] };
        push (@{$expired{$manager}{users}}, $ouser);
    }

    my $lamail = LATMOS::Accounts::Mail->new(
        $self->{_la},
        'account_expired_reminder.mail',
    );

    foreach my $manager (sort keys %expired) {

        my $omanager = $self->{_base}->get_object('user', $manager) or next;
        my $mail = $omanager->get_attributes('mail') or next;

        $expired{$manager}{manager} = $omanager;

        my %mail = (
            Subject => 'LATMOS expired account',
            'X-LATMOS-Reason' => 'Account destruction',
        );

        # to is for debuging
        $mail{to} = $self->{syncm}->ini->val($self->{name}, 'to', $mail);
        $mail{cc} = $self->{syncm}->ini->val($self->{name}, 'cc');


        if ($test) {
            $self->{_base}->log(LA_NOTICE, "Test: sending mail to %s for expired account %s",
                $omanager->id,
                join(', ', sort map { $_->id } @{ $expired{$manager}{users}}),
            );
        } else {
            if ($lamail->process(\%mail, $expired{$manager})) {
                $self->{_base}->log(LA_NOTICE,
                    "Expired account reminder mail sent to %s (%s) (cc: %s) for %s",
                    $mail{to},
                    $omanager->id,
                    ($mail{cc} || ''),
                    join(', ', sort map { $_->id } @{ $expired{$manager}{users}}),
                );

                foreach my $ouser (@{ $expired{$manager}{users}}) {
                    $self->{_base}->set_global_value('expiredWarning.user.' . $ouser->id, $ouser->get_attributes(_DATEFLAG));
                }
                $self->{_base}->commit;
            }
        }
    }

    if (my $sumto = $self->{syncm}->ini->val($self->{name}, 'summary')) {
        my @summary;
        foreach my $manager (sort keys %expired) {
            foreach (@{$expired{$manager}{users}}) {
                push(@summary, sprintf("%s - %s (%s, %s)\n",
                        $_->id,
                        ($expired{$manager}{manager}
                            ? $expired{$manager}{manager}->get_attributes('displayName')
                            : $manager),
                        $_->get_attributes('displayName'),
                        $_->get_attributes('expireText'),
                    )
                );
            }
        }

        if (@summary && !$test) {
            my %mail = (
                Subject => 'LATMOS expired account (to disable)',
                'X-LATMOS-Reason' => 'Account expiration',
                To => $sumto,
            );
            my $summail = LATMOS::Accounts::Mail->new(
                $self->{_la}, \join('', @summary), {}
            );
            if ($summail->process(\%mail)) {
                la_log(LA_NOTICE, "Expiration summary mail sent to %s",
                    $self->val('_default_', 'expire_summary_to'),
                );
            }
        }
    }
}

sub _unexport {
    my ($self) = @_;

    my $test = $self->{syncm}->ini->val($self->{name}, 'test');

    my $warnDelay     = $self->{syncm}->ini->val($self->{name}, 'warndelay', 0);
    my $unexportDelay = $self->{syncm}->ini->val($self->{name}, 'unexportdelay');
    defined($unexportDelay) or do {
        $self->{_base}->log(LA_DEBUG, "Don't unexporting user because no unexportdelay given");
        return;
    };

    my $expiredDate = DateTime->now()->subtract(days => $warnDelay + $unexportDelay);

    my $modifDelay = $self->{syncm}->ini->val($self->{name}, 'modifdelay', 60);
    my $waitAfterModif = DateTime->now->subtract( minutes => $modifDelay  )->iso8601;

    foreach my $user ($self->{_base}->search_objects('user',
            'exported=1',
            'expire<' . $expiredDate->ymd('-'),
            'date<' . $waitAfterModif,
            'oalias=NULL'
        )) {
        my $ouser = $self->{_base}->get_object('user', $user) or next;
        if ($ouser->get_attributes('nextEmployment')) {
            # This user has expire account but a futur employement is coming
            next;
        }

        $self->{_base}->log(LA_NOTICE, "%sUser $user unexported because is expired (%s)",
            $test ? 'Test: ' : '', $ouser->get_attributes('expireText'));

        if (!$test) {
            $ouser->_set_c_fields(
                unexported => 1
            );
            $self->{_base}->del_global_value("expiredWarning.user.$user");
            $self->{_base}->commit;
        }
    }
}

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts>, L<LATMOS::Accounts::Task>

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=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