source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Maintenance.pm @ 1958

package LATMOS::Accounts::Maintenance;

use strict;
use warnings;
use base qw(LATMOS::Accounts);
use LATMOS::Accounts::Log;
use LATMOS::Accounts::Bases::Sql::DataRequest;
use LATMOS::Accounts::Mail;
use FindBin qw($Bin);
use DateTime;
use Date::Calc;
use Date::Parse;

=head1 NAME

    LATMOS::Accounts::Maintenance

=head1 FUNCTIONS

=cut

sub _base {
    my ($self) = @_;
    return $self->{_maintenance_base} if ($self->{_maintenance_base});
    my $base = $self->SUPER::base;
    $base->type eq 'sql' or die "This module work only with SQL base type\n";
    return $self->{_maintenance_base} = $base
}

=head2 find_next_expire_users ($expire)

Return The list of users going to expire in C<$expire> delay.

=cut

sub find_next_expire_users {
    # Do not replace this code by $base->find_next_expire_users
    # it does not exactly the same thing
    my ($self, $expire) = @_;
    my $base = $self->_base;

    my $sth= $base->db->prepare(q{
        select name,
            expire as appliedexpire,
            endcircuit,
            expire
            from "user"
            where
            expire < now() + ?::interval
            and expire > now()
            and expire is not null
            and exported = True
            order by expire
        }
    );
    $sth->execute($expire || '1 month');
    my @users;
    while (my $res = $sth->fetchrow_hashref) {
        my $now = DateTime->now;
        my @expire = strptime($res->{appliedexpire});

        my ($days) = Date::Calc::Delta_Days(
            $now->year, $now->month, $now->day,
            1900 + $expire[5], $expire[4] +1, $expire[3],
        );

        $res->{days} = $days;

        $res->{obj} = $base->get_object('user', $res->{name});
        $res->{obj}->get_attributes('locked') and next;
        push(@users, $res);
    }
    @users
}

=head2 warn_next_expire_users(%options)

Send a mail to user having account expiring soon

C<%options are>

=over 4

=item users => []

Warn only this users (if need)

=item to

Send the only to this person.

=back

=cut

sub warn_next_expire_users {
    my ($self, %options) = @_;

    require LATMOS::Accounts::Mail;
    my $lamail = LATMOS::Accounts::Mail->new(
        $self,
        'account_expire.mail',
    );

    my $MailSubject = $self->val('_default_', 'mailSubject', 'LATMOS::Accounts');

    my @summary;
    foreach my $user ($self->find_next_expire_users($options{delay})) {
        if ($options{users} && ! grep { $_ eq $user->{name} } @{$options{users}}) {
            next;
        }

        my %mail = (
            From => $self->val('_default_', 'mailFrom', 'nomail@localhost'),
            Subject => sprintf("$MailSubject: Account %s Expire in %s days", $user->{name}, $user->{days}),
            'X-LATMOS-Reason' => 'Account expiration',
        );
        my ($manager, $mail) = ($user->{obj}->get_c_field('manager'),
            $user->{obj}->get_c_field('mail'));
        my $managermail = $manager ? $user->{obj}->base->
            get_object('user', $manager)->get_c_field('mail') : undef;
 
        # if user have no mail, mail only to manager, avoiding empty To
        # NB: at time, for testing purpose, mail is not really sent
        my ($to, @cc) = grep { $_ } ($mail, $managermail,
            $self->val('_default_', 'allwayscc'));
        if ($options{to}) {
            $mail{to} = $options{to};
        } else {
            $mail{to} = $to;
            $mail{cc} = join(', ', @cc);
        }
        $mail{to} or do {
            la_log(LA_ERR, 
                "Cannot send expiration for `%s', no mail to send to",
                $user->{obj}->id,
            );
            next;
        };
        my $mailcc = join(', ', @cc) || '';
        push(@summary, sprintf("%s : %s : %s\n",
                $user->{obj}->queryformat('%{sn} %{givenName} : %{name} : %{department} : %{manager} : %{expireText} : %{endcircuit}'),
                $to || 'Not sent, no destination',
                ($mailcc ? $mailcc : ''),
            )
        );
        my $message;
        if ($lamail->process(\%mail, $user)) {
            la_log(LA_NOTICE, "Expiration mail for %s (%s) sent to %s; cc %s",
                $user->{obj}->id,
                $user->{days},
                $mail{to}, ($mail{cc} || ''));
            if ($options{to}) {
                la_log(LA_NOTICE,"\tbut sent to %s", $mail{to});
            }
        } 
    }

    if (@summary) {
        if ($options{test}) {
            print join('', @summary);
        } else {
            if ($self->val('_default_', 'expire_summary_to')) {
                my $summail = LATMOS::Accounts::Mail->new(
                    $self,
                    \join('', @summary),
                );
                my %mail = (
                );
                if ($summail->process({
                    Subject => "$MailSubject: account expiration summary",
                    To => $self->val('_default_', 'expire_summary_to'),
                })) {
                    la_log(
                        LA_NOTICE,
                        "Expiration summary mail sent to %s",
                        $self->val('_default_', 'expire_summary_to'),
                    );
                }
            }
        }
    }

    1;
}

=head2 find_expired_users ($expire)

See L<LATMOS::Accounts::Base/find_expired_users>

=cut

sub find_expired_users {
    my ($self, $expire) = @_;
    $self->_base->find_expired_users($expire);
}

=head2 expired_account_reminder ( %options)

Search account expired for more than C<$options{delay}> (default is 6 month)
send mail to manager and summary to admin to aknoledge destruction.

=cut

sub expired_account_reminder {
    my ($self, %options) = @_;
    $options{delay} ||= '6 month';

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

    my @users = $self->_base->find_expired_users($options{delay});

    my %managers;
    my $accreq = $self->_base->get_object('accreq', 'user-removal');


    $self->base->log(LA_DEBUG,
        "Found accreq 'user-removal', using it to automated deletion",
    ) if ($accreq);

    foreach my $user (@users) {
        my $uobj = $self->_base->get_object('user', $user);
        $uobj->get_attributes('unexported') and next; # can't happend
        my $manager = $uobj->get_attributes('manager') || 'N/A';
        push(@{$managers{$manager}{users}}, $uobj);

        if ($accreq) {
            my $req = LATMOS::Accounts::Bases::Sql::DataRequest->new($accreq);
            $req->set_ptr_object($uobj);
            my @date = localtime( time + 3600 * 24 * 30); # eg: 1 month
            my $apply_date = sprintf(
                '%02d/%02d/%d',
                $date[3],
                $date[4] + 1,
                $date[5] + 1900
            );

            if ($self->_base->list_request_by_object(
                    'user', $user, 'user-removal')) {
                $self->base->log(LA_NOTICE,
                    "Request %s already exists for %s, skipping",
                    'accreq',
                    $user,
                );
            } else {
                $req->register(
                    {
                        user => undef,
                        apply => $apply_date,
                        auto => 1,
                    },
                    exported => 0,
                );
                $self->_base->commit;
            }
        }
    }

    my $MailSubject = $self->val('_default_', 'mailSubject', 'LATMOS::Accounts');

    unless($options{test}) {
        foreach (keys %managers) {
            my $oman = $self->_base->get_object('user', $_) or next; # can't happend
            $managers{$_}{manager} = $oman;
            my $mail = $oman->get_attributes('mail') or next;

            my %mail = (
                Subject => "$MailSubject: expired account",
                'X-LATMOS-Reason' => 'Account destruction',
            );
            $mail{to} = $options{to} || $mail;
            if ($lamail->process(\%mail, $managers{$oman->id})) {
                la_log(LA_NOTICE,
                    "Expired account reminder mail for %s sent to %s (cc: %s) for %s",
                    $oman->id,
                    $mail{to},
                    ($mail{cc} || ''),
                    join(', ', map { $_->id } @{$managers{$oman->id}{users}})
                );
            }
        }
    }
    my @summary;
    foreach my $manager (sort keys %managers) {
        push(@summary, "\n" . (
            $managers{$manager}{manager}
                ? $managers{$manager}{manager}->get_attributes('displayName')
                : $manager) . "\n");
        foreach (@{$managers{$manager}{users}}) {
            push(@summary, sprintf("  %s - %s (%s)\n",
                $_->id,
                $_->get_attributes('displayName'),
                $_->get_attributes('expireText'),
            ));
        }
    }

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

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts::Bases>

=head1 AUTHOR

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

=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