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

Last change on this file since 1904 was 1737, checked in by nanardon, 8 years ago

Add task modules

Add two task module:

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