3 perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
7 The basic IPC facilities of Perl are built out of the good old Unix
8 signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
9 IPC calls. Each is used in slightly different situations.
13 Perl uses a simple signal handling model: the %SIG hash contains names
14 or references of user-installed signal handlers. These handlers will
15 be called with an argument which is the name of the signal that
16 triggered it. A signal may be generated intentionally from a
17 particular keyboard sequence like control-C or control-Z, sent to you
18 from another process, or triggered automatically by the kernel when
19 special events transpire, like a child process exiting, your process
20 running out of stack space, or hitting file size limit.
22 For example, to trap an interrupt signal, set up a handler like this:
27 die "Somebody sent me a SIG$signame";
29 $SIG{INT} = 'catch_zap'; # could fail in modules
30 $SIG{INT} = \&catch_zap; # best strategy
32 Prior to Perl 5.7.3 it was necessary to do as little as you possibly
33 could in your handler; notice how all we do is set a global variable
34 and then raise an exception. That's because on most systems,
35 libraries are not re-entrant; particularly, memory allocation and I/O
36 routines are not. That meant that doing nearly I<anything> in your
37 handler could in theory trigger a memory fault and subsequent core
38 dump - see L</Deferred Signals (Safe Signals)> below.
40 The names of the signals are the ones listed out by C<kill -l> on your
41 system, or you can retrieve them from the Config module. Set up an
42 @signame list indexed by number to get the name and a %signo table
43 indexed by name to get the number:
46 defined $Config{sig_name} || die "No sigs?";
47 foreach $name (split(' ', $Config{sig_name})) {
53 So to check whether signal 17 and SIGALRM were the same, do just this:
55 print "signal #17 = $signame[17]\n";
57 print "SIGALRM is $signo{ALRM}\n";
60 You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
61 the handler, in which case Perl will try to discard the signal or do the
64 On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
65 has special behavior with respect to a value of C<'IGNORE'>.
66 Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
67 not creating zombie processes when the parent process fails to C<wait()>
68 on its child processes (i.e. child processes are automatically reaped).
69 Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
70 C<-1> on such platforms.
72 Some signals can be neither trapped nor ignored, such as
73 the KILL and STOP (but not the TSTP) signals. One strategy for
74 temporarily ignoring signals is to use a local() statement, which will be
75 automatically restored once your block is exited. (Remember that local()
76 values are "inherited" by functions called from within that block.)
79 local $SIG{INT} = 'IGNORE';
83 # interrupts still ignored, for now...
86 Sending a signal to a negative process ID means that you send the signal
87 to the entire Unix process-group. This code sends a hang-up signal to all
88 processes in the current process group (and sets $SIG{HUP} to IGNORE so
89 it doesn't kill itself):
92 local $SIG{HUP} = 'IGNORE';
94 # snazzy writing of: kill('HUP', -$$)
97 Another interesting signal to send is signal number zero. This doesn't
98 actually affect a child process, but instead checks whether it's alive
99 or has changed its UID.
101 unless (kill 0 => $kid_pid) {
102 warn "something wicked happened to $kid_pid";
105 When directed at a process whose UID is not identical to that
106 of the sending process, signal number zero may fail because
107 you lack permission to send the signal, even though the process is alive.
108 You may be able to determine the cause of failure using C<%!>.
110 unless (kill 0 => $pid or $!{EPERM}) {
111 warn "$pid looks dead";
114 You might also want to employ anonymous functions for simple signal
117 $SIG{INT} = sub { die "\nOutta here!\n" };
119 But that will be problematic for the more complicated handlers that need
120 to reinstall themselves. Because Perl's signal mechanism is currently
121 based on the signal(3) function from the C library, you may sometimes be so
122 misfortunate as to run on systems where that function is "broken", that
123 is, it behaves in the old unreliable SysV way rather than the newer, more
124 reasonable BSD and POSIX fashion. So you'll see defensive people writing
125 signal handlers like this:
129 # loathe sysV: it makes us not only reinstate
130 # the handler, but place it after the wait
131 $SIG{CHLD} = \&REAPER;
133 $SIG{CHLD} = \&REAPER;
134 # now do something that forks...
138 use POSIX ":sys_wait_h";
141 # If a second child dies while in the signal handler caused by the
142 # first death, we won't get another signal. So must loop here else
143 # we will leave the unreaped child as a zombie. And the next time
144 # two children die we get another zombie. And so on.
145 while (($child = waitpid(-1,WNOHANG)) > 0) {
146 $Kid_Status{$child} = $?;
148 $SIG{CHLD} = \&REAPER; # still loathe sysV
150 $SIG{CHLD} = \&REAPER;
151 # do something that forks...
153 Signal handling is also used for timeouts in Unix, While safely
154 protected within an C<eval{}> block, you set a signal handler to trap
155 alarm signals and then schedule to have one delivered to you in some
156 number of seconds. Then try your blocking operation, clearing the alarm
157 when it's done but not before you've exited your C<eval{}> block. If it
158 goes off, you'll use die() to jump out of the block, much as you might
159 using longjmp() or throw() in other languages.
164 local $SIG{ALRM} = sub { die "alarm clock restart" };
166 flock(FH, 2); # blocking write lock
169 if ($@ and $@ !~ /alarm clock restart/) { die }
171 If the operation being timed out is system() or qx(), this technique
172 is liable to generate zombies. If this matters to you, you'll
173 need to do your own fork() and exec(), and kill the errant child process.
175 For more complex signal handling, you might see the standard POSIX
176 module. Lamentably, this is almost entirely undocumented, but
177 the F<t/lib/posix.t> file from the Perl source distribution has some
180 =head2 Handling the SIGHUP Signal in Daemons
182 A process that usually starts when the system boots and shuts down
183 when the system is shut down is called a daemon (Disk And Execution
184 MONitor). If a daemon process has a configuration file which is
185 modified after the process has been started, there should be a way to
186 tell that process to re-read its configuration file, without stopping
187 the process. Many daemons provide this mechanism using the C<SIGHUP>
188 signal handler. When you want to tell the daemon to re-read the file
189 you simply send it the C<SIGHUP> signal.
191 Not all platforms automatically reinstall their (native) signal
192 handlers after a signal delivery. This means that the handler works
193 only the first time the signal is sent. The solution to this problem
194 is to use C<POSIX> signal handlers if available, their behaviour
197 The following example implements a simple daemon, which restarts
198 itself every time the C<SIGHUP> signal is received. The actual code is
199 located in the subroutine C<code()>, which simply prints some debug
200 info to show that it works and should be replaced with the real code.
206 use File::Basename ();
207 use File::Spec::Functions;
211 # make the daemon cross-platform, so exec always calls the script
212 # itself with the right path, no matter how the script was invoked.
213 my $script = File::Basename::basename($0);
214 my $SELF = catfile $FindBin::Bin, $script;
216 # POSIX unmasks the sigprocmask properly
217 my $sigset = POSIX::SigSet->new();
218 my $action = POSIX::SigAction->new('sigHUP_handler',
221 POSIX::sigaction(&POSIX::SIGHUP, $action);
224 print "got SIGHUP\n";
225 exec($SELF, @ARGV) or die "Couldn't restart: $!\n";
232 print "ARGV: @ARGV\n";
244 A named pipe (often referred to as a FIFO) is an old Unix IPC
245 mechanism for processes communicating on the same machine. It works
246 just like a regular, connected anonymous pipes, except that the
247 processes rendezvous using a filename and don't have to be related.
249 To create a named pipe, use the C<POSIX::mkfifo()> function.
251 use POSIX qw(mkfifo);
252 mkfifo($path, 0700) or die "mkfifo $path failed: $!";
254 You can also use the Unix command mknod(1) or on some
255 systems, mkfifo(1). These may not be in your normal path.
257 # system return val is backwards, so && not ||
259 $ENV{PATH} .= ":/etc:/usr/etc";
260 if ( system('mknod', $path, 'p')
261 && system('mkfifo', $path) )
263 die "mk{nod,fifo} $path failed";
267 A fifo is convenient when you want to connect a process to an unrelated
268 one. When you open a fifo, the program will block until there's something
271 For example, let's say you'd like to have your F<.signature> file be a
272 named pipe that has a Perl program on the other end. Now every time any
273 program (like a mailer, news reader, finger program, etc.) tries to read
274 from that file, the reading program will block and your program will
275 supply the new signature. We'll use the pipe-checking file test B<-p>
276 to find out whether anyone (or anything) has accidentally removed our fifo.
279 $FIFO = '.signature';
285 POSIX::mkfifo($FIFO, 0700)
286 or die "can't mkfifo $FIFO: $!";
289 # next line blocks until there's a reader
290 open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
291 print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
293 sleep 2; # to avoid dup signals
296 =head2 Deferred Signals (Safe Signals)
298 In Perls before Perl 5.7.3 by installing Perl code to deal with
299 signals, you were exposing yourself to danger from two things. First,
300 few system library functions are re-entrant. If the signal interrupts
301 while Perl is executing one function (like malloc(3) or printf(3)),
302 and your signal handler then calls the same function again, you could
303 get unpredictable behavior--often, a core dump. Second, Perl isn't
304 itself re-entrant at the lowest levels. If the signal interrupts Perl
305 while Perl is changing its own internal data structures, similarly
306 unpredictable behaviour may result.
308 There were two things you could do, knowing this: be paranoid or be
309 pragmatic. The paranoid approach was to do as little as possible in your
310 signal handler. Set an existing integer variable that already has a
311 value, and return. This doesn't help you if you're in a slow system call,
312 which will just restart. That means you have to C<die> to longjmp(3) out
313 of the handler. Even this is a little cavalier for the true paranoiac,
314 who avoids C<die> in a handler because the system I<is> out to get you.
315 The pragmatic approach was to say "I know the risks, but prefer the
316 convenience", and to do anything you wanted in your signal handler,
317 and be prepared to clean up core dumps now and again.
319 In Perl 5.7.3 and later to avoid these problems signals are
320 "deferred"-- that is when the signal is delivered to the process by
321 the system (to the C code that implements Perl) a flag is set, and the
322 handler returns immediately. Then at strategic "safe" points in the
323 Perl interpreter (e.g. when it is about to execute a new opcode) the
324 flags are checked and the Perl level handler from %SIG is
325 executed. The "deferred" scheme allows much more flexibility in the
326 coding of signal handler as we know Perl interpreter is in a safe
327 state, and that we are not in a system library function when the
328 handler is called. However the implementation does differ from
329 previous Perls in the following ways:
333 =item Long-running opcodes
335 As the Perl interpreter only looks at the signal flags when it is about
336 to execute a new opcode, a signal that arrives during a long-running
337 opcode (e.g. a regular expression operation on a very large string) will
338 not be seen until the current opcode completes.
340 N.B. If a signal of any given type fires multiple times during an opcode
341 (such as from a fine-grained timer), the handler for that signal will
342 only be called once after the opcode completes, and all the other
343 instances will be discarded. Furthermore, if your system's signal queue
344 gets flooded to the point that there are signals that have been raised
345 but not yet caught (and thus not deferred) at the time an opcode
346 completes, those signals may well be caught and deferred during
347 subsequent opcodes, with sometimes surprising results. For example, you
348 may see alarms delivered even after calling C<alarm(0)> as the latter
349 stops the raising of alarms but does not cancel the delivery of alarms
350 raised but not yet caught. Do not depend on the behaviors described in
351 this paragraph as they are side effects of the current implementation and
352 may change in future versions of Perl.
355 =item Interrupting IO
357 When a signal is delivered (e.g. INT control-C) the operating system
358 breaks into IO operations like C<read> (used to implement Perls
359 E<lt>E<gt> operator). On older Perls the handler was called
360 immediately (and as C<read> is not "unsafe" this worked well). With
361 the "deferred" scheme the handler is not called immediately, and if
362 Perl is using system's C<stdio> library that library may re-start the
363 C<read> without returning to Perl and giving it a chance to call the
364 %SIG handler. If this happens on your system the solution is to use
365 C<:perlio> layer to do IO - at least on those handles which you want
366 to be able to break into with signals. (The C<:perlio> layer checks
367 the signal flags and calls %SIG handlers before resuming IO operation.)
369 Note that the default in Perl 5.7.3 and later is to automatically use
370 the C<:perlio> layer.
372 Note that some networking library functions like gethostbyname() are
373 known to have their own implementations of timeouts which may conflict
374 with your timeouts. If you are having problems with such functions,
375 you can try using the POSIX sigaction() function, which bypasses the
376 Perl safe signals (note that this means subjecting yourself to
377 possible memory corruption, as described above). Instead of setting
380 local $SIG{ALRM} = sub { die "alarm" };
382 try something like the following:
384 use POSIX qw(SIGALRM);
385 POSIX::sigaction(SIGALRM,
386 POSIX::SigAction->new(sub { die "alarm" }))
387 or die "Error setting SIGALRM handler: $!\n";
389 =item Restartable system calls
391 On systems that supported it, older versions of Perl used the
392 SA_RESTART flag when installing %SIG handlers. This meant that
393 restartable system calls would continue rather than returning when
394 a signal arrived. In order to deliver deferred signals promptly,
395 Perl 5.7.3 and later do I<not> use SA_RESTART. Consequently,
396 restartable system calls can fail (with $! set to C<EINTR>) in places
397 where they previously would have succeeded.
399 Note that the default C<:perlio> layer will retry C<read>, C<write>
400 and C<close> as described above and that interrupted C<wait> and
401 C<waitpid> calls will always be retried.
403 =item Signals as "faults"
405 Certain signals, e.g. SEGV, ILL, and BUS, are generated as a result of
406 virtual memory or other "faults". These are normally fatal and there is
407 little a Perl-level handler can do with them, so Perl now delivers them
408 immediately rather than attempting to defer them.
410 =item Signals triggered by operating system state
412 On some operating systems certain signal handlers are supposed to "do
413 something" before returning. One example can be CHLD or CLD which
414 indicates a child process has completed. On some operating systems the
415 signal handler is expected to C<wait> for the completed child
416 process. On such systems the deferred signal scheme will not work for
417 those signals (it does not do the C<wait>). Again the failure will
418 look like a loop as the operating system will re-issue the signal as
419 there are un-waited-for completed child processes.
423 If you want the old signal behaviour back regardless of possible
424 memory corruption, set the environment variable C<PERL_SIGNALS> to
425 C<"unsafe"> (a new feature since Perl 5.8.1).
427 =head1 Using open() for IPC
429 Perl's basic open() statement can also be used for unidirectional
430 interprocess communication by either appending or prepending a pipe
431 symbol to the second argument to open(). Here's how to start
432 something up in a child process you intend to write to:
434 open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
435 || die "can't fork: $!";
436 local $SIG{PIPE} = sub { die "spooler pipe broke" };
437 print SPOOLER "stuff\n";
438 close SPOOLER || die "bad spool: $! $?";
440 And here's how to start up a child process you intend to read from:
442 open(STATUS, "netstat -an 2>&1 |")
443 || die "can't fork: $!";
445 next if /^(tcp|udp)/;
448 close STATUS || die "bad netstat: $! $?";
450 If one can be sure that a particular program is a Perl script that is
451 expecting filenames in @ARGV, the clever programmer can write something
454 % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
456 and irrespective of which shell it's called from, the Perl program will
457 read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
458 in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
459 file. Pretty nifty, eh?
461 You might notice that you could use backticks for much the
462 same effect as opening a pipe for reading:
464 print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
465 die "bad netstat" if $?;
467 While this is true on the surface, it's much more efficient to process the
468 file one line or record at a time because then you don't have to read the
469 whole thing into memory at once. It also gives you finer control of the
470 whole process, letting you to kill off the child process early if you'd
473 Be careful to check both the open() and the close() return values. If
474 you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise,
475 think of what happens when you start up a pipe to a command that doesn't
476 exist: the open() will in all likelihood succeed (it only reflects the
477 fork()'s success), but then your output will fail--spectacularly. Perl
478 can't know whether the command worked because your command is actually
479 running in a separate process whose exec() might have failed. Therefore,
480 while readers of bogus commands return just a quick end of file, writers
481 to bogus command will trigger a signal they'd better be prepared to
484 open(FH, "|bogus") or die "can't fork: $!";
485 print FH "bang\n" or die "can't write: $!";
486 close FH or die "can't close: $!";
488 That won't blow up until the close, and it will blow up with a SIGPIPE.
489 To catch it, you could use this:
491 $SIG{PIPE} = 'IGNORE';
492 open(FH, "|bogus") or die "can't fork: $!";
493 print FH "bang\n" or die "can't write: $!";
494 close FH or die "can't close: status=$?";
498 Both the main process and any child processes it forks share the same
499 STDIN, STDOUT, and STDERR filehandles. If both processes try to access
500 them at once, strange things can happen. You may also want to close
501 or reopen the filehandles for the child. You can get around this by
502 opening your pipe with open(), but on some systems this means that the
503 child process cannot outlive the parent.
505 =head2 Background Processes
507 You can run a command in the background with:
511 The command's STDOUT and STDERR (and possibly STDIN, depending on your
512 shell) will be the same as the parent's. You won't need to catch
513 SIGCHLD because of the double-fork taking place (see below for more
516 =head2 Complete Dissociation of Child from Parent
518 In some cases (starting server processes, for instance) you'll want to
519 completely dissociate the child process from the parent. This is
520 often called daemonization. A well behaved daemon will also chdir()
521 to the root directory (so it doesn't prevent unmounting the filesystem
522 containing the directory from which it was launched) and redirect its
523 standard file descriptors from and to F</dev/null> (so that random
524 output doesn't wind up on the user's terminal).
529 chdir '/' or die "Can't chdir to /: $!";
530 open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
531 open STDOUT, '>/dev/null'
532 or die "Can't write to /dev/null: $!";
533 defined(my $pid = fork) or die "Can't fork: $!";
535 setsid or die "Can't start a new session: $!";
536 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
539 The fork() has to come before the setsid() to ensure that you aren't a
540 process group leader (the setsid() will fail if you are). If your
541 system doesn't have the setsid() function, open F</dev/tty> and use the
542 C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
544 Non-Unix users should check their Your_OS::Process module for other
547 =head2 Safe Pipe Opens
549 Another interesting approach to IPC is making your single program go
550 multiprocess and communicate between (or even amongst) yourselves. The
551 open() function will accept a file argument of either C<"-|"> or C<"|-">
552 to do a very interesting thing: it forks a child connected to the
553 filehandle you've opened. The child is running the same program as the
554 parent. This is useful for safely opening a file when running under an
555 assumed UID or GID, for example. If you open a pipe I<to> minus, you can
556 write to the filehandle you opened and your kid will find it in his
557 STDIN. If you open a pipe I<from> minus, you can read from the filehandle
558 you opened whatever your kid writes to his STDOUT.
560 use English '-no_match_vars';
564 $pid = open(KID_TO_WRITE, "|-");
565 unless (defined $pid) {
566 warn "cannot fork: $!";
567 die "bailing out" if $sleep_count++ > 6;
570 } until defined $pid;
573 print KID_TO_WRITE @some_data;
574 close(KID_TO_WRITE) || warn "kid exited $?";
576 ($EUID, $EGID) = ($UID, $GID); # suid progs only
577 open (FILE, "> /safe/file")
578 || die "can't open /safe/file: $!";
580 print FILE; # child's STDIN is parent's KID
582 exit; # don't forget this
585 Another common use for this construct is when you need to execute
586 something without the shell's interference. With system(), it's
587 straightforward, but you can't use a pipe open or backticks safely.
588 That's because there's no way to stop the shell from getting its hands on
589 your arguments. Instead, use lower-level control to call exec() directly.
591 Here's a safe backtick or pipe open for read:
593 # add error processing as above
594 $pid = open(KID_TO_READ, "-|");
597 while (<KID_TO_READ>) {
598 # do something interesting
600 close(KID_TO_READ) || warn "kid exited $?";
603 ($EUID, $EGID) = ($UID, $GID); # suid only
604 exec($program, @options, @args)
605 || die "can't exec program: $!";
610 And here's a safe pipe open for writing:
612 # add error processing as above
613 $pid = open(KID_TO_WRITE, "|-");
614 $SIG{PIPE} = sub { die "whoops, $program pipe broke" };
620 close(KID_TO_WRITE) || warn "kid exited $?";
623 ($EUID, $EGID) = ($UID, $GID);
624 exec($program, @options, @args)
625 || die "can't exec program: $!";
629 Since Perl 5.8.0, you can also use the list form of C<open> for pipes :
632 open KID_PS, "-|", "ps", "aux" or die $!;
634 forks the ps(1) command (without spawning a shell, as there are more than
635 three arguments to open()), and reads its standard output via the
636 C<KID_PS> filehandle. The corresponding syntax to write to command
637 pipes (with C<"|-"> in place of C<"-|">) is also implemented.
639 Note that these operations are full Unix forks, which means they may not be
640 correctly implemented on alien systems. Additionally, these are not true
641 multithreading. If you'd like to learn more about threading, see the
642 F<modules> file mentioned below in the SEE ALSO section.
644 =head2 Bidirectional Communication with Another Process
646 While this works reasonably well for unidirectional communication, what
647 about bidirectional communication? The obvious thing you'd like to do
648 doesn't actually work:
650 open(PROG_FOR_READING_AND_WRITING, "| some program |")
652 and if you forget to use the C<use warnings> pragma or the B<-w> flag,
653 then you'll miss out entirely on the diagnostic message:
655 Can't do bidirectional pipe at -e line 1.
657 If you really want to, you can use the standard open2() library function
658 to catch both ends. There's also an open3() for tridirectional I/O so you
659 can also catch your child's STDERR, but doing so would then require an
660 awkward select() loop and wouldn't allow you to use normal Perl input
663 If you look at its source, you'll see that open2() uses low-level
664 primitives like Unix pipe() and exec() calls to create all the connections.
665 While it might have been slightly more efficient by using socketpair(), it
666 would have then been even less portable than it already is. The open2()
667 and open3() functions are unlikely to work anywhere except on a Unix
668 system or some other one purporting to be POSIX compliant.
670 Here's an example of using open2():
674 $pid = open2(*Reader, *Writer, "cat -u -n" );
675 print Writer "stuff\n";
678 The problem with this is that Unix buffering is really going to
679 ruin your day. Even though your C<Writer> filehandle is auto-flushed,
680 and the process on the other end will get your data in a timely manner,
681 you can't usually do anything to force it to give it back to you
682 in a similarly quick fashion. In this case, we could, because we
683 gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix
684 commands are designed to operate over pipes, so this seldom works
685 unless you yourself wrote the program on the other end of the
688 A solution to this is the nonstandard F<Comm.pl> library. It uses
689 pseudo-ttys to make your program behave more reasonably:
692 $ph = open_proc('cat -n');
694 print $ph "a line\n";
695 print "got back ", scalar <$ph>;
698 This way you don't have to have control over the source code of the
699 program you're using. The F<Comm> library also has expect()
700 and interact() functions. Find the library (and we hope its
701 successor F<IPC::Chat>) at your nearest CPAN archive as detailed
702 in the SEE ALSO section below.
704 The newer Expect.pm module from CPAN also addresses this kind of thing.
705 This module requires two other modules from CPAN: IO::Pty and IO::Stty.
706 It sets up a pseudo-terminal to interact with programs that insist on
707 using talking to the terminal device driver. If your system is
708 amongst those supported, this may be your best bet.
710 =head2 Bidirectional Communication with Yourself
712 If you want, you may make low-level pipe() and fork()
713 to stitch this together by hand. This example only
714 talks to itself, but you could reopen the appropriate
715 handles to STDIN and STDOUT and call other processes.
718 # pipe1 - bidirectional communication using two pipe pairs
719 # designed for the socketpair-challenged
720 use IO::Handle; # thousands of lines just for autoflush :-(
721 pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
722 pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
723 CHILD_WTR->autoflush(1);
724 PARENT_WTR->autoflush(1);
727 close PARENT_RDR; close PARENT_WTR;
728 print CHILD_WTR "Parent Pid $$ is sending this\n";
729 chomp($line = <CHILD_RDR>);
730 print "Parent Pid $$ just read this: `$line'\n";
731 close CHILD_RDR; close CHILD_WTR;
734 die "cannot fork: $!" unless defined $pid;
735 close CHILD_RDR; close CHILD_WTR;
736 chomp($line = <PARENT_RDR>);
737 print "Child Pid $$ just read this: `$line'\n";
738 print PARENT_WTR "Child Pid $$ is sending this\n";
739 close PARENT_RDR; close PARENT_WTR;
743 But you don't actually have to make two pipe calls. If you
744 have the socketpair() system call, it will do this all for you.
747 # pipe2 - bidirectional communication using socketpair
748 # "the best ones always go both ways"
751 use IO::Handle; # thousands of lines just for autoflush :-(
752 # We say AF_UNIX because although *_LOCAL is the
753 # POSIX 1003.1g form of the constant, many machines
754 # still don't have it.
755 socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
756 or die "socketpair: $!";
759 PARENT->autoflush(1);
763 print CHILD "Parent Pid $$ is sending this\n";
764 chomp($line = <CHILD>);
765 print "Parent Pid $$ just read this: `$line'\n";
769 die "cannot fork: $!" unless defined $pid;
771 chomp($line = <PARENT>);
772 print "Child Pid $$ just read this: `$line'\n";
773 print PARENT "Child Pid $$ is sending this\n";
778 =head1 Sockets: Client/Server Communication
780 While not limited to Unix-derived operating systems (e.g., WinSock on PCs
781 provides socket support, as do some VMS libraries), you may not have
782 sockets on your system, in which case this section probably isn't going to do
783 you much good. With sockets, you can do both virtual circuits (i.e., TCP
784 streams) and datagrams (i.e., UDP packets). You may be able to do even more
785 depending on your system.
787 The Perl function calls for dealing with sockets have the same names as
788 the corresponding system calls in C, but their arguments tend to differ
789 for two reasons: first, Perl filehandles work differently than C file
790 descriptors. Second, Perl already knows the length of its strings, so you
791 don't need to pass that information.
793 One of the major problems with old socket code in Perl was that it used
794 hard-coded values for some of the constants, which severely hurt
795 portability. If you ever see code that does anything like explicitly
796 setting C<$AF_INET = 2>, you know you're in for big trouble: An
797 immeasurably superior approach is to use the C<Socket> module, which more
798 reliably grants access to various constants and functions you'll need.
800 If you're not writing a server/client for an existing protocol like
801 NNTP or SMTP, you should give some thought to how your server will
802 know when the client has finished talking, and vice-versa. Most
803 protocols are based on one-line messages and responses (so one party
804 knows the other has finished when a "\n" is received) or multi-line
805 messages and responses that end with a period on an empty line
806 ("\n.\n" terminates a message/response).
808 =head2 Internet Line Terminators
810 The Internet line terminator is "\015\012". Under ASCII variants of
811 Unix, that could usually be written as "\r\n", but under other systems,
812 "\r\n" might at times be "\015\015\012", "\012\012\015", or something
813 completely different. The standards specify writing "\015\012" to be
814 conformant (be strict in what you provide), but they also recommend
815 accepting a lone "\012" on input (but be lenient in what you require).
816 We haven't always been very good about that in the code in this manpage,
817 but unless you're on a Mac, you'll probably be ok.
819 =head2 Internet TCP Clients and Servers
821 Use Internet-domain sockets when you want to do client-server
822 communication that might extend to machines outside of your own system.
824 Here's a sample TCP client using Internet-domain sockets:
829 my ($remote,$port, $iaddr, $paddr, $proto, $line);
831 $remote = shift || 'localhost';
832 $port = shift || 2345; # random port
833 if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
834 die "No port" unless $port;
835 $iaddr = inet_aton($remote) || die "no host: $remote";
836 $paddr = sockaddr_in($port, $iaddr);
838 $proto = getprotobyname('tcp');
839 socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
840 connect(SOCK, $paddr) || die "connect: $!";
841 while (defined($line = <SOCK>)) {
845 close (SOCK) || die "close: $!";
848 And here's a corresponding server to go along with it. We'll
849 leave the address as INADDR_ANY so that the kernel can choose
850 the appropriate interface on multihomed hosts. If you want sit
851 on a particular interface (like the external side of a gateway
852 or firewall machine), you should fill this in with your real address
857 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
860 my $EOL = "\015\012";
862 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
864 my $port = shift || 2345;
865 my $proto = getprotobyname('tcp');
867 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
869 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
870 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
871 pack("l", 1)) || die "setsockopt: $!";
872 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
873 listen(Server,SOMAXCONN) || die "listen: $!";
875 logmsg "server started on port $port";
879 $SIG{CHLD} = \&REAPER;
881 for ( ; $paddr = accept(Client,Server); close Client) {
882 my($port,$iaddr) = sockaddr_in($paddr);
883 my $name = gethostbyaddr($iaddr,AF_INET);
885 logmsg "connection from $name [",
886 inet_ntoa($iaddr), "]
889 print Client "Hello there, $name, it's now ",
890 scalar localtime, $EOL;
893 And here's a multithreaded version. It's multithreaded in that
894 like most typical servers, it spawns (forks) a slave server to
895 handle the client request so that the master server can quickly
896 go back to service a new client.
900 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
903 my $EOL = "\015\012";
905 sub spawn; # forward declaration
906 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
908 my $port = shift || 2345;
909 my $proto = getprotobyname('tcp');
911 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
913 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
914 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
915 pack("l", 1)) || die "setsockopt: $!";
916 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
917 listen(Server,SOMAXCONN) || die "listen: $!";
919 logmsg "server started on port $port";
924 use POSIX ":sys_wait_h";
928 local $!; # don't let waitpid() overwrite current error
929 while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
930 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
932 $SIG{CHLD} = \&REAPER; # loathe sysV
935 $SIG{CHLD} = \&REAPER;
938 $paddr = accept(Client, Server) || do {
939 # try again if accept() returned because a signal was received
943 my ($port, $iaddr) = sockaddr_in($paddr);
944 my $name = gethostbyaddr($iaddr, AF_INET);
946 logmsg "connection from $name [",
952 print "Hello there, $name, it's now ", scalar localtime, $EOL;
953 exec '/usr/games/fortune' # XXX: `wrong' line terminators
954 or confess "can't exec fortune: $!";
962 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
963 confess "usage: spawn CODEREF";
967 if (! defined($pid = fork)) {
968 logmsg "cannot fork: $!";
973 return; # I'm the parent
975 # else I'm the child -- go spawn
977 open(STDIN, "<&Client") || die "can't dup client to stdin";
978 open(STDOUT, ">&Client") || die "can't dup client to stdout";
979 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
983 This server takes the trouble to clone off a child version via fork()
984 for each incoming request. That way it can handle many requests at
985 once, which you might not always want. Even if you don't fork(), the
986 listen() will allow that many pending connections. Forking servers
987 have to be particularly careful about cleaning up their dead children
988 (called "zombies" in Unix parlance), because otherwise you'll quickly
989 fill up your process table. The REAPER subroutine is used here to
990 call waitpid() for any child processes that have finished, thereby
991 ensuring that they terminate cleanly and don't join the ranks of the
994 Within the while loop we call accept() and check to see if it returns
995 a false value. This would normally indicate a system error that needs
996 to be reported. However the introduction of safe signals (see
997 L</Deferred Signals (Safe Signals)> above) in Perl 5.7.3 means that
998 accept() may also be interrupted when the process receives a signal.
999 This typically happens when one of the forked sub-processes exits and
1000 notifies the parent process with a CHLD signal.
1002 If accept() is interrupted by a signal then $! will be set to EINTR.
1003 If this happens then we can safely continue to the next iteration of
1004 the loop and another call to accept(). It is important that your
1005 signal handling code doesn't modify the value of $! or this test will
1006 most likely fail. In the REAPER subroutine we create a local version
1007 of $! before calling waitpid(). When waitpid() sets $! to ECHILD (as
1008 it inevitably does when it has no more children waiting), it will
1009 update the local copy leaving the original unchanged.
1011 We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
1012 even if we aren't running setuid or setgid. This is always a good idea
1013 for servers and other programs run on behalf of someone else (like CGI
1014 scripts), because it lessens the chances that people from the outside will
1015 be able to compromise your system.
1017 Let's look at another TCP client. This one connects to the TCP "time"
1018 service on a number of different machines and shows how far their clocks
1019 differ from the system on which it's being run:
1025 my $SECS_of_70_YEARS = 2208988800;
1026 sub ctime { scalar localtime(shift) }
1028 my $iaddr = gethostbyname('localhost');
1029 my $proto = getprotobyname('tcp');
1030 my $port = getservbyname('time', 'tcp');
1031 my $paddr = sockaddr_in(0, $iaddr);
1035 printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
1037 foreach $host (@ARGV) {
1038 printf "%-24s ", $host;
1039 my $hisiaddr = inet_aton($host) || die "unknown host";
1040 my $hispaddr = sockaddr_in($port, $hisiaddr);
1041 socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
1042 connect(SOCKET, $hispaddr) || die "bind: $!";
1044 read(SOCKET, $rtime, 4);
1046 my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
1047 printf "%8d %s\n", $histime - time, ctime($histime);
1050 =head2 Unix-Domain TCP Clients and Servers
1052 That's fine for Internet-domain clients and servers, but what about local
1053 communications? While you can use the same setup, sometimes you don't
1054 want to. Unix-domain sockets are local to the current host, and are often
1055 used internally to implement pipes. Unlike Internet domain sockets, Unix
1056 domain sockets can show up in the file system with an ls(1) listing.
1059 srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
1061 You can test for these with Perl's B<-S> file test:
1063 unless ( -S '/dev/log' ) {
1064 die "something's wicked with the log system";
1067 Here's a sample Unix-domain client:
1072 my ($rendezvous, $line);
1074 $rendezvous = shift || 'catsock';
1075 socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
1076 connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
1077 while (defined($line = <SOCK>)) {
1082 And here's a corresponding server. You don't have to worry about silly
1083 network terminators here because Unix domain sockets are guaranteed
1084 to be on the localhost, and thus everything works right.
1091 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
1092 sub spawn; # forward declaration
1093 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
1095 my $NAME = 'catsock';
1096 my $uaddr = sockaddr_un($NAME);
1097 my $proto = getprotobyname('tcp');
1099 socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
1101 bind (Server, $uaddr) || die "bind: $!";
1102 listen(Server,SOMAXCONN) || die "listen: $!";
1104 logmsg "server started on $NAME";
1108 use POSIX ":sys_wait_h";
1111 while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
1112 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
1114 $SIG{CHLD} = \&REAPER; # loathe sysV
1117 $SIG{CHLD} = \&REAPER;
1120 for ( $waitedpid = 0;
1121 accept(Client,Server) || $waitedpid;
1122 $waitedpid = 0, close Client)
1125 logmsg "connection on $NAME";
1127 print "Hello there, it's now ", scalar localtime, "\n";
1128 exec '/usr/games/fortune' or die "can't exec fortune: $!";
1133 my $coderef = shift;
1135 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
1136 confess "usage: spawn CODEREF";
1140 if (!defined($pid = fork)) {
1141 logmsg "cannot fork: $!";
1144 logmsg "begat $pid";
1145 return; # I'm the parent
1147 # else I'm the child -- go spawn
1149 open(STDIN, "<&Client") || die "can't dup client to stdin";
1150 open(STDOUT, ">&Client") || die "can't dup client to stdout";
1151 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
1155 As you see, it's remarkably similar to the Internet domain TCP server, so
1156 much so, in fact, that we've omitted several duplicate functions--spawn(),
1157 logmsg(), ctime(), and REAPER()--which are exactly the same as in the
1160 So why would you ever want to use a Unix domain socket instead of a
1161 simpler named pipe? Because a named pipe doesn't give you sessions. You
1162 can't tell one process's data from another's. With socket programming,
1163 you get a separate session for each client: that's why accept() takes two
1166 For example, let's say that you have a long running database server daemon
1167 that you want folks from the World Wide Web to be able to access, but only
1168 if they go through a CGI interface. You'd have a small, simple CGI
1169 program that does whatever checks and logging you feel like, and then acts
1170 as a Unix-domain client and connects to your private server.
1172 =head1 TCP Clients with IO::Socket
1174 For those preferring a higher-level interface to socket programming, the
1175 IO::Socket module provides an object-oriented approach. IO::Socket is
1176 included as part of the standard Perl distribution as of the 5.004
1177 release. If you're running an earlier version of Perl, just fetch
1178 IO::Socket from CPAN, where you'll also find modules providing easy
1179 interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
1180 NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
1183 =head2 A Simple Client
1185 Here's a client that creates a TCP connection to the "daytime"
1186 service at port 13 of the host name "localhost" and prints out everything
1187 that the server there cares to provide.
1191 $remote = IO::Socket::INET->new(
1193 PeerAddr => "localhost",
1194 PeerPort => "daytime(13)",
1196 or die "cannot connect to daytime port at localhost";
1197 while ( <$remote> ) { print }
1199 When you run this program, you should get something back that
1202 Wed May 14 08:40:46 MDT 1997
1204 Here are what those parameters to the C<new> constructor mean:
1210 This is which protocol to use. In this case, the socket handle returned
1211 will be connected to a TCP socket, because we want a stream-oriented
1212 connection, that is, one that acts pretty much like a plain old file.
1213 Not all sockets are this of this type. For example, the UDP protocol
1214 can be used to make a datagram socket, used for message-passing.
1218 This is the name or Internet address of the remote host the server is
1219 running on. We could have specified a longer name like C<"www.perl.com">,
1220 or an address like C<"204.148.40.9">. For demonstration purposes, we've
1221 used the special hostname C<"localhost">, which should always mean the
1222 current machine you're running on. The corresponding Internet address
1223 for localhost is C<"127.1">, if you'd rather use that.
1227 This is the service name or port number we'd like to connect to.
1228 We could have gotten away with using just C<"daytime"> on systems with a
1229 well-configured system services file,[FOOTNOTE: The system services file
1230 is in I</etc/services> under Unix] but just in case, we've specified the
1231 port number (13) in parentheses. Using just the number would also have
1232 worked, but constant numbers make careful programmers nervous.
1236 Notice how the return value from the C<new> constructor is used as
1237 a filehandle in the C<while> loop? That's what's called an indirect
1238 filehandle, a scalar variable containing a filehandle. You can use
1239 it the same way you would a normal filehandle. For example, you
1240 can read one line from it this way:
1244 all remaining lines from is this way:
1248 and send a line of data to it this way:
1250 print $handle "some data\n";
1252 =head2 A Webget Client
1254 Here's a simple client that takes a remote host to fetch a document
1255 from, and then a list of documents to get from that host. This is a
1256 more interesting client than the previous one because it first sends
1257 something to the server before fetching the server's response.
1261 unless (@ARGV > 1) { die "usage: $0 host document ..." }
1262 $host = shift(@ARGV);
1265 foreach $document ( @ARGV ) {
1266 $remote = IO::Socket::INET->new( Proto => "tcp",
1268 PeerPort => "http(80)",
1270 unless ($remote) { die "cannot connect to http daemon on $host" }
1271 $remote->autoflush(1);
1272 print $remote "GET $document HTTP/1.0" . $BLANK;
1273 while ( <$remote> ) { print }
1277 The web server handing the "http" service, which is assumed to be at
1278 its standard port, number 80. If the web server you're trying to
1279 connect to is at a different port (like 1080 or 8080), you should specify
1280 as the named-parameter pair, C<< PeerPort => 8080 >>. The C<autoflush>
1281 method is used on the socket because otherwise the system would buffer
1282 up the output we sent it. (If you're on a Mac, you'll also need to
1283 change every C<"\n"> in your code that sends data over the network to
1284 be a C<"\015\012"> instead.)
1286 Connecting to the server is only the first part of the process: once you
1287 have the connection, you have to use the server's language. Each server
1288 on the network has its own little command language that it expects as
1289 input. The string that we send to the server starting with "GET" is in
1290 HTTP syntax. In this case, we simply request each specified document.
1291 Yes, we really are making a new connection for each document, even though
1292 it's the same host. That's the way you always used to have to speak HTTP.
1293 Recent versions of web browsers may request that the remote server leave
1294 the connection open a little while, but the server doesn't have to honor
1297 Here's an example of running that program, which we'll call I<webget>:
1299 % webget www.perl.com /guanaco.html
1300 HTTP/1.1 404 File Not Found
1301 Date: Thu, 08 May 1997 18:02:32 GMT
1302 Server: Apache/1.2b6
1304 Content-type: text/html
1306 <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
1307 <BODY><H1>File Not Found</H1>
1308 The requested URL /guanaco.html was not found on this server.<P>
1311 Ok, so that's not very interesting, because it didn't find that
1312 particular document. But a long response wouldn't have fit on this page.
1314 For a more fully-featured version of this program, you should look to
1315 the I<lwp-request> program included with the LWP modules from CPAN.
1317 =head2 Interactive Client with IO::Socket
1319 Well, that's all fine if you want to send one command and get one answer,
1320 but what about setting up something fully interactive, somewhat like
1321 the way I<telnet> works? That way you can type a line, get the answer,
1322 type a line, get the answer, etc.
1324 This client is more complicated than the two we've done so far, but if
1325 you're on a system that supports the powerful C<fork> call, the solution
1326 isn't that rough. Once you've made the connection to whatever service
1327 you'd like to chat with, call C<fork> to clone your process. Each of
1328 these two identical process has a very simple job to do: the parent
1329 copies everything from the socket to standard output, while the child
1330 simultaneously copies everything from standard input to the socket.
1331 To accomplish the same thing using just one process would be I<much>
1332 harder, because it's easier to code two processes to do one thing than it
1333 is to code one process to do two things. (This keep-it-simple principle
1334 a cornerstones of the Unix philosophy, and good software engineering as
1335 well, which is probably why it's spread to other systems.)
1342 my ($host, $port, $kidpid, $handle, $line);
1344 unless (@ARGV == 2) { die "usage: $0 host port" }
1345 ($host, $port) = @ARGV;
1347 # create a tcp connection to the specified host and port
1348 $handle = IO::Socket::INET->new(Proto => "tcp",
1351 or die "can't connect to port $port on $host: $!";
1353 $handle->autoflush(1); # so output gets there right away
1354 print STDERR "[Connected to $host:$port]\n";
1356 # split the program into two processes, identical twins
1357 die "can't fork: $!" unless defined($kidpid = fork());
1359 # the if{} block runs only in the parent process
1361 # copy the socket to standard output
1362 while (defined ($line = <$handle>)) {
1365 kill("TERM", $kidpid); # send SIGTERM to child
1367 # the else{} block runs only in the child process
1369 # copy standard input to the socket
1370 while (defined ($line = <STDIN>)) {
1371 print $handle $line;
1375 The C<kill> function in the parent's C<if> block is there to send a
1376 signal to our child process (current running in the C<else> block)
1377 as soon as the remote server has closed its end of the connection.
1379 If the remote server sends data a byte at time, and you need that
1380 data immediately without waiting for a newline (which might not happen),
1381 you may wish to replace the C<while> loop in the parent with the
1385 while (sysread($handle, $byte, 1) == 1) {
1389 Making a system call for each byte you want to read is not very efficient
1390 (to put it mildly) but is the simplest to explain and works reasonably
1393 =head1 TCP Servers with IO::Socket
1395 As always, setting up a server is little bit more involved than running a client.
1396 The model is that the server creates a special kind of socket that
1397 does nothing but listen on a particular port for incoming connections.
1398 It does this by calling the C<< IO::Socket::INET->new() >> method with
1399 slightly different arguments than the client did.
1405 This is which protocol to use. Like our clients, we'll
1406 still specify C<"tcp"> here.
1411 port in the C<LocalPort> argument, which we didn't do for the client.
1412 This is service name or port number for which you want to be the
1413 server. (Under Unix, ports under 1024 are restricted to the
1414 superuser.) In our sample, we'll use port 9000, but you can use
1415 any port that's not currently in use on your system. If you try
1416 to use one already in used, you'll get an "Address already in use"
1417 message. Under Unix, the C<netstat -a> command will show
1418 which services current have servers.
1422 The C<Listen> parameter is set to the maximum number of
1423 pending connections we can accept until we turn away incoming clients.
1424 Think of it as a call-waiting queue for your telephone.
1425 The low-level Socket module has a special symbol for the system maximum, which
1430 The C<Reuse> parameter is needed so that we restart our server
1431 manually without waiting a few minutes to allow system buffers to
1436 Once the generic server socket has been created using the parameters
1437 listed above, the server then waits for a new client to connect
1438 to it. The server blocks in the C<accept> method, which eventually accepts a
1439 bidirectional connection from the remote client. (Make sure to autoflush
1440 this handle to circumvent buffering.)
1442 To add to user-friendliness, our server prompts the user for commands.
1443 Most servers don't do this. Because of the prompt without a newline,
1444 you'll have to use the C<sysread> variant of the interactive client above.
1446 This server accepts one of five different commands, sending output
1447 back to the client. Note that unlike most network servers, this one
1448 only handles one incoming client at a time. Multithreaded servers are
1449 covered in Chapter 6 of the Camel.
1451 Here's the code. We'll
1455 use Net::hostent; # for OO version of gethostbyaddr
1457 $PORT = 9000; # pick something not in use
1459 $server = IO::Socket::INET->new( Proto => 'tcp',
1461 Listen => SOMAXCONN,
1464 die "can't setup server" unless $server;
1465 print "[Server $0 accepting clients]\n";
1467 while ($client = $server->accept()) {
1468 $client->autoflush(1);
1469 print $client "Welcome to $0; type help for command list.\n";
1470 $hostinfo = gethostbyaddr($client->peeraddr);
1471 printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
1472 print $client "Command? ";
1473 while ( <$client>) {
1474 next unless /\S/; # blank line
1475 if (/quit|exit/i) { last; }
1476 elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
1477 elsif (/who/i ) { print $client `who 2>&1`; }
1478 elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
1479 elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
1481 print $client "Commands: quit date who cookie motd\n";
1484 print $client "Command? ";
1489 =head1 UDP: Message Passing
1491 Another kind of client-server setup is one that uses not connections, but
1492 messages. UDP communications involve much lower overhead but also provide
1493 less reliability, as there are no promises that messages will arrive at
1494 all, let alone in order and unmangled. Still, UDP offers some advantages
1495 over TCP, including being able to "broadcast" or "multicast" to a whole
1496 bunch of destination hosts at once (usually on your local subnet). If you
1497 find yourself overly concerned about reliability and start building checks
1498 into your message system, then you probably should use just TCP to start
1501 Note that UDP datagrams are I<not> a bytestream and should not be treated
1502 as such. This makes using I/O mechanisms with internal buffering
1503 like stdio (i.e. print() and friends) especially cumbersome. Use syswrite(),
1504 or better send(), like in the example below.
1506 Here's a UDP program similar to the sample Internet TCP client given
1507 earlier. However, instead of checking one host at a time, the UDP version
1508 will check many of them asynchronously by simulating a multicast and then
1509 using select() to do a timed-out wait for I/O. To do something similar
1510 with TCP, you'd have to use a different socket handle for each host.
1517 my ( $count, $hisiaddr, $hispaddr, $histime,
1518 $host, $iaddr, $paddr, $port, $proto,
1519 $rin, $rout, $rtime, $SECS_of_70_YEARS);
1521 $SECS_of_70_YEARS = 2208988800;
1523 $iaddr = gethostbyname(hostname());
1524 $proto = getprotobyname('udp');
1525 $port = getservbyname('time', 'udp');
1526 $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1528 socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
1529 bind(SOCKET, $paddr) || die "bind: $!";
1532 printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
1536 $hisiaddr = inet_aton($host) || die "unknown host";
1537 $hispaddr = sockaddr_in($port, $hisiaddr);
1538 defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
1542 vec($rin, fileno(SOCKET), 1) = 1;
1544 # timeout after 10.0 seconds
1545 while ($count && select($rout = $rin, undef, undef, 10.0)) {
1547 ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
1548 ($port, $hisiaddr) = sockaddr_in($hispaddr);
1549 $host = gethostbyaddr($hisiaddr, AF_INET);
1550 $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
1551 printf "%-12s ", $host;
1552 printf "%8d %s\n", $histime - time, scalar localtime($histime);
1556 Note that this example does not include any retries and may consequently
1557 fail to contact a reachable host. The most prominent reason for this
1558 is congestion of the queues on the sending host if the number of
1559 list of hosts to contact is sufficiently large.
1563 While System V IPC isn't so widely used as sockets, it still has some
1564 interesting uses. You can't, however, effectively use SysV IPC or
1565 Berkeley mmap() to have shared memory so as to share a variable amongst
1566 several processes. That's because Perl would reallocate your string when
1567 you weren't wanting it to.
1569 Here's a small example showing shared memory usage.
1571 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
1574 $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) || die "$!";
1575 print "shm key $id\n";
1577 $message = "Message #1";
1578 shmwrite($id, $message, 0, 60) || die "$!";
1579 print "wrote: '$message'\n";
1580 shmread($id, $buff, 0, 60) || die "$!";
1581 print "read : '$buff'\n";
1583 # the buffer of shmread is zero-character end-padded.
1584 substr($buff, index($buff, "\0")) = '';
1585 print "un" unless $buff eq $message;
1588 print "deleting shm $id\n";
1589 shmctl($id, IPC_RMID, 0) || die "$!";
1591 Here's an example of a semaphore:
1593 use IPC::SysV qw(IPC_CREAT);
1596 $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1597 print "shm key $id\n";
1599 Put this code in a separate file to be run in more than one process.
1600 Call the file F<take>:
1602 # create a semaphore
1605 $id = semget($IPC_KEY, 0 , 0 );
1606 die if !defined($id);
1612 # wait for semaphore to be zero
1614 $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
1616 # Increment the semaphore count
1618 $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
1619 $opstring = $opstring1 . $opstring2;
1621 semop($id,$opstring) || die "$!";
1623 Put this code in a separate file to be run in more than one process.
1624 Call this file F<give>:
1626 # 'give' the semaphore
1627 # run this in the original process and you will see
1628 # that the second process continues
1631 $id = semget($IPC_KEY, 0, 0);
1632 die if !defined($id);
1637 # Decrement the semaphore count
1639 $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
1641 semop($id,$opstring) || die "$!";
1643 The SysV IPC code above was written long ago, and it's definitely
1644 clunky looking. For a more modern look, see the IPC::SysV module
1645 which is included with Perl starting from Perl 5.005.
1647 A small example demonstrating SysV message queues:
1649 use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);
1651 my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
1653 my $sent = "message";
1654 my $type_sent = 1234;
1659 if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
1660 if (msgrcv($id, $rcvd, 60, 0, 0)) {
1661 ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
1662 if ($rcvd eq $sent) {
1668 die "# msgrcv failed\n";
1671 die "# msgsnd failed\n";
1673 msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
1675 die "# msgget failed\n";
1680 Most of these routines quietly but politely return C<undef> when they
1681 fail instead of causing your program to die right then and there due to
1682 an uncaught exception. (Actually, some of the new I<Socket> conversion
1683 functions croak() on bad arguments.) It is therefore essential to
1684 check return values from these functions. Always begin your socket
1685 programs this way for optimal success, and don't forget to add B<-T>
1686 taint checking flag to the #! line for servers:
1695 All these routines create system-specific portability problems. As noted
1696 elsewhere, Perl is at the mercy of your C libraries for much of its system
1697 behaviour. It's probably safest to assume broken SysV semantics for
1698 signals and to stick with simple TCP and UDP socket operations; e.g., don't
1699 try to pass open file descriptors over a local UDP datagram socket if you
1700 want your code to stand a chance of being portable.
1704 Tom Christiansen, with occasional vestiges of Larry Wall's original
1705 version and suggestions from the Perl Porters.
1709 There's a lot more to networking than this, but this should get you
1712 For intrepid programmers, the indispensable textbook is I<Unix
1713 Network Programming, 2nd Edition, Volume 1> by W. Richard Stevens
1714 (published by Prentice-Hall). Note that most books on networking
1715 address the subject from the perspective of a C programmer; translation
1716 to Perl is left as an exercise for the reader.
1718 The IO::Socket(3) manpage describes the object library, and the Socket(3)
1719 manpage describes the low-level interface to sockets. Besides the obvious
1720 functions in L<perlfunc>, you should also check out the F<modules> file
1721 at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
1722 FAQ> for a description of what CPAN is and where to get it.)
1724 Section 5 of the F<modules> file is devoted to "Networking, Device Control
1725 (modems), and Interprocess Communication", and contains numerous unbundled
1726 modules numerous networking modules, Chat and Expect operations, CGI
1727 programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1728 Threads, and ToolTalk--just to name a few.