source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Task/Buildnet.pm

Last change on this file was 2595, checked in by nanardon, 5 months ago

Net::IPv4Addr n'est pas utilisé
File size: 38.2 KB
Line 
1package LATMOS::Accounts::Task::Buildnet;
2
3use strict;
4use warnings;
5use base qw(LATMOS::Accounts::Task);
6use LATMOS::Accounts::Log;
7use LATMOS::Accounts::Utils;
8use FindBin qw($Bin);
9use POSIX qw(strftime);
10use Net::IP;
11use File::Path;
12use File::Temp qw(tempfile);
13use Net::IPv6Addr;
14use URI; # Ensure module is required
15use Net::IDN::Encode ':all';
16
17=head1 NAME
18
19LATMOS::Accounts::Task::Buildnet - Task to generate network configuration files
20
21=head1 DESCRIPTION
22
23This contains functions to generate network config file from C<Netzone> and
24C<Nethost> object.
25
26These config file can be:
27
28=over 4
29
30=item DNS zone files
31
32A standard DNS zone generated from a header and entries found in bases
33
34=item DNS reverse zone files
35
36A reverse DNS zone genarated from a header and entries found in bases
37
38=item A DHCP host list
39
40A file well formated host list to be included in dhcpd config file.
41
42=back
43
44=cut
45
46sub order { 2 }
47
48# Always try because depend also on files:
49
50sub runDelay { 10 * 60 }
51
52sub init {
53    my ($self) = @_;
54    my $LA = $self->LA;
55
56    $self->{_base} = $LA->base();
57    $self->{_base} && $self->{_base} or die "Cannot load base";
58    $self->{_base}->type eq 'sql' or die "This module work only with SQL base type\n";
59    $self->{_la} = $LA;
60}
61
62sub run {
63    my ($self) = @_;
64
65    if (my $cmd = $self->_la->val('_network_', 'pre')) {
66        exec_command(
67            $cmd,
68            {
69                TEMPLATE_DIR => $self->_la->val('_network_', 'template_dir', ''),
70                OUTPUT_DIR => $self->_la->val('_network_', 'output_dir', ''),
71                DIRECTORY => $self->_la->val('_network_', 'output_dir', ''),
72                HOOK_TYPE => 'PRE',
73            },
74        );
75    }
76
77    foreach my $zone ($self->_base->search_objects('netzone', 'exported=*')) {
78        my $ozone = $self->_base->get_object('netzone', $zone)
79            or next;
80        # check file need regeneration:
81        $self->_check_zone_need_update($ozone) or do {
82            la_log(LA_DEBUG, "No need to rebuild %s", $ozone->id);
83            next;
84        };
85        $self->gen_zone($zone) or do {
86            $self->_base->rollback;
87            return;
88        };
89
90        $self->_set_last_build($ozone);
91
92        $self->_base->commit;
93    }
94
95    if (my $cmd = $self->_la->val('_network_', 'post')) {
96        exec_command(
97            $cmd,
98            {
99                TEMPLATE_DIR => $self->_la->val('_network_', 'template_dir', ''),
100                OUTPUT_DIR => $self->_la->val('_network_', 'output_dir', ''),
101                DIRECTORY => $self->_la->val('_network_', 'output_dir', ''),
102                HOOK_TYPE => 'POST',
103            },
104        );
105    }
106
107    1;
108}
109
110sub _la {
111    $_[0]->{_la}
112}
113
114sub _base {
115    my ($self) = @_;
116    return $self->{_base} if ($self->{_base});
117    my $base = $self->SUPER::base;
118    return $self->{_base} = $base
119}
120
121sub _bnet_state {
122    my ($self) = @_;
123    return $self->{_bnet_state} if ($self->{_bnet_state});
124    # where trace goes:
125    my $state_file =  $self->_la->state_dir . '/buildnet_state.ini';
126    la_log(LA_DEBUG, "Status file is %s", $state_file);
127    if ($state_file && ! -w $state_file) {
128        # don't exists, we have to create it
129        open(my $handle, '>', $state_file) or do {
130            la_log(LA_ERR, "Cannot open build net status file %s",
131                $state_file);
132            return;
133        };
134        print $handle "[_default_]\n";
135        close($handle);
136    }
137    $self->{_bnet_state} = Config::IniFiles->new(
138        -file => $state_file
139    );
140}
141
142sub _write_state_file {
143    la_log(LA_DEBUG, "Writting status file");
144    $_[0]->_bnet_state->RewriteConfig;
145}
146
147sub _template_file {
148    my ($self, $ozone) = @_;
149
150    my $template =  join('/', grep { $_ } $self->_la->val('_network_', 'template_dir'),
151        $ozone->get_attributes('templateD'));
152    la_log(LA_DEBUG, "Template for %s is %s", $ozone->id, $template);
153    $template;
154}
155
156sub _output_file {
157    my ($self, $ozone) = @_;
158
159    my $path = join(
160        '/',
161        $self->_la->val('_network_', 'output_dir',
162            ($self->_la->state_dir, $ozone->get_attributes('type'))
163        )
164    );
165
166    if (! -d $path) {
167        la_log(LA_INFO, 'Creating directory %s', $path);
168        mkpath($path) or return;
169    }
170    my $output = join('/', $path, $ozone->get_attributes('outputD'));
171    la_log(LA_DEBUG, 'output file for %s is %s', $ozone->id, $output);
172    $output;
173}
174
175=head2 get_zone_rev ($zone)
176
177Return next zone revision (DNS).
178
179This revision is formated from date + incremental serial number. If day change,
180serial start to 1. If serial goes goes over 99, head build from date is
181increment.
182
183The code ensure returned number is always highter that current one.
184
185=cut
186
187sub get_zone_rev {
188    my ($self, $ozone) = @_;
189    my $date = strftime('%Y%m%d01', localtime);
190    my $oldrev = $ozone->get_attributes('zoneRevision') || 0;
191    my $rev;
192    if ($oldrev >= $date) {
193        # same date, increment subrev
194        $rev = $oldrev + 1;
195    } else {
196        # date has changed, subrev is 1
197        $rev = $date;
198    }
199    la_log(LA_DEBUG, 'new dns revision for %s is %s', $ozone->id, $rev);
200    $ozone->set_c_fields(zoneRevision => $rev) or do {
201        return;
202    };
203    $rev
204}
205
206
207sub _check_zone_need_update {
208    my ($self, $ozone) = @_;
209
210    # If env var is set, do it anyway
211    if ($ENV{LA_BNET_FORCE}) { return 1 }
212
213    if ($ozone->get_attributes('rev') >
214        $self->_bnet_state->val($ozone->id, 'dbrev', 0)) {
215        return 1;
216    }
217
218    return 1 if (! -f $self->_output_file($ozone));
219
220    if ($ozone->get_attributes('templateD')) {
221        my $template = $self->_template_file($ozone);
222        my $output = $self->_output_file($ozone);
223        my @tstat = stat($template) or return;
224        my @ostat = stat($output);
225        if (($ostat[9] || 0) <= ($tstat[9] || 0)) {
226            return 1;
227        }
228    }
229
230    return;
231}
232
233sub _set_last_build {
234    my ($self, $ozone) = @_;
235
236    my $lctime = scalar(localtime);
237    la_log(LA_DEBUG, 'Update last build for zone %s (%s)', $ozone->id, $lctime);
238    $ozone->set_c_fields('lastBuild' => $lctime);
239
240    $self->_bnet_state->newval($ozone->id, 'dbrev',
241        $ozone->get_attributes('rev'));
242    la_log LA_DEBUG, "Zone rev build point is %d for %s",
243    $ozone->get_attributes('rev'),
244    $ozone->id;
245    $self->_bnet_state->SetParameterComment(
246        $ozone->id, 'dbrev',
247        scalar(localtime));
248    $self->_write_state_file;
249}
250
251sub _pre_zone {
252    my ($self, $ozone) = @_;
253
254    if (!$ozone->get_attributes('templateD')) {
255        la_log(LA_ERR, "No template file for zone %s, aborting", $ozone->id);
256        return;
257    }
258
259    my $textzone = $self->_comment_zone($ozone);
260    my $tzone = $self->_read_template($ozone);
261    if (defined($tzone)) {
262        $textzone .= $tzone;
263    } else {
264        return;
265    }
266
267    return $textzone;
268}
269
270=head2 gen_zone($zone, $header)
271
272Generate zone file C<$zone> with header C<$header>
273
274=cut
275
276sub gen_zone {
277    my ($self, $zone) = @_;
278
279    my $timeS = time;
280    my $ozone = $self->_base->get_object('netzone', $zone)
281        or return;
282
283    la_log(LA_INFO, "Start building zone %s (%s)", $zone,
284        $ozone->get_attributes('type'));
285
286    my $header = $self->_pre_zone($ozone);
287
288    my $type = $ozone->get_attributes('type');
289    my $res =
290        $type eq 'dns'     ? $self->_gen_dns_zone($ozone, $header) :
291        $type eq 'reverse' ? $self->_gen_reverse_zone($ozone, $header) :
292        $type eq 'dhcp'    ? $self->_gen_dhcp_zone($ozone, $header) :
293        $type eq 'puppet'  ? $self->_gen_puppet_zone($ozone, $header) :
294        $type eq 'radius'  ? $self->_gen_radius_zone($ozone, $header) :
295        undef;
296
297    if (!defined($res)) {
298    }
299
300    my $textzone =
301        $header .
302        "\n" .
303        $self->_comment($ozone, "Comming from database:\n") .
304        $res .
305        $self->_comment($ozone, "End of data from database\n");
306
307
308    if ($type =~ /^(dns|reverse)$/) {
309        if (!$self->_checkzone_output($ozone, $textzone)) {
310            la_log(LA_ERR, "Output of DNS zone %s not ok, not updating this zone",
311                $ozone->id);
312            return;
313        }
314    }
315
316    if (open(my $handle, '>', $self->_output_file($ozone))) {
317        print $handle $textzone;
318        close($handle);
319        la_log(LA_INFO,
320            "zone %s written into %s (%d second)",
321            $ozone->id,
322            $self->_output_file($ozone),
323            time - $timeS,
324        );
325    } else {
326       la_log(LA_ERR, "Can't open output file for zone %s", $ozone->id);
327       return;
328    }
329
330    if (my $cmd = $self->_la->val('_network_', 'post_file',
331            $self->_la->val('_network_', 'post_zone'))) {
332        exec_command(
333            $cmd,
334            {
335                TEMPLATE_DIR => $self->_la->val('_network_', 'template_dir', ''),
336                OUTPUT_DIR => $self->_la->val('_network_', 'output_dir', ''),
337                DIRECTORY => $self->_la->val('_network_', 'output_dir', ''),
338                TEMPLATE_FILE => $ozone->get_attributes('templateD'),
339                OUTPUT_FILE => $ozone->get_attributes('outputD'),
340                HOOK_TYPE => 'POSTFILE',
341            },
342        );
343    }
344
345    1;
346}
347
348sub _checkzone_output {
349    my ($self, $ozone, $output) = @_;
350
351    if (!$self->_la->val('_network_', 'checkzone')) {
352        return 1;
353    }
354
355    my ($fh, $filename) = tempfile();
356
357    print $fh $output;
358    close($fh);
359
360    my $named_checkzone = $self->_la->val('_network_', 'named-checkzone',
361        '/usr/sbin/named-checkzone');
362
363    my $msg;
364    my $res = exec_command(sprintf(
365            "%s -k fail '%s' '%s'",
366            $named_checkzone,
367            $ozone->id,
368            $filename,
369        ), undef, $msg);
370    if (!$res) {
371        la_log(LA_ERR, "Error on zone %s: ", $ozone->id);
372        la_log(LA_ERR, "  msg: $_") foreach (split(/\n/, $msg));
373    } else {
374        unlink($filename);
375    }
376    $res
377}
378
379sub _comment {
380    my ($self, $ozone, $message, @args) = @_;
381    my $com_prefix =
382        $ozone->get_attributes('type') =~ /^(dhcp|puppet|radius)$/ ? '#' : ';';
383
384    if ($message) {
385        return(sprintf("$com_prefix $message", @args));
386    } else {
387        $com_prefix
388    }
389}
390
391sub _comment_zone {
392    my ($self, $ozone) = @_;
393
394    my @output = ();
395    my $com_prefix =
396        $ozone->get_attributes('type') =~ /^(dhcp|puppet|radius)$/ ? '# ' : '; ';
397    push @output, sprintf('Zone %s, type %s', $ozone->id,
398        $ozone->get_attributes('type'));
399    push @output, $ozone->get_attributes('description')
400        if ($ozone->get_attributes('description'));
401    push @output, sprintf('Generated by %s', q$Id: BuildNet.pm 6283 2011-05-20 10:16:51Z nanardon $ );
402    push @output, sprintf('          the %s', scalar(localtime) );
403    push @output, sprintf('Network: %s', join(', ', $ozone->get_attributes('net')))
404        if ($ozone->get_attributes('net'));
405    push @output, sprintf('Exclude Network: %s', join(', ',
406            $ozone->get_attributes('netExclude')))
407        if ($ozone->get_attributes('netExclude'));
408    if ( $ozone->get_attributes('type') eq 'radius' ) {
409        if ( my $vlan = $ozone->get_attributes('vlan') ) {
410            push( @output, "Default VLAN: $vlan" );
411        }
412    }
413    if ($ozone->get_attributes('type') =~ /^(dhcp|radius)$/) {
414        my @dynFrom = grep { $_ } $ozone->get_attributes('dynFrom');
415        push(@output, sprintf('This zone include host from zone: %s', join(', ', sort @dynFrom)))
416            if (@dynFrom);
417        push(@output, 'This zone include dynamic IP address')
418            if ($ozone->get_attributes('allow_dyn'));
419    }
420
421    return LATMOS::Accounts::Utils::to_ascii(join('', map { $com_prefix . $_ . "\n" } @output) . "\n");
422}
423
424sub _comment_nethost {
425    my ($self, $nethost) = @_;
426
427    my $displayeduser;
428    if (my $owner = $nethost->get_attributes('user')) {
429        if (my $user = $self->_base->get_object('user', $owner)) {
430            $displayeduser = $user->get_attributes('displayName');
431        }
432    }
433    if ((!$displayeduser) && (my $owner = $nethost->get_attributes('owner'))) {
434        if (my $user = $self->_base->get_object('user', $owner)) {
435            $displayeduser = $user->get_attributes('displayName');
436        }
437    }
438    my @desc = (
439        $displayeduser,
440        $nethost->get_attributes('site'),
441        $nethost->get_attributes('physicalDeliveryOfficeName'),
442        $nethost->get_attributes('description'),
443    );
444
445    return LATMOS::Accounts::Utils::to_ascii(join(', ', grep { $_ } @desc) || '');
446}
447
448
449# return undef on fatal error, depending zone type
450sub _read_template {
451    my ($self, $ozone) = @_;
452
453    my $revision = $self->get_zone_rev($ozone) or return;
454    if (open(my $handle, '<', $self->_template_file($ozone))) {
455        my $textzone = '';
456        while (my $line = <$handle>) {
457            $line =~ s/(\d+\s*;\s*)?\@REVISION@/$revision/;
458            $textzone .= $line;
459        }
460        close($handle);
461        return $textzone;
462    } else {
463        if ($ozone->get_attributes('type') =~ /^(dns|reverse)$/) {
464            la_log(LA_ERR, "Can't open template file for zone %s: %s", $ozone->id, $!);
465            return;
466        } else {
467            return '';
468        }
469    }
470}
471
472sub _gen_dns_zone {
473    my ($self, $ozone) = @_;
474
475    my $dbzone = '';
476    my %names;
477    if ($ozone->get_attributes('net')) {
478        my $findhost = $self->_base->db->prepare_cached(q{
479            select name, value::inet as value from nethost join nethost_attributes_ips on
480            nethost.ikey = nethost_attributes_ips.okey
481            where value::inet <<= any(?) and exported = true
482            except
483            select name, value::inet from nethost join nethost_attributes_ips on
484            nethost.ikey = nethost_attributes_ips.okey
485            where value::inet <<= any(?)
486            order by value, name
487        });
488        $findhost->execute(
489            [ $ozone->get_attributes('net') ],
490            [ $ozone->get_attributes('netExclude') ],
491        ) or do {
492            la_log LA_ERR, "Cannot fetch host list: %s",
493                $self->_base->db->errstr;
494            return;
495        };
496        my %lists;
497        # Storing all name in %names to check later if CNAME does not conflict
498        while (my $res = $findhost->fetchrow_hashref) {
499            $lists{$res->{name}} ||= {};
500            push(@{$lists{$res->{name}}{ip}}, $res->{value});
501            my $host_o = $self->_base->get_object('nethost', $res->{name});
502            foreach (grep { $_ } $host_o->get_attributes('otherName')) {
503                $names{$_} = 'A/AAAA';
504            }
505        }
506
507        foreach my $res (sort keys %lists) {
508            my $host_o = $self->_base->get_object('nethost', $res) or do {
509                la_log LA_ERR, "Cannot fetch host %s", $res;
510                return;
511            };
512            my $desc = $self->_comment_nethost($host_o);
513            $dbzone .= $desc
514                ? '; ' . $desc . "\n"
515                : '';
516            foreach my $ip (@{$lists{$res}{ip}}) {
517                $dbzone .= sprintf(
518                    "%-30s IN    %-4s     %s\n",
519                    domain_to_ascii($res),
520                    ($ip =~ /:/ ? 'AAAA' : 'A'),
521                    $ip
522                );
523            }
524            foreach (grep { $_ !~ /\.$/ }  grep { $_ } $host_o->get_attributes('otherName')) {
525                foreach my $ip (@{$lists{$res}{ip}}) {
526                    $dbzone .= sprintf(
527                        "%-30s IN    %-4s     %s\n",
528                        domain_to_ascii($_),
529                        ($ip =~ /:/ ? 'AAAA' : 'A'),
530                        $ip
531                    );
532                }
533            }
534            foreach (grep { $_ !~ /\.$/ } grep { $_ } $host_o->get_attributes('cname')) {
535                # It is deny to have both:
536                # foo IN A
537                # foo IN CNAME
538                if ($names{$_}) {
539                    my $msg .= sprintf(
540                        'Cname %s to %s exclude because %s is already an %s record',
541                        $_, $res, $_, $names{$_}
542                    );
543                    la_log(LA_ERR, sprintf("$msg (zone %s)", $ozone->id));
544                    $dbzone .= "; $msg\n";
545                } else {
546                    $names{ $_ } = 'CNAME';
547                    $dbzone .= sprintf("%-30s IN    CNAME    %s\n", domain_to_ascii($_), domain_to_ascii($res));
548                }
549            }
550            # SSH finger print
551            foreach my $name (grep { $_ !~ /\.$/ }  grep { $_ } ($res, $host_o->get_attributes('otherName'))) {
552                foreach my $sshfp (grep { $_ } $host_o->get_attributes('sshfp')) {
553                    $dbzone .= sprintf(
554                        "%-30s IN    SSHFP    %s\n",
555                        domain_to_ascii($name),
556                        $sshfp,
557                    );
558                }
559            }
560        }
561    }
562
563    my  $suffix = $ozone->id . '.';
564    $suffix =~ s/\./\\./g;
565    $dbzone .= "\n\n; fqdn A, AAAA and CNAME from host in other zone\n";
566
567    {
568        my $dbh = $self->_base->db->prepare_cached(q{
569            select * from nethost join nethost_attributes on nethost.ikey = nethost_attributes.okey
570            where attr = 'otherName' and value ~ ? and exported = 't'
571            order by name, value
572        });
573
574        $dbh->execute( $suffix );
575
576        while ( my $res = $dbh->fetchrow_hashref ) {
577            my $host_o = $self->_base->get_object( 'nethost', $res->{name} ) or do {
578                la_log LA_ERR, "Cannot fetch host '%s'", $res->{name};
579                return;
580            };
581
582            my $hostname = $res->{name};
583            $hostname =~ s/\Q$suffix\E$//;
584
585            if ($names{$hostname} eq 'CNAME') {
586                my $msg .= sprintf(
587                    'Cname %s to %s exclude because %s is already an %s record',
588                    $hostname, $res, $hostname, $names{$hostname}
589                );
590                la_log(LA_ERR, sprintf("$msg (zone %s)", $ozone->id));
591                $dbzone .= "; $msg\n";
592                next;
593            }
594
595            foreach my $ip ( $host_o->get_attributes('ip') ) {
596                my $nip = Net::IP->new($ip);
597                $dbzone .= sprintf(
598                    "%-30s IN    %-4s     %s\n",
599                    domain_to_ascii($hostname),
600                    $nip->version eq 4 ? 'A' : 'AAAA',
601                    $ip,
602                );
603            }
604        }
605    }
606    {
607        my $dbh = $self->_base->db->prepare_cached(q{
608            select * from nethost join nethost_attributes on nethost.ikey = nethost_attributes.okey
609            where attr = 'cname' and value ~ ? and exported = 't'
610            order by name, value
611        });
612
613        $dbh->execute( $suffix );
614
615        while ( my $res = $dbh->fetchrow_hashref ) {
616            my $host_o = $self->_base->get_object( 'nethost', $res->{name} ) or do {
617                la_log LA_ERR, "Cannot fetch host '%s'", $res->{name};
618                return;
619            };
620
621            my $hostname = $res->{name};
622            $hostname =~ s/\Q$suffix\E$//;
623
624            if ($names{$hostname}) {
625                my $msg .= sprintf(
626                    'Cname %s to %s exclude because %s is already an %s record',
627                    $hostname, $res, $hostname, $names{$hostname}
628                );
629                la_log(LA_ERR, sprintf("$msg (zone %s)", $ozone->id));
630                $dbzone .= "; $msg\n";
631                next;
632            }
633
634            foreach my $zone ( $host_o->get_attributes('netZone') ) {
635                my $zone_o = $self->_base->get_object( 'netzone', $zone ) or do {
636                    la_log LA_ERR, "Cannot fetch zone %s", $zone;
637                    next;
638                };
639
640                if ( $zone_o->get_c_field('type') eq 'dns' ) {
641                     $dbzone .= sprintf(
642                        "%-30s IN    CNAME    %s.\n",
643                        domain_to_ascii($hostname),
644                        domain_to_ascii( $host_o->id . '.' . $zone_o->id),
645                    );
646                    last;
647                }
648            }
649        }
650    }
651
652
653    return $dbzone;
654}
655
656sub _gen_reverse_zone {
657    my ($self, $ozone) = @_;
658
659    my $domain = $ozone->get_attributes('domain') || '';
660    my $punyDomain = domain_to_ascii($domain);
661    my $dbzone = '';
662    if ($ozone->get_attributes('net')) {
663        my $findhost = $self->_base->db->prepare_cached(q{
664            select * from (
665            select * from nethost join nethost_attributes_ips on
666            nethost.ikey = nethost_attributes_ips.okey
667            where value::inet <<= ? and exported = true
668            except
669            select * from nethost join nethost_attributes_ips on
670            nethost.ikey = nethost_attributes_ips.okey
671            where value::inet <<= any(?)
672            ) as q
673            order by value::inet
674
675        });
676        $findhost->execute(
677            $ozone->get_attributes('net'),
678            [ $ozone->get_attributes('netExclude') ],
679        ) or do {
680            la_log LA_ERR, "Cannot fetch host list: %s",
681                $self->_base->db->errstr;
682            return;
683        };
684
685        # reverse is complicated:
686        my ($net) = $ozone->get_attributes('net') or do {
687        $self->base->log('Cannot fetch attribute "net" for zone %s', $ozone->id);
688        return;
689    };
690        my $netip = Net::IP->new($net) or do {
691                $self->base->log(LA_ERR, "Cannot build reverse zone %s: wrong net %s", $ozone->id, $net);
692                return;
693        };
694        my $mask = $netip->prefixlen;
695
696        while (my $res = $findhost->fetchrow_hashref) {
697            my $host_o = $self->_base->get_object('nethost', $res->{name}) or do {
698                la_log LA_ERR, "Cannot fetch host %s", $res->{name};
699                return;
700            };
701            my $desc = $self->_comment_nethost($host_o);
702            my $reverse = $host_o->get_attributes('reverse') || ($res->{name} . '.');
703            $dbzone .= $desc
704                ? '; ' . $desc . "\n"
705                : '';
706            my $revip;
707            my $fmt;
708            if ($res->{value} =~ /:/) {
709                # IPv6
710                my $m = $mask/4;
711                $revip = Net::IPv6Addr->new($res->{value})->to_string_ip6_int;
712                $revip =~ s/\.([0-9,a-f]\.?){$m}\.IP6\.INT\.$//i;
713                $fmt = "%-72s IN    PTR    %s%s\n";
714            } else {
715                # ipv4
716                if ($mask > 24) {
717                    $self->_base->log(LA_ERR, 'Mask for zone %s cannot be %d', $ozone->id, $mask);
718                    return;
719                }
720                my @ippart = split(/\./, $res->{value});
721                splice(@ippart, 0, $mask/8); # get rid of start of ip
722                my @nippart;
723                while (@ippart) { unshift(@nippart, shift(@ippart)) }
724                $revip = join('.', @nippart);
725                $fmt = "%-12s IN    PTR    %s%s\n";
726            }
727 
728            $dbzone .= sprintf($fmt, $revip,
729                $reverse =~ /\.$/
730                    ? (domain_to_ascii($reverse), ($punyDomain ? "$punyDomain." : '.'))
731                    : (domain_to_ascii($reverse), '.'));
732        }
733    }
734
735    return $dbzone;
736}
737
738sub _gen_dhcp_zone {
739    my ($self, $ozone) = @_;
740
741    my $outzone = $ozone;
742    my $output = '';
743
744    my $Ikey = $outzone->get_attributes('ikey');
745    my $ZoneId = sprintf('%04x', $Ikey);
746
747    $output .= sprintf("# Zone id is %s (%d)\n\n", $ZoneId, $Ikey);
748
749    my @net;
750    if ($outzone->get_attributes('net')) {
751        @net = (map { Net::IP->new($_) } $outzone->get_attributes('net')) or do {
752            la_log(LA_DEBUG, 'Cannot get Net::IP for zone %s (ip: %s)', $outzone->id,
753                join(', ', $outzone->get_attributes('net')));
754            next;
755        };
756    }
757
758    {
759        my $find = $self->_base->db->prepare(q{
760            select * from nethost where exported = true and ikey in(
761            select okey from nethost_attributes where attr = 'macaddr'
762            intersect (
763                select nethost_attributes_ips.okey from nethost_attributes_ips join
764                netzone_attributes
765                on netzone_attributes.attr = 'net' and
766                netzone_attributes.value::inet >>= nethost_attributes_ips.value::inet
767                join netzone on netzone.ikey = netzone_attributes.okey
768                where netzone.name = $1
769
770                except
771                select nethost_attributes_ips.okey from nethost_attributes_ips join
772                netzone_attributes
773                on netzone_attributes.attr = 'netExclude' and
774                netzone_attributes.value::inet >>= nethost_attributes_ips.value::inet
775                join netzone on netzone.ikey = netzone_attributes.okey
776                where netzone.name = $1
777                )
778            )
779            order by name
780
781            });
782        $find->execute($ozone->id) or do {
783            la_log LA_ERR, "Cannot fetch host list: %s",
784                $self->_base->db->errstr;
785            return;
786        };
787        while (my $res = $find->fetchrow_hashref) {
788            my $nethost = $res->{name};
789
790            my $obj = $self->_base->get_object('nethost', $nethost) or do {
791                la_log LA_ERR, "Cannot fetch host %s", $res->{name};
792                return;
793            };
794
795            my @retainip;
796            if (@net) {
797                foreach my $inet (@net) {
798                    push(@retainip, grep { $_ && $inet->overlaps(Net::IP->new($_)) } $obj->get_attributes('ip'));
799                }
800            }
801
802            $obj->get_attributes('noDynamic') && !@retainip and next;
803
804            my $desc = $self->_comment_nethost($obj);
805            foreach my $mac (sort grep { $_ } $obj->get_attributes('macaddr')) {
806                my %done;
807                foreach my $retainip (sort @retainip) {
808                    $output .= $desc
809                       ? '# ' . $desc . "\n"
810                        : '';
811                    my ($fixedparam, $label) = $retainip =~ /^\d+(\.\d+){3}$/
812                        ? ('fixed-address', '' )
813                        : ('fixed-address6', '-6' );
814                    # If two ip are given for same protocol keep only first
815                    $done{$fixedparam} and next;
816                    $done{$fixedparam} = 1;
817                    my $fmac = $mac;
818                    $fmac =~ s/://g;
819                    $output .= sprintf("host %s-%s-%s%s {\n", domain_to_ascii($nethost), lc($fmac), $ZoneId, $label);
820                    $output .= sprintf("    hardware ethernet %s;\n", $mac);
821                    $output .= sprintf("    $fixedparam %s;\n", $retainip)
822                            if ($retainip);
823                    if ($obj->get_attributes('netLocked')) {
824                        $output .=     "    deny booting;\n";
825                    }
826                    $output .= "}\n\n";
827                }
828            }
829        }
830    }
831    if ($ozone->get_attributes('allow_dyn')) {
832        $output .= "\n# Host without IP:\n";
833        my @dynfrom = grep { $_ } $ozone->get_attributes('dynFrom');
834        my $find = $self->_base->db->prepare(q{
835            select * from nethost where exported = true and ikey in(
836            select okey from nethost_attributes where attr = 'macaddr'
837            } . (@dynfrom ? q{
838            intersect
839            (
840                select ikey from nethost where ikey not in
841                    (select okey from nethost_attributes_ips)
842                union
843
844                (
845                select nethost_attributes_ips.okey from nethost_attributes_ips join
846                netzone_attributes
847                on netzone_attributes.attr = 'net' and
848                   netzone_attributes.value::inet >>=
849                   nethost_attributes_ips.value::inet
850                   join netzone on netzone.ikey = netzone_attributes.okey
851                   where netzone.name = any(?)
852                except
853                select nethost_attributes_ips.okey from nethost_attributes_ips join
854                netzone_attributes
855                on netzone_attributes.attr = 'netExclude' and
856                   netzone_attributes.value::inet >>=
857                   nethost_attributes_ips.value::inet
858                   join netzone on netzone.ikey = netzone_attributes.okey
859                   where netzone.name = any(?)
860                )
861            )} : '') . q{
862            except
863            select nethost_attributes_ips.okey from nethost_attributes_ips join
864            netzone_attributes
865            on netzone_attributes.attr = 'net' and
866            netzone_attributes.value::inet >>= nethost_attributes_ips.value::inet
867            join netzone on netzone.ikey = netzone_attributes.okey
868            where netzone.name = ?
869            )
870            order by name
871
872            });
873        $find->execute((@dynfrom ? ([ @dynfrom ], [ @dynfrom ]) : ()), $ozone->id) or do {
874            la_log LA_ERR, "Cannot fetch host list: %s",
875                $self->_base->db->errstr;
876            return;
877        };
878        while (my $res = $find->fetchrow_hashref) {
879            my $nethost = $res->{name};
880
881            my $obj = $self->_base->get_object('nethost', $nethost);
882
883            $obj->get_attributes('noDynamic') and next;
884
885            my $desc = $self->_comment_nethost($obj);
886            foreach my $mac (sort grep { $_ } $obj->get_attributes('macaddr')) {
887                $output .= $desc
888                    ? '# ' . $desc . "\n"
889                    : '';
890                my $fmac = $mac;
891                $fmac =~ s/://g;
892                if ($obj->get_attributes('netLocked')) {
893                    my ($ipv4, $ipv6);
894                    foreach ($ozone->get_attributes('net')) {
895                        if ($_ =~ /^\d+(\.\d+){3}\/(\d+)$/) {
896                            $ipv4 = 1;
897                        } else {
898                            $ipv6 = 1;
899                        }
900                    }
901
902                    if ($ipv4) {
903                        $output .= sprintf("host %s-%s-%s {\n", $nethost, lc($fmac), $ZoneId);
904                        $output .= sprintf("    hardware ethernet %s;\n", $mac);
905                        $output .=         "    deny booting;\n";
906                        $output .= "}\n\n";
907                    }
908                    if ($ipv6) {
909                        $output .= sprintf("host %s-%s-%s {\n", $nethost, lc($fmac), $ZoneId);
910                        $output .= sprintf("    hardware ethernet %s;\n", $mac);
911                        $output .=         "    deny booting;\n";
912                        $output .= "}\n\n";
913                    }
914                } else {
915                    $output .= sprintf("host %s-%s-%s {\n", $nethost, lc($fmac), $ZoneId);
916                    $output .= sprintf("    hardware ethernet %s;\n", $mac);
917                    $output .= "}\n\n";
918                }
919            }
920        }
921    }
922
923    $output
924}
925
926sub _gen_radius_zone {
927    my ($self, $ozone) = @_;
928
929    my $outzone = $ozone;
930    my $output = '';
931
932    my @net;
933    if ($outzone->get_attributes('net')) {
934        @net = (map { Net::IP->new($_) } $outzone->get_attributes('net')) or do {
935            la_log(LA_DEBUG, 'Cannot get Net::IP for zone %s (ip: %s)', $outzone->id,
936                join(', ', $outzone->get_attributes('net')));
937            next;
938        };
939    }
940
941    my %hosts;
942
943    {
944        my $find = $self->_base->db->prepare(q{
945            select * from nethost where exported = true and ikey in(
946            select okey from nethost_attributes where attr = 'macaddr'
947            intersect (
948                select nethost_attributes_ips.okey from nethost_attributes_ips join
949                netzone_attributes
950                on netzone_attributes.attr = 'net' and
951                netzone_attributes.value::inet >>= nethost_attributes_ips.value::inet
952                join netzone on netzone.ikey = netzone_attributes.okey
953                where netzone.name = $1
954
955                except
956                select nethost_attributes_ips.okey from nethost_attributes_ips join
957                netzone_attributes
958                on netzone_attributes.attr = 'netExclude' and
959                netzone_attributes.value::inet >>= nethost_attributes_ips.value::inet
960                join netzone on netzone.ikey = netzone_attributes.okey
961                where netzone.name = $1
962                )
963            )
964            order by name
965
966            });
967        $find->execute($ozone->id) or do {
968            la_log LA_ERR, "Cannot fetch host list: %s",
969                $self->_base->db->errstr;
970            return;
971        };
972        while (my $res = $find->fetchrow_hashref) {
973            $hosts{ $res->{name} } = 1;
974        }
975    }
976    if ($ozone->get_attributes('allow_dyn')) {
977        my @dynfrom = grep { $_ } $ozone->get_attributes('dynFrom');
978        my $find = $self->_base->db->prepare(q{
979            select * from nethost where exported = true and ikey in(
980            select okey from nethost_attributes where attr = 'macaddr'
981            } . (@dynfrom ? q{
982            intersect
983            (
984                select ikey from nethost where ikey not in
985                    (select okey from nethost_attributes_ips)
986                union
987
988                (
989                select nethost_attributes_ips.okey from nethost_attributes_ips join
990                netzone_attributes
991                on netzone_attributes.attr = 'net' and
992                   netzone_attributes.value::inet >>=
993                   nethost_attributes_ips.value::inet
994                   join netzone on netzone.ikey = netzone_attributes.okey
995                   where netzone.name = any(?)
996                except
997                select nethost_attributes_ips.okey from nethost_attributes_ips join
998                netzone_attributes
999                on netzone_attributes.attr = 'netExclude' and
1000                   netzone_attributes.value::inet >>=
1001                   nethost_attributes_ips.value::inet
1002                   join netzone on netzone.ikey = netzone_attributes.okey
1003                   where netzone.name = any(?)
1004                )
1005            )} : '') . q{
1006            except
1007            select nethost_attributes_ips.okey from nethost_attributes_ips join
1008            netzone_attributes
1009            on netzone_attributes.attr = 'net' and
1010            netzone_attributes.value::inet >>= nethost_attributes_ips.value::inet
1011            join netzone on netzone.ikey = netzone_attributes.okey
1012            where netzone.name = ?
1013            )
1014            order by name
1015
1016            });
1017        $find->execute((@dynfrom ? ([ @dynfrom ], [ @dynfrom ]) : ()), $ozone->id) or do {
1018            la_log LA_ERR, "Cannot fetch host list: %s",
1019                $self->_base->db->errstr;
1020            return;
1021        };
1022        while (my $res = $find->fetchrow_hashref) {
1023            $hosts{ $res->{name} } = 1;
1024        }
1025    }
1026
1027    my %zRadius = ();
1028    foreach ( $outzone->get_attributes('hostParams') ) {
1029        /^\s*(\S+)(?:\s*(.*))$/;
1030        $zRadius{ $1 } = $2;
1031    }
1032    if ( my $zoneVLan = $outzone->get_attributes( 'vlan' ) ) {
1033        $zRadius{'Tunnel-Type'} ||= '= VLAN';
1034        $zRadius{'Tunnel-Medium-Type'} ||= '= 6';
1035        $zRadius{'Tunnel-Private-Group-ID'} ||= "= $zoneVLan";
1036    }
1037
1038    foreach my $nethost (sort keys %hosts) {
1039        my $obj = $self->_base->get_object('nethost', $nethost);
1040
1041        $obj->get_attributes('netLocked') and next;
1042        $obj->get_attributes('noDynamic') and next;
1043
1044        my %hRadius = %zRadius;
1045        foreach ( $obj->get_attributes('radiusParams') ) {
1046            /^\s*(\S+)(?:\s*(.*))$/;
1047            $hRadius{ $1 } = $2;
1048        }
1049        if ( my $vlan = $obj->get_attributes( 'vlan' ) ) {
1050            $hRadius{'Tunnel-Type'} ||= '= VLAN';
1051            $hRadius{'Tunnel-Medium-Type'} ||= '= 6';
1052            $hRadius{'Tunnel-Private-Group-ID'} = "= $vlan";
1053        }
1054
1055        my @parameters = map { "$_ " . $hRadius{ $_ } } grep { $hRadius{ $_ } } sort keys ( %hRadius );
1056
1057        $output .= "# Host: $nethost\n";
1058        my $desc = $self->_comment_nethost($obj);
1059        $output .= $desc
1060            ? '# ' . $desc . "\n"
1061            : '';
1062        foreach my $mac (sort grep { $_ } $obj->get_attributes('macaddr')) {
1063            my $fmac = $mac;
1064            $fmac =~ s/://g;
1065            $output .= sprintf("%s ClearText-Password := \"%s\"\n", lc($fmac), lc($fmac));
1066            $output .= join (",\n", map { "    $_" } @parameters) if( @parameters );
1067            $output .= "\n";
1068        }
1069        $output .= "\n";
1070    }
1071
1072    $output;
1073}
1074
1075sub _gen_puppet_zone {
1076    my ($self, $ozone) = @_;
1077
1078    my $output = '';
1079
1080    if ($ozone->get_attributes('net')) {
1081        my $findhost = $self->_base->db->prepare_cached(q{
1082            select * from (
1083            select * from nethost join nethost_attributes_ips on
1084            nethost.ikey = nethost_attributes_ips.okey
1085            where value::inet <<= ? and exported = true
1086            except
1087            select * from nethost join nethost_attributes_ips on
1088            nethost.ikey = nethost_attributes_ips.okey
1089            where value::inet <<= any(?)
1090            ) as q
1091            order by value::inet
1092
1093        });
1094        $findhost->execute(
1095            $ozone->get_attributes('net'),
1096            [ $ozone->get_attributes('netExclude') ],
1097        ) or do {
1098            la_log LA_ERR, "Cannot fetch host list: %s",
1099                $self->_base->db->errstr;
1100            return;
1101        };
1102
1103        my @puppetclasses = $ozone->get_attributes('puppetClass');
1104        while (my $res = $findhost->fetchrow_hashref) {
1105            my $nethost = $res->{name};
1106
1107            my $obj = $self->_base->get_object('nethost', $nethost) or do {
1108                la_log LA_ERR, "Cannot fetch host %s", $res->{name};
1109                return;
1110            };
1111
1112            # merging classes from host and zone
1113            my %classes = map { $_ => 1 } grep { $_ } (
1114                $obj->get_attributes('puppetClass'),
1115                ($obj->get_attributes('noInheritPuppet') ? () : @puppetclasses),
1116            );
1117            my $desc = $self->_comment_nethost($obj);
1118            $output .= sprintf("node '%s' {\n", $obj->id);
1119            $output .= $desc
1120                ? sprintf("    # %s\n", $desc)
1121                : '';
1122            $output .= join('', map { "    class '$_'\n" } sort keys %classes);
1123            $output .= "}\n\n";
1124        }
1125    }
1126
1127    $output
1128}
1129
1130sub reset_savepoint {
1131    my ($self) = @_;
1132    foreach my $zone ($self->_base->search_objects('netzone')) {
1133        my $ozone = $self->_base->get_object('netzone', $zone)
1134            or next;
1135
1136        $self->_bnet_state->newval($ozone->id, 'dbrev', 0);
1137        la_log LA_DEBUG, "Zone savepoint reset for %s", $ozone->id;
1138        $self->_bnet_state->SetParameterComment(
1139            $ozone->id, 'dbrev',
1140            'Reset savepoint the ' . scalar(localtime));
1141    }
1142
1143    $self->_write_state_file;
1144}
1145
11461;
1147
1148__END__
1149
1150=head1 AUTHOR
1151
1152Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
1153
1154=head1 COPYRIGHT AND LICENSE
1155
1156Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
1157
1158This library is free software; you can redistribute it and/or modify
1159it under the same terms as Perl itself, either Perl version 5.10.0 or,
1160at your option, any later version of Perl 5 you may have available.
1161
1162=cut
Note: See TracBrowser for help on using the repository browser.