I am working on vehicle tracking system, where in a GPS device(socket client is programmed) communicates with socket server to send GPS co-ordinates, etc. The socket server parses the data and is sent via get method to http web services for further processing. I tried simulating 50 clients locally to study the socket server behaviour. Unfortunately, I see a delay in parsing/getting the data, even though all the clients were fired at the same/different time. But My requirement, is to have first come first served, but in this context, it doesn't seem so. Does this need anything to deal with the Timeout parameter in new IO::Socket::INET ();? Below is my socket server listening to port 11050.
#!/usr/bin/perl
use IO::Socket::INET;
$| = 1;
my ($socket,$client_socket);
my ($peeraddress,$peerport);
my $LOGFILE="/home/nuthan/program/input.log";
open (LOG,">>$LOGFILE");
$socket = new IO::Socket::INET ( LocalHost => '192.168.1.110',
LocalPort => '11050', Proto => 'tcp',
Listen => 500, Reuse => 1,
Blocking => 0, Timeout => 2 )
or die "ERROR in Socket Creation : $!\n";
while(1) {
# waiting for new client connection.
$client_socket = $socket->accept();
#print "SOCKET $client_socket SOCKET\n";
if (! $client_socket){
next;
}
# Received from Client :
#356823033046306##0#0000#AUT#1#V#07734.7000,E,1259.5355,N,000.00,288#211011#085017##
#EMI's code(15 numbers)#username#status#password#data type#data volume#base station information#longitude, E,latitude, N, speed, direction#date#time##
$client_socket->recv($data,1500);
print "Received from Client : $data\n";
#print LOG "Received from Client : $data\n";
my ($blah,$EMI,$username,$status,$password,$data_type,$data_volume,
$base_station_info,$dir,$date,$time,$blah1)=split(/\#/,$data);
new_do_get($EMI,$dir,$date,$time);
}
sub new_do_get(){
print "In new_do_get\n";
my ($EMI,$dir,$date,$time) = #_;
my ($longitude,$e,$latitude,$n,$speed,$direction)=split(/,/,$dir);
my $url = "http://192.168.1.110:8080/prototype/socket/location.php?"
. "ln=$longitude<=$latitude&imei=$EMI&d=$date&o=0&v=$speed&t=$time";
# print "$url\n";
use LWP::Simple;
my $content = get $url;
die "Couldn't get $url" unless defined $content;
}
$socket->close();
close LOG;
Multi-threading socket server
After looking around, realized, with such sheer volume of clients, Multi-threading perl socket will suffice the problem. Hope this might help somebody.
a link!
#!/usr/bin/perl -Tw
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
my $EOL = "\015\012";
sub spawn; # forward declaration
sub logmsg { print "$0 $$: #_ at ", scalar localtime, "\n" }
my $port = shift || 11051;
my $proto = getprotobyname('tcp');
($port) = $port =~ /^(\d+)$/ or die "invalid port";
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "server started on port $port";
my $waitedpid = 0;
my $paddr;
use POSIX ":sys_wait_h";
sub REAPER {
my $child;
while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}
$SIG{CHLD} = \&REAPER; # loathe sysV
}
$SIG{CHLD} = \&REAPER;
for ( $waitedpid = 0;
($paddr = accept(Client,Server)) || $waitedpid;
$waitedpid = 0, close Client)
{
read(Client, $buffer, 1000);
next if $waitedpid and not $paddr;
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "connection from $name [",
inet_ntoa($iaddr), "]
$buffer
#your data in $buffer
at port $port";
spawn sub {
$|=1;
print "Hello there, $name, it's now ", scalar localtime, $EOL;
or confess "can't exec fortune: $!";
};
}
sub spawn {
my $coderef = shift;
unless (#_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "begat $pid";
return; # I'm the parent
}
# else I'm the child -- go spawn
open(STDIN, "<&Client") || die "can't dup client to stdin";
open(STDOUT, ">&Client") || die "can't dup client to stdout";
## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
exit &$coderef();
}
Related
I'm beginning to work with sockets and trying to make a client and server, from which the client connects to the server without breaking contact after a message has been delivered to server or vice versa.
The problem that I have is that they both don't output anything (I can see the server is listening and client stops itself directly without outputting anything)
Both programs don't contain any lexical errors.
Here is the client code:
#!/usr/bin/perl -w
use strict;
use diagnostics;
use Socket;
my $port = somedigits;
my $server_addr = "somebits\.somebits\.somebits\.somebits";
sub open_TCP
{
# get parameters
my ($FS, $server_addr, $port) = #_;
my $proto = getprotobyname('tcp');
socket($FS, PF_INET, SOCK_STREAM, $proto);
my $sin = sockaddr_in($port,inet_aton($server_addr));
connect($FS,$sin) || return undef;
my $old_fh = select($FS);
$| = 1; # don't buffer output
select($old_fh);
1;
}
1;
&open_TCP;
Here is the server code:
#!/usr/bin/perl -w
use strict;
use diagnostics;
use Socket;
my $port = somedigits;
my $server_addr = "somebits\.somebits\.somebits\.somebits";
socket(my $socket, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die $!; # initalize socket
bind($socket, pack_sockaddr_in($port, inet_aton($server_addr))) # associate socket with port
or die("can't bind to port:" . $port);
listen($socket, 5) # start listening
or die $1;
while(my $incoming_client = accept(my $new_socket, $socket)) { # accept incoming connections
my $hostname = gethostbyaddr($incoming_client, AF_INET);
sleep 2;
print $new_socket "someoutput" . time() . "\n";
printf("Connection from: $hostname");
close $new_socket;
};
In the client, the sub's $server_addr is uninitialized since you don't pass any arguments to the sub.
In the client, the sub's $port is uninitialized since you don't pass any arguments to the sub.
Fix the above and it works. However, you might think it doesn't work because you don't flush your output. Using printf("Connection from: $hostname\n"); is enough to do that when STDOUT is connected to a terminal.
Finally,
my $hostname = gethostbyaddr($incoming_client, AF_INET);
should be
my ($port, $packed_addr) = unpack_sockaddr_in($incoming_client);
my $hostname = gethostbyaddr($packed_addr, AF_INET);
By the way, the if(!$incoming_client) check is useless since you don't reach that statement if $incoming_client is false.
Following samples demonstrate simple network server and client.
Sample of server.pl
use strict;
use warnings;
use feature 'say';
use Socket;
my $server = 'localhost';
my $port = shift || 6000;
my $proto = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $proto)
or die "Can't open socket $!";
bind(SOCKET, pack_sockaddr_in($port, inet_aton($server)))
or die "Can't bind to port $port!";
listen(SOCKET, 5) or die "listen: $!";
say "SERVER: listen on $port";
while( my $client_addr = accept(NEW_SOCKET, SOCKET)) {
my($port, $iaddr) = sockaddr_in($client_addr);
my $name = gethostbyaddr($iaddr, AF_INET);
my $ip = inet_ntoa($iaddr);
say "CLIENT: connection from $name $ip at port $port";
print NEW_SOCKET "SERVER: localtime is " . localtime();
close NEW_SOCKET;
}
Sample of client.pl
use strict;
use warnings;
use feature 'say';
use Socket;
my $server = shift || 'localhost';
my $port = shift || 6000;
my $proto = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $proto)
or die "Can't create a socket $!";
connect(SOCKET, pack_sockaddr_in($port, inet_aton($server)))
or die "Can't connect to port $port!";
while( <SOCKET> ) {
say;
}
close SOCKET or die "CLOSE: $!";
Recomendation: a quick visit to the following pages will assist you with programming
Sockets: Client/Server Communication
Perl - Socket Programming
IO::Socket
Network Programming with Perl
I've perl script for unix socket server.pl
use IO::Select;
use IO::Socket;
$lsn = new IO::Socket::INET(Listen => 512, LocalPort => 8888);
my $socket_path = '/tmp/punix.sock';
unlink($socket_path);
$SIG{PIPE} = 'IGNORE';
$|++;
$lsn = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Local => $socket_path,
Listen => 512,
) or die("Can't create server socket: $!\n");
$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>;
#........ do some work
#
# Maybe we have finished with the socket
$sel->remove($fh);
$fh->close;
}
}
}
and clients are connecting parallel to socket and getting results.
this is working fine and fastly for first few connections say 60 connections out of 100 connections, after that rest 40 connections are processed slowly like 1 per second.
server.pl seems doesn't have any leaks/issues.
what could be the reason. I've tried with Event::Lib also same issue.
Might relate to my $input = <$fh>;. That's wrong. It blocks until a newline is received. You can only safely use sysread.
our $buf; local *buf = \$bufs{$fh}; # Creates alias $buf for $bufs{$fh}
my $rv = sysread($fh, $buf, length($buf), 64*1024);
if (!defined($rv)) {
... handle error ...
next;
}
if (!$rv) {
... handle eof ...
next;
}
while ($buf =~ s/^(.*)\n//) {
my $line = $1;
...
}
I am trying to implement a simple echo client/server, over a Unix socket. (My ultimate goal is to exchange JSON data, but this example is for simplicity). I have no idea why the client process disappears into a black hole when it tries to print to the socket the second time.
server.pl :
use IO::Socket::UNIX;
my $socket_path = '/tmp/mysocket';
unlink $socket_path if -e $socket_path;
my $socket = IO::Socket::UNIX->new(
Local => $socket_path,
Type => SOCK_STREAM,
Listen => SOMAXCONN,
);
die "Can't create socket: $!" unless $socket;
while (1) {
next unless my $connection = $socket->accept;
chomp( my $line = <$connection> );
print $connection "$line\n";
}
client.pl :
use IO::Socket::UNIX;
my $socket = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Peer => '/tmp/mysocket',
);
die "Can't create socket: $!" unless $socket;
my $line;
print $socket "one\n";
chomp( $line = <$socket> );
say $line;
print $socket "two\n";
chomp( $line = <$socket> );
say $line;
say "three";
Expected output:
> ./client.pl
> one
> two
> three
Actual output:
> ./client.pl
> one
You put the $socket->accept call inside your while loop. After your server establishes a connection and receives some input from the client, the next thing it wants to do is establish a new connection.
Move the accept call outside the while loop
my $connection = $socket->accept;
$connection->autoflush(1);
while (my $line = <$connection> ) {
chomp($line);
print $connection "$line\n";
}
or, if you do want to accept more than one connection,
while (1) {
next unless my $connection = $socket->accept;
$connection->autoflush(1);
while (my $line = <$connection>) {
chomp($line);
print $connection "$line\n";
}
}
Your current solution will also likely be "suffering from buffering", so both the server and the client should set autoflush(1) on their socket handlers.
Now to handle simultaneous connections, the server would usually call fork after getting a connection, and handling that connection in a child process.
while (1) {
my $connection = $socket->accept;
if (fork() == 0) {
$connection->autoflush(1);
while (my $line = <$connection>) {
chomp($line);
print $connection "$line\n";
}
close $connection;
exit;
}
}
A complete bi-directional example for anyone looking:
Server:
#! /usr/bin/perl -w
use strict;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
my $SOCK_PATH = '/tmp/test.sock';
unlink($SOCK_PATH) if -e $SOCK_PATH;
my $server = IO::Socket::UNIX->new(
Type => SOCK_STREAM(),
Local => $SOCK_PATH,
Listen => SOMAXCONN,
)
or die("Can't create server socket: $!\n");
while (1) {
my $connection = $server->accept;
if (fork() == 0) {
print "** New connection received **\n";
$connection->autoflush(1);
my $count = 1;
while (my $line = <$connection>) {
if ($line){
chomp($line);
$connection->print($count . ' -> ' . $line . "\n"); # Sent response back to client, \n terminates
print "Received and replied to $count '$line'\n";
$count++;
}
}
close $connection;
exit;
}
}
Client:
#!/usr/bin/perl -w
use strict;
use IO::Socket::UNIX qw( SOCK_STREAM );
my $SOCK_PATH = '/tmp/test.sock';
my $client = IO::Socket::UNIX->new(
Type => SOCK_STREAM(),
Peer => $SOCK_PATH
)
or die("Can't connect to server: $!\n");
$client->autoflush(1);
## Listen for replies
if (fork() == 0) {
while (my $line = <$client>) {
if ($line){
chomp($line);
print("Recv: '" . $line . "'\n");
}
}
}
## Send something
for my $itm ('Alpha','Beta','Gamma','Delta'){
print("Send: " . $itm . "\n");
print($client $itm . "\n") or warn("Can't send: $!\n"); # send to server, \n terminates
}
print "** Client Finished **\n";
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
My OS is Archlinux with perl 5.14.2. I am just trying to write a little program to accomplish a remote comlile. The program just passes a C source file to the server. The server will call gcc to compile the C code and pass the compiler's message. The client can't receive the compiler's message. I have the message in the server.
There is the code:
#!/usr/bin/perl -w
# oj.pl --- alpha
use warnings;
use strict;
use IO::File;
use IO::Socket;
use constant MY_TRAN_PORT => 138000;
$| = 1;
my $tmpFileToBeCompiled = IO::File->new ("> tmpFile09090989.c") or die "Can't creat this file";
#if (defined $tmpFileToBeCompiled) {
# print $tmpFileToBeCompiled "argh"; # just for test!
#}
# $fihi->close;
my $port = shift || MY_TRAN_PORT;
my $sock_server = IO::Socket::INET->new (Listen => 20,
LocalPort => $port,
Timeout => 60,
Reuse => 1)
or die "Can't create listening socket: $!\n";
my $tmp = 1;
while ($tmp) {
next unless my $session = $sock_server->accept;
my $peer = gethostbyaddr ($session->peeraddr, AF_INET)
|| $session->peerhost;
warn "Connection from [$peer, $port]\n";
while (<$session>) {
print $tmpFileToBeCompiled $_; # if it works, the filehandle should be changed into tmpFile. just fixed.
print $session "test!";
}
my #lines = `gcc tmpFile09090989.c 2>&1`;
foreach ( #lines) {
print $session $_ . "test!!!\n";
# $session->print;
}
print "OK!";
$tmpFileToBeCompiled->close;
warn "Connecting finished!\n";
$session->close;
$tmp --;
}
$sock_server->close;
----------------------------------------end--------------------------------------------------------
-------------------------------------client.pl--------------------------------------------------------
use warnings;
use strict;
use IO::Socket qw(:DEFAULT);
use File::Copy;
use constant MY_TRAN_PORT => 138000;
use IO::File;
my $host = shift || '127.0.0.1';
my $port = shift || MY_TRAN_PORT;
my $socket = IO::Socket::INET->new("$host:$port") or die $#;
my $fh = IO::File->new("a.c", "r");
my $child = fork();
die "Can't fork: $!\n" unless defined $child;
# if (!$child) {
# $SIG{CHLD} = sub { exit 0 };
# userToHost();
# print "Run userToHost done!\n";
# $socket->shutdown(1);
# sleep;
# } else {
# hostToUser();
# print "Run hostToUser done! \n";
# warn "Connection closed by foreign host\n";
# }
userToHost();
unless ($child) {
hostToUser();
print "Run hostToUser done! \n";
warn "Connection closed by foreign host\n";
$socket->close;
}
sub userToHost {
while (<$fh>) {
# print $_; # for debug
print $socket $_;
}
}
sub hostToUser {
while (<$socket >) {
print $_;
}
}
# copy ("a.c", $socket) or die "Copy failed: $!";
print "Done!";
You don't need to fork in client. At all. Just like themel said
You have error in client code: <$socket > should be <$socket>
You need to notify server that you have written all data and server can start compilation. Otherwise server will stuck at while (<$session>) forever.
To achieve this you could call shutdown($socket, 1) which means you finished writing. See perldoc -f shutdown
Final prototype (very rough) could look like this: https://gist.github.com/19b589b8fc8072e3cfff
yko nailed it, but let me just suggest that your task will be solved in a much easier and more maintainable way by a shell script running from inetd.