source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Nethost.pm @ 1557

Last change on this file since 1557 was 1557, checked in by nanardon, 9 years ago

I18N fixes
File size: 10.0 KB
Line 
1package LATMOS::Accounts::Bases::Sql::Nethost;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Sql::objects);
8use LATMOS::Accounts::Log;
9use LATMOS::Accounts::I18N;
10use Net::IP;
11
12our $VERSION = (q$Rev: 2104 $ =~ /^Rev: (\d+) /)[0];
13
14=head1 NAME
15
16LATMOS::Accounts::Bases::Sql::Nethost - A Network Host entry
17
18=cut
19
20sub _object_table { 'nethost' }
21
22sub _key_field { 'name' }
23
24sub _has_extended_attributes { 1 }
25
26sub _get_attr_schema {
27    my ($class, $base) = @_;
28
29    $class->SUPER::_get_attr_schema($base,
30        {
31            name    => { ro => 1, inline => 1, },
32            cn      => { ro => 1, inline => 1, iname => 'name' },
33            date    => { ro => 1, inline => 1, },
34            create  => { ro => 1, inline => 1, },
35            ip      => {
36                monitored => 1,
37                multiple => 1,
38                uniq => 1,
39                input => sub {
40                    my $ip = $_[0] or return;
41                    $ip =~ s/(\D|^)0+/$1/g;
42                    $ip =~ s:/.*$::;
43                    $ip
44                },
45                checkinputformat => sub {
46                    my ($value) = @_;
47                    $value or return;
48                    my $ip = Net::IP->new($value);
49                    $ip or return;
50                    $ip->prefixlen() == ($ip->version == 4 ? 32 : 128) or do {
51                        $base->log(LA_ERR, "Wrong prefix len for IP %s: %d (ip version %d)",
52                            $ip->print, $ip->prefixlen, $ip->version);
53                        return undef;
54                    };
55                },
56                label => l('Ip'),
57            },
58            ipFrom  => {
59                multiple => 1, 
60                managed => 1,
61                delayed => 1,
62                can_values => sub {
63                    $base->search_objects('netzone', 'type=dhcp')
64                },
65                set => sub {
66                    my ($self, $data) = @_;
67                    my $count = 0;
68                    foreach (ref $data ? @{$data} : $data) {
69                        my $zone = $self->base->get_object('netzone', $_)
70                            or next;
71                        my @freeips = $zone->get_attributes('freeIP') or next;
72                        my $idx = rand(scalar(@freeips));
73                        $self->object->_addAttributeValue('ip', $freeips[$idx]);
74                        $self->base->log(LA_NOTICE, "Assigning ip %s to host %s",
75                            $freeips[$idx], $self->object->id);
76                        $count++;
77                    }
78                    return $count;
79                },
80                label => l('Ip from...'),
81            },
82            macaddr => {
83                monitored => 1,
84                multiple => 1,
85                uniq => 1,
86                input => sub {
87                    $_[0] or return;
88                    my @elem = split(/[:-]/, $_[0]);
89                    return join(':', map { sprintf("%02x", hex($_)) } @elem);
90                },
91                checkinputformat => sub {
92                    $_[0] or return;
93                    return $_[0] =~ /^([0-9a-f]{2}([:-]|$)){6}$/i ? 1 : undef;
94                },
95                label => l('Hardware address'),
96            },
97            cname   => {
98                monitored => 1,
99                multiple => 1,
100                input => sub { lc($_[0]) },
101                label => l('Aliases'),
102            },
103            related   => {
104                multiple => 1, uniq => 1,
105                reference => 'nethost',
106                label => l('Related'),
107            },
108            owner   => {
109                monitored => 1,
110                reference => 'user',
111                delayed => 1,
112                label => l('Owner'),
113            },
114            user    => {
115                reference => 'user',
116                delayed => 1,
117                label => l('User'),
118            },
119            netZone => {
120                multiple => 1, ro => 1, managed => 1,
121                reference => 'netzone',
122                get => sub {
123                    my ($self) = @_;
124                    my $find = $self->base->db->prepare_cached(q{
125                        select name from netzone where ikey in
126                        (
127                        select netzone_attributes.okey from netzone_attributes join
128                        nethost_attributes_ips on netzone_attributes.attr='net'
129                            and
130                        nethost_attributes_ips.value::inet <<=
131                        netzone_attributes.value::inet
132                        where nethost_attributes_ips.okey = $1
133                        except
134                        select netzone_attributes.okey from netzone_attributes join
135                        nethost_attributes_ips on netzone_attributes.attr='netExclude'
136                            and nethost_attributes_ips.value::inet <<= netzone_attributes.value::inet
137                        where nethost_attributes_ips.okey = $1
138                        )
139                        order by name
140                        });
141                    $find->execute($self->object->get_attributes('ikey'));
142                    my @zones;
143                    while (my $res = $find->fetchrow_hashref) {
144                        push(@zones, $res->{name});
145                    }
146                    return @zones ? [ @zones ] : undef;
147                },
148                label => l('NetZones'),
149            },
150            puppetClass => {
151                multiple => 1,
152                label => l('Puppet Class'),
153            },
154            netZoneExclude => {
155                multiple => 1, ro => 1, managed => 1,
156                reference => 'netzone',
157                get => sub {
158                    my ($self) = @_;
159                    my $find = $self->base->db->prepare_cached(q{
160                        select name from netzone where ikey in
161                        (
162                        select netzone_attributes.okey from netzone_attributes join
163                        nethost_attributes_ips on netzone_attributes.attr='netExclude'
164                            and
165                        nethost_attributes_ips.value::inet <<=
166                        netzone_attributes.value::inet
167                        where nethost_attributes_ips.okey = $1
168                        )
169                            order by name
170                        });
171                    $find->execute($self->object->get_attributes('ikey'));
172                    my @zones;
173                    while (my $res = $find->fetchrow_hashref) {
174                        push(@zones, $res->{name});
175                    }
176                    return @zones ? [ @zones ] : undef;
177                },
178            },
179            noDynamic => { 
180                formtype => 'CHECKBOX',
181                label => l('No dynamic IP'),
182            },
183            exported => { formtype => 'CHECKBOX', },
184            noInheritPuppet => {
185                formtype => 'CHECKBOX',
186                label => l('No puppet'),
187            },
188            otherName => {
189                multiple => 1,
190                input => sub { lc($_[0]) },
191                label => l('Other name'),
192            },
193            sshfp => {
194                multiple => 1,
195                label => l('SSH finger print'),
196            },
197            ip6 => { },
198            sshfpUpdate  => {
199                managed => 1,
200                iname => 'sshfp',
201                input => sub {
202                    my ($self, $data) = @_;
203                    $data or return;
204                    open(my $h, '<', $data) or return;
205                    my @sshfps;
206                    while (my $line = <$h>) {
207                        my ($type, $mode, $key) = $line =~ /^\S+\s+IN\s+SSHFP\s+(\d)\s+(\d)\s+(\S+)/i
208                            or do {
209                            la_log(LA_ERR, "Seems to not be a ssh-keygen line: %s", $line);
210                            return;
211                        };
212                        la_log(LA_DEBUG, "found sshfp %s %s %s", $type, $mode, $key);
213                        push(@sshfps, "$type $mode $key");
214                    }
215                    close($h);
216                    \@sshfps;
217                }
218            },
219            comment => {
220                label => l('Comment'),
221            },
222            description => {
223                label => l('Description'),
224            },
225            encryptKey => {
226                label => l('Encrypted key'),
227            },
228            reverse => {
229                label => l('Reverse name'),
230            },
231            serialNumber => {
232                label => l('Serial number'),
233            },
234        }
235    )
236}
237
238sub set_fields {
239    my ($self, %data) = @_;
240
241    my $res = $self->SUPER::set_fields(%data);
242
243    # Post update related
244    if (exists $data{related}) {
245        my %exists;
246        if ($data{related}) {
247            my @related = ref $data{related} ? @{$data{related}} : $data{related};
248            foreach (@related) {
249                my $obj = $self->base->get_object('nethost', $_) or next;
250                $exists{$obj->id} = 1; 
251                my @current = grep { $_ } $obj->get_attributes('related');
252                grep { $_ eq $self->id } @current and next;
253                $obj->set_c_fields('related' => [ $self->id, @current ]);
254
255            }
256        }
257        foreach ($self->base->search_objects('nethost', 'related=' . $self->id)) {
258            my $obj = $self->base->get_object('nethost', $_) or next;
259            $exists{$_} and next;
260            my @current = grep { $_ eq $self->id } $obj->get_attributes('related');
261            $obj->set_c_fields('related' => [ @current ]);
262        }
263    }
264
265    $res
266}
267
2681;
269
270__END__
271
272=head1 SEE ALSO
273
274L<LATMOS::Accounts::Bases::Sql::Netzones>, L<LATMOS::Accounts::Bases::Sql>
275
276=head1 AUTHOR
277
278Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
279
280=head1 COPYRIGHT AND LICENSE
281
282Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
283
284This library is free software; you can redistribute it and/or modify
285it under the same terms as Perl itself, either Perl version 5.10.0 or,
286at your option, any later version of Perl 5 you may have available.
287
288
289=cut
Note: See TracBrowser for help on using the repository browser.