dhcpd-lib.pl.bak

# dhcpd-lib.pl
# Functions for parsing the DHCPD config file

do '../web-lib.pl';
&init_config();

# get_parent_config()
# Returns a dummy parent structure for the DHCP config
sub get_parent_config
{ 
return $get_parent_config_cache if ($get_parent_config_cache);
return ($get_parent_config_cache =
		{
		 'file' => $config{'dhcpd_conf'},
	     'members' => &get_config(),
	     'line' => -1,
	     'eline' => $get_config_lines 
		  } );
}

# get_config()
# Parses the DHCPD config file into a data structure
sub get_config
{
return \@get_config_cache if (@get_config_cache);
local(@tok, @rv, $i, $t, $j, $ifile, @inc, $str);

$get_config_lines = &tokenize_file($config{'dhcpd_conf'}, \@tok);
$i = 0; $j = 0;
while($i < @tok) {
	$str = &parse_struct(\@tok, \$i, $j++, $config{'dhcpd_conf'});
	if ($str) { push(@rv, $str); }
	}
@get_config_cache = @rv;
return \@get_config_cache;
}

# tokenize_file(file, &tokens)
sub tokenize_file
{
local $lines = 0;
local ($line, $cmode);
open(FILE, $_[0]);
while($line = <FILE>) {
	# strip comments
	$line =~ s/\r|\n//g;
	$line =~ s/^([^"#]*)#.*$/$1/g;
	$line =~ s/^([^"]*)\/\/.*$/$1/g;
	while(1) {
		if (!$cmode && $line =~ /\/\*/) {
			# start of a C-style comment
			$cmode = 1;
			$line =~ s/\/\*.*$//g;
			}
		elsif ($cmode) {
			if ($line =~ /\*\//) {
				# end of comment
				$cmode = 0;
				$line =~ s/^.*\*\///g;
				}
			else { $line = ""; last; }
			}
		else { last; }
		}

	# split line into tokens
	while(1) {
		if ($line =~ /^\s*"([^"]*)"(.*)$/) {
			push(@{$_[1]}, [ $1, 1, $lines ]); $line = $2;
			}
		elsif ($line =~ /^\s*([{};])(.*)$/) {
			push(@{$_[1]}, [ $1, 0, $lines ]); $line = $2;
			}
		elsif ($line =~ /^\s*([^{}; \t]+)(.*)$/) {
			push(@{$_[1]}, [ $1, 0, $lines ]); $line = $2;
			}
		else { last; }
		}
	$lines++;
	}
close(FILE);
return $lines;
}

# parse_struct(&tokens, &token_num, index, file)
# A structure can either have one value, or a list of values.
# Pos will end up at the start of the next structure
sub parse_struct
{
local(%str, $i, $t, @vals, @quotes, $str, @text);
$i = ${$_[1]};
$str{'name'} = $_[0]->[$i]->[0];
$str{'line'} = $_[0]->[$i]->[2];
while(1) {
	$t = $_[0]->[++$i];
	if ($t->[0] eq "{" || $t->[0] eq ";") { last; }
	elsif (!defined($t->[0])) { ${$_[1]} = $i; return undef; }
	else { push(@vals, $t->[0]); push(@quotes, $t->[1]); }
	push(@text, $t->[1] ? "\"$t->[0]\"" : $t->[0]);
	}
$str{'values'} = \@vals;
$str{'quotes'} = \@quotes;
$str{'value'} = $vals[0];
$str{'text'} = join(" ", @text);
$str{'index'} = $_[2];
$str{'file'} = $_[3];
if ($t->[0] eq "{") {
	# contains sub-structures.. parse them
	local(@mems, $j);
	$i++;		# skip {
	$str{'type'} = 1;
	$j = 0;
	while($_[0]->[$i]->[0] ne "}") {
		if (!defined($_[0]->[$i]->[0]))
			{ ${$_[1]} = $i; return undef; }
		$str = &parse_struct($_[0], \$i, $j++, $_[3]);
		if ($str) { push(@mems, $str); }
		}
	$str{'members'} = \@mems;
	$i++;		# skip trailing }
	}
else {
	# only a single value..
	$str{'type'} = 0;
	$i++;	# skip trailing ;
	}
$str{'eline'} = $_[0]->[$i-1]->[2];	# ending line is the line number the
					# trailing ; is on
${$_[1]} = $i;
return \%str;
}

# find(name, &array)
sub find
{
local($c, @rv);
foreach $c (@{$_[1]}) {
	if ($c->{'name'} eq $_[0]) {
		push(@rv, $c);
		}
	}
return @rv ? wantarray ? @rv : $rv[0]
           : wantarray ? () : undef;
}

# find_value(name, &array)
sub find_value
{
local(@v);
@v = &find($_[0], $_[1]);
if (!@v) { return undef; }
elsif (wantarray) { return map { $_->{'value'} } @v; }
else { return $v[0]->{'value'}; }
}

# choice_input(text, name, &config, [display, option]+)
sub choice_input
{
local($rv, $v, $i, @ops);
$rv = "<td><b>$_[0]</b></td> <td>";
$v = &find_value($_[1], $_[2]);
for($i=3; $i<@_; $i+=2) {
	@ops = split(/,/, $_[$i+1]);
	$rv .= "<input type=radio name=$_[1] value=\"$ops[0]\" ".
		($v eq $ops[0] ? "checked" : "").">$_[$i]\n";
	}
return $rv."</td>\n";
}

# save_choice(name, &parent, indent)
sub save_choice
{
local($nd);
if ($in{$_[0]}) { $nd = { 'name' => $_[0], 'values' => [ $in{$_[0]} ] }; }
&save_directive($_[1], $_[0], $nd ? [ $nd ] : [ ], $_[2], 1);
}

# addr_match_input(text, name, &config)
# A field for editing a list of addresses, ACLs and partial IP addresses
sub addr_match_input
{
local($v, $rv, $av, @av);
$v = &find($_[1], $_[2]);
$rv = "<td><b>$_[0]</b></td> <td>";
$rv .= "<input type=radio name=$_[1]_def value=1 ".
       ($v ? "" : "checked").">Default ";
$rv .= "<input type=radio name=$_[1]_def value=0 ".
       ($v ? "checked" : "").">Listed..<br>";
foreach $av (@{$v->{'members'}}) { push(@av, $av->{'name'}); }
$rv .= "<textarea name=$_[1] rows=3 cols=15>".
	join("\n", @av)."</textarea></td>\n";
}

sub save_addr_match
{
local($addr, @vals, $dir);
if ($in{"$_[0]_def"}) { &save_directive($_[1], $_[0], [ ], $_[2], 1); }
else {
	foreach $addr (split(/\s+/, $in{$_[0]})) {
		push(@vals, { 'name' => $addr });
		}
	$dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
	&save_directive($_[1], $_[0], [ $dir ], $_[2], 1);
	}
}

# address_input(text, name, &config, type)
sub address_input
{
local($v, $rv, $av, @av);
$v = &find($_[1], $_[2]);
foreach $av (@{$v->{'members'}}) { push(@av, $av->{'name'}); }
if ($_[3] == 0) {
	# text area
	$rv = "<td><b>$_[0]</b></td> <td>";
	$rv .= "<textarea name=$_[1] rows=3 cols=15>".
		join("\n", @av)."</textarea></td>\n";
	}
else {
	$rv = "<td><b>$_[0]</b></td> <td colspan=3>";
	$rv .= "<input name=$_[1] size=50 value=\"".join(' ',@av)."\"></td>\n";
	}
return $rv;
}

sub save_address
{
local($addr, @vals, $dir);
foreach $addr (split(/\s+/, $in{$_[0]})) {
	&check_ipaddress($addr) || &error("'$addr' is not a valid IP address");
	push(@vals, { 'name' => $addr });
	}
$dir = { 'name' => $_[0], 'type' => 1, 'members' => \@vals };
&save_directive($_[1], $_[0], @vals ? [ $dir ] : [ ], $_[2], 1);
}

# opt_input(text, name, &config, default, size, units)
sub opt_input
{
local($v, $rv);
$v = &find($_[1], $_[2]);
$rv = "<td><b>$_[0]</b></td> <td nowrap";
$rv .= $_[4] > 30 ? " colspan=3>\n" : ">\n";
$rv .= sprintf "<input type=radio name=$_[1]_def value=1 %s> $_[3]\n",
	$v ? "" : "checked";
$rv .= sprintf "<input type=radio name=$_[1]_def value=0 %s> ",
	$v ? "checked" : "";
$rv .= sprintf "<input name=$_[1] size=$_[4] value=\"%s\"> $_[5]</td>\n",
	$v ? $v->{'value'} : "";
return $rv;
}

# save_opt(name, &func, &parent, [indent], [quote])
sub save_opt
{
local($dir);
if ($in{"$_[0]_def"}) { &save_directive($_[2], $_[0], [ ], $_[3], 1); }
elsif ($_[1] && ($err = &{$_[1]}($in{$_[0]}))) {
	&error($err);
	}
else {
	$dir = { 'name' => $_[0],
		 'values' => [ $in{$_[0]} ],
		 'quotes' => [ $_[4] ] };
	&save_directive($_[2], $_[0], [ $dir ], $_[3], 1);
	}
}

# save_directive(&parent, [name|&oldvalues], &values, indent, start)
# Given a structure containing a directive name, type, values and members
# add, update or remove that directive in config structure and data files.
# Updating of files assumes that there is no overlap between directives -
# each line in the config file must contain part or all of only one directive.
sub save_directive
{
local(@oldv, @newv, $pm, $i, $o, $n, $lref, @nl);
$pm = $_[0]->{'members'};
@oldv = ref($_[1]) ? @{$_[1]} : &find($_[1], $pm);
@newv = @{$_[2]};
for($i=0; $i<@oldv || $i<@newv; $i++) {
	if ($i >= @oldv && $_[4]) {
		# a new directive is being added.. put it at the start of
		# the parent
		$lref = &read_file_lines($_[0]->{'file'});
		@nl = &directive_lines($newv[$i], $_[3]);
		splice(@$lref, $_[0]->{'line'}+1, 0, @nl);
		&renumber(&get_config(), $_[0]->{'line'}+1,
			  $_[0]->{'file'}, scalar(@nl));
		&renumber_index($_[0]->{'members'}, 0, 1);
		$newv[$i]->{'file'} = $_[0]->{'file'};
		$newv[$i]->{'line'} = $_[0]->{'line'}+1;
		$newv[$i]->{'eline'} = $_[0]->{'line'} + scalar(@nl);
		unshift(@$pm, $newv[$i]);
		}
	elsif ($i >= @oldv) {
		# a new directive is being added.. put it at the end of
		# the parent
		$lref = &read_file_lines($_[0]->{'file'});
		@nl = &directive_lines($newv[$i], $_[3]);
		splice(@$lref, $_[0]->{'eline'}, 0, @nl);
		&renumber(&get_config(), $_[0]->{'eline'},
			  $_[0]->{'file'}, scalar(@nl));
		$newv[$i]->{'file'} = $_[0]->{'file'};
		$newv[$i]->{'line'} = $_[0]->{'eline'};
		$newv[$i]->{'eline'} = $_[0]->{'eline'} + scalar(@nl) - 1;
		push(@$pm, $newv[$i]);
		}
	elsif ($i >= @newv) {
		# a directive was deleted
		$lref = &read_file_lines($oldv[$i]->{'file'});
		$ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
		splice(@$lref, $oldv[$i]->{'line'}, $ol);
		&renumber(&get_config(), $oldv[$i]->{'eline'},
			  $oldv[$i]->{'file'}, -$ol);
		&renumber_index($_[0]->{'members'}, $oldv[$i]->{'index'}, -1);
		splice(@$pm, &indexof($oldv[$i], @$pm), 1);
		}
	else {
		# updating some directive
		$lref = &read_file_lines($oldv[$i]->{'file'});
		@nl = &directive_lines($newv[$i], $_[3]);
		$ol = $oldv[$i]->{'eline'} - $oldv[$i]->{'line'} + 1;
		&renumber(&get_config(), $oldv[$i]->{'eline'},
			  $oldv[$i]->{'file'}, scalar(@nl) - $ol);
		splice(@$lref, $oldv[$i]->{'line'}, $ol, @nl);
		$newv[$i]->{'file'} = $_[0]->{'file'};
		$newv[$i]->{'line'} = $oldv[$i]->{'line'};
		$newv[$i]->{'eline'} = $oldv[$i]->{'line'} + scalar(@nl) - 1;
		$pm->[&indexof($oldv[$i], @$pm)] = $newv[$i];
		}
	}
}

# directive_lines(&directive, tabs)
# Renders some directive into a number of lines of text
sub directive_lines
{
local(@rv, $v, $m, $i);
$rv[0] = "\t" x $_[1];
$rv[0] .= "$_[0]->{'name'}";
for($i=0; $i<@{$_[0]->{'values'}}; $i++) {
	$v = $_[0]->{'values'}->[$i];
	if ($_[0]->{'quotes'}->[$i]) { $rv[0] .= " \"$v\""; }
	else { $rv[0] .= " $v"; }
	}
if ($_[0]->{'type'}) {
	# multiple values.. include them as well
	$rv[0] .= " {";
	foreach $m (@{$_[0]->{'members'}}) {
		push(@rv, &directive_lines($m, $_[1]+1));
		}
	push(@rv, ("\t" x ($_[1]+1))."}");
	}
else { $rv[$#rv] .= ";"; }
return @rv;
}

# renumber(&directives, line, file, count)
# Runs through the given array of directives and increases the line numbers
# of all those greater than some line by the given count
sub renumber
{
local($d);
local ($list, $line, $file, $count) = @_;
return if (!$count);
foreach $d (@$list) {
	if ($d->{'file'} eq $file) {
		if ($d->{'line'} >= $line) { $d->{'line'} += $count; }
		if ($d->{'eline'} >= $line) { $d->{'eline'} += $count; }
		}
	if ($d->{'type'}) {
		&renumber($d->{'members'}, $line, $file, $count);
		}
	}
}

# renumber_index(&directives, index, count)
sub renumber_index
{
local($d);
foreach $d (@{$_[0]}) {
	if ($d->{'index'} >= $_[1]) {
		$d->{'index'} += $_[2];
		}
	}
}

# directive_diff(&d1, &d2)
# Do two directives differ?
sub directive_diff
{
local $i;
local ($d1, $d2) = @_;
return 1 if ($d1->{'name'} ne $d2->{'name'});
local $l1 = @{$d1->{'values'}};
local $l2 = @{$d2->{'values'}};
return 1 if ($l1 != $l2);
for($i=0; $i<$l1; $i++) {
	return 1 if ($d1->{'values'}->[$i] ne $d2->{'values'}->[$i]);
	}
return 1 if ($d1->{'type'} != $d2->{'type'});
if ($d1->{'type'}) {
	$l1 = @{$d1->{'members'}};
	$l2 = @{$d2->{'members'}};
	return 1 if ($l1 != $l2);
	for($i=0; $i<$l1; $i++) {
		return 1 if (&directive_diff($d1->{'members'}->[$i],
					     $d2->{'members'}->[$i]));
		}
	}
return 0;
}

# group_name($members)
sub group_name
{
return ($_[0] == 0) ? $text{'index_nomemb'} :
	($_[0] == 1) ? $text{'index_1memb'} :
	($_[0] >= 2 && $_[0] <= 4) ? &text('index_234memb', $_[0]) :
	&text('index_memb', $_[0]);

}

# get_subnets_and_hosts() 
# returns the references to sorted lists of hosts and subnets
sub get_subnets_and_hosts
{
return (\@get_subnets_cache, \@get_hosts_cache) 
	if (@get_subnets_cache && @get_hosts_cache);

local(@subn,@host,@group,@shan, $s,$h,$g,$sn, $conf);
$conf = &get_config();

# get top level hosts and groups
@host = &find("host", $conf);
foreach $h (&find("host", $conf)) {
	$h->{'order'} = $h->{'index'};
	}
@group = &find("group", $conf);
foreach $g (@group) {
	foreach $h (&find("host", $g->{'members'})) {
		push(@host, $h);
		}
	}
@subn = &find("subnet", $conf);
foreach $u (@subn) {
	foreach $h (&find("host", $u->{'members'})) {
		push(@host, $h);
		}
	foreach $g (&find("group", $u->{'members'})) {
		push(@group, $g);
		foreach $h (&find("host", $g->{'members'})) {
			push(@host, $h);
			}
		}
	}
@shan = &find("shared-network", $conf);
foreach $s (@shan) {
	foreach $h (&find("host", $s->{'members'})) {
		push(@host, $h);
		}
	foreach $g (&find("group", $s->{'members'})) {
		push(@group, $g);
		foreach $h (&find("host", $g->{'members'})) {
			push(@host, $h);
			}
		}
	foreach $u (&find("subnet", $s->{'members'})) {
		push(@subn, $u);
		foreach $h (&find("host", $u->{'members'})) {
			push(@host, $h);
			}
		foreach $g (&find("group", $sn->{'members'})) {
			push(@group, $g);
			foreach $h (&find("host", $g->{'members'})) {
				push(@host, $h);
				}
			}
		}
	}
@get_subnets_cache = sort { $a->{'order'} <=> $b->{'order'} } @subn;
@get_hosts_cache = sort { $a->{'order'} <=> $b->{'order'} } @host;

return (\@get_subnets_cache, \@get_hosts_cache);
}

sub get_subnets
{
local ($sr, $hr) = &get_subnets_and_hosts();
return @{$sr};
}

sub get_hosts
{
local ($sr, $hr) = &get_subnets_and_hosts();
return @{$hr};
}

# hash that links objtypes shortcuts with object names
%obj_names2types = qw(host hst group grp subnet sub shared-network sha);

# get_branch($objtype) 
# usefull for edit_*.cgi and save_*.cgi scripts
# $objtype = one of 'hst' 'grp' 'sub' 'sha'
sub get_branch
{
local %obj_types2names = reverse %obj_names2types;
local $name = $obj_types2names{$_[0]};
local ($parnode, $nparnode, $node, $indent, $nindent);
$parnode = $nparnode = &get_parent_config();
$indent = $nindent = 0;
foreach ($in{'sidx'}, $in{'uidx'}, $in{'gidx'}) {
    if ($_ ne '') {
		$parnode = $parnode->{'members'}->[$_];
		$indent++;
		}
    }

if (!($in{'delete'} && $in{'options'})) {
	if ($in{'assign'} > 0 && !defined($in{'parent'})) {
		# A quirk for not javascript-capable browser
		# New parent is undefined yet; we need 2nd step
		undef $nparnode;
		}
	else {
		foreach (split(/\,/, $in{'parent'})) {
			$nindent++;
			if ($_ < @{$nparnode->{'members'}}) {
				$nparnode = $nparnode->{'members'}->[$_];
				}
			}
		}
	}

if (!$in{'new'}) {
	$node = $parnode->{'members'}->[$in{'idx'}];
	}
else {
	die "Wrong call to get_nodes: pass objtype for new object" unless $name;
	# Construct new node structure
	$node->{'name'} = $name;
	$node->{'type'} = 1;
	$node->{'members'} = [ ];
	}
return ($parnode, $node, $indent, $nparnode, $nindent);
}

# can(permissions_string, \%access, \%config_node, smode)
# this is a cached wrapper of can_noncached(...)
sub can
{
local ($perm, $acc, $node, $smode) = @_;
if (defined($can_cache) &&
	($can_perm_cache eq $perm) &&
	($can_node_cache eq $node) &&
	($can_smode_cache eq $smode)) {
	return $can_cache;
	}
else {
	$can_perm_cache = $perm;
	$can_node_cache = $node;
	$can_smode_cache = $smode;
	return ($can_cache = &can_noncached(@_));
	}
}

# can_noncached(permissions_string, \%access, \%config_node, smode)
# check global and per-object permissions:
#
# permissions_string= 'c' 'r' 'w' or any combination.
# smode= 0 or undef - check only current, 1 - recursive childs check, 
#	2 - check parents, 3 - check parents and all childs
#	note: while deleting an object you must allways enforce smode=1 or 3
#		because all child objects are deletes recursevly. 
#	this maybe an optional parameter 
sub can_noncached
{
local $acl;
local ($perm, $acc, $node, $smode) = @_;
local @perm = split(//, $perm);

if ($node ne get_parent_config()) {
	foreach (@perm) { 
		next if ($_ ne 'c') &&  ($_ ne 'r') && ($_ ne 'w');
		return 0 unless $acc->{$_ . '_' . $obj_names2types{$node->{'name'}} };
		}

	# per-object permissions
	return 0 unless &can_node(\@perm, $acc, $node);

	if (($acc->{'smode'} == 2) || ($smode == 2) ||
	    ($acc->{'smode'} == 3) || ($smode == 3)) {
		# check parents
		$parnode=&get_parent_config();								
		foreach ($in{'sidx'}, $in{'uidx'}, $in{'gidx'}) {
			if ($_ ne '') {
				$parnode = $parnode->{'members'}->[$_];
				return 0 unless &can_node(\@perm, $acc, $parnode);
				}
			}
		}
		
	if (($acc->{'smode'} == 1) || ($smode == 1) ||
		($acc->{'smode'} == 3) || ($smode == 3)) {
		# check childs
		return 0 unless &can_subtree(\@perm, $acc, $node);
		}
	}
return 1;
}

# can_node(\@perm, $acc, $node)
# checks object permissions for current node
sub can_node
{
local ($rperm, $acc, $node)=@_;
# per-object permissions
local $otype=$obj_names2types{$node->{'name'}};
if ($acc->{'per_' . $otype . '_acls'}) {  
	local $acl = $acc->{'ACL' . $otype . '_' . $node->{'values'}->[0]};
	foreach (@{$rperm}) {
		next if $_ eq 'c'; # skip creation perms for per-obj acls
		return 0 if index($acl, $_) == -1;
		}
	}
return 1;
}

# can_subtree(\@perm, $acc, $node)
# checks object permissions for subtree
sub can_subtree
{
local ($rperm, $acc, $node)=@_;
return 0 unless &can_node($rperm, $acc, $node); 
if($node->{'members'}) {
	# recursevly process this subtree
	foreach (@{$node->{'members'}}) {
		return 0 unless &can_subtree($rperm, $acc, $_);
		}
	}
return 1;	
}

# save_dhcpd_acl(permissions_string, obj_type, \%access, obj_name)
sub save_dhcpd_acl
{
$_[2]->{'ACL'.$_[1].'_'.$_[3]} = $_[0];
undef($can_cache);
return &save_module_acl($_[2]);
}

# drop_dhcpd_acl(obj_type, \%access, obj_name)
sub drop_dhcpd_acl
{
delete($_[1]->{'ACL'.$_[0].'_'.$_[2]});
undef($can_cache);
return &save_module_acl($_[1]);
}

1;