【问题标题】:perl socket client/server queuing up the packetsperl 套接字客户端/服务器排队数据包
【发布时间】:2012-02-12 10:40:44
【问题描述】:

我正在研究车辆跟踪系统,其中 GPS 设备(已编程套接字客户端)与套接字服务器通信以发送 GPS 坐标等。套接字服务器解析数据并通过 get 方法发送到 http web进一步处理的服务。我尝试在本地模拟 50 个客户端来研究套接字服务器的行为。不幸的是,我看到解析/获取数据的延迟,即使所有客户端都在相同/不同的时间被解雇。但我的要求是先到先得,但在这种情况下,似乎并非如此。这是否需要处理new IO::Socket::INET (); 中的Timeout 参数?下面是我的套接字服务器监听 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&lt=$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;

【问题讨论】:

  • 您测量的代码过多,无法达到您声称的效果。取出 HTTP 请求部分,以便您独立于 PHP 侦听器和中间的网络。放入一些带有时间戳的逐行日志记录。 - 当我猜测 50 个客户端模拟伪造 GPS 设备时,我是否正确?如果是,请同时发布该代码。
  • 您是否意识到,如果一个客户端决定只坐在那里打开套接字而不发送任何内容,那么您的服务器将坐在那里等待它——忽略所有其他客户端?您需要为每个客户分叉或使用select。与其做后者,不如考虑POE
  • thnx @derobert 我意识到它等待了很长时间。环顾四周,才知道有如此庞大的客户端数量,多线程 perl 套接字足以解决问题。我已经在下面发布了该代码。现在,我不确定在哪里读取/接收数据。
  • @nuthan:你可以在传递给 spawn 的匿名子例程中执行此操作。你根本不应该在父进程中做。有什么理由不使用 POE?

标签: perl sockets tcp client-server cpan


【解决方案1】:

多线程套接字服务器

环顾四周后,意识到在如此庞大的客户端数量下,多线程 perl 套接字足以解决问题。希望这可能对某人有所帮助。 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();
}  

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2023-04-05
    • 2011-11-15
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-06-05
    相关资源
    最近更新 更多