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

Last change on this file was 2537, checked in by nanardon, 20 months ago

Add test if manager object can fetch

  • Property svn:keywords set to Id Rev
File size: 9.0 KB
Line 
1package LATMOS::Accounts::Maintenance;
2
3use strict;
4use warnings;
5use base qw(LATMOS::Accounts);
6use LATMOS::Accounts::Log;
7use LATMOS::Accounts::Mail;
8use FindBin qw($Bin);
9use DateTime;
10use Date::Calc;
11use Date::Parse;
12
13=head1 NAME
14
15    LATMOS::Accounts::Maintenance
16
17=head1 FUNCTIONS
18
19=cut
20
21sub _base {
22    my ($self) = @_;
23    return $self->{_maintenance_base} if ($self->{_maintenance_base});
24    my $base = $self->SUPER::base;
25    $base->type eq 'sql' or die "This module work only with SQL base type\n";
26    return $self->{_maintenance_base} = $base
27}
28
29=head2 find_next_expire_users ($expire)
30
31Return The list of users going to expire in C<$expire> delay.
32
33=cut
34
35sub find_next_expire_users {
36    # Do not replace this code by $base->find_next_expire_users
37    # it does not exactly the same thing
38    my ($self, $expire) = @_;
39    my $base = $self->_base;
40
41    my $sth= $base->db->prepare(q{
42        select name,
43            expire as appliedexpire,
44            endcircuit,
45            expire
46            from "user"
47            where
48            expire < now() + ?::interval
49            and expire > now()
50            and expire is not null
51            and exported = True
52            order by expire
53        }
54    );
55    $sth->execute($expire || '1 month');
56    my @users;
57    while (my $res = $sth->fetchrow_hashref) {
58        my $now = DateTime->now;
59        my @expire = strptime($res->{appliedexpire});
60
61        my ($days) = Date::Calc::Delta_Days(
62            $now->year, $now->month, $now->day,
63            1900 + $expire[5], $expire[4] +1, $expire[3],
64        );
65
66        $res->{days} = $days;
67
68        $res->{obj} = $base->get_object('user', $res->{name});
69        $res->{obj}->get_attributes('locked') and next;
70        push(@users, $res);
71    }
72    @users
73}
74
75=head2 warn_next_expire_users(%options)
76
77Send a mail to user having account expiring soon
78
79C<%options are>
80
81=over 4
82
83=item users => []
84
85Warn only this users (if need)
86
87=item to
88
89Send the only to this person.
90
91=back
92
93=cut
94
95sub warn_next_expire_users {
96    my ($self, %options) = @_;
97
98    require LATMOS::Accounts::Mail;
99    my $lamail = LATMOS::Accounts::Mail->new(
100        $self,
101        'account_expire.mail',
102    );
103
104    my $MailSubject = $self->val('_default_', 'mailSubject', 'LATMOS::Accounts');
105
106    my @summary;
107    foreach my $user ($self->find_next_expire_users($options{delay})) {
108        if ($options{users} && ! grep { $_ eq $user->{name} } @{$options{users}}) {
109            next;
110        }
111
112        my %mail = (
113            From => $self->val('_default_', 'mailFrom', 'nomail@localhost'),
114            Subject => $user->{days} == 0
115                ? sprintf("$MailSubject: Account %s Expire today", $user->{name})
116                : sprintf("$MailSubject: Account %s Expire in %s days", $user->{name}, $user->{days}),
117            'X-LATMOS-Reason' => 'Account expiration',
118        );
119        my ($manager, $mail) = ($user->{obj}->get_c_field('manager'),
120            $user->{obj}->get_c_field('mail'));
121        my $managermail;
122        if ( $manager ) {
123            if ( my $omanager = $user->{obj}->base->get_object('user', $manager) ) {
124                $managermail = $omanager->get_c_field('mail');
125            } else {
126                la_log( 'LA_ERR', "Cannot get manager %s for user %s", $manager, $user->{obj}->id );
127            }
128        }
129 
130        # if user have no mail, mail only to manager, avoiding empty To
131        # NB: at time, for testing purpose, mail is not really sent
132        my ($to, @cc) = grep { $_ } ($mail, $managermail,
133            $self->val('_default_', 'allwayscc'));
134        if ($options{to}) {
135            $mail{to} = $options{to};
136        } else {
137            $mail{to} = $to;
138            $mail{cc} = join(', ', @cc);
139        }
140        $mail{to} or do {
141            la_log(LA_ERR, 
142                "Cannot send expiration for `%s', no mail to send to",
143                $user->{obj}->id,
144            );
145            next;
146        };
147        my $mailcc = join(', ', @cc) || '';
148        push(@summary, sprintf("%s : %s : %s\n",
149                $user->{obj}->queryformat('%{sn} %{givenName} : %{name} : %{department} : %{manager} : %{expireText} : %{endcircuit}'),
150                $to || 'Not sent, no destination',
151                ($mailcc ? $mailcc : ''),
152            )
153        );
154        my $message;
155        if ($lamail->process(\%mail, $user)) {
156            la_log(LA_NOTICE, "Expiration mail for %s (%s) sent to %s; cc %s",
157                $user->{obj}->id,
158                $user->{days},
159                $mail{to}, ($mail{cc} || ''));
160            if ($options{to}) {
161                la_log(LA_NOTICE,"\tbut sent to %s", $mail{to});
162            }
163        } 
164    }
165
166    if (@summary) {
167        if ($options{test}) {
168            print join('', @summary);
169        } else {
170            if ($self->val('_default_', 'expire_summary_to')) {
171                my $summail = LATMOS::Accounts::Mail->new(
172                    $self,
173                    \join('', @summary),
174                );
175                my %mail = (
176                );
177                if ($summail->process({
178                    Subject => "$MailSubject: account expiration summary",
179                    To => $self->val('_default_', 'expire_summary_to'),
180                })) {
181                    la_log(
182                        LA_NOTICE,
183                        "Expiration summary mail sent to %s",
184                        $self->val('_default_', 'expire_summary_to'),
185                    );
186                }
187            }
188        }
189    }
190
191    1;
192}
193
194=head2 find_expired_users ($expire)
195
196See L<LATMOS::Accounts::Base/find_expired_users>
197
198=cut
199
200sub find_expired_users {
201    my ($self, $expire) = @_;
202    $self->_base->find_expired_users($expire);
203}
204
205=head2 expired_account_reminder ( %options)
206
207Search account expired for more than C<$options{delay}> (default is 6 month)
208send mail to manager and summary to admin to aknoledge destruction.
209
210=cut
211
212sub expired_account_reminder {
213    my ($self, %options) = @_;
214    $options{delay} ||= '6 month';
215
216    my $lamail = LATMOS::Accounts::Mail->new(
217        $self,
218        'account_expired_reminder.mail',
219    );
220
221    my @users = $self->_base->find_expired_users($options{delay});
222
223    my %managers;
224
225    foreach my $user (@users) {
226        my $uobj = $self->_base->get_object('user', $user);
227        $uobj->get_attributes('unexported') and next; # can't happend
228        my $manager = $uobj->get_attributes('manager') || 'N/A';
229        push(@{$managers{$manager}{users}}, $uobj);
230
231    }
232
233    my $MailSubject = $self->val('_default_', 'mailSubject', 'LATMOS::Accounts');
234
235    unless($options{test}) {
236        foreach (keys %managers) {
237            my $oman = $self->_base->get_object('user', $_) or next; # can't happend
238            $managers{$_}{manager} = $oman;
239            my $mail = $oman->get_attributes('mail') or next;
240
241            my %mail = (
242                Subject => "$MailSubject: expired account",
243                'X-LATMOS-Reason' => 'Account destruction',
244            );
245            $mail{to} = $options{to} || $mail;
246            if ($lamail->process(\%mail, $managers{$oman->id})) {
247                la_log(LA_NOTICE,
248                    "Expired account reminder mail for %s sent to %s (cc: %s) for %s",
249                    $oman->id,
250                    $mail{to},
251                    ($mail{cc} || ''),
252                    join(', ', map { $_->id } @{$managers{$oman->id}{users}})
253                );
254            }
255        }
256    }
257    my @summary;
258    foreach my $manager (sort keys %managers) {
259        push(@summary, "\n" . (
260            $managers{$manager}{manager}
261                ? $managers{$manager}{manager}->get_attributes('displayName')
262                : $manager) . "\n");
263        foreach (@{$managers{$manager}{users}}) {
264            push(@summary, sprintf("  %s - %s (%s)\n",
265                $_->id,
266                $_->get_attributes('displayName'),
267                $_->get_attributes('expireText'),
268            ));
269        }
270    }
271
272    if (@summary) {
273        if ($options{test}) {
274            print join('', @summary);
275        } else {
276            if ($self->val('_default_', 'expire_summary_to')) {
277                my %mail = (
278                    Subject => "$MailSubject: expired account (to disable)",
279                    'X-LATMOS-Reason' => 'Account expiration',
280                    To => $self->val('_default_', 'expire_summary_to'),
281                );
282                my $summail = LATMOS::Accounts::Mail->new(
283                    $self, \join('', @summary), {}
284                );
285                if ($summail->process(\%mail)) {
286                    la_log(LA_NOTICE, "Expiration summary mail sent to %s",
287                        $self->val('_default_', 'expire_summary_to'),
288                    );
289                }
290            }
291        }
292    }
293}
294
2951;
296
297__END__
298
299=head1 SEE ALSO
300
301L<LATMOS::Accounts::Bases>
302
303=head1 AUTHOR
304
305Thauvin Olivier, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
306
307=head1 COPYRIGHT AND LICENSE
308
309Copyright (C) 2009, 2010, 2011, 2012 by Thauvin Olivier
310
311This library is free software; you can redistribute it and/or modify
312it under the same terms as Perl itself, either Perl version 5.10.0 or,
313at your option, any later version of Perl 5 you may have available.
314
315=cut
Note: See TracBrowser for help on using the repository browser.