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