123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190 |
- #!/usr/bin/env perl
- # server.pl
- #
- # Basic HTTP web server without installing any extra modules
- # Supports directory listing, mimetype handling etc.
- #
- # License: CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)
- # This is the first basic, simple version of the server.
- # A more advanced version with watch and possibly other features is available
- # in server.pl
- # Usage:
- # - Have Perl installed
- # - Run "perl server.pl"
- # - Visit "http://localhost:7777" on a web browser
- # Limitations:
- # - Does not handle POST (only GET for now)
- # Original (public domain):
- # https://renenyffenegger.ch/notes/development/languages/Perl/modules/IO/Socket/echo-server-client
- use warnings;
- use strict;
- use IO::Socket::INET;
- use Net::hostent; # for OO version of gethostbyaddr
- # To handle CLI parameters
- use Getopt::Long;
- use File::Basename;
- use Cwd qw( abs_path cwd );
- my $script_dir = abs_path(dirname($0));
- # Set $PWD/public as webroot
- my $webroot_dir = $script_dir . '/public';
- # Fallback to current directory in case $script_dir/public is not found
- unless ( -d $webroot_dir ) {
- $webroot_dir = cwd();
- }
- my $port_listen = 7777;
- $| = 1; # Autoflush
- # Shows up when --help or -h is passed
- sub help_text {
- print("usage: server.pl [-h] [-p PORT] [-d WEBROOT]
- A simple HTTP web server in Perl.
- optional arguments:
- -h, --help show this help message and exit
- -p PORT, --port PORT
- port to listen for requests [default:7777]
- -d WEBROOT, --directory WEBROOT
- directory of the files to serve [default:public or \$PWD]
- examples:
- start server in 7777 port and serve files in public or \$PWD:
- \$ ./server.pl
- start server in 3344 port and serve files in www/static directory
- \$ ./server.pl -p 3344 -d www/static\n");
- exit;
- }
- # Process CLI parameters and update config values as necessary
- GetOptions ("p|port=i" => \$port_listen,
- "d|directory=s" => \$webroot_dir,
- "h|help" => \&help_text)
- or die("Error in command line arguments. Please review and try again. Run with -h for help.\n");
- my $socket = IO::Socket::INET->new(
- LocalHost => '0.0.0.0',
- LocalPort => $port_listen,
- Proto => 'tcp',
- Listen => 5,
- Reuse => 1
- ) or die "Cannot create socket. The port $port_listen is probably already being used? Please pass -p PORT to set a different port or stop already running instances of this script.";
- print "> Server started\n";
- print "> Waiting for requests on http://localhost:${port_listen}\n";
- my $request_path;
- my $content='';
- my $host;
- while ( my $client = $socket->accept() ) {
- # Host related
- my $hostinfo = gethostbyaddr($client->peeraddr);
- $host = $client->peerhost();
- my $request;
- my $request_url = '';
- my $request_params = '';
- my $request_url_full;
- my $request_method;
- # Response related
- my $response_mimetype = 'text/plain';
- local $/ = Socket::CRLF;
- # Read request up to an empty line
- while ( <$client> ) {
- last unless /\S/;
- if (/(\S+) ([^\?]+)(\?.*)? HTTP\//) {
- $request_method = $1;
- $request_url = $2;
- $request_params = $3; # GET params. e.g. "?test=1"
- }
- }
- $request_url_full = $host . ':' . $port_listen . $request_url;
- $request_path = $webroot_dir . $request_url;
- if ( -d $request_path ) {
- if ( -f "${request_path}/index.html" ) {
- $request_path = "${request_path}/index.html";
- } elsif ( -f "${request_path}/index.htm" ) {
- $request_path = "${request_path}/index.htm";
- } else {
- opendir DIR, $request_path;
- my @dir = sort readdir(DIR);
- close DIR;
- # Indicate that we're outputting HTML for the page
- $response_mimetype = 'text/html';
- # Prepare the content for the file index
- $content = "<h1>${request_url_full}</h1>";
- $content .= "<ul>";
- foreach (@dir) {
- if ( -d $request_path . $_ ) {
- $content .= "<li><strong><a href=\"http://${request_url_full}/$_\">$_</a></strong></li>";
- } else {
- $content .= "<li><a href=\"http://${request_url_full}/$_\">$_</a></li>";
- }
- }
- $content .= "</ul>";
- }
- print "> Directory requested. Will serve index HTML instead if found or a directory file list.\n";
- }
- # File is there, so show its content.
- if ( -f $request_path ) {
- open my $CRF, '<', $request_path or die "Can't open cache file $!";
- $content = do { local $/; <$CRF> };
- close($CRF);
- # File does not exist and no directory index content is there to serve.
- # So show error.
- } elsif ( $content eq '' ) {
- print "> ${request_url_full} does not exist, so serving an error instead\n";
- $content = "ERROR: ${request_url_full} could not be found";
- }
- # Set mimetype
- if ( $request_path =~ /\.htm$/ or $request_path =~ /\.html$/ ) {
- $response_mimetype = 'text/html';
- } elsif ( $request_path =~ /\.js$/ ) {
- $response_mimetype = 'text/javascript';
- } elsif ( $request_path =~ /\.css$/ ) {
- $response_mimetype = 'text/css';
- } elsif ( $request_path =~ /\.png$/ ) {
- $response_mimetype = 'image/png';
- } elsif ( $request_path =~ /\.jpg$/ or $request_path =~ /\.jpeg$/ ) {
- $response_mimetype = 'image/jpeg';
- } elsif ( $request_path =~ /\.ico$/ ) {
- $response_mimetype = 'image/x-icon';
- } elsif ( $request_path =~ /\.gif$/ ) {
- $response_mimetype = 'image/gif';
- } elsif ( $request_path =~ /\.svg$/ ) {
- $response_mimetype = 'image/svg+xml';
- } elsif ( $request_path =~ /\.webp$/ ) {
- $response_mimetype = 'image/webp';
- } else {
- print "> Mimetype is not programmed in server for $request_url! Serving as ${response_mimetype}\n";
- }
- # Send header and content
- print $client "HTTP/1.0 200 OK", Socket::CRLF;
- print $client "Content-type: $response_mimetype", Socket::CRLF;
- print $client Socket::CRLF;
- $client->send( $content );
- # Close client and print a message on console
- close $client;
- print "> Request for ${request_url_full} has been answered\n";
- }
|