1# bind8-lib.pl
2# Common functions for bind8 config files
3
4use strict;
5use warnings;
6use Time::Local;
7no warnings 'redefine';
8
9BEGIN { push(@INC, ".."); };
10use WebminCore;
11our (%text, %config, %gconfig, $module_name, $module_var_directory, $module_config_file, $module_config_directory);
12
13my $dnssec_tools_minver = 1.13;
14my $have_dnssec_tools = eval "require Net::DNS::SEC::Tools::dnssectools;";
15my %freeze_zone_count;
16
17if ($have_dnssec_tools) {
18	eval "use Net::DNS::SEC::Tools::dnssectools;
19	      use Net::DNS::SEC::Tools::rollmgr;
20	      use Net::DNS::SEC::Tools::rollrec;
21	      use Net::DNS::SEC::Tools::keyrec;
22	      use Net::DNS::RR::DS;
23	      use Net::DNS;";
24	}
25
26&init_config();
27do 'records-lib.pl';
28
29my $dnssec_expiry_cache = "$module_var_directory/dnssec-expiry-cache";
30
31# Globals (yuck!)
32my @extra_forward = split(/\s+/, $config{'extra_forward'} || '');
33my @extra_reverse = split(/\s+/, $config{'extra_reverse'} || '');
34our %is_extra = map { $_, 1 } (@extra_forward, @extra_reverse);
35our %access = &get_module_acl();
36my $zone_names_cache = "$module_config_directory/zone-names";
37my $zone_names_version = 3;
38my @list_zone_names_cache;
39my $slave_error;
40my %lines_count;
41our $dnssec_cron_cmd = "$module_config_directory/resign.pl";
42
43# Where to find root zones file
44my $internic_ftp_host = "rs.internic.net";
45my $internic_ftp_ip = "199.7.52.73";
46my $internic_ftp_file = "/domain/named.root";
47my $internic_ftp_gzip = "/domain/root.zone.gz";
48
49# Get the version number
50our $bind_version;
51if (open(my $VERSION, "<", "$module_config_directory/version")) {
52	chop($bind_version = <$VERSION>);
53	close($VERSION);
54	}
55$bind_version ||= &get_bind_version();
56if ($bind_version && $bind_version =~ /^(\d+\.\d+)\./) {
57	# Convert to properly formatted number
58	$bind_version = $1;
59	}
60
61# For automatic DLV setup
62our $dnssec_dlv_zone = "dlv.isc.org.";
63our @dnssec_dlv_key = ( 257, 3, 5, '"BEAAAAPHMu/5onzrEE7z1egmhg/WPO0+juoZrW3euWEn4MxDCE1+lLy2brhQv5rN32RKtMzX6Mj70jdzeND4XknW58dnJNPCxn8+jAGl2FZLK8t+1uq4W+nnA3qO2+DL+k6BD4mewMLbIYFwe0PG73Te9fZ2kJb56dhgMde5ymX4BI/oQ+cAK50/xvJv00Frf8kw6ucMTwFlgPe+jnGxPPEmHAte/URkY62ZfkLoBAADLHQ9IrS2tryAe7mbBZVcOwIeU/Rw/mRx/vwwMCTgNboMQKtUdvNXDrYJDSHZws3xiRXF1Rf+al9UmZfSav/4NWLKjHzpT59k/VStTDN0YUuWrBNh"' );
64
65my $rand_flag;
66if ($gconfig{'os_type'} =~ /-linux$/ &&
67    -r "/dev/urandom" &&
68    !$config{'force_random'} &&
69    $bind_version &&
70    &compare_version_numbers($bind_version, '9.14') < 0) {
71	# Version: 9.14.2 deprecated the use of -r option
72	# in favor of using /dev/random [bugs:#5370]
73	$rand_flag = "-r /dev/urandom";
74	}
75
76# have_dnssec_tools_support()
77# Returns 1 if dnssec-tools support is available and we meet minimum version
78sub have_dnssec_tools_support
79{
80	if ($have_dnssec_tools &&
81	    $Net::DNS::SEC::Tools::rollrec::VERSION >= $dnssec_tools_minver) {
82		# check that the location for the following essential
83		# parameters have been defined :
84		# dnssectools_conf
85		# dnssectools_rollrec
86		# dnssectools_keydir
87		# dnssectools_rollmgr_pidfile
88		return undef if (!$config{'dnssectools_conf'} ||
89				 !$config{'dnssectools_rollrec'} ||
90				 !$config{'dnssectools_keydir'} ||
91				 !$config{'dnssectools_rollmgr_pidfile'});
92		return 1;
93	}
94	return undef;
95}
96
97# get_bind_version()
98# Returns the BIND version number, or undef if unknown
99sub get_bind_version
100{
101if (&has_command($config{'named_path'})) {
102	my $out = &backquote_command("$config{'named_path'} -v 2>&1");
103	if ($out && $out =~ /(bind|named)\s+([0-9\.]+)/i) {
104		return $2;
105		}
106	}
107return undef;
108}
109
110our @get_config_cache;
111
112# get_config()
113# Returns an array of references to assocs, each containing the details of
114# one directive
115sub get_config
116{
117if (!@get_config_cache) {
118	@get_config_cache = &read_config_file($config{'named_conf'});
119	}
120return \@get_config_cache;
121}
122
123our %get_config_parent_cache;
124
125# get_config_parent([file])
126# Returns a structure containing the top-level config as members
127sub get_config_parent
128{
129my $file = $_[0] || $config{'named_conf'};
130if (!defined($get_config_parent_cache{$file})) {
131	my $conf = &get_config();
132	if (!defined($lines_count{$file})) {
133		my $lref = &read_file_lines($file);
134		$lines_count{$file} = @$lref;
135		}
136	$get_config_parent_cache{$file} =
137	       { 'file' => $file,
138		 'type' => 1,
139		 'line' => -1,
140		 'eline' => $lines_count{$file},
141		 'members' => $conf };
142	}
143return $get_config_parent_cache{$file};
144}
145
146# read_config_file(file, [expand includes])
147# Reads a config file and returns an array of values
148sub read_config_file
149{
150my ($lnum, $line, $cmode, @ltok, @lnum, @tok,
151      @rv, $t, $ifile, @inc, $str);
152$lnum = 0;
153if (open(my $FILE, "<", &make_chroot($_[0]))) {
154	while($line = <$FILE>) {
155		# strip comments
156		$line =~ s/\r|\n//g;
157		$line =~ s/#.*$//g;
158		$line =~ s/\/\*.*\*\///g;
159		$line =~ s/\/\/.*$//g if ($line !~ /".*\/\/.*"/);
160		while(1) {
161			if (!$cmode && $line =~ /\/\*/) {
162				# start of a C-style comment
163				$cmode = 1;
164				$line =~ s/\/\*.*$//g;
165				}
166			elsif ($cmode) {
167				if ($line =~ /\*\//) {
168					# end of comment
169					$cmode = 0;
170					$line =~ s/^.*\*\///g;
171					}
172				else { $line = ""; last; }
173				}
174			else { last; }
175			}
176
177		# split line into tokens
178		undef(@ltok);
179		while(1) {
180			if ($line =~ /^\s*\"([^"]*)"(.*)$/) {
181				push(@ltok, $1); $line = $2;
182				}
183			elsif ($line =~ /^\s*([{};])(.*)$/) {
184				push(@ltok, $1); $line = $2;
185				}
186			elsif ($line =~ /^\s*([^{}; \t]+)(.*)$/) {
187				push(@ltok, $1); $line = $2;
188				}
189			else { last; }
190			}
191		foreach my $t (@ltok) {
192			push(@tok, $t); push(@lnum, $lnum);
193			}
194		$lnum++;
195		}
196	close($FILE);
197	}
198$lines_count{$_[0]} = $lnum;
199
200# parse tokens into data structures
201my $i = 0;
202my $j = 0;
203while($i < @tok) {
204	$str = &parse_struct(\@tok, \@lnum, \$i, $j++, $_[0]);
205	if ($str) { push(@rv, $str); }
206	}
207if (!@rv) {
208	# Add one dummy directive, so that the file is known
209	push(@rv, { 'name' => 'dummy',
210		    'line' => 0,
211		    'eline' => 0,
212		    'index' => 0,
213		    'file' => $_[0] });
214	}
215
216if (!$_[1]) {
217	# expand include directives
218	while(&recursive_includes(\@rv, &base_directory(\@rv))) {
219		# This is done repeatedly to handle includes within includes
220		}
221	}
222
223return @rv;
224}
225
226# recursive_includes(&dirs, base)
227sub recursive_includes
228{
229my $any = 0;
230for(my $i=0; $i<@{$_[0]}; $i++) {
231	if (lc($_[0]->[$i]->{'name'}) eq "include") {
232		# found one.. replace the include directive with it
233		my $ifile = $_[0]->[$i]->{'value'};
234		if ($ifile !~ /^\//) {
235			$ifile = "$_[1]/$ifile";
236			}
237		my @inc = &read_config_file($ifile, 1);
238
239		# update index of included structures
240		for(my $j=0; $j<@inc; $j++) {
241			$inc[$j]->{'index'} += $_[0]->[$i]->{'index'};
242			}
243
244		# update index of structures after include
245		for(my $j=$i+1; $j<@{$_[0]}; $j++) {
246			$_[0]->[$j]->{'index'} += scalar(@inc) - 1;
247			}
248		splice(@{$_[0]}, $i--, 1, @inc);
249		$any++;
250		}
251	elsif ($_[0]->[$i]->{'type'} &&
252	       $_[0]->[$i]->{'type'} == 1) {
253		# Check sub-structures too
254		$any += &recursive_includes($_[0]->[$i]->{'members'}, $_[1]);
255		}
256	}
257return $any;
258}
259
260
261# parse_struct(&tokens, &lines, &line_num, index, file)
262# A structure can either have one value, or a list of values.
263# Pos will end up at the start of the next structure
264sub parse_struct
265{
266my (%str, $j, $t, @vals);
267my $i = ${$_[2]};
268$str{'line'} = $_[1]->[$i];
269if ($_[0]->[$i] ne '{') {
270	# Has a name
271	$str{'name'} = lc($_[0]->[$i]);
272	}
273else {
274	# No name, so need to move token pointer back one
275	$i--;
276	}
277$str{'index'} = $_[3];
278$str{'file'} = $_[4];
279if ($str{'name'} eq 'inet') {
280	# The inet directive doesn't have sub-structures, just multiple
281	# values with { } in them
282	$str{'type'} = 2;
283	$str{'members'} = { };
284	while(1) {
285		$t = $_[0]->[++$i];
286		if ($_[0]->[$i+1] eq "{") {
287			# Start of a named sub-structure ..
288			$i += 2;	# skip {
289			$j = 0;
290			while($_[0]->[$i] ne "}") {
291				my $substr = &parse_struct(
292						$_[0], $_[1], \$i, $j++, $_[4]);
293				if ($substr) {
294					$substr->{'parent'} = \%str;
295					push(@{$str{'members'}->{$t}}, $substr);
296					}
297				}
298			next;
299			}
300		elsif ($t eq ";") { last; }
301		push(@vals, $t);
302		}
303	$i++;	# skip trailing ;
304	$str{'values'} = \@vals;
305	$str{'value'} = $vals[0];
306	}
307else {
308	# Normal directive, like foo bar; or foo bar { smeg; };
309	while(1) {
310		$t = $_[0]->[++$i];
311		if ($t eq "{" || $t eq ";" || $t eq "}") { last; }
312		elsif (!defined($t)) { ${$_[2]} = $i; return undef; }
313		else { push(@vals, $t); }
314		}
315	$str{'values'} = \@vals;
316	$str{'value'} = $vals[0];
317	if ($t eq "{") {
318		# contains sub-structures.. parse them
319		my (@mems, $j);
320		$i++;		# skip {
321		$str{'type'} = 1;
322		$j = 0;
323		while($_[0]->[$i] ne "}") {
324			if (!defined($_[0]->[$i])) { ${$_[2]} = $i; return undef; }
325			my $substr = &parse_struct(
326				$_[0], $_[1], \$i, $j++, $_[4]);
327			if ($substr) {
328				$substr->{'parent'} = \%str;
329				push(@mems, $substr);
330				}
331			}
332		$str{'members'} = \@mems;
333		$i += 2;	# skip trailing } and ;
334		}
335	else {
336		# only a single value..
337		$str{'type'} = 0;
338		if ($t eq ";") {
339			$i++;	# skip trailing ;
340			}
341		}
342	}
343$str{'eline'} = $_[1]->[$i-1];	# ending line is the line number the trailing
344				# ; is on
345${$_[2]} = $i;
346return \%str;
347}
348
349# find(name, &array)
350sub find
351{
352my ($name, $conf) = @_;
353my @rv;
354foreach my $c (@$conf) {
355	if ($c->{'name'} eq $name) {
356		push(@rv, $c);
357		}
358	}
359return @rv ? wantarray ? @rv : $rv[0]
360           : wantarray ? () : undef;
361}
362
363# find_value(name, &array)
364sub find_value
365{
366my @v = &find($_[0], $_[1]);
367if (!@v) { return undef; }
368elsif (wantarray) { return map { $_->{'value'} } @v; }
369else { return $v[0]->{'value'}; }
370}
371
372# base_directory([&config], [no-cache])
373# Returns the base directory for named files
374sub base_directory
375{
376if ($_[1] || !-r $zone_names_cache) {
377	# Actually work out base
378	my ($opts, $dir, $conf);
379	$conf = $_[0] ? $_[0] : &get_config();
380	if (($opts = &find("options", $conf)) &&
381	    ($dir = &find("directory", $opts->{'members'}))) {
382		return $dir->{'value'};
383		}
384	if ($config{'named_conf'} =~ /^(.*)\/[^\/]+$/ && $1) {
385		return $1;
386		}
387	return "/etc";
388	}
389else {
390	# Use cache
391	my %znc;
392	&read_file_cached($zone_names_cache, \%znc);
393	return $znc{'base'} || &base_directory($_[0], 1);
394	}
395}
396
397# save_directive(&parent, name|&olds, &values, indent, [structonly])
398# Given a structure containing a directive name, type, values and members
399# add, update or remove that directive in config structure and data files.
400# Updating of files assumes that there is no overlap between directives -
401# each line in the config file must contain part or all of only one directive.
402sub save_directive
403{
404my (@oldv, @newv, $pm, $o, $n, $lref, @nl, $ol);
405$pm = $_[0]->{'members'};
406@oldv = ref($_[1]) ? @{$_[1]} : $_[1] ? &find($_[1], $pm) : ( );
407@newv = @{$_[2]};
408for(my $i=0; $i<@oldv || $i<@newv; $i++) {
409	my $oldeline = $i<@oldv ? $oldv[$i]->{'eline'} : undef;
410	if ($i < @newv) {
411		# Make sure new directive has 'value' set
412		my @v;
413		if ($newv[$i]->{'values'}) {
414			@v = @{$newv[$i]->{'values'}};
415			}
416		else {
417			@v = undef;
418			}
419		$newv[$i]->{'value'} = @v ? $v[0] : undef;
420		}
421	if ($i >= @oldv && !$_[5]) {
422		# a new directive is being added.. put it at the end of
423		# the parent
424		if (!$_[4]) {
425			my $addfile = $newv[$i]->{'file'} || $_[0]->{'file'};
426			my $parent = &get_config_parent($addfile);
427			$lref = &read_file_lines(&make_chroot($addfile));
428			@nl = &directive_lines($newv[$i], $_[3]);
429			splice(@$lref, $_[0]->{'eline'}, 0, @nl);
430			$newv[$i]->{'file'} = $_[0]->{'file'};
431			$newv[$i]->{'line'} = $_[0]->{'eline'};
432			$newv[$i]->{'eline'} =
433				$_[0]->{'eline'} + scalar(@nl) - 1;
434			&renumber($parent, $_[0]->{'eline'}-1,
435				  $_[0]->{'file'}, scalar(@nl));
436			}
437		push(@$pm, $newv[$i]);
438		}
439	elsif ($i >= @oldv && $_[5]) {
440		# a new directive is being added.. put it at the start of
441		# the parent
442		if (!$_[4]) {
443			my $parent = &get_config_parent($newv[$i]->{'file'} ||
444							   $_[0]->{'file'});
445			$lref = &read_file_lines(
446				&make_chroot($newv[$i]->{'file'} ||
447					     $_[0]->{'file'}));
448			@nl = &directive_lines($newv[$i], $_[3]);
449			splice(@$lref, $_[0]->{'line'}+1, 0, @nl);
450			$newv[$i]->{'file'} = $_[0]->{'file'};
451			$newv[$i]->{'line'} = $_[0]->{'line'}+1;
452			$newv[$i]->{'eline'} =
453				$_[0]->{'line'} + scalar(@nl);
454			&renumber($parent, $_[0]->{'line'},
455				  $_[0]->{'file'}, scalar(@nl));
456			}
457		splice(@$pm, 0, 0, $newv[$i]);
458		}
459	elsif ($i >= @newv) {
460		# a directive was deleted
461		if (!$_[4]) {
462			my $parent = &get_config_parent($oldv[$i]->{'file'});
463			$lref = &read_file_lines(
464					&make_chroot($oldv[$i]->{'file'}));
465			$ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
466			splice(@$lref, $oldv[$i]->{'line'}, $ol);
467			&renumber($parent, $oldeline,
468				  $oldv[$i]->{'file'}, -$ol);
469			}
470		splice(@$pm, &indexof($oldv[$i], @$pm), 1);
471		}
472	else {
473		# updating some directive
474		if (!$_[4]) {
475			my $parent = &get_config_parent($oldv[$i]->{'file'});
476			$lref = &read_file_lines(
477					&make_chroot($oldv[$i]->{'file'}));
478			@nl = &directive_lines($newv[$i], $_[3]);
479			$ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
480			splice(@$lref, $oldv[$i]->{'line'}, $ol, @nl);
481			$newv[$i]->{'file'} = $_[0]->{'file'};
482			$newv[$i]->{'line'} = $oldv[$i]->{'line'};
483			$newv[$i]->{'eline'} =
484				$oldv[$i]->{'line'} + scalar(@nl) - 1;
485			&renumber($parent, $oldeline,
486				  $oldv[$i]->{'file'}, scalar(@nl) - $ol);
487			}
488		$pm->[&indexof($oldv[$i], @$pm)] = $newv[$i];
489		}
490	}
491}
492
493# directives that need their value to be quoted
494my %need_quote;
495my @need_quote = ( "file", "zone", "view", "pid-file", "statistics-file",
496	        "dump-file", "named-xfer", "secret" );
497foreach my $need (@need_quote) {
498	$need_quote{$need}++;
499	}
500
501# directive_lines(&directive, tabs)
502# Renders some directive into a number of lines of text
503sub directive_lines
504{
505my ($dir, $tabs) = @_;
506$tabs ||= 0;
507my (@rv, $i);
508$rv[0] = "\t" x $tabs;
509$rv[0] .= $dir->{'name'};
510foreach my $v (@{$dir->{'values'}}) {
511	if ($need_quote{$dir->{'name'}} && !$i) { $rv[0] .= " \"$v\""; }
512	else { $rv[0] .= " $v"; }
513	$i++;
514	}
515if ($dir->{'type'} && $dir->{'type'} == 1) {
516	# multiple values.. include them as well
517	$rv[0] .= " {";
518	foreach my $m (@{$dir->{'members'}}) {
519		push(@rv, &directive_lines($m, $tabs + 1));
520		}
521	push(@rv, ("\t" x ($tabs + 1))."}");
522	}
523elsif ($dir->{'type'} && $dir->{'type'} == 2) {
524	# named sub-structures .. include them too
525	foreach my $sn (sort { $a cmp $b } (keys %{$dir->{'members'}})) {
526		$rv[0] .= " ".$sn." {";
527		foreach my $m (@{$dir->{'members'}->{$sn}}) {
528			$rv[0] .= " ".join(" ", &directive_lines($m, 0));
529			}
530		$rv[0] .= " }";
531		}
532	}
533$rv[$#rv] .= ";";
534return @rv;
535}
536
537# renumber(&parent, line, file, count)
538# Runs through the given array of directives and increases the line numbers
539# of all those greater than some line by the given count
540sub renumber
541{
542my ($parent, $lnum, $file, $c) = @_;
543if ($parent->{'file'} && $file && $parent->{'file'} eq $file) {
544	if ($parent->{'line'} > $lnum) { $parent->{'line'} += $c; }
545	if ($parent->{'eline'} > $lnum) { $parent->{'eline'} += $c; }
546	}
547if ($parent->{'type'} && $parent->{'type'} == 1) {
548	# Do members
549	foreach my $d (@{$parent->{'members'}}) {
550		&renumber($d, $lnum, $file, $c);
551		}
552	}
553elsif ($parent->{'type'} && $parent->{'type'} == 2) {
554	# Do sub-members
555	foreach my $sm (keys %{$parent->{'members'}}) {
556		foreach my $d (@{$parent->{'members'}->{$sm}}) {
557			&renumber($d, $lnum, $file, $c);
558			}
559		}
560	}
561}
562
563# choice_input(text, name, &config, [display, option]+)
564# Returns a table row for a multi-value BIND option
565sub choice_input
566{
567my $v = &find_value($_[1], $_[2]);
568my @opts;
569for(my $i=3; $i<@_; $i+=2) {
570	push(@opts, [ $_[$i+1], $_[$i] ]);
571	}
572return &ui_table_row($_[0], &ui_radio($_[1], $v, \@opts));
573}
574
575# save_choice(name, &parent, indent)
576# Updates the config from a multi-value option
577sub save_choice
578{
579my $nd;
580if ($in{$_[0]}) { $nd = { 'name' => $_[0], 'values' => [ $in{$_[0]} ] }; }
581&save_directive($_[1], $_[0], $nd ? [ $nd ] : [ ], $_[2]);
582}
583
584# addr_match_input(text, name, &config)
585# A field for editing a list of addresses, ACLs and partial IP addresses
586sub addr_match_input
587{
588my @av;
589my $v = &find($_[1], $_[2]);
590if ($v && $v->{'members'}) {
591	foreach my $av (@{$v->{'members'}}) {
592		push(@av, join(" ", $av->{'name'}, @{$av->{'values'}}));
593		}
594	}
595return &ui_table_row($_[0],
596	&ui_radio("$_[1]_def", $v ? 0 : 1, [ [ 1, $text{'default'} ],
597					     [ 0, $text{'listed'} ] ])."<br>".
598	&ui_textarea($_[1], join("\n", @av), 3, 50));
599}
600
601# save_addr_match(name, &parent, indent)
602sub save_addr_match
603{
604my (@vals, $dir);
605if ($in{"$_[0]_def"}) { &save_directive($_[1], $_[0], [ ], $_[2]); }
606else {
607	$in{$_[0]} =~ s/\r//g;
608	foreach my $addr (split(/\n+/, $in{$_[0]})) {
609		my ($n, @v) = split(/\s+/, $addr);
610		push(@vals, { 'name' => $n, 'values' => \@v });
611		}
612	$dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
613	&save_directive($_[1], $_[0], [ $dir ], $_[2]);
614	}
615}
616
617# address_port_input(addresstext, portlabeltext, portnametext, defaulttext,
618#                    addressname, portname, &config, size, type)
619# Returns table fields for address and a port number
620sub address_port_input
621  {
622    # Address, using existing function
623    my $rv = &address_input($_[0], $_[4], $_[6], $_[8]);
624    my $v = &find($_[4], $_[6]);
625
626    my $port;
627    if ($v && $v->{'values'}) {
628      for (my $i = 0; $i < @{$v->{'values'}}; $i++) {
629        if ($v->{'values'}->[$i] eq $_[5]) {
630	  $port = $v->{'values'}->[$i+1];
631	  last;
632        }
633      }
634    }
635
636    # Port part
637    my $n;
638    ($n = $_[5]) =~ s/[^A-Za-z0-9_]/_/g;
639    $rv .= &ui_table_row($_[1],
640		&ui_opt_textbox($n, $port, $_[7], $_[3], $_[2]));
641    return $rv;
642  }
643
644# address_input(text, name, &config, type)
645sub address_input
646{
647my ($v, @av);
648$v = &find($_[1], $_[2]);
649if ($v && $v->{'members'}) {
650	foreach my $av (@{$v->{'members'}}) {
651		push(@av, join(" ", $av->{'name'}, @{$av->{'values'}}));
652		}
653	}
654if ($_[3] == 0) {
655	# text area
656	return &ui_table_row($_[0],
657		&ui_textarea($_[1], join("\n", @av), 3, 50));
658	}
659else {
660	# text row
661	return &ui_table_row($_[0],
662		&ui_textbox($_[1], join(' ',@av), 50));
663	}
664}
665
666# save_port_address(name, portname, &config, indent)
667sub save_port_address {
668  my ($port, @vals, $dir, $n);
669  my @sp = split(/\s+/, $in{$_[0]});
670  for(my $i=0; $i<@sp; $i++) {
671	$sp[$i] =~ /^\S+$/ || &error(&text('eipacl', $sp[$i]));
672	if (lc($sp[$i+1]) eq "key") {
673		push(@vals, { 'name' => $sp[$i++],
674			      'values' => [ "key", $sp[++$i] ] });
675		}
676	else {
677		push(@vals, { 'name' => $sp[$i] });
678		}
679	}
680  $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
681  ($n = $_[1]) =~ s/[^A-Za-z0-9_]/_/g;
682  $dir->{'values'} = [ $_[1], $in{$_[1]} ] if (!$in{"${n}_def"});
683  &save_directive($_[2], $_[0], @vals ? [ $dir ] : [ ], $_[3]);
684}
685
686# save_address(name, &parent, indent, ips-only)
687sub save_address
688{
689my ($addr, @vals, $dir);
690my @sp = split(/\s+/, $in{$_[0]});
691for(my $i=0; $i<@sp; $i++) {
692	!$_[3] || &check_ipaddress($sp[$i]) || &error(&text('eip', $sp[$i]));
693	if (lc($sp[$i+1]) eq "key") {
694		push(@vals, { 'name' => $sp[$i++],
695			      'values' => [ "key", $sp[++$i] ] });
696		}
697	else {
698		push(@vals, { 'name' => $sp[$i] });
699		}
700	}
701$dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
702&save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2]);
703}
704
705# forwarders_input(text, name, &config)
706# Returns a form field containing a table of forwarding IPs and ports
707sub forwarders_input
708{
709my $v = &find($_[1], $_[2]);
710my (@ips, @prs);
711if ($v && $v->{'members'}) {
712	foreach my $av (@{$v->{'members'}}) {
713		push(@ips, $av->{'name'});
714		if ($av->{'values'}->[0] eq 'port') {
715			push(@prs, $av->{'values'}->[1]);
716			}
717		else {
718			push(@prs, undef);
719			}
720		}
721	}
722my @table;
723for(my $i=0; $i<@ips+3; $i++) {
724	push(@table, [ &ui_textbox("$_[1]_ip_$i", $ips[$i], 20),
725		       &ui_opt_textbox("$_[1]_pr_$i", $prs[$i], 5,
726				       $text{'default'}),
727		     ]);
728	}
729return &ui_table_row($_[0],
730	&ui_columns_table([ $text{'forwarding_ip'}, $text{'forwarding_port'} ],
731			  undef, \@table, undef, 1), 3);
732}
733
734# save_forwarders(name, &parent, indent)
735sub save_forwarders
736{
737my ($ip, $pr, @vals);
738for(my $i=0; defined($ip = $in{"$_[0]_ip_$i"}); $i++) {
739	next if (!$ip);
740	&check_ipaddress($ip) || &check_ip6address($ip) ||
741		&error(&text('eip', $ip));
742	$pr = $in{"$_[0]_pr_${i}_def"} ? undef : $in{"$_[0]_pr_$i"};
743	!$pr || $pr =~ /^\d+$/ || &error(&text('eport', $pr));
744	push(@vals, { 'name' => $ip,
745		      'values' => $pr ? [ "port", $pr ] : [ ] });
746	}
747my $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
748&save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2]);
749}
750
751# opt_input(text, name, &config, default, size, units)
752# Returns a table row with an optional text field
753sub opt_input
754{
755my $v = &find($_[1], $_[2]);
756my $n;
757($n = $_[1]) =~ s/[^A-Za-z0-9_]/_/g;
758return &ui_table_row($_[0],
759	&ui_opt_textbox($n, $v ? $v->{'value'} : "", $_[4], $_[3])." ".$_[5],
760	$_[4] > 30 ? 3 : 1);
761}
762
763sub save_opt
764{
765my ($dir, $n, $err);
766($n = $_[0]) =~ s/[^A-Za-z0-9_]/_/g;
767if ($in{"${n}_def"}) { &save_directive($_[2], $_[0], [ ], $_[3]); }
768elsif ($err = &{$_[1]}($in{$n})) {
769	&error($err);
770	}
771else {
772	$dir = { 'name' => $_[0], 'values' => [ $in{$n} ] };
773	&save_directive($_[2], $_[0], [ $dir ], $_[3]);
774	}
775}
776
777# find_reverse(address, [view])
778# Returns the zone and record structures for the PTR record for some address
779sub find_reverse
780{
781my ($rev, $revconf, $revfile, $revrec, $addr, $ipv6);
782
783# find reverse domain
784my @zl = grep { $_->{'type'} ne 'view' } &list_zone_names();
785if ($_[1] && $_[1] ne 'any') {
786	@zl = grep { $_->{'view'} && $_->{'viewindex'} == $_[1] } @zl;
787	}
788else {
789	@zl = grep { !$_->{'view'} } @zl;
790	}
791$ipv6 = $config{'support_aaaa'} && &check_ip6address($_[0]);
792if ($ipv6) {
793	my @zero = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
794	$addr = &expandall_ip6($_[0]);
795	$addr =~ s/://g;
796	my @hexs = split('', $addr);
797	DOMAIN: for(my $i=30; $i>=0; $i--) {
798		$addr = join(':',split(/(.{4})/,join('', (@hexs[0..$i],@zero[$i..30]))));
799		$addr =~ s/::/:/g;
800		$addr =~ s/(^:|:$)//g;
801		$rev = &net_to_ip6int($addr, 4*($i+1));
802		$rev =~ s/\.$//g;
803		foreach my $z (@zl) {
804			if (lc($z->{'name'}) eq $rev && $z->{'type'} eq 'master') {
805				# found the reverse master domain
806				$revconf = $z;
807				last DOMAIN;
808				}
809			}
810		}
811	}
812else {
813	my @octs = split(/\./, $_[0]);
814	DOMAIN: for(my $i=2; $i>=-1; $i--) {
815		$rev = $i<0 ? "in-addr.arpa"
816			    : &ip_to_arpa(join('.', @octs[0..$i]));
817		$rev =~ s/\.$//g;
818		foreach my $z (@zl) {
819			# Strip off prefix for partial reverse delegation
820			my $zname = $z->{'name'};
821			$zname =~ s/^(\d+)\/(\d+)\.//;
822			if ((lc($zname) eq $rev ||
823			     lc($zname) eq "$rev.") &&
824			    $z->{'type'} eq "master") {
825				# found the reverse master domain
826				$revconf = $z;
827				last DOMAIN;
828				}
829			}
830		}
831	}
832
833# find reverse record
834if ($revconf) {
835	$revfile = &absolute_path($revconf->{'file'});
836	my @revrecs = &read_zone_file($revfile, $revconf->{'name'});
837	$addr = &make_reverse_name($_[0], $ipv6 ? "AAAA" : "A", $revconf, 128);
838	foreach my $rr (@revrecs) {
839		if ($rr->{'type'} eq "PTR" &&
840		    lc($rr->{'name'}) eq lc($addr)) {
841			# found the reverse record
842			$revrec = $rr;
843			last;
844			}
845		}
846	}
847return ($revconf, $revfile, $revrec);
848}
849
850# find_forward(address, [view])
851# Returns the zone and record structures for the A record for some address
852sub find_forward
853{
854my ($fwdconf, $fwdfile, $fwdrec, $ipv6);
855
856# find forward domain
857my $host = $_[0]; $host =~ s/\.$//;
858my @zl = grep { $_->{'type'} ne 'view' } &list_zone_names();
859if ($_[1] ne '' && $_[1] ne 'any') {
860	@zl = grep { $_->{'view'} && $_->{'viewindex'} == $_[1] } @zl;
861	}
862else {
863	@zl = grep { !$_->{'view'} } @zl;
864	}
865my @parts = split(/\./, $host);
866DOMAIN: for(my $i=1; $i<@parts; $i++) {
867	my $fwd = join(".", @parts[$i .. @parts-1]);
868	foreach my $z (@zl) {
869		my $typed;
870		if ((lc($z->{'name'}) eq $fwd ||
871		     lc($z->{'name'}) eq "$fwd.") &&
872		    $z->{'type'} eq "master") {
873			# Found the forward master!
874			$fwdconf = $z;
875			last DOMAIN;
876			}
877		}
878	}
879
880# find forward record
881if ($fwdconf) {
882	$fwdfile = &absolute_path($fwdconf->{'file'});
883	my @fwdrecs = &read_zone_file($fwdfile, $fwdconf->{'name'});
884	foreach my $fr (@fwdrecs) {
885		if ($ipv6 ? $fr->{'type'} eq "AAAA" : $fr->{'type'} eq "A" &&
886		    $fr->{'name'} eq $_[0]) {
887			# found the forward record!
888			$fwdrec = $fr;
889			last;
890			}
891		}
892	}
893
894return ($fwdconf, $fwdfile, $fwdrec);
895}
896
897# make_reverse_name(ip, type, &reverse-zone, ipv6-bits)
898# Returns the reverse record name for an IP
899sub make_reverse_name
900{
901my ($ip, $type, $revconf, $bits) = @_;
902if ($type eq "A") {
903	my $arpa = &ip_to_arpa($ip);
904	if ($revconf->{'name'} =~ /^(\d+)\/(\d+)\.(.*)/) {
905		# Partial reverse delegation zone - last octet is actually
906		# inside it
907		my @arpa = split(/\./, $arpa);
908		return $arpa[0].".".$revconf->{'name'}.".";
909		}
910	return $arpa;
911	}
912else {
913	return &net_to_ip6int($ip, $bits);
914	}
915}
916
917# can_edit_zone(&zone, [&view] | &cachedzone)
918# Returns 1 if some zone can be edited
919sub can_edit_zone
920{
921my %zcan;
922my ($zn, $vn, $file);
923if ($_[0]->{'members'}) {
924	# A full zone structure
925	$zn = $_[0]->{'value'};
926	$vn = $_[1] ? 'view_'.$_[1]->{'value'} : undef;
927	$file = &find_value("file", $_[0]->{'members'});
928	}
929else {
930	# A cached zone object
931	$zn = $_[0]->{'name'};
932	$vn = !defined($_[0]->{'view'}) ||
933	      $_[0]->{'view'} eq '*' ? undef : $_[0]->{'view'};
934	$file = $_[0]->{'file'};
935	}
936
937# Check zone name
938if ($access{'zones'} eq '*') {
939	# Always can
940	}
941elsif ($access{'zones'} =~ /^\!/) {
942	# List of denied zones
943	foreach (split(/\s+/, $access{'zones'})) {
944		return 0 if ($_ eq $zn || ($vn && $_ eq $vn));
945		}
946	}
947else {
948	# List of allowed zones
949	my $ok;
950	foreach my $z (split(/\s+/, $access{'zones'})) {
951		$ok++ if ($z eq $zn || ($vn && $z eq "view_".$vn));
952		}
953	return 0 if (!$ok);
954	}
955
956# Check allowed view
957if ($access{'inviews'} eq '*') {
958	# All views are OK
959	}
960else {
961	my $ok;
962	foreach my $v (split(/\s+/, $access{'inviews'})) {
963		$ok++ if ($v eq ($vn || "_"));
964		}
965	return 0 if (!$ok);
966	}
967
968if ($access{'dironly'}) {
969	# Check directory access control
970	return 1 if (!$file);
971	$file = &absolute_path($file);
972	return 0 if (!&allowed_zone_file(\%access, $file));
973	}
974return 1;
975}
976
977# can_edit_reverse(&zone)
978sub can_edit_reverse
979{
980return $access{'reverse'} || &can_edit_zone($_[0]);
981}
982
983# record_input(zone-name, view, type, file, origin, [num], [record],
984#	       [new-name, new-value])
985# Display a form for editing or creating a DNS record
986sub record_input
987{
988my (%rec, @recs, $ttl, $ttlunit);
989my $type = $_[6] ? $_[6]->{'type'} : $_[2];
990print &ui_form_start("save_record.cgi");
991print &ui_hidden("zone", $_[0]);
992print &ui_hidden("view", $_[1]);
993print &ui_hidden("file", $_[3]);
994print &ui_hidden("origin", $_[4]);
995print &ui_hidden("sort", $in{'sort'});
996if (defined($_[5])) {
997	print &ui_hidden("num", $_[5]);
998	%rec = %{$_[6]};
999	print &ui_hidden("id", &record_id(\%rec));
1000	}
1001else {
1002	print &ui_hidden("new", 1);
1003	$rec{'name'} = $_[7] if ($_[7]);
1004	$rec{'values'} = [ $_[8] ] if ($_[8]);
1005	}
1006print &ui_hidden("type", $type);
1007print &ui_hidden("redirtype", $_[2]);
1008print &ui_table_start(&text(defined($_[5]) ? 'edit_edit' : 'edit_add',
1009			    $text{"edit_".$type}));
1010
1011# Record name field(s)
1012if ($type eq "PTR") {
1013	print &ui_table_row($text{'edit_addr'},
1014		&ui_textbox("name",
1015		  !%rec && $_[4] =~ /^(\d+)\.(\d+)\.(\d+)\.in-addr/ ?
1016			"$3.$2.$1." :
1017			&ip6int_to_net(&arpa_to_ip($rec{'name'})), 30));
1018	}
1019elsif ($type eq "NS") {
1020	print &ui_table_row($text{'edit_zonename'},
1021		&ui_textbox("name", $rec{'name'}, 30));
1022	}
1023elsif ($type eq "SRV" || $type eq "TLSA") {
1024	my ($serv, $proto, $name) =
1025		$rec{'name'} =~ /^([^\.]+)\.([^\.]+)\.(\S+)/ ? ($1, $2, $3) :
1026			(undef, undef, undef);
1027	$serv =~ s/^_//;
1028	$proto =~ s/^_//;
1029	print &ui_table_row($text{'edit_name'},
1030		&ui_textbox("name", $name, 30));
1031
1032	print &ui_table_row($text{'edit_proto'},
1033		&ui_select("proto", $proto || "tcp",
1034			   [ [ "tcp", "TCP" ],
1035			     [ "udp", "UDP" ],
1036			     [ "tls", "TLS" ] ], undef, undef, 1));
1037
1038	print &ui_table_row($text{'edit_serv'},
1039		&ui_textbox("serv", $serv, 20));
1040	}
1041else {
1042	print &ui_table_row($text{'edit_name'},
1043		&ui_textbox("name", $rec{'name'}, 30));
1044	}
1045
1046# Show canonical name too, if not auto-converted
1047if ($config{'short_names'} && defined($_[5])) {
1048	print &ui_table_row($text{'edit_canon'}, "<tt>$rec{'canon'}</tt>");
1049	}
1050
1051# TTL field
1052if ($rec{'ttl'} && $rec{'ttl'} =~ /^(\d+)([SMHDW]?)$/i) {
1053	$ttl = $1;
1054	$ttlunit = $2;
1055	}
1056else {
1057	$ttl = $rec{'ttl'} || '';
1058	$ttlunit = "";
1059	}
1060print &ui_table_row($text{'edit_ttl'},
1061	&ui_opt_textbox("ttl", $ttl, 8, $text{'default'})." ".
1062	&time_unit_choice("ttlunit", $ttlunit));
1063
1064# Value(s) fields
1065my @v;
1066if ($rec{'values'}) {
1067	@v = @{$rec{'values'}};
1068	}
1069else {
1070	@v = ( );
1071	}
1072if ($type eq "A" || $type eq "AAAA") {
1073	print &ui_table_row($text{'value_A1'},
1074	    &ui_textbox("value0", $v[0], 20)." ".
1075	    (!defined($_[5]) && $type eq "A" ?
1076	     &free_address_button("value0") : ""), 3);
1077	if (defined($_[5])) {
1078		print &ui_hidden("oldname", $rec{'name'});
1079		print &ui_hidden("oldvalue0", $v[0]);
1080		}
1081	}
1082elsif ($type eq "NS") {
1083	print &ui_table_row($text{'value_NS1'},
1084	    &ui_textbox("value0", $v[0], 30)." ($text{'edit_cnamemsg'})", 3);
1085	}
1086elsif ($type eq "CNAME") {
1087	print &ui_table_row($text{'value_CNAME1'},
1088	    &ui_textbox("value0", $v[0], 30)." ($text{'edit_cnamemsg'})", 3);
1089	}
1090elsif ($type eq "MX") {
1091	print &ui_table_row($text{'value_MX2'},
1092	    &ui_textbox("value1", $v[1], 30));
1093	print &ui_table_row($text{'value_MX1'},
1094	    &ui_textbox("value0", $v[0], 8));
1095	}
1096elsif ($type eq "HINFO") {
1097	print &ui_table_row($text{'value_HINFO1'},
1098	    &ui_textbox("value0", $v[0], 20));
1099	print &ui_table_row($text{'value_HINFO2'},
1100	    &ui_textbox("value1", $v[1], 20));
1101	}
1102elsif ($type eq "TXT") {
1103	print &ui_table_row($text{'value_TXT1'},
1104	    &ui_textarea("value0", join("", @v), 5, 80, "soft"), 3);
1105	}
1106elsif ($type eq "WKS") {
1107	# Well known server
1108	print &ui_table_row($text{'value_WKS1'},
1109		&ui_textbox("value0", $v[0], 15));
1110
1111	print &ui_table_row($text{'value_WKS2'},
1112		&ui_select("value1", lc($v[1]),
1113			   [ [ "tcp", "TCP" ], [ "udp", "UDP" ] ]));
1114
1115	print &ui_table_row($text{'value_WKS3'},
1116		&ui_textarea("value2", join(' ', @v[2..$#v]), 3, 20));
1117	}
1118elsif ($type eq "RP") {
1119	# Responsible person
1120	print &ui_table_row($text{'value_RP1'},
1121		&ui_textbox("value0", &dotted_to_email($v[0]), 20));
1122
1123	print &ui_table_row($text{'value_RP2'},
1124		&ui_textbox("value1", $v[1], 30));
1125	}
1126elsif ($type eq "PTR") {
1127	# Reverse address
1128	print &ui_table_row($text{'value_PTR1'},
1129		&ui_textbox("value0", $v[0], 30), 3);
1130	if (defined($_[5])) {
1131		print &ui_hidden("oldname", $rec{'name'});
1132		print &ui_hidden("oldvalue0", $v[0]);
1133		}
1134	}
1135elsif ($type eq "SRV") {
1136	print &ui_table_row($text{'value_SRV1'},
1137		&ui_textbox("value0", $v[0], 8));
1138
1139	print &ui_table_row($text{'value_SRV2'},
1140		&ui_textbox("value1", $v[1], 8));
1141
1142	print &ui_table_row($text{'value_SRV3'},
1143		&ui_textbox("value2", $v[2], 8));
1144
1145	print &ui_table_row($text{'value_SRV4'},
1146		&ui_textbox("value3", $v[3], 30));
1147	}
1148elsif ($type eq "TLSA") {
1149	print &ui_table_row($text{'value_TLSA1'},
1150		&ui_select("value0", $v[0],
1151			   [ [ 0, $text{'tlsa_usage0'}." (0)" ],
1152			     [ 1, $text{'tlsa_usage1'}." (1)" ],
1153			     [ 2, $text{'tlsa_usage2'}." (2)" ],
1154			     [ 3, $text{'tlsa_usage3'}." (3)" ] ]));
1155
1156	print &ui_table_row($text{'value_TLSA2'},
1157		&ui_select("value1", $v[1],
1158			   [ [ 0, $text{'tlsa_selector0'}." (0)" ],
1159			     [ 1, $text{'tlsa_selector1'}." (1)" ] ]));
1160
1161	print &ui_table_row($text{'value_TLSA3'},
1162		&ui_select("value2", $v[2],
1163			   [ [ 0, $text{'tlsa_match0'}." (0)" ],
1164			     [ 1, $text{'tlsa_match1'}." (1)" ],
1165			     [ 2, $text{'tlsa_match2'}." (2)" ] ]));
1166
1167	print &ui_table_row($text{'value_TLSA4'},
1168		&ui_textbox("value3", $v[3], 70));
1169	}
1170elsif ($type eq "SSHFP") {
1171	print &ui_table_row($text{'value_SSHFP1'},
1172		&ui_select("value0", $v[0],
1173			   [ [ 1, $text{'sshfp_alg1'}." (1)" ],
1174			     [ 2, $text{'sshfp_alg2'}." (2)" ],
1175			     [ 3, $text{'sshfp_alg3'}." (3)" ],
1176			     [ 4, $text{'sshfp_alg4'}." (4)" ] ]));
1177
1178	print &ui_table_row($text{'value_SSHFP2'},
1179		&ui_select("value1", $v[1],
1180			   [ [ 1, $text{'sshfp_fp1'}." (1)" ],
1181			     [ 2, $text{'sshfp_fp2'}." (2)" ] ]));
1182
1183	print &ui_table_row($text{'value_SSHFP3'},
1184		&ui_textbox("value2", $v[2], 70));
1185
1186	}
1187elsif ($type eq "LOC") {
1188	print &ui_table_row($text{'value_LOC1'},
1189		&ui_textbox("value0", join(" ", @v), 40), 3);
1190	}
1191elsif ($type eq "KEY") {
1192	print &ui_table_row($text{'value_KEY1'},
1193		&ui_textbox("value0", $v[0], 8));
1194
1195	print &ui_table_row($text{'value_KEY2'},
1196		&ui_textbox("value1", $v[1], 8));
1197
1198	print &ui_table_row($text{'value_KEY3'},
1199		&ui_textbox("value2", $v[2], 8));
1200
1201	print &ui_table_row($text{'value_KEY4'},
1202		&ui_textarea("value3", join("\n", &wrap_lines($v[3], 80)),
1203			     5, 80), 3);
1204	}
1205elsif ($type eq "SPF") {
1206	# SPF records are complex, as they have several attributes encoded
1207	# in the TXT value
1208	my $spf = &parse_spf(@v);
1209	print &ui_table_row($text{'value_spfa'},
1210		&ui_yesno_radio("spfa", $spf->{'a'} ? 1 : 0), 3);
1211
1212	print &ui_table_row($text{'value_spfmx'},
1213		&ui_yesno_radio("spfmx", $spf->{'mx'} ? 1 : 0), 3);
1214
1215	print &ui_table_row($text{'value_spfptr'},
1216		&ui_yesno_radio("spfptr", $spf->{'ptr'} ? 1 : 0), 3);
1217
1218	print &ui_table_row($text{'value_spfas'},
1219		&ui_textarea("spfas", join("\n", @{$spf->{'a:'} || []}), 3, 40), 3);
1220
1221	print &ui_table_row($text{'value_spfmxs'},
1222		&ui_textarea("spfmxs", join("\n", @{$spf->{'mx:'} || []}), 3, 40), 3);
1223
1224	print &ui_table_row($text{'value_spfip4s'},
1225		&ui_textarea("spfip4s", join("\n", @{$spf->{'ip4:'} || []}),
1226		  	     3, 40), 3);
1227	print &ui_table_row($text{'value_spfip6s'},
1228		&ui_textarea("spfip6s", join("\n", @{$spf->{'ip6:'} || []}),
1229			     3, 40), 3);
1230
1231	print &ui_table_row($text{'value_spfincludes'},
1232		&ui_textarea("spfincludes", join("\n", @{$spf->{'include:'} || []}),
1233		  	     3, 40), 3);
1234
1235	print &ui_table_row($text{'value_spfall'},
1236		&ui_select("spfall", int($spf->{'all'}),
1237			[ [ 3, $text{'value_spfall3'} ],
1238			  [ 2, $text{'value_spfall2'} ],
1239			  [ 1, $text{'value_spfall1'} ],
1240			  [ 0, $text{'value_spfall0'} ],
1241			  [ undef, $text{'value_spfalldef'} ] ]), 3);
1242
1243	print &ui_table_row($text{'value_spfredirect'},
1244		&ui_opt_textbox("spfredirect", $spf->{'redirect'}, 40,
1245			    $text{'value_spfnoredirect'}), 3);
1246
1247	print &ui_table_row($text{'value_spfexp'},
1248		&ui_opt_textbox("spfexp", $spf->{'exp'}, 40,
1249			    $text{'value_spfnoexp'}), 3);
1250	}
1251elsif ($type eq "DMARC") {
1252	# Like SPF, DMARC records have several attributes encoded in the
1253	# TXT value
1254	my $dmarc = &parse_dmarc(@v);
1255	my @popts = ( [ "none", $text{'value_dmarcnone'} ],
1256		         [ "quarantine", $text{'value_dmarcquar'} ],
1257		         [ "reject", $text{'value_dmarcreject'} ] );
1258	print &ui_table_row($text{'value_dmarcp'},
1259		&ui_select("dmarcp", $dmarc->{'p'}, \@popts));
1260
1261	print &ui_table_row($text{'value_dmarcpct'},
1262		&ui_textbox("dmarcpct", $dmarc->{'pct'}, 5)."%");
1263
1264	print &ui_table_row($text{'value_dmarcsp'},
1265		&ui_select("dmarcsp", $dmarc->{'sp'},
1266			   [ [ "", $text{'value_dmarcnop'} ], @popts ]));
1267
1268	print &ui_table_row($text{'value_dmarcaspf'},
1269		&ui_yesno_radio("dmarcaspf", $dmarc->{'aspf'} eq 's'));
1270
1271	print &ui_table_row($text{'value_dmarcadkim'},
1272		&ui_yesno_radio("dmarcadkim", $dmarc->{'adkim'} eq 's'));
1273
1274	my $rua = $dmarc->{'rua'};
1275	$rua =~ s/^mailto://;
1276	print &ui_table_row($text{'value_dmarcrua'},
1277	    &ui_opt_textbox("dmarcrua", $rua, 50, $text{'value_dmarcnor'}), 3);
1278
1279	my $ruf = $dmarc->{'ruf'};
1280	$ruf =~ s/^mailto://;
1281	print &ui_table_row($text{'value_dmarcruf'},
1282	    &ui_opt_textbox("dmarcruf", $ruf, 50, $text{'value_dmarcnor'}), 3);
1283
1284	print &ui_table_row($text{'value_dmarcfo'},
1285		&ui_select("dmarcfo", $dmarc->{'fo'},
1286			   [ [ undef, $text{'default'} ],
1287			     [ 0, $text{'value_dmarcfo0'} ],
1288			     [ 1, $text{'value_dmarcfo1'} ],
1289			     [ 'd', $text{'value_dmarcfod'} ],
1290			     [ 's', $text{'value_dmarcfos'} ] ]));
1291	}
1292elsif ($type eq "NSEC3PARAM") {
1293	# NSEC records have a hash type, flags, number of interations, salt
1294	# length and salt
1295	print &ui_table_row($text{'value_NSEC3PARAM1'},
1296		&ui_select("value0", $v[0] || 1,
1297			   [ [ 1, "SHA1" ] ], 1, 0, 1));
1298
1299	print &ui_table_row($text{'value_NSEC3PARAM2'},
1300		&ui_select("value1", $v[1],
1301			   [ [ 0, $text{'value_delegated'} ],
1302			     [ 1, $text{'value_notdelegated'} ] ]));
1303
1304	print &ui_table_row($text{'value_NSEC3PARAM3'},
1305		&ui_textbox("value2", $v[2], 4));
1306
1307	print &ui_table_row($text{'value_NSEC3PARAM4'},
1308		&ui_textbox("value3", $v[3], 20));
1309
1310	}
1311elsif ($type eq "CAA") {
1312	# CAA records have a flag, tag and issuer domain
1313	print &ui_table_row($text{'value_CAA0'},
1314		&ui_yesno_radio("value0", $v[0] || 0));
1315
1316	print &ui_table_row($text{'value_CAA1'},
1317		&ui_select("value1", $v[1],
1318			   [ [ "issue", $text{'value_caa_issue'} ],
1319			     [ "issuewild", $text{'value_caa_issuewild'} ],
1320			     [ "iodef", $text{'value_caa_iodef'} ] ]));
1321
1322	print &ui_table_row($text{'value_CAA2'},
1323		&ui_textbox("value2", $v[2], 40));
1324	}
1325else {
1326	# All other types just have a text box
1327	print &ui_table_row($text{'value_other'},
1328		&ui_textarea("values", join("\n", @v), 3, 40), 3);
1329	}
1330
1331# Comment field
1332if ($type ne "WKS") {
1333	if ($config{'allow_comments'}) {
1334		print &ui_table_row($text{'edit_comment'},
1335			&ui_textbox("comment", $rec{'comment'}, 40), 3);
1336		}
1337	else {
1338		print &ui_hidden("comment", $rec{'comment'});
1339		}
1340	}
1341
1342# Update reverse/forward option
1343if ($type eq "A" || $type eq "AAAA") {
1344	print &ui_table_row($text{'edit_uprev'},
1345		&ui_radio("rev", $config{'rev_def'} == 0 ? 1 :
1346				 $config{'rev_def'} == 2 ? 2 : 0,
1347		   [ [ 1, $text{'yes'} ],
1348		     defined($_[5]) ? ( ) : ( [ 2, $text{'edit_over'} ] ),
1349		     [ 0, $text{'no'} ] ]));
1350	}
1351elsif ($type eq "PTR") {
1352	print &ui_table_row($text{'edit_upfwd'},
1353		&ui_radio("fwd", $config{'rev_def'} ? 0 : 1,
1354		   [ [ 1, $text{'yes'} ],
1355		     [ 0, $text{'no'} ] ]));
1356	}
1357print &ui_table_end();
1358
1359# End buttons
1360if (!$access{'ro'}) {
1361	if (defined($_[5])) {
1362		print &ui_form_end([ [ undef, $text{'save'} ],
1363				     [ "delete", $text{'delete'} ] ]);
1364		}
1365	else {
1366		print &ui_form_end([ [ undef, $text{'create'} ] ]);
1367		}
1368	}
1369}
1370
1371# zones_table(&links, &titles, &types, &deletes, &status)
1372# Returns a table of zones, with checkboxes to delete
1373sub zones_table
1374{
1375my @tds = ( "width=5" );
1376my $rv;
1377if (&have_dnssec_tools_support()) {
1378$rv .= &ui_columns_start([ "", $text{'index_zone'}, $text{'index_type'}, $text{'index_status'} ],
1379			100, 0, \@tds);
1380} else {
1381$rv .= &ui_columns_start([ "", $text{'index_zone'}, $text{'index_type'} ],
1382			100, 0, \@tds);
1383}
1384
1385for(my $i=0; $i<@{$_[0]}; $i++) {
1386	my @cols;
1387	if (&have_dnssec_tools_support()) {
1388		@cols = ( &ui_link($_[0]->[$i], $_[1]->[$i]), $_[2]->[$i], $_[4]->[$i] );
1389	} else {
1390		@cols = ( &ui_link($_[0]->[$i], $_[1]->[$i]), $_[2]->[$i] );
1391	}
1392	if (defined($_[3]->[$i])) {
1393		$rv .= &ui_checked_columns_row(\@cols, \@tds, "d", $_[3]->[$i]);
1394		}
1395	else {
1396		$rv .= &ui_columns_row(\@cols, \@tds);
1397		}
1398	}
1399$rv .= &ui_columns_end();
1400return $rv;
1401}
1402
1403sub check_net_ip
1404{
1405my $arg = $_[0];
1406if ($arg !~ /^(\d{1,3}\.){0,3}([0-9\-\/]+)$/) {
1407	return 0;
1408	}
1409foreach my $j (split(/\./, $arg)) {
1410	$j =~ /^(\d+)-(\d+)$/ && $1 < 255 && $2 < 255 ||
1411	$j =~ /^(\d+)\/(\d+)$/ && $1 < 255 && $2 <= 32 ||
1412		$j <= 255 || return 0;
1413	}
1414return 1;
1415}
1416
1417# expand_ip6(ip)
1418# Transform compact (with ::) IPv6 address to the unique expanded form
1419# (without :: and leading zeroes in all parts)
1420sub expand_ip6
1421{
1422my ($ip) = @_;
1423for(my $n = 6 - ($ip =~ s/([^:]):(?=[^:])/$1:/g); $n > 0; $n--) {
1424	$ip =~ s/::/:0::/;
1425	}
1426$ip =~ s/::/:/;
1427$ip =~ s/^:/0:/;
1428$ip =~ s/:$/:0/;
1429$ip =~ s/(:|^)0(?=\w)/$1/;
1430$ip =~ tr/[A-Z]/[a-z]/;
1431return $ip;
1432}
1433
1434# expandall_ip6(ip)
1435# Transform IPv6 address to the expanded form containing all internal 0's
1436sub expandall_ip6
1437{
1438my ($ip) = @_;
1439$ip = &expand_ip6($ip);
1440$ip =~ s/(:|^)(\w{3})(?=:|$)/:0$2/g;
1441$ip =~ s/(:|^)(\w{2})(?=:|$)/:00$2/g;
1442$ip =~ s/(:|^)(\w)(?=:|$)/:000$2/g;
1443return $ip;
1444}
1445
1446sub time_unit_choice
1447{
1448my ($name, $value) = @_;
1449return &ui_select($name, $value =~ /^(S?)$/i ? "" :
1450			 $value =~ /M/i ? "M" :
1451			 $value =~ /H/i ? "H" :
1452			 $value =~ /D/i ? "D" :
1453			 $value =~ /W/i ? "W" : $value,
1454		  [ [ "", $text{'seconds'} ],
1455		    [ "M", $text{'minutes'} ],
1456		    [ "H", $text{'hours'} ],
1457		    [ "D", $text{'days'} ],
1458		    [ "W", $text{'weeks'} ] ], 1, 0, 1);
1459}
1460
1461sub extract_time_units
1462{
1463my @ret;
1464foreach my $j (@_) {
1465	if ($j =~ /^(\d+)([SMHDW]?)$/is) {
1466		push(@ret, $2); $j = $1;
1467		}
1468	}
1469return @ret;
1470}
1471
1472sub email_to_dotted
1473{
1474my $v = $_[0];
1475$v =~ s/\.$//;
1476if ($v =~ /^([^.]+)\@(.*)$/) {
1477	return "$1.$2.";
1478	}
1479elsif ($v =~ /^(.*)\@(.*)$/) {
1480	my ($u, $d) = ($1, $2);
1481	$u =~ s/\./\\\./g;
1482	return "$u.$d.";
1483	}
1484else {
1485	return $v;
1486	}
1487}
1488
1489sub dotted_to_email
1490{
1491my $v = $_[0];
1492if ($v ne ".") {
1493	$v =~ s/([^\\])\./$1\@/;
1494	$v =~ s/\\\./\./g;
1495	$v =~ s/\.$//;
1496	}
1497return $v;
1498}
1499
1500# set_ownership(file, [slave-mode])
1501# Sets the BIND ownership and permissions on some file
1502sub set_ownership
1503{
1504my ($file, $slave) = @_;
1505my ($user, $group, $perms);
1506if ($config{'file_owner'}) {
1507	# From config
1508	($user, $group) = split(/:/, $config{'file_owner'});
1509	}
1510elsif ($file =~ /^(.*)\/([^\/]+)$/) {
1511	# Match parent dir
1512	my @st = stat($1);
1513	($user, $group) = ($st[4], $st[5]);
1514	}
1515if ($slave && $config{'slave_file_perms'}) {
1516	$perms = oct($config{'slave_file_perms'});
1517	}
1518elsif ($config{'file_perms'}) {
1519	$perms = oct($config{'file_perms'});
1520	}
1521&set_ownership_permissions($user, $group, $perms, $file);
1522}
1523
1524my @cat_list;
1525if ($bind_version && $bind_version >= 9) {
1526	@cat_list = ( 'default', 'general', 'database', 'security', 'config',
1527		      'resolver', 'xfer-in', 'xfer-out', 'notify', 'client',
1528		      'unmatched', 'network', 'update', 'queries', 'dispatch',
1529		      'dnssec', 'lame-servers' );
1530	}
1531else {
1532	@cat_list = ( 'default', 'config', 'parser', 'queries',
1533		      'lame-servers', 'statistics', 'panic', 'update',
1534		      'ncache', 'xfer-in', 'xfer-out', 'db',
1535		      'eventlib', 'packet', 'notify', 'cname', 'security',
1536		      'os', 'insist', 'maintenance', 'load', 'response-checks');
1537	}
1538
1539my @syslog_levels = ( 'kern', 'user', 'mail', 'daemon', 'auth', 'syslog',
1540		   'lpr', 'news', 'uucp', 'cron', 'authpriv', 'ftp',
1541		   'local0', 'local1', 'local2', 'local3',
1542		   'local4', 'local5', 'local6', 'local7' );
1543
1544my @severities = ( 'critical', 'error', 'warning', 'notice', 'info',
1545		'debug', 'dynamic' );
1546
1547# can_edit_view(&view | &viewcache)
1548# Returns 1 if some view can be edited
1549sub can_edit_view
1550{
1551my %vcan;
1552my $vn = $_[0]->{'members'} ? $_[0]->{'value'} : $_[0]->{'name'};
1553
1554if ($access{'vlist'} eq '*') {
1555	return 1;
1556	}
1557elsif ($access{'vlist'} =~ /^\!/) {
1558	foreach (split(/\s+/, $access{'vlist'})) {
1559		return 0 if ($_ eq $vn);
1560		}
1561	return 1;
1562	}
1563else {
1564	foreach (split(/\s+/, $access{'vlist'})) {
1565		return 1 if ($_ eq $vn);
1566		}
1567	return 0;
1568	}
1569}
1570
1571# wrap_lines(text, width)
1572# Given a multi-line string, return an array of lines wrapped to
1573# the given width
1574sub wrap_lines
1575{
1576my $rest = $_[0];
1577my @rv;
1578while(length($rest) > $_[1]) {
1579	push(@rv, substr($rest, 0, $_[1]));
1580	$rest = substr($rest, $_[1]);
1581	}
1582push(@rv, $rest) if ($rest ne '');
1583return @rv;
1584}
1585
1586# add_zone_access(domain)
1587# Add a new zone to the current user's access list
1588sub add_zone_access
1589{
1590if ($access{'zones'} ne '*' && $access{'zones'} !~ /^\!/) {
1591	$access{'zones'} = join(" ", &unique(
1592				split(/\s+/, $access{'zones'}), $_[0]));
1593	&save_module_acl(\%access);
1594	}
1595}
1596
1597# is_config_valid()
1598sub is_config_valid
1599{
1600my $conf = &get_config();
1601my ($opts, $dir);
1602if (($opts = &find("options", $conf)) &&
1603    ($dir = &find("directory", $opts->{'members'})) &&
1604    !(-d &make_chroot($dir->{'value'}))) {
1605	return 0;
1606	}
1607return 1;
1608}
1609
1610my $get_chroot_cache;
1611
1612# get_chroot()
1613# Returns the chroot directory BIND is running under
1614sub get_chroot
1615{
1616if (!defined($get_chroot_cache)) {
1617	if ($gconfig{'real_os_type'} eq 'CentOS Linux' &&
1618	    $gconfig{'real_os_version'} =~ /^(\d+)/ && $1 >= 6 &&
1619	    $config{'auto_chroot'} &&
1620	    $config{'auto_chroot'} =~ /\/etc\/sysconfig\/named/) {
1621		# Special case hack - on CentOS 6, chroot path in
1622		# /etc/sysconfig/named isn't really used. Instead, files
1623		# in the chroot are loopback mounted to the real paths.
1624		if (-r $config{'named_conf'} && !-l $config{'named_conf'}) {
1625			$config{'auto_chroot'} = undef;
1626			}
1627		}
1628	if ($config{'auto_chroot'}) {
1629		my $out = &backquote_command(
1630			"$config{'auto_chroot'} 2>/dev/null");
1631		if (!$?) {
1632			$out =~ s/\r|\n//g;
1633			$get_chroot_cache = $out || "";
1634			}
1635		}
1636	if (!defined($get_chroot_cache)) {
1637		# Use manually set path
1638		$get_chroot_cache = $config{'chroot'};
1639		}
1640	}
1641return $get_chroot_cache;
1642}
1643
1644# make_chroot(file, [is-pid])
1645# Given a path that is relative to the chroot directory, return the real path
1646sub make_chroot
1647{
1648my $chroot = &get_chroot();
1649return $_[0] if (!$chroot);
1650return $_[0] if ($chroot eq "/");
1651return $_[0] if ($_[0] eq $config{'named_conf'} && $config{'no_chroot'});
1652return $_[0] if ($_[0] eq $config{'rndc_conf'});	# don't chroot rndc.conf
1653if ($config{'no_pid_chroot'} && $_[1]) {
1654	return $_[0];
1655	}
1656return $chroot.$_[0];
1657}
1658
1659# has_ndc(exclude-mode)
1660# Returns 2 if rndc is installed, 1 if ndc is instaled, or 0
1661# Mode 2 = try ndc only, 1 = try rndc only, 0 = both
1662sub has_ndc
1663{
1664my $mode = $_[0] || 0;
1665if ($config{'rndc_cmd'} =~ /^(\S+)/ && &has_command("$1") && $mode != 2) {
1666	return 2;
1667	}
1668if ($config{'ndc_cmd'} =~ /^(\S+)/ && &has_command("$1") && $mode != 1) {
1669	return 1;
1670	}
1671return 0;
1672}
1673
1674# get_pid_file([no-cache])
1675# Returns the BIND pid file path, relative to any chroot
1676sub get_pid_file
1677{
1678if ($_[0] || !-r $zone_names_cache) {
1679	# Read real config
1680	my $conf = &get_config();
1681	my ($opts, $pidopt);
1682	if (($opts = &find("options", $conf)) &&
1683	    ($pidopt = &find("pid-file", $opts->{'members'}))) {
1684		# read from PID file
1685		my $pidfile = $pidopt->{'value'};
1686		if ($pidfile !~ /^\//) {
1687			my $dir = &find("directory", $opts->{'members'});
1688			$pidfile = $dir->{'value'}."/".$pidfile;
1689			}
1690		return $pidfile;
1691		}
1692
1693	# use default file
1694	foreach my $p (split(/\s+/, $config{'pid_file'})) {
1695		if (-r &make_chroot($p, 1)) {
1696			return $p;
1697			}
1698		}
1699	return "/var/run/named.pid";
1700	}
1701else {
1702	# Use cache if possible
1703	my %znc;
1704	&read_file_cached($zone_names_cache, \%znc);
1705	if ($znc{'pidfile'} && -r $znc{'pidfile'}) {
1706		return $znc{'pidfile'};
1707		}
1708	else {
1709		return &get_pid_file(1);
1710		}
1711	}
1712}
1713
1714# can_edit_type(record-type)
1715sub can_edit_type
1716{
1717return 1 if (!$access{'types'});
1718foreach my $t (split(/\s+/, $access{'types'})) {
1719	return 1 if (lc($t) eq lc($_[0]));
1720	}
1721return 0;
1722}
1723
1724# add_to_file()
1725# Returns the filename to which new zones should be added (possibly relative to
1726# a chroot directory)
1727sub add_to_file
1728{
1729if ($config{'zones_file'}) {
1730	my $conf = &get_config();
1731	foreach my $f (&get_all_config_files($conf)) {
1732		if (&same_file($f, $config{'zones_file'})) {
1733			return $config{'zones_file'};
1734			}
1735		}
1736	}
1737return $config{'named_conf'};
1738}
1739
1740# get_all_config_files(&conf)
1741# Returns a list of all config files used by named.conf, including includes
1742sub get_all_config_files
1743{
1744my ($conf) = @_;
1745my @rv = ( $config{'named_conf'} );
1746foreach my $c (@$conf) {
1747	push(@rv, $c->{'file'});
1748	if (defined($c->{'type'}) && $c->{'type'} == 1) {
1749		push(@rv, &get_all_config_files($c->{'members'}));
1750		}
1751	}
1752return &unique(@rv);
1753}
1754
1755# free_address_button(name)
1756sub free_address_button
1757{
1758return &popup_window_button("free_chooser.cgi", 200, 500, 1,
1759			    [ [ "ifield", $_[0] ] ]);
1760}
1761
1762# create_slave_zone(name, master-ip, [view], [file], [&other-ips])
1763# A convenience function for creating a new slave zone, if it doesn't exist
1764# yet. Mainly useful for Virtualmin, to avoid excessive transfer of BIND
1765# configuration data.
1766# Returns 0 on success, 1 if BIND is not setup, 2 if the zone already exists,
1767# or 3 if the view doesn't exist, or 4 if the slave file couldn't be created
1768sub create_slave_zone
1769{
1770my $parent = &get_config_parent();
1771my $conf = $parent->{'members'};
1772my $opts = &find("options", $conf);
1773if (!$opts) {
1774	return 1;
1775	}
1776
1777# Check if exists in the view
1778my @zones;
1779if ($_[2]) {
1780	my ($v) = grep { $_->{'value'} eq $_[2] } &find("view", $conf);
1781	@zones = &find("zone", $v->{'members'});
1782	}
1783else {
1784	@zones = &find("zone", $conf);
1785	}
1786my ($z) = grep { $_->{'value'} eq $_[0] } @zones;
1787return 2 if ($z);
1788
1789# Create it
1790my @mips = &unique($_[1], @{$_[4]});
1791my $masters = { 'name' => 'masters',
1792                'type' => 1,
1793                'members' => [ map { { 'name' => $_ } } @mips ] };
1794my $allow = { 'name' => 'allow-transfer',
1795              'type' => 1,
1796              'members' => [ map { { 'name' => $_ } } @mips ] };
1797my $dir = { 'name' => 'zone',
1798            'values' => [ $_[0] ],
1799            'type' => 1,
1800            'members' => [ { 'name' => 'type',
1801                             'values' => [ 'slave' ] },
1802                             $masters,
1803			     $allow,
1804                         ]
1805	     };
1806my $base = $config{'slave_dir'} || &base_directory();
1807if ($base !~ /^([a-z]:)?\//) {
1808	# Slave dir is relative .. make absolute
1809	$base = &base_directory()."/".$base;
1810	}
1811my $file;
1812if (!$_[3]) {
1813	# File has default name and is under default directory
1814	$file = &automatic_filename($_[0], $_[0] =~ /in-addr/i ? 1 : 0, $base,
1815				    $_[2]);
1816	push(@{$dir->{'members'}}, { 'name' => 'file',
1817				     'values' => [ $file ] } );
1818	}
1819elsif ($_[3] ne "none") {
1820	# File was specified
1821	$file = $_[3] =~ /^\// ? $_[3] : $base."/".$_[3];
1822	push(@{$dir->{'members'}}, { 'name' => 'file',
1823				     'values' => [ $file ] } );
1824	}
1825
1826# Create the slave file, so that BIND can write to it
1827if ($file) {
1828	my $ZONE;
1829	&open_tempfile($ZONE, ">".&make_chroot($file), 1, 1) || return 4;
1830	&close_tempfile($ZONE);
1831        &set_ownership(&make_chroot($file));
1832	}
1833
1834# Get and validate view(s)
1835my @views;
1836if ($_[2]) {
1837	foreach my $vn (split(/\s+/, $_[2])) {
1838		my ($view) = grep { $_->{'value'} eq $vn }
1839				    &find("view", $conf);
1840		push(@views, $view);
1841		}
1842	return 3 if (!@views);
1843	}
1844else {
1845	# Top-level only
1846	push(@views, undef);
1847	}
1848
1849# Create the zone in all views
1850foreach my $view (@views) {
1851	&create_zone($dir, $conf, $view ? $view->{'index'} : undef);
1852	}
1853
1854return 0;
1855}
1856
1857# create_master_zone(name, &slave-ips, [view], [file], &records)
1858# A convenience function for creating a new master zone, if it doesn't exist
1859# yet. Mainly useful for Virtualmin, to avoid excessive transfer of BIND
1860# configuration data.
1861# Returns 0 on success, 1 if BIND is not setup, 2 if the zone already exists,
1862# or 3 if the view doesn't exist, or 4 if the zone file couldn't be created
1863sub create_master_zone
1864{
1865my ($name, $slaves, $viewname, $file, $records) = @_;
1866my $parent = &get_config_parent();
1867my $conf = $parent->{'members'};
1868my $opts = &find("options", $conf);
1869if (!$opts) {
1870	return 1;
1871	}
1872
1873# Check if exists in the view
1874my @zones;
1875if ($viewname) {
1876	my ($v) = grep { $_->{'value'} eq $viewname } &find("view", $conf);
1877	@zones = &find("zone", $v->{'members'});
1878	}
1879else {
1880	@zones = &find("zone", $conf);
1881	}
1882my ($z) = grep { $_->{'value'} eq $name } @zones;
1883return 2 if ($z);
1884
1885# Create it
1886my $dir = { 'name' => 'zone',
1887               'values' => [ $name ],
1888               'type' => 1,
1889               'members' => [ { 'name' => 'type',
1890                                'values' => [ 'master' ] },
1891                            ]
1892	     };
1893my $base = $config{'master_dir'} || &base_directory();
1894if ($base !~ /^([a-z]:)?\//) {
1895	# Master dir is relative .. make absolute
1896	$base = &base_directory()."/".$base;
1897	}
1898if (!$file) {
1899	# File has default name and is under default directory
1900	$file = &automatic_filename($name, $_[0] =~ /in-addr/i ? 1 : 0, $base,
1901				    $viewname);
1902	}
1903push(@{$dir->{'members'}}, { 'name' => 'file',
1904			     'values' => [ $file ] } );
1905
1906# Add slave IPs
1907if (@$slaves) {
1908	my $also = { 'name' => 'also-notify',
1909		     'type' => 1,
1910		     'members' => [ ] };
1911	my $allow = { 'name' => 'allow-transfer',
1912		      'type' => 1,
1913		      'members' => [ ] };
1914	foreach my $s (@$slaves) {
1915		push(@{$also->{'members'}}, { 'name' => $s });
1916		push(@{$allow->{'members'}}, { 'name' => $s });
1917		}
1918	push(@{$dir->{'members'}}, $also, $allow);
1919	push(@{$dir->{'members'}}, { 'name' => 'notify',
1920				     'values' => [ 'yes' ] });
1921	}
1922
1923# Create the zone file, with records
1924my $ZONE;
1925&open_tempfile($ZONE, ">".&make_chroot($file), 1, 1) || return 4;
1926&close_tempfile($ZONE);
1927&set_ownership(&make_chroot($file));
1928foreach my $r (@$records) {
1929	if ($r->{'defttl'}) {
1930		&create_defttl($file, $r->{'defttl'});
1931		}
1932	elsif ($r->{'generate'}) {
1933		&create_generator($file, @{$r->{'generate'}});
1934		}
1935	elsif ($r->{'type'}) {
1936		&create_record($file, $r->{'name'}, $r->{'ttl'}, $r->{'class'},
1937				      $r->{'type'}, &join_record_values($r),
1938				      $r->{'comment'});
1939		}
1940	}
1941
1942# Get and validate view(s)
1943my @views;
1944if ($viewname) {
1945	foreach my $vn (split(/\s+/, $viewname)) {
1946		my ($view) = grep { $_->{'value'} eq $vn }
1947				    &find("view", $conf);
1948		push(@views, $view);
1949		}
1950	return 3 if (!@views);
1951	}
1952else {
1953	# Top-level only
1954	push(@views, undef);
1955	}
1956
1957# Create the zone in all views
1958foreach my $view (@views) {
1959	&create_zone($dir, $conf, $view ? $view->{'index'} : undef);
1960	}
1961
1962return 0;
1963}
1964
1965# get_master_zone_file(name, [chroot])
1966# Returns the absolute path to a master zone records file
1967sub get_master_zone_file
1968{
1969my ($name, $chroot) = @_;
1970my $conf = &get_config();
1971my @zones = &find("zone", $conf);
1972foreach my $v (&find("view", $conf)) {
1973        push(@zones, &find("zone", $v->{'members'}));
1974        }
1975my ($z) = grep { lc($_->{'value'}) eq lc($name) } @zones;
1976return undef if (!$z);
1977my $file = &find("file", $z->{'members'});
1978return undef if (!$file);
1979my $filename = &absolute_path($file->{'values'}->[0]);
1980$filename = &make_chroot($filename) if ($chroot);
1981return $filename;
1982}
1983
1984# get_master_zone_records(name)
1985# Returns a list of all the records in a master zone, each of which is a hashref
1986sub get_master_zone_records
1987{
1988my ($name) = @_;
1989my $filename = &get_master_zone_file($name, 0);
1990return ( ) if (!$filename);
1991return &read_zone_file($filename, $name);
1992}
1993
1994# save_master_zone_records(name, &records)
1995# Update all the records in the master zone, based on a list of hashrefs
1996sub save_master_zone_records
1997{
1998my ($name, $records) = @_;
1999my $filename = &get_master_zone_file($name, 0);
2000return 0 if (!$filename);
2001my $ZONE;
2002&open_tempfile($ZONE, ">".&make_chroot($filename), 1, 1) || return 0;
2003&close_tempfile($ZONE);
2004foreach my $r (@$records) {
2005	if ($r->{'defttl'}) {
2006		&create_defttl($filename, $r->{'defttl'});
2007		}
2008	elsif ($r->{'generate'}) {
2009		&create_generator($filename, @{$r->{'generate'}});
2010		}
2011	elsif ($r->{'type'}) {
2012		&create_record($filename, $r->{'name'}, $r->{'ttl'},
2013			       $r->{'class'}, $r->{'type'},
2014			       &join_record_values($r), $r->{'comment'});
2015		}
2016	}
2017return 1;
2018}
2019
2020# delete_zone(name, [view], [file-too])
2021# Delete one zone from named.conf
2022# Returns 0 on success, 1 if the zone was not found, or 2 if the view was not
2023# found.
2024sub delete_zone
2025{
2026my $parent = &get_config_parent();
2027my $conf = $parent->{'members'};
2028my @zones;
2029
2030if ($_[1]) {
2031	# Look in one or more views
2032	my $v;
2033	foreach my $vn (split(/\s+/, $_[1])) {
2034		($v) = grep { $_->{'value'} eq $vn }
2035				  &find("view", $conf);
2036		if ($v) {
2037			push(@zones, &find("zone", $v->{'members'}));
2038			}
2039		}
2040	return 2 if (!@zones);
2041	$parent = $v;
2042	}
2043else {
2044	# Look in all views
2045	push(@zones, &find("zone", $conf));
2046	foreach my $v (&find("view", $conf)) {
2047		push(@zones, &find("zone", $v->{'members'}));
2048		}
2049	}
2050
2051# Delete all zones in the list
2052my $found = 0;
2053foreach my $z (grep { $_->{'value'} eq $_[0] } @zones) {
2054	$found++;
2055
2056	# Remove from config file
2057	&lock_file($z->{'file'});
2058	&save_directive($z->{'parent'} || $parent, [ $z ], [ ]);
2059	&unlock_file($z->{'file'});
2060	&flush_file_lines();
2061
2062	if ($_[2]) {
2063		# Remove file
2064		my $f = &find("file", $z->{'members'});
2065		if ($f) {
2066			my $path = &make_chroot(&absolute_path($f->{'value'}));
2067			if (-f $path) {
2068				&unlink_logged($path);
2069				}
2070			}
2071		}
2072	}
2073
2074&flush_zone_names();
2075&flush_dnssec_expired_domains();
2076return $found ? 0 : 1;
2077}
2078
2079# rename_zone(oldname, newname, [view])
2080# Changes the name of some zone, and perhaps it's file
2081# Returns 0 on success, 1 if the zone was not found, or 2 if the view was
2082# not found.
2083sub rename_zone
2084{
2085my $parent = &get_config_parent();
2086my $conf = $parent->{'members'};
2087my @zones;
2088if ($_[2]) {
2089	# Look in one view
2090	my ($v) = grep { $_->{'value'} eq $_[2] } &find("view", $conf);
2091	return 2 if (!$v);
2092	@zones = &find("zone", $v->{'members'});
2093	$parent = $v;
2094	}
2095else {
2096	# Look in all views
2097	@zones = &find("zone", $conf);
2098	foreach my $v (&find("view", $conf)) {
2099		push(@zones, &find("zone", $v->{'members'}));
2100		}
2101	}
2102my ($z) = grep { $_->{'value'} eq $_[0] } @zones;
2103return 1 if (!$z);
2104
2105$z->{'values'} = [ $_[1] ];
2106$z->{'value'} = $_[1];
2107my $file = &find("file", $z->{'members'});
2108if ($file) {
2109	# Update the file too
2110	my $newfile = $file->{'values'}->[0];
2111	$newfile =~ s/$_[0]/$_[1]/g;
2112	if ($newfile ne $file->{'values'}->[0]) {
2113		rename(&make_chroot($file->{'values'}->[0]),
2114		       &make_chroot($newfile));
2115		$file->{'values'}->[0] = $newfile;
2116		$file->{'value'} = $newfile;
2117		}
2118	}
2119
2120&save_directive($parent, [ $z ], [ $z ]);
2121&flush_file_lines();
2122&flush_zone_names();
2123return 0;
2124}
2125
2126# restart_bind()
2127# A convenience function for re-starting BIND. Returns undef on success, or
2128# an error message on failure.
2129sub restart_bind
2130{
2131if ($config{'restart_cmd'} && $config{'restart_cmd'} eq 'restart') {
2132	# Stop and start again
2133	&stop_bind();
2134	sleep(1);	# Systemd doesn't like rapid stops and starts
2135	return &start_bind();
2136	}
2137elsif ($config{'restart_cmd'}) {
2138	# Custom command
2139	my $out = &backquote_logged(
2140		"$config{'restart_cmd'} 2>&1 </dev/null");
2141	if ($?) {
2142		return &text('restart_ecmd', "<pre>$out</pre>");
2143		}
2144	}
2145else {
2146	# Use signal
2147	my $pidfile = &get_pid_file();
2148	my $pid = &check_pid_file(&make_chroot($pidfile, 1));
2149	if (!$pid) {
2150		return &text('restart_epidfile', $pidfile);
2151		}
2152	elsif (!&kill_logged('HUP', $pid)) {
2153		return &text('restart_esig', $pid, $!);
2154		}
2155	}
2156&refresh_nscd();
2157return undef;
2158}
2159
2160# before_editing(&zone)
2161# Must be called before reading a zone file with intent to edit
2162sub before_editing
2163{
2164my ($zone) = @_;
2165if (!$freeze_zone_count{$zone->{'name'}}) {
2166	my ($out, $ok) = &try_cmd(
2167		"freeze ".quotemeta($zone->{'name'})." IN ".
2168		quotemeta($zone->{'view'} || ""));
2169	if ($ok) {
2170		$freeze_zone_count{$zone->{'name'}}++;
2171		&register_error_handler(\&after_editing, $zone);
2172		}
2173	}
2174}
2175
2176# after_editing(&zone)
2177# Must be called after updating a zone file
2178sub after_editing
2179{
2180my ($zone) = @_;
2181if ($freeze_zone_count{$zone->{'name'}}) {
2182	$freeze_zone_count{$zone->{'name'}}--;
2183	&try_cmd("thaw ".quotemeta($zone->{'name'})." IN ".
2184		 quotemeta($zone->{'view'} || ""));
2185	}
2186}
2187
2188# restart_zone(domain, [view])
2189# Call ndc or rndc to apply a single zone. Returns undef on success or an error
2190# message on failure.
2191sub restart_zone
2192{
2193my ($dom, $view) = @_;
2194my ($out, $ex);
2195if ($view) {
2196	# Reload a zone in a view
2197	&try_cmd("freeze ".quotemeta($dom)." IN ".quotemeta($view));
2198	$out = &try_cmd("reload ".quotemeta($dom)." IN ".quotemeta($view));
2199	$ex = $?;
2200	&try_cmd("thaw ".quotemeta($dom)." IN ".quotemeta($view));
2201	}
2202else {
2203	# Just reload one top-level zone
2204	&try_cmd("freeze ".quotemeta($dom));
2205	$out = &try_cmd("reload ".quotemeta($dom));
2206	$ex = $?;
2207	&try_cmd("thaw ".quotemeta($dom));
2208	}
2209if ($out =~ /not found/i) {
2210	# Zone is not known to BIND yet - do a total reload
2211	my $err = &restart_bind();
2212	return $err if ($err);
2213	if ($access{'remote'}) {
2214		# Restart all slaves too
2215		&error_setup();
2216		my @slaveerrs = &restart_on_slaves();
2217		if (@slaveerrs) {
2218			return &text('restart_errslave',
2219			     "<p>".join("<br>",
2220					map { "$_->[0]->{'host'} : $_->[1]" }
2221					    @slaveerrs));
2222			}
2223		}
2224	}
2225elsif ($ex || $out =~ /failed|not found|error/i) {
2226	return &text('restart_endc', "<tt>".&html_escape($out)."</tt>");
2227	}
2228&refresh_nscd();
2229return undef;
2230}
2231
2232# start_bind()
2233# Attempts to start the BIND DNS server, and returns undef on success or an
2234# error message on failure
2235sub start_bind
2236{
2237my $chroot = &get_chroot();
2238my $user = "";
2239my $cmd;
2240if ($config{'named_user'}) {
2241	$user = "-u $config{'named_user'}";
2242	if ($bind_version < 9) {
2243		# Only version 8 takes the -g flag
2244		if ($config{'named_group'}) {
2245			$user .= " -g $config{'named_group'}";
2246			}
2247		else {
2248			my @u = getpwnam($config{'named_user'});
2249			my @g = getgrgid($u[3]);
2250			$user .= " -g $g[0]";
2251			}
2252		}
2253	}
2254if ($config{'start_cmd'}) {
2255	$cmd = $config{'start_cmd'};
2256	}
2257elsif (!$chroot) {
2258	$cmd = "$config{'named_path'} -c $config{'named_conf'} $user </dev/null 2>&1";
2259	}
2260elsif (`$config{'named_path'} -help 2>&1` =~ /\[-t/) {
2261	# use named's chroot option
2262	$cmd = "$config{'named_path'} -c $config{'named_conf'} -t $chroot $user </dev/null 2>&1";
2263	}
2264else {
2265	# use the chroot command
2266	$cmd = "chroot $chroot $config{'named_path'} -c $config{'named_conf'} $user </dev/null 2>&1";
2267	}
2268
2269my $out = &backquote_logged("$cmd 2>&1 </dev/null");
2270my $rv = $?;
2271if ($rv || $out =~ /chroot.*not available/i) {
2272	return &text('start_error', $out ? "<tt>$out</tt>" : "Unknown error");
2273	}
2274return undef;
2275}
2276
2277# stop_bind()
2278# Kills the running DNS server, and returns undef on success or an error message
2279# upon failure
2280sub stop_bind
2281{
2282if ($config{'stop_cmd'}) {
2283	# Just use a command
2284	my $out = &backquote_logged("($config{'stop_cmd'}) 2>&1");
2285	if ($?) {
2286		return "<pre>$out</pre>";
2287		}
2288	}
2289else {
2290	# Kill the process
2291	my $pidfile = &get_pid_file();
2292	my $pid = &check_pid_file(&make_chroot($pidfile, 1));
2293	if (!$pid || !&kill_logged('TERM', $pid)) {
2294		return $text{'stop_epid'};
2295		}
2296	}
2297return undef;
2298}
2299
2300# is_bind_running()
2301# Returns the PID if BIND is running
2302sub is_bind_running
2303{
2304my $pidfile = &get_pid_file();
2305my $rv = &check_pid_file(&make_chroot($pidfile, 1));
2306if (!$rv && $gconfig{'os_type'} eq 'windows') {
2307	# Fall back to checking for process
2308	$rv = &find_byname("named");
2309	}
2310return $rv;
2311}
2312
2313# version_atleast(v1, v2, v3)
2314sub version_atleast
2315{
2316my @vsp = split(/\./, $bind_version);
2317for(my $i=0; $i<@vsp || $i<@_; $i++) {
2318	return 0 if ($vsp[$i] < $_[$i]);
2319	return 1 if ($vsp[$i] > $_[$i]);
2320	}
2321return 1;	# same!
2322}
2323
2324# get_zone_index(name, [view])
2325# Returns the index of some zone in the real on-disk configuration
2326sub get_zone_index
2327{
2328undef(@get_config_cache);
2329my $conf = &get_config();
2330my $vconf = $_[1] ne '' ? $conf->[$in{'view'}]->{'members'} : $conf;
2331foreach my $c (@$vconf) {
2332	if ($c->{'name'} eq 'zone' && $c->{'value'} eq $_[0]) {
2333		return $c->{'index'};
2334		}
2335	}
2336return undef;
2337}
2338
2339# create_zone(&zone, &conf, [view-idx])
2340# Convenience function for adding a new zone
2341sub create_zone
2342{
2343my ($dir, $conf, $viewidx) = @_;
2344if (defined($viewidx) && $viewidx ne "") {
2345	# Adding inside a view
2346	my $view = $conf->[$viewidx];
2347        &lock_file(&make_chroot($view->{'file'}));
2348        &save_directive($view, undef, [ $dir ], 1);
2349        &flush_file_lines();
2350        &unlock_file(&make_chroot($view->{'file'}));
2351	}
2352else {
2353	# Adding at top level
2354        $dir->{'file'} = &add_to_file();
2355        my $pconf = &get_config_parent($dir->{'file'});
2356        &lock_file(&make_chroot($dir->{'file'}));
2357        &save_directive($pconf, undef, [ $dir ], 0);
2358        &flush_file_lines();
2359        &unlock_file(&make_chroot($dir->{'file'}));
2360	}
2361&flush_zone_names();
2362}
2363
2364my $heiropen_file = "$module_config_directory/heiropen";
2365
2366# get_heiropen()
2367# Returns an array of open categories
2368sub get_heiropen
2369{
2370open(my $HEIROPEN, "<", $heiropen_file);
2371my @heiropen = <$HEIROPEN>;
2372chop(@heiropen);
2373close($HEIROPEN);
2374return @heiropen;
2375}
2376
2377# save_heiropen(&heir)
2378sub save_heiropen
2379{
2380my $HEIR;
2381&open_tempfile($HEIR, ">$heiropen_file");
2382foreach my $h (@{$_[0]}) {
2383	&print_tempfile($HEIR, $h,"\n");
2384	}
2385&close_tempfile($HEIR);
2386}
2387
2388# list_zone_names()
2389# Returns a list of zone names, types, files and views based on a cache
2390# built from the primary configuration.
2391sub list_zone_names
2392{
2393my @st = stat($zone_names_cache);
2394my %znc;
2395&read_file_cached($zone_names_cache, \%znc);
2396
2397# Check if any files have changed, or if the master config has changed, or
2398# the PID file.
2399my %files;
2400my ($changed, $filecount, %donefile);
2401foreach my $k (keys %znc) {
2402	if ($k =~ /^file_(.*)$/) {
2403		$filecount++;
2404		$donefile{$1}++;
2405		my @fst = stat($1);
2406		if (!@st || !@fst || $fst[9] > $st[9]) {
2407			$changed = 1;
2408			}
2409		}
2410	}
2411if ($changed || !$znc{'version'} ||
2412    $znc{'version'} != $zone_names_version ||
2413    int($config{'no_chroot'}) != int($znc{'no_chroot_config'}) ||
2414    $config{'pid_file'} ne $znc{'pidfile_config'}) {
2415	# Yes .. need to rebuild
2416	%znc = ( );
2417	my $conf = &get_config();
2418	my @views = &find("view", $conf);
2419	my $n = 0;
2420	foreach my $v (@views) {
2421		my @vz = &find("zone", $v->{'members'});
2422		foreach my $z (@vz) {
2423			my $type = &find_value("type", $z->{'members'});
2424			next if (!$type);
2425			my $file = &find_value("file", $z->{'members'});
2426			$znc{"zone_".($n++)} = join("\t", $z->{'value'},
2427				$z->{'index'}, $type, $v->{'value'}, $file);
2428			$files{$z->{'file'}}++;
2429			}
2430		$znc{"view_".($n++)} = join("\t", $v->{'value'}, $v->{'index'});
2431		$files{$v->{'file'}}++;
2432		}
2433	foreach my $z (&find("zone", $conf)) {
2434		my $type = &find_value("type", $z->{'members'});
2435		next if (!$type);
2436		my $file = &find_value("file", $z->{'members'});
2437		$file ||= "";	# slaves and other types with no file
2438		$znc{"zone_".($n++)} = join("\t", $z->{'value'},
2439			$z->{'index'}, $type, "*", $file);
2440		$files{$z->{'file'}}++;
2441		}
2442
2443	# Store the base directory and PID file
2444	$znc{'base'} = &base_directory($conf, 1);
2445	$znc{'pidfile'} = &get_pid_file(1);
2446	$znc{'pidfile_config'} = $config{'pid_file'};
2447	$znc{'no_chroot_config'} = $config{'no_chroot'};
2448
2449	# Store source files
2450	foreach my $f (keys %files) {
2451		my $realf = &make_chroot(&absolute_path($f));
2452		my @st = stat($realf);
2453		$znc{"file_".$realf} = $st[9];
2454		}
2455
2456	$znc{'version'} = $zone_names_version;
2457	&write_file($zone_names_cache, \%znc);
2458	undef(@list_zone_names_cache);
2459	}
2460
2461# Use in-memory cache
2462if (scalar(@list_zone_names_cache)) {
2463	return @list_zone_names_cache;
2464	}
2465
2466# Construct the return value from the hash
2467my (@rv, %viewidx);
2468foreach my $k (keys %znc) {
2469	if ($k =~ /^zone_(\d+)$/) {
2470		my ($name, $index, $type, $view, $file) =
2471			split(/\t+/, $znc{$k}, 5);
2472		push(@rv, { 'name' => $name,
2473			    'type' => $type,
2474			    'index' => $index,
2475			    'view' => !$view || $view eq '*' ? undef : $view,
2476			    'file' => $file });
2477		}
2478	elsif ($k =~ /^view_(\d+)$/) {
2479		my ($name, $index) = split(/\t+/, $znc{$k}, 2);
2480		push(@rv, { 'name' => $name,
2481			    'index' => $index,
2482			    'type' => 'view' });
2483		$viewidx{$name} = $index;
2484		}
2485	}
2486foreach my $z (@rv) {
2487	if ($z->{'type'} ne 'view' && $z->{'view'} && $z->{'view'} ne '*') {
2488		$z->{'viewindex'} = $viewidx{$z->{'view'}};
2489		}
2490	}
2491@list_zone_names_cache = @rv;
2492return @rv;
2493}
2494
2495# flush_zone_names()
2496# Clears the in-memory and on-disk zone name caches
2497sub flush_zone_names
2498{
2499undef(@list_zone_names_cache);
2500unlink($zone_names_cache);
2501}
2502
2503# get_zone_name(index|name, [viewindex|"any"])
2504# Returns a zone cache object, looked up by name or index
2505sub get_zone_name
2506{
2507my ($key, $viewidx) = @_;
2508$viewidx ||= '';
2509my @zones = &list_zone_names();
2510my $field = $key =~ /^\d+$/ ? "index" : "name";
2511foreach my $z (@zones) {
2512	if ($z->{$field} eq $key &&
2513	    ($viewidx eq 'any' ||
2514	     $viewidx eq '' && !defined($z->{'viewindex'}) ||
2515	     $viewidx ne '' && $z->{'viewindex'} == $_[1])) {
2516		return $z;
2517		}
2518	}
2519return undef;
2520}
2521
2522# get_zone_name_or_error(index|name, [viewindex|"any"])
2523# Looks up a zone by name and view, or calls error
2524sub get_zone_name_or_error
2525{
2526my $zone = &get_zone_name(@_);
2527if (!$zone) {
2528	my $msg = $_[1] eq 'any' ? 'master_egone' :
2529		  $_[1] eq '' ? 'master_egone2' : 'master_egone3';
2530	&error(&text($msg, @_));
2531	}
2532return $zone;
2533}
2534
2535# zone_to_config(&zone)
2536# Given a zone name object, return the config file object for the zone. In an
2537# array context, also returns the main config list and parent object
2538sub zone_to_config
2539{
2540my ($zone) = @_;
2541my $parent = &get_config_parent();
2542my $bconf = &get_config();
2543my $conf = $bconf;
2544if ($zone->{'viewindex'} ne '') {
2545        my $view = $conf->[$zone->{'viewindex'}];
2546        $conf = $view->{'members'};
2547	$parent = $view;
2548        }
2549my $z = $conf->[$zone->{'index'}];
2550return wantarray ? ( $z, $bconf, $parent ) : $z;
2551}
2552
2553# list_slave_servers()
2554# Returns a list of Webmin servers on which slave zones are created / deleted
2555sub list_slave_servers
2556{
2557&foreign_require("servers", "servers-lib.pl");
2558my %ids = map { $_, 1 } split(/\s+/, $config{'servers'} || '');
2559my %secids = map { $_, 1 } split(/\s+/, $config{'secservers'} || '');
2560my @servers = &servers::list_servers();
2561if (%ids) {
2562	my @rv = grep { $ids{$_->{'id'}} } @servers;
2563	foreach my $s (@rv) {
2564		$s->{'sec'} = $secids{$s->{'id'}};
2565		}
2566	return @rv;
2567	}
2568elsif ($config{'default_slave'} && !defined($config{'servers'})) {
2569	# Migrate old-style setting of single slave
2570	my ($serv) = grep { $_->{'host'} eq $config{'default_slave'} }
2571			     @servers;
2572	if ($serv) {
2573		&add_slave_server($serv);
2574		return ($serv);
2575		}
2576	}
2577return ( );
2578}
2579
2580# add_slave_server(&server)
2581sub add_slave_server
2582{
2583&lock_file($module_config_file);
2584&foreign_require("servers", "servers-lib.pl");
2585my @sids = split(/\s+/, $config{'servers'});
2586$config{'servers'} = join(" ", @sids, $_[0]->{'id'});
2587if ($_[0]->{'sec'}) {
2588	my @secsids = split(/\s+/, $config{'secservers'});
2589	$config{'secservers'} = join(" ", @secsids, $_[0]->{'id'});
2590	}
2591&sync_default_slave();
2592&save_module_config();
2593&unlock_file($module_config_file);
2594&servers::save_server($_[0]);
2595}
2596
2597# delete_slave_server(&server)
2598sub delete_slave_server
2599{
2600&lock_file($module_config_file);
2601my @sids = split(/\s+/, $config{'servers'});
2602$config{'servers'} = join(" ", grep { $_ != $_[0]->{'id'} } @sids);
2603my @secsids = split(/\s+/, $config{'secservers'});
2604$config{'secservers'} = join(" ", grep { $_ != $_[0]->{'id'} } @secsids);
2605&sync_default_slave();
2606&save_module_config();
2607&unlock_file($module_config_file);
2608}
2609
2610sub sync_default_slave
2611{
2612my @servers = &list_slave_servers();
2613if (@servers) {
2614	$config{'default_slave'} = $servers[0]->{'host'};
2615	}
2616else {
2617	$config{'default_slave'} = '';
2618	}
2619}
2620
2621# server_name(&server)
2622sub server_name
2623{
2624return $_[0]->{'desc'} ? $_[0]->{'desc'} : $_[0]->{'host'};
2625}
2626
2627# create_master_records(file, zone, master, email, refresh, retry, expiry, min,
2628#			add-master-ns, add-slaves-ns, add-template, tmpl-ip,
2629#			add-template-reverse)
2630# Creates the records file for a new master zone. Returns undef on success, or
2631# an error message on failure.
2632sub create_master_records
2633{
2634my ($file, $zone, $master, $email, $refresh, $retry, $expiry, $min,
2635    $add_master, $add_slaves, $add_tmpl, $ip, $addrev) = @_;
2636
2637# Create the zone file
2638&lock_file(&make_chroot($file));
2639my $ZONE;
2640&open_tempfile($ZONE, ">".&make_chroot($file), 1) ||
2641	return &text('create_efile3', $file, $!);
2642&print_tempfile($ZONE, "\$ttl $min\n")
2643	if ($config{'master_ttl'});
2644&close_tempfile($ZONE);
2645
2646# create the SOA and NS records
2647my $serial;
2648if ($config{'soa_style'} == 1) {
2649        $serial = &date_serial().sprintf("%2.2d", $config{'soa_start'});
2650        }
2651else {
2652	# Use Unix time for date and running number serials
2653        $serial = time();
2654        }
2655my $vals = "$master $email (\n".
2656        "\t\t\t$serial\n".
2657        "\t\t\t$refresh\n".
2658        "\t\t\t$retry\n".
2659        "\t\t\t$expiry\n".
2660        "\t\t\t$min )";
2661&create_record($file, "$zone.", undef, "IN", "SOA", $vals);
2662&create_record($file, "$zone.", undef, "IN", "NS", $master)
2663	if ($add_master);
2664if ($add_slaves) {
2665	foreach my $slave (&list_slave_servers()) {
2666		my @bn = $slave->{'nsname'} ||
2667				gethostbyname($slave->{'host'});
2668		my $full = "$bn[0].";
2669		&create_record($file, "$zone.", undef, "IN", "NS", $full);
2670		}
2671	}
2672
2673if ($add_tmpl) {
2674	# Create template records
2675	my %bumped;
2676	my %hash = ( 'ip' => $ip,
2677			'dom' => $zone );
2678	for(my $i=0; $config{"tmpl_$i"}; $i++) {
2679		my @c = split(/\s+/, $config{"tmpl_$i"}, 3);
2680		my $name = $c[0] eq '.' ? "$zone." : $c[0];
2681		my $fullname = $name =~ /\.$/ ? $name : "$name.$zone.";
2682		my $recip = $c[2] || $ip;
2683		$recip = &substitute_template($recip, \%hash);
2684		&create_record($file, $name, undef, "IN", $c[1], $recip);
2685		if ($addrev && ($c[1] eq "A" || $c[1] eq "AAAA")) {
2686			# Consider adding reverse record
2687			my ($revconf, $revfile, $revrec) =
2688				&find_reverse($recip);
2689			if ($revconf && &can_edit_reverse($revconf) &&
2690			    !$revrec) {
2691				# Yes, add one
2692				my $rname = $c[1] eq "A" ?
2693					&ip_to_arpa($recip) :
2694					&net_to_ip6int($recip);
2695				&lock_file(&make_chroot($revfile));
2696				&create_record($revfile, $rname,
2697					undef, "IN", "PTR", $fullname);
2698				if (!$bumped{$revfile}++) {
2699					my @rrecs = &read_zone_file(
2700						$revfile, $revconf->{'name'});
2701					&bump_soa_record($revfile, \@rrecs);
2702					&sign_dnssec_zone_if_key(
2703						$revconf, \@rrecs);
2704					}
2705				}
2706			}
2707		}
2708	if ($config{'tmpl_include'}) {
2709		# Add whatever is in the template file
2710		my $tmpl = &read_file_contents($config{'tmpl_include'});
2711		$tmpl = &substitute_template($tmpl, \%hash);
2712		my $FILE;
2713		&open_tempfile($FILE, ">>".&make_chroot($file));
2714		&print_tempfile($FILE, $tmpl);
2715		&close_tempfile($FILE);
2716		}
2717	}
2718
2719# If DNSSEC for new zones was requested, sign now
2720my $secerr;
2721if ($config{'tmpl_dnssec'} && &supports_dnssec()) {
2722	# Compute the size
2723	my ($ok, $size) = &compute_dnssec_key_size($config{'tmpl_dnssecalg'},
2724						$config{'tmpl_dnssecsizedef'},
2725						$config{'tmpl_dnssecsize'});
2726	if (!$ok) {
2727		# Error computing size??
2728		$secerr = &text('mcreate_ednssecsize', $size);
2729		}
2730	else {
2731		# Create key and sign, saving any error
2732		my $fake = { 'file' => $file,
2733			        'name' => $zone };
2734		$secerr = &create_dnssec_key($fake, $config{'tmpl_dnssecalg'},
2735					     $size);
2736		if (!$secerr) {
2737			$secerr = &sign_dnssec_zone($fake);
2738			}
2739		}
2740	}
2741
2742&unlock_file(&make_chroot($file));
2743&set_ownership(&make_chroot($file));
2744
2745if ($secerr) {
2746	return &text('mcreate_ednssec', $secerr);
2747	}
2748return undef;
2749}
2750
2751# automatic_filename(domain, is-reverse, base, [viewname])
2752# Returns a filename for a new zone
2753sub automatic_filename
2754{
2755my ($zone, $rev, $base, $viewname) = @_;
2756my ($subs, $format);
2757if ($rev) {
2758	# create filename for reverse zone
2759	$subs = &ip6int_to_net(&arpa_to_ip($zone));
2760	$subs =~ s/\//_/;
2761	$format = $config{'reversezonefilename_format'};
2762	}
2763else {
2764	# create filename for forward zone
2765	$format = $config{'forwardzonefilename_format'};
2766	$subs = $zone;
2767	}
2768if ($viewname) {
2769	$subs .= ".".$viewname;
2770	}
2771$format =~ s/ZONE/$subs/g;
2772return $base."/".$format;
2773}
2774
2775# create_on_slaves(zone, master-ip, file, [&hostnames], [local-view],
2776# 		   [&extra-slave-ips])
2777# Creates the given zone on all configured slave servers, and returns a list
2778# of errors
2779sub create_on_slaves
2780{
2781my ($zone, $master, $file, $hosts, $localview, $moreslaves) = @_;
2782my %on;
2783if ($hosts && !ref($hosts)) {
2784	$hosts = [ split(/\s+/, $hosts) ];
2785	}
2786if ($hosts) {
2787	%on = map { $_, 1 } @$hosts;
2788	}
2789&remote_error_setup(\&slave_error_handler);
2790my @slaveerrs;
2791my @slaves = &list_slave_servers();
2792foreach my $slave (@slaves) {
2793	# Skip if not on list to add to
2794	next if (%on && !$on{$slave->{'host'}} && !$on{$slave->{'nsname'}});
2795
2796	# Connect to server
2797	$slave_error = undef;
2798	&remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2799	if ($slave_error) {
2800		push(@slaveerrs, [ $slave, $slave_error ]);
2801		next;
2802		}
2803
2804	# Work out other slave IPs
2805	my @otherslaves;
2806	if ($config{'other_slaves'}) {
2807		@otherslaves = grep { $_ ne '' }
2808				  map { &to_ipaddress($_->{'host'}) }
2809				      grep { $_ ne $slave } @slaves;
2810		}
2811	if ($config{'extra_slaves'}) {
2812		push(@otherslaves, split(/\s+/, $config{'extra_slaves'}));
2813		}
2814	if ($moreslaves) {
2815		push(@otherslaves, @$moreslaves);
2816		}
2817
2818	# Work out the view
2819	my $view;
2820	if ($slave->{'bind8_view'} eq '*') {
2821		# Same as this system
2822		$view = $localview;
2823		}
2824	elsif ($slave->{'bind8_view'}) {
2825		# Named view
2826		$view = $slave->{'bind8_view'};
2827		}
2828
2829	# Create the zone
2830	my $err = &remote_foreign_call($slave, "bind8",
2831		"create_slave_zone", $zone, $master,
2832		$view, $file, \@otherslaves);
2833	if ($err == 1) {
2834		push(@slaveerrs, [ $slave, $text{'master_esetup'} ]);
2835		}
2836	elsif ($err == 2) {
2837		push(@slaveerrs, [ $slave, $text{'master_etaken'} ]);
2838		}
2839	elsif ($err == 3) {
2840		push(@slaveerrs, [ $slave, &text('master_eview',
2841					 $slave->{'bind8_view'}) ]);
2842		}
2843	}
2844&remote_error_setup();
2845return @slaveerrs;
2846}
2847
2848# delete_on_slaves(domain, [&slave-hostnames], [local-view])
2849# Delete some domain or all or listed slave servers
2850sub delete_on_slaves
2851{
2852my ($dom, $slavehosts, $localview) = @_;
2853my %on = map { $_, 1 } @$slavehosts;
2854&remote_error_setup(\&slave_error_handler);
2855my @slaveerrs;
2856foreach my $slave (&list_slave_servers()) {
2857	next if (%on && !$on{$slave->{'host'}} && !$on{$slave->{'nsname'}});
2858
2859	# Connect to server
2860	$slave_error = undef;
2861	&remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2862	if ($slave_error) {
2863		push(@slaveerrs, [ $slave, $slave_error ]);
2864		next;
2865		}
2866
2867	# Work out the view
2868	my $view;
2869	if ($slave->{'bind8_view'} eq "*") {
2870		# Same as on master .. but for now, don't pass in any view
2871		# so that it will be found automatically
2872		$view = $localview;
2873		}
2874	elsif ($slave->{'bind8_view'}) {
2875		# Named view
2876		$view = $slave->{'bind8_view'};
2877		}
2878
2879	# Delete the zone
2880	my $err = &remote_foreign_call($slave, "bind8", "delete_zone",
2881			    $dom, $view, 1);
2882	if ($err == 1) {
2883		push(@slaveerrs, [ $slave, $text{'delete_ezone'} ]);
2884		}
2885	elsif ($err == 2) {
2886		push(@slaveerrs, [ $slave, &text('master_eview',
2887					 $slave->{'bind8_view'}) ]);
2888		}
2889	}
2890&remote_error_setup();
2891return @slaveerrs;
2892}
2893
2894# rename_on_slaves(olddomain, newdomain, [&slave-hostnames])
2895# Changes the name of some domain on all or listed slave servers
2896sub rename_on_slaves
2897{
2898my ($olddom, $newdom, $on) = @_;
2899my %on = map { $_, 1 } @$on;
2900&remote_error_setup(\&slave_error_handler);
2901my @slaveerrs;
2902foreach my $slave (&list_slave_servers()) {
2903	next if (%on && !$on{$slave->{'host'}} && !$on{$slave->{'nsname'}});
2904
2905	# Connect to server
2906	$slave_error = undef;
2907	&remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2908	if ($slave_error) {
2909		push(@slaveerrs, [ $slave, $slave_error ]);
2910		next;
2911		}
2912
2913	# Delete the zone
2914	my $err = &remote_foreign_call($slave, "bind8", "rename_zone",
2915			    $olddom, $newdom, $slave->{'bind8_view'});
2916	if ($err == 1) {
2917		push(@slaveerrs, [ $slave, $text{'delete_ezone'} ]);
2918		}
2919	elsif ($err == 2) {
2920		push(@slaveerrs, [ $slave, &text('master_eview',
2921					 $slave->{'bind8_view'}) ]);
2922		}
2923	}
2924&remote_error_setup();
2925return @slaveerrs;
2926}
2927
2928# restart_on_slaves([&slave-hostnames])
2929# Re-starts BIND on all or listed slave servers, and returns a list of errors
2930sub restart_on_slaves
2931{
2932my %on = map { $_, 1 } @{$_[0]};
2933&remote_error_setup(\&slave_error_handler);
2934my @slaveerrs;
2935foreach my $slave (&list_slave_servers()) {
2936	next if (%on && !$on{$slave->{'host'}});
2937
2938	# Find the PID file
2939	$slave_error = undef;
2940	&remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2941	if ($slave_error) {
2942		push(@slaveerrs, [ $slave, $slave_error ]);
2943		next;
2944		}
2945	my $sver = &remote_foreign_call($slave, "bind8",
2946				     "get_webmin_version");
2947	my $pidfile;
2948	if ($sver >= 1.140) {
2949		# Call new function to get PID file from slave
2950		$pidfile = &remote_foreign_call(
2951			$slave, "bind8", "get_pid_file");
2952		$pidfile = &remote_foreign_call(
2953			$slave, "bind8", "make_chroot", $pidfile, 1);
2954		}
2955	else {
2956		push(@slaveerrs, [ $slave, &text('restart_eversion',
2957						 $slave->{'host'}, 1.140) ]);
2958		next;
2959		}
2960
2961	# Read the PID and restart
2962	my $pid = &remote_foreign_call($slave, "bind8",
2963				    "check_pid_file", $pidfile);
2964	if (!$pid) {
2965		push(@slaveerrs, [ $slave, &text('restart_erunning2',
2966						 $slave->{'host'}) ]);
2967		next;
2968		}
2969	my $err = &remote_foreign_call($slave, "bind8", "restart_bind");
2970	if ($err) {
2971		push(@slaveerrs, [ $slave, &text('restart_esig2',
2972						 $slave->{'host'}, $err) ]);
2973		}
2974	}
2975&remote_error_setup();
2976return @slaveerrs;
2977}
2978
2979sub slave_error_handler
2980{
2981$slave_error = $_[0];
2982}
2983
2984sub get_forward_record_types
2985{
2986return ("A", "NS", "CNAME", "MX", "HINFO", "TXT", "SPF", "DMARC", "WKS", "RP", "PTR", "LOC", "SRV", "KEY", "TLSA", "SSHFP", "CAA", "NSEC3PARAM", $config{'support_aaaa'} ? ( "AAAA" ) : ( ), @extra_forward);
2987}
2988
2989sub get_reverse_record_types
2990{
2991return ("PTR", "NS", "CNAME", @extra_reverse);
2992}
2993
2994# try_cmd(args, [rndc-args])
2995# Try calling rndc and ndc with the same args, to see which one works
2996sub try_cmd
2997{
2998my ($args, $rndc_args) = @_;
2999$rndc_args ||= $args;
3000my $out = "";
3001my $ex;
3002if (&has_ndc() == 2) {
3003	# Try with rndc
3004	my $conf = $config{'rndc_conf'} && -r $config{'rndc_conf'} ?
3005			" -c $config{'rndc_conf'}" : "";
3006	$out = &backquote_logged(
3007		$config{'rndc_cmd'}.$conf.
3008		" ".$rndc_args." 2>&1 </dev/null");
3009	$ex = $?;
3010	}
3011if (&has_ndc() != 2 || $out && $out =~ /connect\s+failed/i) {
3012	if (&has_ndc(2)) {
3013		# Try with ndc if rndc is not install or failed
3014		$out = &backquote_logged("$config{'ndc_cmd'} $args 2>&1 </dev/null");
3015		$ex = $?;
3016		}
3017	}
3018sleep(1);
3019return wantarray ? ($out, !$ex) : $out;
3020}
3021
3022# supports_check_zone()
3023# Returns 1 if zone checking is supported, 0 if not
3024sub supports_check_zone
3025{
3026return $config{'checkzone'} && &has_command($config{'checkzone'});
3027}
3028
3029# check_zone_records(&zone-name|&zone)
3030# Returns a list of errors from checking some zone file, if any
3031sub check_zone_records
3032{
3033my ($zone) = @_;
3034my ($zonename, $zonefile);
3035if ($zone->{'values'}) {
3036	# Zone object
3037	$zonename = $zone->{'values'}->[0];
3038	my $f = &find("file", $zone->{'members'});
3039	$zonefile = $f->{'values'}->[0];
3040	}
3041else {
3042	# Zone name object
3043	$zonename = $zone->{'name'};
3044	$zonefile = $zone->{'file'};
3045	}
3046my $out = &backquote_command(
3047	$config{'checkzone'}." ".quotemeta($zonename)." ".
3048	quotemeta(&make_chroot(&absolute_path($zonefile)))." 2>&1 </dev/null");
3049return $? ? split(/\r?\n/, $out) : ( );
3050}
3051
3052# supports_check_conf()
3053# Returns 1 if BIND configuration checking is supported, 0 if not
3054sub supports_check_conf
3055{
3056return $config{'checkconf'} && &has_command($config{'checkconf'});
3057}
3058
3059# check_bind_config([filename])
3060# Checks the BIND configuration and returns a list of errors
3061sub check_bind_config
3062{
3063my ($file) = @_;
3064$file ||= &make_chroot($config{'named_conf'});
3065my $chroot = &get_chroot();
3066my $out = &backquote_command("$config{'checkconf'} -h 2>&1 </dev/null");
3067my $zflag = $out =~ /\[-z\]|\[-\S*z\S*\]/ ? "-z" : "";
3068$out = &backquote_command(
3069        $config{'checkconf'}.
3070	($chroot && $chroot ne "/" ? " -t ".quotemeta($chroot) : "").
3071	" $zflag 2>&1 </dev/null");
3072return $? ? &unique(grep { !/loaded\s+serial|already\s+exists/ }
3073		         split(/\r?\n/, $out)) : ( );
3074}
3075
3076# delete_records_file(file)
3077# Given a file (chroot-relative), delete it with locking, and any associated
3078# journal or log files
3079sub delete_records_file
3080{
3081my ($file) = @_;
3082my $zonefile = &make_chroot(&absolute_path($file));
3083&lock_file($zonefile);
3084unlink($zonefile);
3085my $logfile = $zonefile.".log";
3086if (-r $logfile) {
3087	&lock_file($logfile);
3088	unlink($logfile);
3089	}
3090my $jnlfile = $zonefile.".jnl";
3091if (-r $jnlfile) {
3092	&lock_file($jnlfile);
3093	unlink($jnlfile);
3094	}
3095my $signfile = $zonefile.".signed";
3096if (-r $signfile) {
3097	&lock_file($signfile);
3098	unlink($signfile);
3099	}
3100}
3101
3102# move_zone_button(&config, current-view-index, zone-name)
3103# If possible, returns a button row for moving this zone to another view
3104sub move_zone_button
3105{
3106my ($conf, $view, $zonename) = @_;
3107my @views = grep { &can_edit_view($_) } &find("view", $conf);
3108$view = '' if (!defined($view));
3109if ($view eq '' && @views || $view ne '' && @views > 1) {
3110	return &ui_buttons_row("move_zone.cgi",
3111                $text{'master_move'},
3112                $text{'master_movedesc'},
3113                &ui_hidden("zone", $zonename).
3114                &ui_hidden("view", $view),
3115                &ui_select("newview", undef,
3116                        [ map { [ $_->{'index'}, $_->{'value'} ] }
3117                            grep { $_->{'index'} ne $view } @views ]));
3118	}
3119return undef;
3120}
3121
3122# download_root_zone(file)
3123# Download the root zone data to a file (under the chroot), and returns undef
3124# on success or an error message on failure.
3125sub download_root_zone
3126{
3127my ($file) = @_;
3128my $rootfile = &make_chroot($file);
3129my $ftperr;
3130my $temp;
3131# First try by hostname
3132&ftp_download($internic_ftp_host, $internic_ftp_file, $rootfile, \$ftperr);
3133if ($ftperr) {
3134	# Try IP address directly
3135	$ftperr = undef;
3136	&ftp_download($internic_ftp_ip, $internic_ftp_file, $rootfile,\$ftperr);
3137	}
3138if ($ftperr) {
3139	# Try compressed version
3140	$ftperr = undef;
3141	$temp = &transname();
3142	&ftp_download($internic_ftp_host, $internic_ftp_gzip, $temp, \$ftperr);
3143	}
3144if ($ftperr) {
3145	# Try IP address directly for compressed version!
3146	$ftperr = undef;
3147	&ftp_download($internic_ftp_ip, $internic_ftp_gzip, $temp, \$ftperr);
3148	}
3149return $ftperr if ($ftperr);
3150
3151# Got some file .. maybe need to un-compress
3152if ($temp) {
3153	&has_command("gzip") || return $text{'boot_egzip'};
3154	my $out = &backquote_command("gzip -d -c ".quotemeta($temp)." 2>&1 >".
3155				     quotemeta($rootfile)." </dev/null");
3156	return &text('boot_egzip2', "<tt>".&html_escape($out)."</tt>") if ($?);
3157	}
3158return undef;
3159}
3160
3161# restart_links([&zone-name])
3162# Returns HTML for links to restart or start BIND, separated by <br> for use
3163# in ui_print_header
3164sub restart_links
3165{
3166my ($zone) = @_;
3167my @rv;
3168if (!$access{'ro'} && $access{'apply'}) {
3169	my $r = $ENV{'REQUEST_METHOD'} eq 'POST' ? 0 : 1;
3170	my $link_params = "";
3171	if ($zone) {
3172		$link_params = "&zone=$zone->{'name'}&type=$zone->{'type'}";
3173		if ($zone->{'viewindex'}) {
3174			$link_params .= "&view=$zone->{'viewindex'}";
3175			}
3176		}
3177	if (&is_bind_running()) {
3178		if ($zone && ($access{'apply'} == 1 || $access{'apply'} == 2)) {
3179			# Apply this zone
3180		        my $link = "restart_zone.cgi?return=$r&".
3181				   "view=$zone->{'viewindex'}&".
3182				   "zone=$zone->{'name'}";
3183			push(@rv, &ui_link($link, $text{'links_apply'}) );
3184			}
3185		# Apply whole config
3186		if ($access{'apply'} == 1 || $access{'apply'} == 3) {
3187			push(@rv, &ui_link("restart.cgi?return=$r$link_params", $text{'links_restart'}) );
3188			}
3189		if ($access{'apply'} == 1) {
3190			# Stop BIND
3191			push(@rv, &ui_link("stop.cgi?return=$r$link_params", $text{'links_stop'}) );
3192			}
3193		}
3194	elsif ($access{'apply'} == 1) {
3195		# Start BIND
3196		push(@rv, &ui_link("start.cgi?return=$r$link_params", $text{'links_start'}));
3197		}
3198	}
3199return join('<br>', @rv);
3200}
3201
3202# supports_dnssec()
3203# Returns 1 if zone signing is supported
3204sub supports_dnssec
3205{
3206return &has_command($config{'signzone'}) &&
3207       &has_command($config{'keygen'});
3208}
3209
3210# supports_dnssec_client()
3211# Returns 2 if this BIND can send and verify DNSSEC requests, 1 if the
3212# dnssec-validation directive is not supported, 0 otherwise
3213sub supports_dnssec_client
3214{
3215my ($bind_major, $bind_minor) = split(/\./, $bind_version);
3216
3217return $bind_major > 9 ? 2 :
3218       $bind_major == 9 ? ($bind_minor >= 4 ? 2 : 1) : 0;
3219}
3220
3221# dnssec_size_range(algorithm)
3222# Given an algorithm like DSA or DH, return the max and min allowed key sizes,
3223# and an optional forced divisor.
3224sub dnssec_size_range
3225{
3226my ($alg) = @_;
3227return $alg eq 'RSAMD5' || $alg eq 'RSASHA1' ||
3228	$alg eq 'RSASHA256' ? ( 512, 2048 ) :
3229       $alg eq 'DH' ? ( 128, 4096 ) :
3230       $alg eq 'DSA' ? ( 512, 1024, 64 ) :
3231       $alg eq 'HMAC-MD5' ? ( 1, 512 ) :
3232       $alg eq 'NSEC3RSASHA1' ? ( 512, 4096 ) :
3233       $alg eq 'NSEC3DSA' ? ( 512, 1024, 64 ) :
3234       $alg eq 'ECDSAP256SHA256' ? ( 128, 512 ) :
3235       $alg eq 'ECDSAP384SHA384' ? ( 128, 512 ) :
3236       ( );
3237}
3238
3239sub list_dnssec_algorithms
3240{
3241return ("RSASHA1", "RSASHA256", "RSAMD5", "DSA", "DH", "HMAC-MD5",
3242	"NSEC3RSASHA1", "NSEC3DSA", "ECDSAP256SHA256", "ECDSAP384SHA384");
3243}
3244
3245# get_keys_dir(&zone|&zone-name)
3246# Returns the directory in which to find DNSSEC keys for some zone
3247sub get_keys_dir
3248{
3249my ($z) = @_;
3250if ($config{'keys_dir'}) {
3251	return $config{'keys_dir'};
3252	}
3253else {
3254	my $fn = &get_zone_file($z, 2);
3255	$fn =~ s/\/[^\/]+$//;
3256	return $fn;
3257	}
3258}
3259
3260# create_dnssec_key(&zone|&zone-name, algorithm, size, single-key)
3261# Creates a new DNSSEC key for some zone, and places it in the same directory
3262# as the zone file. Returns undef on success or an error message on failure.
3263sub create_dnssec_key
3264{
3265my ($z, $alg, $size, $single) = @_;
3266my $fn = &get_keys_dir($z);
3267$fn || return "Could not work keys directory!";
3268my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3269
3270# Remove all keys for the same zone
3271opendir(ZONEDIR, $fn);
3272foreach my $f (readdir(ZONEDIR)) {
3273	if ($f =~ /^K\Q$dom\E\.\+(\d+)\+(\d+)\.(key|private)$/) {
3274		&unlink_file("$fn/$f");
3275		}
3276	}
3277closedir(ZONEDIR);
3278
3279# Fork a background job to do lots of IO, to generate entropy
3280my $pid;
3281if (!$rand_flag) {
3282	$pid = fork();
3283	if (!$pid) {
3284		exec("find / -type f >/dev/null 2>&1");
3285		exit(1);
3286		}
3287	}
3288
3289# Work out zone key size
3290my $zonesize;
3291if ($single) {
3292	(undef, $zonesize) = &compute_dnssec_key_size($alg, 1);
3293	}
3294else {
3295	$zonesize = $size;
3296	}
3297
3298# Create the zone key
3299my $out = &backquote_logged(
3300	"cd ".quotemeta($fn)." && ".
3301	"$config{'keygen'} -a ".quotemeta($alg)." -b ".quotemeta($zonesize).
3302	" -n ZONE $rand_flag $dom 2>&1");
3303if ($?) {
3304	kill('KILL', $pid) if ($pid);
3305	return $out;
3306	}
3307
3308# Create the key signing key, if needed
3309if (!$single) {
3310	$out = &backquote_logged(
3311		"cd ".quotemeta($fn)." && ".
3312		"$config{'keygen'} -a ".quotemeta($alg)." -b ".quotemeta($size).
3313		" -n ZONE -f KSK $rand_flag $dom 2>&1");
3314	kill('KILL', $pid) if ($pid);
3315	if ($?) {
3316		return $out;
3317		}
3318	}
3319else {
3320	kill('KILL', $pid) if ($pid);
3321	}
3322
3323# Get the new keys
3324my @keys = &get_dnssec_key($z);
3325@keys || return "No new keys found for zone : $out";
3326foreach my $key (@keys) {
3327	ref($key) || return "Failed to get new key for zone : $key";
3328	}
3329if (!$single) {
3330	@keys == 2 || return "Expected 2 keys for zone, but found ".
3331			     scalar(@keys);
3332	}
3333
3334# Add the new DNSKEY record(s) to the zone
3335my $chrootfn = &get_zone_file($z);
3336my @recs = &read_zone_file($chrootfn, $dom);
3337for(my $i=$#recs; $i>=0; $i--) {
3338	if ($recs[$i]->{'type'} eq 'DNSKEY') {
3339		&delete_record($chrootfn, $recs[$i]);
3340		}
3341	}
3342foreach my $key (@keys) {
3343	&create_record($chrootfn, $dom.".", undef, "IN", "DNSKEY",
3344		       join(" ", @{$key->{'values'}}));
3345	&set_ownership($key->{'privatefile'});
3346	&set_ownership($key->{'publicfile'});
3347	}
3348&bump_soa_record($chrootfn, \@recs);
3349
3350return undef;
3351}
3352
3353# resign_dnssec_key(&zone|&zone-name)
3354# Re-generate the zone key, and re-sign everything. Returns undef on success or
3355# an error message on failure.
3356sub resign_dnssec_key
3357{
3358my ($z) = @_;
3359my $fn = &get_zone_file($z);
3360$fn || return "Could not work out records file!";
3361my $dir = &get_keys_dir($z);
3362$dir || return "Could not work out keys directory!";
3363my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3364
3365# Get the old zone key record
3366my @recs = &read_zone_file($fn, $dom);
3367my $zonerec;
3368foreach my $r (@recs) {
3369	if ($r->{'type'} eq 'DNSKEY' && $r->{'values'}->[0] % 2 == 0) {
3370		$zonerec = $r;
3371		}
3372	}
3373$zonerec || return "Could not find DNSSEC zone key record";
3374my @keys = &get_dnssec_key($z);
3375@keys == 2 || return "Expected to find 2 keys, but found ".scalar(@keys);
3376my ($zonekey) = grep { !$_->{'ksk'} } @keys;
3377$zonekey || return "Could not find DNSSEC zone key";
3378
3379# Fork a background job to do lots of IO, to generate entropy
3380my $pid;
3381if (!$rand_flag) {
3382	$pid = fork();
3383	if (!$pid) {
3384		exec("find / -type f >/dev/null 2>&1");
3385		exit(1);
3386		}
3387	}
3388
3389# Work out zone key size
3390my $zonesize;
3391my $alg = $zonekey->{'algorithm'};
3392(undef, $zonesize) = &compute_dnssec_key_size($alg, 1);
3393
3394# Generate a new zone key
3395my $out = &backquote_logged(
3396	"cd ".quotemeta($dir)." && ".
3397	"$config{'keygen'} -a ".quotemeta($alg)." -b ".quotemeta($zonesize).
3398	" -n ZONE $rand_flag $dom 2>&1");
3399kill('KILL', $pid) if ($pid);
3400if ($?) {
3401	return "Failed to generate new zone key : $out";
3402	}
3403
3404# Delete the old key file
3405&unlink_file($zonekey->{'privatefile'});
3406&unlink_file($zonekey->{'publicfile'});
3407
3408# Update the zone file with the new key
3409@keys = &get_dnssec_key($z);
3410my ($newzonekey) = grep { !$_->{'ksk'} } @keys;
3411$newzonekey || return "Could not find new DNSSEC zone key";
3412&modify_record($fn, $zonerec, $dom.".", undef, "IN", "DNSKEY",
3413	       join(" ", @{$newzonekey->{'values'}}));
3414&bump_soa_record($fn, \@recs);
3415&set_ownership($newzonekey->{'privatefile'});
3416&set_ownership($newzonekey->{'publicfile'});
3417
3418# Re-sign everything
3419my $err = &sign_dnssec_zone($z);
3420return "Re-signing failed : $err" if ($err);
3421
3422return undef;
3423}
3424
3425# delete_dnssec_key(&zone|&zone-name)
3426# Deletes the key for a zone, and all DNSSEC records
3427sub delete_dnssec_key
3428{
3429my ($z) = @_;
3430my $fn = &get_zone_file($z);
3431$fn || return "Could not work out records file!";
3432my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3433
3434# Remove the key
3435my @keys = &get_dnssec_key($z);
3436foreach my $key (@keys) {
3437	foreach my $f ('publicfile', 'privatefile') {
3438		&unlink_file($key->{$f}) if (ref($key) && $key->{$f});
3439		}
3440	}
3441
3442# Remove records
3443my @recs = &read_zone_file($fn, $dom);
3444my $tools = &have_dnssec_tools_support();
3445for(my $i=$#recs; $i>=0; $i--) {
3446	if ($recs[$i]->{'type'} eq 'NSEC' ||
3447	    $recs[$i]->{'type'} eq 'NSEC3' ||
3448	    $recs[$i]->{'type'} eq 'RRSIG' ||
3449	    $recs[$i]->{'type'} eq 'NSEC3PARAM' && $tools ||
3450	    $recs[$i]->{'type'} eq 'DNSKEY') {
3451		&delete_record($fn, $recs[$i]);
3452		}
3453	}
3454&bump_soa_record($fn, \@recs);
3455}
3456
3457# sign_dnssec_zone(&zone|&zone-name, [bump-soa])
3458# Replaces a zone's file with one containing signed records.
3459sub sign_dnssec_zone
3460{
3461my ($z, $bump) = @_;
3462my $chrootfn = &get_zone_file($z, 2);
3463$chrootfn || return "Could not work out records file!";
3464my $dir = &get_keys_dir($z);
3465my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3466my $signed = $chrootfn.".webmin-signed";
3467
3468# Up the serial number, if requested
3469my $fn = &get_zone_file($z, 1);
3470$fn =~ /^(.*)\/([^\/]+$)/;
3471my @recs = &read_zone_file($fn, $dom);
3472if ($bump) {
3473	&bump_soa_record($fn, \@recs);
3474	}
3475
3476# Get the zone algorithm
3477my @keys = &get_dnssec_key($z);
3478my ($zonekey) = grep { !$_->{'ksk'} } @keys;
3479my $alg = $zonekey ? $zonekey->{'algorithm'} : "";
3480
3481# Create the signed file. Sometimes this fails with an error like :
3482# task.c:310: REQUIRE(task->references > 0) failed
3483# But re-trying works!?!
3484my $out;
3485my $tries = 0;
3486while($tries++ < 10) {
3487	$out = &backquote_logged(
3488		"cd ".quotemeta($dir)." && ".
3489		"$config{'signzone'} -o ".quotemeta($dom).
3490		($alg =~ /^NSEC3/ ? " -3 -" : "").
3491		" -f ".quotemeta($signed)." ".
3492		quotemeta($chrootfn)." 2>&1");
3493	last if (!$?);
3494	if ($out =~ /out\s+of\s+range/i) {
3495		# Journal files are out of sync
3496		&try_cmd("sync -clean");
3497		}
3498	}
3499return $out if ($tries >= 10);
3500
3501# Merge records back into original file, by deleting all NSEC and RRSIG records
3502# and then copying over
3503my @delrecs;
3504foreach my $r (@recs) {
3505	if ($r->{'type'} eq 'NSEC' ||
3506	    $r->{'type'} eq 'NSEC3' ||
3507	    $r->{'type'} eq 'RRSIG' ||
3508	    $r->{'type'} eq 'NSEC3PARAM') {
3509		push(@delrecs, $r);
3510		}
3511	}
3512&delete_multiple_records($fn, \@delrecs);
3513my @signedrecs = &read_zone_file($fn.".webmin-signed", $dom);
3514my @addrecs;
3515foreach my $r (@signedrecs) {
3516	if ($r->{'type'} eq 'NSEC' ||
3517	    $r->{'type'} eq 'NSEC3' ||
3518	    $r->{'type'} eq 'RRSIG' ||
3519	    $r->{'type'} eq 'NSEC3PARAM') {
3520		push(@addrecs, $r);
3521		}
3522	}
3523&create_multiple_records($fn, \@addrecs);
3524&unlink_file($signed);
3525return undef;
3526}
3527
3528# check_if_dnssec_tools_managed(&domain)
3529# Check if the given domain is managed by dnssec-tools
3530# Return 1 if yes, undef if not
3531sub check_if_dnssec_tools_managed
3532{
3533	my ($dom) = @_;
3534	my $dt_managed;
3535
3536	if (&have_dnssec_tools_support()) {
3537		my $rrr;
3538
3539		&lock_file($config{"dnssectools_rollrec"});
3540		rollrec_lock();
3541		rollrec_read($config{"dnssectools_rollrec"});
3542		$rrr = rollrec_fullrec($dom);
3543		if ($rrr) {
3544			$dt_managed = 1;
3545		}
3546		rollrec_close();
3547		rollrec_unlock();
3548		&unlock_file($config{"dnssectools_rollrec"});
3549	}
3550
3551	return $dt_managed;
3552}
3553
3554# sign_dnssec_zone_if_key(&zone|&zone-name, &recs, [bump-soa])
3555# If a zone has a DNSSEC key, sign it. Calls error if signing fails
3556sub sign_dnssec_zone_if_key
3557{
3558my ($z, $recs, $bump) = @_;
3559
3560# Check if zones are managed by dnssec-tools
3561my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3562
3563# If zone is managed through dnssec-tools use zonesigner for resigning the zone
3564if (&check_if_dnssec_tools_managed($dom)) {
3565	# Do the signing
3566	my $zonefile = &get_zone_file($z);
3567	my $krfile = "$zonefile".".krf";
3568
3569	&lock_file(&make_chroot($zonefile));
3570	my $err = &dt_resign_zone($dom, $zonefile, $krfile, 0);
3571	&unlock_file(&make_chroot($zonefile));
3572	&error($err) if ($err);
3573	return undef;
3574	}
3575
3576my $keyrec = &get_dnskey_record($z, $recs);
3577if ($keyrec) {
3578	my $err = &sign_dnssec_zone($z, $bump);
3579	&error(&text('sign_emsg', $err)) if ($err);
3580	}
3581}
3582
3583# get_dnssec_key(&zone|&zone-name)
3584# Returns a list of hashes containing details of a zone's keys, or an error
3585# message. The KSK is always returned first.
3586sub get_dnssec_key
3587{
3588my ($z) = @_;
3589my $dir = &get_keys_dir($z);
3590my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3591my %keymap;
3592opendir(ZONEDIR, $dir);
3593foreach my $f (readdir(ZONEDIR)) {
3594	if ($f =~ /^K\Q$dom\E\.\+(\d+)\+(\d+)\.key$/) {
3595		# Found the public key file .. read it
3596		$keymap{$2} ||= { };
3597		my $rv = $keymap{$2};
3598		$rv->{'publicfile'} = "$dir/$f";
3599		$rv->{'algorithmid'} = $1;
3600		$rv->{'keyid'} = $2;
3601		$config{'short_names'} = 0;	# Force canonicalization
3602		my ($pub) = &read_zone_file("$dir/$f", $dom, undef, 0, 1);
3603		$pub || return "Public key file $dir/$f does not contain ".
3604			       "any records";
3605		$pub->{'name'} eq $dom."." ||
3606			return "Public key file $dir/$f is not for zone $dom";
3607		$pub->{'type'} eq "DNSKEY" ||
3608			return "Public key file $dir/$f does not contain ".
3609			       "a DNSKEY record";
3610		$rv->{'ksk'} = $pub->{'values'}->[0] % 2 ? 1 : 0;
3611		$rv->{'public'} = $pub->{'values'}->[3];
3612		$rv->{'values'} = $pub->{'values'};
3613		$rv->{'publictext'} = &read_file_contents("$dir/$f");
3614		while($rv->{'publictext'} =~ s/^;.*\r?\n//) { };
3615		$rv->{'publictext'} = format_dnssec_public_key($rv->{'publictext'});
3616		}
3617	elsif ($f =~ /^K\Q$dom\E\.\+(\d+)\+(\d+)\.private$/) {
3618		# Found the private key file
3619		$keymap{$2} ||= { };
3620		my $rv = $keymap{$2};
3621		$rv->{'privatefile'} = "$dir/$f";
3622		my $lref = &read_file_lines("$dir/$f", 1);
3623		foreach my $l (@$lref) {
3624			if ($l =~ /^(\S+):\s*(.*)/) {
3625				my ($n, $v) = ($1, $2);
3626				$n =~ s/\(\S+\)$//;
3627				$n = lc($n);
3628				$rv->{$n} = $v;
3629				}
3630			}
3631		$rv->{'algorithm'} =~ s/^\d+\s+\((\S+)\)$/$1/;
3632		$rv->{'privatetext'} = join("\n", @$lref)."\n";
3633		while($rv->{'privatetext'} =~ s/^;.*\r?\n//) { }
3634		}
3635	}
3636closedir(ZONEDIR);
3637
3638# Sort to put KSK first
3639my @rv = values %keymap;
3640@rv = sort { $b->{'ksk'} <=> $a->{'ksk'} } @rv;
3641return wantarray ? @rv : $rv[0];
3642}
3643
3644# compute_dnssec_key_size(algorithm, def-mode, size)
3645# Given an algorith and size mode (0=entered, 1=average, 2=big), returns either
3646# 0 and an error message or 1 and the corrected size
3647sub compute_dnssec_key_size
3648{
3649my ($alg, $def, $size) = @_;
3650my ($min, $max, $factor) = &dnssec_size_range($alg);
3651my $rv;
3652if ($def == 1) {
3653	# Average
3654	$rv = int(($max + $min) / 2);
3655	if ($factor) {
3656		$rv = int($rv / $factor) * $factor;
3657		}
3658	}
3659elsif ($def == 2) {
3660	# Max allowed
3661	$rv = $max;
3662	}
3663else {
3664	$size =~ /^\d+$/ && $size >= $min && $size <= $max ||
3665		return (0, &text('zonekey_esize', $min, $max));
3666	if ($factor && $size % $factor) {
3667		return (0, &text('zonekey_efactor', $factor));
3668		}
3669	$rv = $size;
3670	}
3671return (1, $rv);
3672}
3673
3674# get_dnssec_cron_job()
3675# Returns the cron job object for re-signing DNSSEC domains
3676sub get_dnssec_cron_job
3677{
3678&foreign_require("cron", "cron-lib.pl");
3679my ($job) = grep { $_->{'user'} eq 'root' &&
3680		      $_->{'command'} =~ /^\Q$dnssec_cron_cmd\E/ }
3681		    &cron::list_cron_jobs();
3682return $job;
3683}
3684
3685# refresh_nscd()
3686# Signal nscd to re-read cached DNS info
3687sub refresh_nscd
3688{
3689if (&find_byname("nscd")) {
3690	if (&has_command("nscd")) {
3691		# Use nscd -i to reload
3692		&system_logged("nscd -i hosts >/dev/null 2>&1 </dev/null");
3693		}
3694	else {
3695		# Send HUP signal
3696		&kill_byname_logged("nscd", "HUP");
3697		}
3698	}
3699}
3700
3701# transfer_slave_records(zone, &masters, [file], [source-ip, [source-port]])
3702# Transfer DNS records from a master into some file. Returns a map from master
3703# IPs to errors.
3704sub transfer_slave_records
3705{
3706my ($dom, $masters, $file, $source, $sourceport) = @_;
3707my $sourcearg;
3708if ($source && $source ne "*") {
3709	$sourcearg = "-t ".$source;
3710	if ($sourceport) {
3711		$sourcearg .= "#".$sourceport;
3712		}
3713	}
3714my %rv;
3715my $dig = &has_command("dig");
3716foreach my $ip (@$masters) {
3717	if (!$dig) {
3718		$rv{$ip} = "Missing dig command";
3719		}
3720	else {
3721		my $out = &backquote_logged(
3722			"$dig IN $sourcearg AXFR ".quotemeta($dom).
3723			" \@".quotemeta($ip)." 2>&1");
3724		if ($? || $out =~ /Transfer\s+failed/) {
3725			$rv{$ip} = $out;
3726			}
3727		elsif (!$out) {
3728			$rv{$ip} = "No records transferred";
3729			}
3730		else {
3731			if ($file) {
3732				my $XFER;
3733				&open_tempfile($XFER, ">$file");
3734				&print_tempfile($XFER, $out);
3735				&close_tempfile($XFER);
3736				$file = undef;
3737				}
3738			}
3739		}
3740	}
3741return \%rv;
3742}
3743
3744sub get_dnssectools_config
3745{
3746	&lock_file($config{'dnssectools_conf'});
3747	my $lref = &read_file_lines($config{'dnssectools_conf'});
3748	my @rv;
3749	my $lnum = 0;
3750	foreach my $line (@$lref) {
3751		my ($n, $v) = split(/\s+/, $line, 2);
3752		# Do basic sanity checking
3753		$v =~ /(\S+)/;
3754		$v = $1;
3755		if ($n) {
3756			push(@rv, { 'name' => $n, 'value' => $v, 'line' => $lnum });
3757		}
3758		$lnum++;
3759	}
3760	&flush_file_lines();
3761	&unlock_file($config{'dnssectools_conf'});
3762	return \@rv;
3763}
3764
3765# save_dnssectools_directive(&config, name, value)
3766# Save new dnssec-tools configuration values to the configuration file
3767sub save_dnssectools_directive
3768{
3769	my $conf = $_[0];
3770	my $nv = $_[1];
3771
3772	&lock_file($config{'dnssectools_conf'});
3773	my $lref = &read_file_lines($config{'dnssectools_conf'});
3774
3775	foreach my $n (keys %$nv) {
3776		my $old = &find($n, $conf);
3777		if ($old) {
3778			$lref->[$old->{'line'}] = "$n $$nv{$n}";
3779		}
3780		else {
3781		 	push(@$lref, "$n $$nv{$n}");
3782		}
3783	}
3784
3785	&flush_file_lines();
3786	&unlock_file($config{'dnssectools_conf'});
3787}
3788
3789# list_dnssec_dne()
3790# return a list containing the two DNSSEC mechanisms used for
3791# proving non-existance
3792sub list_dnssec_dne
3793{
3794	return ("NSEC", "NSEC3");
3795}
3796
3797# list_dnssec_dshash()
3798# return a list containing the different DS record hash types
3799sub list_dnssec_dshash
3800{
3801	return ("SHA1", "SHA256");
3802}
3803
3804# schedule_dnssec_cronjob()
3805# schedule a cron job to handle periodic resign operations
3806sub schedule_dnssec_cronjob
3807{
3808	my $job;
3809	my $period = $config{'dnssec_period'} || 21;
3810
3811	# Create or delete the cron job
3812	$job = &get_dnssec_cron_job();
3813	if (!$job) {
3814		# Turn on cron job
3815		$job = {'user' => 'root',
3816			'active' => 1,
3817			'command' => $dnssec_cron_cmd,
3818			'mins' => int(rand()*60),
3819			'hours' => '*',
3820			'days' => '*',
3821			'months' => '*',
3822			'weekdays' => '*' };
3823
3824		&lock_file(&cron::cron_file($job));
3825		&cron::create_cron_job($job);
3826		&unlock_file(&cron::cron_file($job));
3827	}
3828
3829
3830	&cron::create_wrapper($dnssec_cron_cmd, $module_name, "resign.pl");
3831
3832	&lock_file($module_config_file);
3833	$config{'dnssec_period'} = $in{'period'};
3834	&save_module_config();
3835	&unlock_file($module_config_file);
3836}
3837
3838# dt_sign_zone(zone, nsec3)
3839# Replaces a zone's file with one containing signed records.
3840sub dt_sign_zone
3841{
3842	my ($zone, $nsec3) = @_;
3843	my @recs;
3844
3845	my $z = &get_zone_file($zone);
3846	my $d = $zone->{'name'};
3847	my $z_chroot = &make_chroot($z);
3848	my $k_chroot = $z_chroot.".krf";
3849	my $usz = $z_chroot.".webmin-unsigned";
3850	my $cmd;
3851	my $out;
3852	my ($nsec3param, $zonesigner);
3853
3854	if ((($zonesigner=dt_cmdpath('zonesigner')) eq '')) {
3855		return $text{'dt_zone_enocmd'};
3856	}
3857	if ($nsec3 == 1) {
3858		$nsec3param = " -usensec3 -nsec3optout ";
3859	} else {
3860		$nsec3param = "";
3861	}
3862
3863	&lock_file($z_chroot);
3864
3865	rollrec_lock();
3866
3867	# Remove DNSSEC records and save the unsigned zone file
3868	@recs = &read_zone_file($z, $d);
3869	my $tools = &have_dnssec_tools_support();
3870	for(my $i=$#recs; $i>=0; $i--) {
3871		if ($recs[$i]->{'type'} eq 'NSEC' ||
3872			$recs[$i]->{'type'} eq 'NSEC3' ||
3873			$recs[$i]->{'type'} eq 'NSEC3PARAM' && $tools ||
3874			$recs[$i]->{'type'} eq 'RRSIG' ||
3875			$recs[$i]->{'type'} eq 'DNSKEY') {
3876				&delete_record($z, $recs[$i]);
3877		}
3878	}
3879	&copy_source_dest($z_chroot, $usz);
3880
3881	$cmd = "$zonesigner $nsec3param".
3882				" -genkeys ".
3883				" -kskdirectory ".quotemeta($config{"dnssectools_keydir"}).
3884				" -zskdirectory ".quotemeta($config{"dnssectools_keydir"}).
3885				" -dsdir ".quotemeta($config{"dnssectools_keydir"}).
3886				" -zone ".quotemeta($d).
3887				" -krfile ".quotemeta($k_chroot).
3888				" ".quotemeta($usz)." ".quotemeta($z_chroot);
3889
3890	$out = &backquote_logged("$cmd 2>&1");
3891
3892	if ($?) {
3893		rollrec_unlock();
3894		&unlock_file($z_chroot);
3895		return $out;
3896	}
3897
3898	# Create rollrec entry for zone
3899	my $rrfile = $config{"dnssectools_rollrec"};
3900	&lock_file($rrfile);
3901	open(my $OUT, ">>", "$rrfile") || &error($text{'dt_zone_errfopen'});
3902	print $OUT "roll \"$d\"\n";
3903	print $OUT " zonename    \"$d\"\n";
3904	print $OUT " zonefile    \"$z_chroot\"\n";
3905	print $OUT " keyrec      \"$k_chroot\"\n";
3906	print $OUT " kskphase    \"0\"\n";
3907	print $OUT " zskphase    \"0\"\n";
3908	print $OUT " ksk_rolldate    \" \"\n";
3909	print $OUT " ksk_rollsecs    \"0\"\n";
3910	print $OUT " zsk_rolldate    \" \"\n";
3911	print $OUT " zsk_rollsecs    \"0\"\n";
3912	print $OUT " maxttl      \"0\"\n";
3913	print $OUT " phasestart  \"new\"\n";
3914	&unlock_file($rrfile);
3915
3916	# Setup zone to be auto-resigned every 30 days
3917	&schedule_dnssec_cronjob();
3918
3919	rollrec_unlock();
3920	&unlock_file($z_chroot);
3921
3922	&dt_rollerd_restart();
3923	&restart_bind();
3924	return undef;
3925}
3926
3927# dt_resign_zone(zone-name, zonefile, krfile, threshold)
3928# Replaces a zone's file with one containing signed records.
3929sub dt_resign_zone
3930{
3931	my ($d, $z, $k, $t) = @_;
3932
3933	my $zonesigner;
3934	my @recs;
3935	my $cmd;
3936	my $out;
3937	my $threshold = "";
3938	my $z_chroot = &make_chroot($z);
3939	my $usz = $z_chroot.".webmin-unsigned";
3940
3941	if ((($zonesigner=dt_cmdpath('zonesigner')) eq '')) {
3942		return $text{'dt_zone_enocmd'};
3943	}
3944
3945	rollrec_lock();
3946
3947	# Remove DNSSEC records and save the unsigned zone file
3948	@recs = &read_zone_file($z, $d);
3949	my $tools = &have_dnssec_tools_support();
3950	for(my $i=$#recs; $i>=0; $i--) {
3951		if ($recs[$i]->{'type'} eq 'NSEC' ||
3952			$recs[$i]->{'type'} eq 'NSEC3' ||
3953			$recs[$i]->{'type'} eq 'NSEC3PARAM' && $tools ||
3954			$recs[$i]->{'type'} eq 'RRSIG' ||
3955			$recs[$i]->{'type'} eq 'DNSKEY') {
3956				&delete_record($z, $recs[$i]);
3957		}
3958	}
3959	&copy_source_dest($z_chroot, $usz);
3960
3961	if ($t > 0) {
3962		$threshold = "-threshold ".quotemeta("-$t"."d"." ");
3963	}
3964
3965	$cmd = "$zonesigner -verbose -verbose".
3966		" -kskdirectory ".quotemeta($config{"dnssectools_keydir"}).
3967		" -zskdirectory ".quotemeta($config{"dnssectools_keydir"}).
3968		" -dsdir ".quotemeta($config{"dnssectools_keydir"}).
3969		" -zone ".quotemeta($d).
3970		" -krfile ".quotemeta(&make_chroot($k)).
3971		" ".$threshold.
3972		" ".quotemeta($usz)." ".quotemeta($z_chroot);
3973	$out = &backquote_logged("$cmd 2>&1");
3974
3975	rollrec_unlock();
3976
3977	return $out if ($?);
3978
3979	&restart_zone($d);
3980
3981	return undef;
3982}
3983
3984# dt_zskroll_zone(zone-name)
3985# Initates a zsk rollover operation for the zone
3986sub dt_zskroll_zone
3987{
3988	my ($d) = @_;
3989	no strict "subs";
3990	if (!rollmgr_sendcmd(CHANNEL_WAIT,ROLLCMD_ROLLZSK,$d)) {
3991		return $text{'dt_zone_erollctl'};
3992	}
3993	use strict "subs";
3994	return undef;
3995}
3996
3997# dt_kskroll_zone(zone-name)
3998# Initates a ksk rollover operation for the zone
3999sub dt_kskroll_zone
4000{
4001	my ($d) = @_;
4002	no strict "subs";
4003	if (!rollmgr_sendcmd(CHANNEL_WAIT,ROLLCMD_ROLLKSK,$d)) {
4004		return $text{'dt_zone_erollctl'};
4005	}
4006	use strict "subs";
4007	return undef;
4008}
4009
4010# dt_notify_parentzone(zone-name)
4011# Notifies rollerd that the new DS record has been published in the parent zone
4012sub dt_notify_parentzone
4013{
4014	my ($d) = @_;
4015	no strict "subs";
4016	if (!rollmgr_sendcmd(CHANNEL_WAIT,ROLLCMD_DSPUB,$d)) {
4017		return $text{'dt_zone_erollctl'};
4018	}
4019	use strict "subs";
4020	return undef;
4021}
4022
4023# dt_rollerd_restart()
4024# Restart the rollerd daemon
4025sub dt_rollerd_restart
4026{
4027	my $rollerd;
4028	my $r;
4029	my $cmd;
4030	my $out;
4031
4032	if ((($rollerd=dt_cmdpath('rollerd')) eq '')) {
4033		return $text{'dt_zone_enocmd'};
4034	}
4035	rollmgr_halt();
4036	$r = $config{"dnssectools_rollrec"};
4037	$cmd = "$rollerd -rrfile ".quotemeta($r);
4038	&execute_command($cmd);
4039	return undef;
4040}
4041
4042# dt_genkrf()
4043# Generate a new krf file for the zone
4044sub dt_genkrf
4045{
4046	my ($zone, $z_chroot, $k_chroot) = @_;
4047	my $dom = $zone->{'name'};
4048	my @keys = &get_dnssec_key($zone);
4049	my $usz = $z_chroot.".webmin-unsigned";
4050	my $zskcur = "";
4051	my $kskcur = "";
4052	my $cmd;
4053	my $out;
4054
4055	my $oldkeydir = &get_keys_dir($zone);
4056	my $keydir = $config{"dnssectools_keydir"};
4057	mkdir($keydir);
4058
4059	foreach my $key (@keys) {
4060		foreach my $f ('publicfile', 'privatefile') {
4061			# Identify if this is a zsk or a ksk
4062			$key->{$f} =~ /(K\Q$dom\E\.\+\d+\+\d+)/;
4063			if ($key->{'ksk'}) {
4064				$kskcur = $1;
4065			} else {
4066				$zskcur = $1;
4067			}
4068			&copy_source_dest($key->{$f}, $keydir);
4069			&unlink_file($key->{$f});
4070		}
4071	}
4072
4073	if (($zskcur eq "") || ($kskcur eq "")) {
4074		return &text('dt_zone_enokey', $dom);
4075	}
4076
4077	# Remove the older dsset file
4078	if ($oldkeydir) {
4079		&unlink_file($oldkeydir."/"."dsset-".$dom.".");
4080	}
4081
4082	my $genkrf;
4083	if ((($genkrf=dt_cmdpath('genkrf')) eq '')) {
4084		return $text{'dt_zone_enocmd'};
4085	}
4086	$cmd = "$genkrf".
4087				" -zone ".quotemeta($dom).
4088				" -krfile ".quotemeta($k_chroot).
4089				" -zskcur=".quotemeta($zskcur).
4090				" -kskcur=".quotemeta($kskcur).
4091				" -zskdir ".quotemeta($keydir).
4092				" -kskdir ".quotemeta($keydir).
4093				" ".quotemeta($usz)." ".quotemeta($z_chroot);
4094
4095	$out = &backquote_logged("$cmd 2>&1");
4096
4097	return $out if ($?);
4098	return undef;
4099}
4100
4101
4102# dt_delete_dnssec_state()
4103# Delete all DNSSEC-Tools meta-data for a given zone
4104sub dt_delete_dnssec_state
4105{
4106	my ($zone) = @_;
4107
4108	my $z = &get_zone_file($zone);
4109	my $dom = $zone->{'members'} ? $zone->{'values'}->[0] : $zone->{'name'};
4110	my $z_chroot = &make_chroot($z);
4111	my $k_chroot = $z_chroot.".krf";
4112	my $usz = $z_chroot.".webmin-unsigned";
4113	my @recs;
4114
4115	if (&check_if_dnssec_tools_managed($dom)) {
4116		rollrec_lock();
4117
4118		#remove entry from rollrec file
4119		&lock_file($config{"dnssectools_rollrec"});
4120		rollrec_read($config{"dnssectools_rollrec"});
4121		rollrec_del($dom);
4122		rollrec_close();
4123		&unlock_file($config{"dnssectools_rollrec"});
4124
4125		&lock_file($z_chroot);
4126
4127		# remove key and krf files
4128		keyrec_read($k_chroot);
4129		my @kskpaths = keyrec_keypaths($dom, "all");
4130		foreach (@kskpaths) {
4131			# remove any trailing ".key"
4132			s/(.*).key$/$1/;
4133			&unlink_file("$_.key");
4134			&unlink_file("$_.private");
4135		}
4136		keyrec_close();
4137		&unlink_file($k_chroot);
4138		&unlink_file($usz);
4139
4140		# Delete dsset
4141		&unlink_file($config{"dnssectools_keydir"}."/"."dsset-".$dom.".");
4142
4143		# remove DNSSEC records from zonefile
4144		@recs = &read_zone_file($z, $dom);
4145		my $tools = &have_dnssec_tools_support();
4146		for(my $i=$#recs; $i>=0; $i--) {
4147			if ($recs[$i]->{'type'} eq 'NSEC' ||
4148				$recs[$i]->{'type'} eq 'NSEC3' ||
4149				$recs[$i]->{'type'} eq 'NSEC3PARAM' && $tools ||
4150				$recs[$i]->{'type'} eq 'RRSIG' ||
4151				$recs[$i]->{'type'} eq 'DNSKEY') {
4152			   	    &delete_record($z, $recs[$i]);
4153			}
4154		}
4155		&bump_soa_record($z, \@recs);
4156
4157		&unlock_file($z_chroot);
4158		rollrec_unlock();
4159
4160		&dt_rollerd_restart();
4161		&restart_bind();
4162	}
4163
4164	return undef;
4165}
4166
4167# get_ds_record(&zone|&zone-name)
4168# Returns the text of a DS record for this zone
4169sub get_ds_record
4170{
4171my ($zone) = @_;
4172my $zonefile;
4173my $dom;
4174if ($zone->{'values'}) {
4175	# Zone object
4176	my $f = &find("file", $zone->{'members'});
4177	$zonefile = $f->{'values'}->[0];
4178	$dom = $zone->{'values'}->[0];
4179	}
4180else {
4181	# Zone name object
4182	$zonefile = $zone->{'file'};
4183	$dom = $zone->{'name'};
4184	}
4185if (&has_command("dnssec-dsfromkey")) {
4186	# Generate with a command
4187	my $out = &backquote_command("dnssec-dsfromkey -f ".quotemeta(&make_chroot(&absolute_path($zonefile)))." ".quotemeta($dom)." 2>/dev/null");
4188	return undef if ($?);
4189	$out =~ s/\r|\n//g;
4190	return $out;
4191	}
4192else {
4193	# From dsset- file
4194	my $keydir = &get_keys_dir($zone);
4195	my $out = &read_file_contents($keydir."/dsset-".$dom.".");
4196	$out =~ s/\r|\n$//g;
4197	return $out;
4198	}
4199}
4200
4201# check_dnssec_client()
4202# If the DNSSEC client config is invalid, return a warning message
4203sub check_dnssec_client
4204{
4205my $conf = &get_config();
4206my $options = &find("options", $conf);
4207my $mems = $options ? $options->{'members'} : [ ];
4208my $en = &find_value("dnssec-enable", $mems);
4209return undef if (!$en || $en !~ /yes/i);
4210my $tkeys = &find("trusted-keys", $conf);
4211return undef if (!$tkeys || !@{$tkeys->{'members'}});
4212return &text('trusted_warning',
4213	     $gconfig{'webprefix'}.'/bind8/conf_trusted.cgi')."<p>\n".
4214       &ui_form_start($gconfig{'webprefix'}.'/bind8/fix_trusted.cgi')."\n".
4215       &ui_form_end([ [ undef, $text{'trusted_fix'} ] ]);
4216}
4217
4218# list_dnssec_expired_domains()
4219# Returns a list of all DNS zones with DNSSEC enabled that are close to expiry
4220sub list_dnssec_expired_domains
4221{
4222my @rv;
4223my %cache;
4224&read_file($dnssec_expiry_cache, \%cache);
4225my $changed = 0;
4226foreach my $z (&list_zone_names()) {
4227	next if ($z->{'type'} ne 'master');
4228	my ($t, $e);
4229	if ($cache{$z->{'name'}}) {
4230		($t, $e) = split(/\s+/, $cache{$z->{'name'}});
4231		}
4232	my @st = stat(&make_chroot($z->{'file'}));
4233	next if (!@st);
4234	if (!defined($t) || $st[9] != $t) {
4235		# Not in cache, or file has changed
4236		my @recs = &read_zone_file($z->{'file'}, $z->{'name'});
4237		$changed = 1;
4238		$e = 0;
4239		foreach my $r (@recs) {
4240			next if ($r->{'type'} ne 'RRSIG');
4241			next if ($r->{'values'}->[4] !~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/);
4242			eval {
4243				$e = timegm($6, $5, $4, $3, $2-1, $1-1900);
4244				};
4245			last if ($e);
4246			}
4247		$cache{$z->{'name'}} = "$st[9] $e";
4248		}
4249	if ($e && time() > $e - 86400) {
4250		# Expires within 1 day
4251		my $rvz = { %$z };
4252		$rvz->{'expiry'} = $e;
4253		push(@rv, $rvz);
4254		}
4255	}
4256if ($changed) {
4257	&write_file($dnssec_expiry_cache, \%cache);
4258	}
4259return @rv;
4260}
4261
4262# flush_dnssec_expired_domains()
4263# Clear the cache of DNSSEC expiry times
4264sub flush_dnssec_expired_domains
4265{
4266&unlink_file($dnssec_expiry_cache);
4267}
4268
4269# get_virtualmin_domains(name)
4270# Returns the Virtualmin domain objects for this zone, if any
4271sub get_virtualmin_domains
4272{
4273my ($name) = @_;
4274my @rv;
4275if (&foreign_check("virtual-server")) {
4276	&foreign_require("virtual-server");
4277	my $d = &virtual_server::get_domain_by("dom", $name);
4278	push(@rv, $d) if ($d);
4279	push(@rv, &virtual_server::get_domain_by("dns_subof", $d->{'id'})) if ($d);
4280	}
4281return wantarray ? @rv : $rv[0];
4282}
4283
4284# zone_subhead(&zone)
4285# Returns a ui_header subtitle for a zone
4286sub zone_subhead
4287{
4288my ($zone) = @_;
4289my $desc = &ip6int_to_net(&arpa_to_ip($zone->{'name'}));
4290my $view = $zone->{'view'};
4291return $view ? &text('master_inview', $desc, $view) : $desc;
4292}
4293
4294# format_dnssec_public_key(pubkey)
4295# Format public dnssec public key, each on new line
4296sub format_dnssec_public_key
4297{
4298my ($pubkey) = @_;
4299my @krvalues = split(/\s+/, $pubkey);
4300my @kvalues = @krvalues[0..5];
4301my $kvspace = " " x length("@kvalues");
4302return join(" ", @kvalues) . " " . join("\n$kvspace ", splice(@krvalues, 6));
4303}
4304
43051;
4306
4307