web-lib.pl

Unix下基于Web的管理工具

# web-lib.pl
# Common functions and definitions for web admin programs

# Vital libraries
use Sys::Hostname;
use Socket;

# Configuration and spool directories
if (!defined($ENV{'WEBMIN_CONFIG'})) { die "WEBMIN_CONFIG not set"; }
$config_directory = $ENV{'WEBMIN_CONFIG'};
if (!defined($ENV{'WEBMIN_VAR'})) { die "WEBMIN_VAR not set"; }
$var_directory = $ENV{'WEBMIN_VAR'};

# read_file(file, &assoc, [&order])
# Fill an associative array with name=value pairs from a file
sub read_file
{
open(ARFILE, $_[0]) || return 0;
while(<ARFILE>) {
        chop;
        if (!/^#/ && /^([^=]+)=(.*)$/) {
		$_[1]->{$1} = $2;
		push(@{$_[2]}, $1);
        	}
        }
close(ARFILE);
return 1;
}
 
# write_file(file, array)
# Write out the contents of an associative array as name=value lines
sub write_file
{
local($arr);
$arr = $_[1];
open(ARFILE, "> $_[0]");
foreach $k (keys %$arr) {
        print ARFILE "$k=$$arr{$k}\n";
        }
close(ARFILE);
}

# html_escape
# Convert &, < and > codes in text to HTML entities
sub html_escape
{
local($tmp);
$tmp = $_[0];
$tmp =~ s/&/&amp;/g;
$tmp =~ s/</&lt;/g;
$tmp =~ s/>/&gt;/g;
$tmp =~ s/\"/&#34;/g;
return $tmp;
}

# obtain_lock
# Get a lock on a file, or wait.
# If the file is locked, and the locking process no longer exists ignore the
# lock and carry on.
sub obtain_lock {
  while(stat("$_[0].lock")) {
	sleep(1);
	open(LOCK, "$_[0].lock");
	chop($lpid = <LOCK>);
	close(LOCK);
	if ($lpid && !kill(0, "/proc/$lpid")) {
		# The process holding this lock is gone!
		# print STDERR "Process $lpid does not exist\n";
		last;
		}
	}
  open(LOCK,">$_[0].lock");
  print LOCK "$$\n";
  close(LOCK);
}

# release_lock
# Release the lock we are holding on a file
sub release_lock {
  unlink("$_[0].lock");
}

# test_lock
# Is this file locked?
sub test_lock
{
if (-r "$_[0].lock") {
	open(LOCK, "$_[0].lock");
	<LOCK> =~ /(\d+)/;
	close(LOCK);
	if ($1 && kill(0, $1)) { return 1; }
	}
return 0;
}

# tempname
# Returns a mostly random temporary file name
sub tempname
{
$tempfilecount++;
return "/tmp/".$$."_".$tempfilecount."_".$scriptname;
}

# trunc
# Truncation a string to the shortest whole word less than the given width
sub trunc {
  local($str,$c);
  if (length($_[0]) <= $_[1])
    { return $_[0]; }
  $str = substr($_[0],0,$_[1]);
  do {
    $c = chop($str);
    } while($c !~ /\S/);
  return $str;
}

# indexof
# Returns the index of some value in an array, or -1
sub indexof {
  local($i);
  for($i=1; $i <= $#_; $i++) {
    if ($_[$i] eq $_[0]) { return $i - 1; }
    }
  return -1;
  }

# unique
# Returns the unique elements of some array
sub unique
{
local(%found, @rv, $e);
foreach $e (@_) {
	if (!$found{$e}++) { push(@rv, $e); }
	}
return @rv;
}

# sysprint(handle, [string]+)
sub sysprint
{
local($str, $fh);
$str = join('', @_[1..$#_]);
$fh = $_[0];
syswrite $fh, $str, length($str);
}

# check_ipaddress(ip)
# Check if some IP address is properly formatted
sub check_ipaddress
{
return $_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ &&
	$1 >= 0 && $1 <= 255 &&
	$2 >= 0 && $2 <= 255 &&
	$3 >= 0 && $3 <= 255 &&
	$4 >= 0 && $4 <= 255;
}

# generate_icon(image, title, link)
sub generate_icon
{
if ($_[2]) {
	print "<table border><tr><td>\n",
	      "<a href=\"$_[2]\"><img src=\"$_[0]\" border=0></a>",
	      "</td></tr></table>\n";
	print "<a href=\"$_[2]\">$_[1]</a>\n";
	}
else {
	print "<table border><tr><td>\n",
	      "<img src=\"$_[0]\" border=0></td></tr></table>\n$_[1]\n";
	}
}

# urlize
# Convert a string to a form ok for putting in a URL
sub urlize {
  local($tmp, $tmp2, $c);
  $tmp = $_[0];
  $tmp2 = "";
  while(($c = chop($tmp)) ne "") {
	if ($c !~ /[A-z0-9]/) {
		$c = sprintf("%%%2.2X", ord($c));
		}
	$tmp2 = $c . $tmp2;
	}
  return $tmp2;
}

# include
# Read and output the named file
sub include
{
open(INCLUDE, $_[0]);
while(<INCLUDE>) {
	print;
	}
close(INCLUDE);
}

# copydata
# Read from one file handle and write to another
sub copydata
{
local($line, $out, $in);
$out = $_[1];
$in = $_[0];
while($line = <$in>) {
	print $out $line;
	}
}

# ReadParseMime
# Read data submitted via a POST request using the multipart/form-data coding
sub ReadParseMime
{
local($boundary,$line,$foo);
$ENV{CONTENT_TYPE} =~ /boundary=(.*)$/;
$boundary = $1;
<STDIN>;	# skip first boundary
while(1) {
	$name = "";
	# Read section headers
	while(1) {
		$line = <STDIN>;
		chop($line); chop($line);	# lose /r/n
		if (!$line) { last; }
		elsif ($line =~ /^Content-Disposition: form-data(.*)/) {
			$rest = $1;
			while ($rest =~ /([a-zA-Z]*)=\"([^\"]*)\"(.*)/) {
				if ($1 eq name) {
					$name = $2;
					}
				else {
					$foo = $name . "_$1";
					$in{$foo} = $2;
					}
				$rest = $3;
				}
			}
		elsif ($line =~ /^Content-Type: (.*)/) {
			$foo = $name . "_content_type";
			$in{$foo} = $1;
			}
		}
	# Read data
	$in{$name} .= "\0" if ($in{$name});
	while(1) {
		$line = <STDIN>;
		if (!$line) { return; }
		if (index($line,"$boundary") != -1) { last; }
		$in{$name} .= $line;
		}
	chop($in{$name}); chop($in{$name});
	if (index($line,"$boundary--") != -1) { last; }
	}
}

# ReadParse([&assoc])
# Fills the given associative array with CGI parameters, or uses the global
# %in if none is given. Also sets the global variables $in and @in
sub ReadParse
{
local $a = $_[0] ? $_[0] : \%in;
local $i;
if ($ENV{'REQUEST_METHOD'} eq 'POST') {
	read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
	}
else {
	$in = $ENV{'QUERY_STRING'};
	}
@in = split(/\&/, $in);
foreach $i (@in) {
	local ($k, $v) = split(/=/, $i, 2);
	$k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
	$v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
	$a->{$k} = defined($a->{$k}) ? $a->{$k}."\0".$v : $v;
	}
}

# PrintHeader
# Outputs the HTTP header for HTML
sub PrintHeader
{
#print "pragma: no-cache\n";
print "Content-type: text/html\n\n";
}

# header(title, image, [help], [config], [nomodule], [nowebmin], [rightside],
#	 [header])
# Output a page header with some title and image. The header may also
# include a link to help, and a link to the config page.
# The header will also have a link to to webmin index, and a link to the
# module menu if there is no config link
sub header
{
local($l, $ll, %access);
foreach $l (&list_languages()) {
	$lang = $l if ($l->{'lang'} eq $current_lang);
	}
&PrintHeader;
print "<html>\n";
if (@_ > 0) {
	print "<head>\n";
	print "<title>$_[0]</title>\n";
	print $_[7] if ($_[7]);
	print "<SCRIPT LANGUAGE=\"JavaScript\">\n";
	printf "defaultStatus=\"%s logged into Webmin %s on %s (%s %s)\";\n",
		$ENV{'REMOTE_USER'},
		&get_webmin_version(),
		&get_system_hostname(),
		$gconfig{'real_os_type'} ? $gconfig{'real_os_type'}
					 : $gconfig{'os_type'},
		$gconfig{'real_os_version'} ? $gconfig{'real_os_version'}
					    : $gconfig{'os_version'};
	print "</SCRIPT>\n";
	print "</head>\n";
	}
local $bgcolor = defined($gconfig{'cs_page'}) ? $gconfig{'cs_page'} : "ffffff";
local $link = defined($gconfig{'cs_link'}) ? $gconfig{'cs_link'} : "0000ee";
local $text = defined($gconfig{'cs_text'}) ? $gconfig{'cs_text'} : "000000";
print "<body bgcolor=#$bgcolor link=#$link vlink=#$link text=#$text>\n";
if (@_ > 1) {
	print "<table width=100%><tr>\n";
	print "<td width=15% valign=top align=left>";
	if ($ENV{'HTTP_WEBMIN_SERVERS'}) {
		print "<a href='$ENV{'HTTP_WEBMIN_SERVERS'}'>",
		      "$text{'header_servers'}</a><br>\n";
		}
	if (!$_[5]) { print "<a href=/>$text{'header_webmin'}</a><br>\n"; }
	if (!$_[4]) { print "<a href=\"\">$text{'header_module'}</a><br>\n"; }
	if (defined($_[2])) {
		print &hlink($text{'header_help'}, $_[2]),"<br>\n";
		}
	if ($_[3]) {
		local %access = &get_module_acl();
		if (!$access{'noconfig'}) {
			print "<a href=\"/config.cgi?$module_name\">",
			      $text{'header_config'},"</a><br>\n";
			}
		}
	print "</td>\n";
	local $title = $_[0];
	$title =~ s/&auml;/