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