remove misleading comment (from M.J.T. Guy)
[p5sagit/p5-mst-13.2.git] / pod / perlipc.pod
CommitLineData
a0d0e21e 1=head1 NAME
2
184e9718 3perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
a0d0e21e 4
5=head1 DESCRIPTION
6
4633a7c4 7The basic IPC facilities of Perl are built out of the good old Unix
8signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
9IPC calls. Each is used in slightly different situations.
10
11=head1 Signals
12
13Perl uses a simple signal handling model: the %SIG hash contains names or
14references of user-installed signal handlers. These handlers will be called
15with an argument which is the name of the signal that triggered it. A
16signal may be generated intentionally from a particular keyboard sequence like
a2eb9003 17control-C or control-Z, sent to you from another process, or
4633a7c4 18triggered automatically by the kernel when special events transpire, like
54310121 19a child process exiting, your process running out of stack space, or
4633a7c4 20hitting file size limit.
21
22For example, to trap an interrupt signal, set up a handler like this.
7b05b7e3 23Do as little as you possibly can in your handler; notice how all we do is
24set a global variable and then raise an exception. That's because on most
25systems, libraries are not re-entrant; particularly, memory allocation and
26I/O routines are not. That means that doing nearly I<anything> in your
27handler could in theory trigger a memory fault and subsequent core dump.
4633a7c4 28
29 sub catch_zap {
30 my $signame = shift;
31 $shucks++;
32 die "Somebody sent me a SIG$signame";
54310121 33 }
4633a7c4 34 $SIG{INT} = 'catch_zap'; # could fail in modules
35 $SIG{INT} = \&catch_zap; # best strategy
36
37The names of the signals are the ones listed out by C<kill -l> on your
38system, or you can retrieve them from the Config module. Set up an
39@signame list indexed by number to get the name and a %signo table
40indexed by name to get the number:
41
42 use Config;
43 defined $Config{sig_name} || die "No sigs?";
44 foreach $name (split(' ', $Config{sig_name})) {
45 $signo{$name} = $i;
46 $signame[$i] = $name;
47 $i++;
54310121 48 }
4633a7c4 49
6a3992aa 50So to check whether signal 17 and SIGALRM were the same, do just this:
4633a7c4 51
52 print "signal #17 = $signame[17]\n";
54310121 53 if ($signo{ALRM}) {
4633a7c4 54 print "SIGALRM is $signo{ALRM}\n";
54310121 55 }
4633a7c4 56
57You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
58the handler, in which case Perl will try to discard the signal or do the
f648820c 59default thing.
60
19799a22 61On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
f648820c 62has special behavior with respect to a value of C<'IGNORE'>.
63Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
64not creating zombie processes when the parent process fails to C<wait()>
65on its child processes (i.e. child processes are automatically reaped).
66Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
67C<-1> on such platforms.
68
69Some signals can be neither trapped nor ignored, such as
4633a7c4 70the KILL and STOP (but not the TSTP) signals. One strategy for
71temporarily ignoring signals is to use a local() statement, which will be
72automatically restored once your block is exited. (Remember that local()
73values are "inherited" by functions called from within that block.)
74
75 sub precious {
76 local $SIG{INT} = 'IGNORE';
77 &more_functions;
54310121 78 }
4633a7c4 79 sub more_functions {
80 # interrupts still ignored, for now...
54310121 81 }
4633a7c4 82
83Sending a signal to a negative process ID means that you send the signal
fb73857a 84to the entire Unix process-group. This code sends a hang-up signal to all
85processes in the current process group (and sets $SIG{HUP} to IGNORE so
86it doesn't kill itself):
4633a7c4 87
88 {
89 local $SIG{HUP} = 'IGNORE';
90 kill HUP => -$$;
91 # snazzy writing of: kill('HUP', -$$)
92 }
a0d0e21e 93
4633a7c4 94Another interesting signal to send is signal number zero. This doesn't
95actually affect another process, but instead checks whether it's alive
54310121 96or has changed its UID.
a0d0e21e 97
4633a7c4 98 unless (kill 0 => $kid_pid) {
99 warn "something wicked happened to $kid_pid";
54310121 100 }
a0d0e21e 101
4633a7c4 102You might also want to employ anonymous functions for simple signal
103handlers:
a0d0e21e 104
4633a7c4 105 $SIG{INT} = sub { die "\nOutta here!\n" };
a0d0e21e 106
4633a7c4 107But that will be problematic for the more complicated handlers that need
54310121 108to reinstall themselves. Because Perl's signal mechanism is currently
184e9718 109based on the signal(3) function from the C library, you may sometimes be so
4633a7c4 110misfortunate as to run on systems where that function is "broken", that
111is, it behaves in the old unreliable SysV way rather than the newer, more
112reasonable BSD and POSIX fashion. So you'll see defensive people writing
113signal handlers like this:
a0d0e21e 114
54310121 115 sub REAPER {
4633a7c4 116 $waitedpid = wait;
6a3992aa 117 # loathe sysV: it makes us not only reinstate
118 # the handler, but place it after the wait
54310121 119 $SIG{CHLD} = \&REAPER;
4633a7c4 120 }
121 $SIG{CHLD} = \&REAPER;
122 # now do something that forks...
123
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 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 152 };
153 if ($@ and $@ !~ /alarm clock restart/) { die }
154
8a4f6ac2 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 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 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 178 && system('mkfifo', $path) )
179 {
5a964f20 180 die "mk{nod,fifo} $path failed";
54310121 181 }
4633a7c4 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 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 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 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 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,
237since you could no longer even write SIGCHLD handlers. Their dodginess
238is expected to be addresses in the 5.005 release.
239
a0d0e21e 240
4633a7c4 241=head1 Using open() for IPC
242
243Perl's basic open() statement can also be used for unidirectional interprocess
244communication by either appending or prepending a pipe symbol to the second
a2eb9003 245argument to open(). Here's how to start something up in a child process you
4633a7c4 246intend to write to:
247
54310121 248 open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
4633a7c4 249 || die "can't fork: $!";
250 local $SIG{PIPE} = sub { die "spooler pipe broke" };
251 print SPOOLER "stuff\n";
252 close SPOOLER || die "bad spool: $! $?";
253
254And here's how to start up a child process you intend to read from:
255
256 open(STATUS, "netstat -an 2>&1 |")
257 || die "can't fork: $!";
258 while (<STATUS>) {
259 next if /^(tcp|udp)/;
260 print;
54310121 261 }
a2eb9003 262 close STATUS || die "bad netstat: $! $?";
4633a7c4 263
264If one can be sure that a particular program is a Perl script that is
265expecting filenames in @ARGV, the clever programmer can write something
266like this:
267
5a964f20 268 % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
4633a7c4 269
270and irrespective of which shell it's called from, the Perl program will
271read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
272in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
273file. Pretty nifty, eh?
274
54310121 275You might notice that you could use backticks for much the
4633a7c4 276same effect as opening a pipe for reading:
277
278 print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
279 die "bad netstat" if $?;
280
281While this is true on the surface, it's much more efficient to process the
282file one line or record at a time because then you don't have to read the
19799a22 283whole thing into memory at once. It also gives you finer control of the
4633a7c4 284whole process, letting you to kill off the child process early if you'd
285like.
286
287Be careful to check both the open() and the close() return values. If
288you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise,
289think of what happens when you start up a pipe to a command that doesn't
290exist: the open() will in all likelihood succeed (it only reflects the
291fork()'s success), but then your output will fail--spectacularly. Perl
292can't know whether the command worked because your command is actually
293running in a separate process whose exec() might have failed. Therefore,
6a3992aa 294while readers of bogus commands return just a quick end of file, writers
4633a7c4 295to bogus command will trigger a signal they'd better be prepared to
296handle. Consider:
297
5a964f20 298 open(FH, "|bogus") or die "can't fork: $!";
299 print FH "bang\n" or die "can't write: $!";
300 close FH or die "can't close: $!";
301
302That won't blow up until the close, and it will blow up with a SIGPIPE.
303To catch it, you could use this:
304
305 $SIG{PIPE} = 'IGNORE';
306 open(FH, "|bogus") or die "can't fork: $!";
307 print FH "bang\n" or die "can't write: $!";
308 close FH or die "can't close: status=$?";
4633a7c4 309
68dc0745 310=head2 Filehandles
311
5a964f20 312Both the main process and any child processes it forks share the same
313STDIN, STDOUT, and STDERR filehandles. If both processes try to access
45bc9206 314them at once, strange things can happen. You may also want to close
5a964f20 315or reopen the filehandles for the child. You can get around this by
316opening your pipe with open(), but on some systems this means that the
317child process cannot outlive the parent.
68dc0745 318
319=head2 Background Processes
320
321You can run a command in the background with:
322
7b05b7e3 323 system("cmd &");
68dc0745 324
325The command's STDOUT and STDERR (and possibly STDIN, depending on your
326shell) will be the same as the parent's. You won't need to catch
327SIGCHLD because of the double-fork taking place (see below for more
328details).
329
330=head2 Complete Dissociation of Child from Parent
331
332In some cases (starting server processes, for instance) you'll want to
893af57a 333completely dissociate the child process from the parent. This is
334often called daemonization. A well behaved daemon will also chdir()
335to the root directory (so it doesn't prevent unmounting the filesystem
336containing the directory from which it was launched) and redirect its
337standard file descriptors from and to F</dev/null> (so that random
338output doesn't wind up on the user's terminal).
339
340 use POSIX 'setsid';
341
342 sub daemonize {
343 chdir '/' or die "Can't chdir to /: $!";
344 open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
345 open STDOUT, '>/dev/null'
346 or die "Can't write to /dev/null: $!";
347 defined(my $pid = fork) or die "Can't fork: $!";
348 exit if $pid;
349 setsid or die "Can't start a new session: $!";
350 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
351 }
5a964f20 352
893af57a 353The fork() has to come before the setsid() to ensure that you aren't a
354process group leader (the setsid() will fail if you are). If your
355system doesn't have the setsid() function, open F</dev/tty> and use the
356C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
5a964f20 357
893af57a 358Non-Unix users should check their Your_OS::Process module for other
359solutions.
68dc0745 360
4633a7c4 361=head2 Safe Pipe Opens
362
363Another interesting approach to IPC is making your single program go
364multiprocess and communicate between (or even amongst) yourselves. The
365open() function will accept a file argument of either C<"-|"> or C<"|-">
366to do a very interesting thing: it forks a child connected to the
367filehandle you've opened. The child is running the same program as the
368parent. This is useful for safely opening a file when running under an
369assumed UID or GID, for example. If you open a pipe I<to> minus, you can
370write to the filehandle you opened and your kid will find it in his
371STDIN. If you open a pipe I<from> minus, you can read from the filehandle
372you opened whatever your kid writes to his STDOUT.
373
374 use English;
375 my $sleep_count = 0;
376
54310121 377 do {
c07a80fd 378 $pid = open(KID_TO_WRITE, "|-");
4633a7c4 379 unless (defined $pid) {
380 warn "cannot fork: $!";
381 die "bailing out" if $sleep_count++ > 6;
382 sleep 10;
54310121 383 }
4633a7c4 384 } until defined $pid;
385
386 if ($pid) { # parent
c07a80fd 387 print KID_TO_WRITE @some_data;
388 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4 389 } else { # child
390 ($EUID, $EGID) = ($UID, $GID); # suid progs only
54310121 391 open (FILE, "> /safe/file")
4633a7c4 392 || die "can't open /safe/file: $!";
393 while (<STDIN>) {
394 print FILE; # child's STDIN is parent's KID
54310121 395 }
4633a7c4 396 exit; # don't forget this
54310121 397 }
4633a7c4 398
399Another common use for this construct is when you need to execute
400something without the shell's interference. With system(), it's
54310121 401straightforward, but you can't use a pipe open or backticks safely.
4633a7c4 402That's because there's no way to stop the shell from getting its hands on
403your arguments. Instead, use lower-level control to call exec() directly.
404
54310121 405Here's a safe backtick or pipe open for read:
4633a7c4 406
407 # add error processing as above
c07a80fd 408 $pid = open(KID_TO_READ, "-|");
4633a7c4 409
410 if ($pid) { # parent
c07a80fd 411 while (<KID_TO_READ>) {
4633a7c4 412 # do something interesting
54310121 413 }
c07a80fd 414 close(KID_TO_READ) || warn "kid exited $?";
4633a7c4 415
416 } else { # child
417 ($EUID, $EGID) = ($UID, $GID); # suid only
418 exec($program, @options, @args)
419 || die "can't exec program: $!";
420 # NOTREACHED
54310121 421 }
4633a7c4 422
423
424And here's a safe pipe open for writing:
425
426 # add error processing as above
c07a80fd 427 $pid = open(KID_TO_WRITE, "|-");
4633a7c4 428 $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
429
430 if ($pid) { # parent
431 for (@data) {
c07a80fd 432 print KID_TO_WRITE;
54310121 433 }
c07a80fd 434 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4 435
436 } else { # child
437 ($EUID, $EGID) = ($UID, $GID);
438 exec($program, @options, @args)
439 || die "can't exec program: $!";
440 # NOTREACHED
54310121 441 }
4633a7c4 442
443Note that these operations are full Unix forks, which means they may not be
444correctly implemented on alien systems. Additionally, these are not true
54310121 445multithreading. If you'd like to learn more about threading, see the
184e9718 446F<modules> file mentioned below in the SEE ALSO section.
4633a7c4 447
7b05b7e3 448=head2 Bidirectional Communication with Another Process
4633a7c4 449
450While this works reasonably well for unidirectional communication, what
451about bidirectional communication? The obvious thing you'd like to do
452doesn't actually work:
453
c07a80fd 454 open(PROG_FOR_READING_AND_WRITING, "| some program |")
4633a7c4 455
9f1b1f2d 456and if you forget to use the C<use warnings> pragma or the B<-w> flag,
457then you'll miss out entirely on the diagnostic message:
4633a7c4 458
459 Can't do bidirectional pipe at -e line 1.
460
461If you really want to, you can use the standard open2() library function
7b05b7e3 462to catch both ends. There's also an open3() for tridirectional I/O so you
4633a7c4 463can also catch your child's STDERR, but doing so would then require an
464awkward select() loop and wouldn't allow you to use normal Perl input
465operations.
466
467If you look at its source, you'll see that open2() uses low-level
5a964f20 468primitives like Unix pipe() and exec() calls to create all the connections.
4633a7c4 469While it might have been slightly more efficient by using socketpair(), it
470would have then been even less portable than it already is. The open2()
471and open3() functions are unlikely to work anywhere except on a Unix
472system or some other one purporting to be POSIX compliant.
473
474Here's an example of using open2():
475
476 use FileHandle;
477 use IPC::Open2;
5a964f20 478 $pid = open2(*Reader, *Writer, "cat -u -n" );
4633a7c4 479 print Writer "stuff\n";
480 $got = <Reader>;
481
6a3992aa 482The problem with this is that Unix buffering is really going to
483ruin your day. Even though your C<Writer> filehandle is auto-flushed,
4633a7c4 484and the process on the other end will get your data in a timely manner,
6a3992aa 485you can't usually do anything to force it to give it back to you
54310121 486in a similarly quick fashion. In this case, we could, because we
4633a7c4 487gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix
488commands are designed to operate over pipes, so this seldom works
54310121 489unless you yourself wrote the program on the other end of the
4633a7c4 490double-ended pipe.
491
54310121 492A solution to this is the nonstandard F<Comm.pl> library. It uses
4633a7c4 493pseudo-ttys to make your program behave more reasonably:
494
495 require 'Comm.pl';
496 $ph = open_proc('cat -n');
497 for (1..10) {
498 print $ph "a line\n";
499 print "got back ", scalar <$ph>;
500 }
a0d0e21e 501
4633a7c4 502This way you don't have to have control over the source code of the
54310121 503program you're using. The F<Comm> library also has expect()
504and interact() functions. Find the library (and we hope its
4633a7c4 505successor F<IPC::Chat>) at your nearest CPAN archive as detailed
184e9718 506in the SEE ALSO section below.
a0d0e21e 507
c8db1d39 508The newer Expect.pm module from CPAN also addresses this kind of thing.
509This module requires two other modules from CPAN: IO::Pty and IO::Stty.
510It sets up a pseudo-terminal to interact with programs that insist on
511using talking to the terminal device driver. If your system is
512amongst those supported, this may be your best bet.
513
5a964f20 514=head2 Bidirectional Communication with Yourself
515
516If you want, you may make low-level pipe() and fork()
517to stitch this together by hand. This example only
518talks to itself, but you could reopen the appropriate
519handles to STDIN and STDOUT and call other processes.
520
521 #!/usr/bin/perl -w
522 # pipe1 - bidirectional communication using two pipe pairs
523 # designed for the socketpair-challenged
524 use IO::Handle; # thousands of lines just for autoflush :-(
525 pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
526 pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
527 CHILD_WTR->autoflush(1);
528 PARENT_WTR->autoflush(1);
529
530 if ($pid = fork) {
531 close PARENT_RDR; close PARENT_WTR;
532 print CHILD_WTR "Parent Pid $$ is sending this\n";
533 chomp($line = <CHILD_RDR>);
534 print "Parent Pid $$ just read this: `$line'\n";
535 close CHILD_RDR; close CHILD_WTR;
536 waitpid($pid,0);
537 } else {
538 die "cannot fork: $!" unless defined $pid;
539 close CHILD_RDR; close CHILD_WTR;
540 chomp($line = <PARENT_RDR>);
541 print "Child Pid $$ just read this: `$line'\n";
542 print PARENT_WTR "Child Pid $$ is sending this\n";
543 close PARENT_RDR; close PARENT_WTR;
544 exit;
545 }
546
547But you don't actually have to make two pipe calls. If you
548have the socketpair() system call, it will do this all for you.
549
550 #!/usr/bin/perl -w
551 # pipe2 - bidirectional communication using socketpair
552 # "the best ones always go both ways"
553
554 use Socket;
555 use IO::Handle; # thousands of lines just for autoflush :-(
556 # We say AF_UNIX because although *_LOCAL is the
557 # POSIX 1003.1g form of the constant, many machines
558 # still don't have it.
559 socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
560 or die "socketpair: $!";
561
562 CHILD->autoflush(1);
563 PARENT->autoflush(1);
564
565 if ($pid = fork) {
566 close PARENT;
567 print CHILD "Parent Pid $$ is sending this\n";
568 chomp($line = <CHILD>);
569 print "Parent Pid $$ just read this: `$line'\n";
570 close CHILD;
571 waitpid($pid,0);
572 } else {
573 die "cannot fork: $!" unless defined $pid;
574 close CHILD;
575 chomp($line = <PARENT>);
576 print "Child Pid $$ just read this: `$line'\n";
577 print PARENT "Child Pid $$ is sending this\n";
578 close PARENT;
579 exit;
580 }
581
4633a7c4 582=head1 Sockets: Client/Server Communication
a0d0e21e 583
6a3992aa 584While not limited to Unix-derived operating systems (e.g., WinSock on PCs
4633a7c4 585provides socket support, as do some VMS libraries), you may not have
184e9718 586sockets on your system, in which case this section probably isn't going to do
6a3992aa 587you much good. With sockets, you can do both virtual circuits (i.e., TCP
588streams) and datagrams (i.e., UDP packets). You may be able to do even more
4633a7c4 589depending on your system.
590
591The Perl function calls for dealing with sockets have the same names as
592the corresponding system calls in C, but their arguments tend to differ
593for two reasons: first, Perl filehandles work differently than C file
594descriptors. Second, Perl already knows the length of its strings, so you
595don't need to pass that information.
a0d0e21e 596
4633a7c4 597One of the major problems with old socket code in Perl was that it used
598hard-coded values for some of the constants, which severely hurt
599portability. If you ever see code that does anything like explicitly
600setting C<$AF_INET = 2>, you know you're in for big trouble: An
601immeasurably superior approach is to use the C<Socket> module, which more
602reliably grants access to various constants and functions you'll need.
a0d0e21e 603
68dc0745 604If you're not writing a server/client for an existing protocol like
605NNTP or SMTP, you should give some thought to how your server will
606know when the client has finished talking, and vice-versa. Most
607protocols are based on one-line messages and responses (so one party
4a6725af 608knows the other has finished when a "\n" is received) or multi-line
68dc0745 609messages and responses that end with a period on an empty line
610("\n.\n" terminates a message/response).
611
5a964f20 612=head2 Internet Line Terminators
613
614The Internet line terminator is "\015\012". Under ASCII variants of
615Unix, that could usually be written as "\r\n", but under other systems,
616"\r\n" might at times be "\015\015\012", "\012\012\015", or something
617completely different. The standards specify writing "\015\012" to be
618conformant (be strict in what you provide), but they also recommend
619accepting a lone "\012" on input (but be lenient in what you require).
620We haven't always been very good about that in the code in this manpage,
621but unless you're on a Mac, you'll probably be ok.
622
4633a7c4 623=head2 Internet TCP Clients and Servers
a0d0e21e 624
4633a7c4 625Use Internet-domain sockets when you want to do client-server
626communication that might extend to machines outside of your own system.
627
628Here's a sample TCP client using Internet-domain sockets:
629
630 #!/usr/bin/perl -w
4633a7c4 631 use strict;
632 use Socket;
633 my ($remote,$port, $iaddr, $paddr, $proto, $line);
634
635 $remote = shift || 'localhost';
636 $port = shift || 2345; # random port
637 if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
638 die "No port" unless $port;
639 $iaddr = inet_aton($remote) || die "no host: $remote";
640 $paddr = sockaddr_in($port, $iaddr);
641
642 $proto = getprotobyname('tcp');
643 socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
644 connect(SOCK, $paddr) || die "connect: $!";
54310121 645 while (defined($line = <SOCK>)) {
4633a7c4 646 print $line;
54310121 647 }
4633a7c4 648
649 close (SOCK) || die "close: $!";
650 exit;
651
652And here's a corresponding server to go along with it. We'll
653leave the address as INADDR_ANY so that the kernel can choose
54310121 654the appropriate interface on multihomed hosts. If you want sit
c07a80fd 655on a particular interface (like the external side of a gateway
656or firewall machine), you should fill this in with your real address
657instead.
658
659 #!/usr/bin/perl -Tw
c07a80fd 660 use strict;
661 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
662 use Socket;
663 use Carp;
5a964f20 664 $EOL = "\015\012";
c07a80fd 665
54310121 666 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
c07a80fd 667
668 my $port = shift || 2345;
669 my $proto = getprotobyname('tcp');
51ee6500 670
671 ($port) = $port =~ /^(\d+)$/ || die "invalid port";
6a3992aa 672
c07a80fd 673 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 674 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd 675 pack("l", 1)) || die "setsockopt: $!";
676 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
677 listen(Server,SOMAXCONN) || die "listen: $!";
678
679 logmsg "server started on port $port";
680
681 my $paddr;
682
683 $SIG{CHLD} = \&REAPER;
684
685 for ( ; $paddr = accept(Client,Server); close Client) {
686 my($port,$iaddr) = sockaddr_in($paddr);
687 my $name = gethostbyaddr($iaddr,AF_INET);
688
54310121 689 logmsg "connection from $name [",
690 inet_ntoa($iaddr), "]
c07a80fd 691 at port $port";
692
54310121 693 print Client "Hello there, $name, it's now ",
5a964f20 694 scalar localtime, $EOL;
54310121 695 }
c07a80fd 696
54310121 697And here's a multithreaded version. It's multithreaded in that
698like most typical servers, it spawns (forks) a slave server to
c07a80fd 699handle the client request so that the master server can quickly
700go back to service a new client.
4633a7c4 701
702 #!/usr/bin/perl -Tw
4633a7c4 703 use strict;
704 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
a0d0e21e 705 use Socket;
4633a7c4 706 use Carp;
5a964f20 707 $EOL = "\015\012";
a0d0e21e 708
4633a7c4 709 sub spawn; # forward declaration
54310121 710 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
a0d0e21e 711
4633a7c4 712 my $port = shift || 2345;
713 my $proto = getprotobyname('tcp');
51ee6500 714
715 ($port) = $port =~ /^(\d+)$/ || die "invalid port";
54310121 716
c07a80fd 717 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 718 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd 719 pack("l", 1)) || die "setsockopt: $!";
720 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
721 listen(Server,SOMAXCONN) || die "listen: $!";
a0d0e21e 722
4633a7c4 723 logmsg "server started on port $port";
a0d0e21e 724
4633a7c4 725 my $waitedpid = 0;
726 my $paddr;
a0d0e21e 727
54310121 728 sub REAPER {
4633a7c4 729 $waitedpid = wait;
6a3992aa 730 $SIG{CHLD} = \&REAPER; # loathe sysV
4633a7c4 731 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
732 }
733
734 $SIG{CHLD} = \&REAPER;
735
54310121 736 for ( $waitedpid = 0;
737 ($paddr = accept(Client,Server)) || $waitedpid;
738 $waitedpid = 0, close Client)
4633a7c4 739 {
6a3992aa 740 next if $waitedpid and not $paddr;
4633a7c4 741 my($port,$iaddr) = sockaddr_in($paddr);
742 my $name = gethostbyaddr($iaddr,AF_INET);
743
54310121 744 logmsg "connection from $name [",
745 inet_ntoa($iaddr), "]
4633a7c4 746 at port $port";
a0d0e21e 747
54310121 748 spawn sub {
5a964f20 749 print "Hello there, $name, it's now ", scalar localtime, $EOL;
750 exec '/usr/games/fortune' # XXX: `wrong' line terminators
4633a7c4 751 or confess "can't exec fortune: $!";
752 };
a0d0e21e 753
54310121 754 }
a0d0e21e 755
4633a7c4 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 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 775 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
776 exit &$coderef();
54310121 777 }
4633a7c4 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 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 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 824 }
825
4633a7c4 826=head2 Unix-Domain TCP Clients and Servers
827
a2eb9003 828That's fine for Internet-domain clients and servers, but what about local
4633a7c4 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 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 837You can test for these with Perl's B<-S> file test:
838
839 unless ( -S '/dev/log' ) {
840 die "something's wicked with the print system";
54310121 841 }
4633a7c4 842
843Here's a sample Unix-domain client:
844
845 #!/usr/bin/perl -w
4633a7c4 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 856 exit;
857
5a964f20 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 861
862 #!/usr/bin/perl -Tw
4633a7c4 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 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 878
879 logmsg "server started on $NAME";
880
5a964f20 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 889 $SIG{CHLD} = \&REAPER;
890
5a964f20 891
54310121 892 for ( $waitedpid = 0;
893 accept(Client,Server) || $waitedpid;
894 $waitedpid = 0, close Client)
4633a7c4 895 {
896 next if $waitedpid;
897 logmsg "connection on $NAME";
54310121 898 spawn sub {
4633a7c4 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 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 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 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
955=over
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 1012 $EOL = "\015\012";
1013 $BLANK = $EOL x 2;
7b05b7e3 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 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 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 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 1083a cornerstones of the Unix philosophy, and good software engineering as
1084well, which is probably why it's spread to other systems.)
7b05b7e3 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 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 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 1148slightly different arguments than the client did.
1149
1150=over
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 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 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 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 1248with.
1249
1250Here's a UDP program similar to the sample Internet TCP client given
7b05b7e3 1251earlier. However, instead of checking one host at a time, the UDP version
4633a7c4 1252will check many of them asynchronously by simulating a multicast and then
1253using select() to do a timed-out wait for I/O. To do something similar
1254with TCP, you'd have to use a different socket handle for each host.
1255
1256 #!/usr/bin/perl -w
1257 use strict;
4633a7c4 1258 use Socket;
1259 use Sys::Hostname;
1260
54310121 1261 my ( $count, $hisiaddr, $hispaddr, $histime,
1262 $host, $iaddr, $paddr, $port, $proto,
4633a7c4 1263 $rin, $rout, $rtime, $SECS_of_70_YEARS);
1264
1265 $SECS_of_70_YEARS = 2208988800;
1266
1267 $iaddr = gethostbyname(hostname());
1268 $proto = getprotobyname('udp');
1269 $port = getservbyname('time', 'udp');
1270 $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1271
1272 socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
1273 bind(SOCKET, $paddr) || die "bind: $!";
1274
1275 $| = 1;
1276 printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
1277 $count = 0;
1278 for $host (@ARGV) {
1279 $count++;
1280 $hisiaddr = inet_aton($host) || die "unknown host";
1281 $hispaddr = sockaddr_in($port, $hisiaddr);
1282 defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
1283 }
1284
1285 $rin = '';
1286 vec($rin, fileno(SOCKET), 1) = 1;
1287
1288 # timeout after 10.0 seconds
1289 while ($count && select($rout = $rin, undef, undef, 10.0)) {
1290 $rtime = '';
1291 ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
1292 ($port, $hisiaddr) = sockaddr_in($hispaddr);
1293 $host = gethostbyaddr($hisiaddr, AF_INET);
1294 $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
1295 printf "%-12s ", $host;
1296 printf "%8d %s\n", $histime - time, scalar localtime($histime);
1297 $count--;
1298 }
1299
1300=head1 SysV IPC
1301
1302While System V IPC isn't so widely used as sockets, it still has some
1303interesting uses. You can't, however, effectively use SysV IPC or
1304Berkeley mmap() to have shared memory so as to share a variable amongst
1305several processes. That's because Perl would reallocate your string when
1306you weren't wanting it to.
1307
54310121 1308Here's a small example showing shared memory usage.
a0d0e21e 1309
41d6edb2 1310 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
0ade1984 1311
a0d0e21e 1312 $size = 2000;
41d6edb2 1313 $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
1314 print "shm key $id\n";
a0d0e21e 1315
1316 $message = "Message #1";
41d6edb2 1317 shmwrite($id, $message, 0, 60) || die "$!";
0ade1984 1318 print "wrote: '$message'\n";
41d6edb2 1319 shmread($id, $buff, 0, 60) || die "$!";
0ade1984 1320 print "read : '$buff'\n";
a0d0e21e 1321
0ade1984 1322 # the buffer of shmread is zero-character end-padded.
1323 substr($buff, index($buff, "\0")) = '';
1324 print "un" unless $buff eq $message;
1325 print "swell\n";
a0d0e21e 1326
41d6edb2 1327 print "deleting shm $id\n";
1328 shmctl($id, IPC_RMID, 0) || die "$!";
a0d0e21e 1329
1330Here's an example of a semaphore:
1331
0ade1984 1332 use IPC::SysV qw(IPC_CREAT);
1333
a0d0e21e 1334 $IPC_KEY = 1234;
41d6edb2 1335 $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1336 print "shm key $id\n";
a0d0e21e 1337
a2eb9003 1338Put this code in a separate file to be run in more than one process.
a0d0e21e 1339Call the file F<take>:
1340
1341 # create a semaphore
1342
1343 $IPC_KEY = 1234;
41d6edb2 1344 $id = semget($IPC_KEY, 0 , 0 );
1345 die if !defined($id);
a0d0e21e 1346
1347 $semnum = 0;
1348 $semflag = 0;
1349
1350 # 'take' semaphore
1351 # wait for semaphore to be zero
1352 $semop = 0;
41d6edb2 1353 $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1354
1355 # Increment the semaphore count
1356 $semop = 1;
41d6edb2 1357 $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1358 $opstring = $opstring1 . $opstring2;
1359
41d6edb2 1360 semop($id,$opstring) || die "$!";
a0d0e21e 1361
a2eb9003 1362Put this code in a separate file to be run in more than one process.
a0d0e21e 1363Call this file F<give>:
1364
4633a7c4 1365 # 'give' the semaphore
a0d0e21e 1366 # run this in the original process and you will see
1367 # that the second process continues
1368
1369 $IPC_KEY = 1234;
41d6edb2 1370 $id = semget($IPC_KEY, 0, 0);
1371 die if !defined($id);
a0d0e21e 1372
1373 $semnum = 0;
1374 $semflag = 0;
1375
1376 # Decrement the semaphore count
1377 $semop = -1;
41d6edb2 1378 $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
a0d0e21e 1379
41d6edb2 1380 semop($id,$opstring) || die "$!";
a0d0e21e 1381
7b05b7e3 1382The SysV IPC code above was written long ago, and it's definitely
0ade1984 1383clunky looking. For a more modern look, see the IPC::SysV module
1384which is included with Perl starting from Perl 5.005.
4633a7c4 1385
41d6edb2 1386A small example demonstrating SysV message queues:
1387
1388 use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
1389
1390 my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
1391
1392 my $sent = "message";
1393 my $type = 1234;
1394 my $rcvd;
1395 my $type_rcvd;
1396
1397 if (defined $id) {
1398 if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
1399 if (msgrcv($id, $rcvd, 60, 0, 0)) {
1400 ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
1401 if ($rcvd eq $sent) {
1402 print "okay\n";
1403 } else {
1404 print "not okay\n";
1405 }
1406 } else {
1407 die "# msgrcv failed\n";
1408 }
1409 } else {
1410 die "# msgsnd failed\n";
1411 }
1412 msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
1413 } else {
1414 die "# msgget failed\n";
1415 }
1416
4633a7c4 1417=head1 NOTES
1418
5a964f20 1419Most of these routines quietly but politely return C<undef> when they
1420fail instead of causing your program to die right then and there due to
1421an uncaught exception. (Actually, some of the new I<Socket> conversion
1422functions croak() on bad arguments.) It is therefore essential to
1423check return values from these functions. Always begin your socket
1424programs this way for optimal success, and don't forget to add B<-T>
1425taint checking flag to the #! line for servers:
4633a7c4 1426
5a964f20 1427 #!/usr/bin/perl -Tw
4633a7c4 1428 use strict;
1429 use sigtrap;
1430 use Socket;
1431
1432=head1 BUGS
1433
1434All these routines create system-specific portability problems. As noted
1435elsewhere, Perl is at the mercy of your C libraries for much of its system
1436behaviour. It's probably safest to assume broken SysV semantics for
6a3992aa 1437signals and to stick with simple TCP and UDP socket operations; e.g., don't
a2eb9003 1438try to pass open file descriptors over a local UDP datagram socket if you
4633a7c4 1439want your code to stand a chance of being portable.
1440
5a964f20 1441As mentioned in the signals section, because few vendors provide C
1442libraries that are safely re-entrant, the prudent programmer will do
1443little else within a handler beyond setting a numeric variable that
1444already exists; or, if locked into a slow (restarting) system call,
1445using die() to raise an exception and longjmp(3) out. In fact, even
1446these may in some cases cause a core dump. It's probably best to avoid
1447signals except where they are absolutely inevitable. This
1448will be addressed in a future release of Perl.
4633a7c4 1449
1450=head1 AUTHOR
1451
1452Tom Christiansen, with occasional vestiges of Larry Wall's original
7b05b7e3 1453version and suggestions from the Perl Porters.
4633a7c4 1454
1455=head1 SEE ALSO
1456
7b05b7e3 1457There's a lot more to networking than this, but this should get you
1458started.
1459
5a964f20 1460For intrepid programmers, the indispensable textbook is I<Unix Network
1461Programming> by W. Richard Stevens (published by Addison-Wesley). Note
1462that most books on networking address networking from the perspective of
1463a C programmer; translation to Perl is left as an exercise for the reader.
7b05b7e3 1464
1465The IO::Socket(3) manpage describes the object library, and the Socket(3)
1466manpage describes the low-level interface to sockets. Besides the obvious
1467functions in L<perlfunc>, you should also check out the F<modules> file
1468at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
1469FAQ> for a description of what CPAN is and where to get it.)
1470
4633a7c4 1471Section 5 of the F<modules> file is devoted to "Networking, Device Control
6a3992aa 1472(modems), and Interprocess Communication", and contains numerous unbundled
4633a7c4 1473modules numerous networking modules, Chat and Expect operations, CGI
1474programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1475Threads, and ToolTalk--just to name a few.