source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Task/Iprecover.pm @ 2024

package LATMOS::Accounts::Task::Iprecover;

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::Iprecover - Recover IP from disabled hosts

=head1 DESCRIPTION

This module check for disabled hosts and remove the IP set on it to free them

=head1 PARAMETER

=head2 netzone

The C<netzone> object containing concerned hosts

=head2 filter

A filter limiting host search.

=head2 modifDelay

The number of day hosts has not be modified in database.
Hosts having recent changes are left unmodified.

=head2 test

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

=cut

sub runDelay { 2 * 60 * 60 }

# Wait 30 minutes
sub waitDelay { 30 * 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 _filters {
    my ($self) = @_;

    my $filteredHosts;

    if (my @cfilters = $self->{syncm}->ini->val($self->{name}, 'filter')) {
        $filteredHosts = {};
        foreach ($self->{_base}->search_objects('nethost', @cfilters)) {
            $filteredHosts->{$_} = 1;
        }
    }

    my $hosts;

    if (my @zones = $self->{syncm}->ini->val($self->{name}, 'netzone')) {

        $hosts = {};

        my @filters;

        foreach my $zone (@zones) {
            la_log(LA_DEBUG, "Limiting affected host to zone %s", $zone);
            my $oZone = $self->{_base}->get_object('netzone', $zone) or do {
                la_log(LA_ERR, "Cannot get zone $zone named in config");
                return;
            };

            my @zonehosts = $oZone->get_attributes('hosts');

            push(@filters, [ 'name=' . join('||', @zonehosts) ]);

            if ($oZone->get_attributes('allow_dyn')) {
                la_log(LA_DEBUG, "Zone %s has allow_dyn set, searching w/o ip", $zone);
                push(@filters, [ 'ip=NULL' ]);
            }
        }

        foreach my $filter (@filters) {
            foreach ($self->{_base}->search_objects('nethost', @$filter)) {
                $filteredHosts && !$filteredHosts->{$_} and next;
                $hosts->{$_} = 1;
            }
        }
    } else {
        $hosts = $filteredHosts;
    }

    return $hosts;
}

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

    $self->{_base}->temp_switch_unexported(sub {

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

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

    my $hosts = $self->_filters;

    my @HostToDisable = $self->{_base}->search_objects('nethost', 'exported=0', 'ip=*', 'date<' . $waitAfterModif);

    foreach my $hostname (@HostToDisable) {
        if ($hosts) {
            $hosts->{$hostname} or next;
        }
        my $Host = $self->{_base}->get_object('nethost', $hostname) or next;
        $self->{_base}->log(
            LA_NOTICE,
            '%sRecovering IP for host %s because is disable from a long time',
            ($test ? '(Test) ' : ''),
            $hostname,
        );
        $Host->ReportChange('Update', "Recovering IP because host is disable from a long time");
        $Host->_set_c_fields( ip => undef );
    }

    $self->{_base}->commit()
        unless($test);

    }, 1);
}

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