Saturday, June 28, 2014

A Perl HTTP Web Server

This is a simple server written in Perl. It listens on a port, but does not follow the HTTP protocol. It just echoes whatever the client sent in.

Note for examples in this post the value of "LocalAddr" is "localhost", so the servers here are accessible only on local machine. If you want access from a remote machine, you should change it to "0.0.0.0".


# This demonstrates a simple Perl HTTP server.
# A user can connect using: telnet [host] [port], here port = 9000.
# The user will say something, which the server repeats.
# When the user says "bye", the connection is closed.
#
# Modified from: http://www.perlmonks.org/?node_id=49823
# By: X.C.
# Created on: 6/28/2014
# Last modified: 6/28/2014
#
#!/usr/bin/perl -w
use strict;
use IO::Select;
use IO::Socket;

my ($data, $fh);
my $ipc_select = IO::Select->new();
my $IPC_SOCKET = new IO::Socket::INET(Listen    => 5,
                                    LocalAddr => 'localhost',
                                    LocalPort => 9000,
                                    Proto   => "tcp" );


$ipc_select->add($IPC_SOCKET);
print "Listening on Socket [$IPC_SOCKET] ...\n";
while (1) {
    if (my @ready = $ipc_select->can_read(.01)) {
        foreach $fh (@ready) {
            if($fh == $IPC_SOCKET) {
                #add incoming socket to select
                my $new = $IPC_SOCKET->accept;
                $ipc_select->add($new);
                print "== incoming connection...\n";
            } else {
                # Process socket
                my $n = recv($fh, $data, 1024, 0); # this seems to be empty.
                my $data_len = length($data); # $data ends with "\r\n".
                #print "data len:" . length($data) . "\n";
                if ($n || $data_len > 0) {
                    print $fh "Server feedback: $data"; # feedback to client.
                    $data = substr($data, 0, $data_len - 2);
                    print "incoming data: $data\n";
                    #chomp($data); # this won't work, since $data is a buffer not filled with 0s.
                    if (uc($data) eq "BYE") {
                        print "== close connection\n";
                        $ipc_select->remove($fh);
                        $fh->close;
                    }
                } else { # seems this won't get executed ever.
                    $ipc_select->remove($fh);
                    $fh->close;
                }
            }
        }
    }
}

Or it can be simplified into the code below. Now this uses standard HTTP response and is a HTTP web server, so you can actually visit it from a browser using url http://localhost:9000/.


#!/usr/bin/perl -w
use strict;
use IO::Select;
use IO::Socket;

my ($data, $fh);
my $ipc_select = IO::Select->new();
my $IPC_SOCKET = new IO::Socket::INET(
    Listen  => 5, LocalAddr => 'localhost', LocalPort => 9000, Proto => "tcp" );

$ipc_select->add($IPC_SOCKET);
print "Listening on Socket [$IPC_SOCKET] ...\n";
while (1) {
    if (my @ready = $ipc_select->can_read(.01)) {
        foreach $fh (@ready) {
            if($fh == $IPC_SOCKET) {
                my $new = $IPC_SOCKET->accept;
                $ipc_select->add($new);
                print "== incoming connection from [$fh]...\n";
            } else {
                recv($fh, $data, 1024, 0); 

                my $data_len = length($data);
                if ($data_len > 0 && uc($data) ne "BYE\r\n") { # feedback to client.
                    print $fh "HTTP/1.0 200 OK\nContent-Type:text\nContent-Length:$data_len\n\n$data"; 
                } else { 
                    $ipc_select->remove($fh);
                    $fh->close;
                }
            }
        }
    }
}

So far this is run in a console, and is tied to the controlling console. If you type CTRL-C then it's stopped, or when the console is closed it's gone.  However, by combining this with the Perl daemon we discussed in the previous post, we obtain a full-fledged web server written in Perl! This web server runs as a daemon process. You can visit it in a web browser using http://localhost:9000. So far the only thing this web server does is to prepend the client request with "PERL Web Server Received:" and send it back to the client.

To be exact, the only modifications needed to the Perl daemon in the previous post are:

1) add this to the top of file:

use IO::Select;
use IO::Socket;


2) replace the do_start() function with:

sub do_start {
    print "start daemon now\n";

    Proc::Daemon::Init();

    if (Proc::PID::File->running()) {
        do_log( "A copy of this daemon is already running, exit" );
        exit(0);
    }

    my ($data, $fh, $data_len);
    my $ipc_select = IO::Select->new();
    my $IPC_SOCKET = new IO::Socket::INET(
        Listen  => 5, LocalAddr => 'localhost', LocalPort => 9000, Proto => "tcp" );

    $ipc_select->add($IPC_SOCKET);
    do_log( "Listening on Socket [$IPC_SOCKET] ..." );
    while (1) {
      if (my @ready = $ipc_select->can_read(.01)) {
        foreach $fh (@ready) {
            if($fh == $IPC_SOCKET) {
                my $new = $IPC_SOCKET->accept;
                $ipc_select->add($new);
                do_log( "== incoming connection from [$fh]..." );
            } else {
                recv($fh, $data, 1024, 0);
                my $data_len = length($data);
                if ($data_len > 0) { # feedback to client.
                    print $fh http_response($data);
                }
                $ipc_select->remove($fh);
                $fh->close;
            }
        }
      }
    }
}

sub http_response {
    my ($request) = @_;
    my $hdr = "PERL Web Server Received:\n";
    my $data_len = length($hdr) + length($request);

    return "HTTP/1.0 200 OK\nContent-Type:text\nContent-Length:$data_len\n\n$hdr$request";
}

No comments:

Blog Archive

Followers