#
# mhws - Manfred Haertel's Web Server
#
# manfred haertel    30.11.1997
#
#
# revisions
# =========
# vers  date         modification
# --------------------------------------------------------------
#

#
# includes. note the upper case S
#

use Socket ;

#
# get parameter (web server directory) from the command line
# note that $#ARGV gives the index of the last paramter, so
# if we have one parameter, it gives zero and if we have no
# parameter (which would be an error), it gives -1
#

print "MHWS: Getting paramters...\n" ;
if ( $#ARGV == -1 )
{
	print "MHWS: No webserver root directory found as parameter...\n" ;
	exit ;
}
else
{
	$root_dir = $ARGV[0] ;
	print "MHWS: Webserver root directory is $root_dir...\n" ;
}

#
# do all the socket initialization
#

print "MHWS: Opening Socket...\n" ;
$protocol = getprotobyname ( 'tcp' ) ;
socket ( listen_handle , PF_INET , SOCK_STREAM , $protocol ) ;

print "MHWS: Binding port...\n" ;
$port = 80 ;
$socket_in = sockaddr_in ( $port , INADDR_ANY ) ;
bind ( listen_handle , $socket_in ) ;

print "MHWS: Listening to port...\n" ;
$queue_length = 1 ;
listen ( listen_handle , $queue_length ) ;

#
# loop forever, handling requests
#

while ( 1 )
{
	#
	# wait for the next connection
	#

	print "MHWS: Accepting connection...\n" ;
	accept ( socket_handle , listen_handle ) ;

	#
	# take the requested file name from the command line
	#

	print "MHWS: Getting command line...\n" ;
	$command_line = <socket_handle> ;
	print $command_line ;
	@parameters = split / / , $command_line ;
	$file_name = $parameters [1] ;
	print "MHWS: Client requests file $file_name...\n" ;

	#
	# get more (header) data and display it
	#

	print "MHWS: Getting more data...\n" ;
	$more_data = 1 ;
	while ( $more_data )
	{
		$in_data = <socket_handle> ;
		print $in_data ;
		if ( $in_data =~ /^\r/ )
		{
			$more_data = 0 ;
		}
	}

	#
	# determine local file name, append our webserver root dir
	# and replace slashes with back slashes
	#

	print "MHWS: Determing file name...\n" ;
	$file_name =~ tr#/#\\# ;
	$file_name = "$root_dir$file_name" ;

	#
	# open requested file
	#

	print "MHWS: Opening file $file_name...\n" ;
	$file_found = open ( file_handle , $file_name ) ;
	if ( ! $file_found )
	{
		#
		# give a message
		#

		print "MHWS: File $file_name not found\n" ;
		print socket_handle "Sorry, file not found on this server.\n" ;
	}
	else
	{
		#
		# switch to binary mode while reading the file
		#

		binmode ( file_handle ) ;

		#
		# we could send a http response header here, but if we would do
		# so then it would be *our* task to determine the file type.
		# at least netscape 4 tries to determine the file type by itself
		# if not told by the server, so we're lazy...
		#

		#
		# this would be a nice header...
		#
		# print "MHWS: Sending header...\n" ;
		# print socket_handle "HTTP/1.0 200 OK\n" ;
		# print socket_handle "Server: MHWS 1.0\n" ;
		# print socket_handle "\n" ;

		#
		# now just send the contents of the file
		#

		print "MHWS: Delivering data...\n" ;
		while ( $out_data = <file_handle> )
		{
			print socket_handle $out_data ;
		}

		#
		# cleanup
		#

		print "MHWS: Closing file $file_name...\n" ;
		close ( handle ) ;

		print "MHWS: Closing socket handle...\n" ;
		close ( socket_handle ) ;
	}
}