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;
}
}
}
}
}
#!/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:
Post a Comment