#!/usr/local/bin/perl5 -w
use IO::Socket;

#
# tiny.pl - The Tiny HTTP server
#

#
# Configuration
#
$port = 8000;                    # the port we listen on
$htmldir = "./html/";            # the base html directory
$cgidir = "./cgi-bin/";          # the base cgi directory
$server = "Tiny Web server 1.0"; # server info

#
# Error messages
#
# Terse error messages go in the response header
%terse_errors = 
    (
     "403", "Forbidden",
     "404", "Not Found",
     "501", "Not Implemented",
     );

# Verbose error messages go in the response message body
%verbose_errors =
    (
     "403", "You are not allowed to access this item",
     "404", "Tiny couldn't find the requested item on the server",
     "501", "Tiny does not support the given request type",
     );

#
# Create a TCP listening socket file descriptor
#
#   LocalPort: list on port $port
#   Type     : use TCP
#   Resuse   : reuse address right away
#   Listen   : buffer at most 10 requests
#
$listenfd = IO::Socket::INET->new(LocalPort => $port,
				Type => SOCK_STREAM,
				Reuse => 1,          
				Listen => 10)
    or die "Couldn't listen on port $port: $@\n";

#
# Loop forever waiting for HTTP requests
#
while(1) {

    # Wait for a connection request from a client
    $connfd = $listenfd->accept(); 

    # Determine the domain name and IP address of this client
    $client_sockaddr = getpeername($connfd);
    ($client_port, $client_iaddr) = unpack_sockaddr_in($client_sockaddr);
    $client_port = $client_port; # so -w won't complain
    $client_name = gethostbyaddr($client_iaddr, AF_INET);
    ($a1, $a2, $a3, $a4) = unpack('C4', $client_iaddr);
    print "Opened connection with $client_name ($a1.$a2.$a3.$a4)\n";

    # Parse the request line (after stripping the newline)
    chomp($line = <$connfd>);
    ($method, $uri, $version) = split(/\s+/, $line);
    print "received $line\n";

    #
    # Parse the URI
    #

    # Either the URI refers to a CGI program...
    if ($uri =~ m:^/cgi-bin/:) {
	$is_static = 0;

	# extract the program name and its arguments
	($filename, $cgiargs) = split(/\?/, $uri); 
	if (!defined($cgiargs)) {
	    $cgiargs = "";
	}

	# replace /cgi-bin with the default cgi directory
	$filename =~ s:^/cgi-bin/:$cgidir:o;
    }

    # ... or the URI refers to a file
    else {
	$is_static = 1;     # static content
	$cgiargs = "";

	# replace the first / with the default html directory
	$filename = $uri;
	$filename =~ s:^/:$htmldir:o;

	# use index.html for the default file
	$filename =~ s:/$:/index.html:;	
    }

    # debug statements like this will help you a lot
    print "parsed URI: is_static=$is_static, filename=$filename, cgiargs=$cgiargs\n";
    

    # 
    # Parse the request headers 
    #
    $content_length = 0;
    $content_type = "text/html";
    while (<$connfd>) {  # read request header into $_

	# Delete CR and NL chars
	s/\n|\r//g;  # delete CRLF and CR chars from $_

	# Determine the length of the message body
	# search for "Content-Length:" at beginning of string $_
	# ignore the case
	if (/^Content-Length: (\S*)/i) {
	    $content_length = $1;
	}

	# determine the type of content (if any) in the message body
	# search for "Content-Type:" at beginning of string $_
	# ignore the case
	if (/^Content-Type: (\S*)/i) {
	    $content_type = $1;
	}

	# If $_ was a blank line, exit the loop
	if (length == 0) {
	    last;
	}
    }


    # 
    # OPTIONS method
    #
    if ($method eq "OPTIONS") {
	$today = gmtime()." GMT";
	$connfd->print("$version 200 OK\n");
	$connfd->print("Date: $today\n");
	$connfd->print("Server: $server\n");
	$connfd->print("Content-length: 0\n");
	$connfd->print("Allow: OPTIONS HEAD GET\n");
	$connfd->print("\n");
    }

    #
    # HEAD method
    #
    elsif ($method eq "HEAD") {

	# we're dissallowing HEAD methods on scripts
	if (!$is_static) {
	    error(403, $filename);
	}
	else {
	    $today = gmtime()." GMT";
	    head_method($filename, $uri, $today, $server);
	}
    }


    #
    # GET method
    #
    elsif ($method eq "GET") {
	if ($is_static) {
	    # serve static content
	}

	else {
	    # serve dynamic content
	}
    }

    #
    # Misc unimplemented methods: POST, PUT, DELETE, TRACE
    #
    else {
	error(501, $method);
    }
    close $connfd;
}


#
# process the HEAD method on static content
#   $_[0] : the file to be processed  
#   $_[1] : the uri
#   $_[2] : today's date
#   $_[3] : server name
#
sub head_method {
    local ($filename) = $_[0];  
    local ($uri) = $_[1];
    local ($today) = $_[2];
    local ($server) = $_[3];

    local $modified;
    local $filesize;
    local $filetype;

    # make sure the requested file exists
    if (!(-e $filename)) {
	error(404, $uri);
    }
    
    # make sure the requested is readable
    elsif (!(-r $filename)) {
	error(403, $uri);
    }
    
    # serve the response header but not the file
    else {
	# determine file modifcation date
	$modified = gmtime((stat($filename))[9])." GMT";

	# determine filesize in bytes 
	$filesize = (stat($filename))[7];

	# determin filetype (default is text)
	if ($filename =~ /\.html$/) {
	    $filetype = "text/html";
	}
	elsif ($filename =~ /\.gif$/) {
	    $filetype = "image/gif";
	}
	elsif ($filename =~ /\.jpg$/) {
	    $filetype = "image/jpeg";
	}
	else {
	    $filetype = "text/plain";
	}

	# print the response header
	$connfd->print("HTTP/1.1 200 OK\n");
	$connfd->print("Date: $today\n");
	$connfd->print("Server: $server\n");
	$connfd->
	    print("Last-modified: $modified\n");
	$connfd->
	    print("Content-length: $filesize\n");
	$connfd->print("Content-type: $filetype\n");
	print("\n"); # CRLF required by HTTP standard
    }
}


#
# error - send an error message back to the client
#   $_[0]: the error number
#   $_[1]: the method or URI that caused the error
#
sub error {
    local($errno) = $_[0];
    local($errmsg) = "$errno $terse_errors{$errno}";
    print $connfd <<EndOfMessage;
HTTP/1.1 $errmsg
Content-type: text/html

<HTML>
<HEAD><TITLE>$errmsg</TITLE></HEAD>
<BODY bgcolor="#ffffff">
<H1>$errmsg</H1>
$verbose_errors{$errno}: <PRE> $_[1] </PRE>
<HR>
The Tiny Web Server
</BODY>
</HTML>
EndOfMessage
}