apache-lib.pl

Unix下基于Web的管理工具

{
local(@rv, $aref);
$aref = $_[0];
foreach $d (@$aref) {
	local(%dir);
	$dir{'name'} = $d->[0];
	$dir{'multiple'} = $d->[1];
	$dir{'type'} = $d->[2];
	$dir{'module'} = $_[2];
	$dir{'version'} = $_[1];
	$dir{'priority'} = $d->[5];
	foreach $c (split(/\s+/, $d->[3])) { $dir{$c}++; }
	if (!$d->[4]) { push(@rv, \%dir); }
	elsif ($d->[4] =~ /^-([\d\.]+)$/ && $_[1] < $1) { push(@rv, \%dir); }
	elsif ($d->[4] =~ /^([\d\.]+)$/ && $_[1] >= $1) { push(@rv, \%dir); }
	elsif ($d->[4] =~ /^([\d\.]+)-([\d\.]+)$/ && $_[1] >= $1 && $_[1] < $2)
		{ push(@rv, \%dir); }
	}
return @rv;
}


# editable_directives(type, context)
# Returns an array of references to associative arrays, one for each 
# directive of the given type that can be used in the given context
sub editable_directives
{
local($m, $func, @rv);
foreach $m (keys %httpd_modules) {
	$func = $m."_directives";
	push(@rv, &$func($httpd_modules{$m}));
	}
@rv = grep { $_->{'type'} == $_[0] && $_->{$_[1]} } @rv;
@rv = sort { $pd = $b->{'priority'} - $a->{'priority'};
	     $md = $a->{'module'} cmp $b->{'module'};
	     $pd == 0 ? ($md == 0 ? $a->{'name'} cmp $b->{'name'} : $md) : $pd }
		@rv;
return @rv;
}

# generate_inputs(&editors, &directives)
# Displays a 2-column list of options, for use inside a table
sub generate_inputs
{
local($e, $sw, @args, @rv, $func);
foreach $e (@{$_[0]}) {
	if (!$sw) { print "<tr>\n"; }

	# Build arg list for the editing function. Each arg can be a single
	# directive struct, or a reference to an array of structures.
	$func = "edit";
	undef(@args);
	foreach $ed (split(/\s+/, $e->{'name'})) {
		local(@vals);
		$func .= "_$ed";
		@vals = &find_directive_struct($ed, $_[1]);
		if ($e->{'multiple'}) { push(@args, \@vals); }
		elsif (!@vals) { push(@args, undef); }
		else { push(@args, $vals[$#vals]); }
		}
	push(@args, $e);

	# call the function
	@rv = &$func(@args);
	if ($rv[0] == 2) {
		# spans 2 columns..
		if ($sw) {
			# need to end this row
			print "<td colspan=2></td> </tr><tr>\n";
			}
		else { $sw = !$sw; }
		print "<td valign=top align=right width=25%><b>$rv[1]</b></td>\n";
		print "<td nowrap valign=top colspan=3 width=75%>$rv[2]</td>\n";
		}
	else {
		# only spans one column
		print "<td valign=top align=right width=25%><b>$rv[1]</b></td>\n";
		print "<td nowrap valign=top width=25%>$rv[2]</td>\n";
		}

	if ($sw) { print "</tr>\n"; }
	$sw = !$sw;
	}
}

# parse_inputs(&editors, &directives, &config)
# Reads user choices from a form and update the directives and config files.
sub parse_inputs
{
# First call editor functions to get new values. Each function returns
# an array of references to arrays containing the new values for the directive.
foreach $e (@{$_[0]}) {
	@dirs = split(/\s+/, $e->{'name'});
	$func = "save_".join('_', @dirs);
	@rv = &$func($e);
	for($i=0; $i<@dirs; $i++) {
		push(@chname, $dirs[$i]);
		push(@chval, $rv[$i]);
		}
	}

# Assuming everything went OK, update the configuration
for($i=0; $i<@chname; $i++) {
	&save_directive($chname[$i], $chval[$i], $_[1], $_[2]);
	}
&flush_file_lines();
}

# opt_input(value, name, default, size)
sub opt_input
{
return sprintf "<input type=radio name=$_[1]_def value=1 %s> $_[2]\n".
	       "<input type=radio name=$_[1]_def value=0 %s>\n".
	       "<input name=$_[1] size=$_[3] value='%s'>\n",
	defined($_[0]) ? "" : "checked",
	defined($_[0]) ? "checked" : "",
	$_[0];
}

# parse_opt(name, regexp, error)
sub parse_opt
{
local($i, $re);
if ($in{"$_[0]_def"}) { return ( [ ] ); }
for($i=1; $i<@_; $i+=2) {
	$re = $_[$i];
	if ($in{$_[0]} !~ /$re/) { &error($_[$i+1]); }
	}
return ( [ $in{$_[0]} ] );
}

# choice_input(value, name, default, [choice]+)
# Each choice is a display,value pair
sub choice_input
{
local($i, $rv);
for($i=3; $i<@_; $i++) {
	$_[$i] =~ /^([^,]*),(.*)$/;
	$rv .= sprintf "<input type=radio name=$_[1] value=\"$2\" %s> $1\n",
		lc($2) eq lc($_[0]) || !defined($_[0]) && lc($2) eq lc($_[2]) ? "checked" : "";
	}
return $rv;
}

# choice_input_vert(value, name, default, [choice]+)
# Each choice is a display,value pair
sub choice_input_vert
{
local($i, $rv);
for($i=3; $i<@_; $i++) {
	$_[$i] =~ /^([^,]*),(.*)$/;
	$rv .= sprintf "<input type=radio name=$_[1] value=\"$2\" %s> $1<br>\n",
		lc($2) eq lc($_[0]) || !defined($_[0]) &&
				       lc($2) eq lc($_[2]) ? "checked" : "";
	}
return $rv;
}

# parse_choice(name, default)
sub parse_choice
{
if (lc($in{$_[0]}) eq lc($_[1])) { return ( [ ] ); }
else { return ( [ $in{$_[0]} ] ); }
}

# select_input(value, name, default, [choice]+)
sub select_input
{
local($i, $rv);
$rv = "<select name=\"$_[1]\">\n";
for($i=3; $i<@_; $i++) {
	$_[$i] =~ /^([^,]*),(.*)$/;
	$rv .= sprintf "<option value=\"$2\" %s> $1\n",
		lc($2) eq lc($_[0]) || !defined($_[0]) && lc($2) eq lc($_[2]) ? "selected" : "";
	}
$rv .= "</select>\n";
return $rv;
}

# parse_choice(name, default)
sub parse_select
{
return &parse_choice(@_);
}

# handler_input(value, name)
sub handler_input
{
local($m, $func, @hl, $rv, $h);
push(@hl, "");
foreach $m (keys %httpd_modules) {
	$func = $m."_handlers";
	if (defined(&$func)) {
		push(@hl, &$func($conf, $httpd_modules{$m}));
		}
	}
if (&indexof($_[0], @hl) < 0) { push(@hl, $_[0]); }
$rv = "<select name=$_[1]>\n";
foreach $h (&unique(@hl)) {
	$rv .= sprintf "<option value=\"$h\" %s>$h\n",
		$h eq $_[0] ? "selected" : "";
	}
$rv .= "</select>\n";
return $rv;
}

# parse_handler(name)
sub parse_handler
{
if ($in{$_[0]} eq "") { return ( [ ] ); }
else { return ( [ $in{$_[0]} ] ); }
}

# virtual_name(struct)
sub virtual_name
{
if ($_[0]) {
	local $n = &find_directive("ServerName", $_[0]->{'members'});
	return $n ? $n : $_[0]->{'value'};
	}
else { return "default server"; }
}

# dir_name(struct)
sub dir_name
{
local($dfm, $mat);
$_[0]->{'name'} =~ /^(Directory|Files|Location)(Match)?$/;
$dfm = $1; $mat = $2;
if ($mat) { return "$dfm regexp <tt>$_[0]->{'words'}->[0]</tt>"; }
elsif ($_[0]->{'words'}->[0] eq "~")
	{ return "$dfm regexp <tt>$_[0]->{'words'}->[1]</tt>"; }
else { return "$dfm <tt>$_[0]->{'words'}->[0]</tt>"; }
}

# list_user_file(file, &user,  &pass)
sub list_user_file
{
local($_);
open(USERS, $_[0]);
while(<USERS>) {
	/^(\S+):(\S+)/;
	push(@{$_[1]}, $1); $_[2]->{$1} = $2;
	}
close(USERS);
}


# config_icons(context, program)
# Displays up to 17 icons, one for each type of configuration directive, for
# some context (global, virtual, directory or htaccess)
sub config_icons
{
local($m, $func, $e, %etype, $i, $c);
foreach $m (sort { $a cmp $b } (keys %httpd_modules)) {
        $func = $m."_directives";
	foreach $e (&$func($httpd_modules{$m})) {
		if ($e->{$_[0]}) { $etype{$e->{'type'}}++; }
		}
        }
print "<table width=100% cellpadding=5>\n";
for($i=0; $text{"type_$i"}; $i++) {
	if ($etype{$i} && $access_types{$i}) {
		if ($c%5 == 0) { print "<tr>\n"; }
		print "<td valign=top align=center width=20%>\n";
		&generate_icon("images/type_icon_$i.gif", $text{"type_$i"},
			       $_[1]."type=$i");
		print "</td>\n";
		if ($c%5 == 4) { print "<tr>\n"; }
		$c++;
		}
	}
for($i=2; $i<@_; $i++) {
	if ($c%5 == 0) { print "<tr>\n"; }
	print "<td valign=top align=center width=20%>\n";
	&generate_icon($_[$i]->{'icon'}, $_[$i]->{'name'}, $_[$i]->{'link'});
	print "</td>\n";
	if ($c%5 == 4) { print "<tr>\n"; }
	$c++;
	}
print "</table><p>\n";
}

# restart_button()
# Returns HTML for a link to put in the top-right corner of every page
sub restart_button
{
local($pidfile, $pidfilestr, $conf, $rv);
$conf = &get_config();
$pidfilestr = &find_directive_struct("PidFile", $conf);
$pidfile = $pidfilestr ? $pidfilestr->{'words'}->[0]
		       : "logs/httpd.pid";
$pidfile = &server_root($pidfile, $conf);
$args = "redir=".&urlize(&this_url());
if (open(PID, $pidfile) && <PID> =~ /(\d+)/ && kill(0, $1)) {
	close(PID);
	$rv = "<a href=\"restart.cgi?$args\">$text{'apache_apply'}</a><br>\n";
	if ($access{'stop'}) {
		$rv .= "<a href=\"stop.cgi?$args\">$text{'apache_stop'}</a>\n";
		}
	}
elsif ($access{'stop'}) {
	$rv = "<a href=\"start.cgi?$args\">$text{'apache_start'}</a><br>\n";
	}
return $rv;
}

# this_url()
# Returns the URL in the apache directory of the current script
sub this_url
{
local($url);
$url = $ENV{'SCRIPT_NAME'};
if ($ENV{'QUERY_STRING'} ne "") { $url .= "?$ENV{'QUERY_STRING'}"; }
return $url;
}

# find_all_directives(config, name)
# Recursively finds all directives of some type
sub find_all_directives
{
local(@rv, $d);
foreach $d (@{$_[0]}) {
	if ($d->{'name'} eq $_[1]) { push(@rv, $d); }
	if ($d->{'type'} == 1) {
		push(@rv, &find_all_directives($d->{'members'}, $_[1]));
		}
	}
return @rv;
}

# httpd_info(executable)
# Returns the httpd version and modules array
sub httpd_info
{
local(@mods, $verstr, $ver, $minor);
$verstr = `$_[0] -v 2>&1`;
if ($verstr =~ /Apache\/(\d+)\.([\d\.]+)/) {
	# standard apache
	$ver = $1; $minor = $2; $minor =~ s/\.//g; $ver .= ".$minor";
	}
elsif ($verstr =~ /Red\s*Hat\s+Secure\/2\.0/i) {
	# redhat secure server 2.0
	$ver = 1.31;
	}
elsif ($verstr =~ /Red\s*Hat\s+Secure\/3\.0/i) {
	# redhat secure server 3.0
	$ver = 1.39;
	}
else {
	# couldn't get version
	return (0, undef);
	}
if ($ver < 1.2) {
	# apache 1.1 has no -l option! Use the standard list
	@mods = ("core", "mod_mime", "mod_access", "mod_auth", "mod_include",
		 "mod_negotiation", "mod_dir", "mod_cgi", "mod_userdir",
		 "mod_alias", "mod_env", "mod_log_common");
	}
else {
	# ask apache for the module list
	@mods = ("core");
	open(APACHE, "$_[0] -l |");
	while(<APACHE>) {
		if (/(mod_\S+)\.c/) { push(@mods, $1); }
		}
	close(APACHE);
	}
return ($ver, \@mods);
}

# print_line(directive, text, indent, link)
sub print_line
{
local $line = $_[0]->{'line'} + 1;
local $lstr = "$_[0]->{'file'} ($line)";
local $txt = join("", @{$_[1]});
local $left = 85 - length($lstr) - $_[2];
if (length($txt) > $left) {
	$txt = substr($txt, 0, $left)." ..";
	}
local $txtlen = length($txt);
$txt =~ s/&/&amp;/g;
$txt =~ s/</&lt;/g;
$txt =~ s/>/&gt;/g;
print " " x $_[2];
if ($_[3]) {
	print "<a href=\"$_[3]\">",$txt,"</a>";
	}
else { print $txt; }
print " " x (90 - $txtlen - $_[2] - length($lstr));
print $lstr,"\n";
}

# can_edit_virt(struct)
sub can_edit_virt
{
return 1 if ($access{'virts'} eq '*');
local %vcan;
map { $vcan{$_}++ } split(/\s+/, $access{'virts'});
return $vcan{&virt_acl_name($_[0])};
}

# virt_acl_name(struct)
sub virt_acl_name
{
return "__default__" if (!$_[0]);
local $n = &find_directive("ServerName", $_[0]->{'members'});
if ($n) {
	local $p;
	if ($_[0]->{'value'} =~ /(:\d+)/) { $p = $1; }
	return $n.$p;
	}
else {
	return $_[0]->{'value'};
	}
}

# allowed_auth_file(file)
sub allowed_auth_file
{
local $_;
return 0 if ($_[0] =~ /\.\./);
local $f = &server_root($_[0], &get_config());
return 0 if (-l $f && !&allowed_auth_file(readlink($f)));
local $l = length($access{'dir'});
return length($f) >= $l && substr($f, 0, $l) eq $access{'dir'};
}

1;