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