File Coverage

blib/lib/Unix/Conf/Bind8/Conf/Options.pm
Criterion Covered Total %
statement 24 511 4.7
branch 0 386 0.0
condition 0 60 0.0
subroutine 8 41 19.5
pod 22 22 100.0
total 54 1020 5.2


line stmt bran cond sub pod time code
1             # Bind8 Options
2             #
3             # Copyright Karthik Krishnamurthy
4              
5             =head1 NAME
6              
7             Unix::Conf::Bind8::Conf::Options - Class for representing Bind8 options
8             directive
9              
10             =head1 SYNOPSIS
11              
12             use Unix::Conf;
13             my ($conf, $options, $ret);
14             $conf = Unix::Conf::Bind8->new_conf (
15             FILE => '/etc/named.conf',
16             SECURE_OPEN => 1,
17             ) or $conf->die ("couldn't open `named.conf'");
18              
19             #
20             # Get an Options object
21             #
22              
23             # get an options object if one is defined
24             $options = $conf->get_options ()
25             or $options->die ("couldn't get options");
26            
27             # or create a new one
28             $options = $conf->new_options (
29             DIRECTORY => 'db',
30             VERSION => '8.2.3-P5',
31             ) or $options->die ("couldn't create options");
32              
33            
34             #
35             # Operations that can be performed on an Options object
36             # Since the number of operations are too many, only a
37             # hint is given here. Consult the METHODS section, for
38             # a comprehnsive list.
39             #
40              
41             my $acl = $conf->new_acl (
42             NAME => 'query-acl',
43             ELEMENTS => [ qw (10.0.0.1 10.0.0.2 10.0.0.3) ],
44             );
45             $acl->die ("couldn't create `query-acl'") unless ($acl);
46              
47             $ret = $options->allow_query ($acl)
48             or $ret->die ("couldn't set allow-query");
49              
50             # OR
51              
52             $ret = $options->allow_query (qw (10.0.0.1 10.0.0.2 10.0.0.3))
53             or $ret->die ("couldn't set allow-query");
54              
55             # Delete the option.
56             $options->delete_allow_query ();
57            
58             =head1 METHODS
59              
60             =cut
61              
62             package Unix::Conf::Bind8::Conf::Options;
63              
64 10     10   53 use strict;
  10         18  
  10         330  
65 10     10   49 use warnings;
  10         17  
  10         269  
66 10     10   134 use Unix::Conf;
  10         20  
  10         178  
67              
68 10     10   49 use Unix::Conf::Bind8::Conf::Directive;
  10         15  
  10         385  
69             our @ISA = qw (Unix::Conf::Bind8::Conf::Directive);
70              
71 10     10   47 use Unix::Conf::Bind8::Conf;
  10         17  
  10         208  
72 10     10   51 use Unix::Conf::Bind8::Conf::Lib;
  10         18  
  10         1380  
73 10     10   7537 use Unix::Conf::Bind8::Conf::Acl;
  10         27  
  10         6629  
74              
75              
76             # Methods that have a valid routine are automatically created. The rest are
77             # hand coded.
78             my %Supported_Options = (
79             'version' => \&__valid_string,
80             'directory' => \&__valid_string,
81             'named-xfer' => \&__valid_string,
82             'dump-file' => \&__valid_string,
83             'memstatistics-file' => \&__valid_string,
84             'pid-file' => \&__valid_string,
85             'statistics-file' => \&__valid_string,
86              
87             'auth-nxdomain' => \&__valid_yesno,
88             'deallocate-on-exit' => \&__valid_yesno,
89             'dialup' => \&__valid_yesno,
90             'fake-iquery' => \&__valid_yesno,
91             'fetch-glue' => \&__valid_yesno,
92             'has-old-clients' => \&__valid_yesno,
93             'host-statistics' => \&__valid_yesno,
94             'host-statistics-max-number' => \&__valid_number,
95             'multiple-cnames' => \&__valid_yesno,
96             'notify' => \&__valid_yesno,
97             'recursion' => \&__valid_yesno,
98             'rfc2308-type1' => \&__valid_yesno,
99             'use-id-pool' => \&__valid_yesno,
100             'treat-cr-as-space' => \&__valid_yesno,
101             'also-notify' => \&__valid_yesno,
102              
103             'forward' => \&__valid_forward,
104              
105             'allow-query' => 'acl',
106             'allow-recursion' => 'acl',
107             'allow-transfer' => 'acl',
108             'blackhole' => 'acl',
109              
110             'lame-ttl' => \&__valid_number,
111             'max-transfer-time-in' => \&__valid_number,
112             'max-ncache-ttl' => \&__valid_number,
113             'min-roots' => \&__valid_number,
114             # the man page provides this directive
115             'serial-queries' => \&__valid_number,
116             # the sample named.conf with bind suggests this.
117             'max-serial-queries' => \&__valid_number,
118              
119             'transfer-format' => \&__valid_transfer_format,
120              
121             'transfers-in' => \&__valid_number,
122             'transfers-out' => \&__valid_number,
123             'transfers-per-ns' => \&__valid_number,
124              
125             'transfer-source' => \&__valid_ipaddress,
126              
127             'maintain-ixfr-base' => \&__valid_yesno,
128             'max-ixfr-log-size' => \&__valid_number,
129              
130             'coresize' => \&__valid_sizespec,
131             'datasize' => \&__valid_sizespec,
132             'files' => \&__valid_sizespec,
133             'stacksize' => \&__valid_sizespec,
134              
135             'cleaning-interval' => \&__valid_number,
136             'heartbeat-interval' => \&__valid_number,
137             'interface-interval' => \&__valid_number,
138             'statistics-interval' => \&__valid_number,
139              
140             'topology' => 'acl',
141             'sortlist' => 'acl',
142              
143             # methods below have only their delete_* counterpart created via closure
144             # as the pattern of arguments don't fit well into a template
145             'check-names' => 0,
146             'forwarders' => 1,
147             'rrset-order' => 0,
148             'listen-on' => 0,
149             'query-source' => 1,
150             );
151              
152             =over 4
153              
154             =item new ()
155              
156             Arguments
157             OPTION-NAME => value, # the value type is dependant on the option
158             WHERE => 'FIRST'|'LAST'|'BEFORE'|'AFTER'
159             WARG => Unix::Conf::Bind8::Conf::Directive subclass object
160             # WARG is to be provided only in case WHERE eq 'BEFORE
161             # or WHERE eq 'AFTER'
162             PARENT => reference, # to the Conf object datastructure.
163              
164             Class Constructor.
165             Create a new Unix::Conf::Bind8::Conf::Options object and return it if
166             successful, or an Err object otherwise. Do not use this constructor
167             directly. Use the Unix::Conf::Bind8::Conf::new_options () method instead.
168              
169             =cut
170              
171             sub new
172             {
173 0     0 1   my $self = shift ();
174 0           my $new = bless ({});
175 0           my $ret;
176              
177 0           my %args = @_;
178 0 0         $args{PARENT} || return (Unix::Conf->_err ('new', "PARENT not defined"));
179 0 0         $ret = $new->_parent ($args{PARENT}) or return ($ret);
180 0           delete ($args{PARENT}); # as PARENT is not a valid option
181 0 0         my $where = $args{WHERE} ? $args{WHERE} : 'LAST';
182 0           my $warg = $args{WARG};
183 0           delete (@args{'WHERE','WARG'});
184 0           for (keys (%args)) {
185 0           my $option = $_;
186 0           $option =~ tr/A-Z/a-z/;
187 0 0         return (Unix::Conf->_err ('new', "option `$option' not supported"))
188             unless (defined ($Supported_Options{$option}));
189             # change it into the corresponding method name
190 0           $option =~ tr/-/_/;
191 0 0         $ret = $new->$option ($args{$_}) or return ($ret);
192             }
193 0 0         $ret = Unix::Conf::Bind8::Conf::_add_options ($new) or return ($ret);
194 0 0         $ret = Unix::Conf::Bind8::Conf::_insert_in_list ($new, $where, $warg)
195             or return ($ret);
196 0           return ($new);
197             }
198              
199             =item version ()
200              
201             =item directory ()
202              
203             =item named_xfer ()
204              
205             =item dump_file ()
206              
207             =item memstatistics_file ()
208              
209             =item pid_file ()
210              
211             =item statistics_file ()
212              
213             Arguments
214             'string', # optional
215              
216             Object method.
217             Get/Set attributes from the invoking object.
218             If called with a string argument, the method tries to set the corresponding
219             attribute and returns true on success, an Err object otherwise. Returns
220             value of the corresponding attribute if defined, an Err object otherwise.
221              
222             =item auth_nxdomain ()
223              
224             =item deallocate_on_exit ()
225              
226             =item dialup ()
227              
228             =item fake_iquery ()
229              
230             =item fetch_glue ()
231              
232             =item has_old_clients ()
233              
234             =item host_statistics ()
235              
236             =item multiple_cnames ()
237              
238             =item notify ()
239              
240             =item recursion ()
241              
242             =item rcf2308_type1 ()
243              
244             =item use_id_pool ()
245              
246             =item treat_cr_as_space ()
247              
248             =item also_notify ()
249              
250             =item maintain_ixfr_base ()
251              
252             Arguments
253             'string', # 'yes'|'no'
254              
255             Object method.
256             Get/Set attributes from the invoking object.
257             If called with a string argument, the method tries to set the corresponding
258             attribute and returns true on success, an Err object otherwise. Returns
259             value of the corresponding attribute if defined, an Err object otherwise.
260              
261             =item forward ()
262              
263             Arguments
264             'string', # 'only'|'first'
265              
266             Object method.
267             Get/Set attributes from the invoking object.
268             If called with a string argument, the method tries to set the corresponding
269             attribute and returns true on success, an Err object otherwise. Returns
270             value of the corresponding attribute if defined, an Err object otherwise.
271              
272             =item allow_query ()
273              
274             =item allow_transfer ()
275              
276             =item allow_recursion ()
277              
278             =item blackhole ()
279              
280             Arguments
281             Acl object
282             or
283             LIST
284             or
285             [ LIST ]
286              
287             Object method.
288             If argument(s) is/are passed, tries to set the elements of the appropriate
289             attribute and returns true on success, an Err object otherwise. If no
290             arguments are passed, tries to return the elements defined for that attribute
291             as an anonymous array, if defined, an Err object otherwise.
292              
293             =item add_to_allow_query ()
294              
295             =item add_to_allow_transfer ()
296              
297             =item add_to_allow_recursion ()
298              
299             =item add_to_blackhole ()
300              
301             =item delete_from_allow_query ()
302              
303             =item delete_from_allow_transfer ()
304              
305             =item delete_from_allow_recursion ()
306              
307             =item delete_from_blackhole ()
308              
309             Arguments
310             LIST
311             or
312             [ LIST ]
313              
314             Object method.
315             Add to/delete from the elements defined for the appropriate attributes.
316             Returns true on success, an Err object otherwise.
317              
318             =item lame_ttl ()
319              
320             =item max_transfer_time_in ()
321              
322             =item max_ncache_ttl ()
323              
324             =item min_roots ()
325              
326             =item serial_queries ()
327              
328             =item max_serial_queries ()
329              
330             =item transfers_in ()
331              
332             =item transfers_out ()
333              
334             =item transfers_per_ns ()
335              
336             =item max_ixfr_log_size ()
337              
338             =item cleaning_interval ()
339              
340             =item heartbeat_interval ()
341              
342             =item interface_interval ()
343              
344             =item statistics_interval ()
345              
346             Arguments
347             number, # Optional
348              
349             Object method.
350             Get/Set attributes from the invoking object.
351             If called with a string argument, the method tries to set the corresponding
352             attribute and returns true on success, an Err object otherwise. Returns
353             value of the corresponding attribute if defined, an Err object otherwise.
354              
355             NOTE: As 0 is also a valid argument, take care that the return value
356             is not tested for truth or falsehood. Instead, test thus:
357              
358             if (UNIVERSAL::isa ($ret, "Unix::Conf::Err"))
359              
360             =item transfer_format ()
361            
362             Arguments
363             'string', # Optional. Allowed arguments are 'one-answer',
364             # 'many-answers'
365              
366             Object method.
367             Get/Set attributes from the invoking object.
368             If called with a string argument, the method tries to set the corresponding
369             attribute and returns true on success, an Err object otherwise. Returns
370             value of the corresponding attribute if defined, an Err object otherwise.
371              
372             =item transfer_source ()
373              
374             Arguments
375             'string', # Optional. The argument must be an IP Address in the
376             # dotted quad notation
377              
378             Object method.
379             Get/Set attributes from the invoking object.
380             If called with a string argument, the method tries to set the corresponding
381             attribute and returns true on success, an Err object otherwise. Returns
382             value of the corresponding attribute if defined, an Err object otherwise.
383              
384             =item coresize ()
385              
386             =item datasize ()
387              
388             =item files ()
389              
390             =item stacksize ()
391              
392             Arguments
393             'string'|number, # Optional. The argument must be a size spec. Refer to
394             # the Bind8 manual for a definition of size_spec.
395              
396             Object method.
397             Get/Set attributes from the invoking object.
398             If called with a string argument, the method tries to set the corresponding
399             attribute and returns true on success, an Err object otherwise. Returns
400             value of the corresponding attribute if defined, an Err object otherwise.
401              
402             NOTE: As 0 is also a valid argument, take care that the return value
403             is not tested for truth or falsehood. Instead, test thus:
404              
405             if (UNIVERSAL::isa ($ret, "Unix::Conf::Err"))
406              
407             =item delete_version ()
408              
409             =item delete_directory ()
410              
411             =item delete_named_xfer ()
412              
413             =item delete_dump_file ()
414              
415             =item delete_memstatistics_file ()
416              
417             =item delete_pid_file ()
418              
419             =item delete_statistics_file ()
420              
421             =item delete_auth_nxdomain ()
422              
423             =item delete_deallocate_on_exit ()
424              
425             =item delete_dialup ()
426              
427             =item delete_fake_iquery ()
428              
429             =item delete_fetch_glue ()
430              
431             =item delete_has_old_clients ()
432              
433             =item delete_host_statistics ()
434              
435             =item delete_multiple_cnames ()
436              
437             =item delete_notify ()
438              
439             =item delete_recursion ()
440              
441             =item delete_rfc2308_type1 ()
442              
443             =item delete_use_id_pool ()
444              
445             =item delete_treat_cr_as_space ()
446              
447             =item delete_also_notify ()
448              
449             =item delete_forward ()
450              
451             =item delete_allow_query ()
452              
453             =item delete_allow_recursion ()
454              
455             =item delete_allow_transfer ()
456              
457             =item delete_blackhole ()
458              
459             =item delete_lame_ttl ()
460              
461             =item delete_max_transfer_time_in ()
462              
463             =item delete_max_ncache_ttl ()
464              
465             =item delete_min_roots ()
466              
467             =item delete_serial_queries ()
468              
469             =item delete_max_serial_queries ()
470              
471             =item delete_transfer_format ()
472              
473             =item delete_transfers_in ()
474              
475             =item delete_transfers_out ()
476              
477             =item delete_transfers_per_ns ()
478              
479             =item delete_transfer_source ()
480              
481             =item delete_maintain_ixfr_base ()
482              
483             =item delete_max_ixfr_log_size ()
484              
485             =item delete_coresize ()
486              
487             =item delete_datasize ()
488              
489             =item delete_files ()
490              
491             =item delete_stacksize ()
492              
493             =item delete_cleaning_interval ()
494              
495             =item delete_heartbeat_interval ()
496              
497             =item delete_interface_interval ()
498              
499             =item delete_statistics_interval ()
500              
501             =item delete_topology ()
502              
503             =item delete_forwarders ()
504              
505             =item delete_query_source ()
506              
507             Object method.
508             Deletes the corresponding directive if defined and returns true, or an Err
509             object otherwise.
510              
511             =cut
512              
513             {
514 10     10   113 no strict 'refs';
  10         17  
  10         87879  
515             for my $option (keys (%Supported_Options)) {
516             my $meth = $option;
517             $meth =~ tr/-/_/;
518              
519             # Options taking ACL elements/anon array as arguments
520             ($Supported_Options{$option} eq 'acl') && do {
521             *$meth = sub {
522 0     0     my $self = shift ();
523 0           my $elements;
524              
525 0 0         if (@_) {
526 0 0         if (ref ($_[0])) {
527 0 0         if (UNIVERSAL::isa ($_[0], 'Unix::Conf::Bind8::Conf::Acl')) {
    0          
528             # Acl object was passed
529 0           $self->{options}{$option} = $_[0];
530 0           $self->dirty (1);
531 0           return (1);
532             }
533             elsif (UNIVERSAL::isa ($_[0], 'ARRAY')) {
534             # array ref was passed
535 0           return (Unix::Conf->_err ("$meth", "array passed by reference empty"))
536 0 0         unless (@{$_[0]});
537 0           $elements = $_[0];
538             }
539             else {
540             return (
541 0           Unix::Conf->_err (
542             "$meth",
543             "expected arguments are a list, an Unix::Conf::Bind8::Conf::Acl object or an array ref"
544             )
545             );
546             }
547             }
548             else {
549             # assume a list of elements to be set was passed.
550 0           $elements = \@_;
551             }
552              
553 0           my $acl;
554 0 0         $acl = Unix::Conf::Bind8::Conf::Acl->new (
555             PARENT => $self->_parent (), ELEMENTS => $elements,
556             ) or return ($acl);
557 0           $self->{options}{$option} = $acl;
558 0           $self->dirty (1);
559 0           return (1);
560             }
561             return (
562 0 0         defined ($self->{options}{$option}) ?
563             $self->{options}{$option} :
564             Unix::Conf->_err ("$meth", "option not defined")
565             );
566             };
567              
568             # add_to_* counterpart for options taking ACL elements as arguments
569             *{"add_to_$meth"} = sub {
570 0     0     my $self = shift ();
571 0           my ($elements, $ret);
572              
573 0 0         return (Unix::Conf->_err ("add_to_$meth", "elements to be added not passed"))
574             unless (@_);
575              
576 0 0         if (ref ($_[0])) {
577             return (
578 0 0         Unix::Conf->_err (
579             "add_to_$meth",
580             "expected arguments are either a list of elements or an array ref")
581             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
582 0           return (Unix::Conf->_err ("add_to_$meth", "array passed by reference empty"))
583 0 0         unless (@{$_[0]});
584 0           $elements = $_[0];
585             }
586             else {
587 0           $elements = [ @_ ];
588             }
589 0 0         $self->{options}{$option} = Unix::Conf::Bind8::Conf::Acl->new (
590             PARENT => $self->_parent ()
591             ) unless (defined ($self->{options}{$option}));
592 0 0         $ret = $self->{options}{$option}->add_elements ($elements) or return ($ret);
593 0           $self->dirty (1);
594 0           return (1);
595             };
596              
597             # delete_from_* counterpart for options taking ACL elements as arguments
598             *{"delete_from_$meth"} = sub {
599 0     0     my $self = shift ();
600 0           my ($elements, $ret);
601              
602 0 0         return (Unix::Conf->_err ("delete_from_$meth", "elements to be added not passed"))
603             unless (@_);
604              
605 0 0         if (ref ($_[0])) {
606             return (
607 0 0         Unix::Conf->_err (
608             "delete_from_$meth",
609             "expected arguments are either a list of elements or an array ref")
610             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
611 0           return (Unix::Conf->_err ("delete_from_$meth", "array passed by reference empty"))
612 0 0         unless (@{$_[0]});
613 0           $elements = $_[0];
614             }
615             else {
616 0           $elements = [ @_ ];
617             }
618              
619 0 0         return (Unix::Conf::->_err ("delete_from_$meth", "option not defined"))
620             unless (defined ($self->{options}{$option}));
621 0 0         $ret = $self->{options}{$option}->delete_elements ($elements) or return ($ret);
622             # if all elements have been deleted, delete the option itself.
623 0           delete ($self->{options}{$option})
624 0 0         unless (@{$self->{options}{$option}->elements ()});
625 0           $self->dirty (1);
626 0           return (1);
627             };
628              
629             # *_elements
630             *{"${meth}_elements"} = sub {
631             return (
632 0 0   0     defined ($_[0]->{options}{$option}) ? $_[0]->{options}{$option}->elements () :
        0      
633             Unix::Conf->_err ("{$meth}_elements", "option not defined")
634             );
635             };
636             goto CREATE_DELETE;
637             };
638              
639             # These methods have the corresponding validation routines
640             ("$Supported_Options{$option}" =~ /^CODE/) && do {
641             *$meth = sub {
642 0     0     my ($self, $arg) = @_;
643            
644 0 0         if (defined ($arg)) {
645 0           return (Unix::Conf->_err ("$meth", "invalid argument `$arg'"))
646 0 0         unless (&{$Supported_Options{$option}}($arg));
647 0           $self->{options}{$option} = $arg;
648 0           $self->dirty (1);
649 0           return (1);
650             }
651             return (
652 0 0         defined ($self->{options}{$option}) ?
653             $self->{options}{$option} :
654             Unix::Conf->_err ("$meth", "option not defined")
655             );
656             };
657             };
658              
659             CREATE_DELETE:
660             if ($Supported_Options{$option}) {
661             # delete_*
662             *{"delete_$meth"} = sub {
663 0 0   0     return (Unix::Conf->_err ("delete_$meth", "option not defined"))
        0      
        0      
664             unless (defined ($_[0]->{options}{$option}));
665 0           delete ($_[0]->{options}{$option});
666 0           $_[0]->dirty (1);
667 0           return (1);
668             };
669             }
670             }
671             }
672              
673             =item delete_option ()
674              
675             Arguments
676             'string', # 'OPTION-NAME'
677              
678             Object method.
679             Deletes the corresponding directive if defined and returns true, or an Err
680             object otherwise.
681              
682             =cut
683              
684             sub delete_option
685             {
686 0     0 1   my ($self, $option) = @_;
687              
688 0 0         return (Unix::Conf->_err ('delete_option', "option not supported or invalid"))
689             unless (defined ($Supported_Options{$option}));
690 0 0         return (Unix::Conf->_err ('delete_option', "option not defined"))
691             unless (defined ($self->{options}{$option}));
692 0           delete ($self->{options}{$option});
693 0           return (1);
694             }
695              
696             =item query_source ()
697              
698             Arguments
699             PORT => port, # Optional
700             ADDRESS => address, # Optional
701             or
702             { } # with the same format as above
703              
704             Object method
705             Get/set query-source attributes. If PORT, or ADDRESS is passed tries
706             to set the attributes. Returns true on success, an Err object otherwise.
707             Else, returns value in an anonymous hash, in the same format as argument.
708              
709             =cut
710              
711             sub query_source
712             {
713 0     0 1   my $self = shift ();
714            
715 0 0         if (@_) {
716 0           my $args;
717 0 0         if (@_ == 1) {
718 0 0         return (Unix::Conf->_err ("query_source", "expected argument type either LIST or hash reference"))
719             unless (UNIVERSAL::isa ($_[0], "HASH"));
720 0           $args = { %{$_[0]} };
  0            
721             }
722             else {
723 0           $args = { @_ };
724             }
725 0 0         if ($args->{ADDRESS}) {
726 0 0 0       return (Unix::Conf->_err ('query_source', "illegal IP address `$args->{ADDRESS}'"))
727             unless (__valid_ipaddress ($args->{ADDRESS}) || $args->{ADDRESS} eq '*');
728             }
729 0 0         if ($args->{PORT}) {
730 0 0 0       return (Unix::Conf->_err ('query_source', "illegal port `$args->{PORT}'"))
731             unless (__valid_port ($args->{PORT}) || $args->{PORT} eq '*');
732             }
733 0           $self->{options}{'query-source'} = $args;
734 0           $self->dirty (1);
735 0           return (1);
736             }
737             return (
738 0 0         defined ($self->{options}{'query-source'}) ? { %{$self->{options}{'query-source'}} } :
  0            
739             Unix::Conf->_err ('query_source', "option not defined")
740             );
741             }
742              
743             =item check_names ()
744              
745             Arguments
746             type => value,
747             type => value,
748             or
749             { } # with the same format as above
750              
751             Object method.
752             Get/set the 'check-names' attribute from the invoking object. If a
753             list is passed as argument, it is interpreted as a hash and sets
754             the check-names attribute. Returns true on success, an Err object
755             otherwise. If only a single scalar is passed, it is interpreted as
756             a type whose value is to be returned. If no arguments are passed,
757             the value of the option is returned as an anonymous hash of the
758             following form.
759              
760             { master => 'fail', slave => 'warn', .. }
761              
762             An Err object is returned in case of error.
763              
764             =cut
765              
766             sub check_names
767             {
768 0     0 1   my $self = shift ();
769 0           my $check_names;
770              
771 0 0 0       if (@_ > 1) {
    0          
772 0           $check_names = { @_ };
773             }
774             elsif (@_ == 1 && UNIVERSAL::isa ($_[0], 'HASH')) {
775 0           $check_names = $_[0];
776             }
777              
778 0 0         if ($check_names) {
779 0           for my $type (keys (%$check_names)) {
780 0 0         return (Unix::Conf->_err ('check_names', "illegal argument `$type'"))
781             if ($type !~ /^(master|slave|response)$/i);
782 0 0         return (Unix::Conf->_err ('check_names', "illegal argument `$check_names->{$type}'"))
783             unless (__valid_checknames ($check_names->{$type}));
784             }
785             # reinit
786 0           $self->{options}{'check-names'} = undef;
787 0           $self->{options}{'check-names'}{lc ($_)} = $check_names->{$_} for (keys (%$check_names));
788 0           $self->dirty (1);
789 0           return (1);
790             }
791            
792 0 0         return (Unix::Conf->_err ('check_names', "option not defined"))
793             unless ($self->{options}{'check-names'});
794 0 0         if (@_ == 1) {
795 0           my $value;
796 0 0         return (Unix::Conf->_err ('check_names', "option `check-names' not defined for type `$_[0]'"))
797             unless (defined ($value = $self->{options}{'check-names'}{lc ($_[0])}));
798 0           return ($value);
799             }
800 0           return ({ %{$self->{options}{'check-names'}} });
  0            
801             }
802              
803             =item add_to_check_names ()
804              
805             Arguments
806             type => value,
807             type => value,
808             ..
809              
810             Object method.
811             Adds the argument to 'check-names' attribute. If a certain 'check-names'
812             type is already defined, returns an Err object. Returns true on success,
813             an Err object otherwise.
814              
815             =cut
816              
817             sub add_to_check_names
818             {
819 0     0 1   my $self = shift ();
820              
821 0 0         return (Unix::Conf->_err ("add_to_check_names", "argument expected, got none"))
822             unless (@_ > 1);
823              
824 0           my %check_names = (@_);
825             # do not depend on -> autovivification.
826 0 0         $self->{options}{'check-names'} = {} unless ($self->{options}{'check-names'});
827 0           for my $type (keys (%check_names)) {
828 0 0         return (Unix::Conf->_err ('add_to_check_names', "illegal argument `$type'"))
829             if ($type !~ /^(master|slave|response)$/i);
830 0 0         return (Unix::Conf->_err ('add_to_check_names', "`$type' already defined"))
831             if ($self->{options}{'check-names'}{$type});
832 0 0         return (Unix::Conf->_err ('add_to_check_names', "illegal argument `$check_names{$type}'"))
833             unless (__valid_checknames ($check_names{$type}));
834             }
835 0           $self->{options}{'check-names'}{lc($_)} = $check_names{$_} for (keys (%check_names));
836 0           $self->dirty (1);
837 0           return (1);
838             }
839              
840             =item delete_from_check_names ()
841              
842             Arguments
843             LIST # of check-names types.
844              
845             Object method.
846             Deletes 'check-names' types passed as argument, if defined and returns true
847             on success, an Err object otherwise.
848              
849             =cut
850              
851             sub delete_from_check_names
852             {
853 0     0 1   my $self = shift ();
854              
855 0 0         return (Unix::Conf->_err ("add_to_check_names", "argument expected, got none"))
856             unless (@_);
857              
858 0           for my $type (@_) {
859 0 0         return (Unix::Conf->_err ('delete_from_check_names', "illegal argument `$type'"))
860             if ($type !~ /^(master|slave|response)$/i);
861 0 0         return (Unix::Conf->_err ('delete_from_check_names', "`$type' not defined"))
862             unless ($self->{options}{'check-names'}{lc ($type)});
863             }
864             # use delete instead of assigning undef. this is because we copy and return
865             # the hash to the user. with undef, the key will be defined, only the value will
866             # be undef.
867 0           delete ($self->{options}{'check-names'}{lc ($_)}) for (@_);
868             # delete option if no keys left.
869 0           delete ($self->{options}{'check-names'})
870 0 0         unless (keys (%{$self->{options}{'check-names'}}));
871 0           $self->dirty (1);
872 0           return (1);
873             }
874              
875             =item delete_check_names ()
876              
877             Arguments
878             LIST # type => 'master'|'slave'|'response'
879              
880             Object method.
881             Deletes check-names attribute if no argument is passed, else
882             deletes only the specified type. Returns true on success, an
883             Err object otherwise.
884              
885             =cut
886              
887             sub delete_check_names
888             {
889 0     0 1   my $self = shift ();
890              
891 0 0         return (Unix::Conf->_err ('delete_check_names', "option `check-names' not defined"))
892             unless (defined ($self->{options}{'check-names'}));
893              
894 0 0         if (@_) {
895 0           for my $type (@_) {
896 0 0         return (Unix::Conf->_err ('delete_check_names', "illegal argument `$type'"))
897             if ($type !~ /^(master|slave|response)$/i);
898 0 0         return (Unix::Conf->_err ('delete_check_names', "check-names `$type' not defined"))
899             unless ($self->{options}{'check-names'}{uc ($type)});
900             }
901 0           delete ($self->{options}{'check-names'}{lc ($_)}) for (@_);
902             }
903             else {
904 0           delete ($self->{options}{'check-names'});
905             }
906              
907 0           $self->dirty (1);
908 0           return (1);
909             }
910              
911             =item forwarders ()
912              
913             Arguments
914             LIST # List of IPv4 addresses in
915             or # dotted quad notation.
916             [ LIST ]
917              
918             Object method.
919             Get/set the 'forwarders' attribute in the invoking object. If argument(s)
920             is/are passed, the method tries to set the 'forwarders' attribute and returns
921             true on success, an Err object otherwise. If no arguments are passed then
922             the method tries to return an array ref if the 'forwarders' attribute is
923             defined, an Err object otherwise.
924              
925             =cut
926              
927             sub forwarders
928             {
929 0     0 1   my $self = shift ();
930 0           my $elements;
931            
932 0 0         if (@_) {
933 0 0         if (ref ($_[0])) {
934 0 0         return (Unix::Conf->_err ('forwarders', "expected arguments are a list or an array reference"))
935             unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
936             # allow empty forwarders statement.
937 0           $elements = $_[0];
938             }
939             else {
940             # assume a list of elements
941 0           $elements = \@_;
942             }
943 0           for (@$elements) {
944 0 0         return (Unix::Conf->_err ('forwarders', "illegal IPv4 address $_"))
945             unless (__valid_ipaddress ($_));
946             }
947             # reinit
948 0           $self->{options}{forwarders} = undef;
949 0           @{$self->{options}{forwarders}}{@$elements} = (1) x @$elements;
  0            
950 0           $self->dirty (1);
951 0           return (1);
952             }
953             return (
954 0 0         defined ($self->{options}{forwarders}) ? [ keys (%{$self->{options}{forwarders}}) ] :
  0            
955             Unix::Conf->_err ('forwarders', "option not defined")
956             );
957             }
958              
959             =item add_to_forwarders ()
960              
961             Arguments
962             LIST # List of IPv4 addresses in
963             or # dotted quad notation.
964             [ LIST ]
965              
966             Object method.
967             Add the elements of the list to the 'forwarders' attribute. Return
968             true on success, an Err object otherwise.
969              
970             =cut
971              
972             sub add_to_forwarders
973             {
974 0     0 1   my $self = shift ();
975 0           my $elements;
976              
977            
978 0 0         return (Unix::Conf->_err ('add_to_forwarders', "elements to be added not passed"))
979             unless (@_);
980              
981 0 0         if (ref ($_[0])) {
982             return (
983 0 0         Unix::Conf->_err (
984             'add_to_forwarders',
985             "expected arguments are a list or an array reference"
986             )
987             ) unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
988             # allow empty forwarders statement.
989 0           $elements = $_[0];
990             }
991             else {
992             # assume a list of elements
993 0           $elements = \@_;
994             }
995            
996 0           for (@$elements) {
997 0 0         return (Unix::Conf->_err ('add_to_forwarders', "illegal IPv4 address $_"))
998             unless (__valid_ipaddress ($_));
999             return (
1000 0 0         Unix::Conf->_err ( 'add_to_forwarders', "address `$_' already defined" )
1001             ) if ($self->{options}{forwarders}{$_});
1002             }
1003 0           @{$self->{options}{forwarders}}{@$elements} = (1) x @$elements;
  0            
1004 0           $self->dirty (1);
1005 0           return (1);
1006             }
1007              
1008             =item delete_from_forwarders ()
1009              
1010             Arguments
1011             LIST # List of IPv4 addresses in
1012             or # dotted quad notation.
1013             [ LIST ]
1014              
1015             Object method.
1016             Delete elements of the list from the 'forwarders' attribute. Return
1017             true on success, an Err object otherwise.
1018              
1019             =cut
1020              
1021             sub delete_from_forwarders
1022             {
1023 0     0 1   my $self = shift ();
1024 0           my $elements;
1025              
1026 0 0         return (Unix::Conf->_err ('delete_from_forwarders', "elements to be deleted not passed"))
1027             unless (@_);
1028              
1029 0 0         if (ref ($_[0])) {
1030 0 0         return (Unix::Conf->_err ('add_to_forwarders', "expected arguments are a list or an array reference"))
1031             unless (UNIVERSAL::isa ($_[0], 'ARRAY'));
1032             # allow empty forwarders statement.
1033 0           $elements = $_[0];
1034             }
1035             else {
1036             # assume a list of elements
1037 0           $elements = \@_;
1038             }
1039            
1040 0           for (@$elements) {
1041 0 0         return (Unix::Conf->_err ('delete_from_forwarders', "illegal IPv4 address $_"))
1042             unless (__valid_ipaddress ($_));
1043             return (
1044 0 0         Unix::Conf->_err ( 'delete_from_forwarders', "address `$_' not defined" )
1045             ) unless ($self->{options}{forwarders}{$_});
1046             }
1047 0           delete (@{$self->{options}{forwarders}}{@$elements});
  0            
1048             # if no keys left, delete the forwarders options itself
1049 0           delete ($self->{options}{forwarders})
1050 0 0         unless (keys (%{$self->{options}{forwarders}}));
1051 0           $self->dirty (1);
1052 0           return (1);
1053             }
1054              
1055             =item listen_on ()
1056              
1057             Arguments
1058             port => [ qw (element1 element2 ..) ],
1059              
1060             OR
1061              
1062             port => Acl object,
1063             port => ...,
1064              
1065             OR
1066             {} # with the same format
1067              
1068             Object method.
1069             `port' can be '' (empty string) to indicate the default port 53.
1070             Sets the values for `port's defined in the argument as the values
1071             for the `listen-on' attribute. Returns true on success, an Err object
1072             otherwise.
1073              
1074             =cut
1075              
1076             # The address data is stored in an Acl object, which itself is stored in a hash
1077             # keyed in port. The default port (when it is not specified) is DEFAULT.
1078             # this option does not need the add_to_listen_on method, because every time
1079             # listen-on is called it adds to the previous data, instead of replacing the old
1080             # data.
1081             sub listen_on
1082             {
1083 0     0 1   my $self = shift ();
1084 0           my $args;
1085              
1086             # no arguments passed.
1087 0 0         return ($self->get_listen_on_elements ())
1088             unless (@_);
1089            
1090 0 0         if (@_ == 1) {
1091 0 0         return (Unix::Conf->_err ("listen_on", "expected argument either a LIST or a hash reference"))
1092             unless (UNIVERSAL::isa ($_[0], "HASH"));
1093 0           $args = { %{$_[0]} };
  0            
1094             }
1095             else {
1096 0           $args = { @_ };
1097             }
1098              
1099             # validate first
1100 0           for my $port (keys (%$args)) {
1101 0 0 0       return (Unix::Conf->_err ('listen_on', "illegal PORT `$port'"))
1102             if ($port && !__valid_port ($port));
1103             return (
1104 0 0 0       Unix::Conf->_err ('listen_on', "value type for port `$port' neither array ref nor Acl object")
1105             ) unless (
1106             UNIVERSAL::isa ($args->{$port}, "Unix::Conf::Bind8::Conf::Acl") ||
1107             UNIVERSAL::isa ($args->{$port}, "ARRAY")
1108             );
1109             }
1110              
1111 0           $self->{options}{'listen-on'} = undef;
1112 0           for my $port (keys (%$args)) {
1113 0 0 0       my $_port = $port && $port == 53 ? '' : $port;
1114 0 0         if (UNIVERSAL::isa ($args->{$port}, "Unix::Conf::Bind8::Conf::Acl")) {
1115 0 0         $args->{$port}->_parent ($self->_parent ())
1116             unless ($args->{$port}->_parent ());
1117             }
1118             else {
1119 0 0         $args->{$port} = Unix::Conf::Bind8::Conf::Acl->new (
1120             PARENT => $self->_parent (), ELEMENTS => $args->{$port}
1121             ) or return ($args->{$port});
1122             }
1123 0           $self->{options}{'listen-on'}{$_port} = $args->{$port};
1124             }
1125              
1126 0           $self->dirty (1);
1127 0           return (1);
1128             }
1129              
1130             =item add_to_listen_on ()
1131              
1132             Arguments
1133             port => [ qw (element1 element2 ..) ],
1134             port => ...,
1135              
1136             Object method.
1137             `port' can be '' (empty string) to indicate the default port 53.
1138              
1139             Adds the value of `port's defined in the argument, to the ones
1140             defined in the listen-on attribute. Returns true on success,
1141             an Err object otherwise.
1142              
1143             =cut
1144              
1145             sub add_to_listen_on ()
1146             {
1147 0     0 1   my $self = shift ();
1148 0           my (%args, $ret);
1149              
1150 0 0         return (Unix::Conf->_err ("add_to_listen_on", "arguments expected, got none"))
1151             unless (@_);
1152              
1153 0           %args = ( @_ );
1154              
1155             # validate first
1156 0           for my $port (keys (%args)) {
1157             # the length test is to ensure that if a '' is specified, $port won't
1158             # be tested against a number, as it will turn into 0
1159 0 0 0       return (Unix::Conf->_err ('add_to_listen_on', "illegal PORT `$port'"))
1160             if ($port && !__valid_port ($port));
1161             return (
1162 0 0         Unix::Conf->_err ('add_to_listen_on', "value type for port `$port' not array ref")
1163             ) unless (UNIVERSAL::isa ($args{$port}, "ARRAY"));
1164             }
1165              
1166 0           for my $port (keys (%args)) {
1167 0 0 0       my $_port = $port && $port == 53 ? '' : $port;
1168             # if no elements defined as of yet for this port, create a new Acl object
1169             # to hold it.
1170 0 0         unless ($self->{options}{'listen-on'}{$_port}) {
1171 0           my $acl;
1172             # specify the reverse pointer.
1173 0 0         $acl = Unix::Conf::Bind8::Conf::Acl->new (PARENT => $self->_parent ()) or return ($acl);
1174 0           $self->{options}{'listen-on'}{$_port} = $acl;
1175             }
1176 0 0         $ret = $self->{options}{'listen-on'}{$_port}->add_elements ($args{$port})
1177             or return ($ret);
1178             }
1179              
1180 0           $self->dirty (1);
1181 0           return (1);
1182             }
1183              
1184             =item get_listen_on ()
1185              
1186             Arguments
1187             port # Optional.
1188              
1189             Object method.
1190             `port' can be '' (empty string) to indicate the default port 53.
1191             If `port' is specified, addresses defined for that port are returned
1192             as an Acl object. Else all listen-on statements are returned
1193             as an anonymous hash with keys as the defined portnos ('' for the
1194             default port) and values as Acl objects defined for that port.
1195             An Err object is returned if the listen-on option has not yet
1196             been defined.
1197              
1198             NOTE:
1199              
1200             Do not manipulate the returned Acl objects directly. If you
1201             do so, set the dirty flag for the Options object.
1202              
1203             =cut
1204              
1205             sub get_listen_on
1206             {
1207 0     0 1   my ($self, $port) = @_;
1208 0           my $_port;
1209              
1210 0 0         return (Unix::Conf->_err ('get_listen_on', "option not defined"))
1211             unless ($self->{options}{'listen-on'});
1212              
1213 0 0         if (defined ($port)) {
1214 0 0 0       return (Unix::Conf->_err ('get_listen_on', "illegal PORT `$port'"))
1215             if ($port && !__valid_port ($port));
1216              
1217 0 0 0       $_port = ($port && $port == 53) ? '' : $port;
1218              
1219             # return Acl object for $port
1220 0 0         return (Unix::Conf->_err ('get_listen_on', "no elements defined for port `$port'"))
1221             unless ($self->{options}{'listen-on'}{$_port});
1222 0           return ($self->{options}{'listen-on'}{$_port});
1223             }
1224              
1225             # return { port => Acl } for all ports
1226 0           my $ret = {};
1227 0           my @keys = keys (%{$self->{options}{'listen-on'}});
  0            
1228             # don't know if this can occur. sanity.
1229 0 0         return (Unix::Conf->_err ('get_listen_on', "no listen-on statements left"))
1230             unless (@keys);
1231 0           $ret->{$_} = $self->{options}{'listen-on'}{$_} for (@keys);
1232 0           return ($ret);
1233             }
1234              
1235             =item get_listen_on_elements ()
1236              
1237             Arguments
1238             port # Optional.
1239              
1240             Object method.
1241             `port' can be '' (empty string) to indicate the default port 53.
1242             If `port' is specified, addresses defined for that port are returned
1243             as an anonymous array. Else all listen-on statements are returned
1244             as an anonymous hash with keys as the defined portnos ('' for the
1245             default port) and values as anonymous array with addresses defined
1246             for that port. An Err object is returned if the listen-on option
1247             has not yet been defined.
1248              
1249             =cut
1250              
1251             sub get_listen_on_elements
1252             {
1253 0     0 1   my ($self, $port) = @_;
1254 0           my $_port;
1255              
1256 0 0         return (Unix::Conf->_err ('get_listen_on_elements', "option not defined"))
1257             unless ($self->{options}{'listen-on'});
1258              
1259 0 0         if (defined ($port)) {
1260 0 0 0       return (Unix::Conf->_err ('get_listen_on', "illegal PORT `$port'"))
1261             if ($port && !__valid_port ($port));
1262              
1263 0 0 0       $_port = ($port && $port == 53) ? '' : $port;
1264              
1265             # return Acl object for $port
1266 0 0         return (Unix::Conf->_err ('get_listen_on_elements', "no elements defined for port `$port'"))
1267             unless ($self->{options}{'listen-on'}{$_port});
1268 0           return ($self->{options}{'listen-on'}{$_port}->elements ());
1269             }
1270              
1271             # return { port => Acl } for all ports
1272 0           my $ret = {};
1273 0           my @keys = keys (%{$self->{options}{'listen-on'}});
  0            
1274             # don't know if this can occur. sanity.
1275 0 0         return (Unix::Conf->_err ('get_listen_on_elements', "no listen-on statements left"))
1276             unless (@keys);
1277 0           $ret->{$_} = $self->{options}{'listen-on'}{$_}->elements () for (@keys);
1278 0           return ($ret);
1279             }
1280              
1281             =item delete_from_listen_on ()
1282              
1283             Arguments
1284             port => [ qw (element1 element2 ..) ],
1285             port => ...,
1286              
1287             Object method.
1288             `port' can be '' (empty string) to indicate the default port 53.
1289             Deletes the value of `port's defined in the argument from the
1290             ones defined in the `listen-on' attribute and returns true on
1291             success, an Err object otherwise.
1292              
1293             =cut
1294              
1295             sub delete_from_listen_on
1296             {
1297 0     0 1   my $self = shift ();
1298 0           my %args;
1299              
1300 0 0         return (Unix::Conf->_err ("delete_from_listen_on", "arguments expected, got none"))
1301             unless (@_);
1302              
1303 0           %args = ( @_ );
1304              
1305             # validate first
1306 0           for my $port (keys (%args)) {
1307 0 0         my $_port = $port == 53 ? '' : $port;
1308             # the length test is to ensure that if a '' is specified, $port won't
1309             # be tested against a number, as it will turn into 0
1310 0 0 0       return (Unix::Conf->_err ('delete_from_listen_on', "illegal PORT `$port'"))
1311             if ($port && !__valid_port ($port));
1312             return (
1313 0 0         Unix::Conf->_err ('delete_from_listen_on', "value type for port `$port' not array ref")
1314             ) unless (UNIVERSAL::isa ($args{$port}, "ARRAY"));
1315 0 0         return (Unix::Conf->_err ('delete_from_listen_on', "listen-on not defined for port `$port'"))
1316             unless ($self->{options}{'listen-on'}{$_port});
1317             }
1318              
1319 0           for my $port (keys (%args)) {
1320 0 0         my $_port = $port == 53 ? '' : $port;
1321 0           my $ret;
1322 0 0         $ret = $self->{options}{'listen-on'}{$_port}->delete_elements ($args{$port})
1323             or return ($ret);
1324             # delete the port if no elements left remaining for that port.
1325 0           delete ($self->{options}{'listen-on'}{$_port})
1326 0 0         unless (@{$self->{options}{'listen-on'}{$_port}->elements ()});
1327             }
1328             # delete the option itself, if no ports left.
1329 0 0         delete ($self->{options}{'listen-on'}) unless (keys (%{$self->{options}{'listen-on'}}));
  0            
1330              
1331 0           $self->dirty (1);
1332 0           return (1);
1333             }
1334              
1335             =item delete_listen_on ()
1336              
1337             Arguments
1338             LIST # of ports.
1339              
1340             Object method.
1341             port can be '' (empty string) to indicate the default port 53.
1342             If an argument(s) are passed, these ports deleted from the internal
1343             representation. Else all listen-on statements are deleted. Returns
1344             true on success, an Err object otherwise.
1345              
1346             =cut
1347              
1348             sub delete_listen_on
1349             {
1350 0     0 1   my $self = shift ();
1351 0           my $_port;
1352              
1353 0 0         return (Unix::Conf->_err ('delete_listen_on', "option not defined"))
1354             unless ($self->{options}{'listen-on'});
1355              
1356 0 0         if (@_) {
1357 0           for my $port (@_) {
1358 0 0 0       return (Unix::Conf->_err ('delete_listen_on', "illegal PORT `$port'"))
1359             if ($port && !__valid_port ($port));
1360 0 0 0       $_port = ($port && $port == 53) ? '' : $port;
1361              
1362             # return elements defined for PORT
1363 0 0         return (Unix::Conf->_err ('delete_listen_on', "no elements defined for port `$port'"))
1364             unless ($self->{options}{'listen-on'}{$_port});
1365 0           delete ($self->{options}{'listen-on'}{$_port});
1366              
1367             }
1368              
1369             # check to see if any port is left. if all defined ones have been deleted
1370             # fall below and delete the whole statement
1371 0 0         if (keys (%{$self->{options}{'listen-on'}})) {
  0            
1372 0           $self->dirty (1);
1373 0           return (1)
1374             }
1375             }
1376              
1377             # delete the whole statement
1378 0           delete ($self->{options}{'listen-on'});
1379 0           $self->dirty (1);
1380 0           return (1);
1381             }
1382              
1383             =item rrset_order ()
1384              
1385             Arguments
1386             NAME => name, # Optional ('*'|'.*')
1387             CLASS => class, # Optional ('ANY'|'IN')
1388             TYPE => type, # Optional ('ANY'|'A'|'NS'|'MX')
1389             ORDER => order, # ('fixed'|'randon'|'cyclic')
1390              
1391             or a list of hash references, where the hashes have the same
1392             structure as above.
1393             or a array reference populated with hash references with the
1394             same structure as above.
1395              
1396             Object method.
1397             Sets the rrset-order option. CLASS, TYPE, NAME can be optional, in which case they
1398             are assumed to be, 'ANY', 'ANY', and '*'. Returns true on success, an Err object
1399             otherwise.
1400              
1401             =cut
1402              
1403             sub rrset_order
1404             {
1405 0     0 1   my $self = shift ();
1406 0           my ($args, $_port);
1407              
1408 0 0         return ($self->get_rrset_order ())
1409             unless (@_);
1410              
1411 0 0         if (ref ($_[0])) {
1412 0 0         if (UNIVERSAL::isa ($_[0], 'HASH')) {
    0          
1413             # assume that a list of hashrefs have been passed
1414 0           $args = \@_;
1415             }
1416             elsif (UNIVERSAL::isa ($_[0], 'ARRAY')) {
1417 0           $args = $_[0];
1418             }
1419             else {
1420 0           return (Unix::Conf->_err ('rrset_order', "Argument must either be a list or a list of hash references"))
1421             }
1422             }
1423             else {
1424             # assume arguments specified as a list directly as PORT => ..
1425 0           $args = [ { @_ } ];
1426             }
1427            
1428 0           for my $itr (@$args) {
1429 0 0         $itr->{CLASS} = 'ANY' unless ($itr->{CLASS});
1430 0 0         $itr->{TYPE} = 'ANY' unless ($itr->{TYPE});
1431 0 0         $itr->{NAME} = '*' unless ($itr->{NAME});
1432 0 0         return (Unix::Conf->_err ('rrset_order', "illegal CLASS `$itr->{CLASS}'"))
1433             unless ($itr->{CLASS} =~ /^(ANY|IN)$/);
1434 0 0         return (Unix::Conf->_err ('rrset_order', "illegal TYPE `$itr->{TYPE}'"))
1435             unless ($itr->{TYPE} =~ /^(ANY|A|NS|MX)$/);
1436             # strip quotes if any
1437 0           $itr->{NAME} =~ s/^"(.+)"$/$1/;
1438 0 0         return (Unix::Conf->_err ('rrset_order', "ORDER not defined"))
1439             unless ($itr->{ORDER});
1440 0 0         return (Unix::Conf->_err ('rrset_order', "illegal value for ORDER `$itr->{ORDER}'"))
1441             unless ($itr->{ORDER} =~ /^(fixed|random|cyclic)$/);
1442             }
1443              
1444             # reinit
1445 0           $self->{options}{'rrset-order'} = undef;
1446 0           for my $itr (@$args) {
1447 0           $self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}}{$itr->{TYPE}} = $itr->{ORDER};
1448             }
1449              
1450 0           $self->dirty (1);
1451 0           return (1);
1452             }
1453              
1454             =item get_rrset_order ()
1455              
1456             Arguments
1457             name, # Optional
1458             class, # Optional
1459             type # Optional
1460              
1461             Object method.
1462             The following diagram should make clear the type of return to expect.
1463             If all 3 arguments are passed, the return is the order defined for the
1464             arguments as a scalar, if defined, an Err object otherwise.
1465             If type is not passed, the return value is an anonymous hash
1466              
1467             {
1468             'TYPE1' => 'order',
1469             'TYPE2' => 'order',
1470             ..
1471             }
1472              
1473             for the passed name and class, if defined, an Err object otherwise.
1474             If class is not passed, the return value is an anonymous hash
1475              
1476             {
1477             'CLASS1' => {
1478             'TYPE1 => 'order',
1479             'TYPE2' => 'order',
1480             ..
1481             },
1482             'CLASS2' => {
1483             'TYPE1 => 'order',
1484             'TYPE2' => 'order',
1485             ..
1486             },
1487             ...
1488             }
1489              
1490             for the passed name, if defined, an Err object otherwise.
1491             If even the name is not passed, the return value is an anonymous hash
1492              
1493             {
1494             'NAME1' => {
1495             'CLASS1' => {
1496             'TYPE1 => 'order',
1497             'TYPE2' => 'order',
1498             ..
1499             },
1500             'CLASS2' => {
1501             'TYPE1 => 'order',
1502             'TYPE2' => 'order',
1503             ..
1504             },
1505             ...
1506             },
1507             'NAME2' => {
1508             'CLASS1' => {
1509             'TYPE1 => 'order',
1510             'TYPE2' => 'order',
1511             ..
1512             },
1513             'CLASS2' => {
1514             'TYPE1 => 'order',
1515             'TYPE2' => 'order',
1516             ..
1517             },
1518             ...
1519             },
1520             ...
1521             }
1522              
1523             for all defined names, if any is defined, an Err object otherwise.
1524              
1525             =cut
1526              
1527             sub get_rrset_order
1528             {
1529 0     0 1   my ($self, $name, $class, $type) = @_;
1530 0           my $ret;
1531              
1532 0 0         return (Unix::Conf->_err ('get_rrset_order', "option not defined"))
1533             unless ($self->{options}{'rrset-order'});
1534              
1535 0 0 0       $class = 'ANY' if (defined ($class) && !$class);
1536 0 0 0       $type = 'ANY' if (defined ($type) && !$type);
1537 0 0 0       $name = '*' if (defined ($name) && !$name);
1538              
1539 0 0 0       return (Unix::Conf->_err ('get_rrset_order', "illegal CLASS `$class'"))
1540             if (defined ($class) && $class !~ /^(ANY|IN)$/);
1541 0 0 0       return (Unix::Conf->_err ('get_rrset_order', "illegal TYPE `$type'"))
1542             if (defined ($type) && $type !~ /^(ANY|A|NS|MX)$/);
1543              
1544 0 0         if (defined ($name)) {
1545             # strip quotes if any
1546 0           $name =~ s/^"(.+)"$/$1/;
1547 0 0         return (Unix::Conf->_err ('get_rrset_order', "$name not defined"))
1548             unless ($self->{options}{'rrset-order'}{$name});
1549              
1550 0 0         if (defined ($class)) {
1551 0 0         return (Unix::Conf->_err ('get_rrset_order', "$class not defined for $name"))
1552             unless ($self->{options}{'rrset-order'}{$name}{$class});
1553              
1554 0 0         if (defined ($type)) {
1555 0 0         return (Unix::Conf->_err ('get_rrset_order', "$type not defined for $name, $class"))
1556             unless ($self->{options}{'rrset-order'}{$name}{$class}{$type});
1557              
1558 0           $ret = $self->{options}{'rrset-order'}{$name}{$class}{$type};
1559             }
1560             else {
1561 0           for my $type (keys (%{$self->{options}{'rrset-order'}{$name}{$class}})) {
  0            
1562 0           $ret->{$type} = $self->{options}{'rrset-order'}{$name}{$class}{$type};
1563             }
1564             }
1565             }
1566             else {
1567 0           for my $class (keys (%{$self->{options}{'rrset-order'}{$name}})) {
  0            
1568 0           for my $type (keys (%{$self->{options}{'rrset-order'}{$name}{$class}})) {
  0            
1569 0           $ret->{$class}{$type} = $self->{options}{'rrset-order'}{$name}{$class}{$type};
1570             }
1571             }
1572             }
1573             }
1574             else {
1575 0           for my $name (keys (%{$self->{options}{'rrset-order'}})) {
  0            
1576 0           for my $class (keys (%{$self->{options}{'rrset-order'}{$name}})) {
  0            
1577 0           for my $type (keys (%{$self->{options}{'rrset-order'}{$name}{$class}})) {
  0            
1578 0           $ret->{$name}{$class}{$type} = $self->{options}{'rrset-order'}{$name}{$class}{$type};
1579             }
1580             }
1581             }
1582             }
1583 0           return ($ret);
1584             }
1585              
1586             =item add_to_rrset_order ()
1587              
1588             Arguments
1589             NAME => name, # Optional ('*'|'.*')
1590             CLASS => class, # Optional ('ANY'|'IN')
1591             TYPE => type, # Optional ('ANY'|'A'|'NS'|'MX')
1592             ORDER => order, # ('fixed'|'randon'|'cyclic')
1593              
1594             or a list of hash references, where the hashes have the same
1595             structure as above.
1596              
1597             Object method.
1598             Adds to any defined rrset-order option. CLASS, TYPE, NAME can be optional, in which
1599             case they are assumed to be, 'ANY', 'ANY', and '*'. Returns true on success, an Err object
1600             otherwise.
1601              
1602             =cut
1603              
1604             sub add_to_rrset_order
1605             {
1606 0     0 1   my $self = shift ();
1607 0           my ($args, $_port);
1608              
1609 0 0         if (ref ($_[0])) {
1610 0 0         if (UNIVERSAL::isa ($_[0], 'HASH')) {
1611             # assume that a list of hashrefs have been passed
1612 0           $args = \@_;
1613             }
1614             else {
1615 0           return (Unix::Conf->_err ('add_to_rrset_order', "Argument must either be a list or a list of hash references"))
1616             }
1617             }
1618             else {
1619             # assume arguments specified as a list directly as PORT => ..
1620 0           $args = [ { @_ } ];
1621             }
1622            
1623 0           for my $itr (@$args) {
1624 0 0         $itr->{CLASS} = 'ANY' unless ($itr->{CLASS});
1625 0 0         $itr->{TYPE} = 'ANY' unless ($itr->{TYPE});
1626 0 0         $itr->{NAME} = '*' unless ($itr->{NAME});
1627 0 0         return (Unix::Conf->_err ('add_to_rrset_order', "illegal value of CLASS `$itr->{CLASS}'"))
1628             unless ($itr->{CLASS} =~ /^(ANY|IN)$/);
1629 0 0         return (Unix::Conf->_err ('add_to_rrset_order', "illegal value of TYPE `$itr->{TYPE}'"))
1630             unless ($itr->{TYPE} =~ /^(ANY|A|NS|MX)$/);
1631             # strip quotes if any
1632 0           $itr->{NAME} =~ s/^"(.+)"$/$1/;
1633 0 0         return (Unix::Conf->_err ('add_to_rrset_order', "ORDER not defined"))
1634             unless ($itr->{ORDER});
1635 0 0         return (Unix::Conf->_err ('add_to_rrset_order', "illegal value for ORDER `$itr->{ORDER}'"))
1636             unless ($itr->{ORDER} =~ /^(fixed|random|cyclic)$/);
1637 0 0         return (Unix::Conf->_err ('add_to_rrset_order', "order already defined for $itr->{NAME}, $itr->{CLASS}, $itr->{TYPE}"))
1638             if ($self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}}{$itr->{TYPE}});
1639             }
1640              
1641 0           for my $itr (@$args) {
1642 0           $self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}}{$itr->{TYPE}} = $itr->{ORDER};
1643             }
1644              
1645 0           $self->dirty (1);
1646 0           return (1);
1647             }
1648              
1649             =item delete_from_rrset_order ()
1650              
1651             Arguments
1652             NAME => name, # Optional ('*'|'.*')
1653             CLASS => class, # Optional ('ANY'|'IN')
1654             TYPE => type, # Optional ('ANY'|'A'|'NS'|'MX')
1655              
1656             or a list of hash references, where the hashes have the same
1657             structure as above.
1658              
1659             Object method.
1660             Deletes from any defined rrset-order option. CLASS, TYPE, NAME can be optional, in which
1661             case they are assumed to be, 'ANY', 'ANY', and '*'. Returns true on success, an Err object
1662             otherwise.
1663             Note that the method, deletes branches that have become leaves because of deletions.
1664             For example, if for NAME, CLASS the only TYPE defined is deleted, CLASS
1665             gets deleted. If NAME has no other records, NAME gets deleted too. If NAME is the only
1666             rrset-order defined, the option gets deleted.
1667              
1668             =cut
1669              
1670             sub delete_from_rrset_order
1671             {
1672 0     0 1   my $self = shift ();
1673 0           my ($args, $_port);
1674              
1675 0 0         if (ref ($_[0])) {
1676 0 0         if (UNIVERSAL::isa ($_[0], 'HASH')) {
1677             # assume that a list of hashrefs have been passed
1678 0           $args = \@_;
1679             }
1680             else {
1681 0           return (Unix::Conf->_err ('delete_from_rrset_order', "Argument must either be a list or a list of hash references"))
1682             }
1683             }
1684             else {
1685             # assume arguments specified as a list directly as PORT => ..
1686 0           $args = [ { @_ } ];
1687             }
1688            
1689 0           for my $itr (@$args) {
1690 0 0         $itr->{CLASS} = 'ANY' unless ($itr->{CLASS});
1691 0 0         $itr->{TYPE} = 'ANY' unless ($itr->{TYPE});
1692 0 0         $itr->{NAME} = '*' unless ($itr->{NAME});
1693 0 0         return (Unix::Conf->_err ('delete_from_rrset_order', "illegal value of CLASS `$itr->{CLASS}'"))
1694             unless ($itr->{CLASS} =~ /^(ANY|IN)$/);
1695 0 0         return (Unix::Conf->_err ('delete_from_rrset_order', "illegal value of TYPE `$itr->{TYPE}'"))
1696             unless ($itr->{TYPE} =~ /^(ANY|A|NS|MX)$/);
1697             # strip quotes if any
1698 0           $itr->{NAME} =~ s/^"(.+)"$/$1/;
1699             # test every step, as it can create unwanted keys through autovivification.
1700             # keys thus created will be deleted down below, but still
1701 0 0         return (Unix::Conf->_err ('delete_from_rrset_order', "$itr->{NAME} not defined"))
1702             unless ($self->{options}{'rrset-order'}{$itr->{NAME}});
1703 0 0         return (Unix::Conf->_err ('delete_from_rrset_order', "$itr->{CLASS} not defined for $itr->{NAME}"))
1704             unless ($self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}});
1705 0 0         return (Unix::Conf->_err ('delete_from_rrset_order', "$itr->{TYPE} not defined for $itr->{NAME}, $itr->{CLASS}"))
1706             unless ($self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}}{$itr->{TYPE}});
1707             }
1708              
1709 0           for my $itr (@$args) {
1710 0           delete ($self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}}{$itr->{TYPE}});
1711              
1712             # delete if no keys left.
1713 0           delete ($self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}})
1714 0 0         unless (keys (%{$self->{options}{'rrset-order'}{$itr->{NAME}}{$itr->{CLASS}}}));
1715              
1716 0           delete ($self->{options}{'rrset-order'}{$itr->{NAME}})
1717 0 0         unless (keys (%{$self->{options}{'rrset-order'}{$itr->{NAME}}}));
1718              
1719             # delete the option itself, if no keys left.
1720 0           delete ($self->{options}{'rrset-order'})
1721 0 0         unless (keys (%{$self->{options}{'rrset-order'}}));
1722             }
1723 0           return (1);
1724             }
1725              
1726             =item delete_rrset_order ()
1727              
1728             Arguments
1729             name, # Optional
1730             class # Optional
1731             type # Optional
1732              
1733             Object method.
1734             If name, class and type are passed, the defined order, if any, for
1735             the same is deleted. If only name, class are passed, all defined
1736             types for that name and class are deleted, if defined. If only the
1737             name is specified, all classes defined for that name are deleted.
1738             Note that the method, deletes branches that have become leaves because of deletions.
1739             For example, if for NAME, CLASS the only TYPE defined is deleted, CLASS
1740             gets deleted. If NAME has no other records, NAME gets deleted too. If NAME is the only
1741             rrset-order defined, the option gets deleted.
1742             In all cases, true is returned on success, an Err object otherwise.
1743              
1744             =cut
1745              
1746             sub delete_rrset_order
1747             {
1748 0     0 1   my ($self, $name, $class, $type) = @_;
1749              
1750 0 0         return (Unix::Conf->_err ('delete_rrset_order', "option not defined"))
1751             unless ($self->{options}{'rrset-order'});
1752              
1753 0 0         if (defined ($name)) {
1754             # strip quotes if any
1755 0           $name =~ s/^"(.+)"$/$1/;
1756 0 0         return (Unix::Conf->_err ('delete_rrset_order', "$name not defined"))
1757             unless ($self->{options}{'rrset-order'}{$name});
1758              
1759 0 0         if (defined ($class)) {
1760 0 0         return (Unix::Conf->_err ('delete_rrset_order', "$class not defind for $name"))
1761             unless ($self->{options}{'rrset-order'}{$name}{$class});
1762              
1763 0 0         if (defined ($type)) {
1764 0 0         return (Unix::Conf->_err ('delete_rrset_order', "$type not defined for $name, $class"))
1765             unless ($self->{options}{'rrset-order'}{$name}{$class}{$type});
1766 0           delete ($self->{options}{'rrset-order'}{$name}{$class}{$type});
1767             goto DELETE_RRS_RET
1768 0 0         if (keys (%{$self->{options}{'rrset-order'}{$name}{$class}}));
  0            
1769             }
1770 0           delete ($self->{options}{'rrset-order'}{$name}{$class});
1771             goto DELETE_RRS_RET
1772 0 0         if (keys (%{$self->{options}{'rrset-order'}{$name}}));
  0            
1773             }
1774 0           delete ($self->{options}{'rrset-order'}{$name});
1775             goto DELETE_RRS_RET
1776 0 0         if (keys (%{$self->{options}{'rrset-order'}}));
  0            
1777             }
1778 0           delete ($self->{options}{'rrset-order'});
1779              
1780 0           DELETE_RRS_RET:
1781             $self->dirty (1);
1782 0           return (1);
1783             }
1784              
1785             =item options
1786              
1787             Object method.
1788             Iterates through the list of defined options returning their name one at a
1789             time in a scalar context, or a list of all defined option names in list
1790             context.
1791              
1792             =cut
1793              
1794             sub options
1795             {
1796             return (
1797 0 0   0 1   wantarray () ? sort keys (%{$_[0]->{options}}) : (each (%{$_[0]->{options}}))[0]
  0            
  0            
1798             );
1799             }
1800              
1801             sub __valid_option
1802             {
1803 0     0     my ($self, $option) = @_;
1804              
1805 0           local $" = "|";
1806 0           my @opts = keys (%Supported_Options);
1807 0           return ($option =~ /^(@opts)$/);
1808             }
1809              
1810             my @AclOptions = qw (
1811             allow-transfer
1812             allow-query
1813             allow-recursion
1814             topology
1815             blackhole
1816             sortlist
1817             );
1818              
1819             my @StringOptions = qw (
1820             version
1821             directory
1822             named-xfer
1823             dump-file
1824             statistics-file
1825             memstatistics-file
1826             pid-file
1827             );
1828              
1829             sub __render ()
1830             {
1831 0     0     my $self = $_[0];
1832 0           my ($rendered, $meth, $tmp);
1833            
1834 0           $rendered = qq (options {\n);
1835            
1836 0           for my $option ($self->options ()) {
1837 0 0         ($option eq 'forwarders') && do {
1838 0           $tmp = $self->forwarders ();
1839 0           local $" = "; ";
1840 0           $rendered .= "\tforwarders {";
1841             # the list can be empty
1842 0 0         $rendered .= " @$tmp;" if (@$tmp);
1843 0           $rendered .= " };\n";
1844 0           next;
1845             };
1846 0 0         ($option eq 'check-names') && do {
1847 0           $tmp = $self->check_names ();
1848             $rendered .= "\tcheck-names $_ $tmp->{$_};\n"
1849 0           for (keys (%$tmp));
1850 0           next;
1851             };
1852 0 0         ($option eq 'listen-on') && do {
1853 0           $tmp = $self->get_listen_on ();
1854 0           for (keys (%$tmp)) {
1855 0           $rendered .= qq (\tlisten-on );
1856             # port can be ''
1857 0 0         $rendered .= qq (port $_ )
1858             if ($_);
1859 0           $rendered .= ${$tmp->{$_}->_rstring (undef, 1)} . "\n";
  0            
1860             }
1861 0           next;
1862             };
1863 0 0         ($option eq 'query-source') && do {
1864 0           $tmp = $self->query_source ();
1865 0           next;
1866 0           $rendered .= qq (\tquery-source );
1867 0 0         $rendered .= qq (port $tmp->{PORT})
1868             if ($tmp->{PORT});
1869 0 0         $rendered .= qq ( address $tmp->{ADDRESS})
1870             if ($tmp->{ADDRESS});
1871 0           $rendered .= ";\n";
1872 0           next;
1873             };
1874 0 0         ($option eq 'rrset-order') && do {
1875 0           $tmp= $self->get_rrset_order ();
1876 0           $rendered .= "\trrset-order {\n";
1877 0           for my $name (keys (%$tmp)) {
1878 0           for my $class (keys (%{$tmp->{$name}})) {
  0            
1879 0           for my $type (keys (%{$tmp->{$name}{$class}})) {
  0            
1880 0           $rendered .= "\t\t";
1881 0 0         $rendered .= "class $class " if ($class ne 'ANY');
1882 0 0         $rendered .= "type $type " if ($type ne 'ANY');
1883 0 0         $rendered .= qq(name "$name" ) if ($name ne '*');
1884 0           $rendered .= "order $tmp->{$name}{$class}{$type};\n";
1885             }
1886             }
1887             }
1888 0           $rendered .= "\t};\n";
1889 0           next;
1890             };
1891              
1892 0           local $"= "|";
1893 0           $meth = $option;
1894 0           $meth =~ tr/-/_/;
1895 0           $tmp = $self->$meth ();
1896              
1897 0 0         ($option =~ /^(@AclOptions)$/) && do {
1898 0           $rendered .= "\t$option " . ${$tmp->_rstring (undef, 1)} . "\n";
  0            
1899 0           next;
1900             };
1901              
1902 0 0         ($option =~ /^(@StringOptions)$/) && do {
1903 0           $rendered .= qq(\t$option "$tmp";\n);
1904 0           next;
1905             };
1906            
1907             # most of the other options.
1908 0           $rendered .= "\t$option $tmp;\n";
1909             }
1910              
1911 0           $rendered .= qq (};);
1912 0           return ($_[0]->_rstring (\$rendered));
1913             }
1914              
1915              
1916             1;
1917             __END__