apache-lib.pl

Unix下基于Web的管理工具

# apache-lib.pl
# Common functions for apache configuration

do '../web-lib.pl';
&init_config();
%access = &get_module_acl();

@access_types = $access{'types'} eq '*' ? (0 .. 100)
				        : split(/\s+/, $access{'types'});
map { $access_types{$_}++ } @access_types;

# Read the site-specific setup file, then require in all the module-specific
# .pl files
if (&read_file("$module_config_directory/site", \%site)) {
	local($m, $f, $d);
	$httpd_size = $site{'size'};
	foreach $m (split(/\s+/, $site{'modules'})) {
		if ($m =~ /(\S+)\/(\S+)/) { $httpd_modules{$1} = $2; }
		}
	foreach $f (split(/\s+/, $site{'htaccess'})) {
		if (-r $f) { push(@htaccess_files, $f); }
		}
	foreach $m (keys %httpd_modules) {
		do "./$m.pl";
		}
	foreach $d (split(/\s+/, $site{'defines'})) {
		$httpd_defines{$d}++;
		}
	}

# parse_config_file(handle, lines, file)
# Parses lines of text from some config file into a data structure. The
# return value is an array of references, one for each directive in the file.
# Each reference points to an associative array containing
#  line -	The line number this directive is at
#  eline -	The line number this directive ends at
#  file -	The file this directive is from
#  type -	0 for a normal directive, 1 for a container directive
#  name -	The name of this directive
#  value -	Value (possibly with spaces)
#  members -	For type 1, a reference to the array of members
sub parse_config_file
{
local($fh, @rv, $line, %dummy);
$fh = $_[0];
$dummy{'line'} = $dummy{'eline'} = $_[1]-1;
$dummy{'file'} = $_[2];
$dummy{'type'} = 0;
$dummy{'name'} = "dummy";
@rv = (\%dummy);
while($line = <$fh>) {
	chop;
	$line =~ s/^\s*#.*$//g;
	if ($line =~ /^\s*<\/(\S+)\s*(.*)>/) {
		# end of a container directive. This can only happen in a
		# recursive call to this function
		$_[1]++;
		last;
		}
	elsif ($line =~ /^\s*<IfModule\s+(\!?)(\S+)\.c>/i) {
		# start of an IfModule block. Read it, and if the module
		# exists put the directives in this section.
		local ($not, $mod) = ($1, $2);
		local $oldline = $_[1];
		$_[1]++;
		local @dirs = &parse_config_file($fh, $_[1], $_[2]);
		if (!$not && $httpd_modules{$mod} ||
		    $not && !$httpd_modules{$mod}) {
			# use the directives..
			push(@rv, { 'line', $oldline,
				    'eline', $oldline,
				    'file', $_[2],
				    'name', "<IfModule $not$mod>" });
			push(@rv, @dirs);
			push(@rv, { 'line', $_[1]-1,
				    'eline', $_[1]-1,
				    'file', $_[2],
				    'name', "</IfModule>" });
			}
		}
	elsif ($line =~ /^\s*<IfDefine\s+(\!?)(\S+)>/i) {
		# start of an IfDefine block. Read it, and if the define
		# exists put the directives in this section
		local ($not, $def) = ($1, $2);
		local $oldline = $_[1];
		$_[1]++;
		local @dirs = &parse_config_file($fh, $_[1], $_[2]);
		if (!$not && $httpd_defines{$def} ||
		    $not && !$httpd_defines{$def}) {
			# use the directives..
			push(@rv, { 'line', $oldline,
				    'eline', $oldline,
				    'file', $_[2],
				    'name', "<IfDefine $not$def>" });
			push(@rv, @dirs);
			push(@rv, { 'line', $_[1]-1,
				    'eline', $_[1]-1,
				    'file', $_[2],
				    'name', "</IfDefine>" });
			}
		}
	elsif ($line =~ /^\s*<(\S+)\s*(.*)>/) {
		# start of a container directive. The first member is a dummy
		# directive at the same line as the container
		local(%dir, @members);
		%dir = ('line', $_[1],
			'file', $_[2],
			'type', 1,
			'name', $1,
			'value', $2);
		$dir{'value'} =~ s/\s+$//g;
		$dir{'words'} = &wsplit($dir{'value'});
		$_[1]++;
		@members = &parse_config_file($fh, $_[1], $_[2]);
		$dir{'members'} = \@members;
		$dir{'eline'} = $_[1]-1;
		push(@rv, \%dir);
		}
	elsif ($line =~ /^\s*(\S+)\s*(.*)$/) {
		# normal directive
		local(%dir);
		%dir = ('line', $_[1],
			'eline', $_[1],
			'file', $_[2],
			'type', 0,
			'name', $1,
			'value', $2);
		if ($dir{'value'} =~ s/\\$//g) {
			# multi-line directive!
			while($line = <$fh>) {
				chop($line);
				$cont = ($line =~ s/\\$//g);
				$dir{'value'} .= $line;
				$dir{'eline'} = ++$_[1];
				if (!$cont) { last; }
				}
			}
		$dir{'value'} =~ s/\s+$//g;
		$dir{'words'} = &wsplit($dir{'value'});
		push(@rv, \%dir);
		$_[1]++;
		}
	else {
		# blank or comment line
		$_[1]++;
		}
	}
return @rv;
}

# wsplit(string)
# Splits a string like  foo "foo \"bar\"" bazzz  into an array of words
sub wsplit
{
local($s, @rv); $s = $_[0];
$s =~ s/\\\"/\0/g;
while($s =~ /^"([^"]*)"\s*(.*)$/ || $s =~ /^(\S+)\s*(.*)$/) {
	$w = $1; $s = $2;
	$w =~ s/\0/"/g; push(@rv, $w);
	}
return \@rv;
}

# wjoin(word, word, ...)
sub wjoin
{
local(@rv, $w);
foreach $w (@_) {
	if ($w =~ /^\S+$/) { push(@rv, $w); }
	else { push(@rv, "\"$w\""); }
	}
return join(' ', @rv);
}

# find_directive(name, &directives)
# Returns the values of directives matching some name
sub find_directive
{
local(@rv, $i, @vals, $dref);
foreach $ref (@{$_[1]}) {
	if (lc($ref->{'name'}) eq lc($_[0])) {
		push(@vals, $ref->{'value'});
		}
	}
return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
}

# find_directive_struct(name, &directives)
# Returns references to directives maching some name
sub find_directive_struct
{
local(@rv, $i, @vals);
foreach $ref (@{$_[1]}) {
	if (lc($ref->{'name'}) eq lc($_[0])) {
		push(@vals, $ref);
		}
	}
return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
}

# find_vdirective(name, &virtualdirectives, &directives)
# Looks for some directive in a <VirtualHost> section, and then in the 
# main section
sub find_vdirective
{
if ($_[1]) {
	$rv = &find_directive($_[0], $_[1]);
	if ($rv) { return $rv; }
	}
return &find_directive($_[0], $_[2]);
}

# get_config()
# Returns the entire config structure
sub get_config
{
local($acc, $res, $lnum, $conf, @virt, $v, $mref, $inc);
if (@get_config_cache) {
	return \@get_config_cache;
	}

# read primary config file
$conf = $config{'httpd_conf'};
if (!$conf) { $conf = "$config{'httpd_dir'}/conf/httpd.conf"; }
if (!-r $conf) { $conf = "$config{'httpd_dir'}/etc/httpd.conf"; }
open(CONF, $conf) || return undef;
$lnum = 0;
@get_config_cache = &parse_config_file(CONF, $lnum,$conf);
close(CONF);

# Read main resource and access config files
$lnum = 0;
$res = &find_directive("ResourceConfig", \@get_config_cache);
if (!$res) { $res = $config{'srm_conf'}; }
if (!$res) { $res = "$config{'httpd_dir'}/conf/srm.conf"; }
if (!-r $res) { $res = "$config{'httpd_dir'}/etc/srm.conf"; }
open(CONF, $res);
push(@get_config_cache, &parse_config_file(CONF, $lnum, $res));
close(CONF);

$lnum = 0;
$acc = &find_directive("AccessConfig", \@get_config_cache);
if (!$acc) { $acc = $config{'access_conf'}; }
if (!$acc) { $acc = "$config{'httpd_dir'}/conf/access.conf"; }
if (!-r $acc) { $acc = "$config{'httpd_dir'}/etc/access.conf"; }
open(CONF, $acc);
push(@get_config_cache, &parse_config_file(CONF, $lnum, $acc));
close(CONF);

# Read extra config files in VirtualHost sections
@virt = &find_directive_struct("VirtualHost", \@get_config_cache);
foreach $v (@virt) {
	$mref = $v->{'members'};
	if ($res = &find_directive("ResourceConfig", $mref)) {
		if ($res !~ /^\//) { $res = "$config{'httpd_dir'}/$res"; }
		$lnum = 0;
		open(CONF, $res);
		push(@$mref, &parse_config_file(CONF, $lnum, $res));
		close(CONF);
		}
	if ($acc = &find_directive("AccessConfig", $mref)) {
		if ($acc !~ /^\//) { $acc = "$config{'httpd_dir'}/$acc"; }
		$lnum = 0;
		open(CONF, $acc);
		push(@$mref, &parse_config_file(CONF, $lnum, $acc));
		close(CONF);
		}
	}

# Read Include'd files
foreach $inc (&find_directive("Include", \@get_config_cache)) {
	if ($inc !~ /^\//) { $inc = "$config{'httpd_dir'}/$inc"; }
	$lnum = 0;
	open(CONF, $inc);
	push(@get_config_cache, &parse_config_file(CONF, $lnum, $inc));
	close(CONF);
	}

# Move directives from active IfModule sections to section they are in

return \@get_config_cache;
}

# get_virtual_config(index)
sub get_virtual_config
{
local($conf, $c, $v);
$conf = &get_config();
if (!$_[0]) { $c = $conf; $v = undef; }
else {
	$c = $conf->[$_[0]]->{'members'};
	$v = $conf->[$_[0]];
	}
return wantarray ? ($c, $v) : $c;
}

# get_htaccess_config(file)
sub get_htaccess_config
{
local($lnum, @conf);
open(HTACCESS, $_[0]);
@conf = &parse_config_file(HTACCESS, $lnum, $_[0]);
close(HTACCESS);
return \@conf;
}

# save_directive(name, &values, &directives, &config)
# Updates the config file(s) and the directives structure with new values
# for the given directives.
# If a directive's value is merely being changed, then its value only needs
# to be updated in the directives array and in the file.
sub save_directive
{
local($i, @old, $lref, $change, $len);
@old = &find_directive_struct($_[0], $_[2]);
for($i=0; $i<@old || $i<@{$_[1]}; $i++) {
	$v = ${$_[1]}[$i];
	if ($i >= @old) {
		# a new directive is being added. If other directives of this
		# type exist, add it after them. Otherwise, put it at the end of
		# the first file in the section
		if ($change) {
			# Have changed some old directive.. add this new one
			# after it, and update change
			local(%v, $j);
			%v = (	"line", $change->{'line'}+1,
				"eline", $change->{'line'}+1,
				"file", $change->{'file'},
				"type", 0,
				"name", $_[0],
				"value", $v);
			$j = &indexof($change, @{$_[2]})+1;
			&renumber($_[3], $v{'line'}, $v{'file'}, 1);
			splice(@{$_[2]}, $j, 0, \%v);
			$lref = &read_file_lines($v{'file'});
			splice(@$lref, $v{'line'}, 0, "$_[0] $v");
			$change = \%v;
			}
		else {
			# Adding a new directive to the end of the list
			# in this section
			local($f, %v, $j);
			$f = $_[2]->[0]->{'file'};
			for($j=0; $_[2]->[$j]->{'file'} eq $f; $j++) { }
			$l = $_[2]->[$j-1]->{'eline'}+1;
			%v = (	"line", $l,
				"eline", $l,
				"file", $f,
				"type", 0,
				"name", $_[0],
				"value", $v);
			&renumber($_[3], $l, $f, 1);
			splice(@{$_[2]}, $j, 0, \%v);
			$lref = &read_file_lines($f);
			splice(@$lref, $l, 0, "$_[0] $v");
			}
		}
	elsif ($i >= @{$_[1]}) {
		# a directive was deleted
		$lref = &read_file_lines($old[$i]->{'file'});
		$idx = &indexof($old[$i], @{$_[2]});
		splice(@{$_[2]}, $idx, 1);
		$len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
		splice(@$lref, $old[$i]->{'line'}, $len);
		&renumber($_[3], $old[$i]->{'line'}, $old[$i]->{'file'}, -$len);
		}
	else {
		# just changing the value
		$lref = &read_file_lines($old[$i]->{'file'});
		$len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
		&renumber($_[3], $old[$i]->{'eline'}+1,
			  $old[$i]->{'file'},1-$len);
		$old[$i]->{'value'} = $v;
		$old[$i]->{'eline'} = $old[$i]->{'line'};
		splice(@$lref, $old[$i]->{'line'}, $len, "$_[0] $v");
		$change = $old[$i];
		}
	}
}

# renumber(&config, line, file, offset)
# Recursively changes the line number of all directives from some file 
# beyond the given line.
sub renumber
{
local($d);
if (!$_[3]) { return; }
foreach $d (@{$_[0]}) {
	if ($d->{'file'} eq $_[2] && $d->{'line'} >= $_[1]) {
		$d->{'line'} += $_[3];
		}
	if ($d->{'file'} eq $_[2] && $d->{'eline'} >= $_[1]) {
		$d->{'eline'} += $_[3];
		}
	if ($d->{'type'}) {
		&renumber($d->{'members'}, $_[1], $_[2], $_[3]);
		}
	}
}

# server_root(path, &directives)
sub server_root
{
if ($_[0] =~ /^\//) { return $_[0]; }
else { return "$config{'httpd_dir'}/$_[0]"; }
}

sub dump_config
{
local($c, $mref);
print "<table border>\n";
print "<tr> <td>Name</td> <td>Value</td> <td>File</td> <td>Line</td> </tr>\n";
foreach $c (@_) {
	printf "<tr> <td>%s</td> <td>%s</td><td>%s</td><td>%s</td> </tr>\n",
		$c->{'name'}, $c->{'value'}, $c->{'file'}, $c->{'line'};
	if ($c->{'type'}) {
		print "<tr> <td colspan=4>\n";
		$mref = $c->{'members'};
		&dump_config(@$mref);
		print "</td> </tr>\n";
		}
	}
print "</table>\n";
}

sub def
{
return $_[0] ? $_[0] : $_[1];
}

# make_directives(ref, version, module)
sub make_directives