You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
the handler, in which case Perl will try to discard the signal or do the
-default thing. Some signals can be neither trapped nor ignored, such as
+default thing.
+
+On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
+has special behavior with respect to a value of C<'IGNORE'>.
+Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
+not creating zombie processes when the parent process fails to C<wait()>
+on its child processes (i.e. child processes are automatically reaped).
+Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
+C<-1> on such platforms.
+
+Some signals can be neither trapped nor ignored, such as
the KILL and STOP (but not the TSTP) signals. One strategy for
temporarily ignoring signals is to use a local() statement, which will be
automatically restored once your block is exited. (Remember that local()
$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;
- while ($child = waitpid(-1,WNOHANG)) {
+ # 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} = $?;
}
$SIG{CHLD} = \&REAPER; # still loathe sysV
};
if ($@ and $@ !~ /alarm clock restart/) { die }
+If the operation being timed out is system() or qx(), this technique
+is liable to generate zombies. If this matters to you, you'll
+need to do your own fork() and exec(), and kill the errant child process.
+
For more complex signal handling, you might see the standard POSIX
module. Lamentably, this is almost entirely undocumented, but
the F<t/lib/posix.t> file from the Perl source distribution has some
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
While this is true on the surface, it's much more efficient to process the
file one line or record at a time because then you don't have to read the
-whole thing into memory at once. It also gives you finer control of the
+whole thing into memory at once. It also gives you finer control of the
whole process, letting you to kill off the child process early if you'd
like.
Both the main process and any child processes it forks share the same
STDIN, STDOUT, and STDERR filehandles. If both processes try to access
-them at once, strange things can happen. You'll certainly want to any
-stdio flush output buffers before forking. You may also want to close
+them at once, strange things can happen. You may also want to close
or reopen the filehandles for the child. You can get around this by
opening your pipe with open(), but on some systems this means that the
child process cannot outlive the parent.
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<use warnings> 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.
use FileHandle;
use IPC::Open2;
$pid = open2(*Reader, *Writer, "cat -u -n" );
- Writer->autoflush(); # default here, actually
print Writer "stuff\n";
$got = <Reader>;
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,
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,
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;
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: $!";
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:
use Carp;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
+ sub spawn; # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $NAME = '/tmp/catsock';
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;
};
}
+ 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
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.
Here are what those parameters to the C<new> constructor mean:
-=over
+=over 4
=item C<Proto>
}
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 =E<gt> 8080>. The C<autoflush>
+as the named-parameter pair, C<
< PeerPort => 8080 >>. The C<autoflush>
method is used on the socket because otherwise the system would buffer
up the output we sent it. (If you're on a Mac, you'll also need to
change every C<"\n"> in your code that sends data over the network to
As always, setting up a server is little bit more involved than running a client.
The model is that the server creates a special kind of socket that
does nothing but listen on a particular port for incoming connections.
-It does this by calling the C<IO::Socket::INET-E<gt>new()> method with
+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
superuser.) In our sample, we'll use port 9000, but you can use
any port that's not currently in use on your system. If you try
to use one already in used, you'll get an "Address already in use"
-message. Under Unix, the C<netstat -a> command will show
+message. Under Unix, the C<netstat -a> command will show
which services current have servers.
=item Listen
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<accept> method, which eventually an
-bidirectional connection to the remote client. (Make sure to autoflush
+to it. The server blocks in the C<accept> 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.
This server accepts one of five different commands, sending output
back to the client. Note that unlike most network servers, this one
only handles one incoming client at a time. Multithreaded servers are
-covered in Chapter 6 of the Camel as well as later in this manpage.
+covered in Chapter 6 of the Camel.
Here's the code. We'll
into your message system, then you probably should use just TCP to start
with.
+Note that UDP datagrams are I<not> 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
$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
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.
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<take>:
# 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;
# '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<give>:
# 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<undef> when they
https://perl5.git.perl.org / perl5.git / blobdiff