I figured out a way to create a quick web server in Perl:
#!/usr/bin/env perl -s -wl
use strict;
use HTTP::Daemon;
use HTTP::Headers;
use HTTP::Response;
sub help {
print "$0 -port=<port-number>";
}
our $port;
our $addr = "localhost";
$port = 9000 unless defined $port;
my $server = HTTP::Daemon->new(
LocalAddr => $addr,
LocalPort => $port,
Listen => 1,
Reuse => 1,
);
die "$0: Could not setup server" unless $server;
print "$0: http://$addr:$port Accepting clients";
while (my $client = $server->accept()) {
print "$0: Client received";
$client->autoflush(1);
my $request = $client->get_request;
print "$0: Client's Request Received";
print "$0: Request: " . $request->method;
if ($request->method eq 'GET') {
my $header = HTTP::Headers->new;
$header->date( time );
$header->server("$0");
$header->content_type('text/html');
my $content = "<!doctype html><html><head><title>Hello World</title></head><body><h1>Hello World!</h1></body></html>";
my $response = HTTP::Response->new(200);
$response->content($content);
$response->header("Content-Type" => "text/html");
$client->send_response($response);
}
print "$0: Closed";
$client->close;
undef($client);
}
But for some reason, every time I access localhost:9000 it displays part of the HTTP Header - date, server, content-length and content-type - and the content. It doesn't render it as an HTML page. Is there something I'm missing?
This is caused by the -l switch:
#!/usr/bin/env perl -s -wl
^
It sets the output record separator to the value of the input record separator (a newline), which results in additional newlines being added to HTTP server output, and a broken HTTP response.
Related
I am trying to create a simple WebSocket server in perl from scratch, when I tried it in Google Chrome it gave me opcode -1, How can I fix it?
websocket.pl
#!/usr/bin/perl -w
use strict;
use IO::Socket::INET;
use Digest::SHA1 "sha1_base64";
$| = 1;
my $magic_string = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
# Create a server
my $socket = IO::Socket::INET->new( LocalHost => 'localhost',
LocalPort => 7777,
Proto => 'tcp',
Listen => 5,
Reuse => 1
) || die "$!";
print "Server is running on port 7777\n";
while (1) {
my $client = $socket->accept();
my $key = "";
# Get the Request
my $data = "";
while (my $line = <$client>) {
$data .= $line;
}
# Get the Sec-WebSocket-Key value
foreach my $line ( split /\n/ => $data ) {
if ( $line =~ /^Sec-WebSocket-Key: (\S+)/ ) {
$key = $1;
}
}
print "Sec-WebSocket-Key: $key\n";
# Create the Sec-WebSocket-Accept header value
my $accept = sha1_base64($key);
$accept .= "="x(4-(length($accept)%4));
print "Sec-WebSocket-Accept: $accept\n";
# Response
print $client "HTTP/1.1 101 Switching Protocols\r\n";
print $client "Upgrade: websocket\r\n";
print $client "Connection: Upgrade\r\n";
print $client "Sec-WebSocket-Accept: $accept\r\n\r\n";
shutdown($client, 1);
}
$socket->close();
I am pretty sure that the key returned to website is correct, so where is the problem? What went wrong?
ws.js
var ws = new WebSocket("ws://localhost:7777/");
ws.onopen = function() {
alert("connected!");
ws.send( 'Hello server' );
};
ws.onclose = function() {
alert( 'Connection is closed... ');
};
Web Browser network traffic
Edit
Stefan Becker: Yea, I know, but in this case I was sure that the request is under 1024 bytes, I've fixed it, thanks.
(Opcode -1) is a generic error. In your case it is a bad Sec-WebSocket-Accept header. You forgot to use $magic_string:
my $accept = sha1_base64($key.$magic_string);
Also while (my $line = <$client>) { will probably run forever. You need to check for an empty line.
I'm following this guide explaining how to do a server using IO::Async but I'm having issues with my client code. I have it where I send first then receive. This makes me press enter on each client before receiving any data. I figured I'd have to listen till I wanted to type something but I'm not really sure how. Below is my current client code.
use IO::Socket::INET;
# auto-flush on socket
$| = 1;
# create a connecting socket
my $socket = new IO::Socket::INET (
PeerHost => 'localhost',
PeerPort => '12345',
Proto => 'tcp',
);
die "cannot connect to the server $!\n" unless $socket;
print "My chat room client. Version One.\n";
while (1) {
my $data = <STDIN>;
$socket->send($data);
my $response = "";
$socket->recv($response, 1024);
print ">$response";
last if (index($data, "logout") == 0);
}
$socket->close();
I actually had this problem myself a few weeks ago when trying to make a client/server chat for fun.
Put it off until now.
The answer to your problem of having to hit enter to receive data, is that you need to use threads. But even if you use threads, if you do $socket->recv(my $data, 1024) you won't be able to write anything on the command line.
This isn't using your code, but here is my solution after banging my head against a wall for the last 24hrs. I wanted to add this as an answer, because though the question is out there on stackoverflow, none of the answers seemed to show how to use IO::Select.
Here is the server.pl script, it does not use threading:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use IO::Select;
$| = 1;
my $serv = IO::Socket::INET->new(
LocalAddr => '0.0.0.0',
LocalPort => '5000',
Reuse => 1,
Listen => 1,
);
$serv or die "$!";
print 'server up...';
my $sel = IO::Select->new($serv); #initializing IO::Select with an IO::Handle / Socket
print "\nAwaiting Connections\n";
#can_read ( [ TIMEOUT ] )
#can_write ( [ TIMEOUT ] )
#add ( HANDLES )
#http://perldoc.perl.org/IO/Select.html
while(1){
if(my #ready = $sel->can_read(0)){ #polls the IO::Select object for IO::Handles / Sockets that can be read from
while(my $sock = shift(#ready)){
if($sock == $serv){
my $client = $sock->accept();
my $paddr = $client->peeraddr();
my $pport = $client->peerport();
print "New connection from $paddr on $pport";
$sel->add($client); #Adds new IO::Handle /Socket to IO::Select, so that it can be polled
#for read/writability with can_read and can_write
}
else{
$sock->recv(my $data, 1024) or die "$!";
if($data){
for my $clients ($sel->can_write(0)){
if($clients == $serv){next}
print $clients $data;
}
}
}
}
}
}
And the client.pl, which uses threads:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use threads;
use IO::Select;
$| = 1;
my $sock = IO::Socket::INET->new("localhost:5000");
$sock or die "$!";
my $sel = IO::Select->new($sock);
print "Connected to Socket ". $sock->peeraddr().":" . $sock->peerport() . "\n";
#This creates a thread that will be used to take info from STDIN and send it out
#through the socket.
threads->create(
sub {
while(1){
my $line = <>;
chomp($line);
for my $out (my #ready = $sel->can_write(0)){
print $out $line;
}
}
}
);
while(1){
if(my #ready = $sel->can_read(0)){
for my $sock(#ready){
$sock->recv(my $data, 1024) or die $!;
print "$data\n" if $data;
}
}
}
There is one other problem that arises though, when the client receives data and prints it to the console, your cursor goes to a new line, leaving behind any characters you had typed.
Hope this helps and answers your question.
For a simple "just send from STDIN, receive to STDOUT" client, you could use any of telnet, nc or socat. These will be simple enough to use for testing.
$ telnet localhost 12345
$ nc localhost 12345
$ socat stdio tcp:localhost:12345
If you actually want to write something in Perl, because you want to use it as an initial base to start a better client from, you probably want to base that on IO::Async. You could then use the netcat-like example here. That will give you a client that looks-and-feels a lot like a simple netcat.
I am guessing you need to set the MSG_DONTWAIT flag on your recv call, and print the response only if it is non-null.
$socket->recv($response, 1024, MSG_DONTWAIT);
print ">$response" if ($response ne "");
For some reasons I can only use IO::Socket to build my small http server (not the other modules dedicated to that).
EDIT1: I edited my question, I want to know what I can put instead of the commented line "#last ..."
Here is my script:
use strict;
use IO::Socket;
my $server = IO::Socket::INET->new(LocalPort => 6800,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 10) or die "$#\n";
my $client ;
while ( $client = $server->accept()) {
my $client_info;
while(<$client>) {
#last if /^\r\n$/;
print "received: '" . $_ . "'\n";
$client_info .= $_;
}
print $client "HTTP/1.0 200 OK\r\n";
print $client "Content-type: text/html\r\n\r\n";
print $client '<H1>Hello World(!), from a perl web server</H1>';
print $client '<br><br>you sent:<br><pre>' . $client_info . '</pre>';
close($client);
}
Now, when I send a POST request, it (the script) doesn't take into account the last line (the POST data):
wget -qO- --post-data='hello=ok' http://127.0.0.1:6800
<H1>Hello World(!), from a perl web server</H1><br><br>you sent:<br><pre>POST / HTTP/1.1
User-Agent: Wget/1.14 (linux-gnu)
Accept: */*
Host: 127.0.0.1:6800
Connection: Keep-Alive
Content-Type: application/x-www-form-urlencoded
Content-Length: 8
</pre>
The script output is:
perl server.pl
received: 'POST / HTTP/1.1
'
received: 'User-Agent: Wget/1.14 (linux-gnu)
'
received: 'Accept: */*
'
received: 'Host: 127.0.0.1:6800
'
received: 'Connection: Keep-Alive
'
received: 'Content-Type: application/x-www-form-urlencoded
'
received: 'Content-Length: 8
'
This is to be expected. A POST request looks like
POST / HTTP/1.1
Header: Value
Data=Value
You terminate processing after the end of the header, but the data is in the body!
If you really want to write your own HTTP server, then you should extract the HTTP method from the header. If it is POST, you can look at the value from the Content-length header, and read that number of bytes:
read $client, my $post_data, $content_length;
WRT the updated question:
If you want to build a production HTTP server, you are going to have a bad time. This stuff is difficult. Please read through perlipc which covers the topic of TCP servers. You can then implement a subset of HTTP on top of this.
Also read through the modules on CPAN that implement servers. Even if you cannot compile modules on your system, you may be able to use pure-Perl modules, or may find parts of code that you can reuse. Large parts of CPAN can be used under a GPL license.
If you want to do this, do it right. Write yourself a subroutine that parses a HTTP request. Here is a sketch that doesn't handle encoded fields etc.:
use strict; use warnings; use autodie;
BEGIN { die "Untested code" }
package Local::HTTP::Request {
sub new {
my ($class, $method, $path, $version, $header_fields, $content) = #_;
...;
}
...; # accessors
sub new_from_fh {
my ($class, $fh) = #_;
local $/ = "\015\102"; # CRLF line endings
chomp(my $first_line = <$fh>);
my ($method, $path, $version) = ...; # parse the $first_line
# this cute little sub parses a single field incl. continuation
# and returns the next line as well.
my $parse_a_field = sub {
chomp(my $line = shift);
my ($name, $value) = split /:\s+/, $line, 2;
while(defined(my $nextline = <$fh>)) {
# handle line continuation
if ($nextline =~ s/^[ \t]//) {
chomp $nextline;
$value .= $nextline;
} else {
return $name, $value, $nextline;
}
}
};
my %fields;
my $line = <$fh>;
until ($line eq $/) {
(my $name, my $value, $line) = $parse_a_field->($line);
$fields{lc $name} = $value;
}
read $fh, my $content, $fields{"content-length"} // 0;
return $class->new( ... );
}
}
Then in your accept loop:
my $request = Local::HTTP::Request->new_from_fh($client);
print $client "HTTP/1.0 200 OK", "\015\012";
print $client "Content-type: text/plain", "\015\012";
print $client "\015\012";
print $client "Request body:\n";
print $client $request->content;
I recently tried to make a game server controller in Perl, I would like to start, stop and view the text that has been outputted by the game server, this is what I have so far:
#!/usr/bin/perl -w
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9050; # pick something not in use
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
while ($client = $server->accept()) {
$client->autoflush(1);
print $client "Welcome to $0; type help for command list.\n";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
print $client "Command? ";
while ( <$client>) {
next unless /\S/; # blank line
if (/quit|exit/i) {
last; }
elsif (/some|thing/i) {
printf $client "%s\n", scalar localtime; }
elsif (/start/i ) {
open RSPS, '|java -jar JARFILE.jar' or die "ERROR STARTING: $!\n";
print $client "I think it started...\n Say status for output\n"; }
elsif (/stop/i ) {
print RSPS "stop";
close(RSPS);
print $client "Should be closed.\n"; }
elsif (/status/i ) {
$output = <RSPS>;
print $client $output; }
else {
print $client "Hmmmm\n";
}
} continue {
print $client "Command? ";
}
close $client;
}
I am having trouble reading from the pipe, any ideas?
Thanks!
You are trying to do both reading and writing on the RSPS filehandle, though you have only opened it for writing (open RSPS, '|java -jar JARFILE.jar' means start the java process and use the RSPS filehandle to write to the standard input of the java process).
To read the output of the process, you will either need to write the process output to a file and open a separate filehandle to that file
open RSPS, '| java -jar JARFILE.jar > jarfile.out';
open PROC_OUTPUT, '<', 'jarfile.out';
or check out a module like IPC::Open3, which was made for applications like this.
use IPC::Open3;
# write to RSPS and read from PROC_OUTPUT and PROC_ERROR
open3(\*RSPS, \*PROC_OUTPUT, \*PROC_ERROR,
'java -jar JARFILE.jar');
here is the request URL http://localhost:9009/?comd&user=kkc&mail=kkc#kkc.com
what are the modification need to do in the server perl script.
server-Perl-script
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9009; # pick something not in use
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
while ($client = $server->accept())
{
$client->autoflush(1);
print $client "Welcome to $0; type help for command list.\n";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
print $client "Command? ";
while ( <$client>) {
next unless /\S/; # blank line
if (/comd/i ) { print $client `dir`; }
} continue {
print $client "Command? ";
}
close $client;
print "client closed";
}
I assume that your script is not for production, but for homework or testing sometime. There are multiple very efficient web server solutions in/with Perl like Apache with CGIs or mod_perl, HTTP::Server::Simple and PSGI/Plack.
You'll also typically use a framework like Dancer, Mojo or Catalyst which does most of the boring standard stuff for you:
use Dancer;
get '/' => sub {
return 'Hi there, you just visited host '.request->host.
' at port '.request->port.' asking for '.request->uri;
};
Back to your question: Your script is a interactive server while HTTP has a strict request and response structure:
Client connects to server
Client sends a request
Server sends a response
You need to remove the interactive part and just wait for the client to start the conversation:
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9009; # pick something not in use
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
while ($client = $server->accept())
{
$hostinfo = gethostbyaddr($client->peeraddr);
# Read request up to a empty line
my $request;
while ( <$client>) {
last unless /\S/;
$request .= $_;
}
# Do something with the request
# Send response
print $client "Status: 200 OK\r\nContent-type: text/plain\r\n\r\n".$request;
close $client;
print "client closed";
}
The server reads the full request from the client and returns a minimized HTTP header plus the original request.