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