X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c47ff5f1a1ef5d0daccf1724400a446cd8e93573..c8d2171d9a4e444fcbc15a9762adc552285c7cab:/pod/perlipc.pod diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 3ddea3e..e591f54 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -121,11 +121,15 @@ signal handlers like this: $SIG{CHLD} = \&REAPER; # now do something that forks... -or even the more elaborate: +or better still: use POSIX ":sys_wait_h"; sub REAPER { my $child; + # If a second child dies while in the signal handler caused by the + # first death, we won't get another signal. So must loop here else + # we will leave the unreaped child as a zombie. And the next time + # two children die we get another zombie. And so on. while (($child = waitpid(-1,WNOHANG)) > 0) { $Kid_Status{$child} = $?; } @@ -234,8 +238,7 @@ prepared to clean up core dumps now and again. To forbid signal handlers altogether would bars you from many interesting programs, including virtually everything in this manpage, -since you could no longer even write SIGCHLD handlers. Their dodginess -is expected to be addresses in the 5.005 release. +since you could no longer even write SIGCHLD handlers. =head1 Using open() for IPC @@ -453,8 +456,8 @@ doesn't actually work: open(PROG_FOR_READING_AND_WRITING, "| some program |") -and if you forget to use the B<-w> flag, then you'll miss out -entirely on the diagnostic message: +and if you forget to use the C pragma or the B<-w> flag, +then you'll miss out entirely on the diagnostic message: Can't do bidirectional pipe at -e line 1. @@ -661,13 +664,14 @@ instead. BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } use Socket; use Carp; - $EOL = "\015\012"; + my $EOL = "\015\012"; sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $port = shift || 2345; my $proto = getprotobyname('tcp'); - $port = $1 if $port =~ /(\d+)/; # untaint port number + + ($port) = $port =~ /^(\d+)$/ or die "invalid port"; socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, @@ -703,14 +707,15 @@ go back to service a new client. BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } use Socket; use Carp; - $EOL = "\015\012"; + 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 = $1 if $port =~ /(\d+)/; # untaint port number + + ($port) = $port =~ /^(\d+)$/ or die "invalid port"; socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, @@ -723,10 +728,13 @@ go back to service a new client. my $waitedpid = 0; my $paddr; + use POSIX ":sys_wait_h"; sub REAPER { - $waitedpid = wait; + my $child; + while (($waitedpid = waitpid(-1,WNOHANG)) > 0) { + logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); + } $SIG{CHLD} = \&REAPER; # loathe sysV - logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); } $SIG{CHLD} = \&REAPER; @@ -744,6 +752,7 @@ go back to service a new client. 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: $!"; @@ -835,7 +844,7 @@ domain sockets can show up in the file system with an ls(1) listing. You can test for these with Perl's B<-S> file test: unless ( -S '/dev/log' ) { - die "something's wicked with the print system"; + die "something's wicked with the log system"; } Here's a sample Unix-domain client: @@ -863,6 +872,7 @@ to be on the localhost, and thus everything works right. use Carp; BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } + sub spawn; # forward declaration sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $NAME = '/tmp/catsock'; @@ -878,10 +888,13 @@ to be on the localhost, and thus everything works right. my $waitedpid; + use POSIX ":sys_wait_h"; sub REAPER { - $waitedpid = wait; + my $child; + while (($waitedpid = waitpid(-1,WNOHANG)) > 0) { + logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); + } $SIG{CHLD} = \&REAPER; # loathe sysV - logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); } $SIG{CHLD} = \&REAPER; @@ -899,6 +912,29 @@ to be on the localhost, and thus everything works right. }; } + 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(); + } + As you see, it's remarkably similar to the Internet domain TCP server, so much so, in fact, that we've omitted several duplicate functions--spawn(), logmsg(), ctime(), and REAPER()--which are exactly the same as in the @@ -922,7 +958,7 @@ For those preferring a higher-level interface to socket programming, the IO::Socket module provides an object-oriented approach. IO::Socket is included as part of the standard Perl distribution as of the 5.004 release. If you're running an earlier version of Perl, just fetch -IO::Socket from CPAN, where you'll also find find modules providing easy +IO::Socket from CPAN, where you'll also find modules providing easy interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just to name a few. @@ -950,7 +986,7 @@ looks like this: Here are what those parameters to the C constructor mean: -=over +=over 4 =item C @@ -1022,7 +1058,7 @@ something to the server before fetching the server's response. } The web server handing the "http" service, which is assumed to be at -its standard port, number 80. If your the web server you're trying to +its standard port, number 80. If the web server you're trying to connect to is at a different port (like 1080 or 8080), you should specify as the named-parameter pair, C<< PeerPort => 8080 >>. The C method is used on the socket because otherwise the system would buffer @@ -1145,7 +1181,7 @@ does nothing but listen on a particular port for incoming connections. It does this by calling the C<< IO::Socket::INET->new() >> method with slightly different arguments than the client did. -=over +=over 4 =item Proto @@ -1182,8 +1218,8 @@ clear out. Once the generic server socket has been created using the parameters listed above, the server then waits for a new client to connect -to it. The server blocks in the C method, which eventually an -bidirectional connection to the remote client. (Make sure to autoflush +to it. The server blocks in the C method, which eventually accepts a +bidirectional connection from the remote client. (Make sure to autoflush this handle to circumvent buffering.) To add to user-friendliness, our server prompts the user for commands. @@ -1245,6 +1281,11 @@ find yourself overly concerned about reliability and start building checks into your message system, then you probably should use just TCP to start with. +Note that UDP datagrams are I a bytestream and should not be treated +as such. This makes using I/O mechanisms with internal buffering +like stdio (i.e. print() and friends) especially cumbersome. Use syswrite(), +or better send(), like in the example below. + Here's a UDP program similar to the sample Internet TCP client given earlier. However, instead of checking one host at a time, the UDP version will check many of them asynchronously by simulating a multicast and then @@ -1295,6 +1336,11 @@ with TCP, you'd have to use a different socket handle for each host. $count--; } +Note that this example does not include any retries and may consequently +fail to contact a reachable host. The most prominent reason for this +is congestion of the queues on the sending host if the number of +list of hosts to contact is sufficiently large. + =head1 SysV IPC While System V IPC isn't so widely used as sockets, it still has some @@ -1305,16 +1351,16 @@ you weren't wanting it to. Here's a small example showing shared memory usage. - use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO); + use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU); $size = 2000; - $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!"; - print "shm key $key\n"; + $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!"; + print "shm key $id\n"; $message = "Message #1"; - shmwrite($key, $message, 0, 60) || die "$!"; + shmwrite($id, $message, 0, 60) || die "$!"; print "wrote: '$message'\n"; - shmread($key, $buff, 0, 60) || die "$!"; + shmread($id, $buff, 0, 60) || die "$!"; print "read : '$buff'\n"; # the buffer of shmread is zero-character end-padded. @@ -1322,16 +1368,16 @@ Here's a small example showing shared memory usage. print "un" unless $buff eq $message; print "swell\n"; - print "deleting shm $key\n"; - shmctl($key, IPC_RMID, 0) || die "$!"; + print "deleting shm $id\n"; + shmctl($id, IPC_RMID, 0) || die "$!"; Here's an example of a semaphore: use IPC::SysV qw(IPC_CREAT); $IPC_KEY = 1234; - $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!"; - print "shm key $key\n"; + $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!"; + print "shm key $id\n"; Put this code in a separate file to be run in more than one process. Call the file F: @@ -1339,8 +1385,8 @@ Call the file F: # create a semaphore $IPC_KEY = 1234; - $key = semget($IPC_KEY, 0 , 0 ); - die if !defined($key); + $id = semget($IPC_KEY, 0 , 0 ); + die if !defined($id); $semnum = 0; $semflag = 0; @@ -1348,14 +1394,14 @@ Call the file F: # 'take' semaphore # wait for semaphore to be zero $semop = 0; - $opstring1 = pack("sss", $semnum, $semop, $semflag); + $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag); # Increment the semaphore count $semop = 1; - $opstring2 = pack("sss", $semnum, $semop, $semflag); + $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag); $opstring = $opstring1 . $opstring2; - semop($key,$opstring) || die "$!"; + semop($id,$opstring) || die "$!"; Put this code in a separate file to be run in more than one process. Call this file F: @@ -1365,22 +1411,53 @@ Call this file F: # that the second process continues $IPC_KEY = 1234; - $key = semget($IPC_KEY, 0, 0); - die if !defined($key); + $id = semget($IPC_KEY, 0, 0); + die if !defined($id); $semnum = 0; $semflag = 0; # Decrement the semaphore count $semop = -1; - $opstring = pack("sss", $semnum, $semop, $semflag); + $opstring = pack("s!s!s!", $semnum, $semop, $semflag); - semop($key,$opstring) || die "$!"; + semop($id,$opstring) || die "$!"; The SysV IPC code above was written long ago, and it's definitely clunky looking. For a more modern look, see the IPC::SysV module which is included with Perl starting from Perl 5.005. +A small example demonstrating SysV message queues: + + use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU); + + my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU); + + my $sent = "message"; + my $type = 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"; + } + =head1 NOTES Most of these routines quietly but politely return C when they