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