perlipc.pod中文版
名称perlipc - Perl的进程间通讯(信号、fifos、管道、安全子进程、套接字与信号量)
描述
Perl的基本的进程间通讯方法有旧式UNIX信号、命名管道、打开的管道、伯克利套接字以及SysV IPC调用。每一种都在不同的情形下有各自的应用。
信号
Perl使用一种简单的信号处理机制:哈希%SIG包含了信号的名字和用户安装的信号处理句柄。这些句柄将带着触发它的信号的名字为参数被调用。一个信号可能通常地从其它进程发送过来的一串键盘序列(如Control-C或者Control-Z)触发,或者自动地从相应的内核事件触发,比如一个子进程退出,你的进程超过了堆栈空间,或者达到了文件大小限制。
比如,为了捕获一个交互地的信号,像这样安装一个信号处理句柄:
sub catch_zap {
my $signame = shift;
$shucks++;
die "Somebody sent me a SIG$signame";
}
$SIG{INT} = 'cat_zap'; # 可能失败噢
$SIG{INT} = /&catch_zap; # 更好的策略
在Perl 5.7.3以前,在你的处理句柄中尽可能少的操作是必要的:你注意一下我们所做的所有操作,就是设置一下全局变量然后触发一个异常。那是因为,在很多系统里,库是不可重入的:尤其内存申请及IO处理不是。那意味着,在你的处理回调句柄里做任何事情,都可能触发一个内存错误或者接下来的崩溃-看安全信号。
信号名字可以在你的系统上由命令kill -l列出,或者从Config模块获取它们。设置一个以数字为索引的@signame列表来得到名字,一个以名字为索引的%signo哈希数组来得到数字。
use Config;
defined $Config{sig_name} || die "No sigs?";
foreach $name (split(' ', $Config{sig_name})) {
$signo{$name} = $i;
$signame[$i] = $name;
$i++;
}
为了检查信号17与SIGALARM是否一样,这样做:
print "signal #17 = $signame[17]/n";
if ($signo{ALRM}) {
print "SIGALRM is $signo{ALRM}/n";
}
你也可以选择字符串'IGNORE'或者'DEFAULT'做为句柄,这样,Perl将尝试忽略信号或者做默认处理。
在很多UNIX平台上,CHLD(有时为CLD)信号被赋与'IGNORE'值时有特别地行为。在这类系统上,设置$SIG{CHLD}为'IGNORE'具有当父进程wait()它的子进程失败时不创建僵尸进程的效果(或者说,子进程被自动地回收)。在这样的系统上,设置$SIG{CHLD}为'IGNORE'的进程调用wait()通常返回-1。
一些信号可以既不被捕获也不被忽略,比如KILL和STOP(但不是TSTP)信号。为了暂时忽略信号,一种策略是使用local()语句,这可以使得你的块结束的时候,信号被恢复。(记住:local()变量是会被块内调用的函数继承的。)
sub precious {
local $SIG{INT} = 'IGNORE';
&more_functions;
}
sub more_functions {
# 中断仍然被忽略着呢……
}
发送一个信号给一个负的进程ID意味着你发送这个信号给整个Unix进程组。这块代码发送hang-up信号给自己所在的进程组的所有进程(设置$SIG{HUP}为IGNORE,所以它不会杀掉自身):
{
local $SIG{HUP} = 'IGNORE';
kill HUP => -$$;
# 比用:kill('HUP', -$$)更优美的书写
}
另一个有趣的信号是数字0。这不会对子进程有任何操作,但是会检查它是否还存活着或者它的进程UID改变过。
unless (kill 0 => $kid_pid) {
warn "something wicked happened to $kid_pid";
}
当直接在一个UID不是发送信号的UID的进程内发送信号0时会失败。因为你没有权限给它发信号,尽管这个进程还活着。你可以可以通过%!判断失败的原因。
unless (kill 0 => $pid or $!{EPERM}) {
warn "$pid looks dead";
}
你也可能希望对简单的信号处理句柄注册匿名函数:
$SIG{INT} = sub { die "/nOutta here!/n" };
但是对于用来重新注册它们的更加复杂的句柄将会有问题。因为Perl的信号机制,是基于C库的signal(3)函数,你在一些系统上可能有时会不幸地失败,即,它的行为是老的SysV式的而不是新的、更加合理的BSD和POSIX方式的。所以,你有时看到保守的人们像这样书写信号句柄:
sub REAPER {
$waitedpid = wait;
# 恶心的sysV: 它使得我们不能恢复
# 这个信号, 但是把它放在wait后面。
$SIG{CHLD} = /&REAPER;
}
$SIG{CHLD} = /&REAPER;
# 现在开始做创建后的事情……
或者更加好:
use POSIX ":sys_wait_h";
sub REAPER {
my $child;
# 如果第1个子进程死亡的引起的信号处理,导致了
# 第2个子进程的结束,我们不会收到第2个信号。所以我们必须循环,或者
# 留下这个子进程做为一个僵尸进程。于是下一次
# 2个子进程死亡我们又得了一个僵尸进程。等等等等。while (($child = waitpid(-1,WNOHANG)) > 0) {
$Kid_Status{$child} = $?;
}
$SIG{CHLD} = /&REAPER; # 仍然是讨厌的sysV
}
$SIG{CHLD} = /&REAPER;
# 开始做创建后的事情……
信号处理也用在Unix的超时操作中,比如,你在一个被安全保护的eval{}块中设置一个信号来捕获超时信号来实现一些时间后调度特定的操作。 然后你阻塞你的操作,在你从你的eval{}块中退出前清除超时信号。如果它失控了,你将使用die()来跳出你的块,就像你在其它语言中使用longjmp()或者throw()。
看一个例子:
eval {
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm 10;
flock(FH, 2); # blocking write lock
alarm 0;
};
if ($@ and $@ !~ /alarm clock restart/) { die }
如果这个超时了的操作是system()或者qx(),这个技巧可以避免创建僵尸进程。如果这符合你的需求,你将需要自己fork()然后exec(),然后杀掉重入的子进程。
对于更复杂的信号处理,你应该看标准的POSIX模块。抱歉,这几乎没有文档,但是Perl源发行包中的t/lib/posix.t文件中有一些例子。
处理后台程序的SIGHUP信号
一个通常在系统启动时启动、在系统关闭时停止的进程叫做精灵进程(Disk And Execution MONitor)。如果一个精灵进程有一个配置文件在进程启动后被改变了,应该有一种方法来告诉这个进程在不停止进程的情况下重读它的配置文件。许多精灵进程用SIGHUP信号提供了这个机制。当你想告诉精灵重读文件时,你只需发送一个SIGHUP信号给它。
并不是所有的平台都会在一个信号被执行后重新安装它们内置的信号。这意味着这个机制只能在第一次信号发送时很好地工作。这个问题的解决方法是尽量使用POSIX信号处理,它们的行为更加精确。
下面的例子实现了一个简单的精灵,每次收到一个SIGHUP信号时它将重启自身。实际的代码在子过程<c13>code()里,它只为了表示它在工作以及它将被实际地代码替换打印一点调试信息。
#!/usr/bin/perl -w
use POSIX ();
use FindBin ();
use File::Basename ();
use File::Spec::Functions;
$|=1;
# 为了使精灵跨平台运行, exec总是使用正确的路径调用这个脚本
# 自身, 不用关心这个脚本是如何被执行起来的。 my $script = File::Basename::basename($0);
my $SELF = catfile $FindBin::Bin, $script;
# POSIX unmasks the sigprocmask properly
my $sigset = POSIX::SigSet->new();
my $action = POSIX::SigAction->new('sigHUP_handler',
$sigset,
&POSIX::SA_NODEFER);
POSIX::sigaction(&POSIX::SIGHUP, $action);
sub sigHUP_handler {
print "got SIGHUP/n";
exec($SELF, @ARGV) or die "Couldn't restart: $!/n";
}
code();
sub code {
print "PID: $$/n";
print "ARGV: @ARGV/n";
my $c = 0;
while (++$c) {
sleep 2;
print "$c/n";
}
}
__END__
命名管道
命名管理(通常称为FIFO)是一种为了在本机进程间通信的古老的UNIX IPC机制。它工作起来就像通常连接起来的匿名管道,但是进程间通过一个文件名来共享它而不用进程相关。
为了创建命名管道,使用POSIX::mkfifo()函数。
use POSIX qw(mkfifo);
mkfifo($path, 0700) or die "mkfifo $path failed: $!";
你也可以使用Unix命令mknod(1)或者其它系统的mkfifo(1)。这些可能不在你的常规的目录下。
# 失败时返回非0,所以得用&&而不是||
#
$ENV{PATH} .= ":/etc:/usr/etc";
if ( system('mknod', $path, 'p')
&& system('mkfifo', $path) )
{
die "mk{nod,fifo} $path failed";
}
当你希望连接一个自己无关的进程时,一个fifo比较方便。当你使用fifo时,这个程序将阻塞,直到另一端有什么东西。
比如,你有你自己的.signature文件为命名管道,有一个Perl程序在另一端。现在每次有任何程序(像一个mailer、news reader、finger 程序……)尝试从这个文件读的时候,读程序将会阻塞直到你的程序提供新的signature。我们将使用管道检测参数-p来确定是否有人(或者其它)突然删除了我们的fifo。
chdir; # go home
$FIFO = '.signature';
while (1) {
unless (-p $FIFO) {
unlink $FIFO;
require POSIX;
POSIX::mkfifo($FIFO, 0700)
or die "can't mkfifo $FIFO: $!";
}
# 下一行阻塞,直到有一个人来读
open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
print FIFO "John Smith (smith/@host.org)/n", `fortune -s`;
close FIFO;
sleep 2;# to avoid dup signals
}
延迟信号(安全信号)
在Perl 5.7.3以前,使用Perl代码来处理信号。由于两点原因,把你自己放在了危险之中。首先,很少的系统库函数是可重入的。如果Perl正在执行着一个函数(如malloc(3)或者printf(3))时,信号打断了,然后你的信号处理函数调用了同样的函数,你可能得到难以料到的结果-通常,是一个崩溃。其次,在较底层上,Perl自身也不是可重入的。如果Perl正在改变着它内部的数据结构,信号打断了,结果一样难以料到。
有两种态度你可以选择,即:保守或者激进。保守是说在信号处理中,尽可能少执行操作。设置一个已经有值的变量一个值,然后返回。如果你在一个比较慢的可能会重试的系统调用中,这仍然帮不了你。这意味着你不得不使用die来longjmp(3)出你的处理函数。尽管这着实有一些过于保守了,但可以防止系统除去你而避免die在一个句柄中。激进是说,“我知道风险,但是我不管”,并且在信号处理中做任意操作,然后一次一次地清除崩溃文件。
在Perl5.7.3以及更新的版本中,避免这些问题是“延迟”-当系统发送信号给进程时(给实现Perl的C代码)一个变量被设置,然后处理马上返回。然后在一个Perl解释器安全的时机(比如,当它要解释一个新的字节码时)这个变量被检查,然后%SIG里的Perl级别的处理被执行。这种“延迟”机制允许在信号处理的代码中有更复杂的处理,因为我们知道Perl解释器在一个安全的状态,当信号处理被调用时,我们没有在系统库里。Perl里的实现跟以前具有如下的不同:
长运行的字节码
当Perl解释器将要执行新的字节码时,它只查看当前的信号标志,一个长运行的字节码(比如在一个很长的字符串上执行一个正则表达式)将不会看到它直到当前的字节码执行完毕。
N.B.如果一个信号在一个字节码执行间触发了多次,这个信号的处理只会在字节码执行完毕后被调用一次,然后所有的其它实例被丢弃。而且,如果这时候你的系统信号队列满了,有更多的信号触发了但没有捕获(没有延迟)的时候,这些信号可以少被捕获一些其余延迟到下一个字节码,当然,有时结果会有点怪。举个例子,在调用alarm(0)后发送的alarms信号不会停止,这时它不阻止新的alarms被触发,但是没有捕获它们。不要依赖这节中描述的行为做为当前或者以后的Perl实现的结果来考虑。
可中断IO
当一个信号被发送的时候(比如,INT control-C),操作系统阻塞在如read的IO操作上(用来实现Perl的<>操作)。在老的Perl中,这个处理被马上调用(如read不是不安全)。有了“延迟”机制,句柄不会马上被调用,如果Perl正在使用系统的stdio库,这个库会在没有给Perl一个机会来调用%SIG的处理的情况下,重试read操作。 如果这发生在你的系统上,它正用着:perlio层来处理IO-最少这些用在你希望信号调用的句柄上。 :perlio层会在恢复IO操作前检查信号标志来调用%SIG句柄)。
注意默认的5.7.3及更新的Perl自动的使用:perlio层。
还要注意,一些像gethostbyname()的网络库函数有他们自己的超时机制可能会跟你自己的超时冲突。如果你使用这些函数有问题,你可以尝试POSIX的sigaction()函数,它绕过了Perl的安全信号(这并意味着你可能会有内存方面的问题)。不是设置$SIG{ALRM}:
local $SIG{ALRM} = sub { die "alarm" };
试试下面:
use POSIX qw(SIGALRM);
POSIX::sigaction(SIGALRM,
POSIX::SigAction->new(sub { die "alarm" })) or die "Error setting SIGALRM handler: $!/n";
不使用安全信号行为的另一种方法是使用CPAN的Perl::Unsafe::Signals模块(它将影响所有的信号)。
可重启的系统调用
在支持这个的系统上,老版本的Perl在安装%SIG句柄的时候,使用SA_RESTART标志。这意味着可重启的系统调用在信号到来时会继续而不是返回。为了发送延迟的信号,Perl 5.7.3以及更新的版本不会使用SA_RESTART。因此,在以前会成功的可重启的系统调用这时会失败。$!会设为EINTR)。
注意,默认地:perlio层会如前所述重试read、write和close,而可中断的wait和waitpid调用会一直重试。
做为错误的信号
一些信号,如SEGV、ILL和BUG,通常在虚拟内存或者有其它错误的时候被创建为一种结果。存在正常错误,但是只有很少的Perl层的处理可以对付他们,所以现在Perl只马上发送它们而不是处理他们。
由操作系统触发的信号
在一些操作系统上,返回以前可以发送一些特定的信号。一个例子是CHLD或者CLD表示一个子进程执行完毕了。 在一些操作系统上,信号处理希望wait到子进程处理完毕。 在这些系统上,延迟信号机制将对这些信号(它们不对wait工作)不起作用。又一次的错误看起来像是操作系统将重试作为没有等待完毕的子进程的循环。
如果你想老的信号的行为出现在内存错误上,设置环境变量PERL_SIGNALS为"unsafe"。(Perl 5.8.1以后的新功能)。
为IPC使用open()
Perl的基本的open()语法也可以通过输出或者输入一个管道符做为第二个参数实现单向的进程间通信。这示范了如何打开一个子进程用来写入:
open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
|| die "can't fork: $!";
local $SIG{PIPE} = sub { die "spooler pipe broke" };
print SPOOLER "stuff/n";
close SPOOLER || die "bad spool: $!$?";
而这示范了如何打开一个子进程用于读出:
open(STATUS, "netstat -an 2>&1 |")
|| die "can't fork: $!";
while (<STATUS>) {
next if /^(tcp|udp)/;
print;
}
close STATUS || die "bad netstat: $!$?";
如果他能确定一个严格的程序是一个文件名在@ARGV中的Perl脚本,聪明的程序员会写成这样:
% program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
不管从什么shell调用,这个Perl程序将从文件f1、命令cmd1,标准输入(在这里重定向为tmpfile)、文件f2、命令cmd2以及文件f3读取。非常漂亮,是吧?
你可能注意到了,你可以使用反斜线达到打开管道来读的效果。
print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
die "bad netstat" if $?;
仅管表面上看是这样,但每次在一个时刻处理一个文件的一行或者一个记录是更有效的,因为你不用非得把整个文件读入内存。它也给了你整个的程序的最终的控制权,让你可以如你所愿地杀掉子进程。
小心地检查open()和close()的返回值。如果你正在写向一个管道,你应该捕获SIGPIPE。或者,想想看,当你打开一个指向一个不存在的程序的管道时:open()将会直接成功(它只表明fork()成功了),但是你的输出将失败-真不幸。Perl不能知道是否一个命令工作了因为你的命令工作在一个分开的进程里,那里的exec()可能失败。所以,当从一个无效的命令读取的时候只会马上得到一个文件结束,向一个无效的命令写入将会导致一个他们准备好处理的信号。建议:
open(FH, "|bogus") or die "can't fork: $!";
print FH "bang/n" or die "can't write: $!";
close FHor die "can't close: $!";
直到close,这不会失败,而且它会导致SIGPIPE。为了捕获它,你可以这样:
$SIG{PIPE} = 'IGNORE';
open(FH, "|bogus") or die "can't fork: $!";
print FH "bang/n" or die "can't write: $!";
close FHor die "can't close: status=$?";
文件句柄
主进程和它的所有子进程共享相同的STDIN、STDOUT和STDERR文件句柄。如果进程同时尝试访问它们,结果是未定的。你可能也想知道关闭或者重新打开子进程的文件句柄。你可以通过open()打开你的管道得到这个,但是在一些系统上这意味着子进程不能脱离父进程而存活。
后台程序
你可以这样在后台运行一个命令:
system("cmd &");
这个命令的STDOUT和STDERR(可能有STDIN,取决于你的shell)将会与父进程一样。你不用捕获SIGCHLD因为两次fork取代了(看下面的细节)。
父进程创建的子进程的完全分离
在一些情形下(启动服务程序),你想从父进程完全脱离出子进程。这通常叫做精灵化。一个好的精灵还将chdir()到root目录(所以它不会阻止停止挂载它启动目录的分区),然后重定向标准文件描述符到/dev/null(所以随机的输出不会扰乱用户的终端)。
use POSIX 'setsid';
sub daemonize {
chdir '/' or die "Can't chdir to /: $!";
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null'
or die "Can't write to /dev/null: $!";
defined(my $pid = fork) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}
为了保证你不是一个进程组的头目,fork()不得不在setsig()之前(如果你是,setsid()会失败)。如果你的系统涮有setsid()函数,打开/dev/tty,在它上执行TIOCNOTIYioctl()代替。 看tty(4)获得详细信息。
Non-Unix用户应用查看他们的Your_OS::Process模块得到其它解决方法。
安全管道的打开
另一个有意思的IPC通信方法,是使你的单个程序进入多进程,你自己在多进程间进行通讯。open()函数将会接受一个"-|"或者"|-"做为文件的参数来做一些非常有意思的事情:它创建了一个子进程连接在了你打开的文件句柄上。这个子进程运行着如同它的父进程一样的程序。这对于正在运行在一个虚假的UDI或者GID下时,安全地打开一个文件很有用。如果你向减号打开一个管道,你可以向这个打开的文件句柄写入,此时子进程会在标准输入得到它们。如果你从减号打开一个管道,你可以从这个打开的文件句柄读取子进程写向标准输出的数据。
use English '-no_match_vars';
my $sleep_count = 0;
do {
$pid = open(KID_TO_WRITE, "|-");
unless (defined $pid) {
warn "cannot fork: $!";
die "bailing out" if $sleep_count++ > 6;
sleep 10;
}
} until defined $pid;
if ($pid) { # parent
print KID_TO_WRITE @some_data;
close(KID_TO_WRITE) || warn "kid exited $?";
} else { # child
($EUID, $EGID) = ($UID, $GID); # suid progs only
open (FILE, "> /safe/file")
|| die "can't open /safe/file: $!";
while (<STDIN>) {
print FILE; # child's STDIN is parent's KID
}
exit; #不要忘了这个
}
这个构造的另一个普遍应用是当你想执行一些东西,但却没有SHELL接口的时候。用system(),这挺直接,但是你不能安全地使用一个管道。因为没有办法来从它正在执行你的参数的时候,停止SHELL的执行。而是,使用低层次的控制来直接调用exec()。
这是一个安全保护的读取管道:
# add error processing as above
$pid = open(KID_TO_READ, "-|");
if ($pid) { # parent
while (<KID_TO_READ>) {
# do something interesting
}
close(KID_TO_READ) || warn "kid exited $?";
} else { # child
($EUID, $EGID) = ($UID, $GID); # suid only
exec($program, @options, @args)
|| die "can't exec program: $!";
# NOTREACHED
}
这是一个安全的打开用来写入的管道:
# add error processing as above
$pid = open(KID_TO_WRITE, "|-");
$SIG{PIPE} = sub { die "whoops, $program pipe broke" };
if ($pid) { # parent
for (@data) {
print KID_TO_WRITE;
}
close(KID_TO_WRITE) || warn "kid exited $?";
} else { # child
($EUID, $EGID) = ($UID, $GID);
exec($program, @options, @args)
|| die "can't exec program: $!";
# NOTREACHED
}
从Perl 5.8.0开始,你也可以使用列表等式的open语法来操作管道:语法
open KID_PS, "-|", "ps", "aux" or die $!;
创建了一个ps(1)命令(没有交互shell,但是有多于三个的选项传给了open()),然后从文件句柄KID_PS读取它的标准输出。对应的用来写入的管道的语法(用"|-"来代替"-|")也实现了。
补充一下,这些操作都是Unix族的分离,即它们有可能在其它系统实现上失败。另外,没有真正地多线程。如果你想多了解一些关于线程的东西,看下面SEE ALSO部分提到的modules文件。
与其它进程双向通信
现在,这对于单向的通讯不错,可是如何实现双向的通讯呢?明显的,你想这样做,但是不成:
open(PROG_FOR_READING_AND_WRITING, "| some program |")
如果你忘记了使用use warnings或者-w选项,你将会得到这样的错误结果:
Can't do bidirectional pipe at -e line 1.
如果你真的想做,你可以使用标准的open2()库函数来连接上两端。并且,为了完全地I/O控制所以你想截获标准错误,也有一个open3()。但是,那样做需要一个select()循环来允许你使用标准的Perl输入操作。
如果你查看它的源代码,你将会看到open2()使用了低层次的像Unix的pipe()和exec()的调用来创建了所有的连接。而如果使用socketpair()则会有些微地性能提升,它也会更小巧一点。open2()和open3()函数并不能在除了Unix或者其它的遵循POSIX的系统上工作的很好。
这是使用open2()的例子:
use FileHandle;
use IPC::Open2;
$pid = open2(*Reader, *Writer, "cat -u -n" );
print Writer "stuff/n";
$got = <Reader>;
这程序的问题是,Unix的缓冲区会使得问题比较复杂。尽管你的Writer</C0>文件句柄是自动缓冲的,另一端的进程也可能及时地收到你的数据,你不能强制地要求它在你的请求中快速返回。在这种情况下,我们可以,给cat一个-u选项来使它不缓冲。但是只有很少地Unix命令是定义为通过管道的,所以这个方法只能工作在你自己写的能通过管道的程序上。
一个解决方法是使用不标准的Comm.pl库。它使用虚拟终端来使你程序的行为更合理。
require 'Comm.pl';
$ph = open_proc('cat -n');
for (1..10) {
print $ph "a line/n";
print "got back ", scalar <$ph>;
}
使用这个方法,你不用再不得不自己控制你使用的程序的源代码。Comm库也支持expect()和interact()函数。你可以在下面的SEE ALSO块里提到的最近的CPAN归档上找到这个库(我们希望它的IPC::Chat)。
CPAN上的更新的Expect.pm模块也能干这个事儿。这个模块需要CPAN上的IO::Pty和IO::Stty两个模块。它设置一个虚拟终端来和你的程序交互,使得如同与一个真实的设备驱动的终端交谈一样。如果你的系统都支持,这可能是你的万幸。
与自身双向通信
如果你想,你可以使用低层次的pipe()和fork()来手动组合。这个例子只是和自己交互,但是你可以重新打开文件句柄来操作标准输入、标准输出或者调用其它进程。
#!/usr/bin/perl -w
# pipe1 - bidirectional communication using two pipe pairs
# designed for the socketpair-challenged
use IO::Handle; # thousands of lines just for autoflush :-(
pipe(PARENT_RDR, CHILD_WTR);# XXX: failure?pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?CHILD_WTR->autoflush(1);
PARENT_WTR->autoflush(1);
if ($pid = fork) {
close PARENT_RDR; close PARENT_WTR;
print CHILD_WTR "Parent Pid $$ is sending this/n";
chomp($line = <CHILD_RDR>);
print "Parent Pid $$ just read this: `$line'/n";
close CHILD_RDR; close CHILD_WTR;
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close CHILD_RDR; close CHILD_WTR;
chomp($line = <PARENT_RDR>);
print "Child Pid $$ just read this: `$line'/n";
print PARENT_WTR "Child Pid $$ is sending this/n";
close PARENT_RDR; close PARENT_WTR;
exit(1);
}
但是你实在不用做两次pipe调用。如果你使用socketpair()系统调用,它将会为你做好这些。
#!/usr/bin/perl -w
# pipe2 - bidirectional communication using socketpair
# "the best ones always go both ways"
use Socket;
use IO::Handle; # thousands of lines just for autoflush :-(
# We say AF_UNIX because although *_LOCAL is the
# POSIX 1003.1g form of the constant, many machines
# still don't have it.
socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
or die "socketpair: $!";
CHILD->autoflush(1);
PARENT->autoflush(1);
if ($pid = fork) {
close PARENT;
print CHILD "Parent Pid $$ is sending this/n";
chomp($line = <CHILD>);
print "Parent Pid $$ just read this: `$line'/n";
close CHILD;
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close CHILD;
chomp($line = <PARENT>);
print "Child Pid $$ just read this: `$line'/n";
print PARENT "Child Pid $$ is sending this/n";
close PARENT;
exit(1);
}
套接字:客户端/服务器通信
不受限于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 root0 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命令可以显示当前运行着的服务。
Listen
Listen选项用来设置我们在接受传入连接以前可以缓冲的连接数目。想象它一下,就像你的电话的等待队列。低层次的Socket模块,有一个特别的符号SOMAXCONN表示系统最大值。
Reuse
Reuse选项用来避免我们手动重启服务时,要经过好长的时间等待清除系统缓存。
一旦这个普通的服务套接字被上面的参数创建成功,它就等待着新的客户端来连接了。这个服务器阻塞在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 notedelsewhere, Perl is at the mercy of your C libraries for much of its systembehaviour. It's probably safest to assume broken SysV semantics forsignals and to stick with simple TCP and UDP socket operations; e.g., don'ttry to pass open file descriptors over a local UDP datagram socket if youwant 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 <naihe2010@gmail.com>
其它
There's a lot more to networking than this, but this should get youstarted.
For intrepid programmers, the indispensable textbook is UnixNetwork Programming, 2nd Edition, Volume 1 by W. Richard Stevens(published by Prentice-Hall). Note that most books on networkingaddress the subject from the perspective of a C programmer; translationto 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 obviousfunctions in perlfunc, you should also check out the modules fileat your nearest CPAN site. (See perlmodlib or best yet, the PerlFAQ 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 unbundledmodules numerous networking modules, Chat and Expect operations, CGIprogramming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,Threads, and ToolTalk--just to name a few.
本文源自:互联网
原文参考:http://perldoc.perl.org/perlipc.html