dhcpd/dhcpd-lib.pl

   1 # dhcpd-lib.pl
   2 # Functions for parsing the DHCPD config file
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 &init_config();
   7
   8 # get_parent_config([file])
   9 # Returns a dummy parent structure for the DHCP config
  10 sub get_parent_config
  11 {
  12 local ($file) = @_;
  13 $file ||= $config{'dhcpd_conf'};
  14 return $get_parent_config_cache{$file} if ($get_parent_config_cache{$file});
  15 return $get_parent_config_cache{$file} = {
  16          'file' => $file,
  17          'members' => &get_config($file),
  18          'line' => -1,
  19          'fline' => -1,
  20          'eline' => $get_config_lines };
  21 }
  22
  23 # get_config([file])
  24 # Parses the DHCPD config file into a data structure
  25 sub get_config
  26 {
  27 local ($file) = @_;
  28 $file ||= $config{'dhcpd_conf'};
  29 return $get_config_cache{$file} if ($get_config_cache{$file});
  30 local @rv = &get_config_file($file, \$get_config_lines);
  31 $get_config_cache{$file} = \@rv;
  32 return $get_config_cache{$file};
  33 }
  34
  35 # get_config_file(file, [&lines])
  36 sub get_config_file
  37 {
  38 local (@tok, $i, $j, @rv, $c);
  39 $i = 0; $j = 0;
  40 local $lines = &tokenize_file($_[0], \@tok);
  41 ${$_[1]} = $lines if ($_[1]);
  42 while($i < @tok) {
  43         local $str = &parse_struct(\@tok, \$i, $j++, $_[0]);
  44         if ($str) {
  45                 if ($str->{'name'} eq 'include') {
  46                         # Expand the include directive
  47                         local $p = $str->{'values'}->[0];
  48                         if ($p !~ /^\//) {
  49                                 $config{'dhcpd_conf'} =~ /^(\S+)\//;
  50                                 $p = "$1/$p";
  51                                 }
  52                         local @inc = &get_config_file($p);
  53                         $j--;
  54                         foreach $c (@inc) {
  55                                 $c->{'index'} += $j;
  56                                 }
  57                         push(@rv, @inc);
  58                         $j += scalar(@inc);
  59                         }
  60                 else {
  61                         push(@rv, $str);
  62                         }
  63                 }
  64         }
  65 return @rv;
  66 }
  67
  68 # tokenize_file(file, &tokens)
  69 sub tokenize_file
  70 {
  71 local $lines = 0;
  72 local ($line, $cmode);
  73 open(FILE, $_[0]);
  74 while($line = <FILE>) {
  75         # strip comments
  76         $line =~ s/\r|\n//g;
  77         $line =~ s/^([^"#]*)#.*$/$1/g;
  78         $line =~ s/^([^"]*)\/\/.*$/$1/g;
  79         $line =~ s/^([^"]*)\s+#.*$/$1/g;        # remove stuff after #, unless
  80         $line =~ s/^(.*".*".*)\s+#.*$/$1/g;     #  it is inside quotes
  81         $line =~ s/\\\\/\\134/g;                # convert \\ into \134
  82         $line =~ s/([^\\])\\"/$1\\042/g;        # convert escaped quotes to \042
  83         while(1) {
  84                 if (!$cmode && $line =~ /\/\*/ && $line !~ /\".*\/\*.*\"/) {
  85                         # start of a C-style comment
  86                         $cmode = 1;
  87                         $line =~ s/\/\*.*$//g;
  88                         }
  89                 elsif ($cmode) {
  90                         if ($line =~ /\*\//) {
  91                                 # end of comment
  92                                 $cmode = 0;
  93                                 $line =~ s/^.*\*\///g;
  94                                 }
  95                         else { $line = ""; last; }
  96                         }
  97                 else { last; }
  98                 }
  99
 100         # split line into tokens
 101         while(1) {
 102                 if ($line =~ /^\s*"([^"]*)"(.*)$/) {
 103                         push(@{$_[1]}, [ $1, 1, $lines ]); $line = $2;
 104                         }
 105                 elsif ($line =~ /^\s*([{};,])(.*)$/) {
 106                         push(@{$_[1]}, [ $1, 0, $lines ]); $line = $2;
 107                         }
 108                 elsif ($line =~ /^\s*([^{}; \t,]+)(.*)$/) {
 109                         push(@{$_[1]}, [ $1, 0, $lines ]); $line = $2;
 110                         }
 111                 else { last; }
 112                 }
 113         $lines++;
 114         }
 115 close(FILE);
 116 #print STDERR "tokenized $_[0] into $lines\n";
 117 return $lines;
 118 }
 119
 120 # parse_struct(&tokens, &token_num, index, file)
 121 # A structure can either have one value, or a list of values.
 122 # Pos will end up at the start of the next structure
 123 sub parse_struct
 124 {
 125 local(%str, $i, $t, @vals, @quotes, $str, @text);
 126 local $lref = &read_file_lines($_[3]);
 127 $i = ${$_[1]};
 128 $str{'name'} = $_[0]->[$i]->[0];
 129 $str{'line'} = $_[0]->[$i]->[2];
 130 if ($str{'line'} && $lref->[$str{'line'}-1] =~ /^\s*(#|\/\/)\s*(.*)/) {
 131         # Previous line is a comment, so include it in the directive
 132         $str{'line'}--;
 133         $str{'comment'} = $2;
 134         }
 135 #print STDERR "parsing at line $str{'line'} = $str{'name'}\n";
 136 while(1) {
 137         # Add values between directive name and { or ;
 138         $t = $_[0]->[++$i];
 139         if (($t->[0] eq "{" && $str{'name'} ne 'option') ||
 140             $t->[0] eq ";") { last; }
 141         elsif (!defined($t->[0])) { ${$_[1]} = $i; return undef; }
 142         else { push(@vals, $t->[0]); push(@quotes, $t->[1]); }
 143         push(@text, $t->[1] ? "\"$t->[0]\"" : $t->[0]);
 144         }
 145 $str{'values'} = \@vals;
 146 $str{'quotes'} = \@quotes;
 147 $str{'value'} = $vals[0];
 148 $str{'text'} = join(" ", @text);
 149 $str{'index'} = $_[2];
 150 $str{'file'} = $_[3];
 151 $str{'fline'} = $_[0]->[$i]->[2];
 152 if ($t->[0] eq "{") {
 153         # contains sub-structures.. parse them
 154         local(@mems, $j);
 155         $i++;           # skip {
 156         $str{'type'} = 1;
 157         $j = 0;
 158         while($_[0]->[$i]->[0] ne "}") {
 159                 if (!defined($_[0]->[$i]->[0]))
 160                         { ${$_[1]} = $i; return undef; }
 161                 $str = &parse_struct($_[0], \$i, $j++, $_[3]);
 162                 if ($str) {
 163                         $str->{'parent'} = \%str;
 164                         push(@mems, $str);
 165                         }
 166                 }
 167         $str{'members'} = \@mems;
 168         $i++;           # skip trailing }
 169         }
 170 else {
 171         # only a single value..
 172         $str{'type'} = 0;
 173         $i++;   # skip trailing ;
 174         }
 175 $str{'eline'} = $_[0]->[$i-1]->[2];     # ending line is the line number the
 176                                         # trailing ; is on
 177 ${$_[1]} = $i;
 178 return \%str;
 179 }
 180
 181 # find(name, &array)
 182 sub find
 183 {
 184 local($c, @rv);
 185 foreach $c (@{$_[1]}) {
 186         if ($c->{'name'} eq $_[0]) {
 187                 push(@rv, $c);
 188                 }
 189         }
 190 return @rv ? wantarray ? @rv : $rv[0]
 191            : wantarray ? () : undef;
 192 }
 193
 194 # find_value(name, &array)
 195 sub find_value
 196 {
 197 local(@v);
 198 @v = &find($_[0], $_[1]);
 199 if (!@v) { return undef; }
 200 elsif (wantarray) { return map { $_->{'value'} } @v; }
 201 else { return $v[0]->{'value'}; }
 202 }
 203
 204 # choice_input(text, name, &config, [display, option]+)
 205 sub choice_input
 206 {
 207 local($rv, $v, $i, @ops);
 208 $rv = "<td><b>$_[0]</b></td> <td>";
 209 $v = &find_value($_[1], $_[2]);
 210 for($i=3; $i<@_; $i+=2) {
 211         @ops = split(/,/, $_[$i+1]);
 212         $rv .= "<input type=radio name=$_[1] value=\"$ops[0]\" ".
 213                 ($v eq $ops[0] ? "checked" : "").">$_[$i]\n";
 214         }
 215 return $rv."</td>\n";
 216 }
 217
 218 # wide_choice_input(text, name, &config, [display, option]+)
 219 sub wide_choice_input
 220 {
 221 local($rv, $v, $i, @ops);
 222 $rv = "<td><b>$_[0]</b></td> <td colspan=3>";
 223 $v = &find_value($_[1], $_[2]);
 224 for($i=3; $i<@_; $i+=2) {
 225         @ops = split(/,/, $_[$i+1]);
 226         $rv .= "<input type=radio name=$_[1] value=\"$ops[0]\" ".
 227                 ($v eq $ops[0] ? "checked" : "").">$_[$i]\n";
 228         }
 229 return $rv."</td>\n";
 230 }
 231
 232 # save_choice(name, &parent, indent)
 233 sub save_choice
 234 {
 235 local($nd);
 236 if ($in{$_[0]}) { $nd = { 'name' => $_[0], 'values' => [ $in{$_[0]} ] }; }
 237 &save_directive($_[1], $_[0], $nd ? [ $nd ] : [ ], $_[2], 1);
 238 }
 239
 240 # addr_match_input(text, name, &config)
 241 # A field for editing a list of addresses, ACLs and partial IP addresses
 242 sub addr_match_input
 243 {
 244 local($v, $rv, $av, @av);
 245 $v = &find($_[1], $_[2]);
 246 $rv = "<td><b>$_[0]</b></td> <td>";
 247 $rv .= "<input type=radio name=$_[1]_def value=1 ".
 248        ($v ? "" : "checked").">Default ";
 249 $rv .= "<input type=radio name=$_[1]_def value=0 ".
 250        ($v ? "checked" : "").">Listed..<br>";
 251 foreach $av (@{$v->{'members'}}) { push(@av, $av->{'name'}); }
 252 $rv .= "<textarea name=$_[1] rows=3 cols=15>".
 253         join("\n", @av)."</textarea></td>\n";
 254 }
 255
 256 sub save_addr_match
 257 {
 258 local($addr, @vals, $dir);
 259 if ($in{"$_[0]_def"}) { &save_directive($_[1], $_[0], [ ], $_[2], 1); }
 260 else {
 261         foreach $addr (split(/\s+/, $in{$_[0]})) {
 262                 push(@vals, { 'name' => $addr });
 263                 }
 264         $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 265         &save_directive($_[1], $_[0], [ $dir ], $_[2], 1);
 266         }
 267 }
 268
 269 # address_input(text, name, &config, type)
 270 sub address_input
 271 {
 272 local($v, $rv, $av, @av);
 273 $v = &find($_[1], $_[2]);
 274 foreach $av (@{$v->{'members'}}) { push(@av, $av->{'name'}); }
 275 if ($_[3] == 0) {
 276         # text area
 277         $rv = "<td><b>$_[0]</b></td> <td>";
 278         $rv .= "<textarea name=$_[1] rows=3 cols=15>".
 279                 join("\n", @av)."</textarea></td>\n";
 280         }
 281 else {
 282         $rv = "<td><b>$_[0]</b></td> <td colspan=3>";
 283         $rv .= "<input name=$_[1] size=50 value=\"".join(' ',@av)."\"></td>\n";
 284         }
 285 return $rv;
 286 }
 287
 288 sub save_address
 289 {
 290 local($addr, @vals, $dir);
 291 foreach $addr (split(/\s+/, $in{$_[0]})) {
 292         &check_ipaddress($addr) || &error("'$addr' is not a valid IP address");
 293         push(@vals, { 'name' => $addr });
 294         }
 295 $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 296 &save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2], 1);
 297 }
 298
 299 # opt_input(text, name, &config, default, size, units)
 300 # Returns HTML for an optional text field
 301 sub opt_input
 302 {
 303 local($v, $rv);
 304 $v = &find($_[1], $_[2]);
 305 $rv = "<td><b>$_[0]</b></td> <td nowrap";
 306 $rv .= $_[4] > 30 ? " colspan=3>\n" : ">\n";
 307 $rv .= sprintf "<input type=radio name=$_[1]_def value=1 %s> $_[3]\n",
 308         $v ? "" : "checked";
 309 $rv .= sprintf "<input type=radio name=$_[1]_def value=0 %s> ",
 310         $v ? "checked" : "";
 311 $rv .= sprintf "<input name=$_[1] size=$_[4] value=\"%s\"> $_[5]</td>\n",
 312         $v ? $v->{'value'} : "";
 313 return $rv;
 314 }
 315
 316 # save_opt(name, &func, &parent, [indent], [quote])
 317 # Saves an optional text field
 318 sub save_opt
 319 {
 320 local($dir);
 321 if ($in{"$_[0]_def"}) { &save_directive($_[2], $_[0], [ ], $_[3], 1); }
 322 elsif ($_[1] && ($err = &{$_[1]}($in{$_[0]}))) {
 323         &error($err);
 324         }
 325 else {
 326         $dir = { 'name' => $_[0],
 327                  'values' => [ $in{$_[0]} ],
 328                  'quotes' => [ $_[4] ] };
 329         &save_directive($_[2], $_[0], [ $dir ], $_[3], 1);
 330         }
 331 }
 332
 333 # save_directive(&parent, [name|&oldvalues], &values, indent, start, [after])
 334 # Given a structure containing a directive name, type, values and members
 335 # add, update or remove that directive in config structure and data files.
 336 # Updating of files assumes that there is no overlap between directives -
 337 # each line in the config file must contain part or all of only one directive.
 338 sub save_directive
 339 {
 340 local(@oldv, @newv, $pm, $i, $o, $n, $lref, @nl);
 341 $pm = $_[0]->{'members'};
 342 @oldv = ref($_[1]) ? @{$_[1]} : &find($_[1], $pm);
 343 @newv = @{$_[2]};
 344 for($i=0; $i<@oldv || $i<@newv; $i++) {
 345         if ($i >= @oldv && $_[5]) {
 346                 # a new directive is being added.. put it after some other
 347                 $lref = $_[0]->{'file'} ? &read_file_lines($_[0]->{'file'})
 348                                         : [ ];
 349                 @nl = &directive_lines($newv[$i], $_[3]);
 350                 $nline = $_[5]->{'line'}+1;
 351                 $nidx = &indexof($_[5], @$pm) + 1;
 352                 splice(@$lref, $nline, 0, @nl);
 353                 &renumber(&get_config(), $nline,
 354                           $_[0]->{'file'}, scalar(@nl));
 355                 &renumber_index($_[0]->{'members'}, $nidx, 1);
 356                 $newv[$i]->{'index'} = $nidx;
 357                 $newv[$i]->{'file'} = $_[0]->{'file'};
 358                 $newv[$i]->{'line'} = $nline;
 359                 $newv[$i]->{'eline'} = $nline + scalar(@nl);
 360                 splice(@$pm, $nidx, 0, $newv[$i]);
 361                 }
 362         elsif ($i >= @oldv && $_[4]) {
 363                 # a new directive is being added.. put it at the start of
 364                 # the parent
 365                 $lref = $_[0]->{'file'} ? &read_file_lines($_[0]->{'file'})
 366                                         : [ ];
 367                 @nl = &directive_lines($newv[$i], $_[3]);
 368                 $nline = $_[0]->{'fline'}+1;
 369                 splice(@$lref, $nline, 0, @nl);
 370                 &renumber(&get_config(), $nline,
 371                           $_[0]->{'file'}, scalar(@nl));
 372                 &renumber_index($_[0]->{'members'}, 0, 1);
 373                 $newv[$i]->{'file'} = $_[0]->{'file'};
 374                 $newv[$i]->{'line'} = $nline;
 375                 $newv[$i]->{'eline'} = $nline + scalar(@nl);
 376                 unshift(@$pm, $newv[$i]);
 377                 }
 378         elsif ($i >= @oldv) {
 379                 # a new directive is being added.. put it at the end of
 380                 # the parent
 381                 $lref = $_[0]->{'file'} ? &read_file_lines($_[0]->{'file'}) : [ ];
 382                 @nl = &directive_lines($newv[$i], $_[3]);
 383                 splice(@$lref, $_[0]->{'eline'}, 0, @nl);
 384                 &renumber(&get_config(), $_[0]->{'eline'},
 385                           $_[0]->{'file'}, scalar(@nl));
 386                 $newv[$i]->{'file'} = $_[0]->{'file'};
 387                 $newv[$i]->{'line'} = $_[0]->{'eline'};
 388                 $newv[$i]->{'eline'} = $_[0]->{'eline'} + scalar(@nl) - 1;
 389                 push(@$pm, $newv[$i]);
 390                 }
 391         elsif ($i >= @newv) {
 392                 # a directive was deleted
 393                 $lref = $oldv[$i]->{'file'} ? &read_file_lines($oldv[$i]->{'file'}) : [ ];
 394                 $ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
 395                 splice(@$lref, $oldv[$i]->{'line'}, $ol);
 396                 &renumber(&get_config(), $oldv[$i]->{'eline'},
 397                           $oldv[$i]->{'file'}, -$ol);
 398                 &renumber_index($_[0]->{'members'}, $oldv[$i]->{'index'}, -1);
 399                 splice(@$pm, &indexof($oldv[$i], @$pm), 1);
 400                 }
 401         else {
 402                 # updating some directive
 403                 if (!defined($newv[$i]->{'comment'})) {
 404                         $newv[$i]->{'comment'} = $oldv[$i]->{'comment'};
 405                         }
 406                 $lref = $oldv[$i]->{'file'} ? &read_file_lines($oldv[$i]->{'file'}) : [ ];
 407                 @nl = &directive_lines($newv[$i], $_[3]);
 408                 $ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
 409                 splice(@$lref, $oldv[$i]->{'line'}, $ol, @nl);
 410                 &renumber(&get_config(), $oldv[$i]->{'eline'},
 411                           $oldv[$i]->{'file'}, scalar(@nl) - $ol);
 412                 $newv[$i]->{'file'} = $_[0]->{'file'};
 413                 $newv[$i]->{'line'} = $oldv[$i]->{'line'};
 414                 $newv[$i]->{'eline'} = $oldv[$i]->{'line'} + scalar(@nl) - 1;
 415                 $pm->[&indexof($oldv[$i], @$pm)] = $newv[$i];
 416                 }
 417         }
 418 }
 419
 420 # directive_lines(&directive, tabs)
 421 # Renders some directive into a number of lines of text
 422 sub directive_lines
 423 {
 424 local(@rv, $v, $m, $i);
 425 if ($_[0]->{'comment'}) {
 426         push(@rv, ("\t" x $_[1])."# ".$_[0]->{'comment'});
 427         }
 428 local $first = "\t" x $_[1];
 429 $first .= "$_[0]->{'name'}";
 430 for($i=0; $i<@{$_[0]->{'values'}}; $i++) {
 431         $v = $_[0]->{'values'}->[$i];
 432         if ($_[0]->{'quotes'}->[$i]) { $first .= " \"$v\""; }
 433         else { $first .= " $v"; }
 434         }
 435 push(@rv, $first);
 436 if ($_[0]->{'type'}) {
 437         # multiple values.. include them as well
 438         $rv[$#rv] .= " {";
 439         foreach $m (@{$_[0]->{'members'}}) {
 440                 push(@rv, &directive_lines($m, $_[1]+1));
 441                 }
 442         push(@rv, ("\t" x ($_[1]+1))."}");
 443         }
 444 else { $rv[$#rv] .= ";"; }
 445 return @rv;
 446 }
 447
 448 # renumber(&directives, line, file, count)
 449 # Runs through the given array of directives and increases the line numbers
 450 # of all those greater than some line by the given count
 451 sub renumber
 452 {
 453 local($d);
 454 local ($list, $line, $file, $count) = @_;
 455 return if (!$count);
 456 foreach $d (@$list) {
 457         if ($d->{'file'} eq $file) {
 458                 if ($d->{'line'} >= $line) { $d->{'line'} += $count; }
 459                 if ($d->{'eline'} >= $line) { $d->{'eline'} += $count; }
 460                 }
 461         if ($d->{'type'}) {
 462                 &renumber($d->{'members'}, $line, $file, $count);
 463                 }
 464         }
 465 }
 466
 467 # renumber_index(&directives, index, count)
 468 sub renumber_index
 469 {
 470 local($d);
 471 foreach $d (@{$_[0]}) {
 472         if ($d->{'index'} >= $_[1]) {
 473                 $d->{'index'} += $_[2];
 474                 }
 475         }
 476 }
 477
 478 # directive_diff(&d1, &d2)
 479 # Do two directives differ?
 480 sub directive_diff
 481 {
 482 local $i;
 483 local ($d1, $d2) = @_;
 484 return 1 if ($d1->{'name'} ne $d2->{'name'});
 485 local $l1 = @{$d1->{'values'}};
 486 local $l2 = @{$d2->{'values'}};
 487 return 1 if ($l1 != $l2);
 488 for($i=0; $i<$l1; $i++) {
 489         return 1 if ($d1->{'values'}->[$i] ne $d2->{'values'}->[$i]);
 490         }
 491 return 1 if ($d1->{'type'} != $d2->{'type'});
 492 if ($d1->{'type'}) {
 493         $l1 = @{$d1->{'members'}};
 494         $l2 = @{$d2->{'members'}};
 495         return 1 if ($l1 != $l2);
 496         for($i=0; $i<$l1; $i++) {
 497                 return 1 if (&directive_diff($d1->{'members'}->[$i],
 498                                              $d2->{'members'}->[$i]));
 499                 }
 500         }
 501 return 0;
 502 }
 503
 504 # group_name(&members, &group)
 505 sub group_name
 506 {
 507 local @opts = &find("option", $_[1]->{'members'});
 508 local ($dn) = grep { $_->{'values'}->[0] eq 'domain-name' } @opts;
 509 return  $config{'group_name'} == 1 && $dn ?
 510                 &text('index_gdom',$dn->{'values'}->[1]) :
 511         $config{'group_name'} == 2 && $_[1]->{'comment'} ?
 512                 $_[1]->{'comment'} :
 513         $_[1]->{'values'}->[0] ? $_[1]->{'values'}->[0] :
 514         $_[0] == 0 ? $text{'index_nomemb'} :
 515         $_[0] == 1 ? $text{'index_1memb'} :
 516         $_[0] >= 2 && $_[0] <= 4 ? &text('index_234memb', $_[0]) :
 517         &text('index_memb', $_[0]);
 518
 519 }
 520
 521 # get_subnets_and_hosts()
 522 # returns the references to sorted lists of hosts and subnets
 523 sub get_subnets_and_hosts
 524 {
 525 return (\@get_subnets_cache, \@get_hosts_cache)
 526         if (@get_subnets_cache && @get_hosts_cache);
 527
 528 local(@subn,@host,@group,@shan, $s,$h,$g,$sn, $conf);
 529 $conf = &get_config();
 530
 531 # get top level hosts and groups
 532 @host = &find("host", $conf);
 533 foreach $h (&find("host", $conf)) {
 534         $h->{'order'} = $h->{'index'};
 535         }
 536 @group = &find("group", $conf);
 537 foreach $g (@group) {
 538         foreach $h (&find("host", $g->{'members'})) {
 539                 push(@host, $h);
 540                 }
 541         }
 542 @subn = &find("subnet", $conf);
 543 foreach $u (@subn) {
 544         foreach $h (&find("host", $u->{'members'})) {
 545                 push(@host, $h);
 546                 }
 547         foreach $g (&find("group", $u->{'members'})) {
 548                 push(@group, $g);
 549                 foreach $h (&find("host", $g->{'members'})) {
 550                         push(@host, $h);
 551                         }
 552                 }
 553         }
 554 @shan = &find("shared-network", $conf);
 555 foreach $s (@shan) {
 556         foreach $h (&find("host", $s->{'members'})) {
 557                 push(@host, $h);
 558                 }
 559         foreach $g (&find("group", $s->{'members'})) {
 560                 push(@group, $g);
 561                 foreach $h (&find("host", $g->{'members'})) {
 562                         push(@host, $h);
 563                         }
 564                 }
 565         foreach $u (&find("subnet", $s->{'members'})) {
 566                 push(@subn, $u);
 567                 foreach $h (&find("host", $u->{'members'})) {
 568                         push(@host, $h);
 569                         }
 570                 foreach $g (&find("group", $sn->{'members'})) {
 571                         push(@group, $g);
 572                         foreach $h (&find("host", $g->{'members'})) {
 573                                 push(@host, $h);
 574                                 }
 575                         }
 576                 }
 577         }
 578 @get_subnets_cache = sort { $a->{'order'} <=> $b->{'order'} } @subn;
 579 @get_hosts_cache = sort { $a->{'order'} <=> $b->{'order'} } @host;
 580
 581 return (\@get_subnets_cache, \@get_hosts_cache);
 582 }
 583
 584 sub get_subnets
 585 {
 586 local ($sr, $hr) = &get_subnets_and_hosts();
 587 return @{$sr};
 588 }
 589
 590 sub get_hosts
 591 {
 592 local ($sr, $hr) = &get_subnets_and_hosts();
 593 return @{$hr};
 594 }
 595
 596 sub get_host_shared_network
 597 {
 598 local ($h) = @_;
 599 local $shar;
 600 while($h) {
 601         if ($h->{'name'} eq 'shared-network') {
 602                 return $h;
 603                 }
 604         $h = $h->{'parent'};
 605         }
 606 return undef;
 607 }
 608
 609 sub get_my_shared_network_hosts
 610 {
 611 local ($h) = @_;
 612 local $shar = &get_host_shared_network($h);
 613 local @rv;
 614 foreach my $oh (&get_hosts()) {
 615         if (&get_host_shared_network($oh) eq $shar) {
 616                 push(@rv, $oh);
 617                 }
 618         }
 619 return @rv;
 620 }
 621
 622 # hash that links objtypes shortcuts with object names
 623 %obj_names2types = qw(host hst group grp subnet sub shared-network sha);
 624
 625 # get_branch(objtype, [addmode])
 626 # usefull for edit_*.cgi and save_*.cgi scripts
 627 # $objtype = one of 'hst' 'grp' 'sub' 'sha'
 628 sub get_branch
 629 {
 630 local %obj_types2names = reverse %obj_names2types;
 631 local $name = $obj_types2names{$_[0]};
 632 local ($parnode, $nparnode, $node, $indent, $nindent);
 633 $parnode = $nparnode = &get_parent_config(
 634         $_[1] && $in{'sidx'} eq '' && $in{'uidx'} eq '' && $in{'gidx'} eq '' &&
 635         $in{'parent'} eq '' ? $config{'add_file'} : undef);
 636 $indent = $nindent = 0;
 637 foreach ($in{'sidx'}, $in{'uidx'}, $in{'gidx'}) {
 638     if ($_ ne '') {
 639                 $parnode = $parnode->{'members'}->[$_];
 640                 $indent++;
 641                 }
 642     }
 643
 644 if (!($in{'delete'} && $in{'options'})) {
 645         if ($in{'assign'} > 0 && !defined($in{'parent'})) {
 646                 # A quirk for not javascript-capable browser
 647                 # New parent is undefined yet; we need 2nd step
 648                 undef $nparnode;
 649                 }
 650         else {
 651                 foreach (split(/\,/, $in{'parent'})) {
 652                         $nindent++;
 653                         if ($_ < @{$nparnode->{'members'}}) {
 654                                 $nparnode = $nparnode->{'members'}->[$_];
 655                                 }
 656                         }
 657                 }
 658         }
 659
 660 if (!$in{'new'}) {
 661         $node = $parnode->{'members'}->[$in{'idx'}];
 662         }
 663 else {
 664         die "Wrong call to get_nodes: pass objtype for new object" unless $name;
 665         # Construct new node structure
 666         $node->{'name'} = $name;
 667         $node->{'type'} = 1;
 668         $node->{'members'} = [ ];
 669         }
 670 return ($parnode, $node, $indent, $nparnode, $nindent);
 671 }
 672
 673 # can(permissions_string, \%access, \%config_node, smode)
 674 # this is a cached wrapper of can_noncached(...)
 675 sub can
 676 {
 677 local ($perm, $acc, $node, $smode) = @_;
 678 if (defined($can_cache) &&
 679         ($can_perm_cache eq $perm) &&
 680         ($can_node_cache eq $node) &&
 681         ($can_smode_cache eq $smode)) {
 682         return $can_cache;
 683         }
 684 else {
 685         $can_perm_cache = $perm;
 686         $can_node_cache = $node;
 687         $can_smode_cache = $smode;
 688         return ($can_cache = &can_noncached(@_));
 689         }
 690 }
 691
 692 # can_noncached(permissions_string, \%access, \%config_node, smode)
 693 # check global and per-object permissions:
 694 #
 695 # permissions_string= 'c' 'r' 'w' or any combination.
 696 # smode= 0 or undef - check only current, 1 - recursive childs check,
 697 #       2 - check parents, 3 - check parents and all childs
 698 #       note: while deleting an object you must allways enforce smode=1 or 3
 699 #               because all child objects are deletes recursevly.
 700 #       this maybe an optional parameter
 701 sub can_noncached
 702 {
 703 local $acl;
 704 local ($perm, $acc, $node, $smode) = @_;
 705 local @perm = split(//, $perm);
 706
 707 if ($node ne get_parent_config() &&
 708     $node ne get_parent_config($config{'add_file'})) {
 709         foreach (@perm) {
 710                 next if ($_ ne 'c') &&  ($_ ne 'r') && ($_ ne 'w');
 711                 return 0 unless $acc->{$_ . '_' . $obj_names2types{$node->{'name'}} };
 712                 }
 713
 714         # per-object permissions
 715         return 0 unless &can_node(\@perm, $acc, $node);
 716
 717         if (($acc->{'smode'} == 2) || ($smode == 2) ||
 718             ($acc->{'smode'} == 3) || ($smode == 3)) {
 719                 # check parents
 720                 #$parnode=&get_parent_config();
 721                 #foreach ($in{'sidx'}, $in{'uidx'}, $in{'gidx'}) {
 722                 #       if ($_ ne '') {
 723                 #               $parnode = $parnode->{'members'}->[$_];
 724                 #               return 0 unless &can_node(\@perm, $acc, $parnode);
 725                 #               }
 726                 #       }
 727                 $parnode = $node->{'parent'};
 728                 while($parnode) {
 729                         return 0 unless &can_node(\@perm, $acc, $parnode);
 730                         $parnode = $parnode->{'parent'};
 731                         }
 732                 }
 733
 734         if (($acc->{'smode'} == 1) || ($smode == 1) ||
 735                 ($acc->{'smode'} == 3) || ($smode == 3)) {
 736                 # check childs
 737                 return 0 unless &can_subtree(\@perm, $acc, $node);
 738                 }
 739         }
 740 return 1;
 741 }
 742
 743 # can_node(\@perm, $acc, $node)
 744 # checks object permissions for current node
 745 sub can_node
 746 {
 747 local ($rperm, $acc, $node)=@_;
 748 # per-object permissions
 749 local $otype=$obj_names2types{$node->{'name'}};
 750 if ($acc->{'per_' . $otype . '_acls'}) {
 751         local $name = $node->{'values'}->[0];
 752         if (!$name && $node->{'name'} eq 'group') {
 753                 local @opts = &find("option", $node->{'members'});
 754                 local ($dn) = grep { $_->{'values'}->[0] eq 'domain-name' }
 755                                    @opts;
 756                 if ($dn) {
 757                         $name = $dn->{'values'}->[1];
 758                         }
 759                 else {
 760                         $name = $node->{'index'};
 761                         }
 762                 }
 763         local $acl = $acc->{'ACL' . $otype . '_' . $name};
 764         foreach (@{$rperm}) {
 765                 next if $_ eq 'c'; # skip creation perms for per-obj acls
 766                 return 0 if index($acl, $_) == -1;
 767                 }
 768         }
 769 return 1;
 770 }
 771
 772 # can_subtree(\@perm, $acc, $node)
 773 # checks object permissions for subtree
 774 sub can_subtree
 775 {
 776 local ($rperm, $acc, $node)=@_;
 777 return 0 unless &can_node($rperm, $acc, $node);
 778 if($node->{'members'}) {
 779         # recursevly process this subtree
 780         foreach (@{$node->{'members'}}) {
 781                 return 0 unless &can_subtree($rperm, $acc, $_);
 782                 }
 783         }
 784 return 1;
 785 }
 786
 787 # save_dhcpd_acl(permissions_string, obj_type, \%access, obj_name)
 788 sub save_dhcpd_acl
 789 {
 790 $_[2]->{'ACL'.$_[1].'_'.$_[3]} = $_[0];
 791 undef($can_cache);
 792 return &save_module_acl($_[2]);
 793 }
 794
 795 # drop_dhcpd_acl(obj_type, \%access, obj_name)
 796 sub drop_dhcpd_acl
 797 {
 798 delete($_[1]->{'ACL'.$_[0].'_'.$_[2]});
 799 undef($can_cache);
 800 return &save_module_acl($_[1]);
 801 }
 802
 803 # find_recursive(name, &config, [parent])
 804 # Returns a list of all config entries with some name, no matter where they
 805 # are in the heirarchy
 806 sub find_recursive
 807 {
 808 local ($c, @rv);
 809 foreach $c (@{$_[1]}) {
 810         if ($c->{'name'} eq $_[0]) {
 811                 push(@rv, $c);
 812                 }
 813         if ($c->{'type'}) {
 814                 push(@rv, &find_recursive($_[0], $c->{'members'}, $c));
 815                 }
 816         }
 817 return @rv;
 818 }
 819
 820 # find_parents(&object)
 821 sub find_parents
 822 {
 823 local ($gidx, $uidx, $sidx);
 824 local $p = $_[0]->{'parent'};
 825 while($p) {
 826         $gidx = $p->{'index'} if ($p->{'name'} eq 'group');
 827         $uidx = $p->{'index'} if ($p->{'name'} eq 'subnet');
 828         $sidx = $p->{'index'} if ($p->{'name'} eq 'shared-network');
 829         $p = $p->{'parent'};
 830         }
 831 return ($gidx, $uidx, $sidx);
 832 }
 833
 834 # get_dhcpd_version(&out)
 835 sub get_dhcpd_version
 836 {
 837 local $out = `$config{'dhcpd_path'} -v 2>&1`;
 838 ${$_[0]} = $out;
 839 return $config{'version'} if ($config{'version'});
 840 return undef if ($out !~ /DHCP/ || $out =~ /V1/);
 841 return $out =~ /\sV([0-9\.]+)/ ? $1 :
 842        $out =~ /\sDHCP\s+Server\s+([0-9\.]+)/ ? $1 :
 843        $out =~ /-T/ ? 3 : 2;
 844 }
 845
 846 # restart_dhcpd()
 847 # Re-starts the DHCP server, and returns an error message if something fails
 848 sub restart_dhcpd
 849 {
 850 local $out;
 851 if ($config{'restart_cmd'}) {
 852         # Run the restart script
 853         $out = &backquote_logged("$config{'restart_cmd'} 2>&1");
 854         }
 855 else {
 856         # Kill and re-run the server
 857         local $pid = &is_dhcpd_running();
 858         $pid && &kill_logged('TERM', $pid) ||
 859                 return "$text{'restart_errmsg2'} $pid : $!";
 860         if ($config{'start_cmd'}) {
 861                 $out = &backquote_logged("$config{'start_cmd'} 2>&1");
 862                 }
 863         else {
 864                 $out = &backquote_logged("$config{'dhcpd_path'} -cf $config{'dhcpd_conf'} -lf $config{'lease_file'} $config{'interfaces'} 2>&1");
 865                 }
 866         }
 867 if ($?) {
 868         return &parse_error_out($out);
 869         }
 870 return undef;
 871 }
 872
 873 # Find and add config file lines around those in an error message
 874 sub parse_error_out
 875 {
 876 local ($out) = @_;
 877 local $conftext;
 878 if ($out =~ /(\S+)\s+line\s+(\d+):/) {
 879         local ($file, $line) = ($1, $2);
 880         local $lref = &read_file_lines($file, 1);
 881         local $start = $line - 5;
 882         local $end = $line + 5;
 883         $start = 0 if ($start < 0);
 884         $end = @$lref-1 if ($end > @$lref-1);
 885         $conftext = &text('restart_conftext', $line, $file)."<br>".
 886             "<pre>".&html_escape(join("\n", @$lref[$start .. $end]))."</pre>";
 887         }
 888 return "<pre>".&html_escape($out)."</pre>".$conftext;
 889 }
 890
 891 # stop_dhcpd()
 892 # Stop the running DHCP server. Returns undef on success, or an error message
 893 # on failure.
 894 sub stop_dhcpd
 895 {
 896 if ($config{'stop_cmd'}) {
 897         local $out = &backquote_logged("$config{'stop_cmd'} 2>&1");
 898         return $? ? "<pre>$out</pre>" : undef;
 899         }
 900 else {
 901         local $pid = &is_dhcpd_running();
 902         if ($pid && &kill_logged('TERM', $pid)) {
 903                 return undef;
 904                 }
 905         else {
 906                 return $text{'stop_ekill'};
 907                 }
 908         }
 909 }
 910
 911 # start_dhcpd()
 912 # Attempt to start the DHCP server, returning undef on success or an error
 913 # message on failure.
 914 sub start_dhcpd
 915 {
 916 if (!-r $config{'lease_file'}) {
 917         # first time.. need to create the lease file
 918         $config{'lease_file'} =~ /^(\S+)\/([^\/]+)$/;
 919         if (!-d $1) { mkdir($1, 0755); }
 920         open(LEASE, ">$config{'lease_file'}");
 921         close(LEASE);
 922         }
 923 local $out;
 924 if ($config{'start_cmd'}) {
 925         $out = &backquote_logged("$config{'start_cmd'} 2>&1");
 926         }
 927 else {
 928         $out = &backquote_logged("$config{'dhcpd_path'} -cf $config{'dhcpd_conf'} -lf $config{'lease_file'} $config{'interfaces'} 2>&1");
 929         }
 930 if ($? || $out =~ /error|failed/i) {
 931         return &parse_error_out($out);
 932         }
 933 else {
 934         return undef;
 935         }
 936 }
 937
 938 # search_re(value, match)
 939 sub search_re
 940 {
 941 if ($in{'match'} == 0) {
 942         return lc($_[0]) eq lc($_[1]);
 943         }
 944 elsif ($in{'match'} == 1) {
 945         return $_[0] =~ /\Q$_[1]\E/i;
 946         }
 947 else {
 948         return eval { $_[0] =~ /$_[1]/i };
 949         }
 950 }
 951
 952 # get_pid_file()
 953 # Returns the DHCP server PID file
 954 sub get_pid_file
 955 {
 956 local $conf = &get_config();
 957 local $file = &find_value("pid-file-name", $conf);
 958 return $file || $config{'pid_file'};
 959 }
 960
 961 sub expand_ip_range
 962 {
 963 local ($s, $e) = @_;
 964 local @rs = split(/\./, $s);
 965 local @re = split(/\./, $e);
 966 local @rv;
 967 for(my $i=$rs[0]; $i<=$re[0]; $i++) {
 968         for(my $j=$rs[1]; $j<=$re[1]; $j++) {
 969                 for(my $k=$rs[2]; $k<=$re[2]; $k++) {
 970                         for(my $l=$rs[3]; $l<=$re[3]; $l++) {
 971                                 push(@rv, "$i.$j.$k.$l");
 972                                 }
 973                         }
 974                 }
 975         }
 976 return @rv;
 977 }
 978
 979 # is_dhcpd_running()
 980 # Returns the pid if the DHCP server is running
 981 sub is_dhcpd_running
 982 {
 983 local $pidfile = &get_pid_file();
 984 if ($pidfile) {
 985         return &check_pid_file($pidfile);
 986         }
 987 else {
 988         local ($pid) = &find_byname("dhcpd");
 989         return $pid;
 990         }
 991 }
 992
 993 1;