#!/usr/bin/perl -Tw

#A tiny Perl web server. Written by Frank Gerlach (frankgerlach@gmail.com)
#Distributed unter the LGPL license. See http://www.gnu.org/copyleft/lesser.html.

    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    use Socket;
    use Carp;
    my $EOL = "\015\012";


    my $mimeTypes;
    $mimeTypes{"txt"}="text/plain";
    $mimeTypes{"txt"}="application/octet-stream";
    $mimeTypes{"ps"}="application/postscript";
    $mimeTypes{"zip"}="application/zip";
    $mimeTypes{"sh"}="application/x-shar";
    $mimeTypes{"tar"}="application/x-tar";
    $mimeTypes{"snd"}="audio/basic";
    $mimeTypes{"au"}="audio/basic";
    $mimeTypes{"wav"}="audio/x-wav";
    $mimeTypes{"gif"}="image/gif";
    $mimeTypes{"jpg"}="image/jpeg";
    $mimeTypes{"jpeg"}="image/jpeg";
    $mimeTypes{"htm"}="text/html";
    $mimeTypes{"xml"}="text/xml";
    $mimeTypes{"html"}="text/html";
    $mimeTypes{"text"}="text/plain";
    $mimeTypes{"c"}="text/plain";
    $mimeTypes{"cc"}="text/plain";
    $mimeTypes{"c++"}="text/plain";
    $mimeTypes{"h"}="text/plain";
    $mimeTypes{"pl"}="text/plain";
    $mimeTypes{"txt"}="text/plain";
    $mimeTypes{"java"}="text/plain";

    my $port = shift || 80;
    my $proto = getprotobyname('tcp');

    ($port) = $port =~ /^(\d+)$/                        or die "invalid port";
    my $Server;


    socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
                                        pack("l", 1))   || die "setsockopt: $!";
    bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
    listen(Server,SOMAXCONN)                            || die "listen: $!";


    my $paddr;

    $SIG{CHLD} = \&REAPER;
 
    sub myPrintf {# handle,string
       syswrite($_[0],$_[1],length($_[1]),0); 
    };

    my $ClientHandle;
    for ( ; $paddr = accept(ClientHandle,Server); close ClientHandle) {
        my $line;
        #process the first line 
        $line=<ClientHandle>;
        my @garray=($line=~/^GET \/(.*) HTTP\/(.*)\r\n$/);
        
        my $filename="./".$garray[0];
        if(-d $filename) {$filename=$filename."/index.html";};
        my @statarray=stat($filename);
        my $allRead=0; 
        while($allRead==0 ){
          $line=<ClientHandle>;
          if(index($line,"\015\012")==0){
             if( -e $filename ){
                myPrintf(ClientHandle,"HTTP/1.0 200 OK\r\n");
                myPrintf(ClientHandle,"Server: MyPerlServer\r\n");
                my $sb1=sprintf("Content-length:%i\r\n",$statarray[7]);
                myPrintf(ClientHandle,$sb1);
                #determine filetype from extension
                my @extarray=($filename=~/.*\.(.*)/);
                my $mimeType=$mimeTypes{$extarray[0]};
                if(!exists $mimeTypes{$extarray[0]} ){$mimeType="content/unknown"; };
                if($mimeType eq "text/plain" || $mimeType eq "text/html"){
                   $mimeType=$mimeType."; charset=ISO-8859-1";
                };
                myPrintf(ClientHandle,"Content-type: ".$mimeType."\r\n");
                myPrintf(ClientHandle,"\r\n");
                #serve the file:
                open(fh2,$filename);
                my $myBuffer;
                my $count;
                my $offset=0;
                while($count=sysread(fh2,$myBuffer,16384,$offset)){
                   syswrite(ClientHandle,$myBuffer,$count,$offset);
                   $offset=$offset+$count;
                }
             }else{
                printf("file not found:%s\n",$filename);
                myPrintf(ClientHandle,"HTTP/1.0 404 not found\r\n");
                myPrintf(ClientHandle,"Server: MyPerlServer\r\n");
                myPrintf(ClientHandle,"Content-type: text/html; charset=ISO-8859-1\r\n");
                myPrintf(ClientHandle,"\r\n");
                myPrintf(ClientHandle,"File not found\r\n");
             }
             $allRead=1;
          }
        };
    }