Zola has asked for the wisdom of the Perl Monks concerning the following question:
I would be very, very grateful if anybody could help me.#!/usr/bin/perl use strict; use warnings; use diagnostics; use IO::Socket; $SIG{CHLD} = \&WAIT; # Declare Globals my $crlf = "\015\012"; my $childpid; my $socket; my $method; my $client; my $oldfh; my $httpv; my $file; my $uri; # Create Socket $socket = IO::Socket::INET->new(Type => SOCK_STREAM, LocalPort => 8080, Listen => 10, Reuse => 1); die "Failed to start httpd: $!\n" unless $socket; while ($client = $socket->accept) { # Fork a child for each client request $childpid = fork; die "Failed to fork: $!\n" unless defined($childpid); # If child deal with client if ($childpid == 0) { while (<$client>) { # Split inital http headers ($method, $uri, $httpv) = split if (/\// && m/HTTP\/1\.(0|1)/) +; # exit if we receive a blank line and the headers are false exit if (/^($crlf|\n)$/ && not($method || $uri || $httpv)); # Send client a 501 if the client uses any of these http metho +ds if ($method =~ /POST|HEAD|PUT|DELETE|TRACE|CONNECT/) { print $client 'HTTP/1.0 501 Not Implemented' . $crlf x 2; exit; } # If no file is given assume index.html was requested if ($uri eq '/') { $file = 'index.html'; } else { $file = substr($uri, 1); } # If we receive a blank line then its the end of the request # so go onto sending a reply/file if (/^($crlf|\n)$/) { # If file exists go onto see if its readable if (-e $file) { # If file is readable go onto sending the file if (-r $file) { print $client 'HTTP/1.0 200 OK', $crlf; print $client 'Content-Type: text/html' . $crlf x 2; open(FILE, $file) || die "Failed to open file: $!\n" +; # Make FILE hot $oldfh = select FILE; $|++; select($oldfh); # Print to client while (<FILE>) { print $client $_; } close(FILE); exit; # Else if file is not readable send 403 } else { print $client 'HTTP/1.0 403 Forbidden' . $crlf x 2; exit; } # Else if file does not exist send 404 } else { print $client 'HTTP/1.0 404 Not Found' . $crlf x 2; exit; } } } } # If parent close client and go back # to the first while loop close($client); next; } sub WAIT { wait; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Forking HTTP Daemon
by Thelonius (Priest) on Mar 19, 2003 at 18:29 UTC | |
by Zola (Initiate) on Mar 19, 2003 at 20:48 UTC | |
by Anonymous Monk on Apr 30, 2004 at 19:06 UTC | |
|
Re: Forking HTTP Daemon
by jasonk (Parson) on Mar 19, 2003 at 17:09 UTC | |
by Zola (Initiate) on Mar 19, 2003 at 18:26 UTC |