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

Last change on this file since 2113 was 2113, checked in by nanardon, 7 years ago

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