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

Last change on this file since 2390 was 2390, checked in by nanardon, 4 years ago

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