miniserv.pl

Unix下基于Web的管理工具

		return 0;
		}
	# A directory.. check for index files
	foreach $idx (split(/\s+/, $config{"index_docs"})) {
		$idxfull = "$full/$idx";
		if (-r $idxfull && !(-d $idxfull)) {
			$full = $idxfull;
			$scriptname .= "/" if ($scriptname ne "/");
			last;
			}
		}
	}
if (-d $full) {
	# This is definately a directory.. list it
	&write_data("HTTP/1.0 200 Document follows\r\n");
	&write_data("Date: $datestr\r\n");
	&write_data("Server: $config{server}\r\n");
	&write_data("Content-type: text/html\r\n");
	&write_keep_alive(0);
	&write_data("\r\n");
	&reset_byte_count();
	&write_data("<h1>Index of $simple</h1>\n");
	&write_data("<pre>\n");
	&write_data(sprintf "%-35.35s %-20.20s %-10.10s\n",
			"Name", "Last Modified", "Size");
	&write_data("<hr>\n");
	opendir(DIR, $full);
	while($df = readdir(DIR)) {
		if ($df =~ /^\./) { next; }
		(@stbuf = stat("$full/$df")) || next;
		if (-d "$full/$df") { $df .= "/"; }
		@tm = localtime($stbuf[9]);
		$fdate = sprintf "%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d",
				$tm[3],$tm[4]+1,$tm[5]+1900,
				$tm[0],$tm[1],$tm[2];
		$len = length($df); $rest = " "x(35-$len);
		&write_data(sprintf 
		 "<a href=\"%s\">%-${len}.${len}s</a>$rest %-20.20s %-10.10s\n",
		 $df, $df, $fdate, $stbuf[7]);
		}
	closedir(DIR);
	&log_request($acptip, $authuser, $reqline, 200, &byte_count());
	return 0;
	}

# CGI or normal file
local $rv;
if (&get_type($full) eq "internal/cgi") {
	# A CGI program to execute
	$envtz = $ENV{"TZ"};
	$envuser = $ENV{"USER"};
	$envpath = $ENV{"PATH"};
	foreach (keys %ENV) { delete($ENV{$_}); }
	$ENV{'PATH'} = $envpath if ($envpath);
	$ENV{"TZ"} = $envtz if ($envtz);
	$ENV{"USER"} = $envuser if ($envuser);
	$ENV{"HOME"} = $user_homedir;
	$ENV{"SERVER_SOFTWARE"} = $config{"server"};
	$ENV{"SERVER_NAME"} = $host;
	$ENV{"SERVER_ADMIN"} = $config{"email"};
	$ENV{"SERVER_ROOT"} = $config{"root"};
	$ENV{"SERVER_PORT"} = $port;
	$ENV{"REMOTE_HOST"} = $acptip;
	$ENV{"REMOTE_ADDR"} = $acptip;
	$ENV{"REMOTE_USER"} = $authuser if (defined($authuser));
	$ENV{"DOCUMENT_ROOT"} = $config{"root"};
	$ENV{"GATEWAY_INTERFACE"} = "CGI/1.1";
	$ENV{"SERVER_PROTOCOL"} = "HTTP/1.0";
	$ENV{"REQUEST_METHOD"} = $method;
	$ENV{"SCRIPT_NAME"} = $scriptname;
	$ENV{"REQUEST_URI"} = $request_uri;
	$ENV{"PATH_INFO"} = $pathinfo;
	$ENV{"PATH_TRANSLATED"} = "$config{root}/$pathinfo";
	$ENV{"QUERY_STRING"} = $querystring;
	$ENV{"MINISERV_CONFIG"} = $conf;
	$ENV{"HTTPS"} = "ON" if ($use_ssl);
	if (defined($header{"content-length"})) {
		$ENV{"CONTENT_LENGTH"} = $header{"content-length"};
		}
	if (defined($header{"content-type"})) {
		$ENV{"CONTENT_TYPE"} = $header{"content-type"};
		}
	foreach $h (keys %header) {
		($hname = $h) =~ tr/a-z/A-Z/;
		$hname =~ s/\-/_/g;
		$ENV{"HTTP_$hname"} = $header{$h};
		}
	$full =~ /^(.*\/)[^\/]+$/; $ENV{"PWD"} = $1;
	foreach $k (keys %config) {
		if ($k =~ /^env_(\S+)$/) {
			$ENV{$1} = $config{$k};
			}
		}

	# fork the process that actually executes the CGI
	pipe(CGIINr, CGIINw);
	pipe(CGIOUTr, CGIOUTw);
	pipe(CGIERRr, CGIERRw);
	if (!($cgipid = fork())) {
		chdir($ENV{"PWD"});
		close(SOCK);
		open(STDIN, "<&CGIINr");
		open(STDOUT, ">&CGIOUTw");
		open(STDERR, ">&CGIERRw");
		close(CGIINw); close(CGIOUTr); close(CGIERRr);
		exec($full, split(/\s+/, $queryargs));
		print STDERR "Failed to exec $full : $!\n";
		exit;
		}
	close(CGIINr); close(CGIOUTw); close(CGIERRw);

	# send post data
	if ($method eq "POST") {
		$got = 0; $clen = $header{"content-length"};
		while($got < $clen) {
			$buf = &read_data($clen-$got);
			$got += length($buf);
			print CGIINw $buf;
			}
		}
	close(CGIINw);

	# read back cgi headers
	select(CGIOUTr); $|=1; select(STDOUT);
	$got_blank = 0;
	while(1) {
		$line = <CGIOUTr>;
		$line =~ s/\r|\n//g;
		if ($line eq "") {
			if ($got_blank || %cgiheader) { last; }
			$got_blank++;
			next;
			}
		($line =~ /^(\S+):\s+(.*)$/) ||
			&http_error(500, "Bad Header", &read_errors(CGIERRr));
		$cgiheader{lc($1)} = $2;
		}
	if ($cgiheader{"location"}) {
		&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
		# ignore the rest of the output. This is a hack, but
		# is necessary for IE in some cases :(
		close(CGIOUTr); close(CGIERRr);
		}
	elsif ($cgiheader{"content-type"} eq "") {
		&http_error(500, "Missing Header", &read_errors(CGIERRr));
		}
	else {
		&write_data("HTTP/1.0 200 Document follows\r\n");
		&write_data("Date: $datestr\r\n");
		&write_data("Server: $config{server}\r\n");
		&write_keep_alive(0);
		}
	foreach $h (keys %cgiheader) {
		&write_data("$h: $cgiheader{$h}\r\n");
		}
	&write_data("\r\n");
	&reset_byte_count();
	while($line = <CGIOUTr>) { &write_data($line); }
	close(CGIOUTr); close(CGIERRr);
	$rv = 0;
	}
else {
	# A file to output
	local @st = stat($full);
	open(FILE, $full) || &http_error(404, "Failed to open file");
	&write_data("HTTP/1.0 200 Document follows\r\n");
	&write_data("Date: $datestr\r\n");
	&write_data("Server: $config{server}\r\n");
	&write_data("Content-type: ".&get_type($full)."\r\n");
	&write_data("Content-length: $st[7]\r\n");
	&write_data("Last-Modified: ".&http_date($st[9])."\r\n");
	&write_keep_alive();
	&write_data("\r\n");
	&reset_byte_count();
	while(read(FILE, $buf, 1024) > 0) {
		&write_data($buf);
		}
	close(FILE);
	$rv = &check_keep_alive();
	}

# log the request
&log_request($acptip, $authuser, $reqline,
	     $cgiheader{"location"} ? "302" : "200", &byte_count());
return $rv;
}	

# http_error(code, message, body, [dontexit])
sub http_error
{
close(CGIOUT);
&write_data("HTTP/1.0 $_[0] $_[1]\r\n");
&write_data("Server: $config{server}\r\n");
&write_data("Date: $datestr\r\n");
&write_data("Content-type: text/html\r\n");
&write_keep_alive(0);
&write_data("\r\n");
&reset_byte_count();
&write_data("<h1>Error - $_[1]</h1>\n");
if ($_[2]) {
	&write_data("<pre>$_[2]</pre>\n");
	}
&log_request($acptip, $authuser, $reqline, $_[0], &byte_count());
exit if (!$_[3]);
}

sub get_type
{
if ($_[0] =~ /\.([A-z0-9]+)$/) {
	$t = $mime{$1};
	if ($t ne "") {
		return $t;
		}
	}
return "text/plain";
}

# simplify_path(path, bogus)
# Given a path, maybe containing stuff like ".." and "." convert it to a
# clean, absolute form.
sub simplify_path
{
local($dir, @bits, @fixedbits, $b);
$dir = $_[0];
$dir =~ s/^\/+//g;
$dir =~ s/\/+$//g;
@bits = split(/\/+/, $dir);
@fixedbits = ();
$_[1] = 0;
foreach $b (@bits) {
        if ($b eq ".") {
                # Do nothing..
                }
        elsif ($b eq "..") {
                # Remove last dir
                if (scalar(@fixedbits) == 0) {
                        $_[1] = 1;
                        return "/";
                        }
                pop(@fixedbits);
                }
        else {
                # Add dir to list
                push(@fixedbits, $b);
                }
        }
return "/" . join('/', @fixedbits);
}

# b64decode(string)
# Converts a string from base64 format to normal
sub b64decode
{
    local($str) = $_[0];
    local($res);
    $str =~ tr|A-Za-z0-9+=/||cd;
    $str =~ s/=+$//;
    $str =~ tr|A-Za-z0-9+/| -_|;
    while ($str =~ /(.{1,60})/gs) {
        my $len = chr(32 + length($1)*3/4);
        $res .= unpack("u", $len . $1 );
    }
    return $res;
}

# ip_match(ip, [match]+)
# Checks an IP address against a list of IPs, networks and networks/masks
sub ip_match
{
local(@io, @mo, @ms, $i, $j);
@io = split(/\./, $_[0]);
for($i=1; $i<@_; $i++) {
	local $mismatch = 0;
	if ($_[$i] =~ /^(\S+)\/(\S+)$/) {
		# Compare with network/mask
		@mo = split(/\./, $1); @ms = split(/\./, $2);
		for($j=0; $j<4; $j++) {
			if ((int($io[$j]) & int($ms[$j])) != int($mo[$j])) {
				$mismatch = 1;
				}
			}
		}
	else {
		# Compare with IP or network
		@mo = split(/\./, $_[$i]);
		while(@mo && !$mo[$#mo]) { pop(@mo); }
		for($j=0; $j<@mo; $j++) {
			if ($mo[$j] != $io[$j]) {
				$mismatch = 1;
				}
			}
		}
	return 1 if (!$mismatch);
	}
return 0;
}

# restart_miniserv()
# Called when a SIGHUP is received to restart the web server. This is done
# by exec()ing perl with the same command line as was originally used
sub restart_miniserv
{
close(SOCK); close(MAIN);
foreach $p (@passin) { close($p); }
foreach $p (@passout) { close($p); }
if ($logclearer) { kill('TERM', $logclearer);	}
open(SOURCE, $0);
<SOURCE> =~ /^#!(\S+)/; $ipath = $1;
close(SOURCE);
exec($ipath, $0, @ARGV);
die "Failed to restart miniserv with $ipath $0";
}

sub trigger_restart
{
$need_restart = 1;
#socket(RES, PF_INET, SOCK_STREAM, getprotobyname("tcp"));
#$addr = inet_aton($config{"bind"} ? $config{"bind"} : "127.0.0.1");
#connect(RES, sockaddr_in($config{"port"}, $addr));
#close(RES);
}

sub to_ipaddress
{
local (@rv, $i);
foreach $i (@_) {
	if ($i =~ /(\S+)\/(\S+)/) { push(@rv, $i); }
	else { push(@rv, join('.', unpack("CCCC", inet_aton($i)))); }
	}
return @rv;
}

# read_line()
# Reads one line from SOCK or SSL
sub read_line
{
local($idx, $more, $rv);
if ($use_ssl) {
	while(($idx = index($read_buffer, "\n")) < 0) {
		# need to read more..
		if (!($more = Net::SSLeay::read($ssl_con))) {
			# end of the data
			$rv = $read_buffer;
			undef($read_buffer);
			return $rv;
			}
		$read_buffer .= $more;
		}
	$rv = substr($read_buffer, 0, $idx+1);
	$read_buffer = substr($read_buffer, $idx+1);
	return $rv;
	}
else { return <SOCK>; }
}

# read_data(length)
# Reads up to some amount of data from SOCK or the SSL connection
sub read_data
{
if ($use_ssl) {
	local($rv);
	if (length($read_buffer)) {
		$rv = $read_buffer;
		undef($read_buffer);
		return $rv;
		}
	else {
		return Net::SSLeay::read($ssl_con, $_[0]);
		}
	}
else {
	local($buf);
	read(SOCK, $buf, $_[0]) || return undef;
	return $buf;
	}
}

# write_data(data)
# Writes a string to SOCK or the SSL connection
sub write_data
{
if ($use_ssl) {
	Net::SSLeay::write($ssl_con, $_[0]);
	}
else {
	print SOCK $_[0];
	}
$write_data_count += length($_[0]);
}

# reset_byte_count()
sub reset_byte_count { $write_data_count = 0; }

# byte_count()
sub byte_count { return $write_data_count; }

# reaper()
# Collects dead processes
sub reaper
{
local($pid);
do {	$pid = waitpid(-1, WNOHANG);
	@childpids = grep { $_ != $pid } @childpids;
	} while($pid > 0);
}

# log_request(address, user, request, code, bytes)
sub log_request
{
if ($config{'log'}) {
	local(@tm, $dstr, $addr, $user, $ident);
	if ($config{'logident'}) {
		# add support for rfc1413 identity checking here
		}
	else { $ident = "-"; }
	@tm = localtime(time());
	$dstr = sprintf "%2.2d/%s/%4.4d:%2.2d:%2.2d:%2.2d %s",
			$tm[3], $make_date_marr[$tm[4]], $tm[5]+1900,
	                $tm[2], $tm[1], $tm[0], $timezone;
	$addr = $config{'loghost'} ? gethostbyaddr(inet_aton($_[0]), AF_INET)
				   : $_[0];
	$user = $_[1] ? $_[1] : "-";
	open(LOG, ">>$config{'logfile'}");
	chmod(0600, $config{'logfile'});
	print LOG "$addr $ident $user [$dstr] \"$_[2]\" $_[3] $_[4]\n";
	close(LOG);
	}
}

# read_errors(handle)
# Read and return all input from some filehandle
sub read_errors
{
local($fh, $_, $rv);
$fh = $_[0];
while(<$fh>) { $rv .= $_; }
return $rv;
}

sub write_keep_alive
{
local $mode;
if (@_) { $mode = $_[0]; }
else { $mode = &check_keep_alive(); }
&write_data("Connection: ".($mode ? "Keep-Alive" : "close")."\r\n");
}

sub check_keep_alive
{
return $header{'connection'} =~ /keep-alive/i;
}

sub term_handler
{
if (@childpids) {
	$len = @childpids;
	kill('TERM', @childpids);
	}
exit(1);
}

sub http_date
{
local @tm = gmtime($_[0]);
return sprintf "%s %d %s %d %2.2d:%2.2d:%2.2d GMT",
		$weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900,
		$tm[2], $tm[1], $tm[0];
}