1# Functions for managing BIND 4 and 8/9 records files
2use strict;
3use warnings;
4no warnings 'redefine';
5
6# Globals from Webmin or bind8-lib.pl
7our (%config, %text, %in);
8our $module_config_directory;
9our $bind_version;
10our $ipv6revzone = $config{'ipv6_mode'} ? "ip6.arpa" : "ip6.int";
11
12# read_zone_file(file, origin, [previous], [only-soa], [no-chroot])
13# Reads a DNS zone file and returns a data structure of records. The origin
14# must be a domain without the trailing dot, or just .
15sub read_zone_file
16{
17my ($file, $line, @tok, @lnum, @coms,
18      @rv, $origin, @inc, @oset, $comment);
19$origin = $_[1];
20if (&has_ndc() == 2) {
21	# Flush the zone file
22	&backquote_command(
23		$config{'rndc_cmd'}.
24		($config{'rndc_conf'} ? " -c $config{'rndc_conf'}" : "").
25		" sync ".quotemeta($origin)." 2>&1 </dev/null");
26	}
27if ($origin ne ".") {
28	# Remove trailing dots in origin name, as they are added automatically
29	# in the code below.
30	$origin =~ s/\.*$//;
31	}
32$file = &absolute_path($_[0]);
33my $rootfile = $_[4] ? $file : &make_chroot($file);
34my $FILE;
35if (&is_raw_format_records($rootfile)) {
36	# Convert from raw format first
37	&has_command("named-compilezone") ||
38		&error("Zone file $rootfile is in raw format, but the ".
39		       "named-compilezone command is not installed");
40	open($FILE, "named-compilezone -f raw -F text -o - $origin $rootfile |");
41	}
42else {
43	# Can read text format records directly
44	open($FILE, "<", $rootfile);
45	}
46my $lnum = 0;
47my ($gotsoa, $aftersoa) = (0, 0);
48while($line = <$FILE>) {
49	my ($glen, $merged_2, $merge);
50	$glen = 0;
51	# strip comments (# is not a valid comment separator here!)
52	$line =~ s/\r|\n//g;
53	# parsing splited into separate cases to fasten it
54	if ($line =~ /;/ &&
55	    ($line =~ /[^\\]/ &&
56	     $line =~ /^((?:[^;\"]+|\"\"|(?:\"(?:[^\"]*)\"))*);(.*)/) ||
57	    ($line =~ /[^\"]/ &&
58	     $line =~ /^((?:[^;\\]|\\.)*);(.*)/) ||
59	     # expresion below is the most general, but very slow
60	     # if ";" is quoted somewhere
61	     $line =~ /^((?:(?:[^;\"\\]|\\.)+|(?:\"(?:[^\"\\]|\\.)*\"))*);(.*)/) {
62		$comment = $2;
63		$line = $1;
64		if ($line =~ /^[^"]*"[^"]*$/) {
65			# Line has only one ", meaning that a ; in the middle
66			# of a quoted string broke it! Fix up
67			$line .= ";".$comment;
68			$comment = "";
69			}
70		}
71	else {
72		$comment = "";
73		}
74
75	# split line into tokens
76	my $oset = 0;
77	while(1) {
78		$merge = 1;
79		my $base_oset = 0;
80		if ($line =~ /^(\s*)\"((?:[^\"\\]|\\.)*)\"(.*)/ ||
81		    $line =~ /^(\s*)((?:[^\s\(\)\"\\]|\\.)+)(.*)/ ||
82		    ($merge = 0) || $line =~ /^(\s*)([\(\)])(.*)/) {
83			if ($glen == 0) {
84				$oset += length($1);
85				}
86			else {
87				$glen += length($1);
88				}
89			$glen += length($2);
90			$merged_2 .= $2;
91			$line = $3;
92			if (!$merge || $line =~ /^([\s\(\)]|$)/) {
93				push(@tok, $merged_2); push(@lnum, $lnum);
94				push(@oset, $oset);
95				push(@coms, $comment); $comment = "";
96
97				# Check if we have the SOA
98				if (uc($merged_2) eq "SOA") {
99					$gotsoa = 1;
100					}
101				elsif ($gotsoa) {
102					$aftersoa++;
103					}
104
105				$merged_2 = "";
106				$oset += $glen;
107				$glen = 0;
108				}
109			}
110		else { last; }
111		}
112	$lnum++;
113
114	# Check if we have a complete SOA record
115	if ($aftersoa > 10 && $_[3]) {
116		last;
117		}
118	}
119close($FILE);
120
121# parse into data structures
122my $i = 0; my $num = 0;
123while($i < @tok) {
124	if ($tok[$i] =~ /^\$origin$/i) {
125		# $ORIGIN directive (may be relative or absolute)
126		if ($tok[$i+1] =~ /^(\S*)\.$/) {
127			$origin = $1 ? $1 : ".";
128			}
129		elsif ($origin eq ".") { $origin = $tok[$i+1]; }
130		else { $origin = "$tok[$i+1].$origin"; }
131		$i += 2;
132		}
133	elsif ($tok[$i] =~ /^\$include$/i) {
134		# including another file
135		if ($lnum[$i+1] == $lnum[$i+2]) {
136			# $INCLUDE zonefile origin
137			my $inc_origin;
138			if ($tok[$i+2] =~ /^(\S+)\.$/) {
139				$inc_origin = $1 ? $1 : ".";
140				}
141			elsif ($origin eq ".") { $inc_origin = $tok[$i+2]; }
142			else { $inc_origin = "$tok[$i+2].$origin"; }
143			@inc = &read_zone_file($tok[$i+1], $inc_origin,
144					       @rv ? $rv[$#rv] : undef);
145			$i += 3;
146			}
147		else {
148			# $INCLUDE zonefile
149			@inc = &read_zone_file($tok[$i+1], $origin,
150					       @rv ? $rv[$#rv] : undef);
151			$i += 2;
152			}
153		foreach my $j (@inc) { $j->{'num'} = $num++; }
154		push(@rv, @inc);
155		}
156	elsif ($tok[$i] =~ /^\$generate$/i) {
157		# a generate directive .. add it as a special record
158		my $gen = { 'file' => $file,
159			    'rootfile' => $rootfile,
160			    'comment' => $coms[$i],
161			    'line' => $lnum[$i],
162			    'num' => $num++,
163			    'type' => '' };
164		my @gv;
165		while($lnum[++$i] == $gen->{'line'}) {
166			push(@gv, $tok[$i]);
167			}
168		$gen->{'generate'} = \@gv;
169		push(@rv, $gen);
170		}
171	elsif ($tok[$i] =~ /^\$ttl$/i) {
172		# a ttl directive
173		$i++;
174		my $defttl = { 'file' => $file,
175			       'rootfile' => $rootfile,
176		      	       'line' => $lnum[$i],
177		               'num' => $num++,
178		       	       'defttl' => $tok[$i++],
179			       'type' => '' };
180		push(@rv, $defttl);
181		}
182	elsif ($tok[$i] =~ /^\$(\S+)/i) {
183		# some other special directive
184		my $ln = $lnum[$i];
185		while($lnum[$i] == $ln) {
186			$i++;
187			}
188		}
189	else {
190		# A DNS record line
191		my(%dir, @values, $l);
192		$dir{'line'} = $lnum[$i];
193		$dir{'file'} = $file;
194		$dir{'rootfile'} = $rootfile;
195		$dir{'comment'} = $coms[$i];
196		if ($tok[$i] =~ /^(in|hs)$/i && $oset[$i] > 0) {
197			# starting with a class
198			$dir{'class'} = uc($tok[$i]);
199			$i++;
200			}
201		elsif ($tok[$i] =~ /^\d/ && $tok[$i] !~ /in-addr/i &&
202		       $oset[$i] > 0 && $tok[$i+1] =~ /^(in|hs)$/i) {
203			# starting with a TTL and class
204			$dir{'ttl'} = $tok[$i];
205			$dir{'class'} = uc($tok[$i+1]);
206			$i += 2;
207			}
208		elsif ($tok[$i+1] =~ /^(in|hs)$/i) {
209			# starting with a name and class
210			$dir{'name'} = $tok[$i];
211			$dir{'class'} = uc($tok[$i+1]);
212			$i += 2;
213			}
214		elsif ($oset[$i] > 0 && $tok[$i] =~ /^\d+/) {
215			# starting with just a ttl
216			$dir{'ttl'} = $tok[$i];
217			$dir{'class'} = "IN";
218			$i++;
219			}
220		elsif ($oset[$i] > 0) {
221			# starting with nothing
222			$dir{'class'} = "IN";
223			}
224		elsif ($tok[$i+1] =~ /^\d/ && $tok[$i+2] =~ /^(in|hs)$/i) {
225			# starting with a name, ttl and class
226			$dir{'name'} = $tok[$i];
227			$dir{'ttl'} = $tok[$i+1];
228			$dir{'class'} = uc($tok[$i+2]);
229			$i += 3;
230			}
231                elsif ($tok[$i+1] =~ /^\d/) {
232                        # starting with a name and ttl
233                        $dir{'name'} = $tok[$i];
234                        $dir{'ttl'} = $tok[$i+1];
235                        $dir{'class'} = "IN";
236                        $i += 2;
237                        }
238		else {
239			# starting with a name
240			$dir{'name'} = $tok[$i];
241			$dir{'class'} = "IN";
242			$i++;
243			}
244		if (!defined($dir{'name'}) || $dir{'name'} eq '') {
245			my $prv;
246			# Name comes from previous record
247			for(my $p=$#rv; $p>=0; $p--) {
248				$prv = $rv[$p];
249				last if ($prv->{'name'});
250				}
251			$prv ||= $_[2];
252			$prv || &error(&text('efirst', $lnum[$i]+1, $file));
253			$dir{'name'} = $prv->{'name'};
254			$dir{'realname'} = $prv->{'realname'};
255			}
256		else {
257			$dir{'realname'} = $dir{'name'};
258			}
259		$dir{'type'} = uc($tok[$i++]);
260
261		# read values until end of line, unless a ( is found, in which
262		# case read till the )
263		$l = $lnum[$i];
264		while($i < @tok && $lnum[$i] == $l) {
265			if ($tok[$i] eq "(") {
266				my $olnum = $lnum[$i];
267				while($tok[++$i] ne ")") {
268					push(@values, $tok[$i]);
269					if ($i >= @tok) {
270						&error("No ending ) found for ".
271						       "( at $olnum in $file");
272						}
273					}
274				$i++; # skip )
275				last;
276				}
277			push(@values, $tok[$i++]);
278			}
279		$dir{'values'} = \@values;
280		$dir{'eline'} = $lnum[$i-1];
281
282		# Work out canonical form, and maybe use it
283		my $canon = $dir{'name'};
284		if ($canon eq "@") {
285			$canon = $origin eq "." ? "." : "$origin.";
286			}
287		elsif ($canon !~ /\.$/) {
288			$canon .= $origin eq "." ? "." : ".$origin.";
289			}
290		if (!$config{'short_names'}) {
291			$dir{'name'} = $canon;
292			}
293		$dir{'canon'} = $canon;
294		$dir{'num'} = $num++;
295
296		# If this is an SPF record .. adjust the class
297		my $spf;
298		if ($dir{'type'} eq 'TXT' &&
299		    !$config{'spf_record'} &&
300		    ($spf=&parse_spf(@{$dir{'values'}}))) {
301			if (!$spf->{'other'} || !@{$spf->{'other'}}) {
302				$dir{'type'} = 'SPF';
303				}
304			}
305
306		# If this is a DMARC record .. adjust the class
307		my $dmarc;
308		if ($dir{'type'} eq 'TXT' &&
309                    ($dmarc=&parse_dmarc(@{$dir{'values'}}))) {
310                        if (!$dmarc->{'other'} || !@{$dmarc->{'other'}}) {
311                                $dir{'type'} = 'DMARC';
312                                }
313                        }
314
315		push(@rv, \%dir);
316
317		# Stop processing if this was an SOA record
318		if ($dir{'type'} eq 'SOA' && $_[3]) {
319			last;
320			}
321		}
322	}
323return @rv;
324}
325
326# files_in_zone_file(file)
327# Quickly finds all includes in a zone file
328sub files_in_zone_file
329{
330my ($file) = @_;
331my @rv = ( $file );
332my $fh;
333open($fh, "<", $file);
334while(<$fh>) {
335	if (/^\$include\s+(\S+)/) {
336		my $inc = $1;
337		push(@rv, &files_in_zone_file($inc));
338		}
339	}
340close($fh);
341return @rv;
342}
343
344# create_record(file, name, ttl, class, type, values, comment)
345# Add a new record of some type to some zone file
346sub create_record
347{
348my ($file, @rec) = @_;
349my $fn = &make_chroot(&absolute_path($file));
350&is_raw_format_records($fn) && &error("Raw format zone files cannot be edited");
351my $lref = &read_file_lines($fn);
352push(@$lref, &make_record(@rec));
353&flush_file_lines($fn);
354}
355
356# create_multiple_records(file, &records)
357# Create records from structures
358sub create_multiple_records
359{
360my ($file, $recs) = @_;
361my $fn = &make_chroot(&absolute_path($file));
362&is_raw_format_records($fn) && &error("Raw format zone files cannot be edited");
363my $lref = &read_file_lines($fn);
364foreach my $r (@$recs) {
365	push(@$lref, &make_record($r->{'name'}, $r->{'ttl'}, $r->{'class'},
366			          $r->{'type'}, join(" ", @{$r->{'values'}}),
367			          $r->{'comment'}));
368	}
369&flush_file_lines($fn);
370}
371
372# modify_record(file, &old, name, ttl, class, type, values, comment)
373# Updates an existing record in some zone file
374sub modify_record
375{
376my $fn = &make_chroot(&absolute_path($_[0]));
377&is_raw_format_records($fn) && &error("Raw format zone files cannot be edited");
378my $lref = &read_file_lines($fn);
379my $lines = $_[1]->{'eline'} - $_[1]->{'line'} + 1;
380splice(@$lref, $_[1]->{'line'}, $lines, &make_record(@_[2..$#_]));
381&flush_file_lines($fn);
382}
383
384# delete_record(file, &old)
385# Deletes a record in some zone file
386sub delete_record
387{
388my ($file, $r) = @_;
389my $fn = &make_chroot(&absolute_path($file));
390&is_raw_format_records($fn) && &error("Raw format zone files cannot be edited");
391my $lref = &read_file_lines($fn);
392my $lines = $r->{'eline'} - $r->{'line'} + 1;
393splice(@$lref, $r->{'line'}, $lines);
394&flush_file_lines($fn);
395}
396
397# delete_multiple_records(file, &records)
398# Delete many records from the same file at once
399sub delete_multiple_records
400{
401my ($file, $recs) = @_;
402my $fn = &make_chroot(&absolute_path($file));
403&is_raw_format_records($fn) && &error("Raw format zone files cannot be edited");
404my $lref = &read_file_lines($fn);
405foreach my $r (sort { $b->{'line'} <=> $a->{'line'} } @$recs) {
406	my $lines = $r->{'eline'} - $r->{'line'} + 1;
407	splice(@$lref, $r->{'line'}, $lines);
408	}
409&flush_file_lines($fn);
410}
411
412# create_generator(file, range, lhs, type, rhs, [comment])
413# Add a new $generate line to some zone file
414sub create_generator
415{
416my $f = &make_chroot(&absolute_path($_[0]));
417my $lref = &read_file_lines($f);
418push(@$lref, join(" ", '$generate', @_[1..4]).
419	     ($_[5] ? " ;$_[5]" : ""));
420&flush_file_lines($f);
421}
422
423# modify_generator(file, &old, range, lhs, type, rhs, [comment])
424# Updates an existing $generate line in some zone file
425sub modify_generator
426{
427my $f = &make_chroot(&absolute_path($_[0]));
428my $lref = &read_file_lines($f);
429$lref->[$_[1]->{'line'}] = join(" ", '$generate', @_[2..5]).
430			   ($_[6] ? " ;$_[6]" : "");
431&flush_file_lines($f);
432}
433
434# delete_generator(file, &old)
435# Deletes a $generate line in some zone file
436sub delete_generator
437{
438my $f = &make_chroot(&absolute_path($_[0]));
439my $lref = &read_file_lines($f);
440splice(@$lref, $_[1]->{'line'}, 1);
441&flush_file_lines($f);
442}
443
444# create_defttl(file, value)
445# Adds a $ttl line to a records file
446sub create_defttl
447{
448my $f = &make_chroot(&absolute_path($_[0]));
449my $lref = &read_file_lines($f);
450splice(@$lref, 0, 0, "\$ttl $_[1]");
451&flush_file_lines($f);
452}
453
454# modify_defttl(file, &old, value)
455# Updates the $ttl line with a new value
456sub modify_defttl
457{
458my $f = &make_chroot(&absolute_path($_[0]));
459my $lref = &read_file_lines($f);
460$lref->[$_[1]->{'line'}] = "\$ttl $_[2]";
461&flush_file_lines($f);
462}
463
464# delete_defttl(file, &old)
465# Removes the $ttl line from a records file
466sub delete_defttl
467{
468my $f = &make_chroot(&absolute_path($_[0]));
469my $lref = &read_file_lines($f);
470splice(@$lref, $_[1]->{'line'}, 1);
471&flush_file_lines($f);
472}
473
474# make_record(name, ttl, class, type, values, comment)
475# Returns a string for some zone record
476sub make_record
477{
478my ($name, $ttl, $cls, $type, $values, $cmt) = @_;
479$type = $type eq "SPF" && !$config{'spf_record'} ? "TXT" :
480        $type eq "DMARC" ? "TXT" : $type;
481return $name . ($ttl ? "\t".$ttl : "") . "\t" . $cls . "\t" . $type ."\t" .
482       $values . ($cmt ? "\t;$cmt" : "");
483}
484
485# bump_soa_record(file, &records)
486# Increase the serial number in some SOA record by 1
487sub bump_soa_record
488{
489my($r, $v, $vals);
490for(my $i=0; $i<@{$_[1]}; $i++) {
491	$r = $_[1]->[$i];
492	if ($r->{'type'} eq "SOA") {
493		$v = $r->{'values'};
494		# already set serial if no acl allow it to update or update
495		# is disabled
496		my $serial = $v->[2];
497		if ($config{'updserial_on'}) {
498			# automatically handle serial numbers ?
499			$serial = &compute_serial($v->[2]);
500			}
501		$vals = "$v->[0] $v->[1] (\n\t\t\t$serial\n\t\t\t$v->[3]\n".
502			"\t\t\t$v->[4]\n\t\t\t$v->[5]\n\t\t\t$v->[6] )";
503		&modify_record($r->{'file'}, $r, $r->{'realname'}, $r->{'ttl'},
504				$r->{'class'}, $r->{'type'}, $vals);
505		}
506	}
507}
508
509# date_serial()
510# Returns a string like YYYYMMDD
511sub date_serial
512{
513my $now = time();
514my @tm = localtime($now);
515return sprintf "%4.4d%2.2d%2.2d", $tm[5]+1900, $tm[4]+1, $tm[3];
516}
517
518# get_zone_defaults(&hash)
519sub get_zone_defaults
520{
521my ($zd) = @_;
522if (!&read_file("$module_config_directory/zonedef", $zd)) {
523	$zd->{'refresh'} = 3600;
524	$zd->{'retry'} = 600;
525	$zd->{'expiry'} = 1209600;
526	$zd->{'minimum'} = 3600;
527	$zd->{'refunit'} = "";
528	$zd->{'retunit'} = "";
529	$zd->{'expunit'} = "";
530	$zd->{'minunit'} = "";
531	}
532else {
533	$zd->{'refunit'} = $1 if ($zd->{'refresh'} =~ s/([^0-9])$//);
534	$zd->{'retunit'} = $1 if ($zd->{'retry'} =~ s/([^0-9])$//);
535	$zd->{'expunit'} = $1 if ($zd->{'expiry'} =~ s/([^0-9])$//);
536	$zd->{'minunit'} = $1 if ($zd->{'minimum'} =~ s/([^0-9])$//);
537	}
538}
539
540# save_zone_defaults(&array)
541sub save_zone_defaults
542{
543&write_file("$module_config_directory/zonedef", $_[0]);
544}
545
546# allowed_zone_file(&access, file)
547sub allowed_zone_file
548{
549return 0 if ($_[1] =~ /\.\./);
550return 0 if (-l $_[1] && !&allowed_zone_file($_[0], readlink($_[1])));
551my $l = length($_[0]->{'dir'});
552return length($_[1]) > $l && substr($_[1], 0, $l) eq $_[0]->{'dir'};
553}
554
555# sort_records(list)
556sub sort_records
557{
558return @_ if (!@_);
559my $s = $in{'sort'} ? $in{'sort'} : $config{'records_order'};
560if ($s == 1) {
561	# Sort by name
562	if ($_[0]->{'type'} eq "PTR") {
563		my @rv = sort ptr_sort_func @_;
564		return @rv;
565		}
566	else {
567		my @rv = sort { $a->{'name'} cmp $b->{'name'} } @_;
568		return @rv;
569		}
570	}
571elsif ($s == 2) {
572	# Sort by value
573	if ($_[0]->{'type'} eq "A") {
574		my @rv = sort ip_sort_func @_;
575		return @rv;
576		}
577	elsif ($_[0]->{'type'} eq "MX") {
578		my @rv = sort { $a->{'values'}->[1] cmp $b->{'values'}->[1] } @_;
579		return @rv;
580		}
581	else {
582		my @rv = sort { $a->{'values'}->[0] cmp $b->{'values'}->[0] } @_;
583		return @rv;
584		}
585	}
586elsif ($s == 3) {
587	# Sort by IP address or by value if there is no IP
588	if ($_[0]->{'type'} eq "A") {
589		my @rv = sort ip_sort_func @_;
590		return @rv;
591		}
592	elsif ($_[0]->{'type'} eq "PTR") {
593		my @rv = sort ptr_sort_func @_;
594		return @rv;
595		}
596	elsif ($_[0]->{'type'} eq "MX") {
597		my @rv = sort { $a->{'values'}->[1] cmp $b->{'values'}->[1] } @_;
598		return @rv;
599		}
600	else {
601		my @rv = sort { $a->{'values'}->[0] cmp $b->{'values'}->[0] } @_;
602		return @rv;
603		}
604	}
605elsif ($s == 4) {
606	# Sort by comment
607	my @rv = sort { $b->{'comment'} cmp $a->{'comment'} } @_;
608	return @rv;
609	}
610elsif ($s == 5) {
611	# Sort by type
612	my @rv = sort { $a->{'type'} cmp $b->{'type'} } @_;
613	return @rv;
614	}
615else {
616	return @_;
617	}
618}
619
620sub ptr_sort_func
621{
622$a->{'name'} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
623my ($a1, $a2, $a3, $a4) = ($1, $2, $3, $4);
624$b->{'name'} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
625return	$a4 < $4 ? -1 :
626	$a4 > $4 ? 1 :
627	$a3 < $3 ? -1 :
628	$a3 > $3 ? 1 :
629	$a2 < $2 ? -1 :
630	$a2 > $2 ? 1 :
631	$a1 < $1 ? -1 :
632	$a1 > $1 ? 1 : 0;
633}
634
635sub ip_sort_func
636{
637$a->{'values'}->[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
638my ($a1, $a2, $a3, $a4) = ($1, $2, $3, $4);
639$b->{'values'}->[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
640return	$a1 < $1 ? -1 :
641	$a1 > $1 ? 1 :
642	$a2 < $2 ? -1 :
643	$a2 > $2 ? 1 :
644	$a3 < $3 ? -1 :
645	$a3 > $3 ? 1 :
646	$a4 < $4 ? -1 :
647	$a4 > $4 ? 1 : 0;
648}
649
650# arpa_to_ip(name)
651# Converts an address like 4.3.2.1.in-addr.arpa. to 1.2.3.4
652sub arpa_to_ip
653{
654if ($_[0] =~ /^([\d\-\.\/]+)\.in-addr\.arpa/i) {
655	return join('.',reverse(split(/\./, $1)));
656	}
657return $_[0];
658}
659
660# ip_to_arpa(address)
661# Converts an IP address like 1.2.3.4 to 4.3.2.1.in-addr.arpa.
662sub ip_to_arpa
663{
664if ($_[0] =~ /^([\d\-\.\/]+)$/) {
665	return join('.',reverse(split(/\./,$1))).".in-addr.arpa.";
666	}
667return $_[0];
668}
669
670# ip6int_to_net(name)
671# Converts an address like a.b.c.d.4.3.2.1.ip6.int. to 1234:dcba::
672sub ip6int_to_net
673{
674my $n;
675my $addr = $_[0];
676if ($addr =~ /^([\da-f]\.)+$ipv6revzone/i) {
677	$addr =~ s/\.$ipv6revzone/\./i;
678	$addr = reverse(split(/\./, $addr));
679	$addr =~ s/([\w]{4})/$1:/g;
680	$n = ($addr =~ s/([\w])/$1/g) * 4;
681	$addr =~ s/(\w+)$/$+0000/;
682	$addr =~ s/([\w]{4})0+$/$1:/;
683	$addr =~ s/$/:/;
684	$addr =~ s/:0{1,3}/:/g;
685	if ($n > 112) {
686		$addr =~ s/::$//;
687		$addr =~ s/(:0)+:/::/;
688		}
689	if ($n < 128) {
690		return $addr."/$n";
691		}
692	return $addr
693	}
694return $_[0];
695}
696
697# net_to_ip6int(address, [bits])
698# Converts an IPv6 address like 1234:dcba:: to a.b.c.d.4.3.2.1.ip6.int.
699sub net_to_ip6int
700{
701my $addr = lc($_[0]);
702my $n = $_[1] ? $_[1] >> 2 : 0;
703if (&check_ip6address($addr)) {
704	$addr = reverse(split(/\:/, &expandall_ip6($addr)));
705	$addr =~ s/(\w)/$1\./g;
706	if ($n > 0) {
707		$addr = substr($addr, -2 * $n, 2 * $n);
708	}
709	$addr = $addr.$ipv6revzone.".";
710	}
711return $addr;
712}
713
714our $uscore = $config{'allow_underscore'} ? "_" : "";
715our $star = $config{'allow_wild'} ? "\\*" : "";
716
717# valdnsname(name, wild, origin)
718sub valdnsname
719{
720my($fqdn);
721$fqdn = $_[0] !~ /\.$/ ? "$_[0].$_[2]." : $_[0];
722if (length($fqdn) > 255) {
723	&error(&text('edit_efqdn', $fqdn));
724	}
725if ($_[0] =~ /[^\.]{64}/) {
726	# no label longer than 63 chars
727	&error(&text('edit_elabel', $_[0]));
728	}
729return ((($_[1] && $config{'allow_wild'})
730	 ? (($_[0] =~ /^[\*A-Za-z0-9\-\.$uscore]+$/)
731	   && ($_[0] !~ /.\*/ || $bind_version >= 9) # "*" can be only the first
732						    # char, for bind 8
733	   && ($_[0] !~ /\*[^\.]/))	# a "." must always follow "*"
734	 : ($_[0] =~ /^[\A-Za-z0-9\-\.$uscore]+$/))
735	&& ($_[0] !~ /\.\./)		# no ".." inside
736	&& ($_[0] !~ /^\../)		# no "." at the beginning
737	&& ($_[0] !~ /^\-/)		# no "-" at the beginning
738	&& ($_[0] !~ /\-$/)		# no "-" at the end
739	&& ($_[0] !~ /\.\-/)		# no ".-" inside
740	&& ($_[0] !~ /\-\./)		# no "-." inside
741	&& ($_[0] !~ /\.[0-9]+\.$/));	# last label in FQDN may not be
742					# purely numeric
743}
744
745# valemail(email)
746sub valemail
747{
748return $_[0] eq "." ||
749       $_[0] =~ /^[A-Za-z0-9\.\-]+$/ ||
750       $_[0] =~ /(\S*)\@(\S*)/ &&
751       &valdnsname($2, 0, ".") &&
752       $1 =~ /[a-z][\w\-\.$uscore]+/i;
753}
754
755# absolute_path(path)
756# If a path does not start with a /, prepend the base directory
757sub absolute_path
758{
759my ($path) = @_;
760if ($path =~ /^([a-zA-Z]:)?\//) {
761	return $path;
762	}
763return &base_directory()."/".$path;
764}
765
766# parse_spf(text, ...)
767# If some text looks like an SPF TXT record, return a parsed hash ref
768sub parse_spf
769{
770my $txt = join(" ", @_);
771if ($txt =~ /^v=spf1/) {
772	my @w = split(/\s+/, $txt);
773	my $spf = { };
774	foreach my $w (@w) {
775		$w = lc($w);
776		if ($w eq "a" || $w eq "mx" || $w eq "ptr") {
777			$spf->{$w} = 1;
778			}
779		elsif ($w =~ /^(a|mx|ip4|ip6|ptr|include|exists):(\S+)$/) {
780			push(@{$spf->{"$1:"}}, $2);
781			}
782		elsif ($w eq "-all") {
783			$spf->{'all'} = 3;
784			}
785		elsif ($w eq "~all") {
786			$spf->{'all'} = 2;
787			}
788		elsif ($w eq "?all") {
789			$spf->{'all'} = 1;
790			}
791		elsif ($w eq "+all" || $w eq "all") {
792			$spf->{'all'} = 0;
793			}
794		elsif ($w eq "v=spf1") {
795			# Ignore this
796			}
797		elsif ($w =~ /^(redirect|exp)=(\S+)$/) {
798			# Modifier for domain redirect or expansion
799			$spf->{$1} = $2;
800			}
801		else {
802			push(@{$spf->{'other'}}, $w);
803			}
804		}
805	return $spf;
806	}
807return undef;
808}
809
810# join_spf(&spf)
811# Converts an SPF record structure to a string, designed to be inserted into
812# quotes in a TXT record. If it is longer than 255 bytes, it will be split
813# into multiple quoted strings.
814sub join_spf
815{
816my ($spf) = @_;
817my @rv = ( "v=spf1" );
818foreach my $s ("a", "mx", "ptr") {
819	push(@rv, $s) if ($spf->{$s});
820	}
821foreach my $s ("a", "mx", "ip4", "ip6", "ptr", "include", "exists") {
822	if ($spf->{"$s:"}) {
823		foreach my $v (@{$spf->{"$s:"}}) {
824			push(@rv, "$s:$v");
825			}
826		}
827	}
828if ($spf->{'other'}) {
829	push(@rv, @{$spf->{'other'}});
830	}
831foreach my $m ("redirect", "exp") {
832	if ($spf->{$m}) {
833		push(@rv, $m."=".$spf->{$m});
834		}
835	}
836if ($spf->{'all'} == 3) { push(@rv, "-all"); }
837elsif ($spf->{'all'} == 2) { push(@rv, "~all"); }
838elsif ($spf->{'all'} == 1) { push(@rv, "?all"); }
839elsif ($spf->{'all'} eq '0') { push(@rv, "all"); }
840my @rvwords;
841my $rvword = "";
842while(@rv) {
843	my $w = shift(@rv);
844	if (length($rvword)+length($w)+1 >= 255) {
845		$rvword .= " ";
846		push(@rvwords, $rvword);
847		$rvword = "";
848		}
849	$rvword .= " " if ($rvword);
850	$rvword .= $w;
851	}
852push(@rvwords, $rvword);
853return join("\" \"", @rvwords);
854}
855
856# parse_dmarc(text, ...)
857# If some text looks like an DMARC TXT record, return a parsed hash ref
858sub parse_dmarc
859{
860my $txt = join(" ", @_);
861if ($txt =~ /^v=dmarc1/i) {
862	my @w = split(/;\s*/, $txt);
863	my $dmarc = { };
864	foreach my $w (@w) {
865		$w = lc($w);
866		if ($w =~ /^(v|pct|ruf|rua|p|sp|adkim|aspf|fo)=(\S+)$/i) {
867			$dmarc->{$1} = $2;
868			}
869		else {
870			push(@{$dmarc->{'other'}}, $w);
871			}
872		}
873	return $dmarc;
874	}
875return undef;
876}
877
878# join_dmarc(&dmarc)
879# Converts a DMARC record structure to a string, designed to be inserted into
880# quotes in a TXT record. If it is longer than 255 bytes, it will be split
881# into multiple quoted strings.
882sub join_dmarc
883{
884my ($dmarc) = @_;
885my @rv = ( "v=DMARC1" );
886foreach my $s ("p", "pct", "ruf", "rua", "sp", "adkim", "aspf", "fo") {
887	if ($dmarc->{$s} && $dmarc->{$s} ne '') {
888		push(@rv, $s."=".$dmarc->{$s});
889		}
890	}
891if ($dmarc->{'other'}) {
892	push(@rv, @{$dmarc->{'other'}});
893	}
894my @rvwords;
895my $rvword = "";
896while(@rv) {
897	my $w = shift(@rv);
898	if (length($rvword)+length($w)+1 >= 255) {
899		push(@rvwords, $rvword);
900		$rvword = "";
901		}
902	$rvword .= "; " if ($rvword);
903	$rvword .= $w;
904	}
905push(@rvwords, $rvword);
906return join("\" \"", @rvwords);
907}
908
909# join_record_values(&record)
910# Given the values for a record, joins them into a space-separated string
911# with quoting if needed
912sub join_record_values
913{
914my ($r) = @_;
915if ($r->{'type'} eq 'SOA') {
916	# Multiliple lines, with brackets
917	my $v = $r->{'values'};
918	return "$v->[0] $v->[1] (\n\t\t\t$v->[2]\n\t\t\t$v->[3]\n".
919	       "\t\t\t$v->[4]\n\t\t\t$v->[5]\n\t\t\t$v->[6] )";
920	}
921else {
922	# All one one line
923	my @rv;
924	foreach my $v (@{$r->{'values'}}) {
925		push(@rv, $v =~ /\s|;/ ? "\"$v\"" : $v);
926		}
927	return join(" ", @rv);
928	}
929}
930
931# compute_serial(old)
932# Given an old serial number, returns a new one using the configured method
933sub compute_serial
934{
935my ($old) = @_;
936if ($config{'soa_style'} == 1 && $old =~ /^(\d{8})(\d\d)$/) {
937	if ($1 >= &date_serial()) {
938		if ($2 >= 99) {
939			# Have to roll over to next day
940			return sprintf "%d%2.2d", $1+1, $config{'soa_start'};
941			}
942		else {
943			# Just increment within this day
944			return sprintf "%d%2.2d", $1, $2+1;
945			}
946		}
947	else {
948		# A new day has come
949		return &date_serial().sprintf("%2.2d", $config{'soa_start'});
950		}
951	}
952elsif ($config{'soa_style'} == 2) {
953	# Unix time
954	my $rv = time();
955	while($rv <= $old) {
956		$rv = $old + 1;
957		}
958	return $rv;
959	}
960else {
961	# Incrementing number
962	return $old+1;
963	}
964}
965
966# convert_to_absolute(short, origin)
967# Make a short name like foo a fully qualified name like foo.domain.com.
968sub convert_to_absolute
969{
970my ($name, $origin) = @_;
971if ($name eq $origin ||
972    $name =~ /\.\Q$origin\E$/) {
973	# Name already ends in domain name - add . automatically, so we don't
974	# re-append the domain name.
975	$name .= ".";
976	}
977my $rv = $name eq "" ? "$origin." :
978	    $name eq "@" ? "$origin." :
979	    $name !~ /\.$/ ? "$name.$origin." : $name;
980$rv =~ s/\.+$/\./;
981return $rv;
982}
983
984# get_zone_file(&zone|&zonename, [absolute])
985# Returns the relative-to-chroot path to a domain's zone file.
986# If absolute is 1, the path is made absolute. If 2, it is also un-chrooted
987sub get_zone_file
988{
989my ($z, $abs) = @_;
990$abs ||= 0;
991my $fn;
992if ($z->{'members'}) {
993	my $file = &find("file", $z->{'members'});
994	return undef if (!$file);
995	$fn = $file->{'values'}->[0];
996	}
997else {
998	$fn = $z->{'file'};
999	}
1000if ($abs) {
1001	$fn = &absolute_path($fn);
1002	}
1003if ($abs == 2) {
1004	$fn = &make_chroot($fn);
1005	}
1006return $fn;
1007}
1008
1009# get_dnskey_record(&zone|&zonename, [&records])
1010# Returns the DNSKEY record(s) for some domain, or undef if none
1011sub get_dnskey_record
1012{
1013my ($z, $recs) = @_;
1014my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
1015my @rv;
1016if ($dom) {
1017	if (!$recs) {
1018		# Need to get zone file and thus records
1019		my $fn = &get_zone_file($z);
1020		$recs = [ &read_zone_file($fn, $dom) ];
1021		}
1022	# Find the record
1023	foreach my $r (@$recs) {
1024		if ($r->{'type'} eq 'DNSKEY' &&
1025		    $r->{'name'} eq $dom.'.') {
1026			push(@rv, $r);
1027			}
1028		}
1029	}
1030return wantarray ? @rv : $rv[0];
1031}
1032
1033# record_id(&r)
1034# Returns a unique ID string for a record, based on the name and value
1035sub record_id
1036{
1037my ($r) = @_;
1038return $r->{'name'}."/".$r->{'type'}.
1039       (uc($r->{'type'}) eq 'SOA' || !$r->{'values'} ? '' :
1040		'/'.join('/', @{$r->{'values'}}));
1041}
1042
1043# find_record_by_id(&recs, id, index)
1044# Find a record by ID and possibly index
1045sub find_record_by_id
1046{
1047my ($recs, $id, $num) = @_;
1048my @rv = grep { &record_id($_) eq $id } @$recs;
1049if (!@rv) {
1050	return undef;
1051	}
1052elsif (@rv == 1) {
1053	return $rv[0];
1054	}
1055else {
1056	# Multiple matches .. find the one with the right index
1057	@rv = grep { $_->{'num'} == $num } @rv;
1058	return @rv ? $rv[0] : undef;
1059	}
1060}
1061
1062# get_dnskey_rrset(&zone, [&records])
1063# Returns the DNSKEY recordset for some domain, or an empty array if none
1064sub get_dnskey_rrset
1065{
1066	my ($z, $recs) = @_;
1067	my @rv = ();
1068	my $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
1069	if (!$recs) {
1070		# Need to get zone file and thus records
1071		my $fn = &get_zone_file($z);
1072		$recs = [ &read_zone_file($fn, $dom) ];
1073	}
1074	# Find the record
1075	foreach my $r (@$recs) {
1076		if ($r->{'type'} eq 'DNSKEY' &&
1077			$r->{'name'} eq $dom.'.') {
1078				push(@rv, $r);
1079		}
1080	}
1081	return @rv;
1082}
1083
1084# is_raw_format_records(file)
1085# Checks if a zone file is in BIND's new raw or text format
1086sub is_raw_format_records
1087{
1088my ($file) = @_;
1089open(my $RAW, "<", $file) || return 0;
1090my $buf;
1091read($RAW, $buf, 3);
1092close($RAW);
1093return $buf eq "\0\0\0";
1094}
1095
10961;
1097
1098