bind8/bind8-lib.pl

   1 # bind8-lib.pl
   2 # Common functions for bind8 config files
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 &init_config();
   7 do 'records-lib.pl';
   8 @extra_forward = split(/\s+/, $config{'extra_forward'});
   9 @extra_reverse = split(/\s+/, $config{'extra_reverse'});
  10 %is_extra = map { $_, 1 } (@extra_forward, @extra_reverse);
  11 %access = &get_module_acl();
  12 $zone_names_cache = "$module_config_directory/zone-names";
  13 $zone_names_version = 3;
  14
  15 # Where to find root zones file
  16 $internic_ftp_host = "rs.internic.net";
  17 $internic_ftp_ip = "198.41.0.6";
  18 $internic_ftp_file = "/domain/named.root";
  19 $internic_ftp_gzip = "/domain/root.zone.gz";
  20
  21 # Get the version number
  22 if (open(VERSION, "$module_config_directory/version")) {
  23         chop($bind_version = <VERSION>);
  24         close(VERSION);
  25         }
  26 else {
  27         $bind_version = &get_bind_version();
  28         }
  29
  30 $dnssec_cron_cmd = "$module_config_directory/resign.pl";
  31
  32 # For automatic DLV setup
  33 $dnssec_dlv_zone = "dlv.isc.org.";
  34 @dnssec_dlv_key = ( 257, 3, 5, '"BEAAAAPHMu/5onzrEE7z1egmhg/WPO0+juoZrW3euWEn4MxDCE1+lLy2brhQv5rN32RKtMzX6Mj70jdzeND4XknW58dnJNPCxn8+jAGl2FZLK8t+1uq4W+nnA3qO2+DL+k6BD4mewMLbIYFwe0PG73Te9fZ2kJb56dhgMde5ymX4BI/oQ+cAK50/xvJv00Frf8kw6ucMTwFlgPe+jnGxPPEmHAte/URkY62ZfkLoBAADLHQ9IrS2tryAe7mbBZVcOwIeU/Rw/mRx/vwwMCTgNboMQKtUdvNXDrYJDSHZws3xiRXF1Rf+al9UmZfSav/4NWLKjHzpT59k/VStTDN0YUuWrBNh"' );
  35
  36 if ($gconfig{'os_type'} =~ /-linux$/ && -r "/dev/urandom") {
  37         $rand_flag = "-r /dev/urandom";
  38         }
  39
  40 # get_bind_version()
  41 # Returns the BIND verison number, or undef if unknown
  42 sub get_bind_version
  43 {
  44 my $out = `$config{'named_path'} -v 2>&1`;
  45 if ($out =~ /(bind|named)\s+([0-9\.]+)/i) {
  46         return $2;
  47         }
  48 return undef;
  49 }
  50
  51 # get_config()
  52 # Returns an array of references to assocs, each containing the details of
  53 # one directive
  54 sub get_config
  55 {
  56 if (!@get_config_cache) {
  57         @get_config_cache = &read_config_file($config{'named_conf'});
  58         }
  59 return \@get_config_cache;
  60 }
  61
  62 # get_config_parent([file])
  63 # Returns a structure containing the top-level config as members
  64 sub get_config_parent
  65 {
  66 local $file = $_[0] || $config{'named_conf'};
  67 if (!defined($get_config_parent_cache{$file})) {
  68         local $conf = &get_config();
  69         if (!defined($lines_count{$file})) {
  70                 local $lref = &read_file_lines($file);
  71                 $lines_count{$file} = @$lref;
  72                 }
  73         $get_config_parent_cache{$file} =
  74                { 'file' => $file,
  75                  'type' => 1,
  76                  'line' => -1,
  77                  'eline' => $lines_count{$file},
  78                  'members' => $conf };
  79         }
  80 return $get_config_parent_cache{$file};
  81 }
  82
  83 # read_config_file(file, [expand includes])
  84 # Reads a config file and returns an array of values
  85 sub read_config_file
  86 {
  87 local($lnum, $line, $cmode, @ltok, @lnum, @tok,
  88       @rv, $i, $t, $j, $ifile, @inc, $str);
  89 $lnum = 0;
  90 open(FILE, &make_chroot($_[0]));
  91 while($line = <FILE>) {
  92         # strip comments
  93         $line =~ s/\r|\n//g;
  94         $line =~ s/#.*$//g;
  95         $line =~ s/\/\/.*$//g if ($line !~ /".*\/\/.*"/);
  96         $line =~ s/\/\*.*\*\///g;
  97         while(1) {
  98                 if (!$cmode && $line =~ /\/\*/) {
  99                         # start of a C-style comment
 100                         $cmode = 1;
 101                         $line =~ s/\/\*.*$//g;
 102                         }
 103                 elsif ($cmode) {
 104                         if ($line =~ /\*\//) {
 105                                 # end of comment
 106                                 $cmode = 0;
 107                                 $line =~ s/^.*\*\///g;
 108                                 }
 109                         else { $line = ""; last; }
 110                         }
 111                 else { last; }
 112                 }
 113
 114         # split line into tokens
 115         undef(@ltok);
 116         while(1) {
 117                 if ($line =~ /^\s*\"([^"]*)"(.*)$/) {
 118                         push(@ltok, $1); $line = $2;
 119                         }
 120                 elsif ($line =~ /^\s*([{};])(.*)$/) {
 121                         push(@ltok, $1); $line = $2;
 122                         }
 123                 elsif ($line =~ /^\s*([^{}; \t]+)(.*)$/) {
 124                         push(@ltok, $1); $line = $2;
 125                         }
 126                 else { last; }
 127                 }
 128         foreach $t (@ltok) {
 129                 push(@tok, $t); push(@lnum, $lnum);
 130                 }
 131         $lnum++;
 132         }
 133 close(FILE);
 134 $lines_count{$_[0]} = $lnum;
 135
 136 # parse tokens into data structures
 137 $i = 0; $j = 0;
 138 while($i < @tok) {
 139         $str = &parse_struct(\@tok, \@lnum, \$i, $j++, $_[0]);
 140         if ($str) { push(@rv, $str); }
 141         }
 142 if (!@rv) {
 143         # Add one dummy directive, so that the file is known
 144         push(@rv, { 'name' => 'dummy',
 145                     'line' => 0,
 146                     'eline' => 0,
 147                     'index' => 0,
 148                     'file' => $_[0] });
 149         }
 150
 151 if (!$_[1]) {
 152         # expand include directives
 153         while(&recursive_includes(\@rv, &base_directory(\@rv))) {
 154                 # This is done repeatedly to handle includes within includes
 155                 }
 156         }
 157
 158 return @rv;
 159 }
 160
 161 # recursive_includes(&dirs, base)
 162 sub recursive_includes
 163 {
 164 local ($i, $j);
 165 local $any = 0;
 166 for($i=0; $i<@{$_[0]}; $i++) {
 167         if (lc($_[0]->[$i]->{'name'}) eq "include") {
 168                 # found one.. replace the include directive with it
 169                 $ifile = $_[0]->[$i]->{'value'};
 170                 if ($ifile !~ /^\//) {
 171                         $ifile = "$_[1]/$ifile";
 172                         }
 173                 local @inc = &read_config_file($ifile, 1);
 174
 175                 # update index of included structures
 176                 local $j;
 177                 for($j=0; $j<@inc; $j++) {
 178                         $inc[$j]->{'index'} += $_[0]->[$i]->{'index'};
 179                         }
 180
 181                 # update index of structures after include
 182                 for($j=$i+1; $j<@{$_[0]}; $j++) {
 183                         $_[0]->[$j]->{'index'} += scalar(@inc) - 1;
 184                         }
 185                 splice(@{$_[0]}, $i--, 1, @inc);
 186                 $any++;
 187                 }
 188         elsif ($_[0]->[$i]->{'type'} == 1) {
 189                 # Check sub-structures too
 190                 $any += &recursive_includes($_[0]->[$i]->{'members'}, $_[1]);
 191                 }
 192         }
 193 return $any;
 194 }
 195
 196
 197 # parse_struct(&tokens, &lines, &line_num, index, file)
 198 # A structure can either have one value, or a list of values.
 199 # Pos will end up at the start of the next structure
 200 sub parse_struct
 201 {
 202 local (%str, $i, $j, $t, @vals);
 203 $i = ${$_[2]};
 204 $str{'line'} = $_[1]->[$i];
 205 if ($_[0]->[$i] ne '{') {
 206         # Has a name
 207         $str{'name'} = lc($_[0]->[$i]);
 208         }
 209 else {
 210         # No name, so need to move token pointer back one
 211         $i--;
 212         }
 213 $str{'index'} = $_[3];
 214 $str{'file'} = $_[4];
 215 if ($str{'name'} eq 'inet') {
 216         # The inet directive doesn't have sub-structures, just multiple
 217         # values with { } in them
 218         $str{'type'} = 2;
 219         $str{'members'} = { };
 220         while(1) {
 221                 $t = $_[0]->[++$i];
 222                 if ($_[0]->[$i+1] eq "{") {
 223                         # Start of a named sub-structure ..
 224                         $i += 2;        # skip {
 225                         $j = 0;
 226                         while($_[0]->[$i] ne "}") {
 227                                 my $substr = &parse_struct(
 228                                                 $_[0], $_[1], \$i, $j++, $_[4]);
 229                                 if ($substr) {
 230                                         $substr->{'parent'} = \%str;
 231                                         push(@{$str{'members'}->{$t}}, $substr);
 232                                         }
 233                                 }
 234                         next;
 235                         }
 236                 elsif ($t eq ";") { last; }
 237                 push(@vals, $t);
 238                 }
 239         $i++;   # skip trailing ;
 240         $str{'values'} = \@vals;
 241         $str{'value'} = $vals[0];
 242         }
 243 else {
 244         # Normal directive, like foo bar; or foo bar { smeg; };
 245         while(1) {
 246                 $t = $_[0]->[++$i];
 247                 if ($t eq "{" || $t eq ";" || $t eq "}") { last; }
 248                 elsif (!defined($t)) { ${$_[2]} = $i; return undef; }
 249                 else { push(@vals, $t); }
 250                 }
 251         $str{'values'} = \@vals;
 252         $str{'value'} = $vals[0];
 253         if ($t eq "{") {
 254                 # contains sub-structures.. parse them
 255                 local(@mems, $j);
 256                 $i++;           # skip {
 257                 $str{'type'} = 1;
 258                 $j = 0;
 259                 while($_[0]->[$i] ne "}") {
 260                         if (!defined($_[0]->[$i])) { ${$_[2]} = $i; return undef; }
 261                         my $substr = &parse_struct(
 262                                 $_[0], $_[1], \$i, $j++, $_[4]);
 263                         if ($substr) {
 264                                 $substr->{'parent'} = \%str;
 265                                 push(@mems, $substr);
 266                                 }
 267                         }
 268                 $str{'members'} = \@mems;
 269                 $i += 2;        # skip trailing } and ;
 270                 }
 271         else {
 272                 # only a single value..
 273                 $str{'type'} = 0;
 274                 if ($t eq ";") {
 275                         $i++;   # skip trailing ;
 276                         }
 277                 }
 278         }
 279 $str{'eline'} = $_[1]->[$i-1];  # ending line is the line number the trailing
 280                                 # ; is on
 281 ${$_[2]} = $i;
 282 return \%str;
 283 }
 284
 285 # find(name, &array)
 286 sub find
 287 {
 288 local($c, @rv);
 289 foreach $c (@{$_[1]}) {
 290         if ($c->{'name'} eq $_[0]) {
 291                 push(@rv, $c);
 292                 }
 293         }
 294 return @rv ? wantarray ? @rv : $rv[0]
 295            : wantarray ? () : undef;
 296 }
 297
 298 # find_value(name, &array)
 299 sub find_value
 300 {
 301 local(@v);
 302 @v = &find($_[0], $_[1]);
 303 if (!@v) { return undef; }
 304 elsif (wantarray) { return map { $_->{'value'} } @v; }
 305 else { return $v[0]->{'value'}; }
 306 }
 307
 308 # base_directory([&config], [no-cache])
 309 # Returns the base directory for named files
 310 sub base_directory
 311 {
 312 if ($_[1] || !-r $zone_names_cache) {
 313         # Actually work out base
 314         local ($opts, $dir, $conf);
 315         $conf = $_[0] ? $_[0] : &get_config();
 316         if (($opts = &find("options", $conf)) &&
 317             ($dir = &find("directory", $opts->{'members'}))) {
 318                 return $dir->{'value'};
 319                 }
 320         if ($config{'named_conf'} =~ /^(.*)\/[^\/]+$/ && $1) {
 321                 return $1;
 322                 }
 323         return "/etc";
 324         }
 325 else {
 326         # Use cache
 327         local %znc;
 328         &read_file_cached($zone_names_cache, \%znc);
 329         return $znc{'base'} || &base_directory($_[0], 1);
 330         }
 331 }
 332
 333 # save_directive(&parent, name|&olds, &values, indent, [structonly])
 334 # Given a structure containing a directive name, type, values and members
 335 # add, update or remove that directive in config structure and data files.
 336 # Updating of files assumes that there is no overlap between directives -
 337 # each line in the config file must contain part or all of only one directive.
 338 sub save_directive
 339 {
 340 local(@oldv, @newv, $pm, $i, $o, $n, $lref, @nl);
 341 $pm = $_[0]->{'members'};
 342 @oldv = ref($_[1]) ? @{$_[1]} : &find($_[1], $pm);
 343 @newv = @{$_[2]};
 344 for($i=0; $i<@oldv || $i<@newv; $i++) {
 345         local $oldeline = $i<@oldv ? $oldv[$i]->{'eline'} : undef;
 346         if ($i >= @oldv && !$_[5]) {
 347                 # a new directive is being added.. put it at the end of
 348                 # the parent
 349                 if (!$_[4]) {
 350                         local $addfile = $newv[$i]->{'file'} || $_[0]->{'file'};
 351                         local $parent = &get_config_parent($addfile);
 352                         $lref = &read_file_lines(&make_chroot($addfile));
 353                         @nl = &directive_lines($newv[$i], $_[3]);
 354                         splice(@$lref, $_[0]->{'eline'}, 0, @nl);
 355                         $newv[$i]->{'file'} = $_[0]->{'file'};
 356                         $newv[$i]->{'line'} = $_[0]->{'eline'};
 357                         $newv[$i]->{'eline'} =
 358                                 $_[0]->{'eline'} + scalar(@nl) - 1;
 359                         &renumber($parent, $_[0]->{'eline'}-1,
 360                                   $_[0]->{'file'}, scalar(@nl));
 361                         }
 362                 push(@$pm, $newv[$i]);
 363                 }
 364         elsif ($i >= @oldv && $_[5]) {
 365                 # a new directive is being added.. put it at the start of
 366                 # the parent
 367                 if (!$_[4]) {
 368                         local $parent = &get_config_parent($newv[$i]->{'file'} ||
 369                                                            $_[0]->{'file'});
 370                         $lref = &read_file_lines(
 371                                 &make_chroot($newv[$i]->{'file'} ||
 372                                              $_[0]->{'file'}));
 373                         @nl = &directive_lines($newv[$i], $_[3]);
 374                         splice(@$lref, $_[0]->{'line'}+1, 0, @nl);
 375                         $newv[$i]->{'file'} = $_[0]->{'file'};
 376                         $newv[$i]->{'line'} = $_[0]->{'line'}+1;
 377                         $newv[$i]->{'eline'} =
 378                                 $_[0]->{'line'} + scalar(@nl);
 379                         &renumber($parent, $_[0]->{'line'},
 380                                   $_[0]->{'file'}, scalar(@nl));
 381                         }
 382                 splice(@$pm, 0, 0, $newv[$i]);
 383                 }
 384         elsif ($i >= @newv) {
 385                 # a directive was deleted
 386                 if (!$_[4]) {
 387                         local $parent = &get_config_parent($oldv[$i]->{'file'});
 388                         $lref = &read_file_lines(
 389                                         &make_chroot($oldv[$i]->{'file'}));
 390                         $ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
 391                         splice(@$lref, $oldv[$i]->{'line'}, $ol);
 392                         &renumber($parent, $oldeline,
 393                                   $oldv[$i]->{'file'}, -$ol);
 394                         }
 395                 splice(@$pm, &indexof($oldv[$i], @$pm), 1);
 396                 }
 397         else {
 398                 # updating some directive
 399                 if (!$_[4]) {
 400                         local $parent = &get_config_parent($oldv[$i]->{'file'});
 401                         $lref = &read_file_lines(
 402                                         &make_chroot($oldv[$i]->{'file'}));
 403                         @nl = &directive_lines($newv[$i], $_[3]);
 404                         $ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
 405                         splice(@$lref, $oldv[$i]->{'line'}, $ol, @nl);
 406                         $newv[$i]->{'file'} = $_[0]->{'file'};
 407                         $newv[$i]->{'line'} = $oldv[$i]->{'line'};
 408                         $newv[$i]->{'eline'} =
 409                                 $oldv[$i]->{'line'} + scalar(@nl) - 1;
 410                         &renumber($parent, $oldeline,
 411                                   $oldv[$i]->{'file'}, scalar(@nl) - $ol);
 412                         }
 413                 $pm->[&indexof($oldv[$i], @$pm)] = $newv[$i];
 414                 }
 415         }
 416 }
 417
 418 # directive_lines(&directive, tabs)
 419 # Renders some directive into a number of lines of text
 420 sub directive_lines
 421 {
 422 local(@rv, $v, $m, $i);
 423 $rv[0] = "\t" x $_[1];
 424 $rv[0] .= "$_[0]->{'name'}";
 425 foreach $v (@{$_[0]->{'values'}}) {
 426         if ($need_quote{$_[0]->{'name'}} && !$i) { $rv[0] .= " \"$v\""; }
 427         else { $rv[0] .= " $v"; }
 428         $i++;
 429         }
 430 if ($_[0]->{'type'} == 1) {
 431         # multiple values.. include them as well
 432         $rv[0] .= " {";
 433         foreach $m (@{$_[0]->{'members'}}) {
 434                 push(@rv, &directive_lines($m, $_[1]+1));
 435                 }
 436         push(@rv, ("\t" x ($_[1]+1))."}");
 437         }
 438 elsif ($_[0]->{'type'} == 2) {
 439         # named sub-structures .. include them too
 440         foreach my $sn (sort { $a cmp $b } (keys %{$_[0]->{'members'}})) {
 441                 $rv[0] .= " ".$sn." {";
 442                 foreach $m (@{$_[0]->{'members'}->{$sn}}) {
 443                         $rv[0] .= " ".join(" ", &directive_lines($m, 0));
 444                         }
 445                 $rv[0] .= " }";
 446                 }
 447         }
 448 $rv[$#rv] .= ";";
 449 return @rv;
 450 }
 451
 452 # renumber(&parent, line, file, count)
 453 # Runs through the given array of directives and increases the line numbers
 454 # of all those greater than some line by the given count
 455 sub renumber
 456 {
 457 if ($_[0]->{'file'} eq $_[2]) {
 458         if ($_[0]->{'line'} > $_[1]) { $_[0]->{'line'} += $_[3]; }
 459         if ($_[0]->{'eline'} > $_[1]) { $_[0]->{'eline'} += $_[3]; }
 460         }
 461 if ($_[0]->{'type'} == 1) {
 462         # Do sub-members
 463         local $d;
 464         foreach $d (@{$_[0]->{'members'}}) {
 465                 &renumber($d, $_[1], $_[2], $_[3]);
 466                 }
 467         }
 468 elsif ($_[0]->{'type'} == 2) {
 469         # Do sub-members
 470         local ($sm, $d);
 471         foreach $sm (keys %{$_[0]->{'members'}}) {
 472                 foreach $d (@{$_[0]->{'members'}->{$sm}}) {
 473                         &renumber($d, $_[1], $_[2], $_[3]);
 474                         }
 475                 }
 476         }
 477 }
 478
 479 # choice_input(text, name, &config, [display, option]+)
 480 # Returns a table row for a multi-value BIND option
 481 sub choice_input
 482 {
 483 my $v = &find_value($_[1], $_[2]);
 484 my @opts;
 485 for(my $i=3; $i<@_; $i+=2) {
 486         push(@opts, [ $_[$i+1], $_[$i] ]);
 487         }
 488 return &ui_table_row($_[0], &ui_radio($_[1], $v, \@opts));
 489 }
 490
 491 # save_choice(name, &parent, indent)
 492 # Updates the config from a multi-value option
 493 sub save_choice
 494 {
 495 local($nd);
 496 if ($in{$_[0]}) { $nd = { 'name' => $_[0], 'values' => [ $in{$_[0]} ] }; }
 497 &save_directive($_[1], $_[0], $nd ? [ $nd ] : [ ], $_[2]);
 498 }
 499
 500 # addr_match_input(text, name, &config)
 501 # A field for editing a list of addresses, ACLs and partial IP addresses
 502 sub addr_match_input
 503 {
 504 my @av;
 505 my $v = &find($_[1], $_[2]);
 506 if ($v) {
 507         foreach my $av (@{$v->{'members'}}) {
 508                 push(@av, join(" ", $av->{'name'}, @{$av->{'values'}}));
 509                 }
 510         }
 511 return &ui_table_row($_[0],
 512         &ui_radio("$_[1]_def", $v ? 0 : 1, [ [ 1, $text{'default'} ],
 513                                              [ 0, $text{'listed'} ] ])."<br>".
 514         &ui_textarea($_[1], join("\n", @av), 3, 50));
 515 }
 516
 517 # save_addr_match(name, &parent, indent)
 518 sub save_addr_match
 519 {
 520 local($addr, @vals, $dir);
 521 if ($in{"$_[0]_def"}) { &save_directive($_[1], $_[0], [ ], $_[2]); }
 522 else {
 523         $in{$_[0]} =~ s/\r//g;
 524         foreach $addr (split(/\n+/, $in{$_[0]})) {
 525                 local ($n, @v) = split(/\s+/, $addr);
 526                 push(@vals, { 'name' => $n, 'values' => \@v });
 527                 }
 528         $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 529         &save_directive($_[1], $_[0], [ $dir ], $_[2]);
 530         }
 531 }
 532
 533 # address_port_input(addresstext, portlabeltext, portnametext, defaulttext,
 534 #                    addressname, portname, &config, size, type)
 535 # Returns table fields for address and a port number
 536 sub address_port_input
 537   {
 538     # Address, using existing function
 539     my $rv = &address_input($_[0], $_[4], $_[6], $_[8]);
 540     my $v = &find($_[4], $_[6]);
 541
 542     my $port;
 543     for ($i = 0; $i < @{$v->{'values'}}; $i++) {
 544       if ($v->{'values'}->[$i] eq $_[5]) {
 545         $port = $v->{'values'}->[$i+1];
 546         last;
 547       }
 548     }
 549
 550     # Port part
 551     my $n;
 552     ($n = $_[5]) =~ s/[^A-Za-z0-9_]/_/g;
 553     $rv .= &ui_table_row($_[1],
 554                 &ui_opt_textbox($n, $port, $_[7], $_[3], $_[2]));
 555     return $rv;
 556   }
 557
 558 # address_input(text, name, &config, type)
 559 sub address_input
 560 {
 561 local($v, $av, @av);
 562 $v = &find($_[1], $_[2]);
 563 foreach $av (@{$v->{'members'}}) {
 564         push(@av, join(" ", $av->{'name'}, @{$av->{'values'}}));
 565         }
 566 if ($_[3] == 0) {
 567         # text area
 568         return &ui_table_row($_[0],
 569                 &ui_textarea($_[1], join("\n", @av), 3, 50));
 570         }
 571 else {
 572         # text row
 573         return &ui_table_row($_[0],
 574                 &ui_textbox($_[1], join(' ',@av), 50));
 575         }
 576 }
 577
 578 # save_port_address(name, portname, &config, indent)
 579 sub save_port_address {
 580   local($addr, $port, @vals, $dir);
 581   foreach $addr (split(/\s+/, $in{$_[0]})) {
 582     $addr =~ /^\S+$/ || &error(&text('eipacl', $addr));
 583     push(@vals, { 'name' => $addr });
 584   }
 585   $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 586   ($n = $_[1]) =~ s/[^A-Za-z0-9_]/_/g;
 587   $dir->{'values'} = [ $_[1], $in{$_[1]} ] if (!$in{"${n}_def"});
 588   &save_directive($_[2], $_[0], @vals ? [ $dir ] : [ ], $_[3]);
 589 }
 590
 591 # save_address(name, &parent, indent, ips-only)
 592 sub save_address
 593 {
 594 local ($addr, @vals, $dir, $i);
 595 local @sp = split(/\s+/, $in{$_[0]});
 596 for($i=0; $i<@sp; $i++) {
 597         !$_[3] || &check_ipaddress($sp[$i]) || &error(&text('eip', $sp[$i]));
 598         if (lc($sp[$i]) eq "key") {
 599                 push(@vals, { 'name' => $sp[$i],
 600                               'values' => [ $sp[++$i] ] });
 601                 }
 602         else {
 603                 push(@vals, { 'name' => $sp[$i] });
 604                 }
 605         }
 606 $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 607 &save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2]);
 608 }
 609
 610 # forwarders_input(text, name, &config)
 611 # Returns a form field containing a table of forwarding IPs and ports
 612 sub forwarders_input
 613 {
 614 my $v = &find($_[1], $_[2]);
 615 my (@ips, @prs);
 616 foreach my $av (@{$v->{'members'}}) {
 617         push(@ips, $av->{'name'});
 618         if ($av->{'values'}->[0] eq 'port') {
 619                 push(@prs, $av->{'values'}->[1]);
 620                 }
 621         else {
 622                 push(@prs, undef);
 623                 }
 624         }
 625 my @table;
 626 for(my $i=0; $i<@ips+3; $i++) {
 627         push(@table, [ &ui_textbox("$_[1]_ip_$i", $ips[$i], 20),
 628                        &ui_opt_textbox("$_[1]_pr_$i", $prs[$i], 5,
 629                                        $text{'default'}),
 630                      ]);
 631         }
 632 return &ui_table_row($_[0],
 633         &ui_columns_table([ $text{'forwarding_ip'}, $text{'forwarding_port'} ],
 634                           undef, \@table, undef, 1), 3);
 635 }
 636
 637 # save_forwarders(name, &parent, indent)
 638 sub save_forwarders
 639 {
 640 local ($i, $ip, $pr, @vals);
 641 for($i=0; defined($ip = $in{"$_[0]_ip_$i"}); $i++) {
 642         next if (!$ip);
 643         &check_ipaddress($ip) || &check_ip6address($ip) ||
 644                 &error(&text('eip', $ip));
 645         $pr = $in{"$_[0]_pr_${i}_def"} ? undef : $in{"$_[0]_pr_$i"};
 646         !$pr || $pr =~ /^\d+$/ || &error(&text('eport', $pr));
 647         push(@vals, { 'name' => $ip,
 648                       'values' => $pr ? [ "port", $pr ] : [ ] });
 649         }
 650 local $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 651 &save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2]);
 652 }
 653
 654 # opt_input(text, name, &config, default, size, units)
 655 # Returns a table row with an optional text field
 656 sub opt_input
 657 {
 658 my $v = &find($_[1], $_[2]);
 659 my $n;
 660 ($n = $_[1]) =~ s/[^A-Za-z0-9_]/_/g;
 661 return &ui_table_row($_[0],
 662         &ui_opt_textbox($n, $v ? $v->{'value'} : "", $_[4], $_[3])." ".$_[5],
 663         $_[4] > 30 ? 3 : 1);
 664 }
 665
 666 sub save_opt
 667 {
 668 local($dir, $n);
 669 ($n = $_[0]) =~ s/[^A-Za-z0-9_]/_/g;
 670 if ($in{"${n}_def"}) { &save_directive($_[2], $_[0], [ ], $_[3]); }
 671 elsif ($err = &{$_[1]}($in{$n})) {
 672         &error($err);
 673         }
 674 else {
 675         $dir = { 'name' => $_[0], 'values' => [ $in{$n} ] };
 676         &save_directive($_[2], $_[0], [ $dir ], $_[3]);
 677         }
 678 }
 679
 680 # directives that need their value to be quoted
 681 @need_quote = ( "file", "zone", "view", "pid-file", "statistics-file",
 682                 "dump-file", "named-xfer", "secret" );
 683 foreach $need (@need_quote) {
 684         $need_quote{$need}++;
 685         }
 686
 687 1;
 688
 689 # find_reverse(address, [view])
 690 # Returns the zone and record structures for the PTR record for some address
 691 sub find_reverse
 692 {
 693 local($conf, @zl, $rev, $z, $revconf, $revfile, $revrec, @revrecs, $addr, $rr,
 694       @octs, $i, @hexs, $ipv6, @zero);
 695
 696 # find reverse domain
 697 local @zl = grep { $_->{'type'} ne 'view' } &list_zone_names();
 698 if ($_[1] ne '') {
 699         @zl = grep { $_->{'view'} && $_->{'viewindex'} == $_[1] } @zl;
 700         }
 701 else {
 702         @zl = grep { !$_->{'view'} } @zl;
 703         }
 704 $ipv6 = $config{'support_aaaa'} && &check_ip6address($_[0]);
 705 if ($ipv6) {
 706         @zero = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
 707         $addr = &expandall_ip6($_[0]);
 708         $addr =~ s/://g;
 709         @hexs = split('', $addr);
 710         DOMAIN: for($i=30; $i>=0; $i--) {
 711                 $addr = join(':',split(/(.{4})/,join('', (@hexs[0..$i],@zero[$i..30]))));
 712                 $addr =~ s/::/:/g;
 713                 $addr =~ s/(^:|:$)//g;
 714                 $rev = &net_to_ip6int($addr, 4*($i+1));
 715                 $rev =~ s/\.$//g;
 716                 foreach $z (@zl) {
 717                         if (lc($z->{'name'}) eq $rev && $z->{'type'} eq 'master') {
 718                                 # found the reverse master domain
 719                                 $revconf = $z;
 720                                 last DOMAIN;
 721                                 }
 722                         }
 723                 }
 724         }
 725 else {
 726         @octs = split(/\./, $_[0]);
 727         DOMAIN: for($i=2; $i>=-1; $i--) {
 728                 $rev = $i<0 ? "in-addr.arpa"
 729                             : &ip_to_arpa(join('.', @octs[0..$i]));
 730                 $rev =~ s/\.$//g;
 731                 foreach $z (@zl) {
 732                         if ((lc($z->{'name'}) eq $rev ||
 733                              lc($z->{'name'}) eq "$rev.") &&
 734                             $z->{'type'} eq "master") {
 735                                 # found the reverse master domain
 736                                 $revconf = $z;
 737                                 last DOMAIN;
 738                                 }
 739                         }
 740                 }
 741         }
 742
 743 # find reverse record
 744 if ($revconf) {
 745         $revfile = &absolute_path($revconf->{'file'});
 746         @revrecs = &read_zone_file($revfile, $revconf->{'name'});
 747         if ($ipv6) {
 748                 $addr = &net_to_ip6int($_[0], 128);
 749                 }
 750         else {
 751                 $addr = &ip_to_arpa($_[0]);
 752                 }
 753         foreach $rr (@revrecs) {
 754                 if ($rr->{'type'} eq "PTR" &&
 755                     lc($rr->{'name'}) eq lc($addr)) {
 756                         # found the reverse record
 757                         $revrec = $rr;
 758                         last;
 759                         }
 760                 }
 761         }
 762 return ($revconf, $revfile, $revrec);
 763 }
 764
 765 # find_forward(address, [view])
 766 # Returns the zone and record structures for the A record for some address
 767 sub find_forward
 768 {
 769 local ($fwdconf, $i, $fwdfile, $fwdrec, $fr, $ipv6);
 770
 771 # find forward domain
 772 local $host = $_[0]; $host =~ s/\.$//;
 773 local @zl = grep { $_->{'type'} ne 'view' } &list_zone_names();
 774 if ($_[1] ne '') {
 775         @zl = grep { $_->{'view'} && $_->{'viewindex'} == $_[1] } @zl;
 776         }
 777 else {
 778         @zl = grep { !$_->{'view'} } @zl;
 779         }
 780 local @parts = split(/\./, $host);
 781 DOMAIN: for($i=1; $i<@parts; $i++) {
 782         local $fwd = join(".", @parts[$i .. @parts-1]);
 783         foreach $z (@zl) {
 784                 local $typed;
 785                 if ((lc($z->{'name'}) eq $fwd ||
 786                      lc($z->{'name'}) eq "$fwd.") &&
 787                     $z->{'type'} eq "master") {
 788                         # Found the forward master!
 789                         $fwdconf = $z;
 790                         last DOMAIN;
 791                         }
 792                 }
 793         }
 794
 795 # find forward record
 796 if ($fwdconf) {
 797         $fwdfile = &absolute_path($fwdconf->{'file'});
 798         local @fwdrecs = &read_zone_file($fwdfile, $fwdconf->{'name'});
 799         foreach $fr (@fwdrecs) {
 800                 if ($ipv6 ? $fr->{'type'} eq "AAAA" : $fr->{'type'} eq "A" &&
 801                     $fr->{'name'} eq $_[0]) {
 802                         # found the forward record!
 803                         $fwdrec = $fr;
 804                         last;
 805                         }
 806                 }
 807         }
 808
 809 return ($fwdconf, $fwdfile, $fwdrec);
 810 }
 811
 812 # can_edit_zone(&zone, [&view] | &cachedzone)
 813 # Returns 1 if some zone can be edited
 814 sub can_edit_zone
 815 {
 816 local %zcan;
 817 local ($zn, $vn, $file);
 818 if ($_[0]->{'members'}) {
 819         # A full zone structure
 820         $zn = $_[0]->{'value'};
 821         $vn = $_[1] ? 'view_'.$_[1]->{'value'} : undef;
 822         $file = &find_value("file", $_[0]->{'members'});
 823         }
 824 else {
 825         # A cached zone object
 826         $zn = $_[0]->{'name'};
 827         $vn = $_[0]->{'view'} eq '*' ? undef : $_[0]->{'view'};
 828         $file = $_[0]->{'file'};
 829         }
 830
 831 # Check zone name
 832 if ($access{'zones'} eq '*') {
 833         # Always can
 834         }
 835 elsif ($access{'zones'} =~ /^\!/) {
 836         # List of denied zones
 837         foreach (split(/\s+/, $access{'zones'})) {
 838                 return 0 if ($_ eq $zn || ($vn && $_ eq $vn));
 839                 }
 840         }
 841 else {
 842         # List of allowed zones
 843         local $ok;
 844         foreach (split(/\s+/, $access{'zones'})) {
 845                 $ok++ if ($_ eq $zn || ($vn && $_ eq $vn));
 846                 }
 847         return 0 if (!$ok);
 848         }
 849
 850 if ($access{'dironly'}) {
 851         # Check directory access control
 852         return 1 if (!$file);
 853         $file = &absolute_path($file);
 854         return 0 if (!&allowed_zone_file(\%access, $file));
 855         }
 856 return 1;
 857 }
 858
 859 # can_edit_reverse(&zone)
 860 sub can_edit_reverse
 861 {
 862 return $access{'reverse'} || &can_edit_zone($_[0]);
 863 }
 864
 865 # record_input(zoneindex, view, type, file, origin, [num], [record],
 866 #              [new-name, new-value])
 867 # Display a form for editing or creating a DNS record
 868 sub record_input
 869 {
 870 local(%rec, @recs, $ttl, $ttlunit);
 871 local $type = $_[6] ? $_[6]->{'type'} : $_[2];
 872 print &ui_form_start("save_record.cgi");
 873 print &ui_hidden("index", $_[0]);
 874 print &ui_hidden("view", $_[1]);
 875 print &ui_hidden("file", $_[3]);
 876 print &ui_hidden("origin", $_[4]);
 877 print &ui_hidden("sort", $in{'sort'});
 878 if (defined($_[5])) {
 879         print &ui_hidden("num", $_[5]);
 880         %rec = %{$_[6]};
 881         print &ui_hidden("id", &record_id(\%rec));
 882         }
 883 else {
 884         print &ui_hidden("new", 1);
 885         $rec{'name'} = $_[7] if ($_[7]);
 886         $rec{'values'} = [ $_[8] ] if ($_[8]);
 887         }
 888 print &ui_hidden("type", $type);
 889 print &ui_hidden("redirtype", $_[2]);
 890 print &ui_table_start(&text(defined($_[5]) ? 'edit_edit' : 'edit_add',
 891                             $text{"edit_".$type}));
 892
 893 # Record name field(s)
 894 if ($type eq "PTR") {
 895         print &ui_table_row($text{'edit_addr'},
 896                 &ui_textbox("name",
 897                   !%rec && $_[4] =~ /^(\d+)\.(\d+)\.(\d+)\.in-addr/ ?
 898                         "$3.$2.$1." :
 899                         &ip6int_to_net(&arpa_to_ip($rec{'name'})), 30));
 900         }
 901 elsif ($type eq "NS") {
 902         print &ui_table_row($text{'edit_zonename'},
 903                 &ui_textbox("name", $rec{'name'}, 30));
 904         }
 905 elsif ($type eq "SRV") {
 906         local ($serv, $proto, $name) =
 907                 $rec{'name'} =~ /^([^\.]+)\.([^\.]+)\.(\S+)/ ? ($1, $2, $3) :
 908                         (undef, undef, undef);
 909         $serv =~ s/^_//;
 910         $proto =~ s/^_//;
 911         print &ui_table_row($text{'edit_name'},
 912                 &ui_textbox("name", $name, 30));
 913
 914         print &ui_table_row($text{'edit_proto'},
 915                 &ui_select("proto", $proto,
 916                            [ [ "tcp", "TCP" ],
 917                              [ "udp", "UDP" ],
 918                              [ "tls", "TLS" ] ], undef, undef, 1));
 919
 920         print &ui_table_row($text{'edit_serv'},
 921                 &ui_textbox("serv", $serv, 20));
 922         }
 923 else {
 924         print &ui_table_row($text{'edit_name'},
 925                 &ui_textbox("name", $rec{'name'}, 30));
 926         }
 927
 928 # Show canonical name too, if not auto-converted
 929 if ($config{'short_names'} && defined($_[5])) {
 930         print &ui_table_row($text{'edit_canon'}, "<tt>$rec{'canon'}</tt>");
 931         }
 932
 933 # TTL field
 934 if ($rec{'ttl'} =~ /^(\d+)([SMHDW]?)$/i) {
 935         $ttl = $1; $ttlunit = $2;
 936         }
 937 else {
 938         $ttl = $rec{'ttl'}; $ttlunit = "";
 939         }
 940 print &ui_table_row($text{'edit_ttl'},
 941         &ui_opt_textbox("ttl", $ttl, 8, $text{'default'})." ".
 942         &time_unit_choice("ttlunit", $ttlunit));
 943
 944 # Value(s) fields
 945 @v = @{$rec{'values'}};
 946 if ($type eq "A" || $type eq "AAAA") {
 947         print &ui_table_row($text{'value_A1'},
 948             &ui_textbox("value0", $v[0], 20)." ".
 949             (!defined($_[5]) && $type eq "A" ?
 950              &free_address_button("value0") : ""), 3);
 951         if (defined($_[5])) {
 952                 print &ui_hidden("oldname", $rec{'name'});
 953                 print &ui_hidden("oldvalue0", $v[0]);
 954                 }
 955         }
 956 elsif ($type eq "NS") {
 957         print &ui_table_row($text{'value_NS1'},
 958             &ui_textbox("value0", $v[0], 30)." ($text{'edit_cnamemsg'})", 3);
 959         }
 960 elsif ($type eq "CNAME") {
 961         print &ui_table_row($text{'value_CNAME1'},
 962             &ui_textbox("value0", $v[0], 30)." ($text{'edit_cnamemsg'})", 3);
 963         }
 964 elsif ($type eq "MX") {
 965         print &ui_table_row($text{'value_MX2'},
 966             &ui_textbox("value1", $v[1], 30));
 967         print &ui_table_row($text{'value_MX1'},
 968             &ui_textbox("value0", $v[0], 8));
 969         }
 970 elsif ($type eq "HINFO") {
 971         print &ui_table_row($text{'value_HINFO1'},
 972             &ui_textbox("value0", $v[0], 20));
 973         print &ui_table_row($text{'value_HINFO2'},
 974             &ui_textbox("value1", $v[1], 20));
 975         }
 976 elsif ($type eq "TXT") {
 977         print &ui_table_row($text{'value_TXT1'},
 978             &ui_textbox("value0", $v[0], 40), 3);
 979         }
 980 elsif ($type eq "WKS") {
 981         # Well known server
 982         print &ui_table_row($text{'value_WKS1'},
 983                 &ui_textbox("value0", $v[0], 15));
 984
 985         print &ui_table_row($text{'value_WKS2'},
 986                 &ui_select("value1", lc($v[1]),
 987                            [ [ "tcp", "TCP" ], [ "udp", "UDP" ] ]));
 988
 989         print &ui_table_row($text{'value_WKS3'},
 990                 &ui_textarea("value2", join(' ', @v[2..$#v]), 3, 20));
 991         }
 992 elsif ($type eq "RP") {
 993         # Responsible person
 994         print &ui_table_row($text{'value_RP1'},
 995                 &ui_textbox("value0", &dotted_to_email($v[0]), 20));
 996
 997         print &ui_table_row($text{'value_RP2'},
 998                 &ui_textbox("value1", $v[1], 30));
 999         }
1000 elsif ($type eq "PTR") {
1001         # Reverse address
1002         print &ui_table_row($text{'value_PTR1'},
1003                 &ui_textbox("value0", $v[0], 30), 3);
1004         if (defined($_[5])) {
1005                 print &ui_hidden("oldname", $rec{'name'});
1006                 print &ui_hidden("oldvalue0", $v[0]);
1007                 }
1008         }
1009 elsif ($type eq "SRV") {
1010         print &ui_table_row($text{'value_SRV1'},
1011                 &ui_textbox("value0", $v[0], 8));
1012
1013         print &ui_table_row($text{'value_SRV2'},
1014                 &ui_textbox("value1", $v[1], 8));
1015
1016         print &ui_table_row($text{'value_SRV3'},
1017                 &ui_textbox("value2", $v[2], 8));
1018
1019         print &ui_table_row($text{'value_SRV4'},
1020                 &ui_textbox("value3", $v[3], 30));
1021         }
1022 elsif ($type eq "LOC") {
1023         print &ui_table_row($text{'value_LOC1'},
1024                 &ui_textbox("value0", join(" ", @v), 40), 3);
1025         }
1026 elsif ($type eq "KEY") {
1027         print &ui_table_row($text{'value_KEY1'},
1028                 &ui_textbox("value0", $v[0], 8));
1029
1030         print &ui_table_row($text{'value_KEY2'},
1031                 &ui_textbox("value1", $v[1], 8));
1032
1033         print &ui_table_row($text{'value_KEY3'},
1034                 &ui_textbox("value2", $v[2], 8));
1035
1036         print &ui_table_row($text{'value_KEY4'},
1037                 &ui_textarea("value3", join("\n", &wrap_lines($v[3], 80)),
1038                              5, 80), 3);
1039         }
1040 elsif ($type eq "SPF") {
1041         # SPF records are complex, as they have several attributes encoded
1042         # in the TXT value
1043         local $spf = &parse_spf(@v);
1044         print &ui_table_row($text{'value_spfa'},
1045                 &ui_yesno_radio("spfa", $spf->{'a'} ? 1 : 0), 3);
1046
1047         print &ui_table_row($text{'value_spfmx'},
1048                 &ui_yesno_radio("spfmx", $spf->{'mx'} ? 1 : 0), 3);
1049
1050         print &ui_table_row($text{'value_spfptr'},
1051                 &ui_yesno_radio("spfptr", $spf->{'ptr'} ? 1 : 0), 3);
1052
1053         print &ui_table_row($text{'value_spfas'},
1054                 &ui_textarea("spfas", join("\n", @{$spf->{'a:'}}), 3, 40), 3);
1055
1056         print &ui_table_row($text{'value_spfmxs'},
1057                 &ui_textarea("spfmxs", join("\n", @{$spf->{'mx:'}}), 3, 40), 3);
1058
1059         print &ui_table_row($text{'value_spfip4s'},
1060                 &ui_textarea("spfip4s", join("\n", @{$spf->{'ip4:'}}),
1061                              3, 40), 3);
1062
1063         if (&supports_ipv6()) {
1064                 print &ui_table_row($text{'value_spfip6s'},
1065                         &ui_textarea("spfip6s", join("\n", @{$spf->{'ip6:'}}),
1066                                      3, 40), 3);
1067                 }
1068
1069         print &ui_table_row($text{'value_spfincludes'},
1070                 &ui_textarea("spfincludes", join("\n", @{$spf->{'include:'}}),
1071                              3, 40), 3);
1072
1073         print &ui_table_row($text{'value_spfall'},
1074                 &ui_select("spfall", int($spf->{'all'}),
1075                         [ [ 3, $text{'value_spfall3'} ],
1076                           [ 2, $text{'value_spfall2'} ],
1077                           [ 1, $text{'value_spfall1'} ],
1078                           [ 0, $text{'value_spfall0'} ],
1079                           [ undef, $text{'value_spfalldef'} ] ]), 3);
1080
1081         print &ui_table_row($text{'value_spfredirect'},
1082                 &ui_opt_textbox("spfredirect", $spf->{'redirect'}, 40,
1083                             $text{'value_spfnoredirect'}), 3);
1084
1085         print &ui_table_row($text{'value_spfexp'},
1086                 &ui_opt_textbox("spfexp", $spf->{'exp'}, 40,
1087                             $text{'value_spfnoexp'}), 3);
1088         }
1089 else {
1090         # All other types just have a text box
1091         print &ui_table_row($text{'value_other'},
1092                 &ui_textarea("values", join("\n", @v), 3, 40), 3);
1093         }
1094
1095 # Comment field
1096 if ($type ne "WKS") {
1097         if ($config{'allow_comments'}) {
1098                 print &ui_table_row($text{'edit_comment'},
1099                         &ui_textbox("comment", $rec{'comment'}, 40), 3);
1100                 }
1101         else {
1102                 print &ui_hidden("comment", $rec{'comment'});
1103                 }
1104         }
1105
1106 # Update reverse/forward option
1107 if ($type eq "A" || $type eq "AAAA") {
1108         print &ui_table_row($text{'edit_uprev'},
1109                 &ui_radio("rev", $config{'rev_def'} == 0 ? 1 :
1110                                  $config{'rev_def'} == 2 ? 2 : 0,
1111                    [ [ 1, $text{'yes'} ],
1112                      defined($_[5]) ? ( ) : ( [ 2, $text{'edit_over'} ] ),
1113                      [ 0, $text{'no'} ] ]));
1114         }
1115 elsif ($type eq "PTR") {
1116         print &ui_table_row($text{'edit_upfwd'},
1117                 &ui_radio("fwd", $config{'rev_def'} ? 0 : 1,
1118                    [ [ 1, $text{'yes'} ],
1119                      [ 0, $text{'no'} ] ]));
1120         }
1121 print &ui_table_end();
1122
1123 # End buttons
1124 if (!$access{'ro'}) {
1125         if (defined($_[5])) {
1126                 print &ui_form_end([ [ undef, $text{'save'} ],
1127                                      [ "delete", $text{'delete'} ] ]);
1128                 }
1129         else {
1130                 print &ui_form_end([ [ undef, $text{'create'} ] ]);
1131                 }
1132         }
1133 }
1134
1135 # zones_table(&links, &titles, &types, &deletes)
1136 # Returns a table of zones, with checkboxes to delete
1137 sub zones_table
1138 {
1139 local($i);
1140 local @tds = ( "width=5" );
1141 local $rv;
1142 $rv .= &ui_columns_start([ "", $text{'index_zone'}, $text{'index_type'} ],
1143                         100, 0, \@tds);
1144 for($i=0; $i<@{$_[0]}; $i++) {
1145         local @cols = ( "<a href=\"$_[0]->[$i]\">$_[1]->[$i]</a>",
1146                         $_[2]->[$i] );
1147         if (defined($_[3]->[$i])) {
1148                 $rv .= &ui_checked_columns_row(\@cols, \@tds, "d", $_[3]->[$i]);
1149                 }
1150         else {
1151                 $rv .= &ui_columns_row(\@cols, \@tds);
1152                 }
1153         }
1154 $rv .= &ui_columns_end();
1155 return $rv;
1156 }
1157
1158 # convert_illegal(text)
1159 # Convert text containing special HTML characters to properly display it.
1160 sub convert_illegal
1161 {
1162 $_[0] =~ s/&/&amp;/g;
1163 $_[0] =~ s/>/&gt;/g;
1164 $_[0] =~ s/</&lt;/g;
1165 $_[0] =~ s/"/&quot;/g;
1166 $_[0] =~ s/ /&nbsp;/g;
1167 return $_[0];
1168 }
1169
1170 sub check_net_ip
1171 {
1172 local($j, $arg = $_[0]);
1173 if ($arg !~ /^(\d{1,3}\.){0,3}([0-9\-\/]+)$/) {
1174         return 0;
1175         }
1176 foreach $j (split(/\./, $arg)) {
1177         $j =~ /^(\d+)-(\d+)$/ && $1 < 255 && $2 < 255 ||
1178         $j =~ /^(\d+)\/(\d+)$/ && $1 < 255 && $2 <= 32 ||
1179                 $j <= 255 || return 0;
1180         }
1181 return 1;
1182 }
1183
1184 # expand_ip6(ip)
1185 # Transform compact (with ::) IPv6 address to the unique expanded form
1186 # (without :: and leading zeroes in all parts)
1187 sub expand_ip6
1188 {
1189 my ($ip) = @_;
1190 for(my $n = 6 - ($ip =~ s/([^:]):(?=[^:])/$1:/g); $n > 0; $n--) {
1191         $ip =~ s/::/:0::/;
1192         }
1193 $ip =~ s/::/:/;
1194 $ip =~ s/^:/0:/;
1195 $ip =~ s/:$/:0/;
1196 $ip =~ s/(:|^)0(?=\w)/$1/;
1197 $ip =~ tr/[A-Z]/[a-z]/;
1198 return $ip;
1199 }
1200
1201 # expandall_ip6(ip)
1202 # Transform IPv6 address to the expanded form containing all internal 0's
1203 sub expandall_ip6
1204 {
1205 my ($ip) = @_;
1206 $ip = &expand_ip6($ip);
1207 $ip =~ s/(:|^)(\w{3})(?=:|$)/:0$2/g;
1208 $ip =~ s/(:|^)(\w{2})(?=:|$)/:00$2/g;
1209 $ip =~ s/(:|^)(\w)(?=:|$)/:000$2/g;
1210 return $ip;
1211 }
1212
1213 # check_ip6address(ip)
1214 # Check if some IPv6 address is properly formatted
1215 sub check_ip6address
1216 {
1217 local($ip6);
1218 $ip6 = $_[0];
1219 $ip6 = &expand_ip6($ip6);
1220 return ($ip6 =~ /^([\da-f]{1,4}:){7}([\da-f]{1,4})$/i);
1221 }
1222
1223 sub time_unit_choice
1224 {
1225 local ($name, $value) = @_;
1226 return &ui_select($name, $value =~ /^(S?)$/i ? "" :
1227                          $value =~ /M/i ? "M" :
1228                          $value =~ /H/i ? "H" :
1229                          $value =~ /D/i ? "D" :
1230                          $value =~ /W/i ? "W" : $value,
1231                   [ [ "", $text{'seconds'} ],
1232                     [ "M", $text{'minutes'} ],
1233                     [ "H", $text{'hours'} ],
1234                     [ "D", $text{'days'} ],
1235                     [ "W", $text{'weeks'} ] ], 1, 0, 1);
1236 }
1237
1238 sub extract_time_units
1239 {
1240 local(@ret);
1241 foreach $j (@_) {
1242         if ($j =~ /^(\d+)([SMHDW]?)$/is) {
1243                 push(@ret, $2); $j = $1;
1244                 }
1245         }
1246 return @ret;
1247 }
1248
1249 sub email_to_dotted
1250 {
1251 local $v = $_[0];
1252 $v =~ s/\.$//;
1253 if ($v =~ /^([^.]+)\@(.*)$/) {
1254         return "$1.$2.";
1255         }
1256 elsif ($v =~ /^(.*)\@(.*)$/) {
1257         local ($u, $d) = ($1, $2);
1258         $u =~ s/\./\\\./g;
1259         return "\"$u.$d.\"";
1260         }
1261 else {
1262         return $v;
1263         }
1264 }
1265
1266 sub dotted_to_email
1267 {
1268 local $v = $_[0];
1269 if ($v ne ".") {
1270         $v =~ s/([^\\])\./$1\@/;
1271         $v =~ s/\\\./\./g;
1272         $v =~ s/\.$//;
1273         }
1274 return $v;
1275 }
1276
1277 # set_ownership(file)
1278 # Sets the BIND ownership and permissions on some file
1279 sub set_ownership
1280 {
1281 local ($user, $group, $perms);
1282 if ($config{'file_owner'}) {
1283         ($user, $group) = split(/:/, $config{'file_owner'});
1284         }
1285 if ($config{'file_perms'}) {
1286         $perms = oct($config{'file_perms'});
1287         }
1288 &set_ownership_permissions($user, $group, $perms, $_[0]);
1289 }
1290
1291 if ($bind_version >= 9) {
1292         @cat_list = ( 'default', 'general', 'database', 'security', 'config',
1293                       'resolver', 'xfer-in', 'xfer-out', 'notify', 'client',
1294                       'unmatched', 'network', 'update', 'queries', 'dispatch',
1295                       'dnssec', 'lame-servers' );
1296         }
1297 else {
1298         @cat_list = ( 'default', 'config', 'parser', 'queries',
1299                       'lame-servers', 'statistics', 'panic', 'update',
1300                       'ncache', 'xfer-in', 'xfer-out', 'db',
1301                       'eventlib', 'packet', 'notify', 'cname', 'security',
1302                       'os', 'insist', 'maintenance', 'load', 'response-checks');
1303         }
1304
1305 @syslog_levels = ( 'kern', 'user', 'mail', 'daemon', 'auth', 'syslog',
1306                    'lpr', 'news', 'uucp', 'cron', 'authpriv', 'ftp',
1307                    'local0', 'local1', 'local2', 'local3',
1308                    'local4', 'local5', 'local6', 'local7' );
1309
1310 @severities = ( 'critical', 'error', 'warning', 'notice', 'info',
1311                 'debug', 'dynamic' );
1312
1313 # can_edit_view(&view | &viewcache)
1314 # Returns 1 if some view can be edited
1315 sub can_edit_view
1316 {
1317 local %vcan;
1318 local $vn = $_[0]->{'members'} ? $_[0]->{'value'} : $_[0]->{'name'};
1319
1320 if ($access{'vlist'} eq '*') {
1321         return 1;
1322         }
1323 elsif ($access{'vlist'} =~ /^\!/) {
1324         foreach (split(/\s+/, $access{'vlist'})) {
1325                 return 0 if ($_ eq $vn);
1326                 }
1327         return 1;
1328         }
1329 else {
1330         foreach (split(/\s+/, $access{'vlist'})) {
1331                 return 1 if ($_ eq $vn);
1332                 }
1333         return 0;
1334         }
1335 }
1336
1337 # wrap_lines(text, width)
1338 # Given a multi-line string, return an array of lines wrapped to
1339 # the given width
1340 sub wrap_lines
1341 {
1342 local $rest = $_[0];
1343 local @rv;
1344 while(length($rest) > $_[1]) {
1345         push(@rv, substr($rest, 0, $_[1]));
1346         $rest = substr($rest, $_[1]);
1347         }
1348 push(@rv, $rest) if ($rest ne '');
1349 return @rv;
1350 }
1351
1352 # add_zone_access(domain)
1353 # Add a new zone to the current user's access list
1354 sub add_zone_access
1355 {
1356 if ($access{'zones'} ne '*' && $access{'zones'} !~ /^\!/) {
1357         $access{'zones'} = join(" ", &unique(
1358                                 split(/\s+/, $access{'zones'}), $_[0]));
1359         &save_module_acl(\%access);
1360         }
1361 }
1362
1363 # is_config_valid()
1364 sub is_config_valid
1365 {
1366 local $conf = &get_config();
1367 local ($opts, $dir);
1368 if (($opts = &find("options", $conf)) &&
1369     ($dir = &find("directory", $opts->{'members'})) &&
1370     !(-d &make_chroot($dir->{'value'}))) {
1371         return 0;
1372         }
1373 return 1;
1374 }
1375
1376 # check_bind_8()
1377 # Returns the --help output if non BIND 8/9, or undef if is
1378 sub check_bind_8
1379 {
1380 local $fflag = $gconfig{'os_type'} eq 'windows' ? '-f' : '';
1381 local $out = `$config{'named_path'} -help $fflag 2>&1`;
1382 return $out !~ /\[-f\]/ && $out !~ /\[-f\|/ ? $out : undef;
1383 }
1384
1385 # get_chroot()
1386 # Returns the chroot directory BIND is running under
1387 sub get_chroot
1388 {
1389 if (!defined($get_chroot_cache)) {
1390         if ($config{'auto_chroot'}) {
1391                 local $out = `$config{'auto_chroot'} 2>/dev/null`;
1392                 if (!$?) {
1393                         $out =~ s/\r|\n//g;
1394                         $get_chroot_cache = $out || "";
1395                         }
1396                 }
1397         if (!defined($get_chroot_cache)) {
1398                 $get_chroot_cache = $config{'chroot'};
1399                 }
1400         }
1401 return $get_chroot_cache;
1402 }
1403
1404 # make_chroot(file, [is-pid])
1405 # Given a path that is relative to the chroot directory, return the real path
1406 sub make_chroot
1407 {
1408 local $chroot = &get_chroot();
1409 return $_[0] if (!$chroot);
1410 return $_[0] if ($_[0] eq $config{'named_conf'} && $config{'no_chroot'});
1411 return $_[0] if ($_[0] eq $config{'rndc_conf'});        # don't chroot rndc.conf
1412 if ($config{'no_pid_chroot'} && $_[1]) {
1413         return $_[0];
1414         }
1415 return $chroot.$_[0];
1416 }
1417
1418 # has_ndc(exclude-mode)
1419 # Returns 2 if rndc is installed, 1 if ndc is instaled, or 0
1420 sub has_ndc
1421 {
1422 if ($config{'rndc_cmd'} =~ /^(\S+)/ && &has_command("$1") && $_[0] != 2) {
1423         return 2;
1424         }
1425 if ($config{'ndc_cmd'} =~ /^(\S+)/ && &has_command("$1") && $_[0] != 1) {
1426         return 1;
1427         }
1428 return 0;
1429 }
1430
1431 # get_pid_file([no-cache])
1432 # Returns the BIND pid file path, relative to any chroot
1433 sub get_pid_file
1434 {
1435 if ($_[0] || !-r $zone_names_cache) {
1436         # Read real config
1437         local $conf = &get_config();
1438         local ($opts, $pidopt);
1439         if (($opts = &find("options", $conf)) &&
1440             ($pidopt = &find("pid-file", $opts->{'members'}))) {
1441                 # read from PID file
1442                 local $pidfile = $pidopt->{'value'};
1443                 if ($pidfile !~ /^\//) {
1444                         local $dir = &find("directory", $opts->{'members'});
1445                         $pidfile = $dir->{'value'}."/".$pidfile;
1446                         }
1447                 return $pidfile;
1448                 }
1449
1450         # use default file
1451         local $p;
1452         foreach $p (split(/\s+/, $config{'pid_file'})) {
1453                 if (-r &make_chroot($p, 1)) {
1454                         return $p;
1455                         }
1456                 }
1457         return "/var/run/named.pid";
1458         }
1459 else {
1460         # Use cache if possible
1461         local %znc;
1462         &read_file_cached($zone_names_cache, \%znc);
1463         if ($znc{'pidfile'} && -r $znc{'pidfile'}) {
1464                 return $znc{'pidfile'};
1465                 }
1466         else {
1467                 return &get_pid_file(1);
1468                 }
1469         }
1470 }
1471
1472 # can_edit_type(record-type)
1473 sub can_edit_type
1474 {
1475 return 1 if (!$access{'types'});
1476 local $t;
1477 foreach $t (split(/\s+/, $access{'types'})) {
1478         return 1 if (lc($t) eq lc($_[0]));
1479         }
1480 return 0;
1481 }
1482
1483 # add_to_file()
1484 # Returns the filename to which new zones should be added (possibly relative to
1485 # a chroot directory)
1486 sub add_to_file
1487 {
1488 if ($config{'zones_file'}) {
1489         local $conf = &get_config();
1490         local $f;
1491         foreach $f (&get_all_config_files($conf)) {
1492                 if (&same_file($f, $config{'zones_file'})) {
1493                         return $config{'zones_file'};
1494                         }
1495                 }
1496         }
1497 return $config{'named_conf'};
1498 }
1499
1500 # get_all_config_files(&conf)
1501 # Returns a list of all config files used by named.conf, including includes
1502 sub get_all_config_files
1503 {
1504 local ($conf) = @_;
1505 local @rv = ( $config{'named_conf'} );
1506 foreach my $c (@$conf) {
1507         push(@rv, $c->{'file'});
1508         if ($c->{'type'} == 1) {
1509                 push(@rv, &get_all_config_files($c->{'members'}));
1510                 }
1511         }
1512 return &unique(@rv);
1513 }
1514
1515 # free_address_button(name)
1516 sub free_address_button
1517 {
1518 return &popup_window_button("free_chooser.cgi", 200, 500, 1,
1519                             [ [ "ifield", $_[0] ] ]);
1520 }
1521
1522 # create_slave_zone(name, master-ip, [view], [file], [&other-ips])
1523 # A convenience function for creating a new slave zone, if it doesn't exist
1524 # yet. Mainly useful for Virtualmin, to avoid excessive transfer of BIND
1525 # configuration data.
1526 # Returns 0 on success, 1 if BIND is not setup, 2 if the zone already exists,
1527 # or 3 if the view doesn't exist, or 4 if the slave file couldn't be created
1528 sub create_slave_zone
1529 {
1530 local $parent = &get_config_parent();
1531 local $conf = $parent->{'members'};
1532 local $opts = &find("options", $conf);
1533 if (!$opts) {
1534         return 1;
1535         }
1536
1537 # Check if exists in the view
1538 if ($_[2]) {
1539         local ($v) = grep { $_->{'value'} eq $_[2] } &find("view", $conf);
1540         @zones = &find("zone", $v->{'members'});
1541         }
1542 else {
1543         @zones = &find("zone", $conf);
1544         }
1545 local ($z) = grep { $_->{'value'} eq $_[0] } @zones;
1546 return 2 if ($z);
1547
1548 # Create it
1549 local @mips = &unique($_[1], @{$_[4]});
1550 local $masters = { 'name' => 'masters',
1551                    'type' => 1,
1552                    'members' => [ map { { 'name' => $_ } } @mips ] };
1553 local $dir = { 'name' => 'zone',
1554                'values' => [ $_[0] ],
1555                'type' => 1,
1556                'members' => [ { 'name' => 'type',
1557                                 'values' => [ 'slave' ] },
1558                                 $masters
1559                             ]
1560              };
1561 local $base = $config{'slave_dir'} || &base_directory();
1562 if ($base !~ /^([a-z]:)?\//) {
1563         # Slave dir is relative .. make absolute
1564         $base = &base_directory()."/".$base;
1565         }
1566 local $file;
1567 if (!$_[3]) {
1568         # File has default name and is under default directory
1569         $file = &automatic_filename($_[0], $_[0] =~ /in-addr/i ? 1 : 0, $base,
1570                                     $_[2]);
1571         push(@{$dir->{'members'}}, { 'name' => 'file',
1572                                      'values' => [ $file ] } );
1573         }
1574 elsif ($_[3] ne "none") {
1575         # File was specified
1576         $file = $_[3] =~ /^\// ? $_[3] : $base."/".$_[3];
1577         push(@{$dir->{'members'}}, { 'name' => 'file',
1578                                      'values' => [ $file ] } );
1579         }
1580
1581 # Create the slave file, so that BIND can write to it
1582 if ($file) {
1583         &open_tempfile(ZONE, ">".&make_chroot($file), 1, 1) || return 4;
1584         &close_tempfile(ZONE);
1585         &set_ownership(&make_chroot($file));
1586         }
1587
1588 # Get and validate view(s)
1589 local @views;
1590 if ($_[2]) {
1591         foreach my $vn (split(/\s+/, $_[2])) {
1592                 my ($view) = grep { $_->{'value'} eq $vn }
1593                                     &find("view", $conf);
1594                 push(@views, $view);
1595                 }
1596         return 3 if (!@views);
1597         }
1598 else {
1599         # Top-level only
1600         push(@views, undef);
1601         }
1602
1603 # Create the zone in all views
1604 foreach my $view (@views) {
1605         &create_zone($dir, $conf, $view ? $view->{'index'} : undef);
1606         }
1607
1608 return 0;
1609 }
1610
1611 # create_master_zone(name, &slave-ips, [view], [file], &records)
1612 # A convenience function for creating a new master zone, if it doesn't exist
1613 # yet. Mainly useful for Virtualmin, to avoid excessive transfer of BIND
1614 # configuration data.
1615 # Returns 0 on success, 1 if BIND is not setup, 2 if the zone already exists,
1616 # or 3 if the view doesn't exist, or 4 if the zone file couldn't be created
1617 sub create_master_zone
1618 {
1619 local ($name, $slaves, $viewname, $file, $records) = @_;
1620 local $parent = &get_config_parent();
1621 local $conf = $parent->{'members'};
1622 local $opts = &find("options", $conf);
1623 if (!$opts) {
1624         return 1;
1625         }
1626
1627 # Check if exists in the view
1628 if ($viewname) {
1629         local ($v) = grep { $_->{'value'} eq $viewname } &find("view", $conf);
1630         @zones = &find("zone", $v->{'members'});
1631         }
1632 else {
1633         @zones = &find("zone", $conf);
1634         }
1635 local ($z) = grep { $_->{'value'} eq $name } @zones;
1636 return 2 if ($z);
1637
1638 # Create it
1639 local $dir = { 'name' => 'zone',
1640                'values' => [ $name ],
1641                'type' => 1,
1642                'members' => [ { 'name' => 'type',
1643                                 'values' => [ 'master' ] },
1644                             ]
1645              };
1646 local $base = $config{'master_dir'} || &base_directory();
1647 if ($base !~ /^([a-z]:)?\//) {
1648         # Master dir is relative .. make absolute
1649         $base = &base_directory()."/".$base;
1650         }
1651 if (!$file) {
1652         # File has default name and is under default directory
1653         $file = &automatic_filename($name, $_[0] =~ /in-addr/i ? 1 : 0, $base,
1654                                     $viewname);
1655         }
1656 push(@{$dir->{'members'}}, { 'name' => 'file',
1657                              'values' => [ $file ] } );
1658
1659 # Add slave IPs
1660 if (@$slaves) {
1661         my $also = { 'name' => 'also-notify',
1662                      'type' => 1,
1663                      'members' => [ ] };
1664         my $allow = { 'name' => 'allow-transfer',
1665                       'type' => 1,
1666                       'members' => [ ] };
1667         foreach my $s (@$slaves) {
1668                 push(@{$also->{'members'}}, { 'name' => $s });
1669                 push(@{$allow->{'members'}}, { 'name' => $s });
1670                 }
1671         push(@{$dir->{'members'}}, $also, $allow);
1672         push(@{$dir->{'members'}}, { 'name' => 'notify',
1673                                      'values' => [ 'yes' ] });
1674         }
1675
1676 # Create the zone file, with records
1677 &open_tempfile(ZONE, ">".&make_chroot($file), 1, 1) || return 4;
1678 &close_tempfile(ZONE);
1679 &set_ownership(&make_chroot($file));
1680 foreach my $r (@$records) {
1681         if ($r->{'defttl'}) {
1682                 &create_defttl($file, $r->{'defttl'});
1683                 }
1684         elsif ($r->{'generate'}) {
1685                 &create_generator($file, @{$r->{'generate'}});
1686                 }
1687         elsif ($r->{'type'}) {
1688                 &create_record($file, $r->{'name'}, $r->{'ttl'}, $r->{'class'},
1689                                       $r->{'type'}, &join_record_values($r),
1690                                       $r->{'comment'});
1691                 }
1692         }
1693
1694 # Get and validate view(s)
1695 local @views;
1696 if ($viewname) {
1697         foreach my $vn (split(/\s+/, $viewname)) {
1698                 my ($view) = grep { $_->{'value'} eq $vn }
1699                                     &find("view", $conf);
1700                 push(@views, $view);
1701                 }
1702         return 3 if (!@views);
1703         }
1704 else {
1705         # Top-level only
1706         push(@views, undef);
1707         }
1708
1709 # Create the zone in all views
1710 foreach my $view (@views) {
1711         &create_zone($dir, $conf, $view ? $view->{'index'} : undef);
1712         }
1713
1714 return 0;
1715 }
1716
1717 # get_master_zone_file(name, [chroot])
1718 # Returns the absolute path to a master zone records file
1719 sub get_master_zone_file
1720 {
1721 local ($name, $chroot) = @_;
1722 local $conf = &get_config();
1723 local @zones = &find("zone", $conf);
1724 local ($v, $z);
1725 foreach $v (&find("view", $conf)) {
1726         push(@zones, &find("zone", $v->{'members'}));
1727         }
1728 local ($z) = grep { lc($_->{'value'}) eq lc($name) } @zones;
1729 return undef if (!$z);
1730 local $file = &find("file", $z->{'members'});
1731 return undef if (!$file);
1732 local $filename = &absolute_path($file->{'values'}->[0]);
1733 $filename = &make_chroot($filename) if ($chroot);
1734 return $filename;
1735 }
1736
1737 # get_master_zone_records(name)
1738 # Returns a list of all the records in a master zone, each of which is a hashref
1739 sub get_master_zone_records
1740 {
1741 local ($name) = @_;
1742 local $filename = &get_master_zone_file($name, 0);
1743 return ( ) if (!$filename);
1744 return &read_zone_file($filename, $name);
1745 }
1746
1747 # save_master_zone_records(name, &records)
1748 # Update all the records in the master zone, based on a list of hashrefs
1749 sub save_master_zone_records
1750 {
1751 local ($name, $records) = @_;
1752 local $filename = &get_master_zone_file($name, 0);
1753 return 0 if (!$filename);
1754 &open_tempfile(ZONE, ">".&make_chroot($filename), 1, 1) || return 0;
1755 &close_tempfile(ZONE);
1756 foreach my $r (@$records) {
1757         if ($r->{'defttl'}) {
1758                 &create_defttl($filename, $r->{'defttl'});
1759                 }
1760         elsif ($r->{'generate'}) {
1761                 &create_generator($filename, @{$r->{'generate'}});
1762                 }
1763         elsif ($r->{'type'}) {
1764                 &create_record($filename, $r->{'name'}, $r->{'ttl'},
1765                                $r->{'class'}, $r->{'type'},
1766                                &join_record_values($r), $r->{'comment'});
1767                 }
1768         }
1769 return 1;
1770 }
1771
1772 # delete_zone(name, [view], [file-too])
1773 # Delete one zone from named.conf
1774 # Returns 0 on success, 1 if the zone was not found, or 2 if the view was not
1775 # found.
1776 sub delete_zone
1777 {
1778 local $parent = &get_config_parent();
1779 local $conf = $parent->{'members'};
1780 local @zones;
1781
1782 if ($_[1]) {
1783         # Look in one or more views
1784         foreach my $vn (split(/\s+/, $_[1])) {
1785                 local ($v) = grep { $_->{'value'} eq $vn }
1786                                   &find("view", $conf);
1787                 if ($v) {
1788                         push(@zones, &find("zone", $v->{'members'}));
1789                         }
1790                 }
1791         return 2 if (!@zones);
1792         $parent = $v;
1793         }
1794 else {
1795         # Look in all views
1796         push(@zones, &find("zone", $conf));
1797         foreach my $v (&find("view", $conf)) {
1798                 push(@zones, &find("zone", $v->{'members'}));
1799                 }
1800         }
1801
1802 # Delete all zones in the list
1803 local $found = 0;
1804 foreach my $z (grep { $_->{'value'} eq $_[0] } @zones) {
1805         $found++;
1806
1807         # Remove from config file
1808         &lock_file($z->{'file'});
1809         &save_directive($z->{'parent'} || $parent, [ $z ], [ ]);
1810         &unlock_file($z->{'file'});
1811         &flush_file_lines();
1812
1813         if ($_[2]) {
1814                 # Remove file
1815                 local $f = &find("file", $z->{'members'});
1816                 if ($f) {
1817                         &unlink_logged(&make_chroot(
1818                                 &absolute_path($f->{'value'})));
1819                         }
1820                 }
1821         }
1822
1823 &flush_zone_names();
1824 return $found ? 0 : 1;
1825 }
1826
1827 # rename_zone(oldname, newname, [view])
1828 # Changes the name of some zone, and perhaps it's file
1829 # Returns 0 on success, 1 if the zone was not found, or 2 if the view was
1830 # not found.
1831 sub rename_zone
1832 {
1833 local $parent = &get_config_parent();
1834 local $conf = $parent->{'members'};
1835 local @zones;
1836 if ($_[2]) {
1837         # Look in one view
1838         local ($v) = grep { $_->{'value'} eq $_[2] } &find("view", $conf);
1839         return 2 if (!$v);
1840         @zones = &find("zone", $v->{'members'});
1841         $parent = $v;
1842         }
1843 else {
1844         # Look in all views
1845         @zones = &find("zone", $conf);
1846         local $v;
1847         foreach $v (&find("view", $conf)) {
1848                 push(@zones, &find("zone", $v->{'members'}));
1849                 }
1850         }
1851 local ($z) = grep { $_->{'value'} eq $_[0] } @zones;
1852 return 1 if (!$z);
1853
1854 $z->{'values'} = [ $_[1] ];
1855 $z->{'value'} = $_[1];
1856 local $file = &find("file", $z->{'members'});
1857 if ($file) {
1858         # Update the file too
1859         local $newfile = $file->{'values'}->[0];
1860         $newfile =~ s/$_[0]/$_[1]/g;
1861         if ($newfile ne $file->{'values'}->[0]) {
1862                 rename(&make_chroot($file->{'values'}->[0]),
1863                        &make_chroot($newfile));
1864                 $file->{'values'}->[0] = $newfile;
1865                 $file->{'value'} = $newfile;
1866                 }
1867         }
1868
1869 &save_directive($parent, [ $z ], [ $z ]);
1870 &flush_file_lines();
1871 &flush_zone_names();
1872 return 0;
1873 }
1874
1875 # restart_bind()
1876 # A convenience function for re-starting BIND. Returns undef on success, or
1877 # an error message on failure.
1878 sub restart_bind
1879 {
1880 if ($config{'restart_cmd'} eq 'restart') {
1881         # Stop and start again
1882         &stop_bind();
1883         return &start_bind();
1884         }
1885 elsif ($config{'restart_cmd'}) {
1886         # Custom command
1887         local $out = &backquote_logged(
1888                 "$config{'restart_cmd'} 2>&1 </dev/null");
1889         if ($?) {
1890                 return &text('restart_ecmd', "<pre>$out</pre>");
1891                 }
1892         }
1893 else {
1894         # Use signal
1895         local $pidfile = &get_pid_file();
1896         local $pid = &check_pid_file(&make_chroot($pidfile, 1));
1897         if (!$pid) {
1898                 return &text('restart_epidfile', $pidfile);
1899                 }
1900         elsif (!&kill_logged('HUP', $pid)) {
1901                 return &text('restart_esig', $pid, $!);
1902                 }
1903         }
1904 &refresh_nscd();
1905 return undef;
1906 }
1907
1908 # restart_zone(domain, [view])
1909 # Call ndc or rndc to apply a single zone. Returns undef on success or an error
1910 # message on failure.
1911 sub restart_zone
1912 {
1913 local ($dom, $view) = @_;
1914 local ($out, $ex);
1915 if ($view) {
1916         # Reload a zone in a view
1917         &try_cmd("freeze ".quotemeta($dom)." IN ".quotemeta($view).
1918                  " 2>&1 </dev/null");
1919         $out = &try_cmd("reload ".quotemeta($dom)." IN ".quotemeta($view).
1920                         " 2>&1 </dev/null");
1921         $ex = $?;
1922         &try_cmd("thaw ".quotemeta($dom)." IN ".quotemeta($view).
1923                  " 2>&1 </dev/null");
1924         }
1925 else {
1926         # Just reload one top-level zone
1927         &try_cmd("freeze ".quotemeta($dom)." 2>&1 </dev/null");
1928         $out = &try_cmd("reload ".quotemeta($dom)." 2>&1 </dev/null");
1929         $ex = $?;
1930         &try_cmd("thaw ".quotemeta($dom)." 2>&1 </dev/null");
1931         }
1932 if ($out =~ /not found/i) {
1933         # Zone is not known to BIND yet - do a total reload
1934         local $err = &restart_bind();
1935         return $err if ($err);
1936         if ($access{'remote'}) {
1937                 # Restart all slaves too
1938                 &error_setup();
1939                 local @slaveerrs = &restart_on_slaves();
1940                 if (@slaveerrs) {
1941                         return &text('restart_errslave',
1942                              "<p>".join("<br>",
1943                                         map { "$_->[0]->{'host'} : $_->[1]" }
1944                                             @slaveerrs));
1945                         }
1946                 }
1947         }
1948 elsif ($ex || $out =~ /failed|not found|error/i) {
1949         return &text('restart_endc', "<tt>".&html_escape($out)."</tt>");
1950         }
1951 &refresh_nscd();
1952 return undef;
1953 }
1954
1955 # start_bind()
1956 # Attempts to start the BIND DNS server, and returns undef on success or an
1957 # error message on failure
1958 sub start_bind
1959 {
1960 local $chroot = &get_chroot();
1961 local $user;
1962 local $cmd;
1963 if ($config{'named_user'}) {
1964         $user = "-u $config{'named_user'}";
1965         if (&get_bind_version() < 9) {
1966                 # Only version 8 takes the -g flag
1967                 if ($config{'named_group'}) {
1968                         $user .= " -g $config{'named_group'}";
1969                         }
1970                 else {
1971                         local @u = getpwnam($config{'named_user'});
1972                         local @g = getgrgid($u[3]);
1973                         $user .= " -g $g[0]";
1974                         }
1975                 }
1976         }
1977 if ($config{'start_cmd'}) {
1978         $cmd = $config{'start_cmd'};
1979         }
1980 elsif (!$chroot) {
1981         $cmd = "$config{'named_path'} -c $config{'named_conf'} $user </dev/null 2>&1";
1982         }
1983 elsif (`$config{'named_path'} -help 2>&1` =~ /\[-t/) {
1984         # use named's chroot option
1985         $cmd = "$config{'named_path'} -c $config{'named_conf'} -t $chroot $user </dev/null 2>&1";
1986         }
1987 else {
1988         # use the chroot command
1989         $cmd = "chroot $chroot $config{'named_path'} -c $config{'named_conf'} $user </dev/null 2>&1";
1990         }
1991
1992 local $out = &backquote_logged("$cmd 2>&1 </dev/null");
1993 local $rv = $?;
1994 if ($rv || $out =~ /chroot.*not available/i) {
1995         return &text('start_error', $out ? "<tt>$out</tt>" : "Unknown error");
1996         }
1997 return undef;
1998 }
1999
2000 # stop_bind()
2001 # Kills the running DNS server, and returns undef on success or an error message
2002 # upon failure
2003 sub stop_bind
2004 {
2005 if ($config{'stop_cmd'}) {
2006         # Just use a command
2007         local $out = &backquote_logged("($config{'stop_cmd'}) 2>&1");
2008         if ($?) {
2009                 return "<pre>$out</pre>";
2010                 }
2011         }
2012 else {
2013         # Kill the process
2014         local $pidfile = &get_pid_file();
2015         local $pid = &check_pid_file(&make_chroot($pidfile, 1));
2016         if (!$pid || !&kill_logged('TERM', $pid)) {
2017                 return $text{'stop_epid'};
2018                 }
2019         }
2020 return undef;
2021 }
2022
2023 # is_bind_running()
2024 # Returns the PID if BIND is running
2025 sub is_bind_running
2026 {
2027 local $pidfile = &get_pid_file();
2028 local $rv = &check_pid_file(&make_chroot($pidfile, 1));
2029 if (!$rv && $gconfig{'os_type'} eq 'windows') {
2030         # Fall back to checking for process
2031         $rv = &find_byname("named");
2032         }
2033 return $rv;
2034 }
2035
2036 # version_atleast(v1, v2, v3)
2037 sub version_atleast
2038 {
2039 local @vsp = split(/\./, $bind_version);
2040 local $i;
2041 for($i=0; $i<@vsp || $i<@_; $i++) {
2042         return 0 if ($vsp[$i] < $_[$i]);
2043         return 1 if ($vsp[$i] > $_[$i]);
2044         }
2045 return 1;       # same!
2046 }
2047
2048 # get_zone_index(name, [view])
2049 # Returns the index of some zone in the real on-disk configuration
2050 sub get_zone_index
2051 {
2052 undef(@get_config_cache);
2053 local $conf = &get_config();
2054 local $vconf = $_[1] ne '' ? $conf->[$in{'view'}]->{'members'} : $conf;
2055 local $c;
2056 foreach $c (@$vconf) {
2057         if ($c->{'name'} eq 'zone' && $c->{'value'} eq $_[0]) {
2058                 return $c->{'index'};
2059                 }
2060         }
2061 return undef;
2062 }
2063
2064 # create_zone(&zone, &conf, [view-idx])
2065 # Convenience function for adding a new zone
2066 sub create_zone
2067 {
2068 local ($dir, $conf, $viewidx) = @_;
2069 if ($viewidx ne "") {
2070         # Adding inside a view
2071         local $view = $conf->[$viewidx];
2072         &lock_file(&make_chroot($view->{'file'}));
2073         &save_directive($view, undef, [ $dir ], 1);
2074         &flush_file_lines();
2075         &unlock_file(&make_chroot($view->{'file'}));
2076         }
2077 else {
2078         # Adding at top level
2079         $dir->{'file'} = &add_to_file();
2080         local $pconf = &get_config_parent($dir->{'file'});
2081         &lock_file(&make_chroot($dir->{'file'}));
2082         &save_directive($pconf, undef, [ $dir ], 0);
2083         &flush_file_lines();
2084         &unlock_file(&make_chroot($dir->{'file'}));
2085         }
2086 &flush_zone_names();
2087 }
2088
2089 $heiropen_file = "$module_config_directory/heiropen";
2090
2091 # get_heiropen()
2092 # Returns an array of open categories
2093 sub get_heiropen
2094 {
2095 open(HEIROPEN, $heiropen_file);
2096 local @heiropen = <HEIROPEN>;
2097 chop(@heiropen);
2098 close(HEIROPEN);
2099 return @heiropen;
2100 }
2101
2102 # save_heiropen(&heir)
2103 sub save_heiropen
2104 {
2105 &open_tempfile(HEIR, ">$heiropen_file");
2106 foreach $h (@{$_[0]}) {
2107         &print_tempfile(HEIR, $h,"\n");
2108         }
2109 &close_tempfile(HEIR);
2110 }
2111
2112 # list_zone_names()
2113 # Returns a list of zone names, types, files and views based on a cache
2114 # built from the primary configuration.
2115 sub list_zone_names
2116 {
2117 local @st = stat($zone_names_cache);
2118 local %znc;
2119 &read_file_cached($zone_names_cache, \%znc);
2120
2121 # Check if any files have changed, or if the master config has changed, or
2122 # the PID file.
2123 local @files;
2124 local ($k, $changed, $filecount, %donefile);
2125 foreach $k (keys %znc) {
2126         if ($k =~ /^file_(.*)$/) {
2127                 $filecount++;
2128                 $donefile{$1}++;
2129                 local @fst = stat($1);
2130                 if ($fst[9] > $st[9]) {
2131                         $changed = 1;
2132                         }
2133                 }
2134         }
2135 if ($changed || !$filecount || $znc{'version'} != $zone_names_version ||
2136     !$donefile{$config{'named_conf'}} ||
2137     $config{'pid_file'} ne $znc{'pidfile_config'}) {
2138         # Yes .. need to rebuild
2139         %znc = ( );
2140         local $conf = &get_config();
2141         local @views = &find("view", $conf);
2142         local ($v, $z);
2143         local $n = 0;
2144         foreach $v (@views) {
2145                 local @vz = &find("zone", $v->{'members'});
2146                 foreach $z (@vz) {
2147                         local $type = &find_value("type", $z->{'members'});
2148                         local $file = &find_value("file", $z->{'members'});
2149                         $znc{"zone_".($n++)} = join("\t", $z->{'value'},
2150                                 $z->{'index'}, $type, $v->{'value'}, $file);
2151                         $files{$z->{'file'}}++;
2152                         }
2153                 $znc{"view_".($n++)} = join("\t", $v->{'value'}, $v->{'index'});
2154                 $files{$v->{'file'}}++;
2155                 }
2156         foreach $z (&find("zone", $conf)) {
2157                 local $type = &find_value("type", $z->{'members'});
2158                 local $file = &find_value("file", $z->{'members'});
2159                 $znc{"zone_".($n++)} = join("\t", $z->{'value'},
2160                         $z->{'index'}, $type, "*", $file);
2161                 $files{$z->{'file'}}++;
2162                 }
2163
2164         # Store the base directory and PID file
2165         $znc{'base'} = &base_directory($conf, 1);
2166         $znc{'pidfile'} = &get_pid_file(1);
2167         $znc{'pidfile_config'} = $config{'pid_file'};
2168
2169         # Store source files
2170         foreach $f (keys %files) {
2171                 local $realf = &make_chroot(&absolute_path($f));
2172                 local @st = stat($realf);
2173                 $znc{"file_".$realf} = $st[9];
2174                 }
2175
2176         $znc{'version'} = $zone_names_version;
2177         &write_file($zone_names_cache, \%znc);
2178         undef(@list_zone_names_cache);
2179         }
2180
2181 # Use in-memory cache
2182 if (scalar(@list_zone_names_cache)) {
2183         return @list_zone_names_cache;
2184         }
2185
2186 # Construct the return value from the hash
2187 local (@rv, %viewidx);
2188 foreach $k (keys %znc) {
2189         if ($k =~ /^zone_(\d+)$/) {
2190                 local ($name, $index, $type, $view, $file) =
2191                         split(/\t+/, $znc{$k}, 5);
2192                 push(@rv, { 'name' => $name,
2193                             'type' => $type,
2194                             'index' => $index,
2195                             'view' => $view eq '*' ? undef : $view,
2196                             'file' => $file });
2197                 }
2198         elsif ($k =~ /^view_(\d+)$/) {
2199                 local ($name, $index) = split(/\t+/, $znc{$k}, 2);
2200                 push(@rv, { 'name' => $name,
2201                             'index' => $index,
2202                             'type' => 'view' });
2203                 $viewidx{$name} = $index;
2204                 }
2205         }
2206 local $z;
2207 foreach $z (@rv) {
2208         if ($z->{'type'} ne 'view' && $z->{'view'} ne '*') {
2209                 $z->{'viewindex'} = $viewidx{$z->{'view'}};
2210                 }
2211         }
2212 @list_zone_names_cache = @rv;
2213 return @rv;
2214 }
2215
2216 # flush_zone_names()
2217 # Clears the in-memory and on-disk zone name caches
2218 sub flush_zone_names
2219 {
2220 undef(@list_zone_names_cache);
2221 unlink($zone_names_cache);
2222 }
2223
2224 # get_zone_name(index|name, [viewindex|"any"])
2225 # Returns a zone cache object, looked up by name or index
2226 sub get_zone_name
2227 {
2228 local @zones = &list_zone_names();
2229 local $field = $_[0] =~ /^\d+$/ ? "index" : "name";
2230 local $z;
2231 foreach $z (@zones) {
2232         if ($z->{$field} eq $_[0] &&
2233             ($_[1] eq 'any' ||
2234              $_[1] eq '' && !defined($z->{'viewindex'}) ||
2235              $_[1] ne '' && $z->{'viewindex'} == $_[1])) {
2236                 return $z;
2237                 }
2238         }
2239 return undef;
2240 }
2241
2242 # list_slave_servers()
2243 # Returns a list of Webmin servers on which slave zones are created / deleted
2244 sub list_slave_servers
2245 {
2246 &foreign_require("servers", "servers-lib.pl");
2247 local %ids = map { $_, 1 } split(/\s+/, $config{'servers'});
2248 local %secids = map { $_, 1 } split(/\s+/, $config{'secservers'});
2249 local @servers = &servers::list_servers();
2250 if (%ids) {
2251         local @rv = grep { $ids{$_->{'id'}} } @servers;
2252         foreach my $s (@rv) {
2253                 $s->{'sec'} = $secids{$s->{'id'}};
2254                 }
2255         return @rv;
2256         }
2257 elsif ($config{'default_slave'} && !defined($config{'servers'})) {
2258         # Migrate old-style setting of single slave
2259         local ($serv) = grep { $_->{'host'} eq $config{'default_slave'} }
2260                              @servers;
2261         if ($serv) {
2262                 &add_slave_server($serv);
2263                 return ($serv);
2264                 }
2265         }
2266 return ( );
2267 }
2268
2269 # add_slave_server(&server)
2270 sub add_slave_server
2271 {
2272 &lock_file($module_config);
2273 &foreign_require("servers", "servers-lib.pl");
2274 local @sids = split(/\s+/, $config{'servers'});
2275 $config{'servers'} = join(" ", @sids, $_[0]->{'id'});
2276 if ($_[0]->{'sec'}) {
2277         local @secsids = split(/\s+/, $config{'secservers'});
2278         $config{'secservers'} = join(" ", @secsids, $_[0]->{'id'});
2279         }
2280 &sync_default_slave();
2281 &save_module_config();
2282 &unlock_file($module_config);
2283 &servers::save_server($_[0]);
2284 }
2285
2286 # delete_slave_server(&server)
2287 sub delete_slave_server
2288 {
2289 &lock_file($module_config);
2290 local @sids = split(/\s+/, $config{'servers'});
2291 $config{'servers'} = join(" ", grep { $_ != $_[0]->{'id'} } @sids);
2292 local @secsids = split(/\s+/, $config{'secservers'});
2293 $config{'secservers'} = join(" ", grep { $_ != $_[0]->{'id'} } @secsids);
2294 &sync_default_slave();
2295 &save_module_config();
2296 &unlock_file($module_config);
2297 }
2298
2299 sub sync_default_slave
2300 {
2301 local @servers = &list_slave_servers();
2302 if (@servers) {
2303         $config{'default_slave'} = $servers[0]->{'host'};
2304         }
2305 else {
2306         $config{'default_slave'} = '';
2307         }
2308 }
2309
2310 # server_name(&server)
2311 sub server_name
2312 {
2313 return $_[0]->{'desc'} ? $_[0]->{'desc'} : $_[0]->{'host'};
2314 }
2315
2316 # create_master_records(file, zone, master, email, refresh, retry, expiry, min,
2317 #                       add-master-ns, add-slaves-ns, add-template, tmpl-ip,
2318 #                       add-template-reverse)
2319 # Creates the records file for a new master zone. Returns undef on success, or
2320 # an error message on failure.
2321 sub create_master_records
2322 {
2323 local ($file, $zone, $master, $email, $refresh, $retry, $expiry, $min,
2324        $add_master, $add_slaves, $add_tmpl, $ip, $addrev) = @_;
2325
2326 # Create the zone file
2327 &lock_file(&make_chroot($file));
2328 &open_tempfile(ZONE, ">".&make_chroot($file), 1) ||
2329         return &text('create_efile3', $file, $!);
2330 &print_tempfile(ZONE, "\$ttl $min\n")
2331         if ($config{'master_ttl'});
2332 &close_tempfile(ZONE);
2333
2334 # create the SOA and NS records
2335 local $serial;
2336 if ($config{'soa_style'} == 1) {
2337         $serial = &date_serial().sprintf("%2.2d", $config{'soa_start'});
2338         }
2339 else {
2340         # Use Unix time for date and running number serials
2341         $serial = time();
2342         }
2343 local $vals = "$master $email (\n".
2344         "\t\t\t$serial\n".
2345         "\t\t\t$refresh\n".
2346         "\t\t\t$retry\n".
2347         "\t\t\t$expiry\n".
2348         "\t\t\t$min )";
2349 &create_record($file, "$zone.", undef, "IN", "SOA", $vals);
2350 &create_record($file, "$zone.", undef, "IN", "NS", $master)
2351         if ($add_master);
2352 if ($add_slaves) {
2353         local $slave;
2354         foreach $slave (&list_slave_servers()) {
2355                 local @bn = $slave->{'nsname'} ||
2356                                 gethostbyname($slave->{'host'});
2357                 local $full = "$bn[0].";
2358                 &create_record($file, "$zone.", undef, "IN", "NS", $full);
2359                 }
2360         }
2361
2362 if ($add_tmpl) {
2363         # Create template records
2364         local %bumped;
2365         for(my $i=0; $config{"tmpl_$i"}; $i++) {
2366                 local @c = split(/\s+/, $config{"tmpl_$i"}, 3);
2367                 local $name = $c[0] eq '.' ? "$zone." : $c[0];
2368                 local $fullname = $name =~ /\.$/ ? $name : "$name.$zone.";
2369                 local $recip = $c[2] || $ip;
2370                 &create_record($file, $name, undef, "IN", $c[1], $recip);
2371                 if ($addrev && ($c[1] eq "A" || $c[1] eq "AAAA")) {
2372                         # Consider adding reverse record
2373                         local ($revconf, $revfile, $revrec) = &find_reverse(
2374                                 $recip, $view);
2375                         if ($revconf && &can_edit_reverse($revconf) &&
2376                             !$revrec) {
2377                                 # Yes, add one
2378                                 local $rname = $c[1] eq "A" ?
2379                                         &ip_to_arpa($recip) :
2380                                         &net_to_ip6int($recip);
2381                                 &lock_file(&make_chroot($revfile));
2382                                 &create_record($revfile, $rname,
2383                                         undef, "IN", "PTR", $fullname);
2384                                 if (!$bumped{$revfile}++) {
2385                                         local @rrecs = &read_zone_file(
2386                                                 $revfile, $revconf->{'name'});
2387                                         &bump_soa_record($revfile, \@rrecs);
2388                                         &sign_dnssec_zone_if_key(
2389                                                 $revconf, \@rrecs);
2390                                         }
2391                                 }
2392                         }
2393                 }
2394         if ($config{'tmpl_include'}) {
2395                 # Add whatever is in the template file
2396                 local $tmpl = &read_file_contents($config{'tmpl_include'});
2397                 local %hash = ( 'ip' => $ip,
2398                                 'dom' => $zone );
2399                 $tmpl = &substitute_template($tmpl, \%hash);
2400                 &open_tempfile(FILE, ">>".&make_chroot($file));
2401                 &print_tempfile(FILE, $tmpl);
2402                 &close_tempfile(FILE);
2403                 }
2404         }
2405
2406 # If DNSSEC for new zones was requested, sign now
2407 local $secerr;
2408 if ($config{'tmpl_dnssec'} && &supports_dnssec()) {
2409         # Compute the size
2410         ($ok, $size) = &compute_dnssec_key_size($config{'tmpl_dnssecalg'},
2411                                                 $config{'tmpl_dnssecsizedef'},
2412                                                 $config{'tmpl_dnssecsize'});
2413         if (!$ok) {
2414                 # Error computing size??
2415                 $secerr = &text('mcreate_ednssecsize', $size);
2416                 }
2417         else {
2418                 # Create key and sign, saving any error
2419                 local $fake = { 'file' => $file,
2420                                 'name' => $zone };
2421                 $secerr = &create_dnssec_key($fake, $config{'tmpl_dnssecalg'},
2422                                              $size);
2423                 if (!$secerr) {
2424                         $secerr = &sign_dnssec_zone($fake);
2425                         }
2426                 }
2427         }
2428
2429 &unlock_file(&make_chroot($file));
2430 &set_ownership(&make_chroot($file));
2431
2432 if ($secerr) {
2433         return &text('mcreate_ednssec', $secerr);
2434         }
2435 return undef;
2436 }
2437
2438 # automatic_filename(domain, is-reverse, base, [viewname])
2439 # Returns a filename for a new zone
2440 sub automatic_filename
2441 {
2442 local ($zone, $rev, $base, $viewname) = @_;
2443 local ($subs, $format);
2444 if ($rev) {
2445         # create filename for reverse zone
2446         $subs = &ip6int_to_net(&arpa_to_ip($zone));
2447         $subs =~ s/\//_/;
2448         $format = $config{'reversezonefilename_format'};
2449         }
2450 else {
2451         # create filename for forward zone
2452         $format = $config{'forwardzonefilename_format'};
2453         $subs = $zone;
2454         }
2455 if ($viewname) {
2456         $subs .= ".".$viewname;
2457         }
2458 $format =~ s/ZONE/$subs/g;
2459 return $file = $base."/".$format;
2460 }
2461
2462 # create_on_slaves(zone, master-ip, file, [&hostnames], [local-view])
2463 # Creates the given zone on all configured slave servers, and returns a list
2464 # of errors
2465 sub create_on_slaves
2466 {
2467 local ($zone, $master, $file, $hosts, $localview) = @_;
2468 local %on = map { $_, 1 } @$hosts;
2469 &remote_error_setup(\&slave_error_handler);
2470 local $slave;
2471 local @slaveerrs;
2472 local @slaves = &list_slave_servers();
2473 foreach $slave (@slaves) {
2474         # Skip if not on list to add to
2475         next if (%on && !$on{$slave->{'host'}} && !$on{$slave->{'nsname'}});
2476
2477         # Connect to server
2478         $slave_error = undef;
2479         &remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2480         if ($slave_error) {
2481                 push(@slaveerrs, [ $slave, $slave_error ]);
2482                 next;
2483                 }
2484
2485         # Work out other slave IPs
2486         local @otherslaves;
2487         if ($config{'other_slaves'}) {
2488                 @otherslaves = grep { $_ ne '' }
2489                                   map { &to_ipaddress($_->{'host'}) }
2490                                       grep { $_ ne $slave } @slaves;
2491                 }
2492         push(@otherslaves, split(/\s+/, $config{'extra_slaves'}));
2493
2494         # Work out the view
2495         my $view;
2496         if ($slave->{'bind8_view'} eq '*') {
2497                 # Same as this system
2498                 $view = $localview;
2499                 }
2500         elsif ($slave->{'bind8_view'}) {
2501                 # Named view
2502                 $view = $slave->{'bind8_view'};
2503                 }
2504
2505         # Create the zone
2506         local $err = &remote_foreign_call($slave, "bind8",
2507                 "create_slave_zone", $zone, $master,
2508                 $view, $file, \@otherslaves);
2509         if ($err == 1) {
2510                 push(@slaveerrs, [ $slave, $text{'master_esetup'} ]);
2511                 }
2512         elsif ($err == 2) {
2513                 push(@slaveerrs, [ $slave, $text{'master_etaken'} ]);
2514                 }
2515         elsif ($err == 3) {
2516                 push(@slaveerrs, [ $slave, &text('master_eview',
2517                                          $slave->{'bind8_view'}) ]);
2518                 }
2519         }
2520 &remote_error_setup();
2521 return @slaveerrs;
2522 }
2523
2524 # delete_on_slaves(domain, [&slave-hostnames], [local-view])
2525 # Delete some domain or all or listed slave servers
2526 sub delete_on_slaves
2527 {
2528 local ($dom, $slavehosts, $localview) = @_;
2529 local %on = map { $_, 1 } @$slavehosts;
2530 &remote_error_setup(\&slave_error_handler);
2531 local $slave;
2532 local @slaveerrs;
2533 foreach $slave (&list_slave_servers()) {
2534         next if (%on && !$on{$slave->{'host'}} && !$on{$slave->{'nsname'}});
2535
2536         # Connect to server
2537         $slave_error = undef;
2538         &remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2539         if ($slave_error) {
2540                 push(@slaveerrs, [ $slave, $slave_error ]);
2541                 next;
2542                 }
2543
2544         # Work out the view
2545         my $view;
2546         if ($slave->{'bind8_view'} eq "*") {
2547                 # Same as on master .. but for now, don't pass in any view
2548                 # so that it will be found automatically
2549                 $view = $localview;
2550                 }
2551         elsif ($slave->{'bind8_view'}) {
2552                 # Named view
2553                 $view = $slave->{'bind8_view'};
2554                 }
2555
2556         # Delete the zone
2557         $err = &remote_foreign_call($slave, "bind8", "delete_zone",
2558                             $dom, $view, 1);
2559         if ($err == 1) {
2560                 push(@slaveerrs, [ $slave, $text{'delete_ezone'} ]);
2561                 }
2562         elsif ($err == 2) {
2563                 push(@slaveerrs, [ $slave, &text('master_eview',
2564                                          $slave->{'bind8_view'}) ]);
2565                 }
2566         }
2567 &remote_error_setup();
2568 return @slaveerrs;
2569 }
2570
2571 # rename_on_slaves(olddomain, newdomain, [&slave-hostnames])
2572 # Changes the name of some domain on all or listed slave servers
2573 sub rename_on_slaves
2574 {
2575 local ($olddom, $newdom, $on) = @_;
2576 local %on = map { $_, 1 } @$on;
2577 &remote_error_setup(\&slave_error_handler);
2578 local $slave;
2579 local @slaveerrs;
2580 foreach $slave (&list_slave_servers()) {
2581         next if (%on && !$on{$slave->{'host'}} && !$on{$slave->{'nsname'}});
2582
2583         # Connect to server
2584         $slave_error = undef;
2585         &remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2586         if ($slave_error) {
2587                 push(@slaveerrs, [ $slave, $slave_error ]);
2588                 next;
2589                 }
2590
2591         # Delete the zone
2592         $err = &remote_foreign_call($slave, "bind8", "rename_zone",
2593                             $olddom, $newdom, $slave->{'bind8_view'});
2594         if ($err == 1) {
2595                 push(@slaveerrs, [ $slave, $text{'delete_ezone'} ]);
2596                 }
2597         elsif ($err == 2) {
2598                 push(@slaveerrs, [ $slave, &text('master_eview',
2599                                          $slave->{'bind8_view'}) ]);
2600                 }
2601         }
2602 &remote_error_setup();
2603 return @slaveerrs;
2604 }
2605
2606 # restart_on_slaves([&slave-hostnames])
2607 # Re-starts BIND on all or listed slave servers, and returns a list of errors
2608 sub restart_on_slaves
2609 {
2610 local %on = map { $_, 1 } @{$_[0]};
2611 &remote_error_setup(\&slave_error_handler);
2612 local $slave;
2613 local @slaveerrs;
2614 foreach $slave (&list_slave_servers()) {
2615         next if (%on && !$on{$slave->{'host'}});
2616
2617         # Find the PID file
2618         $slave_error = undef;
2619         &remote_foreign_require($slave, "bind8", "bind8-lib.pl");
2620         if ($slave_error) {
2621                 push(@slaveerrs, [ $slave, $slave_error ]);
2622                 next;
2623                 }
2624         local $sver = &remote_foreign_call($slave, "bind8",
2625                                      "get_webmin_version");
2626         local $pidfile;
2627         if ($sver >= 1.140) {
2628                 # Call new function to get PID file from slave
2629                 $pidfile = &remote_foreign_call(
2630                         $slave, "bind8", "get_pid_file");
2631                 $pidfile = &remote_foreign_call(
2632                         $slave, "bind8", "make_chroot", $pidfile, 1);
2633                 }
2634         else {
2635                 push(@slaveerrs, [ $slave, &text('restart_eversion',
2636                                                  $slave->{'host'}, 1.140) ]);
2637                 next;
2638                 }
2639
2640         # Read the PID and restart
2641         local $pid = &remote_foreign_call($slave, "bind8",
2642                                     "check_pid_file", $pidfile);
2643         if (!$pid) {
2644                 push(@slaveerrs, [ $slave, &text('restart_erunning2',
2645                                                  $slave->{'host'}) ]);
2646                 next;
2647                 }
2648         $err = &remote_foreign_call($slave, "bind8", "restart_bind");
2649         if ($err) {
2650                 push(@slaveerrs, [ $slave, &text('restart_esig2',
2651                                                  $slave->{'host'}, $err) ]);
2652                 }
2653         }
2654 &remote_error_setup();
2655 return @slaveerrs;
2656 }
2657
2658 sub slave_error_handler
2659 {
2660 $slave_error = $_[0];
2661 }
2662
2663 sub get_forward_record_types
2664 {
2665 return ("A", "NS", "CNAME", "MX", "HINFO", "TXT", "SPF", "WKS", "RP", "PTR", "LOC", "SRV", "KEY", $config{'support_aaaa'} ? ( "AAAA" ) : ( ), @extra_forward);
2666 }
2667
2668 sub get_reverse_record_types
2669 {
2670 return ("PTR", "NS", "CNAME", @extra_reverse);
2671 }
2672
2673 # try_cmd(args, [rndc-args])
2674 # Try calling rndc and ndc with the same args, to see which one works
2675 sub try_cmd
2676 {
2677 local $args = $_[0];
2678 local $rndc_args = $_[1] || $_[0];
2679 local $out;
2680 if (&has_ndc() == 2) {
2681         # Try with rndc
2682         $out = &backquote_logged("$config{'rndc_cmd'} $rndc_args 2>&1 </dev/null");
2683         }
2684 if (&has_ndc() != 2 || $out =~ /connect\s+failed/i) {
2685         if (&has_ndc(2)) {
2686                 # Try with rndc if rndc is not install or failed
2687                 $out = &backquote_logged("$config{'ndc_cmd'} $args 2>&1 </dev/null");
2688                 }
2689         }
2690 return $out;
2691 }
2692
2693 # supports_check_zone()
2694 # Returns 1 if zone checking is supported, 0 if not
2695 sub supports_check_zone
2696 {
2697 return $config{'checkzone'} && &has_command($config{'checkzone'});
2698 }
2699
2700 # check_zone_records(&zone-name|&zone)
2701 # Returns a list of errors from checking some zone file, if any
2702 sub check_zone_records
2703 {
2704 local ($zone) = @_;
2705 local ($zonename, $zonefile);
2706 if ($zone->{'values'}) {
2707         # Zone object
2708         $zonename = $zone->{'values'}->[0];
2709         local $f = &find("file", $zone->{'members'});
2710         $zonefile = $f->{'values'}->[0];
2711         }
2712 else {
2713         # Zone name object
2714         $zonename = $zone->{'name'};
2715         $zonefile = $zone->{'file'};
2716         }
2717 local $out = &backquote_command(
2718         $config{'checkzone'}." ".quotemeta($zonename)." ".
2719         quotemeta(&make_chroot(&absolute_path($zonefile)))." 2>&1 </dev/null");
2720 return $? ? split(/\r?\n/, $out) : ( );
2721 }
2722
2723 # supports_check_conf()
2724 # Returns 1 if BIND configuration checking is supported, 0 if not
2725 sub supports_check_conf
2726 {
2727 return $config{'checkconf'} && &has_command($config{'checkconf'});
2728 }
2729
2730 # check_bind_config([filename])
2731 # Checks the BIND configuration and returns a list of errors
2732 sub check_bind_config
2733 {
2734 local ($file) = @_;
2735 $file ||= &make_chroot($config{'named_conf'});
2736 local $chroot = &get_chroot();
2737 local $out = &backquote_command("$config{'checkconf'} -h 2>&1 </dev/null");
2738 local $zflag = $out =~ /\[-z\]/ ? "-z" : "";
2739 local $out = &backquote_command(
2740         $config{'checkconf'}.
2741         ($chroot && $chroot ne "/" ? " -t ".quotemeta($chroot) : "").
2742         " $zflag 2>&1 </dev/null");
2743 return $? ? grep { !/loaded\s+serial/ } split(/\r?\n/, $out) : ( );
2744 }
2745
2746 # delete_records_file(file)
2747 # Given a file (chroot-relative), delete it with locking, and any associated
2748 # journal or log files
2749 sub delete_records_file
2750 {
2751 local ($file) = @_;
2752 local $zonefile = &make_chroot(&absolute_path($file));
2753 &lock_file($zonefile);
2754 unlink($zonefile);
2755 local $logfile = $zonefile.".log";
2756 if (-r $logfile) {
2757         &lock_file($logfile);
2758         unlink($logfile);
2759         }
2760 local $jnlfile = $zonefile.".jnl";
2761 if (-r $jnlfile) {
2762         &lock_file($jnlfile);
2763         unlink($jnlfile);
2764         }
2765 local $signfile = $zonefile.".signed";
2766 if (-r $signfile) {
2767         &lock_file($signfile);
2768         unlink($signfile);
2769         }
2770 }
2771
2772 # move_zone_button(&config, current-view, zone-index)
2773 # If possible, returns a button row for moving this zone to another view
2774 sub move_zone_button
2775 {
2776 local ($conf, $view, $index) = @_;
2777 local @views = grep { &can_edit_view($_) } &find("view", $conf);
2778 if ($view eq '' && @views || $view ne '' && @views > 1) {
2779         return &ui_buttons_row("move_zone.cgi",
2780                 $text{'master_move'},
2781                 $text{'master_movedesc'},
2782                 &ui_hidden("index", $index).
2783                 &ui_hidden("view", $view),
2784                 &ui_select("newview", undef,
2785                         [ map { [ $_->{'index'}, $_->{'value'} ] }
2786                             grep { $_->{'index'} ne $view } @views ]));
2787         }
2788 return undef;
2789 }
2790
2791 # download_root_zone(file)
2792 # Download the root zone data to a file (under the chroot), and returns undef
2793 # on success or an error message on failure.
2794 sub download_root_zone
2795 {
2796 my ($file) = @_;
2797 my $rootfile = &make_chroot($file);
2798 my $ftperr;
2799 my $temp;
2800 &ftp_download($internic_ftp_host, $internic_ftp_file, $rootfile, \$ftperr);
2801 if ($ftperr) {
2802         # Try IP address directly
2803         $ftperr = undef;
2804         &ftp_download($internic_ftp_ip, $internic_ftp_file, $rootfile,\$ftperr);
2805         }
2806 if ($ftperr) {
2807         # Try compressed version
2808         $ftperr = undef;
2809         $temp = &transname();
2810         &ftp_download($internic_ftp_host, $internic_ftp_gzip, $temp, \$ftperr);
2811         }
2812 if ($ftperr) {
2813         # Try IP address directly for compressed version!
2814         $ftperr = undef;
2815         &ftp_download($internic_ftp_ip, $internic_ftp_gzip, $temp, \$ftperr);
2816         }
2817 return $ftperr if ($ftperr);
2818
2819 # Got some file .. maybe need to un-compress
2820 if ($temp) {
2821         &has_command("gzip") || return $text{'boot_egzip'};
2822         my $out = &backquote_command("gzip -d -c ".quotemeta($temp)." 2>&1 >".
2823                                      quotemeta($rootfile)." </dev/null");
2824         return &text('boot_egzip2', "<tt>".&html_escape($out)."</tt>") if ($?);
2825         }
2826 return undef;
2827 }
2828
2829 # restart_links([&zone-name])
2830 # Returns HTML for links to restart or start BIND, separated by <br> for use
2831 # in ui_print_header
2832 sub restart_links
2833 {
2834 local ($zone) = @_;
2835 local @rv;
2836 if (!$access{'ro'} && $access{'apply'}) {
2837         local $r = $ENV{'REQUEST_METHOD'} eq 'POST' ? 0 : 1;
2838         if (&is_bind_running()) {
2839                 if ($zone && ($access{'apply'} == 1 || $access{'apply'} == 2)) {
2840                         # Apply this zone
2841                         push(@rv, "<a href='restart_zone.cgi?return=$r&".
2842                                   "view=$zone->{'viewindex'}&".
2843                                   "index=$zone->{'index'}'>".
2844                                   "$text{'links_apply'}</a>");
2845                         }
2846                 # Apply whole config
2847                 if ($access{'apply'} == 1 || $access{'apply'} == 3) {
2848                         push(@rv, "<a href='restart.cgi?return=$r'>".
2849                                   "$text{'links_restart'}</a>");
2850                         }
2851                 if ($access{'apply'} == 1) {
2852                         # Stop BIND
2853                         push(@rv, "<a href='stop.cgi?return=$r'>".
2854                                   "$text{'links_stop'}</a>");
2855                         }
2856                 }
2857         elsif ($access{'apply'} == 1) {
2858                 # Start BIND
2859                 push(@rv, "<a href='start.cgi?return=$r'>".
2860                           "$text{'links_start'}</a>");
2861                 }
2862         }
2863 return join('<br>', @rv);
2864 }
2865
2866 # supports_dnssec()
2867 # Returns 1 if zone signing is supported
2868 sub supports_dnssec
2869 {
2870 return &has_command($config{'signzone'}) &&
2871        &has_command($config{'keygen'});
2872 }
2873
2874 # supports_dnssec_client()
2875 # Returns 2 if this BIND can send and verify DNSSEC requests, 1 if the
2876 # dnssec-validation directive is not supported, 0 otherwise
2877 sub supports_dnssec_client
2878 {
2879 return $bind_version >= 9.4 ? 2 :
2880        $bind_version >= 9 ? 1 : 0;
2881 }
2882
2883 # dnssec_size_range(algorithm)
2884 # Given an algorithm like DSA or DH, return the max and min allowed key sizes,
2885 # and an optional forced divisor.
2886 sub dnssec_size_range
2887 {
2888 local ($alg) = @_;
2889 return $alg eq 'RSAMD5' || $alg eq 'RSASHA1' ? ( 512, 2048 ) :
2890        $alg eq 'DH' ? ( 128, 4096 ) :
2891        $alg eq 'DSA' ? ( 512, 1024, 64 ) :
2892        $alg eq 'HMAC-MD5' ? ( 1, 512 ) :
2893        $alg eq 'NSEC3RSASHA1' ? ( 512, 4096 ) :
2894        $alg eq 'NSEC3DSA' ? ( 512, 1024, 64 ) : ( );
2895 }
2896
2897 sub list_dnssec_algorithms
2898 {
2899 return ("RSASHA1", "RSAMD5", "DSA", "DH", "HMAC-MD5",
2900         "NSEC3RSASHA1", "NSEC3DSA");
2901 }
2902
2903 # get_keys_dir(&zone|&zone-name)
2904 # Returns the directory in which to find DNSSEC keys for some zone
2905 sub get_keys_dir
2906 {
2907 local ($z) = @_;
2908 if ($config{'keys_dir'}) {
2909         return $config{'keys_dir'};
2910         }
2911 else {
2912         local $fn = &get_zone_file($z, 2);
2913         $fn =~ s/\/[^\/]+$//;
2914         return $fn;
2915         }
2916 }
2917
2918 # create_dnssec_key(&zone|&zone-name, algorithm, size, single-key)
2919 # Creates a new DNSSEC key for some zone, and places it in the same directory
2920 # as the zone file. Returns undef on success or an error message on failure.
2921 sub create_dnssec_key
2922 {
2923 local ($z, $alg, $size, $single) = @_;
2924 local $fn = &get_keys_dir($z);
2925 $fn || return "Could not work keys directory!";
2926
2927 # Remove all keys for the same zone
2928 opendir(ZONEDIR, $fn);
2929 foreach my $f (readdir(ZONEDIR)) {
2930         if ($f =~ /^K\Q$dom\E\.\+(\d+)\+(\d+)\.(key|private)$/) {
2931                 &unlink_file("$fn/$f");
2932                 }
2933         }
2934 closedir(ZONEDIR);
2935
2936 # Fork a background job to do lots of IO, to generate entropy
2937 local $pid = fork();
2938 if (!$pid) {
2939         exec("find / -type f >/dev/null 2>&1");
2940         exit(1);
2941         }
2942
2943 # Work out zone key size
2944 local $zonesize;
2945 if ($single) {
2946         (undef, $zonesize) = &compute_dnssec_key_size($alg, 1);
2947         }
2948 else {
2949         $zonesize = $size;
2950         }
2951
2952 # Create the zone key
2953 local $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
2954 local $out = &backquote_logged(
2955         "cd ".quotemeta($fn)." && ".
2956         "$config{'keygen'} -a ".quotemeta($alg)." -b ".quotemeta($zonesize).
2957         " -n ZONE $rand_flag $dom 2>&1");
2958 if ($?) {
2959         kill('KILL', $pid);
2960         return $out;
2961         }
2962
2963 # Create the key signing key, if needed
2964 if (!$single) {
2965         $out = &backquote_logged(
2966                 "cd ".quotemeta($fn)." && ".
2967                 "$config{'keygen'} -a ".quotemeta($alg)." -b ".quotemeta($size).
2968                 " -n ZONE -f KSK $rand_flag $dom 2>&1");
2969         kill('KILL', $pid);
2970         if ($?) {
2971                 return $out;
2972                 }
2973         }
2974 else {
2975         kill('KILL', $pid);
2976         }
2977
2978 # Get the new keys
2979 local @keys = &get_dnssec_key($z);
2980 @keys || return "No new keys found for zone : $out";
2981 foreach my $key (@keys) {
2982         ref($key) || return "Failed to get new key for zone : $key";
2983         }
2984 if (!$single) {
2985         @keys == 2 || return "Expected 2 keys for zone, but found ".
2986                              scalar(@keys);
2987         }
2988
2989 # Add the new DNSKEY record(s) to the zone
2990 local $chrootfn = &get_zone_file($z);
2991 local @recs = &read_zone_file($chrootfn, $dom);
2992 for(my $i=$#recs; $i>=0; $i--) {
2993         if ($recs[$i]->{'type'} eq 'DNSKEY') {
2994                 &delete_record($chrootfn, $recs[$i]);
2995                 }
2996         }
2997 foreach my $key (@keys) {
2998         &create_record($chrootfn, $dom.".", undef, "IN", "DNSKEY",
2999                        join(" ", @{$key->{'values'}}));
3000         }
3001 &bump_soa_record($chrootfn, \@recs);
3002
3003 return undef;
3004 }
3005
3006 # resign_dnssec_key(&zone|&zone-name)
3007 # Re-generate the zone key, and re-sign everything. Returns undef on success or
3008 # an error message on failure.
3009 sub resign_dnssec_key
3010 {
3011 local ($z) = @_;
3012 local $fn = &get_zone_file($z);
3013 $fn || return "Could not work out records file!";
3014 local $dir = &get_keys_dir($z);
3015 $dir || return "Could not work out keys directory!";
3016 local $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3017
3018 # Get the old zone key record
3019 local @recs = &read_zone_file($fn, $dom);
3020 local $zonerec;
3021 foreach my $r (@recs) {
3022         if ($r->{'type'} eq 'DNSKEY' && $r->{'values'}->[0] % 2 == 0) {
3023                 $zonerec = $r;
3024                 }
3025         }
3026 $zonerec || return "Could not find DNSSEC zone key record";
3027 local @keys = &get_dnssec_key($z);
3028 @keys == 2 || return "Expected to find 2 keys, but found ".scalar(@keys);
3029 local ($zonekey) = grep { !$_->{'ksk'} } @keys;
3030 $zonekey || return "Could not find DNSSEC zone key";
3031
3032 # Fork a background job to do lots of IO, to generate entropy
3033 local $pid = fork();
3034 if (!$pid) {
3035         exec("find / -type f >/dev/null 2>&1");
3036         exit(1);
3037         }
3038
3039 # Work out zone key size
3040 local $zonesize;
3041 local $alg = $zonekey->{'algorithm'};
3042 (undef, $zonesize) = &compute_dnssec_key_size($alg, 1);
3043
3044 # Generate a new zone key
3045 local $out = &backquote_logged(
3046         "cd ".quotemeta($dir)." && ".
3047         "$config{'keygen'} -a ".quotemeta($alg)." -b ".quotemeta($zonesize).
3048         " -n ZONE $rand_flag $dom 2>&1");
3049 kill('KILL', $pid);
3050 if ($?) {
3051         return "Failed to generate new zone key : $out";
3052         }
3053
3054 # Delete the old key file
3055 &unlink_file($zonekey->{'privatefile'});
3056 &unlink_file($zonekey->{'publicfile'});
3057
3058 # Update the zone file with the new key
3059 @keys = &get_dnssec_key($z);
3060 local ($newzonekey) = grep { !$_->{'ksk'} } @keys;
3061 $newzonekey || return "Could not find new DNSSEC zone key";
3062 &modify_record($fn, $zonerec, $dom.".", undef, "IN", "DNSKEY",
3063                join(" ", @{$newzonekey->{'values'}}));
3064 &bump_soa_record($fn, \@recs);
3065
3066 # Re-sign everything
3067 local $err = &sign_dnssec_zone($z);
3068 return "Re-signing failed : $err" if ($err);
3069
3070 return undef;
3071 }
3072
3073 # delete_dnssec_key(&zone|&zone-name)
3074 # Deletes the key for a zone, and all DNSSEC records
3075 sub delete_dnssec_key
3076 {
3077 local ($z) = @_;
3078 local $fn = &get_zone_file($z);
3079 $fn || return "Could not work out records file!";
3080 local $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3081
3082 # Remove the key
3083 local @keys = &get_dnssec_key($z);
3084 foreach my $key (@keys) {
3085         foreach my $f ('publicfile', 'privatefile') {
3086                 &unlink_file($key->{$f}) if ($key->{$f});
3087                 }
3088         }
3089
3090 # Remove records
3091 local @recs = &read_zone_file($fn, $dom);
3092 for(my $i=$#recs; $i>=0; $i--) {
3093         if ($recs[$i]->{'type'} eq 'NSEC' ||
3094             $recs[$i]->{'type'} eq 'NSEC3' ||
3095             $recs[$i]->{'type'} eq 'RRSIG' ||
3096             $recs[$i]->{'type'} eq 'DNSKEY') {
3097                 &delete_record($fn, $recs[$i]);
3098                 }
3099         }
3100 &bump_soa_record($fn, \@recs);
3101 }
3102
3103 # sign_dnssec_zone(&zone|&zone-name, [bump-soa])
3104 # Replaces a zone's file with one containing signed records.
3105 sub sign_dnssec_zone
3106 {
3107 local ($z, $bump) = @_;
3108 local $chrootfn = &get_zone_file($z, 2);
3109 $chrootfn || return "Could not work out records file!";
3110 local $dir = &get_keys_dir($z);
3111 local $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3112 local $signed = $chrootfn.".webmin-signed";
3113
3114 # Up the serial number, if requested
3115 local $fn = &get_zone_file($z, 1);
3116 $fn =~ /^(.*)\/([^\/]+$)/;
3117 local @recs = &read_zone_file($fn, $dom);
3118 if ($bump) {
3119         &bump_soa_record($fn, \@recs);
3120         }
3121
3122 # Get the zone algorithm
3123 local @keys = &get_dnssec_key($z);
3124 local ($zonekey) = grep { !$_->{'ksk'} } @keys;
3125 local $alg = $zonekey ? $zonekey->{'algorithm'} : "";
3126
3127 # Create the signed file. Sometimes this fails with an error like :
3128 # task.c:310: REQUIRE(task->references > 0) failed
3129 # But re-trying works!?!
3130 local $out;
3131 local $tries = 0;
3132 while($tries++ < 10) {
3133         $out = &backquote_logged(
3134                 "cd ".quotemeta($dir)." && ".
3135                 "$config{'signzone'} -o ".quotemeta($dom).
3136                 ($alg =~ /^NSEC3/ ? " -3 -" : "").
3137                 " -f ".quotemeta($signed)." ".
3138                 quotemeta($chrootfn)." 2>&1");
3139         last if (!$?);
3140         }
3141 return $out if ($tries >= 10);
3142
3143 # Merge records back into original file, by deleting all NSEC and RRSIG records
3144 # and then copying over
3145 for(my $i=$#recs; $i>=0; $i--) {
3146         if ($recs[$i]->{'type'} eq 'NSEC' ||
3147             $recs[$i]->{'type'} eq 'NSEC3' ||
3148             $recs[$i]->{'type'} eq 'RRSIG') {
3149                 &delete_record($fn, $recs[$i]);
3150                 }
3151         }
3152 local @signedrecs = &read_zone_file($fn.".webmin-signed", $dom);
3153 foreach my $r (@signedrecs) {
3154         if ($r->{'type'} eq 'NSEC' ||
3155             $r->{'type'} eq 'NSEC3' ||
3156             $r->{'type'} eq 'RRSIG') {
3157                 &create_record($fn, $r->{'name'}, $r->{'ttl'}, $r->{'class'},
3158                                $r->{'type'}, join(" ", @{$r->{'values'}}),
3159                                $r->{'comment'});
3160                 }
3161         }
3162 &unlink_file($signed);
3163 return undef;
3164 }
3165
3166 # sign_dnssec_zone_if_key(&zone|&zone-name, &recs, [bump-soa])
3167 # If a zone has a DNSSEC key, sign it. Calls error if signing fails
3168 sub sign_dnssec_zone_if_key
3169 {
3170 local ($z, $recs, $bump) = @_;
3171 local $keyrec = &get_dnskey_record($z, $recs);
3172 if ($keyrec) {
3173         local $err = &sign_dnssec_zone($z, $bump);
3174         &error(&text('sign_emsg', $err)) if ($err);
3175         }
3176 }
3177
3178 # get_dnssec_key(&zone|&zone-name)
3179 # Returns a list of hash containing details of a zone's keys, or an error
3180 # message. The KSK is always returned first.
3181 sub get_dnssec_key
3182 {
3183 local ($z) = @_;
3184 local $dir = &get_keys_dir($z);
3185 local $dom = $z->{'members'} ? $z->{'values'}->[0] : $z->{'name'};
3186 local %keymap;
3187 opendir(ZONEDIR, $dir);
3188 foreach my $f (readdir(ZONEDIR)) {
3189         if ($f =~ /^K\Q$dom\E\.\+(\d+)\+(\d+)\.key$/) {
3190                 # Found the public key file .. read it
3191                 $keymap{$2} ||= { };
3192                 local $rv = $keymap{$2};
3193                 $rv->{'publicfile'} = "$dir/$f";
3194                 $rv->{'algorithmid'} = $1;
3195                 $rv->{'keyid'} = $2;
3196                 local $config{'short_names'} = 0;       # Force canonicalization
3197                 local ($pub) = &read_zone_file("$dir/$f", $dom, undef, 0, 1);
3198                 $pub || return "Public key file $dir/$f does not contain ".
3199                                "any records";
3200                 $pub->{'name'} eq $dom."." ||
3201                         return "Public key file $dir/$f is not for zone $dom";
3202                 $pub->{'type'} eq "DNSKEY" ||
3203                         return "Public key file $dir/$f does not contain ".
3204                                "a DNSKEY record";
3205                 $rv->{'ksk'} = $pub->{'values'}->[0] % 2 ? 1 : 0;
3206                 $rv->{'public'} = $pub->{'values'}->[3];
3207                 $rv->{'values'} = $pub->{'values'};
3208                 $rv->{'publictext'} = &read_file_contents("$dir/$f");
3209                 }
3210         elsif ($f =~ /^K\Q$dom\E\.\+(\d+)\+(\d+)\.private$/) {
3211                 # Found the private key file
3212                 $keymap{$2} ||= { };
3213                 local $rv = $keymap{$2};
3214                 $rv->{'privatefile'} = "$dir/$f";
3215                 local $lref = &read_file_lines("$dir/$f", 1);
3216                 foreach my $l (@$lref) {
3217                         if ($l =~ /^(\S+):\s*(.*)/) {
3218                                 local ($n, $v) = ($1, $2);
3219                                 $n =~ s/\(\S+\)$//;
3220                                 $n = lc($n);
3221                                 $rv->{$n} = $v;
3222                                 }
3223                         }
3224                 $rv->{'algorithm'} =~ s/^\d+\s+\((\S+)\)$/$1/;
3225                 $rv->{'privatetext'} = join("\n", @$lref)."\n";
3226                 }
3227         }
3228 closedir(ZONEDIR);
3229
3230 # Sort to put KSK first
3231 local @rv = values %keymap;
3232 @rv = sort { $b->{'ksk'} <=> $a->{'ksk'} } @rv;
3233 return wantarray ? @rv : $rv[0];
3234 }
3235
3236 # compute_dnssec_key_size(algorithm, def-mode, size)
3237 # Given an algorith and size mode (0=entered, 1=average, 2=big), returns either
3238 # 0 and an error message or 1 and the corrected size
3239 sub compute_dnssec_key_size
3240 {
3241 local ($alg, $def, $size) = @_;
3242 local ($min, $max, $factor) = &dnssec_size_range($alg);
3243 local $rv;
3244 if ($def == 1) {
3245         # Average
3246         $rv = int(($max + $min) / 2);
3247         if ($factor) {
3248                 $rv = int($rv / $factor) * $factor;
3249                 }
3250         }
3251 elsif ($def == 2) {
3252         # Max allowed
3253         $rv = $max;
3254         }
3255 else {
3256         $size =~ /^\d+$/ && $size >= $min && $size <= $max ||
3257                 return (0, &text('zonekey_esize', $min, $max));
3258         if ($factor && $size % $factor) {
3259                 return (0, &text('zonekey_efactor', $factor));
3260                 }
3261         $rv = $size;
3262         }
3263 return (1, $rv);
3264 }
3265
3266 # get_dnssec_cron_job()
3267 # Returns the cron job object for re-signing DNSSEC domains
3268 sub get_dnssec_cron_job
3269 {
3270 &foreign_require("cron", "cron-lib.pl");
3271 local ($job) = grep { $_->{'user'} eq 'root' &&
3272                       $_->{'command'} =~ /^\Q$dnssec_cron_cmd\E/ }
3273                     &cron::list_cron_jobs();
3274 return $job;
3275 }
3276
3277 # refresh_nscd()
3278 # Signal nscd to re-read cached DNS info
3279 sub refresh_nscd
3280 {
3281 if (&find_byname("nscd")) {
3282         if (&has_command("nscd")) {
3283                 # Use nscd -i to reload
3284                 &system_logged("nscd -i hosts >/dev/null 2>&1 </dev/null");
3285                 }
3286         else {
3287                 # Send HUP signal
3288                 &kill_byname_logged("nscd", "HUP");
3289                 }
3290         }
3291 }
3292
3293 # transfer_slave_records(zone, &masters, [file])
3294 # Transfer DNS records from a master into some file. Returns a map from master
3295 # IPs to errors.
3296 sub transfer_slave_records
3297 {
3298 my ($dom, $masters, $file) = @_;
3299 my %rv;
3300 my $dig = &has_command("dig");
3301 foreach my $ip (@$masters) {
3302         if (!$dig) {
3303                 $rv{$ip} = "Missing dig command";
3304                 }
3305         else {
3306                 my $out = &backquote_logged("$dig IN AXFR ".quotemeta($dom).
3307                                             " \@".quotemeta($ip)." 2>&1");
3308                 if ($? || $out =~ /Transfer\s+failed/) {
3309                         $rv{$ip} = $out;
3310                         }
3311                 elsif (!$out) {
3312                         $rv{$ip} = "No records transferred";
3313                         }
3314                 else {
3315                         if ($file) {
3316                                 &open_tempfile(XFER, ">$file");
3317                                 &print_tempfile(XFER, $out);
3318                                 &close_tempfile(XFER);
3319                                 $file = undef;
3320                                 }
3321                         }
3322                 }
3323         }
3324 return \%rv;
3325 }
3326
3327 1;
3328