dhcpd/dhcpd-lib.pl.bak

   1 # dhcpd-lib.pl
   2 # Functions for parsing the DHCPD config file
   3
   4 do '../web-lib.pl';
   5 &init_config();
   6
   7 # get_parent_config()
   8 # Returns a dummy parent structure for the DHCP config
   9 sub get_parent_config
  10 {
  11 return $get_parent_config_cache if ($get_parent_config_cache);
  12 return ($get_parent_config_cache =
  13                 {
  14                  'file' => $config{'dhcpd_conf'},
  15              'members' => &get_config(),
  16              'line' => -1,
  17              'eline' => $get_config_lines
  18                   } );
  19 }
  20
  21 # get_config()
  22 # Parses the DHCPD config file into a data structure
  23 sub get_config
  24 {
  25 return \@get_config_cache if (@get_config_cache);
  26 local(@tok, @rv, $i, $t, $j, $ifile, @inc, $str);
  27
  28 $get_config_lines = &tokenize_file($config{'dhcpd_conf'}, \@tok);
  29 $i = 0; $j = 0;
  30 while($i < @tok) {
  31         $str = &parse_struct(\@tok, \$i, $j++, $config{'dhcpd_conf'});
  32         if ($str) { push(@rv, $str); }
  33         }
  34 @get_config_cache = @rv;
  35 return \@get_config_cache;
  36 }
  37
  38 # tokenize_file(file, &tokens)
  39 sub tokenize_file
  40 {
  41 local $lines = 0;
  42 local ($line, $cmode);
  43 open(FILE, $_[0]);
  44 while($line = <FILE>) {
  45         # strip comments
  46         $line =~ s/\r|\n//g;
  47         $line =~ s/^([^"#]*)#.*$/$1/g;
  48         $line =~ s/^([^"]*)\/\/.*$/$1/g;
  49         while(1) {
  50                 if (!$cmode && $line =~ /\/\*/) {
  51                         # start of a C-style comment
  52                         $cmode = 1;
  53                         $line =~ s/\/\*.*$//g;
  54                         }
  55                 elsif ($cmode) {
  56                         if ($line =~ /\*\//) {
  57                                 # end of comment
  58                                 $cmode = 0;
  59                                 $line =~ s/^.*\*\///g;
  60                                 }
  61                         else { $line = ""; last; }
  62                         }
  63                 else { last; }
  64                 }
  65
  66         # split line into tokens
  67         while(1) {
  68                 if ($line =~ /^\s*"([^"]*)"(.*)$/) {
  69                         push(@{$_[1]}, [ $1, 1, $lines ]); $line = $2;
  70                         }
  71                 elsif ($line =~ /^\s*([{};])(.*)$/) {
  72                         push(@{$_[1]}, [ $1, 0, $lines ]); $line = $2;
  73                         }
  74                 elsif ($line =~ /^\s*([^{}; \t]+)(.*)$/) {
  75                         push(@{$_[1]}, [ $1, 0, $lines ]); $line = $2;
  76                         }
  77                 else { last; }
  78                 }
  79         $lines++;
  80         }
  81 close(FILE);
  82 return $lines;
  83 }
  84
  85 # parse_struct(&tokens, &token_num, index, file)
  86 # A structure can either have one value, or a list of values.
  87 # Pos will end up at the start of the next structure
  88 sub parse_struct
  89 {
  90 local(%str, $i, $t, @vals, @quotes, $str, @text);
  91 $i = ${$_[1]};
  92 $str{'name'} = $_[0]->[$i]->[0];
  93 $str{'line'} = $_[0]->[$i]->[2];
  94 while(1) {
  95         $t = $_[0]->[++$i];
  96         if ($t->[0] eq "{" || $t->[0] eq ";") { last; }
  97         elsif (!defined($t->[0])) { ${$_[1]} = $i; return undef; }
  98         else { push(@vals, $t->[0]); push(@quotes, $t->[1]); }
  99         push(@text, $t->[1] ? "\"$t->[0]\"" : $t->[0]);
 100         }
 101 $str{'values'} = \@vals;
 102 $str{'quotes'} = \@quotes;
 103 $str{'value'} = $vals[0];
 104 $str{'text'} = join(" ", @text);
 105 $str{'index'} = $_[2];
 106 $str{'file'} = $_[3];
 107 if ($t->[0] eq "{") {
 108         # contains sub-structures.. parse them
 109         local(@mems, $j);
 110         $i++;           # skip {
 111         $str{'type'} = 1;
 112         $j = 0;
 113         while($_[0]->[$i]->[0] ne "}") {
 114                 if (!defined($_[0]->[$i]->[0]))
 115                         { ${$_[1]} = $i; return undef; }
 116                 $str = &parse_struct($_[0], \$i, $j++, $_[3]);
 117                 if ($str) { push(@mems, $str); }
 118                 }
 119         $str{'members'} = \@mems;
 120         $i++;           # skip trailing }
 121         }
 122 else {
 123         # only a single value..
 124         $str{'type'} = 0;
 125         $i++;   # skip trailing ;
 126         }
 127 $str{'eline'} = $_[0]->[$i-1]->[2];     # ending line is the line number the
 128                                         # trailing ; is on
 129 ${$_[1]} = $i;
 130 return \%str;
 131 }
 132
 133 # find(name, &array)
 134 sub find
 135 {
 136 local($c, @rv);
 137 foreach $c (@{$_[1]}) {
 138         if ($c->{'name'} eq $_[0]) {
 139                 push(@rv, $c);
 140                 }
 141         }
 142 return @rv ? wantarray ? @rv : $rv[0]
 143            : wantarray ? () : undef;
 144 }
 145
 146 # find_value(name, &array)
 147 sub find_value
 148 {
 149 local(@v);
 150 @v = &find($_[0], $_[1]);
 151 if (!@v) { return undef; }
 152 elsif (wantarray) { return map { $_->{'value'} } @v; }
 153 else { return $v[0]->{'value'}; }
 154 }
 155
 156 # choice_input(text, name, &config, [display, option]+)
 157 sub choice_input
 158 {
 159 local($rv, $v, $i, @ops);
 160 $rv = "<td><b>$_[0]</b></td> <td>";
 161 $v = &find_value($_[1], $_[2]);
 162 for($i=3; $i<@_; $i+=2) {
 163         @ops = split(/,/, $_[$i+1]);
 164         $rv .= "<input type=radio name=$_[1] value=\"$ops[0]\" ".
 165                 ($v eq $ops[0] ? "checked" : "").">$_[$i]\n";
 166         }
 167 return $rv."</td>\n";
 168 }
 169
 170 # save_choice(name, &parent, indent)
 171 sub save_choice
 172 {
 173 local($nd);
 174 if ($in{$_[0]}) { $nd = { 'name' => $_[0], 'values' => [ $in{$_[0]} ] }; }
 175 &save_directive($_[1], $_[0], $nd ? [ $nd ] : [ ], $_[2], 1);
 176 }
 177
 178 # addr_match_input(text, name, &config)
 179 # A field for editing a list of addresses, ACLs and partial IP addresses
 180 sub addr_match_input
 181 {
 182 local($v, $rv, $av, @av);
 183 $v = &find($_[1], $_[2]);
 184 $rv = "<td><b>$_[0]</b></td> <td>";
 185 $rv .= "<input type=radio name=$_[1]_def value=1 ".
 186        ($v ? "" : "checked").">Default ";
 187 $rv .= "<input type=radio name=$_[1]_def value=0 ".
 188        ($v ? "checked" : "").">Listed..<br>";
 189 foreach $av (@{$v->{'members'}}) { push(@av, $av->{'name'}); }
 190 $rv .= "<textarea name=$_[1] rows=3 cols=15>".
 191         join("\n", @av)."</textarea></td>\n";
 192 }
 193
 194 sub save_addr_match
 195 {
 196 local($addr, @vals, $dir);
 197 if ($in{"$_[0]_def"}) { &save_directive($_[1], $_[0], [ ], $_[2], 1); }
 198 else {
 199         foreach $addr (split(/\s+/, $in{$_[0]})) {
 200                 push(@vals, { 'name' => $addr });
 201                 }
 202         $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 203         &save_directive($_[1], $_[0], [ $dir ], $_[2], 1);
 204         }
 205 }
 206
 207 # address_input(text, name, &config, type)
 208 sub address_input
 209 {
 210 local($v, $rv, $av, @av);
 211 $v = &find($_[1], $_[2]);
 212 foreach $av (@{$v->{'members'}}) { push(@av, $av->{'name'}); }
 213 if ($_[3] == 0) {
 214         # text area
 215         $rv = "<td><b>$_[0]</b></td> <td>";
 216         $rv .= "<textarea name=$_[1] rows=3 cols=15>".
 217                 join("\n", @av)."</textarea></td>\n";
 218         }
 219 else {
 220         $rv = "<td><b>$_[0]</b></td> <td colspan=3>";
 221         $rv .= "<input name=$_[1] size=50 value=\"".join(' ',@av)."\"></td>\n";
 222         }
 223 return $rv;
 224 }
 225
 226 sub save_address
 227 {
 228 local($addr, @vals, $dir);
 229 foreach $addr (split(/\s+/, $in{$_[0]})) {
 230         &check_ipaddress($addr) || &error("'$addr' is not a valid IP address");
 231         push(@vals, { 'name' => $addr });
 232         }
 233 $dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
 234 &save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2], 1);
 235 }
 236
 237 # opt_input(text, name, &config, default, size, units)
 238 sub opt_input
 239 {
 240 local($v, $rv);
 241 $v = &find($_[1], $_[2]);
 242 $rv = "<td><b>$_[0]</b></td> <td nowrap";
 243 $rv .= $_[4] > 30 ? " colspan=3>\n" : ">\n";
 244 $rv .= sprintf "<input type=radio name=$_[1]_def value=1 %s> $_[3]\n",
 245         $v ? "" : "checked";
 246 $rv .= sprintf "<input type=radio name=$_[1]_def value=0 %s> ",
 247         $v ? "checked" : "";
 248 $rv .= sprintf "<input name=$_[1] size=$_[4] value=\"%s\"> $_[5]</td>\n",
 249         $v ? $v->{'value'} : "";
 250 return $rv;
 251 }
 252
 253 # save_opt(name, &func, &parent, [indent], [quote])
 254 sub save_opt
 255 {
 256 local($dir);
 257 if ($in{"$_[0]_def"}) { &save_directive($_[2], $_[0], [ ], $_[3], 1); }
 258 elsif ($_[1] && ($err = &{$_[1]}($in{$_[0]}))) {
 259         &error($err);
 260         }
 261 else {
 262         $dir = { 'name' => $_[0],
 263                  'values' => [ $in{$_[0]} ],
 264                  'quotes' => [ $_[4] ] };
 265         &save_directive($_[2], $_[0], [ $dir ], $_[3], 1);
 266         }
 267 }
 268
 269 # save_directive(&parent, [name|&oldvalues], &values, indent, start)
 270 # Given a structure containing a directive name, type, values and members
 271 # add, update or remove that directive in config structure and data files.
 272 # Updating of files assumes that there is no overlap between directives -
 273 # each line in the config file must contain part or all of only one directive.
 274 sub save_directive
 275 {
 276 local(@oldv, @newv, $pm, $i, $o, $n, $lref, @nl);
 277 $pm = $_[0]->{'members'};
 278 @oldv = ref($_[1]) ? @{$_[1]} : &find($_[1], $pm);
 279 @newv = @{$_[2]};
 280 for($i=0; $i<@oldv || $i<@newv; $i++) {
 281         if ($i >= @oldv && $_[4]) {
 282                 # a new directive is being added.. put it at the start of
 283                 # the parent
 284                 $lref = &read_file_lines($_[0]->{'file'});
 285                 @nl = &directive_lines($newv[$i], $_[3]);
 286                 splice(@$lref, $_[0]->{'line'}+1, 0, @nl);
 287                 &renumber(&get_config(), $_[0]->{'line'}+1,
 288                           $_[0]->{'file'}, scalar(@nl));
 289                 &renumber_index($_[0]->{'members'}, 0, 1);
 290                 $newv[$i]->{'file'} = $_[0]->{'file'};
 291                 $newv[$i]->{'line'} = $_[0]->{'line'}+1;
 292                 $newv[$i]->{'eline'} = $_[0]->{'line'} + scalar(@nl);
 293                 unshift(@$pm, $newv[$i]);
 294                 }
 295         elsif ($i >= @oldv) {
 296                 # a new directive is being added.. put it at the end of
 297                 # the parent
 298                 $lref = &read_file_lines($_[0]->{'file'});
 299                 @nl = &directive_lines($newv[$i], $_[3]);
 300                 splice(@$lref, $_[0]->{'eline'}, 0, @nl);
 301                 &renumber(&get_config(), $_[0]->{'eline'},
 302                           $_[0]->{'file'}, scalar(@nl));
 303                 $newv[$i]->{'file'} = $_[0]->{'file'};
 304                 $newv[$i]->{'line'} = $_[0]->{'eline'};
 305                 $newv[$i]->{'eline'} = $_[0]->{'eline'} + scalar(@nl) - 1;
 306                 push(@$pm, $newv[$i]);
 307                 }
 308         elsif ($i >= @newv) {
 309                 # a directive was deleted
 310                 $lref = &read_file_lines($oldv[$i]->{'file'});
 311                 $ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
 312                 splice(@$lref, $oldv[$i]->{'line'}, $ol);
 313                 &renumber(&get_config(), $oldv[$i]->{'eline'},
 314                           $oldv[$i]->{'file'}, -$ol);
 315                 &renumber_index($_[0]->{'members'}, $oldv[$i]->{'index'}, -1);
 316                 splice(@$pm, &indexof($oldv[$i], @$pm), 1);
 317                 }
 318         else {
 319                 # updating some directive
 320                 $lref = &read_file_lines($oldv[$i]->{'file'});
 321                 @nl = &directive_lines($newv[$i], $_[3]);
 322                 $ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
 323                 &renumber(&get_config(), $oldv[$i]->{'eline'},
 324                           $oldv[$i]->{'file'}, scalar(@nl) - $ol);
 325                 splice(@$lref, $oldv[$i]->{'line'}, $ol, @nl);
 326                 $newv[$i]->{'file'} = $_[0]->{'file'};
 327                 $newv[$i]->{'line'} = $oldv[$i]->{'line'};
 328                 $newv[$i]->{'eline'} = $oldv[$i]->{'line'} + scalar(@nl) - 1;
 329                 $pm->[&indexof($oldv[$i], @$pm)] = $newv[$i];
 330                 }
 331         }
 332 }
 333
 334 # directive_lines(&directive, tabs)
 335 # Renders some directive into a number of lines of text
 336 sub directive_lines
 337 {
 338 local(@rv, $v, $m, $i);
 339 $rv[0] = "\t" x $_[1];
 340 $rv[0] .= "$_[0]->{'name'}";
 341 for($i=0; $i<@{$_[0]->{'values'}}; $i++) {
 342         $v = $_[0]->{'values'}->[$i];
 343         if ($_[0]->{'quotes'}->[$i]) { $rv[0] .= " \"$v\""; }
 344         else { $rv[0] .= " $v"; }
 345         }
 346 if ($_[0]->{'type'}) {
 347         # multiple values.. include them as well
 348         $rv[0] .= " {";
 349         foreach $m (@{$_[0]->{'members'}}) {
 350                 push(@rv, &directive_lines($m, $_[1]+1));
 351                 }
 352         push(@rv, ("\t" x ($_[1]+1))."}");
 353         }
 354 else { $rv[$#rv] .= ";"; }
 355 return @rv;
 356 }
 357
 358 # renumber(&directives, line, file, count)
 359 # Runs through the given array of directives and increases the line numbers
 360 # of all those greater than some line by the given count
 361 sub renumber
 362 {
 363 local($d);
 364 local ($list, $line, $file, $count) = @_;
 365 return if (!$count);
 366 foreach $d (@$list) {
 367         if ($d->{'file'} eq $file) {
 368                 if ($d->{'line'} >= $line) { $d->{'line'} += $count; }
 369                 if ($d->{'eline'} >= $line) { $d->{'eline'} += $count; }
 370                 }
 371         if ($d->{'type'}) {
 372                 &renumber($d->{'members'}, $line, $file, $count);
 373                 }
 374         }
 375 }
 376
 377 # renumber_index(&directives, index, count)
 378 sub renumber_index
 379 {
 380 local($d);
 381 foreach $d (@{$_[0]}) {
 382         if ($d->{'index'} >= $_[1]) {
 383                 $d->{'index'} += $_[2];
 384                 }
 385         }
 386 }
 387
 388 # directive_diff(&d1, &d2)
 389 # Do two directives differ?
 390 sub directive_diff
 391 {
 392 local $i;
 393 local ($d1, $d2) = @_;
 394 return 1 if ($d1->{'name'} ne $d2->{'name'});
 395 local $l1 = @{$d1->{'values'}};
 396 local $l2 = @{$d2->{'values'}};
 397 return 1 if ($l1 != $l2);
 398 for($i=0; $i<$l1; $i++) {
 399         return 1 if ($d1->{'values'}->[$i] ne $d2->{'values'}->[$i]);
 400         }
 401 return 1 if ($d1->{'type'} != $d2->{'type'});
 402 if ($d1->{'type'}) {
 403         $l1 = @{$d1->{'members'}};
 404         $l2 = @{$d2->{'members'}};
 405         return 1 if ($l1 != $l2);
 406         for($i=0; $i<$l1; $i++) {
 407                 return 1 if (&directive_diff($d1->{'members'}->[$i],
 408                                              $d2->{'members'}->[$i]));
 409                 }
 410         }
 411 return 0;
 412 }
 413
 414 # group_name($members)
 415 sub group_name
 416 {
 417 return ($_[0] == 0) ? $text{'index_nomemb'} :
 418         ($_[0] == 1) ? $text{'index_1memb'} :
 419         ($_[0] >= 2 && $_[0] <= 4) ? &text('index_234memb', $_[0]) :
 420         &text('index_memb', $_[0]);
 421
 422 }
 423
 424 # get_subnets_and_hosts()
 425 # returns the references to sorted lists of hosts and subnets
 426 sub get_subnets_and_hosts
 427 {
 428 return (\@get_subnets_cache, \@get_hosts_cache)
 429         if (@get_subnets_cache && @get_hosts_cache);
 430
 431 local(@subn,@host,@group,@shan, $s,$h,$g,$sn, $conf);
 432 $conf = &get_config();
 433
 434 # get top level hosts and groups
 435 @host = &find("host", $conf);
 436 foreach $h (&find("host", $conf)) {
 437         $h->{'order'} = $h->{'index'};
 438         }
 439 @group = &find("group", $conf);
 440 foreach $g (@group) {
 441         foreach $h (&find("host", $g->{'members'})) {
 442                 push(@host, $h);
 443                 }
 444         }
 445 @subn = &find("subnet", $conf);
 446 foreach $u (@subn) {
 447         foreach $h (&find("host", $u->{'members'})) {
 448                 push(@host, $h);
 449                 }
 450         foreach $g (&find("group", $u->{'members'})) {
 451                 push(@group, $g);
 452                 foreach $h (&find("host", $g->{'members'})) {
 453                         push(@host, $h);
 454                         }
 455                 }
 456         }
 457 @shan = &find("shared-network", $conf);
 458 foreach $s (@shan) {
 459         foreach $h (&find("host", $s->{'members'})) {
 460                 push(@host, $h);
 461                 }
 462         foreach $g (&find("group", $s->{'members'})) {
 463                 push(@group, $g);
 464                 foreach $h (&find("host", $g->{'members'})) {
 465                         push(@host, $h);
 466                         }
 467                 }
 468         foreach $u (&find("subnet", $s->{'members'})) {
 469                 push(@subn, $u);
 470                 foreach $h (&find("host", $u->{'members'})) {
 471                         push(@host, $h);
 472                         }
 473                 foreach $g (&find("group", $sn->{'members'})) {
 474                         push(@group, $g);
 475                         foreach $h (&find("host", $g->{'members'})) {
 476                                 push(@host, $h);
 477                                 }
 478                         }
 479                 }
 480         }
 481 @get_subnets_cache = sort { $a->{'order'} <=> $b->{'order'} } @subn;
 482 @get_hosts_cache = sort { $a->{'order'} <=> $b->{'order'} } @host;
 483
 484 return (\@get_subnets_cache, \@get_hosts_cache);
 485 }
 486
 487 sub get_subnets
 488 {
 489 local ($sr, $hr) = &get_subnets_and_hosts();
 490 return @{$sr};
 491 }
 492
 493 sub get_hosts
 494 {
 495 local ($sr, $hr) = &get_subnets_and_hosts();
 496 return @{$hr};
 497 }
 498
 499 # hash that links objtypes shortcuts with object names
 500 %obj_names2types = qw(host hst group grp subnet sub shared-network sha);
 501
 502 # get_branch($objtype)
 503 # usefull for edit_*.cgi and save_*.cgi scripts
 504 # $objtype = one of 'hst' 'grp' 'sub' 'sha'
 505 sub get_branch
 506 {
 507 local %obj_types2names = reverse %obj_names2types;
 508 local $name = $obj_types2names{$_[0]};
 509 local ($parnode, $nparnode, $node, $indent, $nindent);
 510 $parnode = $nparnode = &get_parent_config();
 511 $indent = $nindent = 0;
 512 foreach ($in{'sidx'}, $in{'uidx'}, $in{'gidx'}) {
 513     if ($_ ne '') {
 514                 $parnode = $parnode->{'members'}->[$_];
 515                 $indent++;
 516                 }
 517     }
 518
 519 if (!($in{'delete'} && $in{'options'})) {
 520         if ($in{'assign'} > 0 && !defined($in{'parent'})) {
 521                 # A quirk for not javascript-capable browser
 522                 # New parent is undefined yet; we need 2nd step
 523                 undef $nparnode;
 524                 }
 525         else {
 526                 foreach (split(/\,/, $in{'parent'})) {
 527                         $nindent++;
 528                         if ($_ < @{$nparnode->{'members'}}) {
 529                                 $nparnode = $nparnode->{'members'}->[$_];
 530                                 }
 531                         }
 532                 }
 533         }
 534
 535 if (!$in{'new'}) {
 536         $node = $parnode->{'members'}->[$in{'idx'}];
 537         }
 538 else {
 539         die "Wrong call to get_nodes: pass objtype for new object" unless $name;
 540         # Construct new node structure
 541         $node->{'name'} = $name;
 542         $node->{'type'} = 1;
 543         $node->{'members'} = [ ];
 544         }
 545 return ($parnode, $node, $indent, $nparnode, $nindent);
 546 }
 547
 548 # can(permissions_string, \%access, \%config_node, smode)
 549 # this is a cached wrapper of can_noncached(...)
 550 sub can
 551 {
 552 local ($perm, $acc, $node, $smode) = @_;
 553 if (defined($can_cache) &&
 554         ($can_perm_cache eq $perm) &&
 555         ($can_node_cache eq $node) &&
 556         ($can_smode_cache eq $smode)) {
 557         return $can_cache;
 558         }
 559 else {
 560         $can_perm_cache = $perm;
 561         $can_node_cache = $node;
 562         $can_smode_cache = $smode;
 563         return ($can_cache = &can_noncached(@_));
 564         }
 565 }
 566
 567 # can_noncached(permissions_string, \%access, \%config_node, smode)
 568 # check global and per-object permissions:
 569 #
 570 # permissions_string= 'c' 'r' 'w' or any combination.
 571 # smode= 0 or undef - check only current, 1 - recursive childs check,
 572 #       2 - check parents, 3 - check parents and all childs
 573 #       note: while deleting an object you must allways enforce smode=1 or 3
 574 #               because all child objects are deletes recursevly.
 575 #       this maybe an optional parameter
 576 sub can_noncached
 577 {
 578 local $acl;
 579 local ($perm, $acc, $node, $smode) = @_;
 580 local @perm = split(//, $perm);
 581
 582 if ($node ne get_parent_config()) {
 583         foreach (@perm) {
 584                 next if ($_ ne 'c') &&  ($_ ne 'r') && ($_ ne 'w');
 585                 return 0 unless $acc->{$_ . '_' . $obj_names2types{$node->{'name'}} };
 586                 }
 587
 588         # per-object permissions
 589         return 0 unless &can_node(\@perm, $acc, $node);
 590
 591         if (($acc->{'smode'} == 2) || ($smode == 2) ||
 592             ($acc->{'smode'} == 3) || ($smode == 3)) {
 593                 # check parents
 594                 $parnode=&get_parent_config();
 595                 foreach ($in{'sidx'}, $in{'uidx'}, $in{'gidx'}) {
 596                         if ($_ ne '') {
 597                                 $parnode = $parnode->{'members'}->[$_];
 598                                 return 0 unless &can_node(\@perm, $acc, $parnode);
 599                                 }
 600                         }
 601                 }
 602
 603         if (($acc->{'smode'} == 1) || ($smode == 1) ||
 604                 ($acc->{'smode'} == 3) || ($smode == 3)) {
 605                 # check childs
 606                 return 0 unless &can_subtree(\@perm, $acc, $node);
 607                 }
 608         }
 609 return 1;
 610 }
 611
 612 # can_node(\@perm, $acc, $node)
 613 # checks object permissions for current node
 614 sub can_node
 615 {
 616 local ($rperm, $acc, $node)=@_;
 617 # per-object permissions
 618 local $otype=$obj_names2types{$node->{'name'}};
 619 if ($acc->{'per_' . $otype . '_acls'}) {
 620         local $acl = $acc->{'ACL' . $otype . '_' . $node->{'values'}->[0]};
 621         foreach (@{$rperm}) {
 622                 next if $_ eq 'c'; # skip creation perms for per-obj acls
 623                 return 0 if index($acl, $_) == -1;
 624                 }
 625         }
 626 return 1;
 627 }
 628
 629 # can_subtree(\@perm, $acc, $node)
 630 # checks object permissions for subtree
 631 sub can_subtree
 632 {
 633 local ($rperm, $acc, $node)=@_;
 634 return 0 unless &can_node($rperm, $acc, $node);
 635 if($node->{'members'}) {
 636         # recursevly process this subtree
 637         foreach (@{$node->{'members'}}) {
 638                 return 0 unless &can_subtree($rperm, $acc, $_);
 639                 }
 640         }
 641 return 1;
 642 }
 643
 644 # save_dhcpd_acl(permissions_string, obj_type, \%access, obj_name)
 645 sub save_dhcpd_acl
 646 {
 647 $_[2]->{'ACL'.$_[1].'_'.$_[3]} = $_[0];
 648 undef($can_cache);
 649 return &save_module_acl($_[2]);
 650 }
 651
 652 # drop_dhcpd_acl(obj_type, \%access, obj_name)
 653 sub drop_dhcpd_acl
 654 {
 655 delete($_[1]->{'ACL'.$_[0].'_'.$_[2]});
 656 undef($can_cache);
 657 return &save_module_acl($_[1]);
 658 }
 659
 660 1;