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