source: branches/4.0/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Nethost.pm @ 1299

package LATMOS::Accounts::Bases::Sql::Nethost;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases::Sql::objects);
use LATMOS::Accounts::Log;

our $VERSION = (q$Rev: 2104 $ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Accounts::Bases::Sql::Nethost - A Network Host entry

=cut

sub _object_table { 'nethost' }

sub _key_field { 'name' }

sub _has_extended_attributes { 1 }

sub _get_attr_schema {
    my ($class, $base) = @_;

    $class->SUPER::_get_attr_schema($base,
        {
            name    => { ro => 1, inline => 1, },
            cn      => { ro => 1, inline => 1, iname => 'name' },
            date    => { ro => 1, inline => 1, },
            create  => { ro => 1, inline => 1, },
            ip      => {
                monitored => 1,
                multiple => 1,
                uniq => 1,
                input => sub {
                    my $ip = $_[0];
                    $ip =~ s/(\D|^)0+/$1/g;
                    $ip
                },
            },
            ipFrom  => {
                multiple => 1, 
                managed => 1,
                can_values => sub {
                    $base->search_objects('netzone', 'type=dhcp')
                },
            },
            macaddr => {
                monitored => 1,
                multiple => 1,
                uniq => 1,
                input => sub {
                    my @elem = split(/[:-]/, $_[0]);
                    return join(':', map { sprintf("%02x", hex($_)) } @elem);
                },
            },
            cname   => {
                monitored => 1,
                multiple => 1, uniq => 1,
                input => sub { lc($_[0]) } 
            },
            owner   => {
                monitored => 1,
                reference => 'user',
                delayed => 1,
            },
            user    => {
                reference => 'user',
                delayed => 1,
            },
            netZone => {
                multiple => 1, ro => 1, managed => 1,
                reference => 'netzone',
            },
            puppetClass => { multiple => 1, },
            netZoneExclude => {
                multiple => 1, ro => 1, managed => 1,
                reference => 'netzone',
            },
            noDynamic => { 
                formtype => 'CHECKBOX',
            },
            exported => { formtype => 'CHECKBOX', },
            noInheritPuppet => { formtype => 'CHECKBOX', },
            otherName => {
                multiple => 1,
                input => sub { lc($_[0]) },
            },
            sshfp => { multiple => 1, },
            sshfpUpdate  => {
                managed => 1,
            },
        }
    )
}

sub get_field {
    my ($self, $field) = @_;

    if ($field eq 'netZone') {
        my $find = $self->base->db->prepare_cached(q{
            select name from netzone where ikey in
            (
            select netzone_attributes.okey from netzone_attributes join
            nethost_attributes_ips on netzone_attributes.attr='net'
                and 
            nethost_attributes_ips.value::inet <<=
            netzone_attributes.value::inet
            where nethost_attributes_ips.okey = $1
            except
            select netzone_attributes.okey from netzone_attributes join
            nethost_attributes_ips on netzone_attributes.attr='netExclude'
            and nethost_attributes_ips.value::inet <<= netzone_attributes.value::inet
            where nethost_attributes_ips.okey = $1
            )
                order by name
            });
        $find->execute($self->get_attributes('ikey'));
        my @zones;
        while (my $res = $find->fetchrow_hashref) {
            push(@zones, $res->{name});
        }
        return @zones ? [ @zones ] : undef;
    } elsif ($field eq 'netZoneExclude') {
        my $find = $self->base->db->prepare_cached(q{
            select name from netzone where ikey in
            (
            select netzone_attributes.okey from netzone_attributes join
            nethost_attributes_ips on netzone_attributes.attr='netExclude'
                and 
            nethost_attributes_ips.value::inet <<=
            netzone_attributes.value::inet
            where nethost_attributes_ips.okey = $1
            )
                order by name
            });
        $find->execute($self->get_attributes('ikey'));
        my @zones;
        while (my $res = $find->fetchrow_hashref) {
            push(@zones, $res->{name});
        }
        return @zones ? [ @zones ] : undef;
    } else {
        return $self->SUPER::get_field($field);
    }
}

sub set_fields {
    my ($self, %data) = @_;
    if ($data{ipFrom}) {
        my @currentips = grep { $_ } $self->get_attributes('ip');
        foreach (ref $data{ipFrom} ? @{$data{ipFrom}} : $data{ipFrom}) {
            my $zone = $self->base->get_object('netzone', $_)
                or next;
            my @freeips = $zone->get_attributes('freeIP') or next;
            my $idx = rand(scalar(@freeips));
            push(@currentips, $freeips[$idx]);
            $self->base->log(LA_NOTICE, "Assigning ip %s to host %s",
                $freeips[$idx], $self->id);
        }
        push(@currentips, ref $data{ip} ? @{$data{ip}} : $data{ip})
            if ($data{ip});
        $data{ip} = \@currentips;
        delete($data{ipFrom});
    }
    if ($data{sshfpUpdate}) {
        open my $h, '<', \$data{sshfpUpdate};
        my @sshfps;
        while (my $line = <$h>) {
            my ($type, $mode, $key) = $line =~ /^\S+\s+IN\s+SSHFP\s+(\d)\s+(\d)\s+(\S+)/i
                or do {
                    la_log(LA_ERR, "Seems to not be a ssh-keygen line: %s", $line);
                    return;
                };
            la_log(LA_DEBUG, "found sshfp %s %s %s", $type, $mode, $key);
            push(@sshfps, "$type $mode $key");
        }
        close($h);
        delete($data{sshfpUpdate});
        $data{sshfp} = \@sshfps;
    }

    $self->SUPER::set_fields(%data)
}

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts::Bases::Sql::Netzones>, L<LATMOS::Accounts::Bases::Sql>

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009, 2010, 2011, 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