Integrate perlio:
[p5sagit/p5-mst-13.2.git] / pod / perlipc.pod
CommitLineData
a0d0e21e 1=head1 NAME
2
184e9718 3perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
a0d0e21e 4
5=head1 DESCRIPTION
6
4633a7c4 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 20hitting file size limit.
21
22For example, to trap an interrupt signal, set up a handler like this.
7b05b7e3 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 28
29 sub catch_zap {
30 my $signame = shift;
31 $shucks++;
32 die "Somebody sent me a SIG$signame";
54310121 33 }
4633a7c4 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 51
52 print "signal #17 = $signame[17]\n";
54310121 53 if ($signo{ALRM}) {
4633a7c4 54 print "SIGALRM is $signo{ALRM}\n";
54310121 55 }
4633a7c4 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 59default thing.
60
19799a22 61On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
f648820c 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 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 79 sub more_functions {
80 # interrupts still ignored, for now...
54310121 81 }
4633a7c4 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 87
88 {
89 local $SIG{HUP} = 'IGNORE';
90 kill HUP => -$$;
91 # snazzy writing of: kill('HUP', -$$)
92 }
a0d0e21e 93
4633a7c4 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 98 unless (kill 0 => $kid_pid) {
99 warn "something wicked happened to $kid_pid";
54310121 100 }
a0d0e21e 101
4633a7c4 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 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 117 # loathe sysV: it makes us not only reinstate
118 # the handler, but place it after the wait
54310121 119 $SIG{CHLD} = \&REAPER;
4633a7c4 120 }
121 $SIG{CHLD} = \&REAPER;
122 # now do something that forks...
123
816229cf 124or better still:
4633a7c4 125
6a3992aa 126 use POSIX ":sys_wait_h";
54310121 127 sub REAPER {
4633a7c4 128 my $child;
816229cf 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.
1450d070 133 while (($child = waitpid(-1,WNOHANG)) > 0) {
4633a7c4 134 $Kid_Status{$child} = $?;
54310121 135 }
6a3992aa 136 $SIG{CHLD} = \&REAPER; # still loathe sysV
4633a7c4 137 }
138 $SIG{CHLD} = \&REAPER;
139 # do something that forks...
140
141Signal handling is also used for timeouts in Unix, While safely
142protected within an C<eval{}> block, you set a signal handler to trap
143alarm signals and then schedule to have one delivered to you in some
144number of seconds. Then try your blocking operation, clearing the alarm
145when it's done but not before you've exited your C<eval{}> block. If it
146goes off, you'll use die() to jump out of the block, much as you might
147using longjmp() or throw() in other languages.
148
149Here's an example:
150
54310121 151 eval {
4633a7c4 152 local $SIG{ALRM} = sub { die "alarm clock restart" };
54310121 153 alarm 10;
4633a7c4 154 flock(FH, 2); # blocking write lock
54310121 155 alarm 0;
4633a7c4 156 };
157 if ($@ and $@ !~ /alarm clock restart/) { die }
158
8a4f6ac2 159If the operation being timed out is system() or qx(), this technique
160is liable to generate zombies. If this matters to you, you'll
161need to do your own fork() and exec(), and kill the errant child process.
162
4633a7c4 163For more complex signal handling, you might see the standard POSIX
164module. Lamentably, this is almost entirely undocumented, but
165the F<t/lib/posix.t> file from the Perl source distribution has some
166examples in it.
167
168=head1 Named Pipes
169
170A named pipe (often referred to as a FIFO) is an old Unix IPC
171mechanism for processes communicating on the same machine. It works
54310121 172just like a regular, connected anonymous pipes, except that the
4633a7c4 173processes rendezvous using a filename and don't have to be related.
174
175To create a named pipe, use the Unix command mknod(1) or on some
176systems, 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";
54310121 181 if ( system('mknod', $path, 'p')
4633a7c4 182 && system('mkfifo', $path) )
183 {
5a964f20 184 die "mk{nod,fifo} $path failed";
54310121 185 }
4633a7c4 186
187
188A fifo is convenient when you want to connect a process to an unrelated
189one. When you open a fifo, the program will block until there's something
54310121 190on the other end.
4633a7c4 191
192For example, let's say you'd like to have your F<.signature> file be a
193named pipe that has a Perl program on the other end. Now every time any
6a3992aa 194program (like a mailer, news reader, finger program, etc.) tries to read
4633a7c4 195from that file, the reading program will block and your program will
6a3992aa 196supply the new signature. We'll use the pipe-checking file test B<-p>
4633a7c4 197to 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;
54310121 206 system('mknod', $FIFO, 'p')
4633a7c4 207 && die "can't mknod $FIFO: $!";
54310121 208 }
4633a7c4 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;
6a3992aa 214 sleep 2; # to avoid dup signals
4633a7c4 215 }
a0d0e21e 216
5a964f20 217=head2 WARNING
218
219By installing Perl code to deal with signals, you're exposing yourself
220to danger from two things. First, few system library functions are
221re-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
223same function again, you could get unpredictable behavior--often, a
224core dump. Second, Perl isn't itself re-entrant at the lowest levels.
225If the signal interrupts Perl while Perl is changing its own internal
226data structures, similarly unpredictable behaviour may result.
227
228There are two things you can do, knowing this: be paranoid or be
229pragmatic. The paranoid approach is to do as little as possible in your
230signal handler. Set an existing integer variable that already has a
231value, and return. This doesn't help you if you're in a slow system call,
232which will just restart. That means you have to C<die> to longjump(3) out
233of the handler. Even this is a little cavalier for the true paranoiac,
234who avoids C<die> in a handler because the system I<is> out to get you.
235The pragmatic approach is to say ``I know the risks, but prefer the
236convenience'', and to do anything you want in your signal handler,
237prepared to clean up core dumps now and again.
238
239To forbid signal handlers altogether would bars you from
240many interesting programs, including virtually everything in this manpage,
f783e543 241since you could no longer even write SIGCHLD handlers.
5a964f20 242
a0d0e21e 243
4633a7c4 244=head1 Using open() for IPC
245
246Perl's basic open() statement can also be used for unidirectional interprocess
247communication by either appending or prepending a pipe symbol to the second
a2eb9003 248argument to open(). Here's how to start something up in a child process you
4633a7c4 249intend to write to:
250
54310121 251 open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
4633a7c4 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
257And 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;
54310121 264 }
a2eb9003 265 close STATUS || die "bad netstat: $! $?";
4633a7c4 266
267If one can be sure that a particular program is a Perl script that is
268expecting filenames in @ARGV, the clever programmer can write something
269like this:
270
5a964f20 271 % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
4633a7c4 272
273and irrespective of which shell it's called from, the Perl program will
274read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
275in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
276file. Pretty nifty, eh?
277
54310121 278You might notice that you could use backticks for much the
4633a7c4 279same effect as opening a pipe for reading:
280
281 print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
282 die "bad netstat" if $?;
283
284While this is true on the surface, it's much more efficient to process the
285file one line or record at a time because then you don't have to read the
19799a22 286whole thing into memory at once. It also gives you finer control of the
4633a7c4 287whole process, letting you to kill off the child process early if you'd
288like.
289
290Be careful to check both the open() and the close() return values. If
291you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise,
292think of what happens when you start up a pipe to a command that doesn't
293exist: the open() will in all likelihood succeed (it only reflects the
294fork()'s success), but then your output will fail--spectacularly. Perl
295can't know whether the command worked because your command is actually
296running in a separate process whose exec() might have failed. Therefore,
6a3992aa 297while readers of bogus commands return just a quick end of file, writers
4633a7c4 298to bogus command will trigger a signal they'd better be prepared to
299handle. Consider:
300
5a964f20 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
305That won't blow up until the close, and it will blow up with a SIGPIPE.
306To 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=$?";
4633a7c4 312
68dc0745 313=head2 Filehandles
314
5a964f20 315Both the main process and any child processes it forks share the same
316STDIN, STDOUT, and STDERR filehandles. If both processes try to access
45bc9206 317them at once, strange things can happen. You may also want to close
5a964f20 318or reopen the filehandles for the child. You can get around this by
319opening your pipe with open(), but on some systems this means that the
320child process cannot outlive the parent.
68dc0745 321
322=head2 Background Processes
323
324You can run a command in the background with:
325
7b05b7e3 326 system("cmd &");
68dc0745 327
328The command's STDOUT and STDERR (and possibly STDIN, depending on your
329shell) will be the same as the parent's. You won't need to catch
330SIGCHLD because of the double-fork taking place (see below for more
331details).
332
333=head2 Complete Dissociation of Child from Parent
334
335In some cases (starting server processes, for instance) you'll want to
893af57a 336completely dissociate the child process from the parent. This is
337often called daemonization. A well behaved daemon will also chdir()
338to the root directory (so it doesn't prevent unmounting the filesystem
339containing the directory from which it was launched) and redirect its
340standard file descriptors from and to F</dev/null> (so that random
341output 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 }
5a964f20 355
893af57a 356The fork() has to come before the setsid() to ensure that you aren't a
357process group leader (the setsid() will fail if you are). If your
358system doesn't have the setsid() function, open F</dev/tty> and use the
359C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
5a964f20 360
893af57a 361Non-Unix users should check their Your_OS::Process module for other
362solutions.
68dc0745 363
4633a7c4 364=head2 Safe Pipe Opens
365
366Another interesting approach to IPC is making your single program go
367multiprocess and communicate between (or even amongst) yourselves. The
368open() function will accept a file argument of either C<"-|"> or C<"|-">
369to do a very interesting thing: it forks a child connected to the
370filehandle you've opened. The child is running the same program as the
371parent. This is useful for safely opening a file when running under an
372assumed UID or GID, for example. If you open a pipe I<to> minus, you can
373write to the filehandle you opened and your kid will find it in his
374STDIN. If you open a pipe I<from> minus, you can read from the filehandle
375you opened whatever your kid writes to his STDOUT.
376
a1ce9542 377 use English '-no_match_vars';
4633a7c4 378 my $sleep_count = 0;
379
54310121 380 do {
c07a80fd 381 $pid = open(KID_TO_WRITE, "|-");
4633a7c4 382 unless (defined $pid) {
383 warn "cannot fork: $!";
384 die "bailing out" if $sleep_count++ > 6;
385 sleep 10;
54310121 386 }
4633a7c4 387 } until defined $pid;
388
389 if ($pid) { # parent
c07a80fd 390 print KID_TO_WRITE @some_data;
391 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4 392 } else { # child
393 ($EUID, $EGID) = ($UID, $GID); # suid progs only
54310121 394 open (FILE, "> /safe/file")
4633a7c4 395 || die "can't open /safe/file: $!";
396 while (<STDIN>) {
397 print FILE; # child's STDIN is parent's KID
54310121 398 }
4633a7c4 399 exit; # don't forget this
54310121 400 }
4633a7c4 401
402Another common use for this construct is when you need to execute
403something without the shell's interference. With system(), it's
54310121 404straightforward, but you can't use a pipe open or backticks safely.
4633a7c4 405That's because there's no way to stop the shell from getting its hands on
406your arguments. Instead, use lower-level control to call exec() directly.
407
54310121 408Here's a safe backtick or pipe open for read:
4633a7c4 409
410 # add error processing as above
c07a80fd 411 $pid = open(KID_TO_READ, "-|");
4633a7c4 412
413 if ($pid) { # parent
c07a80fd 414 while (<KID_TO_READ>) {
4633a7c4 415 # do something interesting
54310121 416 }
c07a80fd 417 close(KID_TO_READ) || warn "kid exited $?";
4633a7c4 418
419 } else { # child
420 ($EUID, $EGID) = ($UID, $GID); # suid only
421 exec($program, @options, @args)
422 || die "can't exec program: $!";
423 # NOTREACHED
54310121 424 }
4633a7c4 425
426
427And here's a safe pipe open for writing:
428
429 # add error processing as above
c07a80fd 430 $pid = open(KID_TO_WRITE, "|-");
4633a7c4 431 $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
432
433 if ($pid) { # parent
434 for (@data) {
c07a80fd 435 print KID_TO_WRITE;
54310121 436 }
c07a80fd 437 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4 438
439 } else { # child
440 ($EUID, $EGID) = ($UID, $GID);
441 exec($program, @options, @args)
442 || die "can't exec program: $!";
443 # NOTREACHED
54310121 444 }
4633a7c4 445
446Note that these operations are full Unix forks, which means they may not be
447correctly implemented on alien systems. Additionally, these are not true
54310121 448multithreading. If you'd like to learn more about threading, see the
184e9718 449F<modules> file mentioned below in the SEE ALSO section.
4633a7c4 450
7b05b7e3 451=head2 Bidirectional Communication with Another Process
4633a7c4 452
453While this works reasonably well for unidirectional communication, what
454about bidirectional communication? The obvious thing you'd like to do
455doesn't actually work:
456
c07a80fd 457 open(PROG_FOR_READING_AND_WRITING, "| some program |")
4633a7c4 458
9f1b1f2d 459and if you forget to use the C<use warnings> pragma or the B<-w> flag,
460then you'll miss out entirely on the diagnostic message:
4633a7c4 461
462 Can't do bidirectional pipe at -e line 1.
463
464If you really want to, you can use the standard open2() library function
7b05b7e3 465to catch both ends. There's also an open3() for tridirectional I/O so you
4633a7c4 466can also catch your child's STDERR, but doing so would then require an
467awkward select() loop and wouldn't allow you to use normal Perl input
468operations.
469
470If you look at its source, you'll see that open2() uses low-level
5a964f20 471primitives like Unix pipe() and exec() calls to create all the connections.
4633a7c4 472While it might have been slightly more efficient by using socketpair(), it
473would have then been even less portable than it already is. The open2()
474and open3() functions are unlikely to work anywhere except on a Unix
475system or some other one purporting to be POSIX compliant.
476
477Here's an example of using open2():
478
479 use FileHandle;
480 use IPC::Open2;
5a964f20 481 $pid = open2(*Reader, *Writer, "cat -u -n" );
4633a7c4 482 print Writer "stuff\n";
483 $got = <Reader>;
484
6a3992aa 485The problem with this is that Unix buffering is really going to
486ruin your day. Even though your C<Writer> filehandle is auto-flushed,
4633a7c4 487and the process on the other end will get your data in a timely manner,
6a3992aa 488you can't usually do anything to force it to give it back to you
54310121 489in a similarly quick fashion. In this case, we could, because we
4633a7c4 490gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix
491commands are designed to operate over pipes, so this seldom works
54310121 492unless you yourself wrote the program on the other end of the
4633a7c4 493double-ended pipe.
494
54310121 495A solution to this is the nonstandard F<Comm.pl> library. It uses
4633a7c4 496pseudo-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 }
a0d0e21e 504
4633a7c4 505This way you don't have to have control over the source code of the
54310121 506program you're using. The F<Comm> library also has expect()
507and interact() functions. Find the library (and we hope its
4633a7c4 508successor F<IPC::Chat>) at your nearest CPAN archive as detailed
184e9718 509in the SEE ALSO section below.
a0d0e21e 510
c8db1d39 511The newer Expect.pm module from CPAN also addresses this kind of thing.
512This module requires two other modules from CPAN: IO::Pty and IO::Stty.
513It sets up a pseudo-terminal to interact with programs that insist on
514using talking to the terminal device driver. If your system is
515amongst those supported, this may be your best bet.
516
5a964f20 517=head2 Bidirectional Communication with Yourself
518
519If you want, you may make low-level pipe() and fork()
520to stitch this together by hand. This example only
521talks to itself, but you could reopen the appropriate
522handles 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
550But you don't actually have to make two pipe calls. If you
551have 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
4633a7c4 585=head1 Sockets: Client/Server Communication
a0d0e21e 586
6a3992aa 587While not limited to Unix-derived operating systems (e.g., WinSock on PCs
4633a7c4 588provides socket support, as do some VMS libraries), you may not have
184e9718 589sockets on your system, in which case this section probably isn't going to do
6a3992aa 590you much good. With sockets, you can do both virtual circuits (i.e., TCP
591streams) and datagrams (i.e., UDP packets). You may be able to do even more
4633a7c4 592depending on your system.
593
594The Perl function calls for dealing with sockets have the same names as
595the corresponding system calls in C, but their arguments tend to differ
596for two reasons: first, Perl filehandles work differently than C file
597descriptors. Second, Perl already knows the length of its strings, so you
598don't need to pass that information.
a0d0e21e 599
4633a7c4 600One of the major problems with old socket code in Perl was that it used
601hard-coded values for some of the constants, which severely hurt
602portability. If you ever see code that does anything like explicitly
603setting C<$AF_INET = 2>, you know you're in for big trouble: An
604immeasurably superior approach is to use the C<Socket> module, which more
605reliably grants access to various constants and functions you'll need.
a0d0e21e 606
68dc0745 607If you're not writing a server/client for an existing protocol like
608NNTP or SMTP, you should give some thought to how your server will
609know when the client has finished talking, and vice-versa. Most
610protocols are based on one-line messages and responses (so one party
4a6725af 611knows the other has finished when a "\n" is received) or multi-line
68dc0745 612messages and responses that end with a period on an empty line
613("\n.\n" terminates a message/response).
614
5a964f20 615=head2 Internet Line Terminators
616
617The Internet line terminator is "\015\012". Under ASCII variants of
618Unix, 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
620completely different. The standards specify writing "\015\012" to be
621conformant (be strict in what you provide), but they also recommend
622accepting a lone "\012" on input (but be lenient in what you require).
623We haven't always been very good about that in the code in this manpage,
624but unless you're on a Mac, you'll probably be ok.
625
4633a7c4 626=head2 Internet TCP Clients and Servers
a0d0e21e 627
4633a7c4 628Use Internet-domain sockets when you want to do client-server
629communication that might extend to machines outside of your own system.
630
631Here's a sample TCP client using Internet-domain sockets:
632
633 #!/usr/bin/perl -w
4633a7c4 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: $!";
54310121 648 while (defined($line = <SOCK>)) {
4633a7c4 649 print $line;
54310121 650 }
4633a7c4 651
652 close (SOCK) || die "close: $!";
653 exit;
654
655And here's a corresponding server to go along with it. We'll
656leave the address as INADDR_ANY so that the kernel can choose
54310121 657the appropriate interface on multihomed hosts. If you want sit
c07a80fd 658on a particular interface (like the external side of a gateway
659or firewall machine), you should fill this in with your real address
660instead.
661
662 #!/usr/bin/perl -Tw
c07a80fd 663 use strict;
664 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
665 use Socket;
666 use Carp;
5865a7df 667 my $EOL = "\015\012";
c07a80fd 668
54310121 669 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
c07a80fd 670
671 my $port = shift || 2345;
672 my $proto = getprotobyname('tcp');
51ee6500 673
5865a7df 674 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
6a3992aa 675
c07a80fd 676 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 677 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd 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
54310121 692 logmsg "connection from $name [",
693 inet_ntoa($iaddr), "]
c07a80fd 694 at port $port";
695
54310121 696 print Client "Hello there, $name, it's now ",
5a964f20 697 scalar localtime, $EOL;
54310121 698 }
c07a80fd 699
54310121 700And here's a multithreaded version. It's multithreaded in that
701like most typical servers, it spawns (forks) a slave server to
c07a80fd 702handle the client request so that the master server can quickly
703go back to service a new client.
4633a7c4 704
705 #!/usr/bin/perl -Tw
4633a7c4 706 use strict;
707 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
a0d0e21e 708 use Socket;
4633a7c4 709 use Carp;
5865a7df 710 my $EOL = "\015\012";
a0d0e21e 711
4633a7c4 712 sub spawn; # forward declaration
54310121 713 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
a0d0e21e 714
4633a7c4 715 my $port = shift || 2345;
716 my $proto = getprotobyname('tcp');
51ee6500 717
5865a7df 718 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
54310121 719
c07a80fd 720 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 721 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd 722 pack("l", 1)) || die "setsockopt: $!";
723 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
724 listen(Server,SOMAXCONN) || die "listen: $!";
a0d0e21e 725
4633a7c4 726 logmsg "server started on port $port";
a0d0e21e 727
4633a7c4 728 my $waitedpid = 0;
729 my $paddr;
a0d0e21e 730
816229cf 731 use POSIX ":sys_wait_h";
54310121 732 sub REAPER {
816229cf 733 my $child;
734 while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
735 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
736 }
6a3992aa 737 $SIG{CHLD} = \&REAPER; # loathe sysV
4633a7c4 738 }
739
740 $SIG{CHLD} = \&REAPER;
741
54310121 742 for ( $waitedpid = 0;
743 ($paddr = accept(Client,Server)) || $waitedpid;
744 $waitedpid = 0, close Client)
4633a7c4 745 {
6a3992aa 746 next if $waitedpid and not $paddr;
4633a7c4 747 my($port,$iaddr) = sockaddr_in($paddr);
748 my $name = gethostbyaddr($iaddr,AF_INET);
749
54310121 750 logmsg "connection from $name [",
751 inet_ntoa($iaddr), "]
4633a7c4 752 at port $port";
a0d0e21e 753
54310121 754 spawn sub {
b921b357 755 $|=1;
5a964f20 756 print "Hello there, $name, it's now ", scalar localtime, $EOL;
757 exec '/usr/games/fortune' # XXX: `wrong' line terminators
4633a7c4 758 or confess "can't exec fortune: $!";
759 };
a0d0e21e 760
54310121 761 }
a0d0e21e 762
4633a7c4 763 sub spawn {
764 my $coderef = shift;
a0d0e21e 765
54310121 766 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
4633a7c4 767 confess "usage: spawn CODEREF";
a0d0e21e 768 }
4633a7c4 769
770 my $pid;
771 if (!defined($pid = fork)) {
772 logmsg "cannot fork: $!";
773 return;
774 } elsif ($pid) {
775 logmsg "begat $pid";
6a3992aa 776 return; # I'm the parent
4633a7c4 777 }
6a3992aa 778 # else I'm the child -- go spawn
4633a7c4 779
c07a80fd 780 open(STDIN, "<&Client") || die "can't dup client to stdin";
781 open(STDOUT, ">&Client") || die "can't dup client to stdout";
4633a7c4 782 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
783 exit &$coderef();
54310121 784 }
4633a7c4 785
786This server takes the trouble to clone off a child version via fork() for
787each incoming request. That way it can handle many requests at once,
788which you might not always want. Even if you don't fork(), the listen()
789will allow that many pending connections. Forking servers have to be
790particularly careful about cleaning up their dead children (called
791"zombies" in Unix parlance), because otherwise you'll quickly fill up your
792process table.
793
794We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
795even if we aren't running setuid or setgid. This is always a good idea
796for servers and other programs run on behalf of someone else (like CGI
797scripts), because it lessens the chances that people from the outside will
798be able to compromise your system.
799
800Let's look at another TCP client. This one connects to the TCP "time"
801service on a number of different machines and shows how far their clocks
802differ from the system on which it's being run:
803
804 #!/usr/bin/perl -w
4633a7c4 805 use strict;
806 use Socket;
807
808 my $SECS_of_70_YEARS = 2208988800;
54310121 809 sub ctime { scalar localtime(shift) }
4633a7c4 810
54310121 811 my $iaddr = gethostbyname('localhost');
812 my $proto = getprotobyname('tcp');
813 my $port = getservbyname('time', 'tcp');
4633a7c4 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);
a0d0e21e 831 }
832
4633a7c4 833=head2 Unix-Domain TCP Clients and Servers
834
a2eb9003 835That's fine for Internet-domain clients and servers, but what about local
4633a7c4 836communications? While you can use the same setup, sometimes you don't
837want to. Unix-domain sockets are local to the current host, and are often
54310121 838used internally to implement pipes. Unlike Internet domain sockets, Unix
4633a7c4 839domain sockets can show up in the file system with an ls(1) listing.
840
5a964f20 841 % ls -l /dev/log
4633a7c4 842 srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
a0d0e21e 843
4633a7c4 844You can test for these with Perl's B<-S> file test:
845
846 unless ( -S '/dev/log' ) {
3ba19564 847 die "something's wicked with the log system";
54310121 848 }
4633a7c4 849
850Here's a sample Unix-domain client:
851
852 #!/usr/bin/perl -w
4633a7c4 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: $!";
9607fc9c 859 connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
54310121 860 while (defined($line = <SOCK>)) {
4633a7c4 861 print $line;
54310121 862 }
4633a7c4 863 exit;
864
5a964f20 865And here's a corresponding server. You don't have to worry about silly
866network terminators here because Unix domain sockets are guaranteed
867to be on the localhost, and thus everything works right.
4633a7c4 868
869 #!/usr/bin/perl -Tw
4633a7c4 870 use strict;
871 use Socket;
872 use Carp;
873
874 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
5865a7df 875 sub spawn; # forward declaration
5a964f20 876 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
4633a7c4 877
878 my $NAME = '/tmp/catsock';
879 my $uaddr = sockaddr_un($NAME);
880 my $proto = getprotobyname('tcp');
881
c07a80fd 882 socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
4633a7c4 883 unlink($NAME);
c07a80fd 884 bind (Server, $uaddr) || die "bind: $!";
885 listen(Server,SOMAXCONN) || die "listen: $!";
4633a7c4 886
887 logmsg "server started on $NAME";
888
5a964f20 889 my $waitedpid;
890
816229cf 891 use POSIX ":sys_wait_h";
5a964f20 892 sub REAPER {
816229cf 893 my $child;
894 while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
895 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
896 }
5a964f20 897 $SIG{CHLD} = \&REAPER; # loathe sysV
5a964f20 898 }
899
4633a7c4 900 $SIG{CHLD} = \&REAPER;
901
5a964f20 902
54310121 903 for ( $waitedpid = 0;
904 accept(Client,Server) || $waitedpid;
905 $waitedpid = 0, close Client)
4633a7c4 906 {
907 next if $waitedpid;
908 logmsg "connection on $NAME";
54310121 909 spawn sub {
4633a7c4 910 print "Hello there, it's now ", scalar localtime, "\n";
911 exec '/usr/games/fortune' or die "can't exec fortune: $!";
912 };
54310121 913 }
4633a7c4 914
5865a7df 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
4633a7c4 938As you see, it's remarkably similar to the Internet domain TCP server, so
939much so, in fact, that we've omitted several duplicate functions--spawn(),
940logmsg(), ctime(), and REAPER()--which are exactly the same as in the
941other server.
942
943So why would you ever want to use a Unix domain socket instead of a
944simpler named pipe? Because a named pipe doesn't give you sessions. You
945can't tell one process's data from another's. With socket programming,
946you get a separate session for each client: that's why accept() takes two
947arguments.
948
949For example, let's say that you have a long running database server daemon
950that you want folks from the World Wide Web to be able to access, but only
951if they go through a CGI interface. You'd have a small, simple CGI
952program that does whatever checks and logging you feel like, and then acts
953as a Unix-domain client and connects to your private server.
954
7b05b7e3 955=head1 TCP Clients with IO::Socket
956
957For those preferring a higher-level interface to socket programming, the
958IO::Socket module provides an object-oriented approach. IO::Socket is
959included as part of the standard Perl distribution as of the 5.004
960release. If you're running an earlier version of Perl, just fetch
106325ad 961IO::Socket from CPAN, where you'll also find modules providing easy
7b05b7e3 962interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
963NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
964to name a few.
965
966=head2 A Simple Client
967
968Here's a client that creates a TCP connection to the "daytime"
969service at port 13 of the host name "localhost" and prints out everything
970that 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
982When you run this program, you should get something back that
983looks like this:
984
985 Wed May 14 08:40:46 MDT 1997
986
987Here are what those parameters to the C<new> constructor mean:
988
13a2d996 989=over 4
7b05b7e3 990
991=item C<Proto>
992
993This is which protocol to use. In this case, the socket handle returned
994will be connected to a TCP socket, because we want a stream-oriented
995connection, that is, one that acts pretty much like a plain old file.
996Not all sockets are this of this type. For example, the UDP protocol
997can be used to make a datagram socket, used for message-passing.
998
999=item C<PeerAddr>
1000
1001This is the name or Internet address of the remote host the server is
1002running on. We could have specified a longer name like C<"www.perl.com">,
1003or an address like C<"204.148.40.9">. For demonstration purposes, we've
1004used the special hostname C<"localhost">, which should always mean the
1005current machine you're running on. The corresponding Internet address
1006for localhost is C<"127.1">, if you'd rather use that.
1007
1008=item C<PeerPort>
1009
1010This is the service name or port number we'd like to connect to.
1011We could have gotten away with using just C<"daytime"> on systems with a
1012well-configured system services file,[FOOTNOTE: The system services file
1013is in I</etc/services> under Unix] but just in case, we've specified the
1014port number (13) in parentheses. Using just the number would also have
1015worked, but constant numbers make careful programmers nervous.
1016
1017=back
1018
1019Notice how the return value from the C<new> constructor is used as
1020a filehandle in the C<while> loop? That's what's called an indirect
1021filehandle, a scalar variable containing a filehandle. You can use
1022it the same way you would a normal filehandle. For example, you
1023can read one line from it this way:
1024
1025 $line = <$handle>;
1026
1027all remaining lines from is this way:
1028
1029 @lines = <$handle>;
1030
1031and send a line of data to it this way:
1032
1033 print $handle "some data\n";
1034
1035=head2 A Webget Client
1036
1037Here's a simple client that takes a remote host to fetch a document
1038from, and then a list of documents to get from that host. This is a
1039more interesting client than the previous one because it first sends
1040something 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);
5a964f20 1046 $EOL = "\015\012";
1047 $BLANK = $EOL x 2;
7b05b7e3 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);
5a964f20 1055 print $remote "GET $document HTTP/1.0" . $BLANK;
7b05b7e3 1056 while ( <$remote> ) { print }
1057 close $remote;
1058 }
1059
1060The web server handing the "http" service, which is assumed to be at
4375e838 1061its standard port, number 80. If the web server you're trying to
7b05b7e3 1062connect to is at a different port (like 1080 or 8080), you should specify
c47ff5f1 1063as the named-parameter pair, C<< PeerPort => 8080 >>. The C<autoflush>
7b05b7e3 1064method is used on the socket because otherwise the system would buffer
1065up the output we sent it. (If you're on a Mac, you'll also need to
1066change every C<"\n"> in your code that sends data over the network to
1067be a C<"\015\012"> instead.)
1068
1069Connecting to the server is only the first part of the process: once you
1070have the connection, you have to use the server's language. Each server
1071on the network has its own little command language that it expects as
1072input. The string that we send to the server starting with "GET" is in
1073HTTP syntax. In this case, we simply request each specified document.
1074Yes, we really are making a new connection for each document, even though
1075it's the same host. That's the way you always used to have to speak HTTP.
1076Recent versions of web browsers may request that the remote server leave
1077the connection open a little while, but the server doesn't have to honor
1078such a request.
1079
1080Here's an example of running that program, which we'll call I<webget>:
1081
5a964f20 1082 % webget www.perl.com /guanaco.html
7b05b7e3 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
1094Ok, so that's not very interesting, because it didn't find that
1095particular document. But a long response wouldn't have fit on this page.
1096
1097For a more fully-featured version of this program, you should look to
1098the I<lwp-request> program included with the LWP modules from CPAN.
1099
1100=head2 Interactive Client with IO::Socket
1101
1102Well, that's all fine if you want to send one command and get one answer,
1103but what about setting up something fully interactive, somewhat like
1104the way I<telnet> works? That way you can type a line, get the answer,
1105type a line, get the answer, etc.
1106
1107This client is more complicated than the two we've done so far, but if
1108you're on a system that supports the powerful C<fork> call, the solution
1109isn't that rough. Once you've made the connection to whatever service
1110you'd like to chat with, call C<fork> to clone your process. Each of
1111these two identical process has a very simple job to do: the parent
1112copies everything from the socket to standard output, while the child
1113simultaneously copies everything from standard input to the socket.
1114To accomplish the same thing using just one process would be I<much>
1115harder, because it's easier to code two processes to do one thing than it
1116is to code one process to do two things. (This keep-it-simple principle
5a964f20 1117a cornerstones of the Unix philosophy, and good software engineering as
1118well, which is probably why it's spread to other systems.)
7b05b7e3 1119
1120Here'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
1158The C<kill> function in the parent's C<if> block is there to send a
1159signal to our child process (current running in the C<else> block)
1160as soon as the remote server has closed its end of the connection.
1161
7b05b7e3 1162If the remote server sends data a byte at time, and you need that
1163data immediately without waiting for a newline (which might not happen),
1164you may wish to replace the C<while> loop in the parent with the
1165following:
1166
1167 my $byte;
1168 while (sysread($handle, $byte, 1) == 1) {
1169 print STDOUT $byte;
1170 }
1171
1172Making 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
1174well.
1175
1176=head1 TCP Servers with IO::Socket
1177
5a964f20 1178As always, setting up a server is little bit more involved than running a client.
7b05b7e3 1179The model is that the server creates a special kind of socket that
1180does nothing but listen on a particular port for incoming connections.
c47ff5f1 1181It does this by calling the C<< IO::Socket::INET->new() >> method with
7b05b7e3 1182slightly different arguments than the client did.
1183
13a2d996 1184=over 4
7b05b7e3 1185
1186=item Proto
1187
1188This is which protocol to use. Like our clients, we'll
1189still specify C<"tcp"> here.
1190
1191=item LocalPort
1192
1193We specify a local
1194port in the C<LocalPort> argument, which we didn't do for the client.
1195This is service name or port number for which you want to be the
1196server. (Under Unix, ports under 1024 are restricted to the
1197superuser.) In our sample, we'll use port 9000, but you can use
1198any port that's not currently in use on your system. If you try
1199to use one already in used, you'll get an "Address already in use"
19799a22 1200message. Under Unix, the C<netstat -a> command will show
7b05b7e3 1201which services current have servers.
1202
1203=item Listen
1204
1205The C<Listen> parameter is set to the maximum number of
1206pending connections we can accept until we turn away incoming clients.
1207Think of it as a call-waiting queue for your telephone.
1208The low-level Socket module has a special symbol for the system maximum, which
1209is SOMAXCONN.
1210
1211=item Reuse
1212
1213The C<Reuse> parameter is needed so that we restart our server
1214manually without waiting a few minutes to allow system buffers to
1215clear out.
1216
1217=back
1218
1219Once the generic server socket has been created using the parameters
1220listed above, the server then waits for a new client to connect
d1be9408 1221to it. The server blocks in the C<accept> method, which eventually accepts a
1222bidirectional connection from the remote client. (Make sure to autoflush
7b05b7e3 1223this handle to circumvent buffering.)
1224
1225To add to user-friendliness, our server prompts the user for commands.
1226Most servers don't do this. Because of the prompt without a newline,
1227you'll have to use the C<sysread> variant of the interactive client above.
1228
1229This server accepts one of five different commands, sending output
1230back to the client. Note that unlike most network servers, this one
1231only handles one incoming client at a time. Multithreaded servers are
f83494b9 1232covered in Chapter 6 of the Camel.
7b05b7e3 1233
1234Here'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
4633a7c4 1273
1274Another kind of client-server setup is one that uses not connections, but
1275messages. UDP communications involve much lower overhead but also provide
1276less reliability, as there are no promises that messages will arrive at
1277all, let alone in order and unmangled. Still, UDP offers some advantages
1278over TCP, including being able to "broadcast" or "multicast" to a whole
1279bunch of destination hosts at once (usually on your local subnet). If you
1280find yourself overly concerned about reliability and start building checks
6a3992aa 1281into your message system, then you probably should use just TCP to start
4633a7c4 1282with.
1283
90034919 1284Note that UDP datagrams are I<not> a bytestream and should not be treated
1285as such. This makes using I/O mechanisms with internal buffering
1286like stdio (i.e. print() and friends) especially cumbersome. Use syswrite(),
1287or better send(), like in the example below.
1288
4633a7c4 1289Here's a UDP program similar to the sample Internet TCP client given
7b05b7e3 1290earlier. However, instead of checking one host at a time, the UDP version
4633a7c4 1291will check many of them asynchronously by simulating a multicast and then
1292using select() to do a timed-out wait for I/O. To do something similar
1293with TCP, you'd have to use a different socket handle for each host.
1294
1295 #!/usr/bin/perl -w
1296 use strict;
4633a7c4 1297 use Socket;
1298 use Sys::Hostname;
1299
54310121 1300 my ( $count, $hisiaddr, $hispaddr, $histime,
1301 $host, $iaddr, $paddr, $port, $proto,
4633a7c4 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
90034919 1339Note that this example does not include any retries and may consequently
1340fail to contact a reachable host. The most prominent reason for this
1341is congestion of the queues on the sending host if the number of
a31a806a 1342list of hosts to contact is sufficiently large.
90034919 1343
4633a7c4 1344=head1 SysV IPC
1345
1346While System V IPC isn't so widely used as sockets, it still has some
1347interesting uses. You can't, however, effectively use SysV IPC or
1348Berkeley mmap() to have shared memory so as to share a variable amongst
1349several processes. That's because Perl would reallocate your string when
1350you weren't wanting it to.
1351
54310121 1352Here's a small example showing shared memory usage.
a0d0e21e 1353
41d6edb2 1354 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
0ade1984 1355
a0d0e21e 1356 $size = 2000;
41d6edb2 1357 $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
1358 print "shm key $id\n";
a0d0e21e 1359
1360 $message = "Message #1";
41d6edb2 1361 shmwrite($id, $message, 0, 60) || die "$!";
0ade1984 1362 print "wrote: '$message'\n";
41d6edb2 1363 shmread($id, $buff, 0, 60) || die "$!";
0ade1984 1364 print "read : '$buff'\n";
a0d0e21e 1365
0ade1984 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";
a0d0e21e 1370
41d6edb2 1371 print "deleting shm $id\n";
1372 shmctl($id, IPC_RMID, 0) || die "$!";
a0d0e21e 1373
1374Here's an example of a semaphore:
1375
0ade1984 1376 use IPC::SysV qw(IPC_CREAT);
1377
a0d0e21e 1378 $IPC_KEY = 1234;
41d6edb2 1379 $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1380 print "shm key $id\n";
a0d0e21e 1381
a2eb9003 1382Put this code in a separate file to be run in more than one process.
a0d0e21e 1383Call the file F<take>:
1384
1385 # create a semaphore
1386
1387 $IPC_KEY = 1234;
41d6edb2 1388 $id = semget($IPC_KEY, 0 , 0 );
1389 die if !defined($id);
a0d0e21e 1390
1391 $semnum = 0;
1392 $semflag = 0;
1393
1394 # 'take' semaphore
1395 # wait for semaphore to be zero
1396 $semop = 0;
41d6edb2 1397 $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1398
1399 # Increment the semaphore count
1400 $semop = 1;
41d6edb2 1401 $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1402 $opstring = $opstring1 . $opstring2;
1403
41d6edb2 1404 semop($id,$opstring) || die "$!";
a0d0e21e 1405
a2eb9003 1406Put this code in a separate file to be run in more than one process.
a0d0e21e 1407Call this file F<give>:
1408
4633a7c4 1409 # 'give' the semaphore
a0d0e21e 1410 # run this in the original process and you will see
1411 # that the second process continues
1412
1413 $IPC_KEY = 1234;
41d6edb2 1414 $id = semget($IPC_KEY, 0, 0);
1415 die if !defined($id);
a0d0e21e 1416
1417 $semnum = 0;
1418 $semflag = 0;
1419
1420 # Decrement the semaphore count
1421 $semop = -1;
41d6edb2 1422 $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1423
41d6edb2 1424 semop($id,$opstring) || die "$!";
a0d0e21e 1425
7b05b7e3 1426The SysV IPC code above was written long ago, and it's definitely
0ade1984 1427clunky looking. For a more modern look, see the IPC::SysV module
1428which is included with Perl starting from Perl 5.005.
4633a7c4 1429
41d6edb2 1430A 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
4633a7c4 1461=head1 NOTES
1462
5a964f20 1463Most of these routines quietly but politely return C<undef> when they
1464fail instead of causing your program to die right then and there due to
1465an uncaught exception. (Actually, some of the new I<Socket> conversion
1466functions croak() on bad arguments.) It is therefore essential to
1467check return values from these functions. Always begin your socket
1468programs this way for optimal success, and don't forget to add B<-T>
1469taint checking flag to the #! line for servers:
4633a7c4 1470
5a964f20 1471 #!/usr/bin/perl -Tw
4633a7c4 1472 use strict;
1473 use sigtrap;
1474 use Socket;
1475
1476=head1 BUGS
1477
1478All these routines create system-specific portability problems. As noted
1479elsewhere, Perl is at the mercy of your C libraries for much of its system
1480behaviour. It's probably safest to assume broken SysV semantics for
6a3992aa 1481signals and to stick with simple TCP and UDP socket operations; e.g., don't
a2eb9003 1482try to pass open file descriptors over a local UDP datagram socket if you
4633a7c4 1483want your code to stand a chance of being portable.
1484
5a964f20 1485As mentioned in the signals section, because few vendors provide C
1486libraries that are safely re-entrant, the prudent programmer will do
1487little else within a handler beyond setting a numeric variable that
1488already exists; or, if locked into a slow (restarting) system call,
1489using die() to raise an exception and longjmp(3) out. In fact, even
1490these may in some cases cause a core dump. It's probably best to avoid
1491signals except where they are absolutely inevitable. This
1492will be addressed in a future release of Perl.
4633a7c4 1493
1494=head1 AUTHOR
1495
1496Tom Christiansen, with occasional vestiges of Larry Wall's original
7b05b7e3 1497version and suggestions from the Perl Porters.
4633a7c4 1498
1499=head1 SEE ALSO
1500
7b05b7e3 1501There's a lot more to networking than this, but this should get you
1502started.
1503
5a964f20 1504For intrepid programmers, the indispensable textbook is I<Unix Network
1505Programming> by W. Richard Stevens (published by Addison-Wesley). Note
1506that most books on networking address networking from the perspective of
1507a C programmer; translation to Perl is left as an exercise for the reader.
7b05b7e3 1508
1509The IO::Socket(3) manpage describes the object library, and the Socket(3)
1510manpage describes the low-level interface to sockets. Besides the obvious
1511functions in L<perlfunc>, you should also check out the F<modules> file
1512at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
1513FAQ> for a description of what CPAN is and where to get it.)
1514
4633a7c4 1515Section 5 of the F<modules> file is devoted to "Networking, Device Control
6a3992aa 1516(modems), and Interprocess Communication", and contains numerous unbundled
4633a7c4 1517modules numerous networking modules, Chat and Expect operations, CGI
1518programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1519Threads, and ToolTalk--just to name a few.