This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlipc: fix bug in example
[perl5.git] / pod / perlipc.pod
CommitLineData
a0d0e21e
LW
1=head1 NAME
2
184e9718 3perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
a0d0e21e
LW
4
5=head1 DESCRIPTION
6
4633a7c4
LW
7The basic IPC facilities of Perl are built out of the good old Unix
8signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
9IPC calls. Each is used in slightly different situations.
10
11=head1 Signals
12
490f90af
JH
13Perl uses a simple signal handling model: the %SIG hash contains names
14or references of user-installed signal handlers. These handlers will
15be called with an argument which is the name of the signal that
16triggered it. A signal may be generated intentionally from a
17particular keyboard sequence like control-C or control-Z, sent to you
18from another process, or triggered automatically by the kernel when
19special events transpire, like a child process exiting, your process
20running out of stack space, or hitting file size limit.
4633a7c4 21
a11adca0 22For example, to trap an interrupt signal, set up a handler like this:
4633a7c4 23
73af1a12
DG
24 our $shucks;
25
4633a7c4
LW
26 sub catch_zap {
27 my $signame = shift;
28 $shucks++;
29 die "Somebody sent me a SIG$signame";
54310121 30 }
4633a7c4
LW
31 $SIG{INT} = 'catch_zap'; # could fail in modules
32 $SIG{INT} = \&catch_zap; # best strategy
33
490f90af
JH
34Prior to Perl 5.7.3 it was necessary to do as little as you possibly
35could in your handler; notice how all we do is set a global variable
36and then raise an exception. That's because on most systems,
37libraries are not re-entrant; particularly, memory allocation and I/O
38routines are not. That meant that doing nearly I<anything> in your
39handler could in theory trigger a memory fault and subsequent core
ec488bcf 40dump - see L</Deferred Signals (Safe Signals)> below.
a11adca0 41
4633a7c4
LW
42The names of the signals are the ones listed out by C<kill -l> on your
43system, or you can retrieve them from the Config module. Set up an
44@signame list indexed by number to get the name and a %signo table
45indexed by name to get the number:
46
47 use Config;
48 defined $Config{sig_name} || die "No sigs?";
49 foreach $name (split(' ', $Config{sig_name})) {
50 $signo{$name} = $i;
51 $signame[$i] = $name;
52 $i++;
54310121 53 }
4633a7c4 54
6a3992aa 55So to check whether signal 17 and SIGALRM were the same, do just this:
4633a7c4
LW
56
57 print "signal #17 = $signame[17]\n";
54310121 58 if ($signo{ALRM}) {
4633a7c4 59 print "SIGALRM is $signo{ALRM}\n";
54310121 60 }
4633a7c4
LW
61
62You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
63the handler, in which case Perl will try to discard the signal or do the
f648820c
GS
64default thing.
65
19799a22 66On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
f648820c
GS
67has special behavior with respect to a value of C<'IGNORE'>.
68Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
69not creating zombie processes when the parent process fails to C<wait()>
70on its child processes (i.e. child processes are automatically reaped).
71Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
72C<-1> on such platforms.
73
74Some signals can be neither trapped nor ignored, such as
4633a7c4
LW
75the KILL and STOP (but not the TSTP) signals. One strategy for
76temporarily ignoring signals is to use a local() statement, which will be
77automatically restored once your block is exited. (Remember that local()
78values are "inherited" by functions called from within that block.)
79
80 sub precious {
81 local $SIG{INT} = 'IGNORE';
82 &more_functions;
54310121 83 }
4633a7c4
LW
84 sub more_functions {
85 # interrupts still ignored, for now...
54310121 86 }
4633a7c4
LW
87
88Sending a signal to a negative process ID means that you send the signal
fb73857a
PP
89to the entire Unix process-group. This code sends a hang-up signal to all
90processes in the current process group (and sets $SIG{HUP} to IGNORE so
91it doesn't kill itself):
4633a7c4
LW
92
93 {
94 local $SIG{HUP} = 'IGNORE';
95 kill HUP => -$$;
96 # snazzy writing of: kill('HUP', -$$)
97 }
a0d0e21e 98
4633a7c4 99Another interesting signal to send is signal number zero. This doesn't
1e9c1022 100actually affect a child process, but instead checks whether it's alive
54310121 101or has changed its UID.
a0d0e21e 102
4633a7c4
LW
103 unless (kill 0 => $kid_pid) {
104 warn "something wicked happened to $kid_pid";
54310121 105 }
a0d0e21e 106
1e9c1022
JL
107When directed at a process whose UID is not identical to that
108of the sending process, signal number zero may fail because
109you lack permission to send the signal, even though the process is alive.
bf003f36 110You may be able to determine the cause of failure using C<%!>.
1e9c1022 111
bf003f36 112 unless (kill 0 => $pid or $!{EPERM}) {
1e9c1022
JL
113 warn "$pid looks dead";
114 }
115
4633a7c4
LW
116You might also want to employ anonymous functions for simple signal
117handlers:
a0d0e21e 118
4633a7c4 119 $SIG{INT} = sub { die "\nOutta here!\n" };
a0d0e21e 120
4633a7c4 121But that will be problematic for the more complicated handlers that need
54310121 122to reinstall themselves. Because Perl's signal mechanism is currently
184e9718 123based on the signal(3) function from the C library, you may sometimes be so
353c6505 124unfortunate as to run on systems where that function is "broken", that
4633a7c4
LW
125is, it behaves in the old unreliable SysV way rather than the newer, more
126reasonable BSD and POSIX fashion. So you'll see defensive people writing
127signal handlers like this:
a0d0e21e 128
54310121 129 sub REAPER {
4633a7c4 130 $waitedpid = wait;
abf724c9 131 # loathe SysV: it makes us not only reinstate
6a3992aa 132 # the handler, but place it after the wait
54310121 133 $SIG{CHLD} = \&REAPER;
4633a7c4
LW
134 }
135 $SIG{CHLD} = \&REAPER;
136 # now do something that forks...
137
816229cf 138or better still:
4633a7c4 139
6a3992aa 140 use POSIX ":sys_wait_h";
54310121 141 sub REAPER {
4633a7c4 142 my $child;
816229cf
NC
143 # If a second child dies while in the signal handler caused by the
144 # first death, we won't get another signal. So must loop here else
145 # we will leave the unreaped child as a zombie. And the next time
146 # two children die we get another zombie. And so on.
1450d070 147 while (($child = waitpid(-1,WNOHANG)) > 0) {
4633a7c4 148 $Kid_Status{$child} = $?;
54310121 149 }
abf724c9 150 $SIG{CHLD} = \&REAPER; # still loathe SysV
4633a7c4
LW
151 }
152 $SIG{CHLD} = \&REAPER;
153 # do something that forks...
154
0a18a49b
MH
155Note: qx(), system() and some modules for calling external commands do a
156fork() and wait() for the result. Thus, your signal handler (REAPER in the
157example) will be called. Since wait() was already called by system() or qx()
158the wait() in the signal handler will not see any more zombies and therefore
159block.
160
161The best way to prevent this issue is to use waitpid, as in the following
162example:
163
164 use POSIX ":sys_wait_h"; # for nonblocking read
165
166 my %children;
167
168 $SIG{CHLD} = sub {
169 # don't change $! and $? outside handler
170 local ($!,$?);
171 my $pid = waitpid(-1, WNOHANG);
172 return if $pid == -1;
173 return unless defined $children{$pid};
174 delete $children{$pid};
175 cleanup_child($pid, $?);
176 };
177
178 while (1) {
179 my $pid = fork();
180 if ($pid == 0) {
181 # ...
182 exit 0;
183 } else {
184 $children{$pid}=1;
185 # ...
186 system($command);
187 # ...
188 }
189 }
190
191Signal handling is also used for timeouts in Unix. While safely
4633a7c4
LW
192protected within an C<eval{}> block, you set a signal handler to trap
193alarm signals and then schedule to have one delivered to you in some
194number of seconds. Then try your blocking operation, clearing the alarm
195when it's done but not before you've exited your C<eval{}> block. If it
196goes off, you'll use die() to jump out of the block, much as you might
197using longjmp() or throw() in other languages.
198
199Here's an example:
200
54310121 201 eval {
4633a7c4 202 local $SIG{ALRM} = sub { die "alarm clock restart" };
54310121 203 alarm 10;
4633a7c4 204 flock(FH, 2); # blocking write lock
54310121 205 alarm 0;
4633a7c4
LW
206 };
207 if ($@ and $@ !~ /alarm clock restart/) { die }
208
8a4f6ac2
GS
209If the operation being timed out is system() or qx(), this technique
210is liable to generate zombies. If this matters to you, you'll
211need to do your own fork() and exec(), and kill the errant child process.
212
4633a7c4
LW
213For more complex signal handling, you might see the standard POSIX
214module. Lamentably, this is almost entirely undocumented, but
215the F<t/lib/posix.t> file from the Perl source distribution has some
216examples in it.
217
28494392
SB
218=head2 Handling the SIGHUP Signal in Daemons
219
220A process that usually starts when the system boots and shuts down
221when the system is shut down is called a daemon (Disk And Execution
222MONitor). If a daemon process has a configuration file which is
223modified after the process has been started, there should be a way to
224tell that process to re-read its configuration file, without stopping
225the process. Many daemons provide this mechanism using the C<SIGHUP>
226signal handler. When you want to tell the daemon to re-read the file
227you simply send it the C<SIGHUP> signal.
228
3031ea75
JH
229Not all platforms automatically reinstall their (native) signal
230handlers after a signal delivery. This means that the handler works
231only the first time the signal is sent. The solution to this problem
232is to use C<POSIX> signal handlers if available, their behaviour
233is well-defined.
28494392
SB
234
235The following example implements a simple daemon, which restarts
236itself every time the C<SIGHUP> signal is received. The actual code is
237located in the subroutine C<code()>, which simply prints some debug
238info to show that it works and should be replaced with the real code.
239
240 #!/usr/bin/perl -w
d6fd60d6 241
28494392
SB
242 use POSIX ();
243 use FindBin ();
244 use File::Basename ();
245 use File::Spec::Functions;
d6fd60d6 246
28494392 247 $|=1;
d6fd60d6 248
28494392
SB
249 # make the daemon cross-platform, so exec always calls the script
250 # itself with the right path, no matter how the script was invoked.
251 my $script = File::Basename::basename($0);
252 my $SELF = catfile $FindBin::Bin, $script;
d6fd60d6 253
28494392
SB
254 # POSIX unmasks the sigprocmask properly
255 my $sigset = POSIX::SigSet->new();
256 my $action = POSIX::SigAction->new('sigHUP_handler',
257 $sigset,
258 &POSIX::SA_NODEFER);
259 POSIX::sigaction(&POSIX::SIGHUP, $action);
d6fd60d6 260
28494392
SB
261 sub sigHUP_handler {
262 print "got SIGHUP\n";
263 exec($SELF, @ARGV) or die "Couldn't restart: $!\n";
264 }
d6fd60d6 265
28494392 266 code();
d6fd60d6 267
28494392
SB
268 sub code {
269 print "PID: $$\n";
270 print "ARGV: @ARGV\n";
271 my $c = 0;
272 while (++$c) {
273 sleep 2;
274 print "$c\n";
275 }
276 }
277 __END__
278
279
4633a7c4
LW
280=head1 Named Pipes
281
282A named pipe (often referred to as a FIFO) is an old Unix IPC
283mechanism for processes communicating on the same machine. It works
54310121 284just like a regular, connected anonymous pipes, except that the
4633a7c4
LW
285processes rendezvous using a filename and don't have to be related.
286
3341d187
AT
287To create a named pipe, use the C<POSIX::mkfifo()> function.
288
289 use POSIX qw(mkfifo);
290 mkfifo($path, 0700) or die "mkfifo $path failed: $!";
291
292You can also use the Unix command mknod(1) or on some
4633a7c4
LW
293systems, mkfifo(1). These may not be in your normal path.
294
295 # system return val is backwards, so && not ||
296 #
297 $ENV{PATH} .= ":/etc:/usr/etc";
54310121 298 if ( system('mknod', $path, 'p')
4633a7c4
LW
299 && system('mkfifo', $path) )
300 {
5a964f20 301 die "mk{nod,fifo} $path failed";
54310121 302 }
4633a7c4
LW
303
304
305A fifo is convenient when you want to connect a process to an unrelated
306one. When you open a fifo, the program will block until there's something
54310121 307on the other end.
4633a7c4
LW
308
309For example, let's say you'd like to have your F<.signature> file be a
310named pipe that has a Perl program on the other end. Now every time any
6a3992aa 311program (like a mailer, news reader, finger program, etc.) tries to read
4633a7c4 312from that file, the reading program will block and your program will
6a3992aa 313supply the new signature. We'll use the pipe-checking file test B<-p>
4633a7c4
LW
314to find out whether anyone (or anything) has accidentally removed our fifo.
315
316 chdir; # go home
317 $FIFO = '.signature';
4633a7c4
LW
318
319 while (1) {
320 unless (-p $FIFO) {
321 unlink $FIFO;
3341d187
AT
322 require POSIX;
323 POSIX::mkfifo($FIFO, 0700)
324 or die "can't mkfifo $FIFO: $!";
54310121 325 }
4633a7c4
LW
326
327 # next line blocks until there's a reader
328 open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
329 print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
330 close FIFO;
6a3992aa 331 sleep 2; # to avoid dup signals
4633a7c4 332 }
a0d0e21e 333
ffc145e8 334=head2 Deferred Signals (Safe Signals)
5a964f20 335
490f90af
JH
336In Perls before Perl 5.7.3 by installing Perl code to deal with
337signals, you were exposing yourself to danger from two things. First,
338few system library functions are re-entrant. If the signal interrupts
339while Perl is executing one function (like malloc(3) or printf(3)),
340and your signal handler then calls the same function again, you could
341get unpredictable behavior--often, a core dump. Second, Perl isn't
342itself re-entrant at the lowest levels. If the signal interrupts Perl
343while Perl is changing its own internal data structures, similarly
344unpredictable behaviour may result.
5a964f20 345
a11adca0
NIS
346There were two things you could do, knowing this: be paranoid or be
347pragmatic. The paranoid approach was to do as little as possible in your
5a964f20
TC
348signal handler. Set an existing integer variable that already has a
349value, and return. This doesn't help you if you're in a slow system call,
7b34eba2 350which will just restart. That means you have to C<die> to longjmp(3) out
5a964f20
TC
351of the handler. Even this is a little cavalier for the true paranoiac,
352who avoids C<die> in a handler because the system I<is> out to get you.
b432a672
AL
353The pragmatic approach was to say "I know the risks, but prefer the
354convenience", and to do anything you wanted in your signal handler,
a11adca0
NIS
355and be prepared to clean up core dumps now and again.
356
ac036724 357Perl 5.7.3 and later avoid these problems by "deferring" signals.
358That is, when the signal is delivered to the process by
490f90af
JH
359the system (to the C code that implements Perl) a flag is set, and the
360handler returns immediately. Then at strategic "safe" points in the
361Perl interpreter (e.g. when it is about to execute a new opcode) the
362flags are checked and the Perl level handler from %SIG is
363executed. The "deferred" scheme allows much more flexibility in the
364coding of signal handler as we know Perl interpreter is in a safe
365state, and that we are not in a system library function when the
366handler is called. However the implementation does differ from
367previous Perls in the following ways:
5a964f20 368
a11adca0 369=over 4
5a964f20 370
e188fdae
CB
371=item Long-running opcodes
372
373As the Perl interpreter only looks at the signal flags when it is about
374to execute a new opcode, a signal that arrives during a long-running
375opcode (e.g. a regular expression operation on a very large string) will
376not be seen until the current opcode completes.
377
378N.B. If a signal of any given type fires multiple times during an opcode
379(such as from a fine-grained timer), the handler for that signal will
380only be called once after the opcode completes, and all the other
381instances will be discarded. Furthermore, if your system's signal queue
382gets flooded to the point that there are signals that have been raised
383but not yet caught (and thus not deferred) at the time an opcode
384completes, those signals may well be caught and deferred during
385subsequent opcodes, with sometimes surprising results. For example, you
386may see alarms delivered even after calling C<alarm(0)> as the latter
387stops the raising of alarms but does not cancel the delivery of alarms
388raised but not yet caught. Do not depend on the behaviors described in
389this paragraph as they are side effects of the current implementation and
390may change in future versions of Perl.
a11adca0 391
a11adca0
NIS
392
393=item Interrupting IO
394
490f90af
JH
395When a signal is delivered (e.g. INT control-C) the operating system
396breaks into IO operations like C<read> (used to implement Perls
397E<lt>E<gt> operator). On older Perls the handler was called
398immediately (and as C<read> is not "unsafe" this worked well). With
399the "deferred" scheme the handler is not called immediately, and if
400Perl is using system's C<stdio> library that library may re-start the
401C<read> without returning to Perl and giving it a chance to call the
402%SIG handler. If this happens on your system the solution is to use
403C<:perlio> layer to do IO - at least on those handles which you want
404to be able to break into with signals. (The C<:perlio> layer checks
405the signal flags and calls %SIG handlers before resuming IO operation.)
406
407Note that the default in Perl 5.7.3 and later is to automatically use
408the C<:perlio> layer.
a11adca0 409
91d81acc
JH
410Note that some networking library functions like gethostbyname() are
411known to have their own implementations of timeouts which may conflict
412with your timeouts. If you are having problems with such functions,
413you can try using the POSIX sigaction() function, which bypasses the
414Perl safe signals (note that this means subjecting yourself to
415possible memory corruption, as described above). Instead of setting
e399c6ae 416C<$SIG{ALRM}>:
91d81acc 417
e399c6ae
SB
418 local $SIG{ALRM} = sub { die "alarm" };
419
420try something like the following:
421
422 use POSIX qw(SIGALRM);
423 POSIX::sigaction(SIGALRM,
424 POSIX::SigAction->new(sub { die "alarm" }))
425 or die "Error setting SIGALRM handler: $!\n";
91d81acc 426
a1966b02
RGS
427Another way to disable the safe signal behavior locally is to use
428the C<Perl::Unsafe::Signals> module from CPAN (which will affect
429all signals).
430
9ce5b4ad
SG
431=item Restartable system calls
432
433On systems that supported it, older versions of Perl used the
434SA_RESTART flag when installing %SIG handlers. This meant that
435restartable system calls would continue rather than returning when
436a signal arrived. In order to deliver deferred signals promptly,
437Perl 5.7.3 and later do I<not> use SA_RESTART. Consequently,
438restartable system calls can fail (with $! set to C<EINTR>) in places
439where they previously would have succeeded.
440
441Note that the default C<:perlio> layer will retry C<read>, C<write>
442and C<close> as described above and that interrupted C<wait> and
443C<waitpid> calls will always be retried.
444
a11adca0
NIS
445=item Signals as "faults"
446
e188fdae
CB
447Certain signals, e.g. SEGV, ILL, and BUS, are generated as a result of
448virtual memory or other "faults". These are normally fatal and there is
449little a Perl-level handler can do with them, so Perl now delivers them
450immediately rather than attempting to defer them.
a11adca0
NIS
451
452=item Signals triggered by operating system state
453
490f90af
JH
454On some operating systems certain signal handlers are supposed to "do
455something" before returning. One example can be CHLD or CLD which
456indicates a child process has completed. On some operating systems the
457signal handler is expected to C<wait> for the completed child
458process. On such systems the deferred signal scheme will not work for
459those signals (it does not do the C<wait>). Again the failure will
460look like a loop as the operating system will re-issue the signal as
461there are un-waited-for completed child processes.
a11adca0 462
818c4caa 463=back
a0d0e21e 464
4ffa73a3
JH
465If you want the old signal behaviour back regardless of possible
466memory corruption, set the environment variable C<PERL_SIGNALS> to
45c0772f 467C<"unsafe"> (a new feature since Perl 5.8.1).
4ffa73a3 468
4633a7c4
LW
469=head1 Using open() for IPC
470
490f90af
JH
471Perl's basic open() statement can also be used for unidirectional
472interprocess communication by either appending or prepending a pipe
473symbol to the second argument to open(). Here's how to start
474something up in a child process you intend to write to:
4633a7c4 475
54310121 476 open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
4633a7c4
LW
477 || die "can't fork: $!";
478 local $SIG{PIPE} = sub { die "spooler pipe broke" };
479 print SPOOLER "stuff\n";
480 close SPOOLER || die "bad spool: $! $?";
481
482And here's how to start up a child process you intend to read from:
483
484 open(STATUS, "netstat -an 2>&1 |")
485 || die "can't fork: $!";
486 while (<STATUS>) {
487 next if /^(tcp|udp)/;
488 print;
54310121 489 }
a2eb9003 490 close STATUS || die "bad netstat: $! $?";
4633a7c4
LW
491
492If one can be sure that a particular program is a Perl script that is
493expecting filenames in @ARGV, the clever programmer can write something
494like this:
495
5a964f20 496 % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
4633a7c4
LW
497
498and irrespective of which shell it's called from, the Perl program will
499read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
500in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
501file. Pretty nifty, eh?
502
54310121 503You might notice that you could use backticks for much the
4633a7c4
LW
504same effect as opening a pipe for reading:
505
506 print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
507 die "bad netstat" if $?;
508
509While this is true on the surface, it's much more efficient to process the
510file one line or record at a time because then you don't have to read the
19799a22 511whole thing into memory at once. It also gives you finer control of the
4633a7c4
LW
512whole process, letting you to kill off the child process early if you'd
513like.
514
515Be careful to check both the open() and the close() return values. If
516you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise,
517think of what happens when you start up a pipe to a command that doesn't
518exist: the open() will in all likelihood succeed (it only reflects the
519fork()'s success), but then your output will fail--spectacularly. Perl
520can't know whether the command worked because your command is actually
521running in a separate process whose exec() might have failed. Therefore,
6a3992aa 522while readers of bogus commands return just a quick end of file, writers
4633a7c4
LW
523to bogus command will trigger a signal they'd better be prepared to
524handle. Consider:
525
5a964f20
TC
526 open(FH, "|bogus") or die "can't fork: $!";
527 print FH "bang\n" or die "can't write: $!";
528 close FH or die "can't close: $!";
529
530That won't blow up until the close, and it will blow up with a SIGPIPE.
531To catch it, you could use this:
532
533 $SIG{PIPE} = 'IGNORE';
534 open(FH, "|bogus") or die "can't fork: $!";
535 print FH "bang\n" or die "can't write: $!";
536 close FH or die "can't close: status=$?";
4633a7c4 537
68dc0745
PP
538=head2 Filehandles
539
5a964f20
TC
540Both the main process and any child processes it forks share the same
541STDIN, STDOUT, and STDERR filehandles. If both processes try to access
45bc9206 542them at once, strange things can happen. You may also want to close
5a964f20
TC
543or reopen the filehandles for the child. You can get around this by
544opening your pipe with open(), but on some systems this means that the
545child process cannot outlive the parent.
68dc0745
PP
546
547=head2 Background Processes
548
549You can run a command in the background with:
550
7b05b7e3 551 system("cmd &");
68dc0745
PP
552
553The command's STDOUT and STDERR (and possibly STDIN, depending on your
554shell) will be the same as the parent's. You won't need to catch
555SIGCHLD because of the double-fork taking place (see below for more
556details).
557
558=head2 Complete Dissociation of Child from Parent
559
560In some cases (starting server processes, for instance) you'll want to
893af57a
RS
561completely dissociate the child process from the parent. This is
562often called daemonization. A well behaved daemon will also chdir()
563to the root directory (so it doesn't prevent unmounting the filesystem
564containing the directory from which it was launched) and redirect its
565standard file descriptors from and to F</dev/null> (so that random
566output doesn't wind up on the user's terminal).
567
568 use POSIX 'setsid';
569
570 sub daemonize {
571 chdir '/' or die "Can't chdir to /: $!";
572 open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
573 open STDOUT, '>/dev/null'
574 or die "Can't write to /dev/null: $!";
575 defined(my $pid = fork) or die "Can't fork: $!";
576 exit if $pid;
c4cd47ac 577 die "Can't start a new session: $!" if setsid == -1;
893af57a
RS
578 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
579 }
5a964f20 580
893af57a
RS
581The fork() has to come before the setsid() to ensure that you aren't a
582process group leader (the setsid() will fail if you are). If your
583system doesn't have the setsid() function, open F</dev/tty> and use the
f979aebc 584C<TIOCNOTTY> ioctl() on it instead. See tty(4) for details.
5a964f20 585
893af57a
RS
586Non-Unix users should check their Your_OS::Process module for other
587solutions.
68dc0745 588
4633a7c4
LW
589=head2 Safe Pipe Opens
590
591Another interesting approach to IPC is making your single program go
592multiprocess and communicate between (or even amongst) yourselves. The
593open() function will accept a file argument of either C<"-|"> or C<"|-">
594to do a very interesting thing: it forks a child connected to the
595filehandle you've opened. The child is running the same program as the
596parent. This is useful for safely opening a file when running under an
597assumed UID or GID, for example. If you open a pipe I<to> minus, you can
598write to the filehandle you opened and your kid will find it in his
599STDIN. If you open a pipe I<from> minus, you can read from the filehandle
600you opened whatever your kid writes to his STDOUT.
601
a1ce9542 602 use English '-no_match_vars';
4633a7c4
LW
603 my $sleep_count = 0;
604
54310121 605 do {
c07a80fd 606 $pid = open(KID_TO_WRITE, "|-");
4633a7c4
LW
607 unless (defined $pid) {
608 warn "cannot fork: $!";
609 die "bailing out" if $sleep_count++ > 6;
610 sleep 10;
54310121 611 }
4633a7c4
LW
612 } until defined $pid;
613
614 if ($pid) { # parent
c07a80fd
PP
615 print KID_TO_WRITE @some_data;
616 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4
LW
617 } else { # child
618 ($EUID, $EGID) = ($UID, $GID); # suid progs only
54310121 619 open (FILE, "> /safe/file")
4633a7c4
LW
620 || die "can't open /safe/file: $!";
621 while (<STDIN>) {
848ead87 622 print FILE; # child's STDIN is parent's KID_TO_WRITE
54310121 623 }
4633a7c4 624 exit; # don't forget this
54310121 625 }
4633a7c4
LW
626
627Another common use for this construct is when you need to execute
628something without the shell's interference. With system(), it's
54310121 629straightforward, but you can't use a pipe open or backticks safely.
4633a7c4
LW
630That's because there's no way to stop the shell from getting its hands on
631your arguments. Instead, use lower-level control to call exec() directly.
632
54310121 633Here's a safe backtick or pipe open for read:
4633a7c4
LW
634
635 # add error processing as above
c07a80fd 636 $pid = open(KID_TO_READ, "-|");
4633a7c4
LW
637
638 if ($pid) { # parent
c07a80fd 639 while (<KID_TO_READ>) {
4633a7c4 640 # do something interesting
54310121 641 }
c07a80fd 642 close(KID_TO_READ) || warn "kid exited $?";
4633a7c4
LW
643
644 } else { # child
645 ($EUID, $EGID) = ($UID, $GID); # suid only
646 exec($program, @options, @args)
647 || die "can't exec program: $!";
648 # NOTREACHED
54310121 649 }
4633a7c4
LW
650
651
652And here's a safe pipe open for writing:
653
654 # add error processing as above
c07a80fd 655 $pid = open(KID_TO_WRITE, "|-");
76c0e0db 656 $SIG{PIPE} = sub { die "whoops, $program pipe broke" };
4633a7c4
LW
657
658 if ($pid) { # parent
659 for (@data) {
c07a80fd 660 print KID_TO_WRITE;
54310121 661 }
c07a80fd 662 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4
LW
663
664 } else { # child
665 ($EUID, $EGID) = ($UID, $GID);
666 exec($program, @options, @args)
667 || die "can't exec program: $!";
668 # NOTREACHED
54310121 669 }
4633a7c4 670
c40e8e9b
SV
671It is very easy to dead-lock a process using this form of open(), or
672indeed any use of pipe() and multiple sub-processes. The above
673example is 'safe' because it is simple and calls exec(). See
674L</"Avoiding Pipe Deadlocks"> for general safety principles, but there
675are extra gotchas with Safe Pipe Opens.
676
677In particular, if you opened the pipe using C<open FH, "|-">, then you
678cannot simply use close() in the parent process to close an unwanted
679writer. Consider this code:
680
681 $pid = open WRITER, "|-";
682 defined $pid or die "fork failed; $!";
683 if ($pid) {
684 if (my $sub_pid = fork()) {
685 close WRITER;
686 # do something else...
687 }
688 else {
689 # write to WRITER...
690 exit;
691 }
692 }
693 else {
694 # do something with STDIN...
695 exit;
696 }
697
698In the above, the true parent does not want to write to the WRITER
699filehandle, so it closes it. However, because WRITER was opened using
700C<open FH, "|-">, it has a special behaviour: closing it will call
701waitpid() (see L<perlfunc/waitpid>), which waits for the sub-process
702to exit. If the child process ends up waiting for something happening
703in the section marked "do something else", then you have a deadlock.
704
705This can also be a problem with intermediate sub-processes in more
706complicated code, which will call waitpid() on all open filehandles
707during global destruction; in no predictable order.
708
709To solve this, you must manually use pipe(), fork(), and the form of
710open() which sets one file descriptor to another, as below:
711
712 pipe(READER, WRITER);
713 $pid = fork();
714 defined $pid or die "fork failed; $!";
715 if ($pid) {
716 close READER;
717 if (my $sub_pid = fork()) {
718 close WRITER;
719 }
720 else {
721 # write to WRITER...
722 exit;
723 }
724 # write to WRITER...
725 }
726 else {
727 open STDIN, "<&READER";
728 close WRITER;
729 # do something...
730 exit;
731 }
732
307eac13
RGS
733Since Perl 5.8.0, you can also use the list form of C<open> for pipes :
734the syntax
735
736 open KID_PS, "-|", "ps", "aux" or die $!;
737
738forks the ps(1) command (without spawning a shell, as there are more than
739three arguments to open()), and reads its standard output via the
8a2485f8 740C<KID_PS> filehandle. The corresponding syntax to write to command
ca585e4d 741pipes (with C<"|-"> in place of C<"-|">) is also implemented.
307eac13 742
4633a7c4
LW
743Note that these operations are full Unix forks, which means they may not be
744correctly implemented on alien systems. Additionally, these are not true
54310121 745multithreading. If you'd like to learn more about threading, see the
184e9718 746F<modules> file mentioned below in the SEE ALSO section.
4633a7c4 747
c40e8e9b
SV
748=head2 Avoiding Pipe Deadlocks
749
750In general, if you have more than one sub-process, you need to be very
751careful that any process which does not need the writer half of any
752pipe you create for inter-process communication does not have it open.
753
754The reason for this is that any child process which is reading from
755the pipe and expecting an EOF will never receive it, and therefore
756never exit. A single process closing a pipe is not enough to close it;
757the last process with the pipe open must close it for it to read EOF.
758
e1020413 759Certain built-in Unix features help prevent this most of
c40e8e9b
SV
760the time. For instance, filehandles have a 'close on exec' flag (set
761I<en masse> with Perl using the C<$^F> L<perlvar>), so that any
762filehandles which you didn't explicitly route to the STDIN, STDOUT or
763STDERR of a child I<program> will automatically be closed for you.
764
765So, always explicitly and immediately call close() on the writable end
766of any pipe, unless that process is actually writing to it. If you
767don't explicitly call close() then be warned Perl will still close()
768all the filehandles during global destruction. As warned above, if
769those filehandles were opened with Safe Pipe Open, they will also call
770waitpid() and you might again deadlock.
771
7b05b7e3 772=head2 Bidirectional Communication with Another Process
4633a7c4
LW
773
774While this works reasonably well for unidirectional communication, what
775about bidirectional communication? The obvious thing you'd like to do
776doesn't actually work:
777
c07a80fd 778 open(PROG_FOR_READING_AND_WRITING, "| some program |")
4633a7c4 779
9f1b1f2d
GS
780and if you forget to use the C<use warnings> pragma or the B<-w> flag,
781then you'll miss out entirely on the diagnostic message:
4633a7c4
LW
782
783 Can't do bidirectional pipe at -e line 1.
784
785If you really want to, you can use the standard open2() library function
7b05b7e3 786to catch both ends. There's also an open3() for tridirectional I/O so you
4633a7c4
LW
787can also catch your child's STDERR, but doing so would then require an
788awkward select() loop and wouldn't allow you to use normal Perl input
789operations.
790
791If you look at its source, you'll see that open2() uses low-level
5a964f20 792primitives like Unix pipe() and exec() calls to create all the connections.
4633a7c4
LW
793While it might have been slightly more efficient by using socketpair(), it
794would have then been even less portable than it already is. The open2()
795and open3() functions are unlikely to work anywhere except on a Unix
796system or some other one purporting to be POSIX compliant.
797
798Here's an example of using open2():
799
800 use FileHandle;
801 use IPC::Open2;
5a964f20 802 $pid = open2(*Reader, *Writer, "cat -u -n" );
4633a7c4
LW
803 print Writer "stuff\n";
804 $got = <Reader>;
805
6a3992aa
DL
806The problem with this is that Unix buffering is really going to
807ruin your day. Even though your C<Writer> filehandle is auto-flushed,
4633a7c4 808and the process on the other end will get your data in a timely manner,
6a3992aa 809you can't usually do anything to force it to give it back to you
54310121 810in a similarly quick fashion. In this case, we could, because we
4633a7c4
LW
811gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix
812commands are designed to operate over pipes, so this seldom works
54310121 813unless you yourself wrote the program on the other end of the
4633a7c4
LW
814double-ended pipe.
815
54310121 816A solution to this is the nonstandard F<Comm.pl> library. It uses
4633a7c4
LW
817pseudo-ttys to make your program behave more reasonably:
818
819 require 'Comm.pl';
820 $ph = open_proc('cat -n');
821 for (1..10) {
822 print $ph "a line\n";
823 print "got back ", scalar <$ph>;
824 }
a0d0e21e 825
4633a7c4 826This way you don't have to have control over the source code of the
54310121
PP
827program you're using. The F<Comm> library also has expect()
828and interact() functions. Find the library (and we hope its
4633a7c4 829successor F<IPC::Chat>) at your nearest CPAN archive as detailed
184e9718 830in the SEE ALSO section below.
a0d0e21e 831
c8db1d39
TC
832The newer Expect.pm module from CPAN also addresses this kind of thing.
833This module requires two other modules from CPAN: IO::Pty and IO::Stty.
834It sets up a pseudo-terminal to interact with programs that insist on
a11adca0 835using talking to the terminal device driver. If your system is
c8db1d39
TC
836amongst those supported, this may be your best bet.
837
5a964f20
TC
838=head2 Bidirectional Communication with Yourself
839
840If you want, you may make low-level pipe() and fork()
841to stitch this together by hand. This example only
842talks to itself, but you could reopen the appropriate
843handles to STDIN and STDOUT and call other processes.
844
845 #!/usr/bin/perl -w
846 # pipe1 - bidirectional communication using two pipe pairs
847 # designed for the socketpair-challenged
848 use IO::Handle; # thousands of lines just for autoflush :-(
849 pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
850 pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
851 CHILD_WTR->autoflush(1);
852 PARENT_WTR->autoflush(1);
853
854 if ($pid = fork) {
855 close PARENT_RDR; close PARENT_WTR;
856 print CHILD_WTR "Parent Pid $$ is sending this\n";
857 chomp($line = <CHILD_RDR>);
858 print "Parent Pid $$ just read this: `$line'\n";
859 close CHILD_RDR; close CHILD_WTR;
860 waitpid($pid,0);
861 } else {
862 die "cannot fork: $!" unless defined $pid;
863 close CHILD_RDR; close CHILD_WTR;
864 chomp($line = <PARENT_RDR>);
865 print "Child Pid $$ just read this: `$line'\n";
866 print PARENT_WTR "Child Pid $$ is sending this\n";
867 close PARENT_RDR; close PARENT_WTR;
868 exit;
869 }
870
a11adca0 871But you don't actually have to make two pipe calls. If you
5a964f20
TC
872have the socketpair() system call, it will do this all for you.
873
874 #!/usr/bin/perl -w
875 # pipe2 - bidirectional communication using socketpair
876 # "the best ones always go both ways"
877
878 use Socket;
879 use IO::Handle; # thousands of lines just for autoflush :-(
880 # We say AF_UNIX because although *_LOCAL is the
881 # POSIX 1003.1g form of the constant, many machines
882 # still don't have it.
883 socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
884 or die "socketpair: $!";
885
886 CHILD->autoflush(1);
887 PARENT->autoflush(1);
888
889 if ($pid = fork) {
890 close PARENT;
891 print CHILD "Parent Pid $$ is sending this\n";
892 chomp($line = <CHILD>);
893 print "Parent Pid $$ just read this: `$line'\n";
894 close CHILD;
895 waitpid($pid,0);
896 } else {
897 die "cannot fork: $!" unless defined $pid;
898 close CHILD;
899 chomp($line = <PARENT>);
900 print "Child Pid $$ just read this: `$line'\n";
901 print PARENT "Child Pid $$ is sending this\n";
902 close PARENT;
903 exit;
904 }
905
4633a7c4 906=head1 Sockets: Client/Server Communication
a0d0e21e 907
6a3992aa 908While not limited to Unix-derived operating systems (e.g., WinSock on PCs
4633a7c4 909provides socket support, as do some VMS libraries), you may not have
184e9718 910sockets on your system, in which case this section probably isn't going to do
6a3992aa
DL
911you much good. With sockets, you can do both virtual circuits (i.e., TCP
912streams) and datagrams (i.e., UDP packets). You may be able to do even more
4633a7c4
LW
913depending on your system.
914
915The Perl function calls for dealing with sockets have the same names as
916the corresponding system calls in C, but their arguments tend to differ
917for two reasons: first, Perl filehandles work differently than C file
918descriptors. Second, Perl already knows the length of its strings, so you
919don't need to pass that information.
a0d0e21e 920
4633a7c4
LW
921One of the major problems with old socket code in Perl was that it used
922hard-coded values for some of the constants, which severely hurt
923portability. If you ever see code that does anything like explicitly
924setting C<$AF_INET = 2>, you know you're in for big trouble: An
925immeasurably superior approach is to use the C<Socket> module, which more
926reliably grants access to various constants and functions you'll need.
a0d0e21e 927
68dc0745
PP
928If you're not writing a server/client for an existing protocol like
929NNTP or SMTP, you should give some thought to how your server will
930know when the client has finished talking, and vice-versa. Most
931protocols are based on one-line messages and responses (so one party
4a6725af 932knows the other has finished when a "\n" is received) or multi-line
68dc0745
PP
933messages and responses that end with a period on an empty line
934("\n.\n" terminates a message/response).
935
5a964f20
TC
936=head2 Internet Line Terminators
937
938The Internet line terminator is "\015\012". Under ASCII variants of
939Unix, that could usually be written as "\r\n", but under other systems,
940"\r\n" might at times be "\015\015\012", "\012\012\015", or something
941completely different. The standards specify writing "\015\012" to be
942conformant (be strict in what you provide), but they also recommend
943accepting a lone "\012" on input (but be lenient in what you require).
944We haven't always been very good about that in the code in this manpage,
945but unless you're on a Mac, you'll probably be ok.
946
4633a7c4 947=head2 Internet TCP Clients and Servers
a0d0e21e 948
4633a7c4
LW
949Use Internet-domain sockets when you want to do client-server
950communication that might extend to machines outside of your own system.
951
952Here's a sample TCP client using Internet-domain sockets:
953
954 #!/usr/bin/perl -w
4633a7c4
LW
955 use strict;
956 use Socket;
957 my ($remote,$port, $iaddr, $paddr, $proto, $line);
958
959 $remote = shift || 'localhost';
960 $port = shift || 2345; # random port
961 if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
962 die "No port" unless $port;
963 $iaddr = inet_aton($remote) || die "no host: $remote";
964 $paddr = sockaddr_in($port, $iaddr);
965
966 $proto = getprotobyname('tcp');
967 socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
968 connect(SOCK, $paddr) || die "connect: $!";
54310121 969 while (defined($line = <SOCK>)) {
4633a7c4 970 print $line;
54310121 971 }
4633a7c4
LW
972
973 close (SOCK) || die "close: $!";
974 exit;
975
976And here's a corresponding server to go along with it. We'll
977leave the address as INADDR_ANY so that the kernel can choose
54310121 978the appropriate interface on multihomed hosts. If you want sit
c07a80fd
PP
979on a particular interface (like the external side of a gateway
980or firewall machine), you should fill this in with your real address
981instead.
982
983 #!/usr/bin/perl -Tw
c07a80fd
PP
984 use strict;
985 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
986 use Socket;
987 use Carp;
5865a7df 988 my $EOL = "\015\012";
c07a80fd 989
54310121 990 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
c07a80fd
PP
991
992 my $port = shift || 2345;
993 my $proto = getprotobyname('tcp');
51ee6500 994
5865a7df 995 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
6a3992aa 996
c07a80fd 997 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 998 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd
PP
999 pack("l", 1)) || die "setsockopt: $!";
1000 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
1001 listen(Server,SOMAXCONN) || die "listen: $!";
1002
1003 logmsg "server started on port $port";
1004
1005 my $paddr;
1006
1007 $SIG{CHLD} = \&REAPER;
1008
1009 for ( ; $paddr = accept(Client,Server); close Client) {
1010 my($port,$iaddr) = sockaddr_in($paddr);
1011 my $name = gethostbyaddr($iaddr,AF_INET);
1012
54310121
PP
1013 logmsg "connection from $name [",
1014 inet_ntoa($iaddr), "]
c07a80fd
PP
1015 at port $port";
1016
54310121 1017 print Client "Hello there, $name, it's now ",
5a964f20 1018 scalar localtime, $EOL;
54310121 1019 }
c07a80fd 1020
54310121
PP
1021And here's a multithreaded version. It's multithreaded in that
1022like most typical servers, it spawns (forks) a slave server to
c07a80fd
PP
1023handle the client request so that the master server can quickly
1024go back to service a new client.
4633a7c4
LW
1025
1026 #!/usr/bin/perl -Tw
4633a7c4
LW
1027 use strict;
1028 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
a0d0e21e 1029 use Socket;
4633a7c4 1030 use Carp;
5865a7df 1031 my $EOL = "\015\012";
a0d0e21e 1032
4633a7c4 1033 sub spawn; # forward declaration
54310121 1034 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
a0d0e21e 1035
4633a7c4
LW
1036 my $port = shift || 2345;
1037 my $proto = getprotobyname('tcp');
51ee6500 1038
5865a7df 1039 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
54310121 1040
c07a80fd 1041 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 1042 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd
PP
1043 pack("l", 1)) || die "setsockopt: $!";
1044 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
1045 listen(Server,SOMAXCONN) || die "listen: $!";
a0d0e21e 1046
4633a7c4 1047 logmsg "server started on port $port";
a0d0e21e 1048
4633a7c4
LW
1049 my $waitedpid = 0;
1050 my $paddr;
a0d0e21e 1051
816229cf 1052 use POSIX ":sys_wait_h";
c5ae6365
AW
1053 use Errno;
1054
54310121 1055 sub REAPER {
c5ae6365
AW
1056 local $!; # don't let waitpid() overwrite current error
1057 while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
1058 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
1059 }
abf724c9 1060 $SIG{CHLD} = \&REAPER; # loathe SysV
4633a7c4
LW
1061 }
1062
1063 $SIG{CHLD} = \&REAPER;
1064
c5ae6365
AW
1065 while(1) {
1066 $paddr = accept(Client, Server) || do {
1067 # try again if accept() returned because a signal was received
1068 next if $!{EINTR};
1069 die "accept: $!";
1070 };
1071 my ($port, $iaddr) = sockaddr_in($paddr);
1072 my $name = gethostbyaddr($iaddr, AF_INET);
1073
1074 logmsg "connection from $name [",
1075 inet_ntoa($iaddr),
1076 "] at port $port";
1077
1078 spawn sub {
1079 $|=1;
1080 print "Hello there, $name, it's now ", scalar localtime, $EOL;
1081 exec '/usr/games/fortune' # XXX: `wrong' line terminators
1082 or confess "can't exec fortune: $!";
1083 };
1084 close Client;
54310121 1085 }
a0d0e21e 1086
4633a7c4 1087 sub spawn {
c5ae6365
AW
1088 my $coderef = shift;
1089
1090 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
1091 confess "usage: spawn CODEREF";
1092 }
1093
1094 my $pid;
1095 if (! defined($pid = fork)) {
1096 logmsg "cannot fork: $!";
1097 return;
1098 }
1099 elsif ($pid) {
1100 logmsg "begat $pid";
1101 return; # I'm the parent
1102 }
1103 # else I'm the child -- go spawn
1104
1105 open(STDIN, "<&Client") || die "can't dup client to stdin";
1106 open(STDOUT, ">&Client") || die "can't dup client to stdout";
1107 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
1108 exit &$coderef();
54310121 1109 }
4633a7c4 1110
c5ae6365
AW
1111This server takes the trouble to clone off a child version via fork()
1112for each incoming request. That way it can handle many requests at
1113once, which you might not always want. Even if you don't fork(), the
1114listen() will allow that many pending connections. Forking servers
1115have to be particularly careful about cleaning up their dead children
1116(called "zombies" in Unix parlance), because otherwise you'll quickly
1117fill up your process table. The REAPER subroutine is used here to
1118call waitpid() for any child processes that have finished, thereby
1119ensuring that they terminate cleanly and don't join the ranks of the
1120living dead.
1121
1122Within the while loop we call accept() and check to see if it returns
1123a false value. This would normally indicate a system error that needs
1124to be reported. However the introduction of safe signals (see
1125L</Deferred Signals (Safe Signals)> above) in Perl 5.7.3 means that
1126accept() may also be interrupted when the process receives a signal.
1127This typically happens when one of the forked sub-processes exits and
1128notifies the parent process with a CHLD signal.
1129
1130If accept() is interrupted by a signal then $! will be set to EINTR.
1131If this happens then we can safely continue to the next iteration of
1132the loop and another call to accept(). It is important that your
1133signal handling code doesn't modify the value of $! or this test will
1134most likely fail. In the REAPER subroutine we create a local version
1135of $! before calling waitpid(). When waitpid() sets $! to ECHILD (as
1136it inevitably does when it has no more children waiting), it will
1137update the local copy leaving the original unchanged.
4633a7c4
LW
1138
1139We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
1140even if we aren't running setuid or setgid. This is always a good idea
1141for servers and other programs run on behalf of someone else (like CGI
1142scripts), because it lessens the chances that people from the outside will
1143be able to compromise your system.
1144
1145Let's look at another TCP client. This one connects to the TCP "time"
1146service on a number of different machines and shows how far their clocks
1147differ from the system on which it's being run:
1148
1149 #!/usr/bin/perl -w
4633a7c4
LW
1150 use strict;
1151 use Socket;
1152
1153 my $SECS_of_70_YEARS = 2208988800;
54310121 1154 sub ctime { scalar localtime(shift) }
4633a7c4 1155
54310121
PP
1156 my $iaddr = gethostbyname('localhost');
1157 my $proto = getprotobyname('tcp');
1158 my $port = getservbyname('time', 'tcp');
4633a7c4
LW
1159 my $paddr = sockaddr_in(0, $iaddr);
1160 my($host);
1161
1162 $| = 1;
1163 printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
1164
1165 foreach $host (@ARGV) {
1166 printf "%-24s ", $host;
1167 my $hisiaddr = inet_aton($host) || die "unknown host";
1168 my $hispaddr = sockaddr_in($port, $hisiaddr);
1169 socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
09a3ed31 1170 connect(SOCKET, $hispaddr) || die "connect: $!";
4633a7c4
LW
1171 my $rtime = ' ';
1172 read(SOCKET, $rtime, 4);
1173 close(SOCKET);
4358a253 1174 my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
4633a7c4 1175 printf "%8d %s\n", $histime - time, ctime($histime);
a0d0e21e
LW
1176 }
1177
4633a7c4
LW
1178=head2 Unix-Domain TCP Clients and Servers
1179
a2eb9003 1180That's fine for Internet-domain clients and servers, but what about local
4633a7c4
LW
1181communications? While you can use the same setup, sometimes you don't
1182want to. Unix-domain sockets are local to the current host, and are often
54310121 1183used internally to implement pipes. Unlike Internet domain sockets, Unix
4633a7c4
LW
1184domain sockets can show up in the file system with an ls(1) listing.
1185
5a964f20 1186 % ls -l /dev/log
4633a7c4 1187 srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
a0d0e21e 1188
4633a7c4
LW
1189You can test for these with Perl's B<-S> file test:
1190
1191 unless ( -S '/dev/log' ) {
3ba19564 1192 die "something's wicked with the log system";
54310121 1193 }
4633a7c4
LW
1194
1195Here's a sample Unix-domain client:
1196
1197 #!/usr/bin/perl -w
4633a7c4
LW
1198 use Socket;
1199 use strict;
1200 my ($rendezvous, $line);
1201
2359510d 1202 $rendezvous = shift || 'catsock';
4633a7c4 1203 socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
9607fc9c 1204 connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
54310121 1205 while (defined($line = <SOCK>)) {
4633a7c4 1206 print $line;
54310121 1207 }
4633a7c4
LW
1208 exit;
1209
5a964f20
TC
1210And here's a corresponding server. You don't have to worry about silly
1211network terminators here because Unix domain sockets are guaranteed
1212to be on the localhost, and thus everything works right.
4633a7c4
LW
1213
1214 #!/usr/bin/perl -Tw
4633a7c4
LW
1215 use strict;
1216 use Socket;
1217 use Carp;
1218
1219 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
5865a7df 1220 sub spawn; # forward declaration
5a964f20 1221 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
4633a7c4 1222
2359510d 1223 my $NAME = 'catsock';
4633a7c4
LW
1224 my $uaddr = sockaddr_un($NAME);
1225 my $proto = getprotobyname('tcp');
1226
c07a80fd 1227 socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
4633a7c4 1228 unlink($NAME);
c07a80fd
PP
1229 bind (Server, $uaddr) || die "bind: $!";
1230 listen(Server,SOMAXCONN) || die "listen: $!";
4633a7c4
LW
1231
1232 logmsg "server started on $NAME";
1233
5a964f20
TC
1234 my $waitedpid;
1235
816229cf 1236 use POSIX ":sys_wait_h";
5a964f20 1237 sub REAPER {
816229cf
NC
1238 my $child;
1239 while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
1240 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
1241 }
abf724c9 1242 $SIG{CHLD} = \&REAPER; # loathe SysV
5a964f20
TC
1243 }
1244
4633a7c4
LW
1245 $SIG{CHLD} = \&REAPER;
1246
5a964f20 1247
54310121
PP
1248 for ( $waitedpid = 0;
1249 accept(Client,Server) || $waitedpid;
1250 $waitedpid = 0, close Client)
4633a7c4
LW
1251 {
1252 next if $waitedpid;
1253 logmsg "connection on $NAME";
54310121 1254 spawn sub {
4633a7c4
LW
1255 print "Hello there, it's now ", scalar localtime, "\n";
1256 exec '/usr/games/fortune' or die "can't exec fortune: $!";
1257 };
54310121 1258 }
4633a7c4 1259
5865a7df
NC
1260 sub spawn {
1261 my $coderef = shift;
1262
1263 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
1264 confess "usage: spawn CODEREF";
1265 }
1266
1267 my $pid;
1268 if (!defined($pid = fork)) {
1269 logmsg "cannot fork: $!";
1270 return;
1271 } elsif ($pid) {
1272 logmsg "begat $pid";
1273 return; # I'm the parent
1274 }
1275 # else I'm the child -- go spawn
1276
1277 open(STDIN, "<&Client") || die "can't dup client to stdin";
1278 open(STDOUT, ">&Client") || die "can't dup client to stdout";
1279 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
1280 exit &$coderef();
1281 }
1282
4633a7c4
LW
1283As you see, it's remarkably similar to the Internet domain TCP server, so
1284much so, in fact, that we've omitted several duplicate functions--spawn(),
1285logmsg(), ctime(), and REAPER()--which are exactly the same as in the
1286other server.
1287
1288So why would you ever want to use a Unix domain socket instead of a
1289simpler named pipe? Because a named pipe doesn't give you sessions. You
1290can't tell one process's data from another's. With socket programming,
1291you get a separate session for each client: that's why accept() takes two
1292arguments.
1293
1294For example, let's say that you have a long running database server daemon
1295that you want folks from the World Wide Web to be able to access, but only
1296if they go through a CGI interface. You'd have a small, simple CGI
1297program that does whatever checks and logging you feel like, and then acts
1298as a Unix-domain client and connects to your private server.
1299
7b05b7e3
TC
1300=head1 TCP Clients with IO::Socket
1301
1302For those preferring a higher-level interface to socket programming, the
1303IO::Socket module provides an object-oriented approach. IO::Socket is
1304included as part of the standard Perl distribution as of the 5.004
1305release. If you're running an earlier version of Perl, just fetch
106325ad 1306IO::Socket from CPAN, where you'll also find modules providing easy
7b05b7e3
TC
1307interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
1308NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
1309to name a few.
1310
1311=head2 A Simple Client
1312
1313Here's a client that creates a TCP connection to the "daytime"
1314service at port 13 of the host name "localhost" and prints out everything
1315that the server there cares to provide.
1316
1317 #!/usr/bin/perl -w
1318 use IO::Socket;
1319 $remote = IO::Socket::INET->new(
1320 Proto => "tcp",
1321 PeerAddr => "localhost",
1322 PeerPort => "daytime(13)",
1323 )
1324 or die "cannot connect to daytime port at localhost";
1325 while ( <$remote> ) { print }
1326
1327When you run this program, you should get something back that
1328looks like this:
1329
1330 Wed May 14 08:40:46 MDT 1997
1331
1332Here are what those parameters to the C<new> constructor mean:
1333
13a2d996 1334=over 4
7b05b7e3
TC
1335
1336=item C<Proto>
1337
1338This is which protocol to use. In this case, the socket handle returned
1339will be connected to a TCP socket, because we want a stream-oriented
1340connection, that is, one that acts pretty much like a plain old file.
1341Not all sockets are this of this type. For example, the UDP protocol
1342can be used to make a datagram socket, used for message-passing.
1343
1344=item C<PeerAddr>
1345
1346This is the name or Internet address of the remote host the server is
1347running on. We could have specified a longer name like C<"www.perl.com">,
1348or an address like C<"204.148.40.9">. For demonstration purposes, we've
1349used the special hostname C<"localhost">, which should always mean the
1350current machine you're running on. The corresponding Internet address
1351for localhost is C<"127.1">, if you'd rather use that.
1352
1353=item C<PeerPort>
1354
1355This is the service name or port number we'd like to connect to.
1356We could have gotten away with using just C<"daytime"> on systems with a
1357well-configured system services file,[FOOTNOTE: The system services file
1358is in I</etc/services> under Unix] but just in case, we've specified the
1359port number (13) in parentheses. Using just the number would also have
1360worked, but constant numbers make careful programmers nervous.
1361
1362=back
1363
1364Notice how the return value from the C<new> constructor is used as
1365a filehandle in the C<while> loop? That's what's called an indirect
1366filehandle, a scalar variable containing a filehandle. You can use
1367it the same way you would a normal filehandle. For example, you
1368can read one line from it this way:
1369
1370 $line = <$handle>;
1371
1372all remaining lines from is this way:
1373
1374 @lines = <$handle>;
1375
1376and send a line of data to it this way:
1377
1378 print $handle "some data\n";
1379
1380=head2 A Webget Client
1381
1382Here's a simple client that takes a remote host to fetch a document
1383from, and then a list of documents to get from that host. This is a
1384more interesting client than the previous one because it first sends
1385something to the server before fetching the server's response.
1386
1387 #!/usr/bin/perl -w
1388 use IO::Socket;
1389 unless (@ARGV > 1) { die "usage: $0 host document ..." }
1390 $host = shift(@ARGV);
5a964f20
TC
1391 $EOL = "\015\012";
1392 $BLANK = $EOL x 2;
7b05b7e3
TC
1393 foreach $document ( @ARGV ) {
1394 $remote = IO::Socket::INET->new( Proto => "tcp",
1395 PeerAddr => $host,
1396 PeerPort => "http(80)",
1397 );
1398 unless ($remote) { die "cannot connect to http daemon on $host" }
1399 $remote->autoflush(1);
5a964f20 1400 print $remote "GET $document HTTP/1.0" . $BLANK;
7b05b7e3
TC
1401 while ( <$remote> ) { print }
1402 close $remote;
1403 }
1404
1405The web server handing the "http" service, which is assumed to be at
4375e838 1406its standard port, number 80. If the web server you're trying to
7b05b7e3 1407connect to is at a different port (like 1080 or 8080), you should specify
c47ff5f1 1408as the named-parameter pair, C<< PeerPort => 8080 >>. The C<autoflush>
7b05b7e3
TC
1409method is used on the socket because otherwise the system would buffer
1410up the output we sent it. (If you're on a Mac, you'll also need to
1411change every C<"\n"> in your code that sends data over the network to
1412be a C<"\015\012"> instead.)
1413
1414Connecting to the server is only the first part of the process: once you
1415have the connection, you have to use the server's language. Each server
1416on the network has its own little command language that it expects as
1417input. The string that we send to the server starting with "GET" is in
1418HTTP syntax. In this case, we simply request each specified document.
1419Yes, we really are making a new connection for each document, even though
1420it's the same host. That's the way you always used to have to speak HTTP.
1421Recent versions of web browsers may request that the remote server leave
1422the connection open a little while, but the server doesn't have to honor
1423such a request.
1424
1425Here's an example of running that program, which we'll call I<webget>:
1426
5a964f20 1427 % webget www.perl.com /guanaco.html
7b05b7e3
TC
1428 HTTP/1.1 404 File Not Found
1429 Date: Thu, 08 May 1997 18:02:32 GMT
1430 Server: Apache/1.2b6
1431 Connection: close
1432 Content-type: text/html
1433
1434 <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
1435 <BODY><H1>File Not Found</H1>
1436 The requested URL /guanaco.html was not found on this server.<P>
1437 </BODY>
1438
1439Ok, so that's not very interesting, because it didn't find that
1440particular document. But a long response wouldn't have fit on this page.
1441
1442For a more fully-featured version of this program, you should look to
1443the I<lwp-request> program included with the LWP modules from CPAN.
1444
1445=head2 Interactive Client with IO::Socket
1446
1447Well, that's all fine if you want to send one command and get one answer,
1448but what about setting up something fully interactive, somewhat like
1449the way I<telnet> works? That way you can type a line, get the answer,
1450type a line, get the answer, etc.
1451
1452This client is more complicated than the two we've done so far, but if
1453you're on a system that supports the powerful C<fork> call, the solution
1454isn't that rough. Once you've made the connection to whatever service
1455you'd like to chat with, call C<fork> to clone your process. Each of
1456these two identical process has a very simple job to do: the parent
1457copies everything from the socket to standard output, while the child
1458simultaneously copies everything from standard input to the socket.
1459To accomplish the same thing using just one process would be I<much>
1460harder, because it's easier to code two processes to do one thing than it
1461is to code one process to do two things. (This keep-it-simple principle
5a964f20
TC
1462a cornerstones of the Unix philosophy, and good software engineering as
1463well, which is probably why it's spread to other systems.)
7b05b7e3
TC
1464
1465Here's the code:
1466
1467 #!/usr/bin/perl -w
1468 use strict;
1469 use IO::Socket;
1470 my ($host, $port, $kidpid, $handle, $line);
1471
1472 unless (@ARGV == 2) { die "usage: $0 host port" }
1473 ($host, $port) = @ARGV;
1474
1475 # create a tcp connection to the specified host and port
1476 $handle = IO::Socket::INET->new(Proto => "tcp",
1477 PeerAddr => $host,
1478 PeerPort => $port)
1479 or die "can't connect to port $port on $host: $!";
1480
1481 $handle->autoflush(1); # so output gets there right away
1482 print STDERR "[Connected to $host:$port]\n";
1483
1484 # split the program into two processes, identical twins
1485 die "can't fork: $!" unless defined($kidpid = fork());
1486
1487 # the if{} block runs only in the parent process
1488 if ($kidpid) {
1489 # copy the socket to standard output
1490 while (defined ($line = <$handle>)) {
1491 print STDOUT $line;
1492 }
1493 kill("TERM", $kidpid); # send SIGTERM to child
1494 }
1495 # the else{} block runs only in the child process
1496 else {
1497 # copy standard input to the socket
1498 while (defined ($line = <STDIN>)) {
1499 print $handle $line;
1500 }
1501 }
1502
1503The C<kill> function in the parent's C<if> block is there to send a
1504signal to our child process (current running in the C<else> block)
1505as soon as the remote server has closed its end of the connection.
1506
7b05b7e3
TC
1507If the remote server sends data a byte at time, and you need that
1508data immediately without waiting for a newline (which might not happen),
1509you may wish to replace the C<while> loop in the parent with the
1510following:
1511
1512 my $byte;
1513 while (sysread($handle, $byte, 1) == 1) {
1514 print STDOUT $byte;
1515 }
1516
1517Making a system call for each byte you want to read is not very efficient
1518(to put it mildly) but is the simplest to explain and works reasonably
1519well.
1520
1521=head1 TCP Servers with IO::Socket
1522
5a964f20 1523As always, setting up a server is little bit more involved than running a client.
7b05b7e3
TC
1524The model is that the server creates a special kind of socket that
1525does nothing but listen on a particular port for incoming connections.
c47ff5f1 1526It does this by calling the C<< IO::Socket::INET->new() >> method with
7b05b7e3
TC
1527slightly different arguments than the client did.
1528
13a2d996 1529=over 4
7b05b7e3
TC
1530
1531=item Proto
1532
1533This is which protocol to use. Like our clients, we'll
1534still specify C<"tcp"> here.
1535
1536=item LocalPort
1537
1538We specify a local
1539port in the C<LocalPort> argument, which we didn't do for the client.
1540This is service name or port number for which you want to be the
1541server. (Under Unix, ports under 1024 are restricted to the
1542superuser.) In our sample, we'll use port 9000, but you can use
1543any port that's not currently in use on your system. If you try
1544to use one already in used, you'll get an "Address already in use"
19799a22 1545message. Under Unix, the C<netstat -a> command will show
7b05b7e3
TC
1546which services current have servers.
1547
1548=item Listen
1549
1550The C<Listen> parameter is set to the maximum number of
1551pending connections we can accept until we turn away incoming clients.
1552Think of it as a call-waiting queue for your telephone.
1553The low-level Socket module has a special symbol for the system maximum, which
1554is SOMAXCONN.
1555
1556=item Reuse
1557
1558The C<Reuse> parameter is needed so that we restart our server
1559manually without waiting a few minutes to allow system buffers to
1560clear out.
1561
1562=back
1563
1564Once the generic server socket has been created using the parameters
1565listed above, the server then waits for a new client to connect
d1be9408
JF
1566to it. The server blocks in the C<accept> method, which eventually accepts a
1567bidirectional connection from the remote client. (Make sure to autoflush
7b05b7e3
TC
1568this handle to circumvent buffering.)
1569
1570To add to user-friendliness, our server prompts the user for commands.
1571Most servers don't do this. Because of the prompt without a newline,
1572you'll have to use the C<sysread> variant of the interactive client above.
1573
1574This server accepts one of five different commands, sending output
1575back to the client. Note that unlike most network servers, this one
1576only handles one incoming client at a time. Multithreaded servers are
f83494b9 1577covered in Chapter 6 of the Camel.
7b05b7e3
TC
1578
1579Here's the code. We'll
1580
1581 #!/usr/bin/perl -w
1582 use IO::Socket;
1583 use Net::hostent; # for OO version of gethostbyaddr
1584
1585 $PORT = 9000; # pick something not in use
1586
1587 $server = IO::Socket::INET->new( Proto => 'tcp',
1588 LocalPort => $PORT,
1589 Listen => SOMAXCONN,
1590 Reuse => 1);
1591
1592 die "can't setup server" unless $server;
1593 print "[Server $0 accepting clients]\n";
1594
1595 while ($client = $server->accept()) {
1596 $client->autoflush(1);
1597 print $client "Welcome to $0; type help for command list.\n";
1598 $hostinfo = gethostbyaddr($client->peeraddr);
78fc38e1 1599 printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
7b05b7e3
TC
1600 print $client "Command? ";
1601 while ( <$client>) {
1602 next unless /\S/; # blank line
1603 if (/quit|exit/i) { last; }
1604 elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
1605 elsif (/who/i ) { print $client `who 2>&1`; }
1606 elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
1607 elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
1608 else {
1609 print $client "Commands: quit date who cookie motd\n";
1610 }
1611 } continue {
1612 print $client "Command? ";
1613 }
1614 close $client;
1615 }
1616
1617=head1 UDP: Message Passing
4633a7c4
LW
1618
1619Another kind of client-server setup is one that uses not connections, but
1620messages. UDP communications involve much lower overhead but also provide
1621less reliability, as there are no promises that messages will arrive at
1622all, let alone in order and unmangled. Still, UDP offers some advantages
1623over TCP, including being able to "broadcast" or "multicast" to a whole
1624bunch of destination hosts at once (usually on your local subnet). If you
1625find yourself overly concerned about reliability and start building checks
6a3992aa 1626into your message system, then you probably should use just TCP to start
4633a7c4
LW
1627with.
1628
90034919
LC
1629Note that UDP datagrams are I<not> a bytestream and should not be treated
1630as such. This makes using I/O mechanisms with internal buffering
1631like stdio (i.e. print() and friends) especially cumbersome. Use syswrite(),
1632or better send(), like in the example below.
1633
4633a7c4 1634Here's a UDP program similar to the sample Internet TCP client given
7b05b7e3 1635earlier. However, instead of checking one host at a time, the UDP version
4633a7c4
LW
1636will check many of them asynchronously by simulating a multicast and then
1637using select() to do a timed-out wait for I/O. To do something similar
1638with TCP, you'd have to use a different socket handle for each host.
1639
1640 #!/usr/bin/perl -w
1641 use strict;
4633a7c4
LW
1642 use Socket;
1643 use Sys::Hostname;
1644
54310121
PP
1645 my ( $count, $hisiaddr, $hispaddr, $histime,
1646 $host, $iaddr, $paddr, $port, $proto,
4633a7c4
LW
1647 $rin, $rout, $rtime, $SECS_of_70_YEARS);
1648
1649 $SECS_of_70_YEARS = 2208988800;
1650
1651 $iaddr = gethostbyname(hostname());
1652 $proto = getprotobyname('udp');
1653 $port = getservbyname('time', 'udp');
1654 $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1655
1656 socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
1657 bind(SOCKET, $paddr) || die "bind: $!";
1658
1659 $| = 1;
1660 printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
1661 $count = 0;
1662 for $host (@ARGV) {
1663 $count++;
1664 $hisiaddr = inet_aton($host) || die "unknown host";
1665 $hispaddr = sockaddr_in($port, $hisiaddr);
1666 defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
1667 }
1668
1669 $rin = '';
1670 vec($rin, fileno(SOCKET), 1) = 1;
1671
1672 # timeout after 10.0 seconds
1673 while ($count && select($rout = $rin, undef, undef, 10.0)) {
1674 $rtime = '';
1675 ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
1676 ($port, $hisiaddr) = sockaddr_in($hispaddr);
1677 $host = gethostbyaddr($hisiaddr, AF_INET);
4358a253 1678 $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
4633a7c4
LW
1679 printf "%-12s ", $host;
1680 printf "%8d %s\n", $histime - time, scalar localtime($histime);
1681 $count--;
1682 }
1683
90034919
LC
1684Note that this example does not include any retries and may consequently
1685fail to contact a reachable host. The most prominent reason for this
1686is congestion of the queues on the sending host if the number of
a31a806a 1687list of hosts to contact is sufficiently large.
90034919 1688
4633a7c4
LW
1689=head1 SysV IPC
1690
1691While System V IPC isn't so widely used as sockets, it still has some
1692interesting uses. You can't, however, effectively use SysV IPC or
1693Berkeley mmap() to have shared memory so as to share a variable amongst
1694several processes. That's because Perl would reallocate your string when
1695you weren't wanting it to.
1696
54310121 1697Here's a small example showing shared memory usage.
a0d0e21e 1698
7b34eba2 1699 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
0ade1984 1700
a0d0e21e 1701 $size = 2000;
3365b412 1702 $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) // die "$!";
41d6edb2 1703 print "shm key $id\n";
a0d0e21e
LW
1704
1705 $message = "Message #1";
41d6edb2 1706 shmwrite($id, $message, 0, 60) || die "$!";
0ade1984 1707 print "wrote: '$message'\n";
41d6edb2 1708 shmread($id, $buff, 0, 60) || die "$!";
0ade1984 1709 print "read : '$buff'\n";
a0d0e21e 1710
0ade1984
JH
1711 # the buffer of shmread is zero-character end-padded.
1712 substr($buff, index($buff, "\0")) = '';
1713 print "un" unless $buff eq $message;
1714 print "swell\n";
a0d0e21e 1715
41d6edb2
JH
1716 print "deleting shm $id\n";
1717 shmctl($id, IPC_RMID, 0) || die "$!";
a0d0e21e
LW
1718
1719Here's an example of a semaphore:
1720
0ade1984
JH
1721 use IPC::SysV qw(IPC_CREAT);
1722
a0d0e21e 1723 $IPC_KEY = 1234;
3365b412 1724 $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) // die "$!";
41d6edb2 1725 print "shm key $id\n";
a0d0e21e 1726
a2eb9003 1727Put this code in a separate file to be run in more than one process.
a0d0e21e
LW
1728Call the file F<take>:
1729
1730 # create a semaphore
1731
1732 $IPC_KEY = 1234;
41d6edb2
JH
1733 $id = semget($IPC_KEY, 0 , 0 );
1734 die if !defined($id);
a0d0e21e
LW
1735
1736 $semnum = 0;
1737 $semflag = 0;
1738
1739 # 'take' semaphore
1740 # wait for semaphore to be zero
1741 $semop = 0;
41d6edb2 1742 $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e
LW
1743
1744 # Increment the semaphore count
1745 $semop = 1;
41d6edb2 1746 $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e
LW
1747 $opstring = $opstring1 . $opstring2;
1748
41d6edb2 1749 semop($id,$opstring) || die "$!";
a0d0e21e 1750
a2eb9003 1751Put this code in a separate file to be run in more than one process.
a0d0e21e
LW
1752Call this file F<give>:
1753
4633a7c4 1754 # 'give' the semaphore
a0d0e21e
LW
1755 # run this in the original process and you will see
1756 # that the second process continues
1757
1758 $IPC_KEY = 1234;
41d6edb2
JH
1759 $id = semget($IPC_KEY, 0, 0);
1760 die if !defined($id);
a0d0e21e
LW
1761
1762 $semnum = 0;
1763 $semflag = 0;
1764
1765 # Decrement the semaphore count
1766 $semop = -1;
41d6edb2 1767 $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1768
41d6edb2 1769 semop($id,$opstring) || die "$!";
a0d0e21e 1770
7b05b7e3 1771The SysV IPC code above was written long ago, and it's definitely
0ade1984
JH
1772clunky looking. For a more modern look, see the IPC::SysV module
1773which is included with Perl starting from Perl 5.005.
4633a7c4 1774
41d6edb2
JH
1775A small example demonstrating SysV message queues:
1776
7b34eba2 1777 use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);
41d6edb2 1778
7b34eba2 1779 my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
41d6edb2
JH
1780
1781 my $sent = "message";
e343e2e2 1782 my $type_sent = 1234;
41d6edb2
JH
1783 my $rcvd;
1784 my $type_rcvd;
1785
1786 if (defined $id) {
1787 if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
1788 if (msgrcv($id, $rcvd, 60, 0, 0)) {
1789 ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
1790 if ($rcvd eq $sent) {
1791 print "okay\n";
1792 } else {
1793 print "not okay\n";
1794 }
1795 } else {
1796 die "# msgrcv failed\n";
1797 }
1798 } else {
1799 die "# msgsnd failed\n";
1800 }
1801 msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
1802 } else {
1803 die "# msgget failed\n";
1804 }
1805
4633a7c4
LW
1806=head1 NOTES
1807
5a964f20
TC
1808Most of these routines quietly but politely return C<undef> when they
1809fail instead of causing your program to die right then and there due to
1810an uncaught exception. (Actually, some of the new I<Socket> conversion
1811functions croak() on bad arguments.) It is therefore essential to
1812check return values from these functions. Always begin your socket
1813programs this way for optimal success, and don't forget to add B<-T>
1814taint checking flag to the #! line for servers:
4633a7c4 1815
5a964f20 1816 #!/usr/bin/perl -Tw
4633a7c4
LW
1817 use strict;
1818 use sigtrap;
1819 use Socket;
1820
1821=head1 BUGS
1822
1823All these routines create system-specific portability problems. As noted
1824elsewhere, Perl is at the mercy of your C libraries for much of its system
1825behaviour. It's probably safest to assume broken SysV semantics for
6a3992aa 1826signals and to stick with simple TCP and UDP socket operations; e.g., don't
a2eb9003 1827try to pass open file descriptors over a local UDP datagram socket if you
4633a7c4
LW
1828want your code to stand a chance of being portable.
1829
4633a7c4
LW
1830=head1 AUTHOR
1831
1832Tom Christiansen, with occasional vestiges of Larry Wall's original
7b05b7e3 1833version and suggestions from the Perl Porters.
4633a7c4
LW
1834
1835=head1 SEE ALSO
1836
7b05b7e3
TC
1837There's a lot more to networking than this, but this should get you
1838started.
1839
c04e1326
AL
1840For intrepid programmers, the indispensable textbook is I<Unix
1841Network Programming, 2nd Edition, Volume 1> by W. Richard Stevens
1842(published by Prentice-Hall). Note that most books on networking
1843address the subject from the perspective of a C programmer; translation
1844to Perl is left as an exercise for the reader.
7b05b7e3
TC
1845
1846The IO::Socket(3) manpage describes the object library, and the Socket(3)
1847manpage describes the low-level interface to sockets. Besides the obvious
1848functions in L<perlfunc>, you should also check out the F<modules> file
1849at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
1850FAQ> for a description of what CPAN is and where to get it.)
1851
4633a7c4 1852Section 5 of the F<modules> file is devoted to "Networking, Device Control
6a3992aa 1853(modems), and Interprocess Communication", and contains numerous unbundled
4633a7c4
LW
1854modules numerous networking modules, Chat and Expect operations, CGI
1855programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1856Threads, and ToolTalk--just to name a few.