How can I find out the $code and $mess in HTTP::Daemon module? In cpan the usage is as
$c->send_status_line( $code, $mess, $proto )
but I dont know where/how to get $code, $mess from.
Like, send_error($code) is used as send_error(RC_FORBIDDEN) which I found from someone's code online, where did he get RC_FORBIDDEN from?
Have been playing with the following code. Sorry for the formatting and many thanks to #choroba for formatting it for me.
use warnings;
use strict;
use HTTP::Daemon;
use HTTP::Status;
use LWP;
my $daemon = HTTP::Daemon->new or die;
my $d = HTTP::Daemon->new(
LocalAddr => '0.0.0.0',
LocalPort => '5000',
);
printf ("\n\n URL of webserver is %s, show this script with %stest\n",
$d->url, $d->url);
while (my $client_connection = $d->accept)
{
new_connection($client_connection);
}
sub new_connection
{
my $client_connection = shift;
printf "new connection\n";
while (my $request = $client_connection->get_request)
{
if (my $pid = fork)
{
print "Child created : $pid\n";
}
elsif (!defined $pid)
{
die "Cannot fork $!\n";
}
else
{
my $address_of_client = $client_connection->peerhost();
my $port_of_client = $client_connection->peerport();
print "Connection from client $address_of_client on port
$port_of_client\n";
print " request\n";
if ($request->method eq 'GET' and $request->uri->path
eq "/test")
{
$client_connection->send_file_response(RC_OK);
#$client_connection->send_status_line(200);
#print "OK ";
#$client_connection->send_file_response($0);
}
else
{
$client_connection->send_error(RC_NOT_FOUND);
}
}
$client_connection->close;
}
}
The documentation also states
If $code is omitted 200 is assumed. If $mess is omitted, then a message corresponding to $code is inserted. If $proto is missing the content of the $HTTP::Daemon::PROTO variable is used.
So, you don't have to specify the arguments at all. Otherwise, just use any of the possible HTTP status codes for $code, and either don't specify the $mess to get the default message for the code, or use any message you like.
RC_FORBIDEN is exported from HTTP::Status.
Related
Yesterday I have been writing simple program in perl.
It is icq bot, you write a message as the math expression and it calculates the value.
The problem is that incoming message has not-single-byte encoding and when it is writing
to file there are a lot of bad symbols and of course calc can't handle this file.
how can I convert incoming message to ASCII?
Here is the source:
#!/usr/bin/perl
use Net::OSCAR;
use Encode;
use strict;
my ($UIN, $PASSWORD, $oscar, $t, $msg);
$UIN='675349295';
$PASSWORD='passwd';
$oscar = Net::OSCAR->new();
$oscar->set_callback_im_in(\&send_answer);
$t = 0;
while (1)
{
if (!$oscar->is_on && (time() - $t) > 120)
{
$oscar->signon($UIN, $PASSWORD);
$t=time();
}
$oscar->do_one_loop();
}
sub send_answer()
{
my($oscar, $sender, $msg) = #_;
if ($msg eq "quit")
{
$oscar->signoff();
exit();
}
open(my($fh), '>', '/tmp/msg');
print $fh "$msg";
close $fh;
my($ans)=`calc -p -f /tmp/msg`;
$oscar->send_im($sender, $ans);
}
I am trying to have a pool of shared connections that can be accessed by Net::Server instances. Unfortunately IPC::Shareable does not allow me to store the connections as they are code references. This is a stripped down version of the code:
use IPC::Shareable (':lock');
use parent 'Net::Server::Fork';
use MyConnectClass;
sub login {
return MyConnectClass->new();
};
my %connection;
tie %connection, 'IPC::Shareable', 'CONN', {
'create' => 1,
'exclusive' => 0,
'mode' => 0666,
'destroy' => 'yes',
}
or croak 'Can not tie connection variable';
sub add_connection {
my $id = shift(#_);
my $con = shift(#_);
$connection{$id} = $con;
};
sub get_connection {
my $id = # .. find unused connection
return $connection{$id};
}
sub process_request {
my $self = shift(#_);
eval {
my $connection = get_connection();
my $line = <STDIN>;
# .. use $connection to fetch data for user
};
};
for (my $i=0; $i<10; $i++) {
add_connection($i, &login);
};
main->run(
'host' => '*',
'port' => 7000,
'ipv' => '*',
'max_server' => 3,
};
Unfortunately the program dies after the first login: 'Can't store CODE items at ../../lib/Storable.pm'. This happens even when hiding $connection in an anonymous array. I am looking for an alternative to utilize the pool.
I appreciate your support
I am unable to propose an alternative module, but make a suggestion which may or not be of use. While you cannot store CODE, you can store strings which can be evaluated to run. would it be possible to pass a reference to the string q!&login! which you can dereference call after being assigned to $connection. ?
#!/usr/bin/perl
use warnings;
use strict;
use Storable;
my $codestring = q'sub { q^japh^ };' ;
#my $codestring = q'sub { return MyConnectClass->new(); }';
#
# for (0..9){ add_connection($i, $codestring) }
open my $file, '>', '.\filestore.dat' or die $!;
store \ $codestring, $file;
close $file;
open $file, '<', '.\filestore.dat' or die " 2 $!";
my $stringref = retrieve $file; # my $con = get_connection()
close $file;
print &{ eval $$stringref } ; # &{eval $$con} ;
exit 0; # my $line = <STDIN>; ...
I'm working on creating a local service to listen on localhost and provide a basic call and response type interface. What I'd like to start with is a baby server that you can connect to over telnet and echoes what it receives.
I've heard AnyEvent is great for this, but the documentation for AnyEvent::Socket does not give a very good example how to do this. I'd like to build this with AnyEvent, AnyEvent::Socket and AnyEvent::Handle.
Right now the little server code looks like this:
#!/usr/bin/env perl
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
my $cv = AnyEvent->condvar;
my $host = '127.0.0.1';
my $port = 44244;
tcp_server($host, $port, sub {
my($fh) = #_;
my $cv = AnyEvent->condvar;
my $handle;
$handle = AnyEvent::Handle->new(
fh => $fh,
poll => "r",
on_read => sub {
my($self) = #_;
print "Received: " . $self->rbuf . "\n";
$cv->send;
}
);
$cv->recv;
});
print "Listening on $host\n";
$cv->wait;
This doesn't work and also if I telnet to localhost:44244 I get this:
EV: error in callback (ignoring): AnyEvent::CondVar:
recursive blocking wait attempted at server.pl line 29.
I think if I understand how to make a small single threaded server that I can connect to over telnet and prints out whatever its given and then waits for more input, I could take it a lot further from there. Any ideas?
You're blocking inside a callback. That's not allowed. There are a few ways to handle this. My preference is to launch a Coro thread from within the tcp_server callback. But without Coro, something like this might be what you're looking for:
#!/usr/bin/env perl5.16.2
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
my $cv = AE::cv;
my $host = '127.0.0.1';
my $port = 44244;
my %connections;
tcp_server(
$host, $port, sub {
my ($fh) = #_;
print "Connected...\n";
my $handle;
$handle = AnyEvent::Handle->new(
fh => $fh,
poll => 'r',
on_read => sub {
my ($self) = #_;
print "Received: " . $self->rbuf . "\n";
},
on_eof => sub {
my ($hdl) = #_;
$hdl->destroy();
},
);
$connections{$handle} = $handle; # keep it alive.
return;
});
print "Listening on $host\n";
$cv->recv;
Note that I'm only waiting on one condvar. And I'm storing the handles to keep the AnyEvent::Handle objects alive longer. Work to clean up the $self->rbuf is left as an excersise for the reader :-)
Question cross-posted, answer, too :-)
I have heard good things about AnyEvent as well, but have not used it. I wrote a small nonblocking server in the past using IO::Select. There is an example in the documentation for that module (I've added a few lines):
use IO::Select;
use IO::Socket;
$lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
$sel = new IO::Select( $lsn );
while(#ready = $sel->can_read) {
foreach $fh (#ready) {
if($fh == $lsn) {
# Create a new socket
$new = $lsn->accept;
$sel->add($new);
}
else {
# Process socket
my $input = <$fh>;
print $fh "Hello there. You said: $input\n";
# Maybe we have finished with the socket
$sel->remove($fh);
$fh->close;
}
}
}
I'm not sure what your condvar is trying to trigger there. Use it to send state, like:
#!/usr/bin/env perl
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
my $host = '127.0.0.1';
my $port = 44244;
my $exit = AnyEvent->condvar;
tcp_server($host, $port, sub {
my($fh) = #_;
my $handle; $handle = AnyEvent::Handle->new(
fh => $fh,
poll => "r",
on_read => sub {
my($self) = #_;
print "Received: " . $self->rbuf . "\n";
if ($self->rbuf eq 'exit') {
$exit->send;
}
}
);
});
print "Listening on $host\n";
$exit->recv;
Im trying to emulate a TCP Server on the same PC where the app is running.
I dont know if it can be done in Perl because im not very experienced.
With the code bellow the first reply is working but i dont know how to implement the second.
#!/usr/bin/perl -w
use IO::Socket::INET;
use strict;
my $socket = IO::Socket::INET->new('LocalPort' => '3000',
'Proto' => 'tcp',
'Listen' => SOMAXCONN)
or die "Can't create socket ($!)\n";
print "Server listening\n";
while (my $client = $socket->accept) {
my $name = gethostbyaddr($client->peeraddr, AF_INET);
my $port = $client->peerport;
while (<$client>) {
print "$_";
print $client "RESPONSE1";
}
close $client
or die "Can't close ($!)\n";
}
die "Can't accept socket ($!)\n";
EDIT: Thank you guys for the imput, i ended up with php done it and its working, yay!
Use Net::Server for the connection, and a variable in the sub to keep the current state ($state in this code); something like this:
package MyServer;
use base qw/Net::Server/;
use strict;
use warnings;
sub process_request {
my $self = shift;
my $state = 0;
while (<STDIN>) {
s/\r?\n$//; # like chomp but for crlf too
if ($state == 0 and $_ eq 'data1') {
print "> okay1\n";
$state++;
} elsif ($state == 1 and $_ eq 'data2') {
print "> okay2\n";
$state++;
} else {
last if $state == 2;
$state = 0;
}
}
}
my $port = shift || 3000;
MyServer->run( port => $port );
The example in the Net::Server POD suggests using an alarm to timeout connections, which might be appropriate here. The code above does the following:
$ nc localhost 3000
data1
> okay1
data2
> okay2
data3
$
And if you need to move to a forking / preforking / non-blocking / co-routine driven system, there's a Net::Server personality for that.
"ready to go" code:
package MyServer;
use base qw/Net::Server/;
use strict;
use warnings;
sub process_request {
my $self = shift;
my $state = 0;
$| = 1;
binmode *STDIN;
while (read(*STDIN, local $_, 3 )) {
if ($state == 0 and $_ eq "\x{de}\x{c0}\x{ad}") {
print "\x{c4}\x{1a}\x{20}\x{de}";
$state++;
} elsif ($state == 1 and $_ eq "\x{18}\x{c0}\x{0a}") {
print "\x{11}\x{01}\x{73}\x{93}";
$state++;
last;
}
}
}
my $port = shift || 3000;
MyServer->run( port => $port );
It seems to me process_request sub doesn't work correctly when a low port is set (in my situation, port 23). In particular only with low port, while parsing data input, the first request contains additional chars (but it's all ok with subsequent requests).
Have you a tips? Thank you
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');