DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets has posted 5883 posts at DZone. View Full User Profile

Web Server Written In PERL

08.31.2005
| 1921 views |
  • submit to reddit
        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."<h2>404 - File Not found</h2><b>".$theFile."</b> 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 = <cheeZjournal>;
@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]
}

    

Comments

Snippets Manager replied on Fri, 2007/05/11 - 6:26pm

this is perfect for testing a bit of local code