Over a million developers have joined DZone.

Web Server Written In PERL

·
Lame webserver I wrote in PERL as a test.. It was never completed, but I want to save this for future reference.  


#!/usr/bin/perl -w
# Jeff Torgerson
# chee-Z WebServer
# TODO:
# [] parse parameters
# [] pass arguments to web pages, and regex replace the values
# [] config for base directory, port, etc

use strict;
use IO::Socket;
use Time::Local;

#####################
# declarations
#####################
my ($client,$cheezServer,$count,$jCount,$linenumber,$line,$logfile,$fileToServe,$ourMsg,$time,$timestamp,$fnf,$year);
my (@date,@info,@lines,@ln);

#####################
## Settings
#####################
$logfile = "chee-z_webserver.log";

#####################
# main
#####################
$cheezServer = IO::Socket::INET->new
(
LocalPort => 80,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 5 # number of clients to allow
) or die "Could not open your dumb server.. es ist kaput!";

# Now, wait for a connection
while ($client = $cheezServer->accept()) {
# $client->autoflush(1);

my $request = <$client>; # Get the first line
# right below here i get strange error on command line hits
# Use of uninitialized value in pattern match (m//) at E:\scripts\webserver.pl line 40.
if ($request =~ m|^GET /(.+)HTTP/1.[01]|) { # this must match a valid http request
my $theActualFile = stripParams($1); # I need to get rid of the params passed
# writeLogFile("debug","$theActualFile");# This allows me to throw a debug msg into the log file
if (-e $theActualFile) { # does the file exist
print $client "HTTP/1.0 200 OK\nContent-Type: text/html\n\n"; # Start serving my request

open($fileToServe,"<$theActualFile") or die "Can't open file: $theActualFile";
while(<$fileToServe>) { print $client $_ };
# now write the log file
writeLogFile("200","$1");
} else {
# we have a file not found if we get here, 404 error
$fnf = notFound("$theActualFile");
print $client $fnf; # writes the not found page
}
} else {
# we did not get a valid request
print $client "HTTP/1.0 400 BAD REQUEST\n";
print $client "Content-Type: text/plain\n\n";
print $client "BAD REQUEST\n";
}
close $client;
}

# now, close the server
close($cheezServer);

############################################################
## Subroutines
############################################################


##############################
## 404 errors here
sub notFound{
my $theFile = $_[0];
$ourMsg = "HTTP/1.0 404 FILE NOT FOUND\n";
$ourMsg = $ourMsg."Content-Type: text/html\n\n";
$ourMsg = $ourMsg."

404 - File Not found

".$theFile." not found\n"; writeLogFile("404","$theFile"); return $ourMsg; } ############################## ## Write my log file sub writeLogFile{ my $httpStatusCode = $_[0]; my $entry = $_[1]; # now, open the log file open(cheeZjournal,">>$logfile" ) || die "Could not open journal"; # Open the file @lines = ; @info = stat cheeZjournal; @date = localtime($info[9]); $year = sprintf("%d-%d-%d",$date[4]+1,$date[3],$date[5]+1900); $time = "$date[2]:$date[1]"; # goofy error here when time is 7:03, I get 7:3 $timestamp = "$year|$time||$info[9]||"; $linenumber = $count; print cheeZjournal "$httpStatusCode|$timestamp|$entry\n"; close(cheeZjournal) ; # Close the file print @lines; } ############################## ## Strip all the parameters ## off the file name for use sub stripParams{ my @request; my $fullStuff = $_[0]; # split on the Q to get only the file name @request = split(/\?/,$fullStuff); return $request[0] }
Topics:

{{ parent.title || parent.header.title}}

{{ parent.tldr }}

{{ parent.urlSource.name }}