just like a regular, connected anonymous pipes, except that the
processes rendezvous using a filename and don't have to be related.
-To create a named pipe, use the Unix command mknod(1) or on some
+To create a named pipe, use the C<POSIX::mkfifo()> function.
+
+ use POSIX qw(mkfifo);
+ mkfifo($path, 0700) or die "mkfifo $path failed: $!";
+
+You can also use the Unix command mknod(1) or on some
systems, mkfifo(1). These may not be in your normal path.
# system return val is backwards, so && not ||
chdir; # go home
$FIFO = '.signature';
- $ENV{PATH} .= ":/etc:/usr/games";
while (1) {
unless (-p $FIFO) {
unlink $FIFO;
- system('mknod', $FIFO, 'p')
- && die "can't mknod $FIFO: $!";
+ require POSIX;
+ POSIX::mkfifo($FIFO, 0700)
+ or die "can't mkfifo $FIFO: $!";
}
# next line blocks until there's a reader
pragmatic. The paranoid approach was to do as little as possible in your
signal handler. Set an existing integer variable that already has a
value, and return. This doesn't help you if you're in a slow system call,
-which will just restart. That means you have to C<die> to longjump(3) out
+which will just restart. That means you have to C<die> to longjmp(3) out
of the handler. Even this is a little cavalier for the true paranoiac,
who avoids C<die> in a handler because the system I<is> out to get you.
-The pragmatic approach was to say ``I know the risks, but prefer the
-convenience'', and to do anything you wanted in your signal handler,
+The pragmatic approach was to say "I know the risks, but prefer the
+convenience", and to do anything you wanted in your signal handler,
and be prepared to clean up core dumps now and again.
In Perl 5.7.3 and later to avoid these problems signals are
=over 4
-=item Long running opcodes
+=item Long-running opcodes
+
+As the Perl interpreter only looks at the signal flags when it is about
+to execute a new opcode, a signal that arrives during a long-running
+opcode (e.g. a regular expression operation on a very large string) will
+not be seen until the current opcode completes.
+
+N.B. If a signal of any given type fires multiple times during an opcode
+(such as from a fine-grained timer), the handler for that signal will
+only be called once after the opcode completes, and all the other
+instances will be discarded. Furthermore, if your system's signal queue
+gets flooded to the point that there are signals that have been raised
+but not yet caught (and thus not deferred) at the time an opcode
+completes, those signals may well be caught and deferred during
+subsequent opcodes, with sometimes surprising results. For example, you
+may see alarms delivered even after calling C<alarm(0)> as the latter
+stops the raising of alarms but does not cancel the delivery of alarms
+raised but not yet caught. Do not depend on the behaviors described in
+this paragraph as they are side effects of the current implementation and
+may change in future versions of Perl.
-As Perl interpreter only looks at the signal flags when it about to
-execute a new opcode if a signal arrives during a long running opcode
-(e.g. a regular expression operation on a very large string) then
-signal will not be seen until operation completes.
=item Interrupting IO
POSIX::SigAction->new(sub { die "alarm" }))
or die "Error setting SIGALRM handler: $!\n";
+Another way to disable the safe signal behavior locally is to use
+the C<Perl::Unsafe::Signals> module from CPAN (which will affect
+all signals).
+
=item Restartable system calls
On systems that supported it, older versions of Perl used the
=item Signals as "faults"
-Certain signals e.g. SEGV, ILL, BUS are generated as a result of
-virtual memory or other "faults". These are normally fatal and there
-is little a Perl-level handler can do with them. (In particular the
-old signal scheme was particularly unsafe in such cases.) However if
-a %SIG handler is set the new scheme simply sets a flag and returns as
-described above. This may cause the operating system to try the
-offending machine instruction again and - as nothing has changed - it
-will generate the signal again. The result of this is a rather odd
-"loop". In future Perl's signal mechanism may be changed to avoid this
-- perhaps by simply disallowing %SIG handlers on signals of that
-type. Until then the work-round is not to set a %SIG handler on those
-signals. (Which signals they are is operating system dependent.)
+Certain signals, e.g. SEGV, ILL, and BUS, are generated as a result of
+virtual memory or other "faults". These are normally fatal and there is
+little a Perl-level handler can do with them, so Perl now delivers them
+immediately rather than attempting to defer them.
=item Signals triggered by operating system state
The fork() has to come before the setsid() to ensure that you aren't a
process group leader (the setsid() will fail if you are). If your
system doesn't have the setsid() function, open F</dev/tty> and use the
-C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
+C<TIOCNOTTY> ioctl() on it instead. See tty(4) for details.
Non-Unix users should check their Your_OS::Process module for other
solutions.
my $paddr;
use POSIX ":sys_wait_h";
+ use Errno;
+
sub REAPER {
- my $child;
- while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
- logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
- }
- $SIG{CHLD} = \&REAPER; # loathe sysV
+ 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;
- for ( $waitedpid = 0;
- ($paddr = accept(Client,Server)) || $waitedpid;
- $waitedpid = 0, close Client)
- {
- 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), "]
- 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: $!";
- };
-
+ 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;
+ my $coderef = shift;
- unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
- confess "usage: spawn CODEREF";
- }
+ 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
+ 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();
+ 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();
}
-This server takes the trouble to clone off a child version via fork() for
-each incoming request. That way it can handle many requests at once,
-which you might not always want. Even if you don't fork(), the listen()
-will allow that many pending connections. Forking servers have to be
-particularly careful about cleaning up their dead children (called
-"zombies" in Unix parlance), because otherwise you'll quickly fill up your
-process table.
+This server takes the trouble to clone off a child version via fork()
+for each incoming request. That way it can handle many requests at
+once, which you might not always want. Even if you don't fork(), the
+listen() will allow that many pending connections. Forking servers
+have to be particularly careful about cleaning up their dead children
+(called "zombies" in Unix parlance), because otherwise you'll quickly
+fill up your process table. The REAPER subroutine is used here to
+call waitpid() for any child processes that have finished, thereby
+ensuring that they terminate cleanly and don't join the ranks of the
+living dead.
+
+Within the while loop we call accept() and check to see if it returns
+a false value. This would normally indicate a system error that needs
+to be reported. However the introduction of safe signals (see
+L</Deferred Signals (Safe Signals)> above) in Perl 5.7.3 means that
+accept() may also be interrupted when the process receives a signal.
+This typically happens when one of the forked sub-processes exits and
+notifies the parent process with a CHLD signal.
+
+If accept() is interrupted by a signal then $! will be set to EINTR.
+If this happens then we can safely continue to the next iteration of
+the loop and another call to accept(). It is important that your
+signal handling code doesn't modify the value of $! or this test will
+most likely fail. In the REAPER subroutine we create a local version
+of $! before calling waitpid(). When waitpid() sets $! to ECHILD (as
+it inevitably does when it has no more children waiting), it will
+update the local copy leaving the original unchanged.
We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
even if we aren't running setuid or setgid. This is always a good idea
my $rtime = ' ';
read(SOCKET, $rtime, 4);
close(SOCKET);
- my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
+ my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
printf "%8d %s\n", $histime - time, ctime($histime);
}
($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 ;
+ $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
printf "%-12s ", $host;
printf "%8d %s\n", $histime - time, scalar localtime($histime);
$count--;
Here's a small example showing shared memory usage.
- use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
+ use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
$size = 2000;
- $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
+ $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) || die "$!";
print "shm key $id\n";
$message = "Message #1";
A small example demonstrating SysV message queues:
- use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
+ use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);
- my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
+ my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
my $sent = "message";
my $type_sent = 1234;
https://perl5.git.perl.org / perl5.git / blobdiff