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

Last change on this file since 2265 was 2142, checked in by nanardon, 6 years ago

Fix: test on alias/othername
File size: 11.1 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                checkinputformat => sub {
113                    return $_[0] =~ /^[[:ascii:]]+$/ ? 1 : 0;
114                },
115            },
116            related   => {
117                multiple => 1, uniq => 1,
118                reference => 'nethost',
119                label => l('Related'),
120            },
121            owner   => {
122                monitored => 1,
123                reference => 'user',
124                delayed => 1,
125                label => l('Owner'),
126            },
127            user    => {
128                reference => 'user',
129                delayed => 1,
130                label => l('User'),
131                monitored => 1,
132            },
133            netZone => {
134                multiple => 1, ro => 1, managed => 1,
135                reference => 'netzone',
136                get => sub {
137                    my ($self) = @_;
138                    my $find = $self->base->db->prepare_cached(q{
139                        select name from netzone where ikey in
140                        (
141                        select netzone_attributes.okey from netzone_attributes join
142                        nethost_attributes_ips on netzone_attributes.attr='net'
143                            and
144                        nethost_attributes_ips.value::inet <<=
145                        netzone_attributes.value::inet
146                        where nethost_attributes_ips.okey = $1
147                        except
148                        select netzone_attributes.okey from netzone_attributes join
149                        nethost_attributes_ips on netzone_attributes.attr='netExclude'
150                            and nethost_attributes_ips.value::inet <<= netzone_attributes.value::inet
151                        where nethost_attributes_ips.okey = $1
152                        )
153                        order by name
154                        });
155                    $find->execute($self->object->get_attributes('ikey'));
156                    my @zones;
157                    while (my $res = $find->fetchrow_hashref) {
158                        push(@zones, $res->{name});
159                    }
160                    return @zones ? [ @zones ] : undef;
161                },
162                label => l('NetZones'),
163            },
164            puppetClass => {
165                multiple => 1,
166                label => l('Puppet Class'),
167            },
168            netZoneExclude => {
169                multiple => 1, ro => 1, managed => 1,
170                reference => 'netzone',
171                get => sub {
172                    my ($self) = @_;
173                    my $find = $self->base->db->prepare_cached(q{
174                        select name from netzone where ikey in
175                        (
176                        select netzone_attributes.okey from netzone_attributes join
177                        nethost_attributes_ips on netzone_attributes.attr='netExclude'
178                            and
179                        nethost_attributes_ips.value::inet <<=
180                        netzone_attributes.value::inet
181                        where nethost_attributes_ips.okey = $1
182                        )
183                            order by name
184                        });
185                    $find->execute($self->object->get_attributes('ikey'));
186                    my @zones;
187                    while (my $res = $find->fetchrow_hashref) {
188                        push(@zones, $res->{name});
189                    }
190                    return @zones ? [ @zones ] : undef;
191                },
192            },
193            noDynamic => { 
194                formtype => 'CHECKBOX',
195                label => l('No dynamic IP'),
196            },
197            exported => { formtype => 'CHECKBOX', },
198            noInheritPuppet => {
199                formtype => 'CHECKBOX',
200                label => l('No puppet'),
201            },
202            otherName => {
203                multiple => 1,
204                input => sub { lc($_[0]) },
205                label => l('Other name'),
206                checkinputformat => sub {
207                    return $_[0] =~ /^[[:ascii:]]+$/ ? 1 : 0;
208                },
209            },
210            sshfp => {
211                multiple => 1,
212                label => l('SSH finger print'),
213            },
214            ip6 => { },
215            sshfpUpdate  => {
216                managed => 1,
217                iname => 'sshfp',
218                input => sub {
219                    my ($self, $data) = @_;
220                    $data or return;
221                    open(my $h, '<', $data) or return;
222                    my @sshfps;
223                    while (my $line = <$h>) {
224                        my ($type, $mode, $key) = $line =~ /^\S+\s+IN\s+SSHFP\s+(\d)\s+(\d)\s+(\S+)/i
225                            or do {
226                            la_log(LA_ERR, "Seems to not be a ssh-keygen line: %s", $line);
227                            return;
228                        };
229                        la_log(LA_DEBUG, "found sshfp %s %s %s", $type, $mode, $key);
230                        push(@sshfps, "$type $mode $key");
231                    }
232                    close($h);
233                    \@sshfps;
234                }
235            },
236            comment => {
237                label => l('Comment'),
238            },
239            description => {
240                label => l('Description'),
241            },
242            hostType => {
243                label => l('Host\'s type'),
244            },
245            encryptKey => {
246                label => l('Encrypted key'),
247            },
248            reverse => {
249                label => l('Reverse name'),
250            },
251            serialNumber => {
252                label => l('Serial number'),
253            },
254            inventoryNumber => {
255                label => l('Inventory number'),
256            },
257            site => {
258                reference => 'site',
259                label => l('Site'),
260            },
261            physicalDeliveryOfficeName => {
262                label => l('Office'),
263            },
264            netLocked => {
265                formtype => 'CHECKBOX',
266                monitored => 1,
267                label => l('Locked'),
268            },
269
270        }
271    )
272}
273
274sub set_fields {
275    my ($self, %data) = @_;
276
277    my $res = $self->SUPER::set_fields(%data);
278
279    # Post update related
280    if (exists $data{related}) {
281        my %exists;
282        if ($data{related}) {
283            my @related = ref $data{related} ? @{$data{related}} : $data{related};
284            foreach (@related) {
285                my $obj = $self->base->get_object('nethost', $_) or next;
286                $exists{$obj->id} = 1; 
287                my @current = grep { $_ } $obj->get_attributes('related');
288                grep { $_ eq $self->id } @current and next;
289                $obj->set_c_fields('related' => [ $self->id, @current ]);
290
291            }
292        }
293        foreach ($self->base->search_objects('nethost', 'related=' . $self->id)) {
294            my $obj = $self->base->get_object('nethost', $_) or next;
295            $exists{$_} and next;
296            my @current = grep { $_ eq $self->id } $obj->get_attributes('related');
297            $obj->set_c_fields('related' => [ @current ]);
298        }
299    }
300
301    $res
302}
303
3041;
305
306__END__
307
308=head1 SEE ALSO
309
310L<LATMOS::Accounts::Bases::Sql::Netzones>, L<LATMOS::Accounts::Bases::Sql>
311
312=head1 AUTHOR
313
314Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
315
316=head1 COPYRIGHT AND LICENSE
317
318Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
319
320This library is free software; you can redistribute it and/or modify
321it under the same terms as Perl itself, either Perl version 5.10.0 or,
322at your option, any later version of Perl 5 you may have available.
323
324
325=cut
Note: See TracBrowser for help on using the repository browser.