#!/usr/bin/perl ##################################################### # # # PerlServ v1.0 # # Written By: Samuel Sparling (samuel@wilter.com) # # # # A simple web server designed to serve up text and # # HTML documents. Nothing more than the simple GET # # method is used. # # # # Initial Release: 02-02-1999 # # # # Released as open source. Feel free to make any # # modifications you like. Just give me credit where # # it's due. # # # # Tested On: # # Windows 95 w/ ActiveState Perl 5.005_02 Build 509 # # SunOS 5.6 w/ perl 5.004_04 # # RedHat Linux 5.1 w/ perl 5.004_04 # # # ##################################################### use Socket;# use the socket module # The root directory of this web server. $root_dir = "/htdocs"; # The default file when no file is specified. $default = "index.html"; # The logfile this server will use. $logfile = "/htdocs/log.txt"; # The port to run on. $port = 80; ##################################################### # NO NEED TO EDIT BELOW THIS LINE. # ##################################################### $proto = getprotobyname('tcp'); 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: $!"); $time=scalar(localtime); &log("startup - PerlServ started on port $port - [$time]"); for(; $paddr = accept(CLIENT,Server); close CLIENT) { ($port,$iaddr) = sockaddr_in($paddr); $name = gethostbyaddr($iaddr,AF_INET); $get_request=; # chop CR, LF, and CTRL+M off of the get request (for pretty log files) chop($get_request) if $get_request =~ /\r$/; chop($get_request) if $get_request =~ /\n$/; chop($get_request) if $get_request =~ /\cM/; ($get,$file,$crap) = split(/\s+/, $get_request); $file .= "$default" if $file =~ m@/$@; if($file =~ /\.\./) { $time=scalar(localtime); &log("$name - [$time] - \"$get_request\""); &error("Bad Request"); } $time=scalar(localtime); &log("$name - [$time] - \"$get_request\""); open(FILE,"$root_dir$file") || &four_oh_four_error($file); while() { print CLIENT $_; } close(FILE); print CLIENT "\r\n";#Fixes a bug w/ files of only one line. } sub four_oh_four_error { $file=shift(@_); print CLIENT "\n"; print CLIENT "\n"; print CLIENT "404 Not Found\n"; print CLIENT "\n"; print CLIENT "

Not Found

\n"; print CLIENT "The requested URL $file was not found on this server.

\n"; print CLIENT "\n"; close(CLIENT); } sub error { $error=shift(@_); print CLIENT "\n"; print CLIENT "\n"; print CLIENT "Error - $error\n"; print CLIENT "\n"; print CLIENT "

$error

\n"; print CLIENT "There was an error in your request.

\n"; print CLIENT "\n"; close(CLIENT); } sub log { $msg=shift(@_); open(LOG,">>$logfile") || die($!); print LOG "$msg\n"; close(LOG); print "$msg\n"; }