This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Out-of-date note removed.
[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 {
5a964f20
TC
748 print "Hello there, $name, it's now ", scalar localtime, $EOL;
749 exec '/usr/games/fortune' # XXX: `wrong' line terminators
4633a7c4
LW
750 or confess "can't exec fortune: $!";
751 };
a0d0e21e 752
54310121 753 }
a0d0e21e 754
4633a7c4
LW
755 sub spawn {
756 my $coderef = shift;
a0d0e21e 757
54310121 758 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
4633a7c4 759 confess "usage: spawn CODEREF";
a0d0e21e 760 }
4633a7c4
LW
761
762 my $pid;
763 if (!defined($pid = fork)) {
764 logmsg "cannot fork: $!";
765 return;
766 } elsif ($pid) {
767 logmsg "begat $pid";
6a3992aa 768 return; # I'm the parent
4633a7c4 769 }
6a3992aa 770 # else I'm the child -- go spawn
4633a7c4 771
c07a80fd 772 open(STDIN, "<&Client") || die "can't dup client to stdin";
773 open(STDOUT, ">&Client") || die "can't dup client to stdout";
4633a7c4
LW
774 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
775 exit &$coderef();
54310121 776 }
4633a7c4
LW
777
778This server takes the trouble to clone off a child version via fork() for
779each incoming request. That way it can handle many requests at once,
780which you might not always want. Even if you don't fork(), the listen()
781will allow that many pending connections. Forking servers have to be
782particularly careful about cleaning up their dead children (called
783"zombies" in Unix parlance), because otherwise you'll quickly fill up your
784process table.
785
786We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
787even if we aren't running setuid or setgid. This is always a good idea
788for servers and other programs run on behalf of someone else (like CGI
789scripts), because it lessens the chances that people from the outside will
790be able to compromise your system.
791
792Let's look at another TCP client. This one connects to the TCP "time"
793service on a number of different machines and shows how far their clocks
794differ from the system on which it's being run:
795
796 #!/usr/bin/perl -w
4633a7c4
LW
797 use strict;
798 use Socket;
799
800 my $SECS_of_70_YEARS = 2208988800;
54310121 801 sub ctime { scalar localtime(shift) }
4633a7c4 802
54310121 803 my $iaddr = gethostbyname('localhost');
804 my $proto = getprotobyname('tcp');
805 my $port = getservbyname('time', 'tcp');
4633a7c4
LW
806 my $paddr = sockaddr_in(0, $iaddr);
807 my($host);
808
809 $| = 1;
810 printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
811
812 foreach $host (@ARGV) {
813 printf "%-24s ", $host;
814 my $hisiaddr = inet_aton($host) || die "unknown host";
815 my $hispaddr = sockaddr_in($port, $hisiaddr);
816 socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
817 connect(SOCKET, $hispaddr) || die "bind: $!";
818 my $rtime = ' ';
819 read(SOCKET, $rtime, 4);
820 close(SOCKET);
821 my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
822 printf "%8d %s\n", $histime - time, ctime($histime);
a0d0e21e
LW
823 }
824
4633a7c4
LW
825=head2 Unix-Domain TCP Clients and Servers
826
a2eb9003 827That's fine for Internet-domain clients and servers, but what about local
4633a7c4
LW
828communications? While you can use the same setup, sometimes you don't
829want to. Unix-domain sockets are local to the current host, and are often
54310121 830used internally to implement pipes. Unlike Internet domain sockets, Unix
4633a7c4
LW
831domain sockets can show up in the file system with an ls(1) listing.
832
5a964f20 833 % ls -l /dev/log
4633a7c4 834 srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
a0d0e21e 835
4633a7c4
LW
836You can test for these with Perl's B<-S> file test:
837
838 unless ( -S '/dev/log' ) {
3ba19564 839 die "something's wicked with the log system";
54310121 840 }
4633a7c4
LW
841
842Here's a sample Unix-domain client:
843
844 #!/usr/bin/perl -w
4633a7c4
LW
845 use Socket;
846 use strict;
847 my ($rendezvous, $line);
848
849 $rendezvous = shift || '/tmp/catsock';
850 socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
9607fc9c 851 connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
54310121 852 while (defined($line = <SOCK>)) {
4633a7c4 853 print $line;
54310121 854 }
4633a7c4
LW
855 exit;
856
5a964f20
TC
857And here's a corresponding server. You don't have to worry about silly
858network terminators here because Unix domain sockets are guaranteed
859to be on the localhost, and thus everything works right.
4633a7c4
LW
860
861 #!/usr/bin/perl -Tw
4633a7c4
LW
862 use strict;
863 use Socket;
864 use Carp;
865
866 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
5a964f20 867 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
4633a7c4
LW
868
869 my $NAME = '/tmp/catsock';
870 my $uaddr = sockaddr_un($NAME);
871 my $proto = getprotobyname('tcp');
872
c07a80fd 873 socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
4633a7c4 874 unlink($NAME);
c07a80fd 875 bind (Server, $uaddr) || die "bind: $!";
876 listen(Server,SOMAXCONN) || die "listen: $!";
4633a7c4
LW
877
878 logmsg "server started on $NAME";
879
5a964f20
TC
880 my $waitedpid;
881
882 sub REAPER {
883 $waitedpid = wait;
884 $SIG{CHLD} = \&REAPER; # loathe sysV
885 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
886 }
887
4633a7c4
LW
888 $SIG{CHLD} = \&REAPER;
889
5a964f20 890
54310121 891 for ( $waitedpid = 0;
892 accept(Client,Server) || $waitedpid;
893 $waitedpid = 0, close Client)
4633a7c4
LW
894 {
895 next if $waitedpid;
896 logmsg "connection on $NAME";
54310121 897 spawn sub {
4633a7c4
LW
898 print "Hello there, it's now ", scalar localtime, "\n";
899 exec '/usr/games/fortune' or die "can't exec fortune: $!";
900 };
54310121 901 }
4633a7c4
LW
902
903As you see, it's remarkably similar to the Internet domain TCP server, so
904much so, in fact, that we've omitted several duplicate functions--spawn(),
905logmsg(), ctime(), and REAPER()--which are exactly the same as in the
906other server.
907
908So why would you ever want to use a Unix domain socket instead of a
909simpler named pipe? Because a named pipe doesn't give you sessions. You
910can't tell one process's data from another's. With socket programming,
911you get a separate session for each client: that's why accept() takes two
912arguments.
913
914For example, let's say that you have a long running database server daemon
915that you want folks from the World Wide Web to be able to access, but only
916if they go through a CGI interface. You'd have a small, simple CGI
917program that does whatever checks and logging you feel like, and then acts
918as a Unix-domain client and connects to your private server.
919
7b05b7e3
TC
920=head1 TCP Clients with IO::Socket
921
922For those preferring a higher-level interface to socket programming, the
923IO::Socket module provides an object-oriented approach. IO::Socket is
924included as part of the standard Perl distribution as of the 5.004
925release. If you're running an earlier version of Perl, just fetch
106325ad 926IO::Socket from CPAN, where you'll also find modules providing easy
7b05b7e3
TC
927interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
928NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
929to name a few.
930
931=head2 A Simple Client
932
933Here's a client that creates a TCP connection to the "daytime"
934service at port 13 of the host name "localhost" and prints out everything
935that the server there cares to provide.
936
937 #!/usr/bin/perl -w
938 use IO::Socket;
939 $remote = IO::Socket::INET->new(
940 Proto => "tcp",
941 PeerAddr => "localhost",
942 PeerPort => "daytime(13)",
943 )
944 or die "cannot connect to daytime port at localhost";
945 while ( <$remote> ) { print }
946
947When you run this program, you should get something back that
948looks like this:
949
950 Wed May 14 08:40:46 MDT 1997
951
952Here are what those parameters to the C<new> constructor mean:
953
954=over
955
956=item C<Proto>
957
958This is which protocol to use. In this case, the socket handle returned
959will be connected to a TCP socket, because we want a stream-oriented
960connection, that is, one that acts pretty much like a plain old file.
961Not all sockets are this of this type. For example, the UDP protocol
962can be used to make a datagram socket, used for message-passing.
963
964=item C<PeerAddr>
965
966This is the name or Internet address of the remote host the server is
967running on. We could have specified a longer name like C<"www.perl.com">,
968or an address like C<"204.148.40.9">. For demonstration purposes, we've
969used the special hostname C<"localhost">, which should always mean the
970current machine you're running on. The corresponding Internet address
971for localhost is C<"127.1">, if you'd rather use that.
972
973=item C<PeerPort>
974
975This is the service name or port number we'd like to connect to.
976We could have gotten away with using just C<"daytime"> on systems with a
977well-configured system services file,[FOOTNOTE: The system services file
978is in I</etc/services> under Unix] but just in case, we've specified the
979port number (13) in parentheses. Using just the number would also have
980worked, but constant numbers make careful programmers nervous.
981
982=back
983
984Notice how the return value from the C<new> constructor is used as
985a filehandle in the C<while> loop? That's what's called an indirect
986filehandle, a scalar variable containing a filehandle. You can use
987it the same way you would a normal filehandle. For example, you
988can read one line from it this way:
989
990 $line = <$handle>;
991
992all remaining lines from is this way:
993
994 @lines = <$handle>;
995
996and send a line of data to it this way:
997
998 print $handle "some data\n";
999
1000=head2 A Webget Client
1001
1002Here's a simple client that takes a remote host to fetch a document
1003from, and then a list of documents to get from that host. This is a
1004more interesting client than the previous one because it first sends
1005something to the server before fetching the server's response.
1006
1007 #!/usr/bin/perl -w
1008 use IO::Socket;
1009 unless (@ARGV > 1) { die "usage: $0 host document ..." }
1010 $host = shift(@ARGV);
5a964f20
TC
1011 $EOL = "\015\012";
1012 $BLANK = $EOL x 2;
7b05b7e3
TC
1013 foreach $document ( @ARGV ) {
1014 $remote = IO::Socket::INET->new( Proto => "tcp",
1015 PeerAddr => $host,
1016 PeerPort => "http(80)",
1017 );
1018 unless ($remote) { die "cannot connect to http daemon on $host" }
1019 $remote->autoflush(1);
5a964f20 1020 print $remote "GET $document HTTP/1.0" . $BLANK;
7b05b7e3
TC
1021 while ( <$remote> ) { print }
1022 close $remote;
1023 }
1024
1025The web server handing the "http" service, which is assumed to be at
4375e838 1026its standard port, number 80. If the web server you're trying to
7b05b7e3 1027connect to is at a different port (like 1080 or 8080), you should specify
c47ff5f1 1028as the named-parameter pair, C<< PeerPort => 8080 >>. The C<autoflush>
7b05b7e3
TC
1029method is used on the socket because otherwise the system would buffer
1030up the output we sent it. (If you're on a Mac, you'll also need to
1031change every C<"\n"> in your code that sends data over the network to
1032be a C<"\015\012"> instead.)
1033
1034Connecting to the server is only the first part of the process: once you
1035have the connection, you have to use the server's language. Each server
1036on the network has its own little command language that it expects as
1037input. The string that we send to the server starting with "GET" is in
1038HTTP syntax. In this case, we simply request each specified document.
1039Yes, we really are making a new connection for each document, even though
1040it's the same host. That's the way you always used to have to speak HTTP.
1041Recent versions of web browsers may request that the remote server leave
1042the connection open a little while, but the server doesn't have to honor
1043such a request.
1044
1045Here's an example of running that program, which we'll call I<webget>:
1046
5a964f20 1047 % webget www.perl.com /guanaco.html
7b05b7e3
TC
1048 HTTP/1.1 404 File Not Found
1049 Date: Thu, 08 May 1997 18:02:32 GMT
1050 Server: Apache/1.2b6
1051 Connection: close
1052 Content-type: text/html
1053
1054 <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
1055 <BODY><H1>File Not Found</H1>
1056 The requested URL /guanaco.html was not found on this server.<P>
1057 </BODY>
1058
1059Ok, so that's not very interesting, because it didn't find that
1060particular document. But a long response wouldn't have fit on this page.
1061
1062For a more fully-featured version of this program, you should look to
1063the I<lwp-request> program included with the LWP modules from CPAN.
1064
1065=head2 Interactive Client with IO::Socket
1066
1067Well, that's all fine if you want to send one command and get one answer,
1068but what about setting up something fully interactive, somewhat like
1069the way I<telnet> works? That way you can type a line, get the answer,
1070type a line, get the answer, etc.
1071
1072This client is more complicated than the two we've done so far, but if
1073you're on a system that supports the powerful C<fork> call, the solution
1074isn't that rough. Once you've made the connection to whatever service
1075you'd like to chat with, call C<fork> to clone your process. Each of
1076these two identical process has a very simple job to do: the parent
1077copies everything from the socket to standard output, while the child
1078simultaneously copies everything from standard input to the socket.
1079To accomplish the same thing using just one process would be I<much>
1080harder, because it's easier to code two processes to do one thing than it
1081is to code one process to do two things. (This keep-it-simple principle
5a964f20
TC
1082a cornerstones of the Unix philosophy, and good software engineering as
1083well, which is probably why it's spread to other systems.)
7b05b7e3
TC
1084
1085Here's the code:
1086
1087 #!/usr/bin/perl -w
1088 use strict;
1089 use IO::Socket;
1090 my ($host, $port, $kidpid, $handle, $line);
1091
1092 unless (@ARGV == 2) { die "usage: $0 host port" }
1093 ($host, $port) = @ARGV;
1094
1095 # create a tcp connection to the specified host and port
1096 $handle = IO::Socket::INET->new(Proto => "tcp",
1097 PeerAddr => $host,
1098 PeerPort => $port)
1099 or die "can't connect to port $port on $host: $!";
1100
1101 $handle->autoflush(1); # so output gets there right away
1102 print STDERR "[Connected to $host:$port]\n";
1103
1104 # split the program into two processes, identical twins
1105 die "can't fork: $!" unless defined($kidpid = fork());
1106
1107 # the if{} block runs only in the parent process
1108 if ($kidpid) {
1109 # copy the socket to standard output
1110 while (defined ($line = <$handle>)) {
1111 print STDOUT $line;
1112 }
1113 kill("TERM", $kidpid); # send SIGTERM to child
1114 }
1115 # the else{} block runs only in the child process
1116 else {
1117 # copy standard input to the socket
1118 while (defined ($line = <STDIN>)) {
1119 print $handle $line;
1120 }
1121 }
1122
1123The C<kill> function in the parent's C<if> block is there to send a
1124signal to our child process (current running in the C<else> block)
1125as soon as the remote server has closed its end of the connection.
1126
7b05b7e3
TC
1127If the remote server sends data a byte at time, and you need that
1128data immediately without waiting for a newline (which might not happen),
1129you may wish to replace the C<while> loop in the parent with the
1130following:
1131
1132 my $byte;
1133 while (sysread($handle, $byte, 1) == 1) {
1134 print STDOUT $byte;
1135 }
1136
1137Making a system call for each byte you want to read is not very efficient
1138(to put it mildly) but is the simplest to explain and works reasonably
1139well.
1140
1141=head1 TCP Servers with IO::Socket
1142
5a964f20 1143As always, setting up a server is little bit more involved than running a client.
7b05b7e3
TC
1144The model is that the server creates a special kind of socket that
1145does nothing but listen on a particular port for incoming connections.
c47ff5f1 1146It does this by calling the C<< IO::Socket::INET->new() >> method with
7b05b7e3
TC
1147slightly different arguments than the client did.
1148
1149=over
1150
1151=item Proto
1152
1153This is which protocol to use. Like our clients, we'll
1154still specify C<"tcp"> here.
1155
1156=item LocalPort
1157
1158We specify a local
1159port in the C<LocalPort> argument, which we didn't do for the client.
1160This is service name or port number for which you want to be the
1161server. (Under Unix, ports under 1024 are restricted to the
1162superuser.) In our sample, we'll use port 9000, but you can use
1163any port that's not currently in use on your system. If you try
1164to use one already in used, you'll get an "Address already in use"
19799a22 1165message. Under Unix, the C<netstat -a> command will show
7b05b7e3
TC
1166which services current have servers.
1167
1168=item Listen
1169
1170The C<Listen> parameter is set to the maximum number of
1171pending connections we can accept until we turn away incoming clients.
1172Think of it as a call-waiting queue for your telephone.
1173The low-level Socket module has a special symbol for the system maximum, which
1174is SOMAXCONN.
1175
1176=item Reuse
1177
1178The C<Reuse> parameter is needed so that we restart our server
1179manually without waiting a few minutes to allow system buffers to
1180clear out.
1181
1182=back
1183
1184Once the generic server socket has been created using the parameters
1185listed above, the server then waits for a new client to connect
1186to it. The server blocks in the C<accept> method, which eventually an
1187bidirectional connection to the remote client. (Make sure to autoflush
1188this handle to circumvent buffering.)
1189
1190To add to user-friendliness, our server prompts the user for commands.
1191Most servers don't do this. Because of the prompt without a newline,
1192you'll have to use the C<sysread> variant of the interactive client above.
1193
1194This server accepts one of five different commands, sending output
1195back to the client. Note that unlike most network servers, this one
1196only handles one incoming client at a time. Multithreaded servers are
f83494b9 1197covered in Chapter 6 of the Camel.
7b05b7e3
TC
1198
1199Here's the code. We'll
1200
1201 #!/usr/bin/perl -w
1202 use IO::Socket;
1203 use Net::hostent; # for OO version of gethostbyaddr
1204
1205 $PORT = 9000; # pick something not in use
1206
1207 $server = IO::Socket::INET->new( Proto => 'tcp',
1208 LocalPort => $PORT,
1209 Listen => SOMAXCONN,
1210 Reuse => 1);
1211
1212 die "can't setup server" unless $server;
1213 print "[Server $0 accepting clients]\n";
1214
1215 while ($client = $server->accept()) {
1216 $client->autoflush(1);
1217 print $client "Welcome to $0; type help for command list.\n";
1218 $hostinfo = gethostbyaddr($client->peeraddr);
1219 printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
1220 print $client "Command? ";
1221 while ( <$client>) {
1222 next unless /\S/; # blank line
1223 if (/quit|exit/i) { last; }
1224 elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
1225 elsif (/who/i ) { print $client `who 2>&1`; }
1226 elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
1227 elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
1228 else {
1229 print $client "Commands: quit date who cookie motd\n";
1230 }
1231 } continue {
1232 print $client "Command? ";
1233 }
1234 close $client;
1235 }
1236
1237=head1 UDP: Message Passing
4633a7c4
LW
1238
1239Another kind of client-server setup is one that uses not connections, but
1240messages. UDP communications involve much lower overhead but also provide
1241less reliability, as there are no promises that messages will arrive at
1242all, let alone in order and unmangled. Still, UDP offers some advantages
1243over TCP, including being able to "broadcast" or "multicast" to a whole
1244bunch of destination hosts at once (usually on your local subnet). If you
1245find yourself overly concerned about reliability and start building checks
6a3992aa 1246into your message system, then you probably should use just TCP to start
4633a7c4
LW
1247with.
1248
1249Here's a UDP program similar to the sample Internet TCP client given
7b05b7e3 1250earlier. However, instead of checking one host at a time, the UDP version
4633a7c4
LW
1251will check many of them asynchronously by simulating a multicast and then
1252using select() to do a timed-out wait for I/O. To do something similar
1253with TCP, you'd have to use a different socket handle for each host.
1254
1255 #!/usr/bin/perl -w
1256 use strict;
4633a7c4
LW
1257 use Socket;
1258 use Sys::Hostname;
1259
54310121 1260 my ( $count, $hisiaddr, $hispaddr, $histime,
1261 $host, $iaddr, $paddr, $port, $proto,
4633a7c4
LW
1262 $rin, $rout, $rtime, $SECS_of_70_YEARS);
1263
1264 $SECS_of_70_YEARS = 2208988800;
1265
1266 $iaddr = gethostbyname(hostname());
1267 $proto = getprotobyname('udp');
1268 $port = getservbyname('time', 'udp');
1269 $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1270
1271 socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
1272 bind(SOCKET, $paddr) || die "bind: $!";
1273
1274 $| = 1;
1275 printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
1276 $count = 0;
1277 for $host (@ARGV) {
1278 $count++;
1279 $hisiaddr = inet_aton($host) || die "unknown host";
1280 $hispaddr = sockaddr_in($port, $hisiaddr);
1281 defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
1282 }
1283
1284 $rin = '';
1285 vec($rin, fileno(SOCKET), 1) = 1;
1286
1287 # timeout after 10.0 seconds
1288 while ($count && select($rout = $rin, undef, undef, 10.0)) {
1289 $rtime = '';
1290 ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
1291 ($port, $hisiaddr) = sockaddr_in($hispaddr);
1292 $host = gethostbyaddr($hisiaddr, AF_INET);
1293 $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
1294 printf "%-12s ", $host;
1295 printf "%8d %s\n", $histime - time, scalar localtime($histime);
1296 $count--;
1297 }
1298
1299=head1 SysV IPC
1300
1301While System V IPC isn't so widely used as sockets, it still has some
1302interesting uses. You can't, however, effectively use SysV IPC or
1303Berkeley mmap() to have shared memory so as to share a variable amongst
1304several processes. That's because Perl would reallocate your string when
1305you weren't wanting it to.
1306
54310121 1307Here's a small example showing shared memory usage.
a0d0e21e 1308
41d6edb2 1309 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
0ade1984 1310
a0d0e21e 1311 $size = 2000;
41d6edb2
JH
1312 $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
1313 print "shm key $id\n";
a0d0e21e
LW
1314
1315 $message = "Message #1";
41d6edb2 1316 shmwrite($id, $message, 0, 60) || die "$!";
0ade1984 1317 print "wrote: '$message'\n";
41d6edb2 1318 shmread($id, $buff, 0, 60) || die "$!";
0ade1984 1319 print "read : '$buff'\n";
a0d0e21e 1320
0ade1984
JH
1321 # the buffer of shmread is zero-character end-padded.
1322 substr($buff, index($buff, "\0")) = '';
1323 print "un" unless $buff eq $message;
1324 print "swell\n";
a0d0e21e 1325
41d6edb2
JH
1326 print "deleting shm $id\n";
1327 shmctl($id, IPC_RMID, 0) || die "$!";
a0d0e21e
LW
1328
1329Here's an example of a semaphore:
1330
0ade1984
JH
1331 use IPC::SysV qw(IPC_CREAT);
1332
a0d0e21e 1333 $IPC_KEY = 1234;
41d6edb2
JH
1334 $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1335 print "shm key $id\n";
a0d0e21e 1336
a2eb9003 1337Put this code in a separate file to be run in more than one process.
a0d0e21e
LW
1338Call the file F<take>:
1339
1340 # create a semaphore
1341
1342 $IPC_KEY = 1234;
41d6edb2
JH
1343 $id = semget($IPC_KEY, 0 , 0 );
1344 die if !defined($id);
a0d0e21e
LW
1345
1346 $semnum = 0;
1347 $semflag = 0;
1348
1349 # 'take' semaphore
1350 # wait for semaphore to be zero
1351 $semop = 0;
41d6edb2 1352 $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e
LW
1353
1354 # Increment the semaphore count
1355 $semop = 1;
41d6edb2 1356 $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e
LW
1357 $opstring = $opstring1 . $opstring2;
1358
41d6edb2 1359 semop($id,$opstring) || die "$!";
a0d0e21e 1360
a2eb9003 1361Put this code in a separate file to be run in more than one process.
a0d0e21e
LW
1362Call this file F<give>:
1363
4633a7c4 1364 # 'give' the semaphore
a0d0e21e
LW
1365 # run this in the original process and you will see
1366 # that the second process continues
1367
1368 $IPC_KEY = 1234;
41d6edb2
JH
1369 $id = semget($IPC_KEY, 0, 0);
1370 die if !defined($id);
a0d0e21e
LW
1371
1372 $semnum = 0;
1373 $semflag = 0;
1374
1375 # Decrement the semaphore count
1376 $semop = -1;
41d6edb2 1377 $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1378
41d6edb2 1379 semop($id,$opstring) || die "$!";
a0d0e21e 1380
7b05b7e3 1381The SysV IPC code above was written long ago, and it's definitely
0ade1984
JH
1382clunky looking. For a more modern look, see the IPC::SysV module
1383which is included with Perl starting from Perl 5.005.
4633a7c4 1384
41d6edb2
JH
1385A small example demonstrating SysV message queues:
1386
1387 use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
1388
1389 my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
1390
1391 my $sent = "message";
1392 my $type = 1234;
1393 my $rcvd;
1394 my $type_rcvd;
1395
1396 if (defined $id) {
1397 if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
1398 if (msgrcv($id, $rcvd, 60, 0, 0)) {
1399 ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
1400 if ($rcvd eq $sent) {
1401 print "okay\n";
1402 } else {
1403 print "not okay\n";
1404 }
1405 } else {
1406 die "# msgrcv failed\n";
1407 }
1408 } else {
1409 die "# msgsnd failed\n";
1410 }
1411 msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
1412 } else {
1413 die "# msgget failed\n";
1414 }
1415
4633a7c4
LW
1416=head1 NOTES
1417
5a964f20
TC
1418Most of these routines quietly but politely return C<undef> when they
1419fail instead of causing your program to die right then and there due to
1420an uncaught exception. (Actually, some of the new I<Socket> conversion
1421functions croak() on bad arguments.) It is therefore essential to
1422check return values from these functions. Always begin your socket
1423programs this way for optimal success, and don't forget to add B<-T>
1424taint checking flag to the #! line for servers:
4633a7c4 1425
5a964f20 1426 #!/usr/bin/perl -Tw
4633a7c4
LW
1427 use strict;
1428 use sigtrap;
1429 use Socket;
1430
1431=head1 BUGS
1432
1433All these routines create system-specific portability problems. As noted
1434elsewhere, Perl is at the mercy of your C libraries for much of its system
1435behaviour. It's probably safest to assume broken SysV semantics for
6a3992aa 1436signals and to stick with simple TCP and UDP socket operations; e.g., don't
a2eb9003 1437try to pass open file descriptors over a local UDP datagram socket if you
4633a7c4
LW
1438want your code to stand a chance of being portable.
1439
5a964f20
TC
1440As mentioned in the signals section, because few vendors provide C
1441libraries that are safely re-entrant, the prudent programmer will do
1442little else within a handler beyond setting a numeric variable that
1443already exists; or, if locked into a slow (restarting) system call,
1444using die() to raise an exception and longjmp(3) out. In fact, even
1445these may in some cases cause a core dump. It's probably best to avoid
1446signals except where they are absolutely inevitable. This
1447will be addressed in a future release of Perl.
4633a7c4
LW
1448
1449=head1 AUTHOR
1450
1451Tom Christiansen, with occasional vestiges of Larry Wall's original
7b05b7e3 1452version and suggestions from the Perl Porters.
4633a7c4
LW
1453
1454=head1 SEE ALSO
1455
7b05b7e3
TC
1456There's a lot more to networking than this, but this should get you
1457started.
1458
5a964f20
TC
1459For intrepid programmers, the indispensable textbook is I<Unix Network
1460Programming> by W. Richard Stevens (published by Addison-Wesley). Note
1461that most books on networking address networking from the perspective of
1462a C programmer; translation to Perl is left as an exercise for the reader.
7b05b7e3
TC
1463
1464The IO::Socket(3) manpage describes the object library, and the Socket(3)
1465manpage describes the low-level interface to sockets. Besides the obvious
1466functions in L<perlfunc>, you should also check out the F<modules> file
1467at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
1468FAQ> for a description of what CPAN is and where to get it.)
1469
4633a7c4 1470Section 5 of the F<modules> file is devoted to "Networking, Device Control
6a3992aa 1471(modems), and Interprocess Communication", and contains numerous unbundled
4633a7c4
LW
1472modules numerous networking modules, Chat and Expect operations, CGI
1473programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1474Threads, and ToolTalk--just to name a few.