We've got a Perl system which opens listener sockets, and then spawns threads to actually accept and act on connections. We're running on Windows Server 2008, and running Perl 5.8.8 (it's quite an old system).
(As an aside, this works fine on Linux, where we're using forking - but the implementation of fork on Windows is less than optimal).
We're creating the socket using this code:
use Socket;
...;
unless (
($rSock) = IO::Socket::INET->new(
LocalPort => $aChannelConfig{$sChannel}->{nPort},
Proto => 'tcp',
Type => SOCK_STREAM,
Reuse => 1,
Listen => $aChannelConfig{$sChannel}->{nListen},
)
and $rSock
)
{
$sErrNote = "Cannot create tcp listener socket: sChannel=$sChannel sService=>$aChannelConfig{$sChannel}->{nPort} Err=$!";
}
When the spawned processes come to accept the socket, only the first one works properly.
The problem is that subsequent processes just get undef from IO::Socket::accept - in the core IO::Socket::accept code below, the call to _accept_ returns undef (we're not using timeouts).
sub accept {
#_ == 1 || #_ == 2 or croak 'usage $sock->accept([PKG])';
my $sock = shift;
my $pkg = shift || $sock;
my $timeout = ${*$sock}{'io_socket_timeout'};
my $new = $pkg->new( Timeout => $timeout );
my $peer = undef;
print("!!! in IO::Socket::accept sock=$socket pkg=$pkg timeout=$timeout new=$new\n");
if ( defined $timeout ) {
require IO::Select;
my $sel = new IO::Select $sock;
unless ( $sel->can_read($timeout) ) {
$# = 'accept: timeout';
$! = ( exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1 );
return;
}
}
$peer = accept( $new, $sock )
or return;
return wantarray
? ( $new, $peer )
: $new;
}
Presumably we need to do something with the socket options to allow different threads to accept on it.
Can someone give me some pointers please?
Edit
Our call to create a thread is:
my $thr = server::start_thread(\&_start_server_process,$sServerType,$sIcPipe,$rIcSock,'thread');
sub start_thread {
my $thr = threads->create(#_) or return;
return $thr;
}
Edit 2
Log output from successful and unsuccessful calls are as below:
Successful accept:
2014-09-22 08:55:32,575 p:2532.5 e:2532.5 s:OA.2 DEBUG : CADETserver::channel_accept - !!! - TCP socket accept. Channel=oa rH=IO::Socket::INET=GLOB(0x743c4ac)
2014-09-22 08:55:32,635 p:2532.5 e:2532.5 s:OA.2 DEBUG : CADETserver::channel_accept - !!! - TCP socket accept result. Channel=oa $#= $rClient=IO::Socket::INET=GLOB(0x9fb2d3c)
Unsuccessful accept:
2014-09-22 08:55:32,575 p:2532.6 e:2532.6 s:OA.3 DEBUG : CADETserver::channel_accept - !!! - TCP socket accept. Channel=oa rH=IO::Socket::INET=GLOB(0x7aef7d4)
2014-09-22 08:55:32,606 p:2532.6 e:2532.6 s:OA.3 DEBUG : CADETserver::channel_accept - !!! - TCP socket accept result. Channel=oa $#= $rClient=
Note that we're just getting an undef client socket and no error recorded in $#
The code which produced the above log output is below - as you can see, we're just calling accept with no parameters.
my $rH = $rHndlHandles{$sCurrServerType}{$rSock};
$l4p->debug("!!! - TCP socket accept. Channel=$sChannel rH=$rH");
my $rClient;
eval {
local $SIG{__DIE__} = 'IGNORE';
$rClient = $rH->accept();
};
$l4p->debug('!!! - TCP socket accept result. Channel=' . $sChannel . ' $#=' .$# . ' $rClient=' . $rClient );
Interestingly I was looking at whether the problem is how we're setting the socket to non-blocking. Our current code is as follows:
ioctl ($rSock, 0x8004667E, \$temp); # set non-blocking
When I change it to:
use constant FIONREAD => 0x4004667f;
my $numbytes = "\x00" x 4; # pack('L',0) works too
ioctl($rSock, FIONREAD, unpack('I',pack('P',$numbytes)));
my $nbytes = unpack('I',$numbytes);
(with thanks to bitshiftleft on PerlMonks - http://www.perlmonks.org/?node_id=780083)
this allows the sockets to accept OK, but the sockets don't communicate reliably.
So... is it to do with how we're setting the sockets to non-blocking?
Related
I would like to add this code in PERL. I was looking for a solution via google, perldoc. It did not help me.
How to gain timeout for the client? And after some time, disconnect the client, but the server will listen.
Thank you for your help.
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use threads;
use Thread::Queue;
# Defaulting to 42424
my $port = $ARGV[0] || 42424;
# Storing list of connected clients sensors to monitor
my %clients;
my $queue = Thread::Queue -> new;
my $monitor = threads->create ("monitor", $queue);
# This probably might not be of use
$SIG{CHLD} = 'IGNORE';
my $listen_socket = IO::Socket::INET->new(LocalPort => $port,
Listen => 10,
Proto => 'tcp',
Reuse => 1);
# Confirm we are listening
die "Can't listen on socket: $#" unless $listen_socket;
warn "Server ready. Listening to port $port\n";
# Process TCP data after accepting connection
while (my $connection = $listen_socket->accept) {
# spawning a thread per client sensor
# Could potentially do this with IO Multiplexing too
threads->create ("read_data", $queue, $connection)->detach;
}
sub read_data {
# accept data from the socket and put it on the queue
my ($queue, $socket) = #_;
while (<$socket>) {
print "Received: $_";
$queue -> enqueue(time." $_");
}
close $socket
}
sub monitor {
my $queue = shift;
# As of now, the monitor is invoked only every 10 seconds
while (1) {
while ($queue -> pending) {
my $data = $queue -> dequeue;
print "monitor got: $data\n";
$data =~ /(\d+) (\S+): Next ping in (\d+) seconds/;
my $time = $1;
my $client = $2;
my $frequency = $3;
if ((defined $clients{$client}) and $clients{$client} -> [0] eq 'NAK') {
print "$client sent a ping again\n";
}
$clients{$client} = [ 'OK', $time + $frequency];
}
for my $client (keys %clients) {
next if $clients{$client}->[0] eq 'NAK';
next if $clients{$client}->[1] > time;
print "$client missed a signal ping, expected at $clients{$client}->[1], now it is ".time."\n";
$clients{$client}->[0] = 'NAK';
}
sleep 10;
}
}
I am trying to create a socket object that can be shared among threads. The following code does not work because socket object is a GLOB. How could the socket object be shared? Can it be done this way?
my $socket1 = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => "localhost",
PeerPort => "888",
) or die "couldn't connect: $!";
my $socket_shared =shared_clone($socket1);
....
my $thr1 = threads->create(\&Thread_1);
$thr1->join();
sub Thread_1 {
lock($socket_cpy);
my $data = "Msg.\n";
$socket1->send($data);
$socket1->recv($data,1024);
}
ERROR: Unsupported ref type: GLOB at line (7 here, where the shared_clone is called).
Can I suggest instead that you don't try and share a socket between threads? That feels like something that's going to be asking for concurrency issues between them.
Whilst there are (probably) ways of doing that, I'd suggest instead - have a single thread 'responsible' for the IO, and use something like Thread::Queue to interact with it.
E.g. something like:
use strict;
use warnings;
use threads;
use Thread::Queue;
my $output_q = Thread::Queue->new();
my $nthreads = 1;
sub socket_thread {
my $socket1 = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => "localhost",
PeerPort => "888",
) or die "couldn't connect: $!";
while ( my $data = $output_q->dequeue() ) {
$socket1->send($data);
$socket1->recv( $data, 1024 );
}
}
sub worker_thread {
$output_q->enqueue( "Some text from thread: ",
threads->self->tid(), "\n" );
}
for ( 1 .. $nthreads ) {
threads->create( \&worker_thread );
}
foreach my $thr ( threads->list() ) {
$thr->join();
}
That way you don't need to pass the socket around at all, you can use one or more queues to serialise your IO. This - to my mind - is one of the stronger reasons to thread in perl in the first place - you've better IPC mechanisms to work with.
Otherwise I'd be tempted to suggest using forks, which (on Unix) are generally more efficient.
I am building a multithreaded perl TCP server that uses different threads to handle different clients. For this purpose, I am maintaining a thread pool which keeps track of whether the thread is idle or working.
In the main thread, I open a listening socket and bind to a specific port using:
$socket = new IO::Socket::INET(Localhost => '127.0.0.1',
LocalPort => '5000',
Proto => 'tcp',
Listen => $MAX_THREADS, Reuse => 1) or die "Error in Socket Creation: $!\n";
The main thread also listens to any incoming connections using socket->accept() and if successful passes this return socket to the child thread which handles it and sends an acknowledgement to the client corresponding to the socket. However, I was unable to pass this socket.
I googled a bit and having no luck, later I decided to maintain a global hashmap of incoming sockets which can be later accessed by the child threads(the hashmap is shared) and then work on it.
However perl is giving me an error as to Invalid value for shared scalar. Here is the code bit:
$sochandler->{$tid} = $socket->accept();
#$sochandler is the shared global hashmap with keys as thread IDs
PS: I am newbie to perl and I have tried to explain as much as I can regarding my problem
Here is the subroutine code which is run by every child thread:
sub worker
{
my ($work_q) = #_;
my $tid = threads->tid();
do {
printf("Idle -> %2d\n", $tid);
$IDLE_QUEUE->enqueue($tid);
my $work_tid = $work_q->dequeue();
my $work = $sochandler->{$work_tid};
last if ($work_tid < 0);
printf(" %2d <- Working\n", $tid);
while (($work_tid > 0) && ! $TERM) {
print "Accepted New Client Connection From: $work->peerhost(), $work->peerport()\n";
my $data = "ACK from server";
$work->send($data);
$work->recv($data,1024);
print "Received from Client : $data\n";
}
} while (! $TERM);
printf("Finished -> %2d\n", $tid);
}
The error you are getting is because the $tid is not declared as a shared variable. You need to share 'deep' so that not only is the hash shared, but also its keys.
I'm trying to write a multithreaded server with perl (Windows x64). When trying to connect to it from another computer, I found the memory and handle usage kept going up, even if I maintained only one connection at a time. And after thousands of trials it used up nearly all system memory. I can't figure out the reason.
Here is the server side:
use IO::Socket::INET;
use threads;
sub session_thread
{
my $client_socket=$_[0];
my $client_address = $client_socket->peerhost();
my $client_port = $client_socket->peerport();
print "connection from $client_address:$client_port\n";
my $data = "";
$client_socket->recv($data, 1024);
print "$client_address:$client_port says: $data";
$data = "ok";
$client_socket->send($data);
shutdown($client_socket, 1);
$client_socket->close();
threads->exit();
}
$| = 1;
my $socket = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => '7777',
Proto => 'tcp',
Listen => 5,
ReuseAddr => 1
);
die "cannot create socket $!\n" unless $socket;
print "server waiting for client connection on port 7777\n";
while(1)
{
my $client_socket = $socket->accept();
threads->create('session_thread',$client_socket);
}
$socket->close();
Thanks.
You either have to wait for the thread to finish by joining it or tell Perl that you don't care about the thread's return value and that Perl itself should clean up the data once the thread exits. The latter seems to match your use case and is done by detaching.
Also note that using exit is not necessary in your example. You can simply return from the thread's subroutine normally. exit is used for ending a thread from a deeper nesting level within the program.
I'll preface this by saying I have minimal experience with both Perl and Socket programming, so I appreciate any help I can get. I have a TCP Server which needs to handle multiple Client connections simultaneously and be able to receive data from any one of the Clients at any time and also be able to send data back to the Clients based on information it's received. For example, Client1 and Client2 connect to my Server. Client2 sends "Ready", the server interprets that and sends "Go" to Client1. The following is what I have written so far:
my $sock = new IO::Socket::INET
{
LocalHost => $host, // defined earlier in code
LocalPort => $port, // defined earlier in code
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1,
};
die "Could not create socket $!\n" unless $sock;
while ( my ($new_sock,$c_addr) = $sock->accept() ) {
my ($client_port, $c_ip) = sockaddr_in($c_addr);
my $client_ipnum = inet_ntoa($c_ip);
my $client_host = "";
my #threads;
print "got a connection from $client_host", "[$client_ipnum]\n";
my $command;
my $data;
while ($data = <$new_sock>) {
push #threads, async \&Execute, $data;
}
}
sub Execute {
my ($command) = #_;
// if($command) = "test"
// send "go" to socket1
print "Executing command: $command\n";
system($command);
}
I know both of my while loops will be blocking and I need a way to implement my accept command as a thread, but I'm not sure the proper way of writing it.
Either fork, thread or do I/O multiplexing with select. Take a look at Net::Server and AnyEvent::Socket, too. For an example of I/O multiplexing, take a look at How can I accept multiple TCP connections in Perl?.