File Coverage

blib/lib/NoZone/Zone.pm
Criterion Covered Total %
statement 339 352 96.3
branch 100 148 67.5
condition 7 13 53.8
subroutine 35 35 100.0
pod 19 19 100.0
total 500 567 88.1


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             #
3             # NoZone::Zone - record information for a bind zone
4             #
5             # Copyright (C) 2013-2021 Daniel P. Berrange
6             #
7             # This program is free software: you can redistribute it and/or modify
8             # it under the terms of the GNU General Public License as published by
9             # the Free Software Foundation, either version 3 of the License, or
10             # (at your option) any later version.
11             #
12             # This program is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15             # GNU General Public License for more details.
16             #
17             # You should have received a copy of the GNU General Public License
18             # along with this program. If not, see .
19             #
20              
21             package NoZone::Zone;
22              
23 2     2   16 use strict;
  2         4  
  2         65  
24 2     2   10 use warnings;
  2         3  
  2         61  
25              
26 2     2   1020 use POSIX qw(strftime);
  2         14510  
  2         14  
27              
28             =head1 NAME
29              
30             Nozone::Zone - record information for a bind zone
31              
32             =head1 SYNOPSIS
33              
34             use Nozone::Zone;
35              
36             my $nozone = Nozone::Zone->new(
37             domains => [
38             "nozone.org",
39             "nozone.com",
40             ],
41             hostmaster => "hostmaster",
42             lifetimes => {
43             refresh => "1H",
44             retry => "15M",
45             expire => "1W"
46             negative => "1H",
47             ttl => "1H",
48             },
49             machines => {
50             platinum => {
51             ipv4 => "12.32.56.1"
52             ipv6 => "2001:1234:6789::1"
53             },
54             gold => {
55             ipv4 => "12.32.56.2"
56             ipv6 => "2001:1234:6789::2"
57             },
58             silver => {
59             ipv4 => "12.32.56.3"
60             ipv6 => "2001:1234:6789::3"
61             },
62             },
63             default => "platinum",
64             spf => {
65             policy => "reject",
66             machines => [
67             "gold",
68             "silver"
69             ]
70             },
71             dkim => {
72             "default" => {
73             version => "DKIM1",
74             keytype => "rsa",
75             pubkey => "MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC1TaNgLlSyQMNWVLNLvyY/neDgaL2oqQE8T5illKqCgDtFHc8eHVAU+nlcaGmrKmDMw9dbgiGk1ocgZ56NR4ycfUHwQhvQPMUZw0cveel/8EAGoi/UyPmqfcPibytH81NFtTMAxUeM4Op8A6iHkvAMj5qLf4YRNsTkKAV"
76             },
77             },
78             mail => {
79             mx0 => {
80             priority => 10,
81             machine => "gold"
82             },
83             mx1 => {
84             priority => 30,
85             machine => "silver"
86             },
87             },
88             dns => {
89             ns0 => "gold",
90             ns1 => "silver",
91             },
92             names => {
93             www => "platinum",
94             },
95             aliases => {
96             db => "gold",
97             backup => "silver",
98             },
99             txt => {
100             challenge1 => "9e428dae-b677-49b6-9eb9-a5754cbbfc2c",
101             },
102             wildcard => "platinum",
103             inherits => $parentzone,
104             );
105              
106             foreach my $domain ($zone->get_domains()) {
107             my $conffile = "/etc/named/$domain.conf";
108             my $datafile = "/var/named/data/$domain.data";
109              
110             my $conffh = IO::File->new($conffile, ">");
111             $zone->generate_conffile($conffh, $domain, $datafile);
112             $conffh->close();
113              
114             my $datafh = IO::File->new($datafile, ">");
115             $zone->generate_datafile($datafh, $domain);
116             $datafh->close();
117             }
118              
119             =head1 DESCRIPTION
120              
121             The C class records the information for a single
122             DNS zone. A DNS zone can be associated with zero or more domain
123             names. A zone without any associated domain names can serve as
124             an abstract base from which other zones inherit data. Inheritance
125             of zones allows admins to minimize the duplication of data across
126             zones.
127              
128             A zone contains a number of parameters, which are usually provided
129             when the object is initialized.
130              
131             =over 4
132              
133             =item domains
134              
135             The C parameter is an array reference providing the list
136             of domain names associated with the DNS zone.
137              
138             domains => [
139             "nozone.org",
140             "nozone.com",
141             ]
142              
143             =item hostmaster
144              
145             The C parameter is the local part of the email address
146             of the person who manages the domain. This will be combined with
147             the domain name to form the complete email address
148              
149             hostmaster => "hostmaster"
150              
151             =item lifetimes
152              
153             The C parameter specifies various times for DNS zone
154             records. These are use to populate the SOA records in the zone.
155              
156             lifetimes => {
157             refresh => "1H",
158             retry => "15M",
159             expire => "1W"
160             negative => "1H",
161             ttl => "1H",
162             }
163              
164             =item machines
165              
166             The C parameter is a hash reference whose keys are the
167             names of physical machines. The values are further hash references
168             specifying the IPv4 and IPv6 addresses for the names.
169              
170             machines => {
171             platinum => {
172             ipv4 => "12.32.56.1"
173             ipv6 => "2001:1234:6789::1"
174             },
175             gold => {
176             ipv4 => "12.32.56.2"
177             ipv6 => "2001:1234:6789::2"
178             },
179             silver => {
180             ipv4 => "12.32.56.3"
181             ipv6 => "2001:1234:6789::3"
182             },
183             }
184              
185             =item default
186              
187             The C parameter is used to specify the name of the
188             machine which will be use as the default when resolving the
189             base domain name
190              
191             default => "platinum"
192              
193             =item mail
194              
195             The C parameter is a hash reference whose keys are the
196             names to setup as mail servers. The values are an further has
197             reference whose elements specify the priority of the mail
198             server and the name of the machine defined in the C
199             parameter.
200              
201             mail => {
202             mx0 => {
203             priority => 10,
204             machine => "gold"
205             },
206             mx1 => {
207             priority => 30,
208             machine => "silver"
209             },
210             }
211              
212             =item dns
213              
214             The C parameter is a hash reference whose keys are the
215             names to setup as DNS servers. The values are the names of
216             machines defined in the C parameter which are to
217             used to define the corresponding IP addresses
218              
219             dns => [
220             ns0 => "gold",
221             ns1 => "silver",
222             ]
223              
224             =item names
225              
226             The C parameter is a hash reference whose keys reflect
227             additional names to be defined as A/AAAA records for the zone.
228             The values refer to keys in the C parameter and are
229             used to define the corresponding IP addresses
230              
231             names => {
232             www => "platinum",
233             }
234              
235             =item aliases
236              
237             The C parameter is a hash reference whose keys reflect
238             additional names to be defiend as CNAME records for the zone.
239             The values refer to keys in the C or C
240             parameter and are used to the define the CNAME target.
241              
242             aliases => {
243             db => "gold",
244             backup => "silver",
245             }
246              
247             =item wildcard
248              
249             The C parameter is a string refering to a name
250             defined in the C parameter. If set this parameter
251             is used to defined a wildcard DNS entry in the zone.
252              
253             wildcard => "platinum"
254              
255             =item spf
256              
257             The C parameter is a hash reference setting up the
258             SPF records. The C key takes one of the values
259             B, B, or B, to specify what happens
260             when an IP doesn't match the SPF. The C key
261             is an array reference that specifies the list of machine
262             names that are permitted to send email.
263              
264             =item dkim
265              
266             The C parameter is a hash of hash references setting
267             up the DKIM records. The key for the first level hash is
268             the DKIM
269             following keys.
270              
271             The C key must always be C. The C
272             key must be a public key algorithm name, typically 'rsa'.
273             The C key is a string restricting the usage.
274             The C key is the public key.
275              
276             =item txt
277              
278             The C parameter is a has of arbitrary key and value
279             strings, which will be added as TXT records.
280              
281             =back
282              
283             =head1 METHODS
284              
285             =over 4
286              
287             =item my $zone = NoZone::Zone->new(%params);
288              
289             Creates a new L object to hold information
290             about a DNS zone. The C<%params> has keys are allowed to
291             be any of the parameters documented earlier in this
292             document. In addition the C parameter is valid
293             and can refer to another instance of the L
294             class.
295              
296             =cut
297              
298              
299             sub new {
300 6     6 1 11 my $proto = shift;
301 6   33     24 my $class = ref($proto) || $proto;
302 6         18 my $self = {};
303 6         36 my %params = @_;
304              
305 6 50       77 $self->{domains} = $params{domains} ? $params{domains} : [];
306 6 100       20 $self->{hostmaster} = $params{hostmaster} ? $params{hostmaster} : "hostmaster";
307 6 100       14 $self->{lifetimes} = $params{lifetimes} ? $params{lifetimes} : undef;
308 6 50       16 $self->{machines} = $params{machines} ? $params{machines} : {};
309 6 100       15 $self->{default} = $params{default} ? $params{default} : undef;
310 6 50       12 $self->{mail} = $params{mail} ? $params{mail} : {};
311 6 50       15 $self->{dns} = $params{dns} ? $params{dns} : [];
312 6 50       26 $self->{names} = $params{names} ? $params{names} : {};
313 6 50       17 $self->{aliases} = $params{aliases} ? $params{aliases} : {};
314 6 50       17 $self->{txt} = $params{txt} ? $params{txt} : {};
315 6 100       12 $self->{wildcard} = $params{wildcard} ? $params{wildcard} : undef;
316 6 100       26 $self->{spf} = $params{spf} ? $params{spf} : undef;
317 6 50       15 $self->{dkim} = $params{dkim} ? $params{dkim} : {};
318 6 50       15 $self->{inherits} = $params{inherits} ? $params{inherits} : undef;
319              
320 6         10 bless $self, $class;
321              
322 6         24 return $self;
323             }
324              
325              
326             =item $zone->set_inherits($parentzone);
327              
328             Sets the zone from which this zone will inherit data
329             parameters. The C<$parentzone> method should be an
330             instance of the C class.
331              
332             =cut
333              
334              
335             sub set_inherits {
336 4     4 1 8 my $self = shift;
337 4         12 my $zone = shift;
338              
339 4         17 $self->{inherits} = $zone;
340             }
341              
342              
343             =item my @domains = $zone->get_domains();
344              
345             Returns the array of domain names associated directly
346             with this zone.
347              
348             =cut
349              
350             sub get_domains {
351 6     6 1 15 my $self = shift;
352              
353 6         9 return @{$self->{domains}};
  6         34  
354             }
355              
356              
357             =item my $name = $zone->get_hostmaster();
358              
359             Returns the hostmaster setting associated with this
360             zone, if any. If no hostmaster is set against this zone,
361             then the hostmaster from any parent zone will be returned.
362             If no parent zone is present, an undefined value will
363             be returned.
364              
365             =cut
366              
367             sub get_hostmaster {
368 3     3 1 7 my $self = shift;
369              
370 3 50       11 if (defined $self->{hostmaster}) {
371 3         10 return $self->{hostmaster};
372             }
373              
374 0 0       0 if (defined $self->{inherits}) {
375 0         0 return $self->{inherits}->get_hostmaster();
376             }
377              
378 0         0 return "hostmaster";
379             }
380              
381              
382             =item my %lifetimes = $zone->get_lifetimes();
383              
384             Return a hash containing the lifetimes defined against
385             this zone. If no data is defined for this zone, then
386             the data from any parent zone is returned. If not
387             parent zone is set, then some sensible default times
388             are returned.
389              
390             =cut
391              
392             sub get_lifetimes {
393 6     6 1 10 my $self = shift;
394              
395 6 100       19 if (defined $self->{lifetimes}) {
396 3         5 return %{$self->{lifetimes}};
  3         28  
397             }
398              
399 3 50       8 if ($self->{inherits}) {
400 3         10 return $self->{inherits}->get_lifetimes();
401             }
402              
403             return (
404 0         0 refresh => "1H",
405             retry => "15M",
406             expire => "1W",
407             negative => "1H",
408             ttl => "1H",
409             );
410             }
411              
412              
413             =item my %machines = $zone->get_machines();
414              
415             Return hash containing the union of all the machines
416             defined in this zone and its parent(s) recursively.
417              
418             =cut
419              
420             sub get_machines {
421 102     102 1 177 my $self = shift;
422              
423 102         125 my %machines;
424              
425 102 100       215 if ($self->{inherits}) {
426 51         101 %machines = $self->{inherits}->get_machines();
427             }
428              
429 102         138 foreach my $name (keys %{$self->{machines}}) {
  102         232  
430 153         297 $machines{$name} = $self->{machines}->{$name};
431             }
432              
433 102         296 return %machines;
434             }
435              
436              
437             =item $machine = $zone->get_machine($name);
438              
439             Return a hash reference containing the IP addresses
440             associated with the machine named C<$name>.
441              
442             =cut
443              
444             sub get_machine {
445 48     48 1 71 my $self = shift;
446 48         71 my $name = shift;
447              
448 48         171 my %machines = $self->get_machines();
449              
450 48 50       227 return exists $machines{$name} ? $machines{$name} : undef;
451             }
452              
453              
454             =item my $name = $zone->get_default();
455              
456             Returns the name of the machine to be used as the
457             default for the zone. If no default is defined
458             for this zone, then the default from any parent
459             zone is defined. If no parent zone is defined,
460             then return an undefined value
461              
462             =cut
463              
464             sub get_default {
465 6     6 1 10 my $self = shift;
466              
467 6 100       15 if (defined $self->{default}) {
468 3         14 return $self->{default};
469             }
470              
471 3 50       15 if (defined $self->{inherits}) {
472 3         9 return $self->{inherits}->get_default();
473             }
474              
475 0         0 return undef;
476             }
477              
478              
479             =item my %dns = $zone->get_dns();
480              
481             Return a hash containing the union of all the machines
482             defined as dns servers in this zone and its parent(s)
483             recursively.
484              
485             =cut
486              
487             sub get_dns {
488 6     6 1 12 my $self = shift;
489              
490 6         8 my %dns;
491              
492 6 100       18 if ($self->{inherits}) {
493 3         16 %dns = $self->{inherits}->get_dns();
494             }
495              
496 6         7 foreach my $name (keys %{$self->{dns}}) {
  6         22  
497 6         16 $dns{$name} = $self->{dns}->{$name};
498             }
499              
500 6         25 return %dns;
501             }
502              
503              
504             =item my %mail = $zone->get_mail();
505              
506             Return a hash containing the union of all the machines
507             defined as mail servers in this zone and its parent(s)
508             recursively.
509              
510             =cut
511              
512             sub get_mail {
513 6     6 1 9 my $self = shift;
514              
515 6         8 my %mail;
516              
517 6 100       19 if ($self->{inherits}) {
518 3         10 %mail = $self->{inherits}->get_mail();
519             }
520              
521 6         10 foreach my $name (keys %{$self->{mail}}) {
  6         22  
522 6         12 $mail{$name} = $self->{mail}->{$name};
523             }
524              
525 6         23 return %mail;
526             }
527              
528              
529             =item %names = $zone->get_names();
530              
531             Return a hash containing the union of all the machine
532             hostnames defined in this zone and its parent(s)
533             recursively.
534              
535             =cut
536              
537             sub get_names {
538 6     6 1 102 my $self = shift;
539              
540 6         10 my %names;
541              
542 6 100       17 if ($self->{inherits}) {
543 3         12 %names = $self->{inherits}->get_names();
544             }
545              
546 6         10 foreach my $name (keys %{$self->{names}}) {
  6         20  
547 3         8 $names{$name} = $self->{names}->{$name};
548             }
549              
550 6         20 return %names;
551             }
552              
553              
554             =item %names = $zone->get_aliases();
555              
556             Return a hash containing the union of all the machine
557             aliases defined in this zone and its parent(s)
558             recursively.
559              
560             =cut
561              
562             sub get_aliases {
563 6     6 1 9 my $self = shift;
564              
565 6         10 my %aliases;
566              
567 6 100       25 if ($self->{inherits}) {
568 3         19 %aliases = $self->{inherits}->get_aliases();
569             }
570              
571 6         9 foreach my $name (keys %{$self->{aliases}}) {
  6         20  
572 6         16 $aliases{$name} = $self->{aliases}->{$name};
573             }
574              
575 6         26 return %aliases;
576             }
577              
578              
579             =item %names = $zone->get_txt();
580              
581             Return a hash containing the union of all the TXT
582             records defined in this zone and its parent(s)
583             recursively.
584              
585             =cut
586              
587             sub get_txt {
588 6     6 1 12 my $self = shift;
589              
590 6         9 my %txt;
591              
592 6 100       15 if ($self->{inherits}) {
593 3         9 %txt = $self->{inherits}->get_txt();
594             }
595              
596 6         9 foreach my $name (keys %{$self->{txt}}) {
  6         19  
597 4         11 $txt{$name} = $self->{txt}->{$name};
598             }
599              
600 6         19 return %txt;
601             }
602              
603              
604             =item %selectors = $zone->get_dkim_selectors();
605              
606             Return a hash containing the union of all the dkim
607             records defined in this zone and its parent(s)
608             recursively.
609              
610             =cut
611              
612             sub get_dkim_selectors {
613 6     6 1 11 my $self = shift;
614              
615 6         7 my %selectors;
616              
617 6 100       34 if ($self->{inherits}) {
618             %selectors = $self->{inherits}->get_dkim_selectors()
619 3         10 }
620              
621 6         7 foreach my $selector (keys %{$self->{dkim}}) {
  6         18  
622 4         9 $selectors{$selector} = $self->{dkim}->{$selector};
623             }
624              
625 6         18 return %selectors;
626             }
627              
628              
629             =item my $name = $zone->get_wildcard();
630              
631             Return the name of the machine which will handle
632             wildcard name lookups. If no wildcard is defined
633             against the zone, returns the wildcard of the
634             parent zone. If there is no parent zone, an
635             undefined value is returned, indicating that no
636             wildcard DNS entry will be created.
637              
638             =cut
639              
640             sub get_wildcard {
641 6     6 1 11 my $self = shift;
642              
643 6 100       16 if (defined $self->{wildcard}) {
644 3         10 return $self->{wildcard};
645             }
646              
647 3 50       7 if ($self->{inherits}) {
648 3         9 return $self->{inherits}->get_wildcard();
649             }
650              
651 0         0 return undef;
652             }
653              
654             =item my $policy = $zone->get_spf_policy();
655              
656             Returns the policy for SPF records for the domain.
657             The policy is one of the string B, B
658             or B. If no SPF policy is defined gainst the
659             zone, returns the SPF policy of the parent zone.
660             if there is no parent zone an undefined value is
661             returned indicating that no SPF entry will be
662             created.
663              
664             =cut
665              
666             sub get_spf_policy {
667 40     40 1 48 my $self = shift;
668              
669 40 100       76 if (defined $self->{spf}) {
670 20         49 return $self->{spf}->{policy};
671             }
672              
673 20 100       37 if ($self->{inherits}) {
674 10         18 return $self->{inherits}->get_spf_policy();
675             }
676              
677 10         21 return undef;
678             }
679              
680              
681             =item my @machines = $zone->get_spf_machines();
682              
683             Returns the list of machines that are permitted to
684             send mail to record as SPF records. If no machines
685             are defined against the zone, returns the machines
686             of teh parent zone. If there is no parent zone an
687             empty list if returned
688              
689             =cut
690              
691             sub get_spf_machines {
692 20     20 1 28 my $self = shift;
693              
694 20 50       39 if (defined $self->{spf}) {
695 20         23 return @{$self->{spf}->{machines}};
  20         61  
696             }
697              
698 0 0       0 if ($self->{inherits}) {
699 0         0 return $self->{inherits}->get_spf_machines();
700             }
701              
702 0         0 return ();
703             }
704              
705              
706             =item $zone->generate_conffile($fh, $domain, $datafile, \@masters, $verbose=0);
707              
708             Generate a Bind zone conf file for the domain C<$domain>
709             writing the data to the file handle C<$fh>. C<$fh>
710             should be an instance of L. The optional C<$verbose>
711             parameter can be set to a true value to print progress on
712             stdout. If C<@masters> is a non-empty list, then a slave
713             config will be created, otherwise a master config will be
714             created. The C<$datafile> parameter should specify the
715             path to the corresponding zone data file, usually kept
716             in C.
717              
718             =cut
719              
720             sub generate_conffile {
721 6     6 1 11 my $self = shift;
722 6         10 my $fh = shift;
723 6         12 my $domain = shift;
724 6         10 my $datafile = shift;
725 6         10 my $masters = shift;
726 6   50     26 my $verbose = shift || 0;
727              
728 6 100       9 if (int(@{$masters})) {
  6         20  
729 3         6 my $masterlist = join (" ; ", @{$masters});
  3         10  
730              
731 3         22 print $fh <
732             zone "$domain" in {
733             type slave;
734             file "$datafile";
735             masters { $masterlist ; };
736             };
737             EOF
738             } else {
739 3         55 print $fh <
740             zone "$domain" in {
741             type master;
742             file "$datafile";
743             };
744             EOF
745             }
746             }
747              
748              
749             =item $zone->generate_datafile($fh, $domain, $verbose=0);
750              
751             Generate a Bind zone data file for the domain C<$domain>
752             writing the data to the file handle C<$fh>. C<$fh>
753             should be an instance of L. The optional C<$verbose>
754             parameter can be set to a true value to print progress on
755             stdout.
756              
757             =cut
758              
759             sub generate_datafile {
760 3     3 1 6 my $self = shift;
761 3         5 my $fh = shift;
762 3         7 my $domain = shift;
763 3   50     7 my $verbose = shift || 0;
764              
765 3         13 $self->_generate_soa($fh, $domain, $verbose);
766 3         13 $self->_generate_default($fh, $verbose);
767 3         11 $self->_generate_dns($fh, $verbose);
768 3         63 $self->_generate_mail($fh, $verbose);
769 3         11 $self->_generate_machines($fh, $verbose);
770 3         21 $self->_generate_names($fh, $verbose);
771 3         9 $self->_generate_aliases($fh, $verbose);
772 3         11 $self->_generate_dkim($fh, $verbose);
773 3         15 $self->_generate_txt($fh, $verbose);
774 3         117 $self->_generate_wildcard($fh, $verbose);
775             }
776              
777              
778             sub _generate_soa {
779 3     3   6 my $self = shift;
780 3         4 my $fh = shift;
781 3         6 my $domain = shift;
782 3         3 my $verbose = shift;
783              
784 3 50       29 print " - Generate soa $domain\n" if $verbose;
785              
786 3         15 my $hostmaster = $self->get_hostmaster();
787              
788 3         8 my $now = time;
789 3         216 my $time = strftime("%Y/%m/%d %H:%M:%S", gmtime(time));
790              
791 3         16 my %lifetimes = $self->get_lifetimes();
792 3         8 my $refresh = $lifetimes{refresh};
793 3         6 my $retry = $lifetimes{retry};
794 3         5 my $expire = $lifetimes{expire};
795 3         4 my $negative = $lifetimes{negative};
796 3         6 my $ttl = $lifetimes{ttl};
797              
798 3         48 print $fh <
799             \$ORIGIN $domain.
800             \$TTL $ttl ; queries are cached for this long
801             @ IN SOA ns1 $hostmaster (
802             $now ; Date $time
803             $refresh ; slave queries for refresh this often
804             $retry ; slave retries refresh this often after failure
805             $expire ; slave expires after this long if not refreshed
806             $negative ; errors are cached for this long
807             )
808              
809             EOF
810              
811             }
812              
813              
814             sub _generate_record {
815 106     106   226 my $self = shift;
816 106         175 my $fh = shift;
817 106         178 my $name = shift;
818 106         161 my $type = shift;
819 106         226 my $detail = shift;
820 106         130 my $value = shift;
821 106         191 my $comment = shift;
822              
823 106         180 my $suffix = "";
824 106 100       164 if (defined $comment) {
825 62         96 $suffix = " ; " . $comment;
826             }
827              
828 106         652 printf $fh "%-20s IN %-8s %-6s %s%s\n", $name, $type, $detail, $value, $suffix;
829             }
830              
831              
832             sub _generate_spf {
833 30     30   43 my $self = shift;
834 30         37 my $fh = shift;
835 30         35 my $name = shift;
836 30         40 my $machine = shift;
837 30         35 my $verbose = shift;
838              
839 30         53 my $policy = $self->get_spf_policy();
840 30 100       72 return unless defined $policy;
841              
842 20         25 my $sentinel;
843 20 50       180 if ($policy eq "accept") {
    50          
    50          
844 0         0 $sentinel = "+all";
845             } elsif ($policy eq "reject") {
846 0         0 $sentinel = "-all";
847             } elsif ($policy eq "mark") {
848 20         31 $sentinel = "~all";
849             } else {
850 0         0 $sentinel = "?all";
851             }
852              
853 20         32 my $spf;
854             my $comment;
855 20 100 100     70 if ($name eq "\@" || $name eq "*") {
856 4         11 my @machines = $self->get_spf_machines();
857              
858 4         6 my @ips;
859 4         10 foreach my $machine (@machines) {
860 8         19 my $addrs = $self->get_machine($machine);
861 8 50       19 die "cannot find machine $machine" unless defined $addrs;
862 8 50       18 if (exists $addrs->{ipv4}) {
863 8         24 push @ips, "ip4:" . $addrs->{ipv4};
864             }
865 8 50       17 if (exists $addrs->{ipv6}) {
866 8         26 push @ips, "ip6:" . $addrs->{ipv6};
867             }
868             }
869              
870 4         19 $comment = "Machine(s) " . join(", ", @machines);
871 4         14 $spf = "v=spf1 " . join(" ", @ips, $sentinel);
872             } else {
873 16         31 my @machines = $self->get_spf_machines();
874              
875 16         34 $comment = "Machine $machine";
876 16 100       34 if (grep { $_ eq $machine } @machines) {
  32         75  
877 10         21 my $addrs = $self->get_machine($machine);
878 10 50       23 die "cannot find machine $machine" unless defined $addrs;
879 10         15 my @ips;
880 10 50       114 if (exists $addrs->{ipv4}) {
881 10         27 push @ips, "ip4:" . $addrs->{ipv4};
882             }
883 10 50       20 if (exists $addrs->{ipv6}) {
884 10         33 push @ips, "ip6:" . $addrs->{ipv6};
885             }
886 10         115 $spf = "v=spf1 " . join(" ", @ips, $sentinel);
887             } else {
888 6         11 $spf = "v=spf1 " . $sentinel;
889             }
890             }
891 20         61 $self->_generate_record($fh, $name, "TXT", "", '"' . $spf . '"', $comment);
892             }
893              
894             sub _generate_machine {
895 30     30   88 my $self = shift;
896 30         37 my $fh = shift;
897 30         42 my $name = shift;
898 30         42 my $machine = shift;
899 30         34 my $verbose = shift;
900              
901 30 100       774 print " - Generate [$name] for [$machine]\n" if $verbose;
902              
903 30         124 my $addrs = $self->get_machine($machine);
904              
905 30 50       64 die "cannot find machine $machine" unless defined $addrs;
906              
907 30         38 my $comment;
908 30 100       57 if ($name ne $machine) {
909 21         33 $comment = "Machine $machine";
910             }
911              
912 30 50       117 $self->_generate_record($fh, $name, "A", "", $addrs->{ipv4}, $comment) if exists $addrs->{ipv4};
913 30 50       160 $self->_generate_record($fh, $name, "AAAA", "", $addrs->{ipv6}, $comment) if exists $addrs->{ipv6};
914 30 50 33     91 if (exists $addrs->{ipv4} || exists $addrs->{ipv6}) {
915 30         63 $self->_generate_spf($fh, $name, $machine, $verbose);
916             }
917             }
918              
919              
920             sub _generate_default {
921 3     3   7 my $self = shift;
922 3         6 my $fh = shift;
923 3         4 my $cfg = shift;
924 3         4 my $domain = shift;
925 3         6 my $verbose = shift;
926              
927 3 50       8 print " - Generate default\n" if $verbose;
928              
929 3         16 my $default = $self->get_default();
930              
931 3 50       10 if (defined $default) {
932 3         8 print $fh "; Primary name records for unqualfied domain\n";
933 3         11 $self->_generate_machine($fh, "\@", $default, $verbose);
934 3         8 print $fh "\n";
935             }
936             }
937              
938              
939             sub _generate_dns {
940 3     3   6 my $self = shift;
941 3         6 my $fh = shift;
942 3         4 my $verbose = shift;
943              
944 3 50       107 print " - Generate dns\n" if $verbose;
945              
946 3         23 my %dns = $self->get_dns();
947              
948 3         17 print $fh "; DNS server records\n";
949              
950 3         16 my @dns = sort { $a cmp $b } keys %dns;
  3         13  
951 3         9 foreach my $name (@dns) {
952 6         15 $self->_generate_record($fh, "\@", "NS", "", $name);
953             }
954              
955 3         9 foreach my $name (@dns) {
956 6         17 $self->_generate_machine($fh, $name, $dns{$name}, $verbose);
957             }
958 3         9 print $fh "\n";
959             }
960              
961              
962             sub _generate_mail {
963 3     3   6 my $self = shift;
964 3         4 my $fh = shift;
965 3         5 my $verbose = shift;
966              
967 3 50       99 print " - Generate mail\n" if $verbose;
968              
969 3         19 my %mail = $self->get_mail();
970              
971 3         10 print $fh "; E-Mail server records\n";
972              
973 3         13 my @mail = sort { $a cmp $b } keys %mail;
  3         13  
974 3         8 foreach my $name (@mail) {
975 6         14 my $prio = $mail{$name}->{'priority'};
976 6         23 $self->_generate_record($fh, "\@", "MX", $prio, $name);
977             }
978              
979 3         8 foreach my $name (@mail) {
980 6         14 my $machine = $mail{$name}->{'machine'};
981 6         45 $self->_generate_machine($fh, $name, $machine, $verbose);
982             }
983 3         11 print $fh "\n";
984             }
985              
986              
987             sub _generate_machines {
988 3     3   6 my $self = shift;
989 3         5 my $fh = shift;
990 3         5 my $verbose = shift;
991              
992 3 50       95 print " - Generate machines\n" if $verbose;
993              
994 3         14 my %names = $self->get_machines();
995              
996 3 50       8 if (%names) {
997 3         18 print $fh "; Primary names\n";
998              
999 3         17 foreach my $name (sort { $a cmp $b } keys %names) {
  7         17  
1000 9         21 $self->_generate_machine($fh, $name, $name, $verbose);
1001             }
1002 3         8 print $fh "\n";
1003             }
1004             }
1005              
1006              
1007             sub _generate_names {
1008 3     3   5 my $self = shift;
1009 3         5 my $fh = shift;
1010 3         5 my $verbose = shift;
1011              
1012 3 50       90 print " - Generate names\n" if $verbose;
1013              
1014 3         18 my %names = $self->get_names();
1015              
1016 3 50       9 if (%names) {
1017 3         7 print $fh "; Extra names\n";
1018              
1019 3         10 foreach my $name (sort { $a cmp $b } keys %names) {
  0         0  
1020 3         9 $self->_generate_machine($fh, $name, $names{$name}, $verbose);
1021             }
1022 3         10 print $fh "\n";
1023             }
1024             }
1025              
1026              
1027             sub _generate_aliases {
1028 3     3   7 my $self = shift;
1029 3         4 my $fh = shift;
1030 3         5 my $verbose = shift;
1031              
1032 3 50       108 print " - Generate aliases\n" if $verbose;
1033              
1034 3         21 my %aliases = $self->get_aliases();
1035              
1036 3 50       10 if (%aliases) {
1037 3         9 print $fh "; Aliased names\n";
1038              
1039 3         14 foreach my $alias (sort { $a cmp $b } keys %aliases) {
  3         11  
1040 6         28 $self->_generate_record($fh, $alias, "CNAME", "", $aliases{$alias});
1041             }
1042 3         10 print $fh "\n";
1043             }
1044             }
1045              
1046              
1047             sub _generate_txt {
1048 3     3   8 my $self = shift;
1049 3         4 my $fh = shift;
1050 3         5 my $verbose = shift;
1051              
1052 3 50       71 print " - Generate txt\n" if $verbose;
1053              
1054 3         16 my %txt = $self->get_txt();
1055              
1056 3 50       8 if (%txt) {
1057 3         7 print $fh "; Extra TXT\n";
1058              
1059 3         10 foreach my $alias (sort { $a cmp $b } keys %txt) {
  1         3  
1060 4         12 $self->_generate_record($fh, $alias, "TXT", "", $txt{$alias});
1061             }
1062 3         10 print $fh "\n";
1063             }
1064             }
1065              
1066              
1067             sub _generate_dkim {
1068 3     3   7 my $self = shift;
1069 3         5 my $fh = shift;
1070 3         5 my $verbose = shift;
1071              
1072 3 50       50 print " - Generate dkim\n" if $verbose;
1073              
1074 3         16 my %selectors = $self->get_dkim_selectors();
1075              
1076 3 100       10 if (%selectors) {
1077 2         5 print $fh "; DKIM selectors\n";
1078              
1079 2         8 foreach my $selector (sort { $a cmp $b } keys %selectors) {
  2         6  
1080 4         8 my $dkim = $selectors{$selector};
1081 4 100       13 my $version = exists $dkim->{"version"} ? $dkim->{"version"} : "DKIM1";
1082 4 100       10 my $keytype = exists $dkim->{"keytype"} ? $dkim->{"keytype"} : "rsa";
1083 4         8 my $service = $dkim->{"service"};
1084 4         6 my $pubkey = $dkim->{"pubkey"};
1085 4         12 my $value = "v=$version; k=$keytype;";
1086 4 100       10 if (defined $service) {
1087 2         5 $value .= " s=$service;";
1088             }
1089 4         7 $value .= " p=$pubkey";
1090 4         23 $self->_generate_record($fh, $selector . "._domainkey", "TXT", "", '"' . $value . '"');
1091             }
1092 2         6 print $fh "\n";
1093             }
1094             }
1095              
1096              
1097             sub _generate_wildcard {
1098 3     3   8 my $self = shift;
1099 3         5 my $fh = shift;
1100 3         4 my $verbose = shift;
1101              
1102 3 50       71 print " - Generate wildcard\n" if $verbose;
1103 3         16 my $wildcard = $self->get_wildcard();
1104              
1105 3 50       7 if (defined $wildcard) {
1106 3         7 print $fh "; Wildcard\n";
1107 3         10 $self->_generate_machine($fh, "*", $wildcard, $verbose);
1108 3         15 print $fh "\n";
1109             }
1110             }
1111              
1112              
1113             1;
1114              
1115             =back
1116              
1117             =head1 AUTHORS
1118              
1119             C was written by Daniel P. Berrange
1120              
1121             =head1 LICENSE
1122              
1123             C is distributed under the terms of the GNU GPL version 3
1124             or any later version. You should have received a copy of the GNU
1125             General Public License along with this program. If not, see
1126             C.
1127              
1128             =head1 SEE ALSO
1129              
1130             L, C