bind8/records-lib.pl

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