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