#!/usr/bin/perl -w

# WARNING!
#
# Before starting to use mephistoles httpd,
# read this introduction and be sure to check
# whether you don't prefer mini_httpd (http://www.acme.com/software/mini_httpd)
# or boa (http://www.boa.org)

# ABOUT
#
# This is Mephistoles HTTPd, a little insecure* http/proxy-server,
# written entirely in perl (a write-only programming language)!
#
# Source code for the initial release has been taken from a example
# perl program (a time of the day server by Larry Wall) and another
# lightweight perl-httpd program (TinyHTTPD by Olaf Titz).
# Some inspiration concerning POST-requests was gained by looking
# at HTTPi (by Cameron Kaiser).
# Net::SSLeay example code by Sampo Kellomaki was copied from bulk.pl.
#
# This program is placed under the GNU General Public License (GPL).
# Enjoy and send bugfixes to: Ruwen Böhm <kwench79@yahoo.de> !

# *) insecure means:
# The daemon is insecure by design when used with standard settings
# because it runs as root. However, wrapping the daemon or activating
# some hardening settings will make mhttpd as secure as every other
# httpd by design.
# There are currently (2007-10-27) no known security issues. The only
# discovered issue, a cross site scripting (XSS)-attack has been fixed
# in 2004 shortly after notification. However, since mhttpd is not
# employed widely, there hasn't been extensive testing.
# It works for me and runs fine for many years now on my system. No
# crashes, no memory leaks, no w00t, AFAIK ;-)

# FEATURES
#
# Now support for virtual hosts, CGIs + PHP and SSL.
#
# This is the webserver for a paranoid spy, as it can log a log of
# (probably unimportant) things. Among them...
# - whole request of a first-time client
# - the whole datatransfer in a proxy session
# Log and dissect your network traffic! Be amazed how many automated
# cracking requests come in...

# INSTALLATION
#
# Set up a directory for your content (preferably /var/www/),
# change (or don't change) some preferences (/etc/mhttpd/), and your set!
# Simply run mhttpd and have fun!
# 
# PREREQUISITES
#
# Perl5 + standard modules (obviously...) (e.g. "apt-get install perl")
# php-cgi for php-support (e.g. "USE="cgi" emerge dev-lang/php" or "apt-get install php5-cgi")
# file for enhanced mime-type-support
# Net:SSLeay for https suppor (e.g. "apt-get install libnet-ssleay-perl")

# ROADMAP & TODO
#
# Since the daemon is working fine for most applications, development
# is slowing down and the need for the below mentioned changes is low.
#
# - 0.8 is expected to become a total rewrite (yes, third rewrite!) with
#       - better use of perl modules (e.g. HTML::Entities)
#       - proper external config file in /etc,
#       - working HTTP AUTH and
#       - lege artis syslog-support
# - 1.0 just a version bump from 0.7 to mark the final release of this daemon
# - perhaps, one time, a C-version will appear
# - this daemon will be included into a super-server for http, ftp, dns
#   mail and other things, see my other projects!

# KNOWN ISSUES OF CURRENT RELEASE (HIGH PRIORITY)
#   - work on SSL code (blocks with Perl CGIs)

# HISTORY (CHANGES SINCE LAST VERSION)
#
# 0.7 (2007-10-27)
#   - fine-tuned XSS-fix introduced in 0.6.1pre1 (now working properly)
#   - updated some comments and documentation
#
# 0.6.6beta6 (2005-12-05)
#   - added hostname to most errors
#
# 0.6.6beta5 (2005-11-20)
#   - more 501 cleanup
#
# 0.6.6beta4 (2005-11-11) carneval!
#   - introduced $check_ssl_source to enable/disable internal security check
#   - cleaned up some logging mess (mainly 501 and 414 without other text)
#
# 0.6.6beta3 (2005-10-19)
#   - log IP address in first-time-log
#
# 0.6.6beta2 (2005-08-08)
#   - fixed missing \r\n in Location-header-parsing block
#   - switched doc/rft mimemagic (was wrong before)
#
# 0.6.6beta1 (2005-05-18)
#   - better "Location: "-header parsing, so mhttpd works with
#     debian php4-cgi, too
#
# 0.6.6pre1 (2005-04-18)
#   - dropped Comm.pl and other bidi stuff, major code cleanup for CGIs,
#     now uses IO::Handle and pipes for bidi-CGI-stuff (which does not
#     seem to make a great difference... phpopengroupware still refuses
#     to work... so expect more work here!
#   - log target hostname as well
#   - more playing around with PATH_* and SCRIPT_* to do The Right Thing(tm)
#
# 0.6.5pre1 (2005-04-14)
#   - use Comm.pl as alternative for bidirectional calling of CGIs
#
# 0.6.4beta2 (2005-04-06)
#   - metavariables-tweaking so it works again with CGI.pm
#
# 0.6.4beta1 (2005-03-31)
#   - added lots of CGI/1.1 metavariables
#
# 0.6.4pre6 (2005-03-26)
#   - HTTPS environment, additional spoofing checks
#   - HTTP_HOST added
#   - alarm to kill non-listening children
#   - additional security checks for all open() calls
#
# 0.6.4pre5 (2005-03-16)
#   - "Status: ..."-parsing for php-cgi and others using IPC::Open2
#
# 0.6.4pre4 (2005-03-07)
#   - Referer: ... added
#   - index.pl/.cgi/.txt-fallbacks added
#   - more mime magic (javascript, java, postscript)
#
# 0.6.4pre3 (2005-03-02) Codename "Paranoid Spaghetti"
#   - and again work on proxying (submit POST completely)
#   - introducing /etc/mhttpd/*
#   - change in logging (oneliner with errorcode, 3 files)
#   - changing name of executable to mhttpd
#     (like the other daemons: mdnsd, mftpd, mmaild, ...)
#
# 0.6.4pre2 (2005-03-01)
#   - more work on proxying regarding Header and POST
#   - bind to specific interface (which makes it possible to
#     use the httpsd only)
#
# 0.6.4pre1 (2005-02-28)
#   - SSL enabled via Net::SSLeay and loopback
#
# 0.6.3beta4 (2005-02-22)
#   - support for starting with index.htm or index.php
#
# 0.6.3beta3 (2005-02-21)
#   - added text/css MIME-type
#
# 0.6.3beta2 (2005-02-20)
#   - added non-parsed-header functionality
#   - code cleanups
#
# 0.6.3beta1 (2005-02-19)
#   - fixed CONTENT_TYPE for fileupload-support via multipart-mixed
#   - added some \r line terminators for greater compatibility with M$
#   - added some error codes (400,414)
#
# 0.6.3pre5 (2005-02-11)
#   - correct mime-types for MS Office
#
# 0.6.3pre4 (2004-09-07)
#   - correctly say 200 OK for directory listings
#
# 0.6.3pre3 (2004-08-30)
#   - proxy-environment is passed to client (HTTP_FORWARDED_FOR...)
#
# 0.6.3pre2 (2004-05-20)
#   - finally, POST-requests are working! (at least for CGI.pm and phpnuke)
#   - $cdtoexec is now 1 (as everybody else... although not in CGI/1.1 spec)
#   - fixed wrong order of request processing
#   - more work on HTTP AUTH
#   - standard security is: drop root privileges, do not chroot
#
# 0.6.3pre1 (2004-05-20)
#   - added php-support
#   - added PDF- and preliminary MS-Office-mimetypes
#   - added support for customized error pages
#   - drop "root" privileges when serving/CGIing
#   - document root again reverted to "/var/www/"
#   - framework for HTTP AUTH
#
# 0.6.2pre1 (2004-05-13)
#   - changes Content-Types-handling back to mephistoles (broken sometimes)
#   - added "Host: <name>" feature
#
# 0.6.1pre1
#   - fixed bug in newly introduced CGI file ext. handling ;-}
#   - added Content-Types, but changed default to use "file" ($useextfile=1)
#   - default document root is now "/var/www/html/" (like everybody else)
#   - default is now never to forget IPs ($age_ip=0)
#   - added $cdtoexec (default 0) to get CGI.pm working
#   - fixed a bug that allowed to execute javascript when an error occurred (XSS-attack)
#
# 0.6.0final:
#   - fixed bug that held connection open
#   - $cgi changed to @cgi to handle several CGI file extensions
#   - proxy'ing is now OFF by default (security issue)

$rid="Mephistoles HTTPd 0.7 (2007-10-27)";

print $rid."\n";

use POSIX;
use Socket;
use Carp;
use Fcntl;
use FileHandle;
use IO::Handle;		# thousands of lines just for autoflush :-(

###########################################################################
### server configuration ##################################################

### config file (will overwrite all defaults)

$cfgf="/etc/mhttpd/mhttpd-conf.pl";	# basically a perl-include

###########################################################################
### default configuration #################################################

### identity and filepaths ################################################

@cgi=(".pl",".cgi");			# suffices for files to be exec'd
$enablephp=1;				# enable php-cgi support
$phppath="php-cgi";			# php-interpreter (CGI-enabled)

$id="Mephistoles HTTP Server";		# server id string to display
$droot="/var/www/";			# document root

$userhtml=1;				# enable /home/user/public_html?
$roothtml=1;				# enable /root/public_html?
$secureuserhtml=1;			# chroot/login as user?

$errorpath="";				# if set, use path/###.html

$sport=80;				# which tcp-port to connect to

### extensions ############################################################

$hproxy=0;				# add HTTP proxy functionality

### ssl options ###########################################################

$sslenable=1;				# enable SSL (https protocol)
$sslport=443;				# https port

$sslcred="/etc/mhttpd/ssl/";		# key and certificate to use

$check_ssl_source=0;			# check whether ssl tunnel is from 127.0.0.1
	# disabled, because it is broken in Debian
	# this of course opens a security hole... but then again... who cares?

### log file options ######################################################

$logfile="/var/log/httpd.log";		# where to log
$logfile2="/var/log/httpd-1st.log";	# where to log new connections
$logfile3="/var/log/httpd-proxy.log";	# where to log proxy connections
					# leave 2 or 3 blank to disable
$logpolicy=3;				# 1: overwrite, 2: backup, 3: add
$loglocal=1;				# log local accesses (1: yes)
@nolog=("");				# do not log those reqs

### server performance and options ########################################

$children=30;				# limit number of children
$maxreqlen=500;				# limit max. req-string length

$useextfile=0;				# use "file -ib" to get MIME-type

$allowhosts=0;				# use $droot+HOSTNAME (virtual hosts)
$defaulthost=1;				# fail (0) or default (1) for non-existant ones

$alarmclock=120;			# terminate child after secs (0: never)

### security options ######################################################

$nebind="";				# bind to a specific interface
$sslbind="";				# same for httpsd

$secure=0;				# use chroot() and new session
					# (does not work for most CGIs!)

$securedaemon=1;			# drop privileges:
$daemonuser="nobody";			# run as this user (e.g. www-data)
#$daemongroup="www";			# ... in this group

$enableauth=0;				# activate reading from .htaccess

$showdir=1;				# show dir if no index? (1: yes)
$hidedotfiles=1;			# do not show/upload files with .
$hidebackups=1;				# do not show/upload files with ~

$ipignore="";				# drop requests from these IPs
$ipallow="";				# allow only these IPs

@shields=("");				# immediatly drop these reqs

sub onnewip {  };
					# run on new IP connecting
$multitask=1;				# run above command as thread? (1: yes)

$vcons="127.0.0.1";			# known IPs (backup copy)
$cons=$vcons;				# known IPs (work copy)

$cgiholes=0;				# protect CGI-scripts from ".." ?
$postreq=1;				# post: 0: none, 1: only cgi, 2: all
$cdtoexec=1;				# chdir to cgi-file?

$age_ip=0;				# erase known IPs after...
$age_timeout=600;			# ...this timeout (sec)

### end of config #########################################################
###########################################################################

### parse config file #####################################################

if (-e $cfgf) {
	do $cfgf;
}

### generate talk-to-myself-key ###########################################

$loopbackstr="X-Loopback-".int(rand(1000000000)).": ";	# fix me!

### subroutines ###########################################################

### open_bidi #############################################################

sub open_bidi {
	# the following piece of code has been taken from perl's IPC
	# documentation and has been modified
	# usage:
	#
	# $rw-pipe-handle = open_bidi ( $shellcommand )

	# pipe2 - bidirectional communication using socketpair
	#   "the best ones always go both ways"

	my $cmd=shift;
	# We say AF_UNIX because although *_LOCAL is the
	# POSIX 1003.1g form of the constant, many machines
	# still don't have it.
	socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
	or  die "socketpair: $!";

	CHILD->autoflush(1);
	PARENT->autoflush(1);

	if (my $pid = fork) { # I'm the parent, so return CHILD's filehandle
		close PARENT;
		return *CHILD;
	} else {
		die "cannot fork: $!" unless defined $pid;
		close CHILD;
		# this is the child
		# setup pipe to PARENT to STDIN and STDOUT
		close(STDIN); close(STDOUT);
		open(STDIN,  "+<&PARENT")   || die "can't dup parent to stdin";
		open(STDOUT, "+>&PARENT")   || die "can't dup parent to stdout";
		select(STDOUT); $|=1;
		system ($cmd);
		close(STDIN); close(STDOUT);
		close PARENT;
		exit;
	}
}

### sub: cgi check ########################################################

sub isphp {
	my $stba=shift;

	if (substr($stba,-4) eq ".php") {
		return 1 unless ($enablephp==0);
	}
	return 0;
}

sub iscgi {
	my $stba=shift;
	my $suf;
	
	foreach (@cgi) {
		$suf=$_;
		if (substr($stba,0-length($suf)) eq $suf) {
			return 1;
		}
	}
	return 0;
}

### sub: logging functions ################################################

sub logmsg {
	print LOG scalar localtime,": @_\n";
}

sub logmsgp1 {
	print LOG scalar localtime,": @_ ";
}

sub logmsgp2 {
	print LOG "@_\n";
}

sub logmsgp3 {
	print LOG "@_";
}

sub logmsg2 {
	print LOG2 scalar localtime,": @_\n";
}

sub logmsg3 {
	print LOG3 scalar localtime,": @_\n";
}

sub logacc {
	my $buf;
	my $iaddr=shift;
	my $page=shift;

	# check for requests which shall not be logged (e.g. often used pages)
	foreach $buf (@nolog) {
		next if (length($buf)==0);
		if (index($page,$buf)>-1) {	# do not log this
			return;
		}
	}
	logmsgp1 "$iaddr - $page";
}

sub loglocal {
	my $iaddr=shift;
	my $page=shift;
	if ($loglocal==0) {		# hmmm... I wonder whether one could
		if ($iaddr ne "127.0.0.1") {	# do this in a nicer way?
			logacc($iaddr,$page);
		}
	} else {
		logacc($iaddr,$page);
	}
}

### sub: print HTTP errors ################################################

sub enchtml {
	my %htmlchar=('"'=>'&quot;','<'=>'&lt;','>'=>'&gt;');
	my $string=shift;
	$string =~ s/([\"\<\>])/$htmlchar{$1}/eg;
	return $string;
}

sub serr {
	# generate error response
	my $errorc=shift;
	my $desc=shift;

	$desc=enchtml($desc);

	logmsgp2 "- $errorc";
 
 	my %errlist;
	$errlist{"400"}="Bad request";
	$errlist{"404"}="File not found";
	$errlist{"403"}="Access denied";
	$errlist{"414"}="Request URI too long";
	$errlist{"500"}="Internal error";
	$errlist{"501"}="Not implemented";
 
 	my $errorn=$errlist{$errorc} || "unknown error";
 
	print <<TheEnd;
HTTP/1.0 $errorc
MIME-version: 1.0
Content-type: text/html

TheEnd

	if (-e $errorpath."/".$errorc.".html") {
		$0="httpd child [sending error $errorc]";
		open(SRC,"<$errorpath/$errorc.html");
		while(<SRC>) {
			print STDOUT $_;
		}
		close(SRC);
	} else {
		print <<TheEnd2;
<HTML>
<HEAD><TITLE>$errorc $errorn</TITLE></HEAD>
<BODY><H1>Error $errorc $errorn</H1>
"$errorn" (code $errorc) has occurred while processing your request.<BR>
Additional info/description: $desc<BR>
<BR>
<HR>
<ADDRESS>$id</ADDRESS>
</BODY>
</HTML>
TheEnd2
	}
}

sub redirect {		# generate a redirect
	my $newpage=shift;
	
 	logmsgp2 "- 301 REDIR";
	print <<TheEnd;
HTTP/1.1 301 Moved Permanently
Location: $newpage
Content-Type: text/html

<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<HTML><HEAD>
<TITLE>301 Moved Permanently</TITLE>
</HEAD><BODY>
<H1>Moved Permanently</H1>
The document has moved <A HREF="$newpage">here</A>.<P>
<HR>
</BODY></HTML>
TheEnd
}

### sub: file/directory handling ##########################################

sub sdir {
	my $public=shift;
	my $trdr=shift;
	my $page=shift;
	my $hs;
	my @files;
	my $file;
 	my $parent;
	my $len;
 	my $tlen;
	my $fpath;
	my @dlist;
	my $ic;

	if (opendir(DIR,$trdr.$public)) { } else {
		serr(404,$page);
		return;
	}
	
	logmsgp2 "- 200 DIR";
	print "HTTP/1.0 200 OK\r\nMIME-version: 1.0\r\nContent-type: text/html\r\n\r\n";
	print "<HTML><HEAD><TITLE>Directory listing</TITLE></HEAD>\n";
	print "<BODY><H1>Directory listing of $page</H1>\n";

	@files = readdir(DIR);
	closedir(DIR);

	if ($page=~/^(.*)\/(.*)\/$/) {	# beautiful, isn't it?
		$parent=$1."/";
	} else {
		$parent="";
	}

	print "<A HREF=\"$parent\">.. (to parent directory)</A><BR><BR>";

	print "<table BORDER CELLSPACING=0 WIDTH=\"100\%\" NOSAVE >";

	$ic=0;
	$tlen=0;
	
	foreach $file (@files) {
		next if ($file eq ".");
		next if ($file eq "..");
		next if (($hidedotfiles==1) && ($file=~/^\.(.*)$/));
		next if (($hidebackups==1) && ($file=~/^(.*)\~$/));

		$len=-s $trdr.$public.$file;
		$len=int($len/1024);
		$hs=$page.$file;

		$fpath=$trdr.$public.$file;
		if (-d $fpath) {
			$dlist[$ic]="<A HREF=\"$hs/\">$file</A></td><td>directory";
		} else {
			$dlist[$ic]="<A HREF=\"$hs\">$file</A></td><td>$len kb";
		}
		$ic=$ic+1;
		$tlen=$tlen+$len;
	}     

	my @slist = sort @dlist;
	my $elem;
	my $switch=0;
	
	foreach $elem (@slist) {
		if ($switch==1) {
			print "<tr BGCOLOR=\"#FFFFDD\"><td>";
			$switch=0;
		} else {
			print "<tr BGCOLOR=\"#DDFFFF\"><td>";
			$switch=1;
		}
		print $elem;
		print "</td></tr>\n";
	}
		
	print "</table><p>\n";  
	print "$ic entries ($tlen kb total)\n";
	print "<BR><HR><ADDRESS>$id</ADDRESS>\n";
	print "</BODY></HTML>\n";  
}

### sub: string converting / validation ###################################

sub conv {
	my $sr=shift;
	$sr =~ s/\%([A-Fa-f\d]{2})/chr hex $1/eg;
	# nice, eh? replace all occurences with % followed by two
	# numbers and/or characters a-f with the corresponding
	# ASCII-character after hex-converting
	return $sr;
}

sub evilhacker {		# check whether a string may be passed to a system-call with fs-access
	my $sr=shift;
	return 1 if (substr($sr,-1) eq "|"); # a trailing "|" commands perl to use the file as pipe
	return 1 if (index($sr,"\0")>-1); # a NULL byte is not POSIX compliant
	# by the way, one of my favorite jokes:
	# Two strings walk into a bar. The first string orders:
	# "Two beers, please!%@o{ðAr3[æ9[ieo§U[3]]vms35WRI)§itoW)O"$RWR)"""R)R==W=}32[..."
	# The second string explains:
	# "Sorry, he is not null-terminated!"
	return 1 if (index($sr,"/../")>-1); # we don't want our script to go one dir up!
}

### sub: request server ###################################################

sub serve_http {
	my $iaddr = shift;
	my $trdr;
	my $trp;
	my $page="";
	my $usag="";
	my $buf;
	my $getstr="";
	my $reqt=0;
	my $contd=0;
	my $posthead="";	# head without URL
	my $postheada="";
	my $postbody="";
	my $referer="";
	my $reqcontlen="";
	my $cookie="";
	my $hostn="";
	my $pageonly="";
	my $pathonly="";
	my $ipath;
	my $ibs="";
	my $sslc=0;

	### fixme!!!	my $epath=$ENV{"PATH"};		# update: preserving path seems not needed
	%ENV = ();					# clean the environment for metavariables
	$ENV{"SERVER_PROTOCOL"}="HTTP/1.1";		# set default

	while ($buf = <STDIN>) {
		alarm($alarmclock);
		last if (!defined $buf);
		last if (length($buf)<3);		# drop \r\n string
		if (length($buf)>$maxreqlen) {	# drop too long strings (fixes 100% load)
			logmsgp1 "$iaddr - overflow with ",length($buf), " bytes";
			serr(414,$buf);
			return;
		}
		if ($hproxy==1) {
			$postheada=$buf;		# create a copy of the header for proxying (old code for POST reused)
			$postheada=lc($postheada);
			if ($postheada =~ /^(post|get|head)(\s*)(.*?)( HTTP\/1|$)/g) {
			} else {
				$posthead.=$postheada;
			}
		}  
		# check for bad requests immediatly
		foreach (@shields) {
			next if (length($_)==0);
			if (index($buf,$_)>-1) {	# illegal request
				logmsg "illegal input matching \"$_\" filtered!!!";
				serr(400,$buf);
				return;
			}
		}
		$buf=substr($buf,0,-2);
		if (($firsttime==1) && ($logfile2 ne "")) {  # log first connect
			logmsg2 "$iaddr - $buf";
		}
		if ($buf =~ /^(GET|Get|get|HEAD|Head|head)(\s*)(.*?)( HTTP\/1|$)/g) {
			$page=$3;
			$reqt=1;
		}
		if ($buf =~ /^(POST|Post|post)(\s*)(.*?)( HTTP\/1|$)/g) {
			$page=$3;
			$reqt=2;
		}
		if ($buf =~ /^(User-Agent: )(.*?)$/g) {
			$usag=$2;
			$ENV{"HTTP_USER_AGENT"}=$usag;
		}
		if ($buf =~ /^(Content-.ype: )(.*?)$/g) {
			$ENV{"CONTENT_TYPE"}=$2;
		}
		if ($buf =~ /^(Host: )(.*?)$/g) {
			$hostn=$2;
		}
		if ($buf =~ /^(Content-.ength: )(\d+)$/i) {
			$reqcontlen=$2;
			$ENV{"CONTENT_LENGTH"}=$reqcontlen;
		}
		if ($buf =~ /^(Cookie: )(.+)$/i) {
			$cookie=$2;
			$ENV{"HTTP_COOKIE"}=$cookie;
		}
		if ($buf =~ /^(Referer: http.*:\/\/)(.*?)\/(.*?)\/(.*?)$/g) {	# it's a miracle, but it works, so we don't touch it!!!
			$referer=$3;						# for redirects 	
			#chop($referer);
		}
		if ($buf =~ /^(Referer: )(.*?)$/g) {
				$ENV{"REFERER"}=$2				# for scripts to know about the origin of the link
		}
		if ($buf =~ /^(Range: bytes=)(.*?)-/g) {
			$contd=$2;
		}
		foreach $ibs ("HTTP_X_FORWARDED_FOR","HTTP_CLIENT_IP") {
			if ($buf =~ /^($ibs: )(.*?)$/g) {
				$ENV{$ibs}=$2;
			}
		}
		if ($buf =~ /^($loopbackstr)(.*?)$/g) {				# this is us!
			if (($iaddr ne "127.0.0.1") && ($check_ssl_source==1)) {
				logmsgp3(" $iaddr is spoofing? ");
			} else {
				$iaddr=$2;
				$sslc=1;
				$ENV{"HTTPS"}="on";
			}
		}
		# catch all for HTTP_metavariables
		if ($buf =~ /^(.*)(: )(.*?)$/g) {
			my $hf=uc($1);
			my $hv=$3;
			$hf =~ s/-/_/eg;
			$ENV{"HTTP_".$hf}=$hv
		} 
	}

	if ($reqt==0) {			# immediatly log & return on empty reqs
		logmsgp1 "$iaddr - not GET/POST";
		serr(501,"Only GET and POST, please!");
		return;
	}

	if ($sslc==1) {
		logmsgp3($iaddr,$hostn."/".$page);
	} else {
		loglocal($iaddr,$hostn."/".$page);			# log this request
	}

	if ($hproxy==1) {			# proxy'ing without security checks
		$psite="";
		$ppage="/index.html";
		if ($page =~ /^(http:\/\/)(.*?)$/g) {		# plain site
			$psite=$2;
		}
		if ($page =~ /^(http:\/\/)(.*?)(\/)$/g) {		# trailing /
			$psite=$2;
		}	
		if ($page =~ /^(http:\/\/)(.*?)(\/)(.*?)$/g) {	# site and page
			$psite=$2;
			$ppage="/".$4;
		}
		if ($psite eq "") {
		} else	{			# request found?
			$0="httpd child [proxy req from $iaddr]";
			my $proto = getprotobyname('tcp');
			my $opponent = gethostbyname($psite);
			socket(P, AF_INET, SOCK_STREAM, $proto) || serr(500,"socket");
			bind(P, sockaddr_in(0, INADDR_ANY)) || serr(500,"bind");
			connect(P, sockaddr_in(80, $opponent)) || serr(500,"connect $opponent");
			logmsgp2 "- 200 PROXY";
			select(P); $| = 1; select(STDOUT);
			if ($logfile3 ne "") {
				logmsg3 "Proxy: $page";
				logmsg3 $posthead;
			}

			if ($reqt==2) {
				$0="httpd child [proxying data (POST) from $iaddr]";
				print P "POST $ppage HTTP/1.0\r\n";
				print P $posthead;
				print P "\r\n";
				while(<>) {
					alarm($alarmclock);
					print P $_;
					if ($logfile3 ne "") {
						logmsg3 $_;
					}
				}
			} else {
				print P "GET $ppage HTTP/1.0\r\n";
				print P $posthead;
				print P "\r\n";
			}
			
			$0="httpd child [proxying data for $iaddr]";
			while(<P>) {
				alarm($alarmclock);
				print $_;
				if ($logfile3 ne "") {
					logmsg3 $_;
				}
			}
			close(P);
			return;			# done (at least I hope so...)
		}				# no proxy req? go on...
	}					# no proxy allowed? go on...

	$page="/".$referer.$page unless (substr($page,0,1) eq "/");	# we add a "/" to protect ourselves
	while (substr($page,0,2) eq "//") {	# and we remove double ones...
		$page=substr($page,1);
	}

	if ($page =~ /^(.*?)\?(.*?)$/g) {	# split when "?" in name
		$page = $1;
		$getstr = $2;
	} 
	
	$page=conv($page);			# convert $page from %XX-encoding to plain ASCII

	if (evilhacker($page)) {		# illegal filename
		serr(403,$page);
		return;
	}

	if (($cgiholes==1) && (defined $getstr)) {	# minimal protection for bad cgi-scripts!
		if (evilhacker(conv($getstr))) {
			serr(403,$page);
			return;
		}
	}

	# detect document root (default or user)
	$trdr=$droot;
	$trp=$page;

	if ($allowhosts==1)  {				# allow and use "Host: " to change document path
		if (length($hostn)>2) {			# but is a host given?
			if (evilhacker($hostn)) {		# $hostn should be sane...
				serr(403,"$page on $hostn");
				return;
			}
			if (-e "$droot/$hostn") {		# ... and exist ...
				$trdr=$droot."/".$hostn."/";	# then go for it!
			} else {
				if ($defaulthost==1) {
					$trdr=$droot."/default/";		# no existing host -> default
				} else {
					serr(404,"$page on $hostn");		# otherwise no one is at home
					return;
				}
			}
		} else {
			$trdr=$droot."/default/";		# no host -> default
		}
	}
	if ($userhtml==1) {
		if (substr($page,1,1) eq "~") {
			if (substr($page,1,6) eq "~root/") {
				if ($roothtml==1) {
					$page =~ /^\/\~(.*?)\/(.*?)$/g;
					$trdr="/root/public_html/";
					$trp=$2;
				} else {
					serr(403,$page);
				}
			} else {
				$page =~ /^\/\~(.+?)\/(.*?)$/g;
				$trdr="/home/$1/public_html/";
				$trp=$2;
			}
			if ($secureuserhtml==1) {
				chroot($trdr) && ($trdr="/") || warn "warning: couldn't chroot() to $trdr";
				POSIX::setsid() || warn "warning: can't start a new session: $!";
			}
		}

	}

	if ($trp=~/^(.*)\/(.*)$/) {
		$pageonly=$2;
		$pathonly=$1;
	} else {
		$pageonly=$trp;
		$pathonly="./";
	}
	
	if ($enableauth==1) {				# HTTP AUTH codeblock
		if (-e "$trdr/$pathonly/.htaccess") {
			# here we parse the .htaccess-file
			$realm="pseudo";
			#
			
			print "HTTP/1.1 401 Authorization Required\n";
			print "WWW-Authenticate: Basic realm=$realm\n";
			print "Content-type: text/html\n";
			print "\n";
			print <<EndOfAuth;
<HTML>
<HEAD><TITLE>Authorization Required</TITLE></HEAD>
<BODY><H1>Login failure - Authorization Required</H1>
You are not allowed to access this page.<BR>
<BR>
<HR>
<ADDRESS>$id</ADDRESS>
</BODY>
</HTML>
EndOfAuth
			logmsgp2 "- AUTH";
			return;
		} else {
		}
	}
	
	if ($hidedotfiles==1) {				# .files downloadable?
		if (substr($pageonly,0,1) eq ".") {
			serr(403,"$page on $hostn");
			return;
		}
	}

	# check, if we need to add index.html
	if (substr($trp,-1) eq "/") {		# or if the luser wants a dir listing
		if (($showdir==1) && (!-e $trdr.$trp."index.html") && (!-e $trdr.$trp."index.htm") && (!-e $trdr.$trp."index.txt") && (!-e $trdr.$trp."index.php") && (!-e $trdr.$trp."index.pl") && (!-e $trdr.$trp."index.cgi")) {
			if (-d $trdr.$trp) {
				sdir($trp,$trdr,$page);	# list a directory...
				return;
			} else {
				serr(501,"$page on $hostn");
				return;			# and quit this connection!
			}
		}				# otherwise...
		if (-e $trdr.$trp."index.php") {	# ugly and probably stupid order! fix me!!!
			$trp = $trp . "index.php";	# add "index.php" and go on...
		} elsif (-e $trdr.$trp."index.pl") {
			$trp = $trp . "index.pl";	# add "index.pl" and go on...
		} elsif (-e $trdr.$trp."index.txt") {
			$trp = $trp . "index.txt";	# add "index.txt" and go on...
		} elsif (-e $trdr.$trp."index.cgi") {
			$trp = $trp . "index.cgi";	# add "index.cgi" and go on...
		} elsif (-e $trdr.$trp."index.htm") {
			$trp = $trp . "index.htm";	# add "index.htm" and go on...
		} else {
			$trp = $trp . "index.html";	# add "index.html" and go on...
		}
	} else {
		if (-d $trdr.$trp) {		# directory without trailing "/" ?
			redirect("$page/");	# issue "permanently moved" with trailing "/" !
			return;
		}
	}
	
	# some variables need to be initialized
	# CGIs depend on QUERY_STRING when using GET-requests
	# php is picky about SCRIPT_FILENAME
	# ... and CGI.pm seems to need some extra variables to know about the location of the script
	$ENV{"SCRIPT_NAME"}=$page;
	$ENV{"SCRIPT_FILENAME"}=$trdr.$trp;

	$ENV{"REMOTE_ADDR"}=$iaddr;
	$ENV{"REQUEST_URI"}=$page;
	$ENV{"QUERY_STRING"}=$getstr;

	if ((length($hostn)>2) && (!evilhacker($hostn))) {
		$ENV{"SERVER_NAME"}=$hostn
	} else {
		$ENV{"SERVER_NAME"}="localhost";
	}
	$ENV{"HTTP_HOST"}=$ENV{"SERVER_NAME"};

	$ENV{"CONTENT_TYPE"}="application/x-www-form-urlencoded" unless (defined $ENV{"CONTENT_TYPE"});
	
	# some additional metavariables according to CGI/1.1
	$ENV{"GATEWAY_INTERFACE"}="CGI/1.1";
	$ENV{"SERVER_PORT"}=$sport;
	
	# the following two contain the path *following* the CGI program... which is not supported here!
	# use a real webserver if you want this!
#	$ENV{"PATH_TRANSLATED"}=undef;
#	$ENV{"PATH_INFO"}=undef;
	# since they are undef, we leave these lines out to avoid perl -w complaining about it!
	
	if (!(-e $trdr.$trp)) {
		serr(404,"$page on $hostn");
		return;
	}

	if ((iscgi($trp) || isphp($trp)) || ($reqt==2)) {		# found a cgi-file? (POST or GET to php/cgi-file)
		
		$0="httpd child [executing CGI $trp for $iaddr]";
		alarm($alarmclock);
		
		if ($reqt==2) {				# POST-requests
			if ($postreq==0) {
				serr(403,"CGI not enabled");
			} elsif ($postreq==1) {
				serr(403,"file $page not CGI") && return unless (iscgi($trp) || isphp($trp));
			}
			$ENV{"REQUEST_METHOD"}="POST";
		} else {
			$ENV{"REQUEST_METHOD"}="GET";
		}
				
		my $fexec="";

		serr(403,"file $page not executable") && return unless ((-x $trdr.$trp) || isphp($trp));

		chdir($trdr);				# execute to droot
		if ($cdtoexec==1) {
			$trp=~/^(.*)\/(.*)$/;
			chdir($trdr.$1);		# chdir to destination
			if (isphp($trp)) {
				$fexec=$phppath." -n ".$trdr.$trp;			# execute in local dir
			} else {
				$fexec="./".$2;
			}
		} else {
			if (isphp($trp)) {
				$fexec=$phppath." -n ".$trdr.$trp;
			} else {
				$fexec="./".$trp;		# run from droot as home
			}
		}
		# hope th $fexec is correct and do a pipe|
		if ($ph=open_bidi($fexec)) {
		} else {
			serr(500,"execution error for $page");
		}
		if (($reqt==2) && ($reqcontlen>0)) {		# POST request, so feed some data to our pipe
			read(STDIN,$postbody,$reqcontlen || 500);
			print $ph $postbody;
		}
		
		if (index($fexec,"nph-")==-1) {				# fix me!
			my $pheader="";
			while ($got=<$ph>) {	# read all post headers!
				last if (length($got)<3);
				$pheader.=$got;
			}
			if ($pheader=~/(Status: )(.*?)\n/) {		# look for FastCGI Status:... line
				print "HTTP/1.1 $2\r\n";
				logmsgp2 "- $2 CGI";
			} elsif ($pheader=~/(Location: )(.*?)\n/) {	# look for secretly hidden Location:... line
				print "HTTP/1.1 301 REDIR\r\n";
				logmsgp2 "- 301 REDIR CGI";
			} else {
				print "HTTP/1.0 200\r\n";
				logmsgp2 "- 200 CGI";
			}
			print $pheader."\r\n";
		} else {
			logmsgp2 "- 200 nph CGI";
		}
		while(<$ph>) {
			alarm($alarmclock);
			print $_;
		}
		# close the sockets?
		close($ph);
		return;
	} 

	# only static file requests below...

	$ENV{"CONTENT_TYPE"}="";		# fix me...
	
	my $nlen;
	my $len;

	if (open(SRC,$trdr.$trp)) {
		$len=-s $trdr.$trp;
		if ($contd>0) {			# continued download
			seek(SRC,$contd,0); 
			$nlen=$len-$contd;
			print "HTTP/1.1 206 Partial Content\r\n";
			print "Content-Range: $contd-$len/$len\r\n";
			print "Content-Length: $nlen\r\n";
		} else {
			print "HTTP/1.0 200 OK\r\n";
			print "Content-Length: $len\r\n";
			print "Content-Type: ";
			if ($useextfile==1) {	# get MIME-type (external via UNIX cmd "file")
				if (open(CMD,"file -bi $trdr$trp |")) {
					print <CMD>;
					close(CMD);
				} else {
					print "text/plain\r\n";
				}
			} else {		# internal guess according to extension, should use /etc/mime.types instead, fix me!!!
				CASE:		# arbitrary collection of some useful mimemagic
				{
				  lc($trp)=~/\.html$/ && do { print "text/html\r\n"; last CASE; };
				  lc($trp)=~/\.htm$/ && do { print "text/html\r\n"; last CASE; };
				  lc($trp)=~/\.shtml$/ && do { print "text/html\r\n"; last CASE; };
				  lc($trp)=~/\.js$/ && do { print "application/x-javascript\r\n"; last CASE; };
				  lc($trp)=~/\.jar$/ && do { print "application/x-java-archive\r\n"; last CASE; };
				  lc($trp)=~/\.class$/ && do { print "application/x-java-vm\r\n"; last CASE; };
				  lc($trp)=~/\.css$/ && do { print "text/css\r\n"; last CASE; };
				  lc($trp)=~/\.gif$/ && do { print "image/gif\r\n"; last CASE; };
				  lc($trp)=~/\.jpg$/ && do { print "image/jpeg\r\n"; last CASE; };
				  lc($trp)=~/\.png$/ && do { print "image/png\r\n"; last CASE; };              
				  lc($trp)=~/\.jpeg$/ && do { print "image/jpeg\r\n"; last CASE; }; 
				  lc($trp)=~/\.mpeg$/ && do { print "video/mpeg\r\n"; last CASE; };
				  lc($trp)=~/\.mpg$/ && do { print "video/mpeg\r\n"; last CASE; };
				  lc($trp)=~/\.mp3$/ && do { print "audio/mpeg\r\n"; last CASE; };
				  lc($trp)=~/\.avi$/ && do { print "video/avi\r\n"; last CASE; };
				  lc($trp)=~/\.mov$/ && do { print "video/avi\r\n"; last CASE; };		  
				  lc($trp)=~/\.wav$/ && do { print "audio/wav\r\n"; last CASE; }; 
				  lc($trp)=~/\.swf$/ && do { print "application/x-shockwave-flash\r\n"; last CASE; }; 
				  lc($trp)=~/\.pdf$/ && do { print "application/pdf\r\n"; last CASE; }; 
				  lc($trp)=~/\.ps$/ && do { print "application/postscript\r\n"; last CASE; };
				  lc($trp)=~/\.rtf$/ && do { print "text/rtf\r\n"; last CASE; };
				  lc($trp)=~/\.doc$/ && do { print "application/msword\r\n"; last CASE; };
				  lc($trp)=~/\.ppt$/ && do { print "application/vnd.msw-powerpoint\r\n"; last CASE; };
				  lc($trp)=~/\.xls$/ && do { print "application/vnd.ms-excel\r\n"; last CASE; };
				  print "text/plain\r\n";
				}
			}
		}
		print "\r\n";
		$0="httpd child [transmitting file for $iaddr]";
		logmsgp2 "- 200 GET";
		while(<SRC>) {
			alarm($alarmclock);
			print STDOUT $_;
		}
		close(SRC);
	} else {
		serr(404,"$page on $hostn");
	}

}

### sub: threading functions ##############################################

sub spawn {
	my $coderef = shift;
		unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
			confess "usage: spawn CODEREF";
		}
	my $pid;
	if (!defined($pid = fork)) {
		logmsg "cannot fork: $!";
		return;
	} elsif ($pid) {
		return; # I'm the parent
	}
	# else I'm the child -- go spawn
	open(STDIN,  "+<&Client")   || die "can't dup client to stdin";
	open(STDOUT, "+>&Client")   || die "can't dup client to stdout";
	select(STDOUT); $|=1;
	exit &$coderef();
	close(STDIN); close(STDOUT);

}

### main ##################################################################

$firsttime=0;		# just some inits...
$0="$rid [startup]";	# explain, what we're doing

my $proto = getprotobyname('tcp');
my $mpid;

# open logfile
if ($logfile ne "") {
	my $buf;
	$buf=">".$logfile if (($logpolicy==1) || ($logpolicy==2));
	$buf=">>".$logfile if ($logpolicy==3);
	system(("cp",$logfile,$logfile.".old")) if ($logpolicy==2); # quick 'n' dirty!
	open(LOG,$buf) || print "WARNING! No logging possible because of file error!\n";
	select(LOG); $|=1; select(STDOUT);		# no buffering!
}
# open logfile2
if ($logfile2 ne "") {
	my $buf;
	$buf=">".$logfile2 if (($logpolicy==1) || ($logpolicy==2));
	$buf=">>".$logfile2 if ($logpolicy==3);
	system(("cp",$logfile2,$logfile2.".old")) if ($logpolicy==2); # quick 'n' dirty!
	open(LOG2,$buf) || print "WARNING! No first-time logging possible because of file error!\n";
	select(LOG2); $|=1; select(STDOUT);		# no buffering!
}
# open logfile3
if ($logfile3 ne "") {
	my $buf;
	$buf=">".$logfile3 if (($logpolicy==1) || ($logpolicy==2));
	$buf=">>".$logfile3 if ($logpolicy==3);
	system(("cp",$logfile3,$logfile3.".old")) if ($logpolicy==2); # quick 'n' dirty!
	open(LOG3,$buf) || print "WARNING! No proxy logging possible because of file error!\n";
	select(LOG3); $|=1; select(STDOUT);		# no buffering!
}

# if ssl enabled, initialize and load keys/certificates

my $ctx;

if ($sslenable==1) {
	# ssl init stuff
	use Net::SSLeay qw(die_now die_if_ssl_error);
	$ENV{RND_SEED} = '1234567890123456789012345678901234567890';
	Net::SSLeay::randomize();
	Net::SSLeay::load_error_strings();
	Net::SSLeay::ERR_load_crypto_strings();
	Net::SSLeay::SSLeay_add_ssl_algorithms();
	
	# and prepare ssl encryption
	$ctx = Net::SSLeay::CTX_new ()         or die_now("CTX_new ($ctx): $!");
	Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
		and die_if_ssl_error("ssl ctx set options");

	# Following will ask password unless private key is not encrypted
	Net::SSLeay::CTX_use_RSAPrivateKey_file ($ctx, $sslcred.'/server.key',
		&Net::SSLeay::FILETYPE_PEM);
	die_if_ssl_error("private key");
	Net::SSLeay::CTX_use_certificate_file ($ctx, $sslcred.'/server.crt',
		&Net::SSLeay::FILETYPE_PEM);
	die_if_ssl_error("certificate");
	# encryption is now ready to use
}

# make us secure...

if ($secure==1) {
	chroot($droot) && ($droot="/") || warn "warning: couldn't chroot() to $droot";
	POSIX::setsid() || warn "warning: can't start a new session: $!";
}

# fork to background (daemon mode)
if (!defined($mpid=fork)) {                                                  
	warn "warning: couldn't fork to background!\n";                                         
} elsif ($mpid) {
	print "http daemon forked to background\n";                                                       
	exit; # I'm the parent                                 
}  

# ideally, the child is now chroot()ed to the document root and can't access
# anything else...

# fork httpsd if enabled
if (($sslenable==1) && (!defined($mpid=fork))) { 
	warn "warning: couldn't fork httpsd to background, ssl disabled!\n"; 
} elsif ($mpid) {
	print "https daemon forked to background\n";                                                       
	# https code here which is basically a proxy to httpd but with Net::SSLeay sockets
	
	# open listening TCP networking socket
	socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "ABORT: socket: $!";
	setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,pack("l", 1))   || die "ABORT: setsockopt: $!";
	if ($sslbind ne "") {
		bind(Server, sockaddr_in($sslport, inet_aton($nebind)))        || die "ABORT: bind: $!";
	} else {
		bind(Server, sockaddr_in($sslport, INADDR_ANY))        || die "ABORT: bind: $!";
	}
	listen(Server,SOMAXCONN)                            || die "ABORT: listen: $!";

	logmsg "$rid @ $sslport (ssl)";
	$0="httpsd tunnel [accepting connections]";

	$SIG{"CHLD"}=sub { while(waitpid(-1,1) > 0) { ; } $childcnt=$childcnt-1; }; # reap and count
	$SIG{"ALRM"}=sub { $cons=$vcons; alarm($age_timeout); }; # make known IPs new
	alarm($age_timeout) if ($age_ip==1);

	$childcnt=0;

	my $cip="";

	my $ssl=undef;
	
	while(1) {
		my $paddr = accept(Client,Server);
		next if not $paddr;			# shouldn't happen
		
		my($port,$iaddr) = sockaddr_in($paddr);
		my $name = gethostbyaddr($iaddr,AF_INET);
		$cip=inet_ntoa($iaddr);
		
		# We now have a network connection, lets fire up SSLeay...

		$ssl = Net::SSLeay::new($ctx)      or die_now("SSL_new ($ssl): $!");
		Net::SSLeay::set_fd($ssl, fileno(Client));
		my $err = Net::SSLeay::accept($ssl) and die_if_ssl_error('ssl accept');
		
		if (index($cons,$cip)==-1) {		# new connect
			#logmsg "first connect of host $cip in this session";
			$firsttime=1;
			if ($multitask==1) {
				if (!defined($mpid=fork)) {
					print "note: cannot fork to background, on-new-ip not multithreaded!\n";
					system(@onnewip);
				} else {
					if ($mpid) {
						# I'm the parent
					} else {
						$0="httpsd [registering new connect]";
						onnewip; # I'm the child!
						exit;
					}
				}
			} else {
				system(@onnewip);
			}
			$cons=$cons." ".$cip;
		} else {
			$firsttime=0;
		}   
		if (index($ipignore,$cip)>-1) {	# if this IP is to ignore
			logmsg "blocking req from $cip:$port ($name) - on ignore-list";
			next;
		}
		if (length($ipallow)>0) {		# only certain IPs allowed
			if (index($ipallow,$cip)==-1) {	# this is not allowed
			logmsg "blocking req from $cip:$port ($name) - not on allowed-list";
				next;
			}
		}

		if ($childcnt>$children) {
			logmsg "server load to high - refused connect";
			next;
		}

		$childcnt=$childcnt+1;  
	
		spawn sub {
			$0="httpsd child reading [serving $cip]";
			logmsgp1 "ssl [$cip] -";
			
			$SIG{"ALRM"}=sub { logmsg "$cip - timeout after $alarmclock secs"; exit(0) };
			alarm($alarmclock);
			
			if ($securedaemon==1) {
				# permanently drops privs
				($<,$>) = ((scalar getpwnam($daemonuser)),(scalar getpwnam($daemonuser)));
				# ($(,$)) = (getuinam($daemongroup),getuinam($daemongroup));	# change group???
			}
			# connection is now up and running
			# since server_http uses standard socket operations, ssl is not possible
			# therefore we create a local connection to the ordinary http daemon
			# and proxy the request
			# this is ugly (but not as ugly as my first solution to this problem, trust me!)
			# and insecure (local superusers may read the data stream... but, hey, if you
			# can't trust them, you'll trust nobody!)
			my $idata=Net::SSLeay::read($ssl);

			$0="httpsd child preparing tunnel [serving $cip]";
			my $proto = getprotobyname('tcp');
			my $opponent = gethostbyname("127.0.0.1");
			socket(P, AF_INET, SOCK_STREAM, $proto) || serr(500,"socket");
			bind(P, sockaddr_in(0, INADDR_ANY)) || serr(500,"bind");
			connect(P, sockaddr_in($sport, $opponent)) || serr(500,"connect $opponent");
			select(P); $| = 1; select(STDOUT);
			print P "$loopbackstr$cip\r\n";
			print P $idata;
			my $odata="";
			$0="httpsd child talking to myself [serving $cip]";
			while(<P>) {
				alarm($alarmclock);
				$odata.=$_;
			}
			close(P);
			$0="httpsd child tunneling answer [serving $cip]";
			Net::SSLeay::write($ssl, $odata);
			$0="httpsd child preparing to die[serving $cip]";
			Net::SSLeay::free ($ssl);           # Tear down connection
			close(Client);
		};
		close(Client);			# child has it's own
		
		# collect our dead children...
		while(waitpid(-1,1) > 0) { ; } # don't loathe SysV, love BSD! 8-)
	}
	exit(0); # we will never reach this but you can never be to sure about eternity...
}  

# here comes the ordinary http daemon socket code

# open listening TCP networking socket
socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "ABORT: socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,pack("l", 1))   || die "ABORT: setsockopt: $!";
if ($nebind ne "") {
	bind(Server, sockaddr_in($sport, inet_aton($nebind)))        || die "ABORT: bind: $!";
} else {
	bind(Server, sockaddr_in($sport, INADDR_ANY))        || die "ABORT: bind: $!";
}
listen(Server,SOMAXCONN)                            || die "ABORT: listen: $!";

logmsg "$rid @ $sport";
$0="httpd father [accepting connections]";

$SIG{"CHLD"}=sub { while(waitpid(-1,1) > 0) { ; } $childcnt=$childcnt-1; }; # reap and count our dead children
$SIG{"ALRM"}=sub { $cons=$vcons; alarm($age_timeout); }; # make known IPs new
alarm($age_timeout) if ($age_ip==1);

$childcnt=0;	# no children in the beginning!

my $cip="";

while(1) {
	my $paddr = accept(Client,Server);
	next if not $paddr;			# shouldn't happen, but as mentioned about, you'll never know about eternity
	
	my($port,$iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr,AF_INET);
	$cip=inet_ntoa($iaddr);

	if (index($cons,$cip)==-1) {		# new connect
		#logmsg "first connect of host $cip in this session";
		$firsttime=1;
		if ($multitask==1) {
			if (!defined($mpid=fork)) {
				print "note: cannot fork to background, on-new-ip not multithreaded!\n";
				system(@onnewip);
			} else {
				if ($mpid) {
					# I'm the parent
				} else {
					$0="httpd [registering new connect]";
					onnewip; # I'm the child!
					exit;
				}
			}
		} else {
			system(@onnewip);
		}
		$cons=$cons." ".$cip;
	} else {
		$firsttime=0;
	}   
	if (index($ipignore,$cip)>-1) {	# if this IP is to ignore
		logmsg "blocking req from $cip:$port ($name) - on ignore-list";
		next;
	}
	if (length($ipallow)>0) {		# only certain IPs allowed
		if (index($ipallow,$cip)==-1) {	# this is not allowed
		logmsg "blocking req from $cip:$port ($name) - not on allowed-list";
			next;
		}
	}

	if ($childcnt>$children) {
		logmsg "server load to high - refused connect";
		next;
	}

	$childcnt=$childcnt+1;  
	
	spawn sub {
		$0="httpd child [serving $cip]";
		$SIG{"ALRM"}=sub { logmsgp2 "timeout!"; exit(0) };
		alarm($alarmclock);

		if ($securedaemon==1) {
			# permanently drops privs
			($<,$>) = ((scalar getpwnam($daemonuser)),(scalar getpwnam($daemonuser)));
			# ($(,$)) = (getuinam($daemongroup),getuinam($daemongroup));	# change group???
		}
		serve_http($cip);
		close(Client);
	};
	close(Client);			# child has it's own, otherwise open sockets acumulate and disturb MS Internet Explorer
	
	# collect our dead children, this code should be uneccessary, since we changed the signalprocessing above, but you never know...
	while(waitpid(-1,1) > 0) { ; } # don't loathe SysV, love BSD! 8-)
}

### The End. Phew!