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