File Coverage

blib/lib/Unix/Conf/Bind8/Conf/Zone.pm
Criterion Covered Total %
statement 24 318 7.5
branch 0 230 0.0
condition n/a
subroutine 8 34 23.5
pod 12 13 92.3
total 44 595 7.3


line stmt bran cond sub pod time code
1             # Bind8 Zone handling
2             #
3             # Copyright Karthik Krishnamurthy
4              
5             =head1 NAME
6              
7             Unix::Conf::Bind8::Conf::Zone - Class for representing the Bind8 zone
8             directive
9              
10             =head1 SYNOPSIS
11              
12             use Unix::Conf::Bind8;
13              
14             my ($conf, $zone, $acl, $db, $ret);
15             $conf = Unix::Conf::Bind8->new_conf (
16             FILE => '/etc/named.conf',
17             SECURE_OPEN => 1,
18             ) or $conf->die ("couldn't open `named.conf'");
19              
20             #
21             # Ways to get a Zone object.
22             #
23            
24             $zone = $conf->new_zone (
25             NAME => 'extremix.net',
26             TYPE => 'master',
27             FILE => 'db.extremix.net',
28             ) or $zone->die ("couldn't create zone");
29              
30             # OR
31              
32             $zone = $conf->get_zone ('extremix.net')
33             or $zone->die ("couldn't get zone");
34            
35             #
36             # Operations that can be performed on a Zone object.
37             #
38              
39             $ret = $zone->type ('slave') $ret->die ("couldn't change type");
40             $ret = $zone->masters (qw (192.168.1.1 192.168.1.2))
41             or $ret->die ("couldn't set masters");
42              
43             # create a new acl to be defined before the zone directive
44             # 'extremix.net'.
45             $acl = $conf->new_acl (
46             NAME => 'extremix.com-slaves',
47             ELEMENTS => [ qw (element1 element2) ],
48             WHERE => 'BEFORE',
49             WARG => $zone,
50             ) or $acl->die ("couldn't create `extremix.com-slaves'");
51              
52             $ret = $zone->allow_transfer ('extremix.com-slaves')
53             or $ret->die ("couldn't set `allow-transfer'");
54            
55             $ret = $zone->delete_allow_update ()
56             or $ret->die ("couldn't delete `allow-update'");
57              
58             $db = $zone->get_db () or $db->die ("couldn't get db");
59             # Refer to documentation for Unix::Conf::Bind8::DB
60             # for manipulating the DB file.
61              
62             # delete
63             $ret = $zone->delete () or $ret->die ("couldn't delete");
64              
65             # OR
66              
67             $ret = $conf->delete_zone ('extremix.net')
68             or $ret->die ("couldn't delete zone `extremix.net'");
69              
70             =head1 METHODS
71              
72             =cut
73              
74             package Unix::Conf::Bind8::Conf::Zone;
75              
76 10     10   55 use strict;
  10         18  
  10         545  
77 10     10   55 use warnings;
  10         20  
  10         328  
78 10     10   50 use Unix::Conf;
  10         15  
  10         204  
79              
80 10     10   48 use Unix::Conf::Bind8::Conf::Directive;
  10         17  
  10         408  
81             our @ISA = qw (Unix::Conf::Bind8::Conf::Directive);
82              
83 10     10   51 use Unix::Conf::Bind8::Conf;
  10         17  
  10         255  
84 10     10   57 use Unix::Conf::Bind8::Conf::Lib;
  10         37  
  10         1570  
85 10     10   54 use Unix::Conf::Bind8::Conf::Acl;
  10         16  
  10         18432  
86              
87             # dont become too restrictive. i am putting in validations offhand.
88             # recheck with Bind behaviour.
89             # Arguments: zone class
90             # INCOMPLETE
91             sub validate ($)
92             {
93 0     0 0   my ($zone) = @_;
94 0           my $errmsg = "";
95              
96 0 0         ($zone->type () eq 'master') && do {
97 0 0         $errmsg .= sprintf ("no records file defined for master zone `%s'\n", $zone->name ())
98             if (! $zone->file ());
99 0 0         $errmsg .= sprintf ("masters defined for master zone `%s'\n", $zone->name ())
100             if ($zone->masters ());
101             };
102 0 0         ($zone->type () eq 'slave') && do {
103 0 0         $errmsg .= sprintf ("masters not defined for slave zone `%s'\n", $zone->name ())
104             if (! $zone->masters ());
105             };
106 0 0         ($zone->type () eq 'forward') && do {
107 0 0         $errmsg .= sprintf ("masters defined for forward zone `%s'\n", $zone->name ())
108             if ($zone->masters ());
109 0 0         $errmsg .= sprintf ("forward not defined for forward zone `%s'\n", $zone->name ())
110             if (! $zone->forward ());
111 0 0         $errmsg .= sprintf ("forwarders not defined for forward zone `%s'\n", $zone->name ())
112             if (! $zone->forwarders ());
113             };
114              
115 0 0         return ($errmsg) if ($errmsg);
116 0           return ();
117             }
118              
119             # change to access the hash members directly instead of thro the methods.
120             # that should speed up things a bit
121             sub __render
122             {
123 0     0     my $self = $_[0];
124 0           my ($rendered, $tmp);
125              
126             # name class { type
127 0 0         if ($self->__defined_class ()) {
128 0           $rendered = sprintf (qq (zone "%s" %s {\n\ttype %s;\n), $self->name (), $self->class (), $self->type ());
129             }
130             else {
131 0           $rendered = sprintf (qq (zone "%s" {\n\ttype %s;\n), $self->name (), $self->type ());
132             }
133              
134 0 0         $rendered .= qq (\tfile "$tmp";\n)
135             if (($tmp = $self->file ()));
136 0 0         if (($tmp = $self->masters ())) {
137 0           local $" = "; ";
138 0 0         $rendered .= sprintf (qq (\tmasters %s{\n\t\t@{$tmp->[1]};\n\t};\n),
  0            
139             defined ($tmp->[0]) ? "port $tmp->[0] " : "");
140             }
141              
142 0 0         $rendered .= qq (\tforward $tmp;\n)
143             if (($tmp = $self->forward ()));
144             # list can be empty.
145 0 0         if (($tmp = $self->forwarders ())) {
146 0           local $" = "; ";
147 0           $rendered .= qq (\tforwarders {);
148             # the array might be empty. print `{};' in such cases
149 0 0         $rendered .= qq (\n\t\t@{$tmp};\n\t) if (@$tmp);
  0            
150 0           $rendered .= qq (};\n);
151             }
152              
153 0 0         $rendered .= qq (\tcheck-names $tmp;\n)
154             if (($tmp = $self->check_names ()));
155              
156 0 0         $rendered .= qq (\tnotify $tmp;\n)
157             if (($tmp = $self->notify ()));
158             # list can be empty
159 0 0         if (($tmp = $self->also_notify ())) {
160 0           local $" = "; ";
161 0           $rendered .= qq (\talso-notify {);
162 0 0         $rendered .= qq (\n\t\t@{$tmp};\n\t) if (@$tmp);
  0            
163 0           $rendered .= qq (};\n);
164             }
165              
166             # The values are represented by an ACL. Get the elements, stringify it
167             # and set the ACL to clean, so that the destructors do not write it to file
168             {
169 0 0         $rendered .= "\tallow-update " . ${$tmp->_rstring (undef, 1)} . "\n"
  0            
  0            
170             if (($tmp = $self->allow_update ()));
171 0 0         $rendered .= "\tallow-query " . ${$tmp->_rstring (undef, 1)} . "\n"
  0            
172             if (($tmp = $self->allow_query ()));
173 0 0         $rendered .= "\tallow-transfer " . ${$tmp->_rstring (undef, 1)} . "\n"
  0            
174             if (($tmp = $self->allow_transfer ()));
175             }
176             #local $" = " ";
177 0 0         $rendered .= qq/\tpubkey @{$tmp}[0..2] "$tmp->[3]";\n/
  0            
178             if ($tmp = $self->pubkey ());
179              
180 0           $rendered .= "};";
181 0           return ($self->_rstring (\$rendered));
182             }
183              
184              
185             my %ZoneDirectives = (
186             'forward' => \&__valid_yesno,
187             'notify' => \&__valid_yesno,
188             'dialup' => \&__valid_yesno,
189             'check-names' => \&__valid_checknames,
190             'transfer-source' => \&__valid_ipaddress,
191             'max-transfer-time-in'
192             => \&__valid_number,
193              
194             'also-notify' => 'IPLIST',
195             'forwarders' => 'IPLIST',
196              
197              
198             'allow-transfer' => 'acl',
199             'allow-query' => 'acl',
200             'allow-update' => 'acl',
201              
202             # can't delete the 'name' attribute
203             'name' => 0,
204             'file' => 1,
205             'class' => 1,
206             'type' => 1,
207             'masters' => 1,
208             'pubkey' => 1,
209             );
210              
211              
212             =over 4
213              
214             =item new ()
215              
216             Arguments
217             NAME => 'name',
218             TYPE => 'type', # 'master'|'slave'|'forward'|'stub'|'hint'
219             CLASS => 'class', # 'in'|'hs'|'hesiod'|'chaos'
220             FILE => 'pathname',
221             MASTERS => { # only if TYPE =~ /'slave'|'stub'/
222             PORT => 'port' # optional
223             ADDRESS => [ qw (ip1 ip2) ],
224             },
225             FORWARD => 'yes_no',
226             FORWARDERS => [ qw (ip1 ip2) ],
227             CHECK-NAMES => 'value', # 'warn'|'fail'|'ignore'
228             ALLOW-UPDATE => [ qw (host1 host2) ],
229             ALLOW-QUERY => [ qw (host1 host2) ],
230             ALLOW-TRANSFER => [ qw (host1 host2) ],
231             DIALUP => 'yes_no',
232             NOTIFY => 'yes_no',
233             ALSO-NOTIFY => [ qw (ip1 ip2) ],
234             WHERE => 'FIRST'|'LAST'|'BEFORE'|'AFTER'
235             WARG => Unix::Conf::Bind8::Conf::Directive subclass object
236             # WARG is to be provided only in case WHERE eq 'BEFORE
237             # or WHERE eq 'AFTER'
238             PARENT => reference, # to the Conf object datastructure.
239              
240             Class constructor
241             Creates a new Unix::Conf::Bind8::Conf::Zone object and returns
242             it if successful, an Err object otherwise. Do not use this constructor
243             directly. Use Unix::Conf::Bind8::Conf::new_zone () instead.
244              
245             =cut
246              
247             sub new
248             {
249 0     0 1   shift ();
250 0           my $new = bless ({});
251 0           my %args = @_;
252 0           my ($ret, $acl);
253            
254 0 0         $args{NAME} || return (Unix::Conf->_err ('new', "zone name not defined"));
255 0 0         $args{PARENT} || return (Unix::Conf->_err ('new', "PARENT not defined"));
256 0 0         my $where = $args{WHERE} ? $args{WHERE} : 'LAST';
257 0           my $warg = $args{WARG};
258 0 0         $ret = $new->_parent ($args{PARENT}) or return ($ret);
259 0 0         $ret = $new->name ($args{NAME}) or return ($ret);
260 0           delete (@args{'NAME','PARENT','WHERE','WARG'});
261              
262             # now what is left in %args are zone attributes.
263 0           for (keys (%args)) {
264 0           my $meth = $_;
265 0           $meth =~ tr/A-Z/a-z/;
266 0 0         return (Unix::Conf->_err ("new", "attribute `$meth' not supported"))
267             unless (defined ($ZoneDirectives{$meth}));
268 0           $meth =~ tr/-/_/;
269 0 0         ($_ eq 'MASTERS') && do {
270 0 0         $ret = $new->$meth (%{$args{$_}}) or return ($ret);
  0            
271 0           next;
272             };
273 0 0         $ret = $new->$meth ($args{$_}) or return ($ret);
274             }
275 0 0         $ret = Unix::Conf::Bind8::Conf::_insert_in_list ($new, $where, $warg)
276             or return ($ret);
277 0           return ($new);
278             }
279              
280             =item name ()
281              
282             Arguments
283             'zone', # optional
284              
285             Object method.
286             Get/Set object's name attribute. If argument is passed, the method tries to
287             set the name attribute to 'zone', and returns true if successful, an Err
288             object otherwise. If no argument is passed, returns the name of the zone,
289             if defined, an Err object otherwise.
290              
291             =cut
292              
293             sub name
294             {
295 0     0 1   my ($self, $name) = @_;
296              
297 0 0         if (defined ($name)) {
298 0           my $ret;
299             # strip the double quotes if any
300 0           $name =~ s/^"(.+)"$/$1/;
301             # already defined. changing name
302 0 0         if ($self->{name}) {
303 0 0         $ret = Unix::Conf::Bind8::Conf::_del_zone ($self) or return ($ret);
304             }
305 0           $self->{name} = $name;
306 0 0         $ret = Unix::Conf::Bind8::Conf::_add_zone ($self) or return ($ret);
307 0           $self->dirty (1);
308 0           return (1);
309             }
310 0           return ($self->{name});
311             }
312              
313             =item class ()
314              
315             Arguments
316             'class', # optional
317              
318             Object method.
319             Get/Set object's class attribute. If argument is passed, the method tries
320             to set the class attribute to 'class', and returns true if successful, an
321             Err object otherwise. If no argument is passed, returns the class of
322             the zone, if defined, an Err object otherwise.
323              
324             =cut
325              
326             sub class
327             {
328 0     0 1   my ($self, $class) = @_;
329              
330 0 0         if (defined ($class)) {
331 0 0         return (Unix::Conf->_err ('class', "illegal class `$class'"))
332             if ($class !~ /^(in|hs|hesoid|chaos)$/i);
333 0           $self->{class} = lc ($class);
334 0           return (1);
335             }
336 0 0         return ( defined ($self->{class}) ? $self->{class} : "IN" );
337             }
338              
339 0     0     sub __defined_class { return ( defined ($_[0]->{class}) ); }
340              
341             =item file ()
342              
343             Arguments
344             'file', # optional
345              
346             Object method.
347             Get/Set the object's file attribute. If argument is passed, the method tries
348             to set the file attribute to 'file', and returns true if successful, and
349             Err object otherwise. If no argument is passed, returns the file of the zone, if
350             defined, an Err object otherwise.
351              
352             =cut
353              
354             sub file
355             {
356 0     0 1   my ($self, $file) = @_;
357              
358 0 0         if (defined ($file)) {
359             # strip the double quotes if any
360 0           $file =~ s/^"(.+)"$/$1/;
361 0           $self->{file} = $file;
362 0           $self->dirty (1);
363 0           return (1);
364             }
365             return (
366 0 0         defined ($self->{file}) ? $self->{file} : Unix::Conf->_err ('file', "file not defined")
367             );
368             }
369              
370             =item type ()
371              
372             Arguments
373             'type', # optional
374              
375             Object method.
376             Get/Set the object's type attribute. If argument is passed, the method
377             tries to set the type attribute to 'type', and returns true if successful,
378             an Err object otherwise. If no argument is passed, returns the type of the
379             zone, if defined, an Err object otherwise.
380              
381             =cut
382              
383             sub type
384             {
385 0     0 1   my ($self, $type) = @_;
386              
387 0 0         if (defined ($type)) {
388 0 0         return (Unix::Conf->_err ('type', "illegal type `$type'"))
389             if ($type !~ /^(hint|master|slave|stub|forward)$/);
390 0           $self->{type} = $type;
391 0           $self->dirty (1);
392 0           return (1);
393             }
394 0           return ($self->{type});
395             }
396              
397             =item forward ()
398              
399             =item notify ()
400              
401             =item dialup ()
402              
403             Arguments
404             SCALAR, # 'yes'|'no'|0|1
405              
406             Object method
407             Get/set corresponding attribute in the invocant. If argument is passed,
408             the method tries to set it as the value and returns true if successful,
409             an Err object otherwise. If no argument is passed the value of that
410             attribute is returned if defined, an Err object otherwise.
411              
412             =cut
413              
414             =item check_names ()
415              
416             Arguments
417             string, # 'warn'|'fail'|'ignore'
418              
419             Object method
420             Get/set corresponding attribute in the invocant. If argument is passed,
421             the method tries to set it as the value and returns true if successful,
422             an Err object otherwise. If no argument is passed the value of that
423             attribute is returned if defined, an Err object otherwise.
424              
425             =cut
426              
427             =item transfer_source ()
428              
429             Arguments
430             string, # IPv4 address in dotted quad notation
431              
432             Object method
433             Get/set corresponding attribute in the invocant. If argument is passed,
434             the method tries to set it as the value and returns true if successful,
435             an Err object otherwise. If no argument is passed the value of that
436             attribute is returned if defined, an Err object otherwise.
437              
438             =cut
439              
440             =item max_transfer_time_in ()
441              
442             Arguments
443             number,
444              
445             Object method
446             Get/set corresponding attribute in the invocant. If argument is passed,
447             the method tries to set it as the value and returns true if successful,
448             an Err object otherwise. If no argument is passed the value of that
449             attribute is returned if defined, an Err object otherwise.
450              
451             =cut
452              
453             =item also_notify ()
454              
455             =item forwarders ()
456              
457             Arguments
458             LIST # List of IPv4 addresses in
459             or # dotted quad notation
460             [ LIST ]
461              
462             Object method.
463             Get/set the corresponding attribute in the invoking object. If argument(s)
464             is/are passed, the method tries to set the attribute and returns true
465             on success, an Err object otherwise. If no arguments are passed then
466             the method tries to return an array reference if the attribute is defined,
467             an Err object otherwise.
468              
469             =cut
470              
471             =item add_to_also_notify ()
472              
473             =item add_to_forwarders ()
474              
475             =item add_to_masters ()
476              
477             Arguments
478             LIST # List of IPv4 addresses in
479             or # dotted quad notation.
480             [ LIST ]
481              
482             Object method.
483             Add the elements of the list to the corresponding attribute. Return
484             true on success, an Err object otherwise.
485              
486             =cut
487              
488             =item delete_from_also_notify ()
489              
490             =item delete_from_forwarders ()
491              
492             =item delete_from_masters ()
493              
494             Arguments
495             LIST # List of IPv4 addresses in
496             or # dotted quad notation.
497             [ LIST ]
498              
499             Object method.
500             Delete elements of the list from the corresponding attribute. Return
501             true on success, an Err object otherwise.
502              
503             =cut
504              
505             =item allow_transfer ()
506              
507             =item allow_query ()
508              
509             =item allow_update ()
510              
511             Arguments
512             Acl object,
513             or
514             LIST
515             or
516             [ LIST ]
517              
518             Object method.
519             If argument(s) is/are passed, tries to set the elements of the corresponding
520             attribute and returns true on success, an Err object otherwise. If no
521             arguments are passed, tries to return the elements defined for that attribute
522             as an anonymous array, if defined, an Err object otherwise.
523              
524             =cut
525              
526             =item add_to_allow_transfer ()
527              
528             =item add_to_allow_query ()
529              
530             =item add_to_allow_update ()
531              
532             =item delete_from_allow_transfer ()
533              
534             =item delete_from_allow_query ()
535              
536             =item delete_from_allow_update ()
537              
538             Arguments
539             LIST
540             [ LIST ]
541              
542             Object method.
543             Add to/delete from elements defined for the corresponding attributes.
544             Returns true on success, an Err object otherwise.
545              
546             =cut
547              
548             =item delete_forward ()
549              
550             =item delete_notify ()
551              
552             =item delete_dialup ()
553              
554             =item delete_check_names ()
555              
556             =item delete_transfer_source ()
557              
558             =item delete_max_transfer_time_in ()
559              
560             =item delete_also_notify ()
561              
562             =item delete_forwarders ()
563              
564             =item delete_allow_transfer ()
565              
566             =item delete_allow_query ()
567              
568             =item delete_allow_update ()
569              
570             =item delete_file ()
571              
572             =item delete_class ()
573              
574             =item delete_type ()
575              
576             =item delete_masters ()
577              
578             =item delete_also_notify ()
579              
580             =item delete_forwarders ()
581              
582             =item delete_pubkey ()
583              
584             Object method.
585             Deletes the corresponding attribute, if defined and returns true,
586             an Err object otherwise.
587              
588             =cut
589              
590             for my $dir (keys (%ZoneDirectives)) {
591 10     10   72 no strict 'refs';
  10         20  
  10         33683  
592              
593             my $meth;
594             ($meth = $dir) =~ tr/-/_/;
595              
596             ($ZoneDirectives{$dir} eq 'IPLIST') && do {
597             *$meth = sub {
598 0     0     my $self = shift ();
599 0           my $addresses;
600              
601 0 0         if (@_) {
602 0 0         if (ref ($_[0])) {
603             return (
604 0 0         Unix::Conf->_err (
605             "$meth",
606             "expected arguments are a list or an array reference"
607             )
608             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
609 0           $addresses = $_[0];
610             }
611             else {
612 0           $addresses = \@_;
613             }
614 0           for (@$addresses) {
615 0 0         return (Unix::Conf->_err ("$meth", "illegal IP address `$_'"))
616             if (! __valid_ipaddress ($_));
617             }
618             # reinit
619 0           $self->{$dir} = undef;
620 0           @{$self->{$dir}}{@$addresses} = (1) x @$addresses;
  0            
621 0           $self->dirty (1);
622 0           return (1);
623             }
624              
625             return (
626 0 0         defined ($self->{$dir}) ? [ keys (%{$self->{$dir}}) ] :
  0            
627             Unix::Conf->_err ("$meth", "zone directive `$dir' not defined")
628             )
629             };
630              
631             *{"add_to_$meth"} = sub {
632 0     0     my $self = shift ();
        0      
633 0           my $addresses;
634              
635 0 0         if (@_) {
636 0 0         if (ref ($_[0])) {
637             return (
638 0 0         Unix::Conf->_err (
639             "add_to_$meth",
640             "expected arguments are a list or an array reference"
641             )
642             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
643 0           $addresses = $_[0];
644             }
645             else {
646 0           $addresses = \@_;
647             }
648 0           for (@$addresses) {
649 0 0         return (Unix::Conf->_err ("add_to_$meth", "illegal IP address `$_'"))
650             if (! __valid_ipaddress ($_));
651             return (
652 0 0         Unix::Conf->_err ( "add_to_$meth", "address `$_' already defined" )
653             ) if ($self->{$dir}{$_});
654             }
655 0           @{$self->{$dir}}{@$addresses} = (1) x @$addresses;
  0            
656 0           $self->dirty (1);
657 0           return (1);
658             }
659 0           return (Unix::Conf->_err ("add_to_$meth", "addresses to be added not passed"));
660             };
661              
662             *{"delete_from_$meth"} = sub {
663 0     0     my $self = shift ();
        0      
664 0           my $addresses;
665              
666 0 0         if (@_) {
667 0 0         if (ref ($_[0])) {
668             return (
669 0 0         Unix::Conf->_err (
670             "delete_from_$meth",
671             "expected arguments are a list or an array reference"
672             )
673             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
674 0           $addresses = $_[0];
675             }
676             else {
677 0           $addresses = \@_;
678             }
679 0           for (@$addresses) {
680 0 0         return (Unix::Conf->_err ("delete_from_$meth", "illegal IP address `$_'"))
681             if (! __valid_ipaddress ($_));
682             return (
683 0 0         Unix::Conf->_err ( "delete_from_$meth", "address `$_' not defined" )
684             ) unless ($self->{$dir}{$_});
685             }
686 0           delete (@{$self->{$dir}}{@$addresses});
  0            
687             # if no keys left delete the zone directive itself
688 0           delete ($self->{$dir})
689 0 0         unless (keys (%{$self->{$dir}}));
690 0           $self->dirty (1);
691 0           return (1);
692             }
693 0           return (Unix::Conf->_err ("delete_from_$meth", "addresses to be deleted not passed"));
694             };
695             goto CREATE_DELETE;
696             };
697              
698             # zone directives taking Acl as arguments.
699             ($ZoneDirectives{$dir} eq 'acl') && do {
700             *$meth = sub {
701 0     0     my $self = shift ();
702 0           my $elements;
703              
704 0 0         if (@_) {
705 0 0         if (ref ($_[0])) {
706 0 0         if (UNIVERSAL::isa ($_[0], 'Unix::Conf::Bind8::Conf::Acl')) {
    0          
707             # Acl object passed
708 0           $self->{$dir} = $_[0];
709 0           $self->dirty (1);
710 0           return (1);
711             }
712             elsif (UNIVERSAL::isa ($_[0], 'ARRAY')) {
713             # array ref was passed
714 0           return (Unix::Conf->_err ("$meth", "array passed by reference empty"))
715 0 0         unless (@{$_[0]});
716 0           $elements = $_[0];
717             }
718             else {
719             return (
720 0           Unix::Conf->_err (
721             "$meth",
722             "expected arguments are a list, an Unix::Conf::Bind8::Conf::Acl object or an array ref"
723             )
724             );
725             }
726             }
727             else {
728             # assume a list of elements to be set was passed.
729 0           $elements = \@_;
730             }
731              
732 0           my $acl;
733 0 0         $acl = Unix::Conf::Bind8::Conf::Acl->new (
734             PARENT => $self->_parent (), ELEMENTS => $elements,
735             ) or return ($acl);
736 0           $self->{$dir} = $acl;
737 0           $self->dirty (1);
738 0           return (1);
739             }
740             return (
741 0 0         defined ($self->{$dir}) ?
742             $self->{$dir} :
743             Unix::Conf->_err ("$meth", "zone directive `$dir' not defined")
744             );
745             };
746              
747             # add_to_* counterpart for options taking ACL elements as arguments
748             *{"add_to_$meth"} = sub {
749 0     0     my $self = shift ();
750 0           my ($elements, $ret);
751              
752 0 0         return (Unix::Conf->_err ("add_to_$meth", "elements to be added not passed"))
753             unless (@_);
754              
755 0 0         if (ref ($_[0])) {
756             return (
757 0 0         Unix::Conf->_err (
758             "add_to_$meth",
759             "expected arguments are either a list of elements or an array ref")
760             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
761 0           return (Unix::Conf->_err ("add_to_$meth", "array passed by reference empty"))
762 0 0         unless (@{$_[0]});
763 0           $elements = $_[0];
764             }
765             else {
766 0           $elements = [ @_ ];
767             }
768 0 0         $self->{$dir} = Unix::Conf::Bind8::Conf::Acl->new (
769             PARENT => $self->_parent ()
770             ) unless (defined ($self->{$dir}));
771 0 0         $ret = $self->{$dir}->add_elements ($elements) or return ($ret);
772 0           $self->dirty (1);
773 0           return (1);
774             };
775              
776             # delete_from_* counterpart for options taking ACL elements as arguments
777             *{"delete_from_$meth"} = sub {
778 0     0     my $self = shift ();
779 0           my ($elements, $ret);
780              
781 0 0         return (Unix::Conf->_err ("delete_from_$meth", "elements to be added not passed"))
782             unless (@_);
783              
784 0 0         if (ref ($_[0])) {
785             return (
786 0 0         Unix::Conf->_err (
787             "delete_from_$meth",
788             "expected arguments are either a list of elements or an array ref")
789             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
790 0           return (Unix::Conf->_err ("delete_from_$meth", "array passed by reference empty"))
791 0 0         unless (@{$_[0]});
792 0           $elements = $_[0];
793             }
794             else {
795 0           $elements = [ @_ ];
796             }
797              
798 0 0         return (Unix::Conf::->_err ("delete_from_$meth", "zone directive `$dir' not defined"))
799             unless (defined ($self->{$dir}));
800 0 0         $ret = $self->{$dir}->delete_elements ($elements) or return ($ret);
801             # if all elements have been deleted, delete the option itself.
802 0           delete ($self->{$dir})
803 0 0         unless (@{$self->{$dir}->elements ()});
804 0           $self->dirty (1);
805 0           return (1);
806             };
807             # *_elements
808             *{"${meth}_elements"} = sub {
809             return (
810 0 0   0     defined ($_[0]->{$dir}) ? $_[0]->{$dir}->elements () :
811             Unix::Conf->_err ("{$meth}_elements", "zone directive $dir not defined")
812             );
813             };
814             goto CREATE_DELETE;
815             };
816              
817             ("$ZoneDirectives{$dir}" =~ /^CODE/) && do {
818             *$meth = sub {
819 0     0     my ($self, $arg) = @_;
820            
821 0 0         if (defined ($arg)) {
822 0           return (Unix::Conf->_err ("$meth", "invalid argument $arg"))
823 0 0         unless (&{$ZoneDirectives{$dir}}($arg));
824 0           $self->{$dir} = $arg;
825 0           $self->dirty (1);
826 0           return (1);
827             }
828             return (
829 0 0         defined ($self->{$dir}) ?
830             $self->{$dir} :
831             Unix::Conf->_err ("$meth", "zone directive `$dir' not defined")
832             );
833             };
834             };
835             CREATE_DELETE:
836             # delete_* to be created only for directives which have true value.
837             # will not be created for name.
838             ($ZoneDirectives{$dir}) && do {
839             *{"delete_$meth"} = sub {
840 0 0   0     return (Unix::Conf->_err ("delete_$meth", "zone directive `$dir' not defined"))
841             unless (defined ($_[0]->{$dir}));
842 0           delete ($_[0]->{$dir});
843 0           $_[0]->dirty (1);
844 0           return (1);
845             };
846             };
847             }
848              
849             =item masters ()
850              
851             Arguments
852             PORT => port, # optional
853             ADDRESS => [ LIST ],
854              
855             Object method.
856             Get/sets the 'masters' attribute. If argument is passed, the
857             attribute is set to the argument and returns true on success,
858             an Err object otherwise. If not the attribute value is returned
859             in the form of an anonymous array
860             ([ PORT, [ LIST OF ADDRESSES ] ]), if defined, an Err object
861             otherwise.
862              
863             =cut
864              
865             sub masters
866             {
867 0     0 1   my $self = shift ();
868            
869 0 0         if (@_) {
870 0           my %args = ( @_ );
871            
872 0           $self->{masters} = undef;
873 0 0         if (defined ($args{PORT})) {
874 0 0         return (Unix::Conf->_err ("masters", "illegal PORT `$args{PORT}'"))
875             unless (__valid_port ($args{PORT}));
876 0           $self->{masters}[0] = $args{PORT};
877             }
878 0           for (@{$args{ADDRESS}}) {
  0            
879 0 0         return (Unix::Conf->_err ("masters", "illegal IP address `$_'"))
880             if (! __valid_ipaddress ($_));
881             }
882             # reinit
883 0           @{$self->{masters}[1]}{@{$args{ADDRESS}}} = (1) x @{$args{ADDRESS}};
  0            
  0            
  0            
884 0           $self->dirty (1);
885             }
886              
887 0 0         return (Unix::Conf->_err ("masters", "zone directive `masters' not defined"))
888             unless ($self->{masters});
889 0           return ([ $self->{masters}[0], [ keys (%{$self->{masters}[1]}) ] ]);
  0            
890             }
891              
892             sub add_to_masters
893             {
894 0     0 1   my $self = shift ();
895 0           my $addresses;
896              
897 0 0         if (@_) {
898 0 0         if (ref ($_[0])) {
899             return (
900 0 0         Unix::Conf->_err (
901             "add_to_masters",
902             "expected arguments are a list or an array reference"
903             )
904             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
905 0           $addresses = $_[0];
906             }
907             else {
908 0           $addresses = \@_;
909             }
910 0           for (@$addresses) {
911 0 0         return (Unix::Conf->_err ("add_to_masters", "illegal IP address `$_'"))
912             if (! __valid_ipaddress ($_));
913             return (
914 0 0         Unix::Conf->_err ( "add_to_masters", "address `$_' already defined")
915             ) if ($self->{masters}[1]{$_});
916             }
917 0           @{$self->{masters}[1]}{@$addresses} = (1) x @$addresses;
  0            
918 0           $self->dirty (1);
919 0           return (1);
920             }
921 0           return (Unix::Conf->_err ("add_to_masters", "addresses to be added not passed"));
922             }
923              
924             sub delete_from_masters
925             {
926 0     0 1   my $self = shift ();
927 0           my $addresses;
928              
929 0 0         if (@_) {
930 0 0         if (ref ($_[0])) {
931             return (
932 0 0         Unix::Conf->_err (
933             "delete_from_masters",
934             "expected arguments are a list or an array reference"
935             )
936             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
937 0           $addresses = $_[0];
938             }
939             else {
940 0           $addresses = \@_;
941             }
942 0           for (@$addresses) {
943 0 0         return (Unix::Conf->_err ("delete_from_masters", "illegal IP address `$_'"))
944             if (! __valid_ipaddress ($_));
945             return (
946 0 0         Unix::Conf->_err ( "delete_from_masters", "address `$_' not defined" )
947             ) unless ($self->{masters}[1]{$_});
948             }
949 0           delete (@{$self->{masters}[1]}{@$addresses});
  0            
950             # if no keys left delete the zone directive itself
951 0           delete ($self->{masters})
952 0 0         unless (keys (%{$self->{masters}[1]}));
953 0           $self->dirty (1);
954 0           return (1);
955             }
956 0           return (Unix::Conf->_err ("delete_from_masters", "addresses to be deleted not passed"));
957             }
958              
959             =item masters_port ()
960              
961             Arguments
962             'port', # optional
963              
964             Object method.
965             Get/Set the object's masters port attribute. If argument is passed, the
966             method tries to set the masters port attribute to 'port', and returns true if
967             successful, an Err object otherwise. If no argument is passed, returns the
968             masters port, if defined, an Err object otherwise.
969              
970             =cut
971              
972             sub masters_port
973             {
974 0     0 1   my ($self, $port) = @_;
975              
976 0 0         if (defined ($port)) {
977 0 0         return (Unix::Conf->_err ("masters", "illegal PORT `$port'"))
978             unless (__valid_port ($port));
979 0           $self->{masters}[0] = $port;
980 0           $self->dirty (1);
981 0           return (1);
982             }
983             return (
984 0 0         defined ($self->{masters}[0]) ? $self->{masters}[0] :
985             Unix::Conf->_err ('masters_port', "masters port not defined")
986             );
987             }
988              
989             =item pubkey ()
990              
991             Arguments
992             LIST # flags, protocol, algorithm, string
993             or
994             [ LIST ] # same structure
995              
996             =cut
997              
998             sub pubkey
999             {
1000 0     0 1   my $self = shift ();
1001 0           my $args;
1002              
1003             return (
1004 0 0         defined ($self->{pubkey}) ? [ @{$self->{pubkey}} ] :
  0 0          
1005             Unix::Conf->_err ('pubkey', "zone directive `pubkey' not defined")
1006             ) unless (@_);
1007              
1008 0 0         if (ref ($_[0])) {
    0          
1009 0 0         return (Unix::Conf->_err ('pubkey', ""))
1010             unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
1011 0           $args = [ @{$_[0]} ];
  0            
1012             }
1013             elsif (@_ == 4) {
1014 0           $args = [ @_ ];
1015             }
1016             else {
1017             return (
1018 0           Unix::Conf->_err (
1019             'pubkey', "expected arguments are LIST (flags, protocol, algorithm, key) or [ LIST ]"
1020             )
1021             );
1022             }
1023             # strip quotes if any.
1024 0           $args->[3] =~ s/^"(.+)"$/$1/;
1025 0           $self->{pubkey} = $args;
1026 0           $self->dirty (1);
1027 0           return (1);
1028             }
1029              
1030             =item delete_directive ()
1031              
1032             Arguments
1033             'directive',
1034              
1035             Object method.
1036             Deletes the directive passed as argument, if defined, and returns true, an Err object
1037             otherwise.
1038              
1039             =cut
1040              
1041             sub delete_directive
1042             {
1043 0     0 1   my ($self, $dir) = @_;
1044              
1045 0 0         return (Unix::Conf->_err ('delete_zonedir', "directive to be deleted not passed"))
1046             unless ($dir);
1047             # validate $dir
1048 0 0         return (Unix::Conf->_err ('delete_zonedir', "illegal zone directive `$dir'"))
1049             if ($dir !~ /^(type|file|masters|check-names|allow-update|allow-query|allow-transfer|forward|forwarders|transfer-source|max-transfer-time-in|notify|also-notify)$/);
1050 0 0         return (Unix::Conf->_err ('delete_zonedir', "cannot delete `$dir'"))
1051             if ($dir =~ /^(name|type)$/);
1052 0           undef ($self->{$dir});
1053 0           $self->dirty (1);
1054 0           return (1);
1055             }
1056              
1057             =item get_db ()
1058              
1059             Arguments,
1060             number, # 0/1 secure open
1061              
1062             Constructor
1063             This method is a wrapper method of the class constructor of the Unix::Conf::Bind8::DB
1064             class. Creates and returns a new Unix::Conf::Bind8::DB object representing the records
1065             file for the zone, if successful, an error object otherwise.
1066              
1067             =cut
1068              
1069             sub get_db
1070             {
1071 0     0 1   require Unix::Conf::Bind8::DB;
1072 0           my ($self, $secure_open) = @_;
1073 0 0         $secure_open = 1 unless (defined ($secure_open));
1074              
1075             return (
1076 0           Unix::Conf::Bind8::DB::->new (
1077             FILE => $self->file (),
1078             ORIGIN => $self->name (),
1079             CLASS => uc ($self->class ()),
1080             SECURE_OPEN => $secure_open
1081             )
1082             );
1083             }
1084              
1085             1;