web server

   use Socket;

   #
   #  Determine the content type based upon the filename
   #
   sub define_content_type {

     my $name = shift
       or die 'usage is define_content_type( $filename )';

     if      ($name =~ /.htm/) { 
      $string = "text/html";
    } elsif ($name =~ /.txt/) { 
       $string = "text/plain";
     } elsif ($name =~ /.pl/) {
       $string = "text/plain";
     } else {
       $string = "application/octet-stream";
     }

     return( $string );

   }


   #
   #  Emit the standard HTTP response message header
   #
   sub emit_response_header {

     my $sock = shift;
     my $ct = shift;

     print $sock "HTTP/1.1 200 OK\n";
     print $sock "Server: Perl shttp\n";
     print $sock "Connection: close\n";
     print $sock "Content-Type: ", $ct;
     print $sock "\n\n";

   }


   #
   #  HTTP 'GET' Method Handler
   #
   sub handle_get_method {

     my $sock = shift;
     my $fname = shift or
       die 'usage is handle_get_method( $sock, $filename )';

     # Remove any '/' characters
     $fname =~ s/\///g;

     # If filename is now empty, convert it to the default
     if ($fname eq "") {
       $fname = "index.html";
     }

     my ($content_type) =  define_content_type( $fname );

     emit_response_header( $sock, $content_type );

     # Test the extistence of the requested file
     if (-e $fname) {

       # Open the file and emit it through the socket
       open( INFILE, $fname );

       @theFile = ;

       print $sock @theFile;
       print $sock "\n";

       close( INFILE );

     } else {

       print "File not found.\n";

       # Unknown file -- notify client
       print $sock "HTTP/1.1 404\n\nFile not found.\n\n";

     }

   }


  #
   #  HTTP Connection Handler
   #
   sub handle_connection {

     my $sock = shift or
       die 'usage is handle_connection( $sock )';
   # Get the request line from the client
     recv( $sock, $line, 1024, 0 );

     # Split the GET request into its parts
     ($Request, $Filename, $Version) = split( ' ', $line, 3 );

     # Check the request ?we handle only GET requests
     if ( $Request eq "GET" ) {

       # Call our GET method handler
       handle_get_method( $sock, $Filename );

     } else {

      print "Unknown Method ", $Filename, "\n";

       # Unknown method ?notify client
       print $sock, "HTTP/1.1 501 Unimplemented Method\n\n";

     }

   }


   #
   #  Initialization function for the simple HTTP server
   #
   sub Simple_Http_Server {

     my $addr = shift;
     my $port = shift or
       die 'usage is Simple_HTTP_Server( $addr, $port )';

     # Create a new TCP Server socket
     socket( SRVSOCK, Socket::AF_INET, 
              Socket::SOCK_STREAM, 0 )
       or die "socket: $!";

     # Make the local address reusable
     setsockopt( SRVSOCK, Socket::SOL_SOCKET,
                  Socket::SO_REUSEADDR, 1 );

     # Conver the dotted IP string to a binary address
     my $baddr = inet_aton( $addr );

     # Create a packed address for the server
     my $paddr = sockaddr_in( $port, $baddr );

     # Bind the local address to the server
     bind( SRVSOCK, $paddr ) or die "bind: $!";

     # Enable incoming connections
     listen( SRVSOCK, Socket::SOMAXCONN ) or 
       die "listen: $!";

     while (1) {

       if ( accept( CLISOCK, SRVSOCK ) ) {

         handle_connection( CLISOCK );
         close( CLISOCK );

       }

     }
   }

Simple_Http_Server( '192.168.0.254', 80 );