=head1 Signals
-Perl uses a simple signal handling model: the %SIG hash contains names or
-references of user-installed signal handlers. These handlers will be called
-with an argument which is the name of the signal that triggered it. A
-signal may be generated intentionally from a particular keyboard sequence like
-control-C or control-Z, sent to you from another process, or
-triggered automatically by the kernel when special events transpire, like
-a child process exiting, your process running out of stack space, or
-hitting file size limit.
-
-For example, to trap an interrupt signal, set up a handler like this.
-Do as little as you possibly can in your handler; notice how all we do is
-set a global variable and then raise an exception. That's because on most
-systems, libraries are not re-entrant; particularly, memory allocation and
-I/O routines are not. That means that doing nearly I<anything> in your
-handler could in theory trigger a memory fault and subsequent core dump.
+Perl uses a simple signal handling model: the %SIG hash contains names
+or references of user-installed signal handlers. These handlers will
+be called with an argument which is the name of the signal that
+triggered it. A signal may be generated intentionally from a
+particular keyboard sequence like control-C or control-Z, sent to you
+from another process, or triggered automatically by the kernel when
+special events transpire, like a child process exiting, your process
+running out of stack space, or hitting file size limit.
+
+For example, to trap an interrupt signal, set up a handler like this:
sub catch_zap {
my $signame = shift;
$SIG{INT} = 'catch_zap'; # could fail in modules
$SIG{INT} = \&catch_zap; # best strategy
+Prior to Perl 5.7.3 it was necessary to do as little as you possibly
+could in your handler; notice how all we do is set a global variable
+and then raise an exception. That's because on most systems,
+libraries are not re-entrant; particularly, memory allocation and I/O
+routines are not. That meant that doing nearly I<anything> in your
+handler could in theory trigger a memory fault and subsequent core
+dump - see L</Deferred Signals (Safe Signals)> below.
+
The names of the signals are the ones listed out by C<kill -l> on your
system, or you can retrieve them from the Config module. Set up an
@signame list indexed by number to get the name and a %signo table
the handler, in which case Perl will try to discard the signal or do the
default thing.
-On most UNIX platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
+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()>
}
Another interesting signal to send is signal number zero. This doesn't
-actually affect another process, but instead checks whether it's alive
+actually affect a child process, but instead checks whether it's alive
or has changed its UID.
unless (kill 0 => $kid_pid) {
warn "something wicked happened to $kid_pid";
}
+When directed at a process whose UID is not identical to that
+of the sending process, signal number zero may fail because
+you lack permission to send the signal, even though the process is alive.
+You may be able to determine the cause of failure using C<%!>.
+
+ unless (kill 0 => $pid or $!{EPERM}) {
+ warn "$pid looks dead";
+ }
+
You might also want to employ anonymous functions for simple signal
handlers:
But that will be problematic for the more complicated handlers that need
to reinstall themselves. Because Perl's signal mechanism is currently
based on the signal(3) function from the C library, you may sometimes be so
-misfortunate as to run on systems where that function is "broken", that
+unfortunate as to run on systems where that function is "broken", that
is, it behaves in the old unreliable SysV way rather than the newer, more
reasonable BSD and POSIX fashion. So you'll see defensive people writing
signal handlers like this:
sub REAPER {
$waitedpid = wait;
- # loathe sysV: it makes us not only reinstate
+ # loathe SysV: it makes us not only reinstate
# the handler, but place it after the wait
$SIG{CHLD} = \&REAPER;
}
$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
+ $SIG{CHLD} = \&REAPER; # still loathe SysV
}
$SIG{CHLD} = \&REAPER;
# do something that forks...
};
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
examples in it.
+=head2 Handling the SIGHUP Signal in Daemons
+
+A process that usually starts when the system boots and shuts down
+when the system is shut down is called a daemon (Disk And Execution
+MONitor). If a daemon process has a configuration file which is
+modified after the process has been started, there should be a way to
+tell that process to re-read its configuration file, without stopping
+the process. Many daemons provide this mechanism using the C<SIGHUP>
+signal handler. When you want to tell the daemon to re-read the file
+you simply send it the C<SIGHUP> signal.
+
+Not all platforms automatically reinstall their (native) signal
+handlers after a signal delivery. This means that the handler works
+only the first time the signal is sent. The solution to this problem
+is to use C<POSIX> signal handlers if available, their behaviour
+is well-defined.
+
+The following example implements a simple daemon, which restarts
+itself every time the C<SIGHUP> signal is received. The actual code is
+located in the subroutine C<code()>, which simply prints some debug
+info to show that it works and should be replaced with the real code.
+
+ #!/usr/bin/perl -w
+
+ use POSIX ();
+ use FindBin ();
+ use File::Basename ();
+ use File::Spec::Functions;
+
+ $|=1;
+
+ # make the daemon cross-platform, so exec always calls the script
+ # itself with the right path, no matter how the script was invoked.
+ 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__
+
+
=head1 Named Pipes
A named pipe (often referred to as a FIFO) is an old Unix IPC
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
sleep 2; # to avoid dup signals
}
-=head2 WARNING
+=head2 Deferred Signals (Safe Signals)
-By installing Perl code to deal with signals, you're exposing yourself
-to danger from two things. First, few system library functions are
-re-entrant. If the signal interrupts while Perl is executing one function
-(like malloc(3) or printf(3)), and your signal handler then calls the
-same function again, you could get unpredictable behavior--often, a
-core dump. Second, Perl isn't itself re-entrant at the lowest levels.
-If the signal interrupts Perl while Perl is changing its own internal
-data structures, similarly unpredictable behaviour may result.
+In Perls before Perl 5.7.3 by installing Perl code to deal with
+signals, you were exposing yourself to danger from two things. First,
+few system library functions are re-entrant. If the signal interrupts
+while Perl is executing one function (like malloc(3) or printf(3)),
+and your signal handler then calls the same function again, you could
+get unpredictable behavior--often, a core dump. Second, Perl isn't
+itself re-entrant at the lowest levels. If the signal interrupts Perl
+while Perl is changing its own internal data structures, similarly
+unpredictable behaviour may result.
-There are two things you can do, knowing this: be paranoid or be
-pragmatic. The paranoid approach is to do as little as possible in your
+There were two things you could do, knowing this: be paranoid or be
+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 is to say ``I know the risks, but prefer the
-convenience'', and to do anything you want in your signal handler,
-prepared to clean up core dumps now and again.
+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.
+
+Perl 5.7.3 and later avoid these problems by "deferring" signals.
+That is, when the signal is delivered to the process by
+the system (to the C code that implements Perl) a flag is set, and the
+handler returns immediately. Then at strategic "safe" points in the
+Perl interpreter (e.g. when it is about to execute a new opcode) the
+flags are checked and the Perl level handler from %SIG is
+executed. The "deferred" scheme allows much more flexibility in the
+coding of signal handler as we know Perl interpreter is in a safe
+state, and that we are not in a system library function when the
+handler is called. However the implementation does differ from
+previous Perls in the following ways:
+
+=over 4
+
+=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.
+
+
+=item Interrupting IO
+
+When a signal is delivered (e.g. INT control-C) the operating system
+breaks into IO operations like C<read> (used to implement Perls
+E<lt>E<gt> operator). On older Perls the handler was called
+immediately (and as C<read> is not "unsafe" this worked well). With
+the "deferred" scheme the handler is not called immediately, and if
+Perl is using system's C<stdio> library that library may re-start the
+C<read> without returning to Perl and giving it a chance to call the
+%SIG handler. If this happens on your system the solution is to use
+C<:perlio> layer to do IO - at least on those handles which you want
+to be able to break into with signals. (The C<:perlio> layer checks
+the signal flags and calls %SIG handlers before resuming IO operation.)
+
+Note that the default in Perl 5.7.3 and later is to automatically use
+the C<:perlio> layer.
+
+Note that some networking library functions like gethostbyname() are
+known to have their own implementations of timeouts which may conflict
+with your timeouts. If you are having problems with such functions,
+you can try using the POSIX sigaction() function, which bypasses the
+Perl safe signals (note that this means subjecting yourself to
+possible memory corruption, as described above). Instead of setting
+C<$SIG{ALRM}>:
+
+ local $SIG{ALRM} = sub { die "alarm" };
+
+try something like the following:
+
+ use POSIX qw(SIGALRM);
+ POSIX::sigaction(SIGALRM,
+ 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
+SA_RESTART flag when installing %SIG handlers. This meant that
+restartable system calls would continue rather than returning when
+a signal arrived. In order to deliver deferred signals promptly,
+Perl 5.7.3 and later do I<not> use SA_RESTART. Consequently,
+restartable system calls can fail (with $! set to C<EINTR>) in places
+where they previously would have succeeded.
+
+Note that the default C<:perlio> layer will retry C<read>, C<write>
+and C<close> as described above and that interrupted C<wait> and
+C<waitpid> calls will always be retried.
+
+=item Signals as "faults"
+
+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
+
+On some operating systems certain signal handlers are supposed to "do
+something" before returning. One example can be CHLD or CLD which
+indicates a child process has completed. On some operating systems the
+signal handler is expected to C<wait> for the completed child
+process. On such systems the deferred signal scheme will not work for
+those signals (it does not do the C<wait>). Again the failure will
+look like a loop as the operating system will re-issue the signal as
+there are un-waited-for completed child processes.
-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.
+=back
+If you want the old signal behaviour back regardless of possible
+memory corruption, set the environment variable C<PERL_SIGNALS> to
+C<"unsafe"> (a new feature since Perl 5.8.1).
=head1 Using open() for IPC
-Perl's basic open() statement can also be used for unidirectional interprocess
-communication by either appending or prepending a pipe symbol to the second
-argument to open(). Here's how to start something up in a child process you
-intend to write to:
+Perl's basic open() statement can also be used for unidirectional
+interprocess communication by either appending or prepending a pipe
+symbol to the second argument to open(). Here's how to start
+something up in a child process you intend to write to:
open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
|| die "can't fork: $!";
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.
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: $!";
+ die "Can't start a new session: $!" if setsid == -1;
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}
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.
STDIN. If you open a pipe I<from> minus, you can read from the filehandle
you opened whatever your kid writes to his STDOUT.
- use English;
+ use English '-no_match_vars';
my $sleep_count = 0;
do {
open (FILE, "> /safe/file")
|| die "can't open /safe/file: $!";
while (<STDIN>) {
- print FILE; # child's STDIN is parent's KID
+ print FILE; # child's STDIN is parent's KID_TO_WRITE
}
exit; # don't forget this
}
# add error processing as above
$pid = open(KID_TO_WRITE, "|-");
- $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
+ $SIG{PIPE} = sub { die "whoops, $program pipe broke" };
if ($pid) { # parent
for (@data) {
# NOTREACHED
}
+It is very easy to dead-lock a process using this form of open(), or
+indeed any use of pipe() and multiple sub-processes. The above
+example is 'safe' because it is simple and calls exec(). See
+L</"Avoiding Pipe Deadlocks"> for general safety principles, but there
+are extra gotchas with Safe Pipe Opens.
+
+In particular, if you opened the pipe using C<open FH, "|-">, then you
+cannot simply use close() in the parent process to close an unwanted
+writer. Consider this code:
+
+ $pid = open WRITER, "|-";
+ defined $pid or die "fork failed; $!";
+ if ($pid) {
+ if (my $sub_pid = fork()) {
+ close WRITER;
+ # do something else...
+ }
+ else {
+ # write to WRITER...
+ exit;
+ }
+ }
+ else {
+ # do something with STDIN...
+ exit;
+ }
+
+In the above, the true parent does not want to write to the WRITER
+filehandle, so it closes it. However, because WRITER was opened using
+C<open FH, "|-">, it has a special behaviour: closing it will call
+waitpid() (see L<perlfunc/waitpid>), which waits for the sub-process
+to exit. If the child process ends up waiting for something happening
+in the section marked "do something else", then you have a deadlock.
+
+This can also be a problem with intermediate sub-processes in more
+complicated code, which will call waitpid() on all open filehandles
+during global destruction; in no predictable order.
+
+To solve this, you must manually use pipe(), fork(), and the form of
+open() which sets one file descriptor to another, as below:
+
+ pipe(READER, WRITER);
+ $pid = fork();
+ defined $pid or die "fork failed; $!";
+ if ($pid) {
+ close READER;
+ if (my $sub_pid = fork()) {
+ close WRITER;
+ }
+ else {
+ # write to WRITER...
+ exit;
+ }
+ # write to WRITER...
+ }
+ else {
+ open STDIN, "<&READER";
+ close WRITER;
+ # do something...
+ exit;
+ }
+
+Since Perl 5.8.0, you can also use the list form of C<open> for pipes :
+the syntax
+
+ open KID_PS, "-|", "ps", "aux" or die $!;
+
+forks the ps(1) command (without spawning a shell, as there are more than
+three arguments to open()), and reads its standard output via the
+C<KID_PS> filehandle. The corresponding syntax to write to command
+pipes (with C<"|-"> in place of C<"-|">) is also implemented.
+
Note that these operations are full Unix forks, which means they may not be
correctly implemented on alien systems. Additionally, these are not true
multithreading. If you'd like to learn more about threading, see the
F<modules> file mentioned below in the SEE ALSO section.
+=head2 Avoiding Pipe Deadlocks
+
+In general, if you have more than one sub-process, you need to be very
+careful that any process which does not need the writer half of any
+pipe you create for inter-process communication does not have it open.
+
+The reason for this is that any child process which is reading from
+the pipe and expecting an EOF will never receive it, and therefore
+never exit. A single process closing a pipe is not enough to close it;
+the last process with the pipe open must close it for it to read EOF.
+
+Certain built-in Unix features help prevent this most of
+the time. For instance, filehandles have a 'close on exec' flag (set
+I<en masse> with Perl using the C<$^F> L<perlvar>), so that any
+filehandles which you didn't explicitly route to the STDIN, STDOUT or
+STDERR of a child I<program> will automatically be closed for you.
+
+So, always explicitly and immediately call close() on the writable end
+of any pipe, unless that process is actually writing to it. If you
+don't explicitly call close() then be warned Perl will still close()
+all the filehandles during global destruction. As warned above, if
+those filehandles were opened with Safe Pipe Open, they will also call
+waitpid() and you might again deadlock.
+
=head2 Bidirectional Communication with Another Process
While this works reasonably well for unidirectional communication, what
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>;
The newer Expect.pm module from CPAN also addresses this kind of thing.
This module requires two other modules from CPAN: IO::Pty and IO::Stty.
It sets up a pseudo-terminal to interact with programs that insist on
-using talking to the terminal device driver. If your system is
+using talking to the terminal device driver. If your system is
amongst those supported, this may be your best bet.
=head2 Bidirectional Communication with Yourself
exit;
}
-But you don't actually have to make two pipe calls. If you
+But you don't actually have to make two pipe calls. If you
have the socketpair() system call, it will do this all for you.
#!/usr/bin/perl -w
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";
+ use Errno;
+
sub REAPER {
- $waitedpid = wait;
- $SIG{CHLD} = \&REAPER; # loathe sysV
- logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+ 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 {
- 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;
-
- 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();
+ 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();
}
-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 $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: $!";
+ connect(SOCKET, $hispaddr) || die "connect: $!";
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);
}
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 strict;
my ($rendezvous, $line);
- $rendezvous = shift || '/tmp/catsock';
+ $rendezvous = shift || 'catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
while (defined($line = <SOCK>)) {
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 $NAME = 'catsock';
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');
my $waitedpid;
+ use POSIX ":sys_wait_h";
sub REAPER {
- $waitedpid = wait;
- $SIG{CHLD} = \&REAPER; # loathe sysV
- logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+ my $child;
+ while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
+ logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+ }
+ $SIG{CHLD} = \&REAPER; # loathe SysV
}
$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.
$client->autoflush(1);
print $client "Welcome to $0; type help for command list.\n";
$hostinfo = gethostbyaddr($client->peeraddr);
- printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
+ printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
print $client "Command? ";
while ( <$client>) {
next unless /\S/; # blank line
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
($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--;
}
+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_IRUSR S_IWUSR);
$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_IRUSR|S_IWUSR) // 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_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";
+ }
+
=head1 NOTES
Most of these routines quietly but politely return C<undef> when they
try to pass open file descriptors over a local UDP datagram socket if you
want your code to stand a chance of being portable.
-As mentioned in the signals section, because few vendors provide C
-libraries that are safely re-entrant, the prudent programmer will do
-little else within a handler beyond setting a numeric variable that
-already exists; or, if locked into a slow (restarting) system call,
-using die() to raise an exception and longjmp(3) out. In fact, even
-these may in some cases cause a core dump. It's probably best to avoid
-signals except where they are absolutely inevitable. This
-will be addressed in a future release of Perl.
-
=head1 AUTHOR
Tom Christiansen, with occasional vestiges of Larry Wall's original
There's a lot more to networking than this, but this should get you
started.
-For intrepid programmers, the indispensable textbook is I<Unix Network
-Programming> by W. Richard Stevens (published by Addison-Wesley). Note
-that most books on networking address networking from the perspective of
-a C programmer; translation to Perl is left as an exercise for the reader.
+For intrepid programmers, the indispensable textbook is I<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
https://perl5.git.perl.org / perl5.git / blobdiff