继续Perl文档翻译计划：Perl IPC（二）
时间：2010-02-04 来源：naihe2010
套接字：客户端／服务器通信
不受限于Unix族的操作系统（比如，PCs的WinSock提供了socket支持），你系统上没有sockets，你将没法很好地对付这一节。使用套按字，你可以实现虚拟的流（如TCP流）和数据报（如UDP报）。你能不能做更多取决于你的系统。
Perl的操作套接字的函数与C中的这类系统调用有着一样的名字，但是它们的参数不同，这里有两个原因：第一，Perl的文件句柄与C文件描述符不一样。第二，Perl已经知道字符串的长度，所以你不需要传递这类信息。
在Perl中老的套接字代码的一个主要问题是，一些硬编码的值可能会引起问题。如果你看到它的源码中如同设置$AF_INET = 2，你知道你有很大的麻烦：一个更好的解决方案是使用Socket模块，它更好的管理了你需要访问的这些量和函数的方法。
如果你不是在写一个为了如NNTP或者SMTP等已知协议的服务器/客户机，你应该给定一些规则来告诉你的服务器如何知道客户机结束了一次交互。很 多协议是基于单行消息和回应（一端知道收到一个"\n"知道另一端结束了）或者用一个标志来分行的多行消息和回应（"\n.\n"终结一个消息/回应）。
网络行终止
网络行终止是"\015\012"。在Unix的ASCII码中，可以写做"\r\n"，但是其它一些系统，"\r\n"可以有时为"\015 \015\012"，"\012\012\015"，或者其它完全不同的东西。标准的提供"\015\012"的写法是做不到的，但是他们也建议接受输入 时的单个"\012"（但是处理你的请求时灵活一些）。我们不能很好的在本手册中弄清这些，但是除非你在一个Mac上，你可能没问题。
网络TCP客户端与服务器
当你想客户机－服务器之间跨机器通讯时，使用网络域的套接字。
这是一个使用网络域的套接字的TCP客户端的例子：
#!/usr/bin/perl -w
use strict;
use Socket;
my ($remote,$port, $iaddr, $paddr, $proto, $line);
$remote = shift || 'localhost';
$port = shift || 2345; # random port
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$iaddr = inet_aton($remote) || die "no host: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
while (defined($line = <SOCK>)) {
print $line;
}
close (SOCK) || die "close: $!";
exit(1);
并且有一个类似的服务器来配合它。我们设置监听地址为INADDR_ANY以使内核可以在多网卡的主机上选择一个合适的网络接口。如果你想选择特定接口（比如网关或者防火墙的外端），你应该用你的真实地址来填充这个值。
#!/usr/bin/perl -Tw
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
my $EOL = "\015\012";
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $port = shift || 2345;
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 $paddr;
$SIG{CHLD} = \&REAPER;
for ( ; $paddr = accept(Client,Server); close Client) {
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "connection from $name [",
inet_ntoa($iaddr), "]
at port $port";
print Client "Hello there, $name, it's now ",
scalar localtime, $EOL;
}
这是一个多线程的版本。多线程意指在传统机器上，它创建一个从服务器来处理客户端的请求而主服务器马上回去接受新的客户端。
#!/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 || 2345;
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";
use Errno;
sub REAPER {
local $!; # don't let waitpid() overwrite current error
while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
logmsg "reaped $waitedpid" . ($??" with exit $?" : '');
}
$SIG{CHLD} = \&REAPER; # loathe sysV
}
$SIG{CHLD} = \&REAPER;
while(1) {
$paddr = accept(Client, Server) || do {
# try again if accept() returned because a signal was received
next if $!{EINTR};
die "accept: $!";
};
my ($port, $iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr, AF_INET);
logmsg "connection from $name [",
inet_ntoa($iaddr),
"] at port $port";
spawn sub {
$|=1;
print "Hello there, $name, it's now ", scalar localtime, $EOL;
exec '/usr/games/fortune' # XXX: `wrong' line terminators
or confess "can't exec fortune: $!";
};
close Client;
}
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();
}
这个服务器把麻烦给了通过fork出一个子进程来处理每个传入的请求。这种方法可以同时处理多个请求，使客户不用一直等待。即使你不fork()，listen()将允许多个连接被等待。创建服务器不得不很小心地回收死掉的子进程（叫做“僵尸”），否则这些会很快用光你的进程表。调用waitpid()用来回收结束的子进程的资源，所以确保完全地关闭并且不要回收它的死锁。
在整个地循环中我们调用accept来检查它是否返回错误值。这可以发现一个需要报告的系统错误。仅管Perl 5.7.3中的安全信号(看延迟信号(安全信号)）意味着accept()可能被进程收到信号时打断。这通常发生在其中一个创建的子进程退出时返回给父进程一个CHLD信号。
如果accept()被一个信号打断，$!将设为EINTR。如果是这样，我们可以安全地继续执行下一次循环，再次调用accept()。你的信号处理过程不要更改$!的值或者测试通常失败。在子过程PEAPER里我们创建了一个本地的$!先于waitpid()。当waitpid()设置$!为ECHILD（当没有其它子进程要等待时），它将升级本地的值而保留原来的不变。
我们建议你使用-T开关来严格约束检查（看perlsec）仅管我们没有运行setuid或者setgid。对于一些服务器和其它运行脚本的程序（如CGI脚本）来说，这一直是一个好主意。因为它限制了你的系统以外的人运行程序的机会。
让我们再看一个TCP客户端。这个连接到一些不同的机器上的TCP"time"服务然后显示它运行的主机有多不同。
#!/usr/bin/perl -w
use strict;
use Socket;
my $SECS_of_70_YEARS = 2208988800;
sub ctime { scalar localtime(shift) }
my $iaddr = gethostbyname('localhost');
my $proto = getprotobyname('tcp');
my $port = getservbyname('time', 'tcp');
my $paddr = sockaddr_in(0, $iaddr);
my($host);
$| = 1;
printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
foreach $host (@ARGV) {
printf "%-24s ", $host;
my $hisiaddr = inet_aton($host) || die "unknown host";
my $hispaddr = sockaddr_in($port, $hisiaddr);
socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCKET, $hispaddr) || die "bind: $!";
my $rtime = ' ';
read(SOCKET, $rtime, 4);
close(SOCKET);
my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
printf "%8d %s\n", $histime - time, ctime($histime);
}
Unix域的TCP客户端与服务器
关于网络域的客户端与服务器介绍完了，但是本地的通讯如何呢？有时你可能得用相同的设置，有时不用。Unix域套接字是绑定在当前主机，通常用来跟本地管道通讯。与网络域的套接字不同，Unix域的套接字可以显示通过ls(1)在文件系统中显示出来。
% ls -l /dev/log
srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
你可以通过Perl的-S来检测它。
unless ( -S '/dev/log' ) {
die "something's wicked with the log system";
}
这是一个Unix－域的客户端：
#!/usr/bin/perl -w
use Socket;
use strict;
my ($rendezvous, $line);
$rendezvous = shift || 'catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
while (defined($line = <SOCK>)) {
print $line;
}
exit(1);
这是一个对应的服务器。因为Unix域的套接字在本地，一切都会工作的很好，你不用担心网络行终结。
#!/usr/bin/perl -Tw
use strict;
use Socket;
use Carp;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
sub spawn; # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $NAME = 'catsock';
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');
socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
unlink($NAME);
bind (Server, $uaddr) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "server started on $NAME";
my $waitedpid;
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;
accept(Client,Server) || $waitedpid;
$waitedpid = 0, close Client)
{
next if $waitedpid;
logmsg "connection on $NAME";
spawn sub {
print "Hello there, it's now ", scalar localtime, "\n";
exec '/usr/games/fortune' or die "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();
}
如你所见，它跟网络域的TCP服务器很相似，事实上，我们完全照抄了那些函数：spwan()，logmsg()，ctime()和REAPER()，跟另一个完全一样。
那么，为什么你要用一个Unix域的套接字来代替命名管道呢？因为命名管道不给你保存状态。你不能从一个进程告诉另一个进程数据。用套接字编程，你为每一个客户端，得到了一个分离的状态：所以accept()有两个参数。
举例来说，你有一个长时间运行的数据库服务器，你想创建进程让WWW可以访问，但是你只有一个CGI接口。你最好有一个小巧的、简单的CGI程序，它做一切的检查和记录，然后做为一个Unix域的客户端来连上你的私有服务器。
使用IO::Socket的TCP客户端
相对那些高级别的套接字编程接口来说，IO::Socket模块提供了一个面向对象的接口。IO::Socket自从5.004发布版开始做为标准 模块被包含。如果你正在运行一个老版的Perl，就从CPAN获取IO::Socket，你也可以找到易用的接口：DNS，FTP，Ident（RFC 931），NIS和NISPlus，NNTP，Ping，POP3，SMTP，SNMP，SSLeay，Telnet，和Time。
一个简单的客户端
这是一个客户端，它创建了一个连向主机名“localhost"，端口号13的"daytime"服务，然后打印服务器返回的所有信息。
#!/usr/bin/perl -w
use IO::Socket;
$remote = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => "localhost",
PeerPort => "daytime(13)",
)
or die "cannot connect to daytime port at localhost";
while ( <$remote> ) { print }
运行这个程序后，你应该会得到一些如下面这样的回应：
Wed May 14 08:40:46 MDT 1997
这是选项new创建的意义：
Proto要使用何种协议。在这里，套接字句柄返回连向一个TCP套接字，因为我们想要一个面向流的连接，即，此时这个连接的处理像是一个流式的老文件。并不是所有的套接字都是这种类型。比如，UDP协议可以用来做数据报套接字，做消息转发。
PeerAddr运行远程服务的主机的名字。我们可以指定一个如"www.perl.com"的长的名字，或者一个如"204.148.40.9"的地址。为了演示目的，我们使用了特定的"localhost"，永远代表你正在运行的当前主机。如果在需要的话，localhost对应的网络地址为"127.0.0.1"。
PeerPort我们将要连接的服务名字或者端口号。我们可以在一个很好的配置了"daytime"项的系统服务文件,[FOOTNOTE: Unix系统上的系统服务文件在/etc/services]，但是，我们用括号中的端口号更好。使用端口号挺好，但是各种各样的端口号着实让程序员头疼。
注意，new的返回值如何做为文件句柄在while循环中使用呢？这就是所谓的”间接文件句柄“，一个包含文件句柄的标量变量。你可以像正常的文件句柄一样使用它。举个例子，你可以这样从它里面读取一行：
$line = <$handle>;
all remaining lines from is this way:
@lines = <$handle>;
然后发送一行数据到它里面：
print $handle "some data\n";
一个网页抓取客户端
这是一个连接上远程主机来获取文件的简单的客户端，然后从它返回文件列表。这是一个比前一个更有意思的客户端，因为它先发送一些数据给要获取回应的服务器。
#!/usr/bin/perl -w
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host document ..." }
$host = shift(@ARGV);
$EOL = "\015\012";
$BLANK = $EOL x 2;
foreach $document ( @ARGV ) {
$remote = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => $host,
PeerPort => "http(80)",
);
unless ($remote) { die "cannot connect to http daemon on $host" }
$remote->autoflush(1);
print $remote "GET $document HTTP/1.0" . $BLANK;
while ( <$remote> ) { print }
close $remote;
}
万维网服务器运行"http"服务，它监听到标准的端口，80端口。如果你要连接的万维网服务器监听在不同的端口（如1080或者8080），你应该手工指定它，PeerPort => 8080 。autoflush方法用在套接字上，应该操作系统会缓冲我们发送出去的数据。（如果你在一个Mac系统上，你还需要把你的代码中要通过网络发送出去的数据的每一个"\n"改成"\015\012"。
连接上服务器只是这个程序的第一步；一旦连接上，你不得不使用服务器的语言。网络上每一个服务都有它能接受的小命令语言。我们发送给它的 以"GET"开头的字符串是HTTP语法。这里，我们只是简单地请求每一个文档。是的，我们实际上为每一个文档建了一个新连接，而它们在同一个主机上。这 是你一直得用的说HTTP的方法。最近版本的万维网浏览器可能会请求远程服务器时保持一会儿连接，但是服务器并不需要遵循这样的请求。
这是执行那个程序的例子，我们叫它webget：
% webget www.perl.com /guanaco.html
HTTP/1.1 404 File Not Found
Date: Thu, 08 May 1997 18:02:32 GMT
Server: Apache/1.2b6
Connection: close
Content-type: text/html
<HEAD><TITLE>404 File Not Found</TITLE></HEAD>
<BODY><H1>File Not Found</H1>
The requested URL /guanaco.html was not found on this server.<P>
</BODY>
好吧，这并不那么有趣，因为它不能找到那文件。但是这个页面放不下一个太长的响应。
如果想要这个程序的功能更加全面，你应该看看CPAN上的LWP模块中带的lwp-request程序。
IO::Socket的客户端交互
如果你只想发送一个命令，然后得到一个响应，这没问题。但是，怎么设置成完全地如telnet那样地交互模式呢？此时，你可以输入一行，得到响应，输入一行，得到响应，等等。
这个客户端比目前为止我们做的两个都要复杂，但是如果你运行在一个支持强大的fork调用的系统上，解决方法不太粗糙。一旦你建立了同你要交互的远程主机的连接，调用fork， 克隆你的进程。每一个独立的进程有一个简单的工作要做：父进程复制从套接字收到的一切到标准输出，同时，子进程复制标准输入的一切数据到套接字。为了在一 个进程里完成同样的事情将会困难得多，因为在两个进程里做一件事情比在一个进程里做两件事情要简单。这是Unix经典哲学中的Keep-it- Simple原则，它也是好的软件工程，适用于其它系统。
Here's the code:
#!/usr/bin/perl -w
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);
unless (@ARGV == 2) { die "usage: $0 host port" }
($host, $port) = @ARGV;
# create a tcp connection to the specified host and port
$handle = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
PeerPort => $port)
or die "can't connect to port $port on $host: $!";
$handle->autoflush(1); # so output gets there right away
print STDERR "[Connected to $host:$port]\n";
# split the program into two processes, identical twins
die "can't fork: $!" unless defined($kidpid = fork());
# the if{} block runs only in the parent process
if ($kidpid) {
# copy the socket to standard output
while (defined ($line = <$handle>)) {
print STDOUT $line;
}
kill("TERM", $kidpid); # send SIGTERM to child
}
# the else{} block runs only in the child process
else
# copy standard input to the socket
while (defined ($line = <STDIN>)) {
print $handle $line;
}
}
父进程中的if块中的kill函数，在远程服务器关闭了它那面的连接之后，给我们的子进程发送一个信号（目前运行在else块）。
如果远程服务器发送了一个字节的数据，你需要那些数据马上返回，而不要等新行（可能没有），你需要把父进程中的while循环改一下：
my $byte;
while (sysread($handle, $byte, 1) == 1) {
print STDOUT $byte;
}
对你需要的每一个字节做一次系统调用是一种非常低效但是最简单的解决问题的方式。
使用IO::Socket的TCP服务器
一直以来，设置一个服务器比执行一个客户端要复杂一点。服务器创建一个特定类型的套接字，除了监听在一个特定的端口上等待新的传入连接外，什么也不做。这个通过调用不同参数的IO::Socket::INET->new()方法来做到。
Proto要使用何种协议。如同我们的客户端，我们还是指定了"tcp"。
LocalPort我们通过LocalPort， 指定一个本地端口，这一条，我们没有对客户端做。你的服务要实现的服务名称或者端口号。（在Unix中，1024以下的端口号只有超级用户可以使用。）在 我们的示例中，我们使用端口号9090，但是你可以使用你的系统中的任何没有被占用的端口。如果你要使用一个已经在使用中的，你将得到一 个"Address already in use"消息。在Unix中，netstat -a命令可以显示当前运行着的服务。
ListenListen选项用来设置我们在接受传入连接以前可以缓冲的连接数目。想象它一下，就像你的电话的等待队列。低层次的Socket模块，有一个特别的符号SOMAXCONN表示系统最大值。
ReuseReuse选项用来避免我们手动重启服务时，要经过好长的时间等待清除系统缓存。
一旦这个普通的服务套接字被上面的参数创建成功，它就等待着新的客户端来连接了。这个服务器阻塞在accept方法上，这个方法可以接受来自远程的客户端的双向通讯。（确保autoflush这个句柄以避免缓冲。）
为了更加友好，我们的服务器马上返回给用户命令。大多数服务不会。因为不带新行的返回，你不得不使用sysread等实现交互。
这个服务器接受五种不同命令中的一个，把输出返回给客户端。跟大多数服务器不同，这一个同一时刻只能处理一个连接。多线程服务器在第6章中讲述。
这里是代码。我们将
#!/usr/bin/perl -w
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9000; # 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 (/quit|exit/i) { last; }
elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
elsif (/who/i ) { print $client `who 2>&1`; }
elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
else
print $client "Commands: quit date who cookie motd\n";
}
} continue {
print $client "Command?";
}
close $client;
}
UDP：消息传输
另一种客户机－服务器配置使用的不是连接，而是消息。UDP通讯包含更快的速度但是提供更少的可靠性，它们不保证消息被送达，也不管顺序。但 是，UDP也提供一些优于TCP的方面，它可以广播，可以同时多播给整个目标主机族（通常是你的本地子网）。如果你发现你自己比较关心可靠性并且开始自己 解决消息的完整性了，那你可能应该开始使用TCP了。
记住，UDP数据报不是一个字节流，不应该那样处理。这使得使用内部有缓冲的I/O模型（如print()等）尤其困难。使用syswrite，或者更好的send()，像下面例子这样。
这里是一个像前面给出的网络TCP客户端的UDP程序。仅管如此，UDP版本的可以通过广播来异步地检测多个客户端，然后用select()做超时监视I/O，而不是在同一时刻只能监视一个主机。如果用TCP达到同样的效果，你不得不为不同的主机，使用一个不同的套接字句柄。
#!/usr/bin/perl -w
use strict;
use Socket;
use Sys::Hostname;
my ( $count, $hisiaddr, $hispaddr, $histime,
$host, $iaddr, $paddr, $port, $proto,
$rin, $rout, $rtime, $SECS_of_70_YEARS);
$SECS_of_70_YEARS = 2208988800;
$iaddr = gethostbyname(hostname());
$proto = getprotobyname('udp');
$port = getservbyname('time', 'udp');
$paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
bind(SOCKET, $paddr) || die "bind: $!";
$| = 1;
printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
$count = 0;
for $host (@ARGV) {
$count++;
$hisiaddr = inet_aton($host) || die "unknown host";
$hispaddr = sockaddr_in($port, $hisiaddr);
defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
}
$rin = '';
vec($rin, fileno(SOCKET), 1) = 1;
# timeout after 10.0 seconds
while ($count && select($rout = $rin, undef, undef, 10.0)) {
$rtime = '';
($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
($port, $hisiaddr) = sockaddr_in($hispaddr);
$host = gethostbyaddr($hisiaddr, AF_INET);
$histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
printf "%-12s ", $host;
printf "%8d %s\n", $histime - time, scalar localtime($histime);
$count--;
}
注意，这个示例没有包括任何重试或者可能发送到达不了的失败处理。这通常发生在发送端的主机要很大数目的主机要发送数据导致发送队列太大的时候。
SysV IPC
尽管System V IPC不如套接字那么广泛，但它仍然有一些有意思的用处。但是，你不能有效地使用Sysv IPC或者Berkeleymmap()来用共享内存来在多个服务进程间共享变量的目的。因为Perl会在你不需要的情况下，重新申请创建你的字符串。
这是一个展示共享内存的用法的小示例。
use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
$size = 2000;
$id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) || die "$!";
print "shm key $id\n";
$message = "Message #1";
shmwrite($id, $message, 0, 60) || die "$!";
print "wrote: '$message'\n";
shmread($id, $buff, 0, 60) || die "$!";
print "read : '$buff'\n";
# the buffer of shmread is zero-character end-padded.
substr($buff, index($buff, "\0")) = '';
print "un" unless $buff eq $message;
print "swell\n";
print "deleting shm $id\n";
shmctl($id, IPC_RMID, 0) || die "$!";
这是信号量的示例：
use IPC::SysV qw(IPC_CREAT);
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
print "shm key $id\n";
放这些代码到单独的文件中运行多个进程。Call the file take:
# create a semaphore
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 0 , 0 );
die if !defined($id);
$semnum = 0;
$semflag = 0;
# 'take' semaphore
# wait for semaphore to be zero
$semop = 0;
$opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
# Increment the semaphore count
$semop = 1;
$opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
$opstring = $opstring1 . $opstring2;
semop($id,$opstring) || die "$!";
放这些代码到单独的文件中运行多个进程。Call this file give:
# 'give' the semaphore
# run this in the original process and you will see
# that the second process continues
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 0, 0);
die if !defined($id);
$semnum = 0;
$semflag = 0;
# Decrement the semaphore count
$semop = -1;
$opstring = pack("s!s!s!", $semnum, $semop, $semflag);
semop($id,$opstring) || die "$!";
这节SysV IPC代码被写于很久以前，但它看起来挺好。为了看一看更现代的方法，阅读自从Perl 5.005开始包含的IPC::SysV模块。
这个简单的小示例展示了SysV的消息队列：
use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);
my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
my $sent = "message";
my $type_sent = 1234;
my $rcvd;
my $type_rcvd;
if (defined $id) {
if (msgsnd($id, pack("l!a*", $type_sent, $sent), 0)) {
if (msgrcv($id, $rcvd, 60, 0, 0)) {
($type_rcvd, $rcvd) = unpack("l!a*", $rcvd);
if ($rcvd eq $sent) {
print "okay\n";
} else {
print "not okay\n";
}
} else {
die "# msgrcv failed\n";
}
} else {
die "# msgsnd failed\n";
}
msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
} else {
die "# msgget failed\n";
}
摘要
大部分子过程在失败的情况下返回undef，它们可能导致你的程序死于一个没抓到的异常。（事实上，一些新的Socket族函数将在错误参数时croak()。）所以检测这些返回值很有必要。保持你的套接字程序到最成功，不要忘了加上-T标志给#!line for servers:
#!/usr/bin/perl -Tw
use strict;
use sigtrap;
use Socket;
疏误
All these routines create system-specific portability problems. As noted elsewhere, Perl is at the mercy of your C libraries for much of its system behaviour. It's probably safest to assume broken SysV semantics for signals and to stick with simple TCP and UDP socket operations; e.g., don't try to pass open file descriptors over a local UDP datagram socket if you want your code to stand a chance of being portable.
作者
Tom Christiansen, with occasional vestiges of Larry Wall's original version and suggestions from the Perl Porters.
译者
Alf <[email protected]>
其它
There's a lot more to networking than this, but this should get you started.
For intrepid programmers, the indispensable textbook is Unix Network Programming, 2nd Edition, Volume 1 by W. Richard Stevens (published by Prentice-Hall). Note that most books on networking address the subject from the perspective of a C programmer; translation to Perl is left as an exercise for the reader.
The IO::Socket(3) manpage describes the object library, and the Socket(3) manpage describes the low-level interface to sockets. Besides the obvious functions in perlfunc, you should also check out the modules file at your nearest CPAN site. (See perlmodlib or best yet, the Perl FAQ for a description of what CPAN is and where to get it.)
Section 5 of the modules file is devoted to "Networking, Device Control (modems), and Interprocess Communication", and contains numerous unbundled modules numerous networking modules, Chat and Expect operations, CGI programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet, Threads, and ToolTalk--just to name a few.
相关阅读 更多 +
