1PERLIPC(1) Perl Programmers Reference Guide PERLIPC(1)
2
6 perlipc - Perl interprocess communication (signals, fifos, pipes, safe
7 subprocesses, sockets, and semaphores)
8
10 The basic IPC facilities of Perl are built out of the good old Unix
11 signals, named pipes, pipe opens, the Berkeley socket routines, and
12 SysV IPC calls. Each is used in slightly different situations.
13
15 Perl uses a simple signal handling model: the %SIG hash contains names
16 or references of user-installed signal handlers. These handlers will
17 be called with an argument which is the name of the signal that
18 triggered it. A signal may be generated intentionally from a
19 particular keyboard sequence like control-C or control-Z, sent to you
20 from another process, or triggered automatically by the kernel when
21 special events transpire, like a child process exiting, your process
22 running out of stack space, or hitting file size limit.
23 For example, to trap an interrupt signal, set up a handler like this:
25 sub catch_zap {
27 my $signame = shift;
28 $shucks++;
29 die "Somebody sent me a SIG$signame";
30 }
31 $SIG{INT} = 'catch_zap'; # could fail in modules
32 $SIG{INT} = \&catch_zap; # best strategy
33 Prior to Perl 5.7.3 it was necessary to do as little as you possibly
35 could in your handler; notice how all we do is set a global variable
36 and then raise an exception. That's because on most systems, libraries
37 are not re-entrant; particularly, memory allocation and I/O routines
38 are not. That meant that doing nearly anything in your handler could
39 in theory trigger a memory fault and subsequent core dump - see
40 "Deferred Signals (Safe Signals)" below.
41 The names of the signals are the ones listed out by "kill -l" on your
43 system, or you can retrieve them from the Config module. Set up an
44 @signame list indexed by number to get the name and a %signo table
45 indexed by name to get the number:
46 use Config;
48 defined $Config{sig_name} || die "No sigs?";
49 foreach $name (split(' ', $Config{sig_name})) {
50 $signo{$name} = $i;
51 $signame[$i] = $name;
52 $i++;
53 }
54 So to check whether signal 17 and SIGALRM were the same, do just this:
56 print "signal #17 = $signame[17]\n";
58 if ($signo{ALRM}) {
59 print "SIGALRM is $signo{ALRM}\n";
60 }
61 You may also choose to assign the strings 'IGNORE' or 'DEFAULT' as the
63 handler, in which case Perl will try to discard the signal or do the
64 default thing.
65 On most Unix platforms, the "CHLD" (sometimes also known as "CLD")
67 signal has special behavior with respect to a value of 'IGNORE'.
68 Setting $SIG{CHLD} to 'IGNORE' on such a platform has the effect of not
69 creating zombie processes when the parent process fails to "wait()" on
70 its child processes (i.e. child processes are automatically reaped).
71 Calling "wait()" with $SIG{CHLD} set to 'IGNORE' usually returns "-1"
72 on such platforms.
73 Some signals can be neither trapped nor ignored, such as the KILL and
75 STOP (but not the TSTP) signals. One strategy for temporarily ignoring
76 signals is to use a local() statement, which will be automatically
77 restored once your block is exited. (Remember that local() values are
78 "inherited" by functions called from within that block.)
79 sub precious {
81 local $SIG{INT} = 'IGNORE';
82 &more_functions;
83 }
84 sub more_functions {
85 # interrupts still ignored, for now...
86 }
87 Sending a signal to a negative process ID means that you send the
89 signal to the entire Unix process-group. This code sends a hang-up
90 signal to all processes in the current process group (and sets
91 $SIG{HUP} to IGNORE so it doesn't kill itself):
92 {
94 local $SIG{HUP} = 'IGNORE';
95 kill HUP => -$$;
96 # snazzy writing of: kill('HUP', -$$)
97 }
98 Another interesting signal to send is signal number zero. This doesn't
100 actually affect a child process, but instead checks whether it's alive
101 or has changed its UID.
102 unless (kill 0 => $kid_pid) {
104 warn "something wicked happened to $kid_pid";
105 }
106 When directed at a process whose UID is not identical to that of the
108 sending process, signal number zero may fail because you lack
109 permission to send the signal, even though the process is alive. You
110 may be able to determine the cause of failure using "%!".
111 unless (kill 0 => $pid or $!{EPERM}) {
113 warn "$pid looks dead";
114 }
115 You might also want to employ anonymous functions for simple signal
117 handlers:
118 $SIG{INT} = sub { die "\nOutta here!\n" };
120 But that will be problematic for the more complicated handlers that
122 need to reinstall themselves. Because Perl's signal mechanism is
123 currently based on the signal(3) function from the C library, you may
124 sometimes be so unfortunate as to run on systems where that function is
125 "broken", that is, it behaves in the old unreliable SysV way rather
126 than the newer, more reasonable BSD and POSIX fashion. So you'll see
127 defensive people writing signal handlers like this:
128 sub REAPER {
130 $waitedpid = wait;
131 # loathe SysV: it makes us not only reinstate
132 # the handler, but place it after the wait
133 $SIG{CHLD} = \&REAPER;
134 }
135 $SIG{CHLD} = \&REAPER;
136 # now do something that forks...
137 or better still:
139 use POSIX ":sys_wait_h";
141 sub REAPER {
142 my $child;
143 # If a second child dies while in the signal handler caused by the
144 # first death, we won't get another signal. So must loop here else
145 # we will leave the unreaped child as a zombie. And the next time
146 # two children die we get another zombie. And so on.
147 while (($child = waitpid(-1,WNOHANG)) > 0) {
148 $Kid_Status{$child} = $?;
149 }
150 $SIG{CHLD} = \&REAPER; # still loathe SysV
151 }
152 $SIG{CHLD} = \&REAPER;
153 # do something that forks...
154 Signal handling is also used for timeouts in Unix, While safely
156 protected within an "eval{}" block, you set a signal handler to trap
157 alarm signals and then schedule to have one delivered to you in some
158 number of seconds. Then try your blocking operation, clearing the
159 alarm when it's done but not before you've exited your "eval{}" block.
160 If it goes off, you'll use die() to jump out of the block, much as you
161 might using longjmp() or throw() in other languages.
162 Here's an example:
164 eval {
166 local $SIG{ALRM} = sub { die "alarm clock restart" };
167 alarm 10;
168 flock(FH, 2); # blocking write lock
169 alarm 0;
170 };
171 if ($@ and $@ !~ /alarm clock restart/) { die }
172 If the operation being timed out is system() or qx(), this technique is
174 liable to generate zombies. If this matters to you, you'll need to
175 do your own fork() and exec(), and kill the errant child process.
176 For more complex signal handling, you might see the standard POSIX
178 module. Lamentably, this is almost entirely undocumented, but the
179 t/lib/posix.t file from the Perl source distribution has some examples
180 in it.
181 Handling the SIGHUP Signal in Daemons
183 A process that usually starts when the system boots and shuts down when
184 the system is shut down is called a daemon (Disk And Execution
185 MONitor). If a daemon process has a configuration file which is
186 modified after the process has been started, there should be a way to
187 tell that process to re-read its configuration file, without stopping
188 the process. Many daemons provide this mechanism using the "SIGHUP"
189 signal handler. When you want to tell the daemon to re-read the file
190 you simply send it the "SIGHUP" signal.
191 Not all platforms automatically reinstall their (native) signal
193 handlers after a signal delivery. This means that the handler works
194 only the first time the signal is sent. The solution to this problem is
195 to use "POSIX" signal handlers if available, their behaviour is well-
196 defined.
197 The following example implements a simple daemon, which restarts itself
199 every time the "SIGHUP" signal is received. The actual code is located
200 in the subroutine "code()", which simply prints some debug info to show
201 that it works and should be replaced with the real code.
202 #!/usr/bin/perl -w
204 use POSIX ();
206 use FindBin ();
207 use File::Basename ();
208 use File::Spec::Functions;
209 $|=1;
211 # make the daemon cross-platform, so exec always calls the script
213 # itself with the right path, no matter how the script was invoked.
214 my $script = File::Basename::basename($0);
215 my $SELF = catfile $FindBin::Bin, $script;
216 # POSIX unmasks the sigprocmask properly
218 my $sigset = POSIX::SigSet->new();
219 my $action = POSIX::SigAction->new('sigHUP_handler',
220 $sigset,
221 &POSIX::SA_NODEFER);
222 POSIX::sigaction(&POSIX::SIGHUP, $action);
223 sub sigHUP_handler {
225 print "got SIGHUP\n";
226 exec($SELF, @ARGV) or die "Couldn't restart: $!\n";
227 }
228 code();
230 sub code {
232 print "PID: $$\n";
233 print "ARGV: @ARGV\n";
234 my $c = 0;
235 while (++$c) {
236 sleep 2;
237 print "$c\n";
238 }
239 }
240 __END__
241
243 A named pipe (often referred to as a FIFO) is an old Unix IPC mechanism
244 for processes communicating on the same machine. It works just like a
245 regular, connected anonymous pipes, except that the processes
246 rendezvous using a filename and don't have to be related.
247 To create a named pipe, use the "POSIX::mkfifo()" function.
249 use POSIX qw(mkfifo);
251 mkfifo($path, 0700) or die "mkfifo $path failed: $!";
252 You can also use the Unix command mknod(1) or on some systems,
254 mkfifo(1). These may not be in your normal path.
255 # system return val is backwards, so && not ||
257 #
258 $ENV{PATH} .= ":/etc:/usr/etc";
259 if ( system('mknod', $path, 'p')
260 && system('mkfifo', $path) )
261 {
262 die "mk{nod,fifo} $path failed";
263 }
264 A fifo is convenient when you want to connect a process to an unrelated
266 one. When you open a fifo, the program will block until there's
267 something on the other end.
268 For example, let's say you'd like to have your .signature file be a
270 named pipe that has a Perl program on the other end. Now every time
271 any program (like a mailer, news reader, finger program, etc.) tries to
272 read from that file, the reading program will block and your program
273 will supply the new signature. We'll use the pipe-checking file test
274 -p to find out whether anyone (or anything) has accidentally removed
275 our fifo.
276 chdir; # go home
278 $FIFO = '.signature';
279 while (1) {
281 unless (-p $FIFO) {
282 unlink $FIFO;
283 require POSIX;
284 POSIX::mkfifo($FIFO, 0700)
285 or die "can't mkfifo $FIFO: $!";
286 }
287 # next line blocks until there's a reader
289 open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
290 print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
291 close FIFO;
292 sleep 2; # to avoid dup signals
293 }
294 Deferred Signals (Safe Signals)
296 In Perls before Perl 5.7.3 by installing Perl code to deal with
297 signals, you were exposing yourself to danger from two things. First,
298 few system library functions are re-entrant. If the signal interrupts
299 while Perl is executing one function (like malloc(3) or printf(3)), and
300 your signal handler then calls the same function again, you could get
301 unpredictable behavior--often, a core dump. Second, Perl isn't itself
302 re-entrant at the lowest levels. If the signal interrupts Perl while
303 Perl is changing its own internal data structures, similarly
304 unpredictable behaviour may result.
305 There were two things you could do, knowing this: be paranoid or be
307 pragmatic. The paranoid approach was to do as little as possible in
308 your signal handler. Set an existing integer variable that already has
309 a value, and return. This doesn't help you if you're in a slow system
310 call, which will just restart. That means you have to "die" to
311 longjmp(3) out of the handler. Even this is a little cavalier for the
312 true paranoiac, who avoids "die" in a handler because the system is out
313 to get you. The pragmatic approach was to say "I know the risks, but
314 prefer the convenience", and to do anything you wanted in your signal
315 handler, and be prepared to clean up core dumps now and again.
316 In Perl 5.7.3 and later to avoid these problems signals are
318 "deferred"-- that is when the signal is delivered to the process by the
319 system (to the C code that implements Perl) a flag is set, and the
320 handler returns immediately. Then at strategic "safe" points in the
321 Perl interpreter (e.g. when it is about to execute a new opcode) the
322 flags are checked and the Perl level handler from %SIG is executed. The
323 "deferred" scheme allows much more flexibility in the coding of signal
324 handler as we know Perl interpreter is in a safe state, and that we are
325 not in a system library function when the handler is called. However
326 the implementation does differ from previous Perls in the following
327 ways:
328 Long-running opcodes
330 As the Perl interpreter only looks at the signal flags when it is
331 about to execute a new opcode, a signal that arrives during a long-
332 running opcode (e.g. a regular expression operation on a very large
333 string) will not be seen until the current opcode completes.
334 N.B. If a signal of any given type fires multiple times during an
336 opcode (such as from a fine-grained timer), the handler for that
337 signal will only be called once after the opcode completes, and all
338 the other instances will be discarded. Furthermore, if your
339 system's signal queue gets flooded to the point that there are
340 signals that have been raised but not yet caught (and thus not
341 deferred) at the time an opcode completes, those signals may well
342 be caught and deferred during subsequent opcodes, with sometimes
343 surprising results. For example, you may see alarms delivered even
344 after calling alarm(0) as the latter stops the raising of alarms
345 but does not cancel the delivery of alarms raised but not yet
346 caught. Do not depend on the behaviors described in this paragraph
347 as they are side effects of the current implementation and may
348 change in future versions of Perl.
349 Interrupting IO
351 When a signal is delivered (e.g. INT control-C) the operating
352 system breaks into IO operations like "read" (used to implement
353 Perls <> operator). On older Perls the handler was called
354 immediately (and as "read" is not "unsafe" this worked well). With
355 the "deferred" scheme the handler is not called immediately, and if
356 Perl is using system's "stdio" library that library may re-start
357 the "read" without returning to Perl and giving it a chance to call
358 the %SIG handler. If this happens on your system the solution is to
359 use ":perlio" layer to do IO - at least on those handles which you
360 want to be able to break into with signals. (The ":perlio" layer
361 checks the signal flags and calls %SIG handlers before resuming IO
362 operation.)
363 Note that the default in Perl 5.7.3 and later is to automatically
365 use the ":perlio" layer.
366 Note that some networking library functions like gethostbyname()
368 are known to have their own implementations of timeouts which may
369 conflict with your timeouts. If you are having problems with such
370 functions, you can try using the POSIX sigaction() function, which
371 bypasses the Perl safe signals (note that this means subjecting
372 yourself to possible memory corruption, as described above).
373 Instead of setting $SIG{ALRM}:
374 local $SIG{ALRM} = sub { die "alarm" };
376 try something like the following:
378 use POSIX qw(SIGALRM);
380 POSIX::sigaction(SIGALRM,
381 POSIX::SigAction->new(sub { die "alarm" }))
382 or die "Error setting SIGALRM handler: $!\n";
383 Another way to disable the safe signal behavior locally is to use
385 the "Perl::Unsafe::Signals" module from CPAN (which will affect all
386 signals).
387 Restartable system calls
389 On systems that supported it, older versions of Perl used the
390 SA_RESTART flag when installing %SIG handlers. This meant that
391 restartable system calls would continue rather than returning when
392 a signal arrived. In order to deliver deferred signals promptly,
393 Perl 5.7.3 and later do not use SA_RESTART. Consequently,
394 restartable system calls can fail (with $! set to "EINTR") in
395 places where they previously would have succeeded.
396 Note that the default ":perlio" layer will retry "read", "write"
398 and "close" as described above and that interrupted "wait" and
399 "waitpid" calls will always be retried.
400 Signals as "faults"
402 Certain signals, e.g. SEGV, ILL, and BUS, are generated as a result
403 of virtual memory or other "faults". These are normally fatal and
404 there is little a Perl-level handler can do with them, so Perl now
405 delivers them immediately rather than attempting to defer them.
406 Signals triggered by operating system state
408 On some operating systems certain signal handlers are supposed to
409 "do something" before returning. One example can be CHLD or CLD
410 which indicates a child process has completed. On some operating
411 systems the signal handler is expected to "wait" for the completed
412 child process. On such systems the deferred signal scheme will not
413 work for those signals (it does not do the "wait"). Again the
414 failure will look like a loop as the operating system will re-issue
415 the signal as there are un-waited-for completed child processes.
416 If you want the old signal behaviour back regardless of possible memory
418 corruption, set the environment variable "PERL_SIGNALS" to "unsafe" (a
419 new feature since Perl 5.8.1).
420
422 Perl's basic open() statement can also be used for unidirectional
423 interprocess communication by either appending or prepending a pipe
424 symbol to the second argument to open(). Here's how to start something
425 up in a child process you intend to write to:
426 open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
428 || die "can't fork: $!";
429 local $SIG{PIPE} = sub { die "spooler pipe broke" };
430 print SPOOLER "stuff\n";
431 close SPOOLER || die "bad spool: $! $?";
432 And here's how to start up a child process you intend to read from:
434 open(STATUS, "netstat -an 2>&1 |")
436 || die "can't fork: $!";
437 while (<STATUS>) {
438 next if /^(tcp|udp)/;
439 print;
440 }
441 close STATUS || die "bad netstat: $! $?";
442 If one can be sure that a particular program is a Perl script that is
444 expecting filenames in @ARGV, the clever programmer can write something
445 like this:
446 % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
448 and irrespective of which shell it's called from, the Perl program will
450 read from the file f1, the process cmd1, standard input (tmpfile in
451 this case), the f2 file, the cmd2 command, and finally the f3 file.
452 Pretty nifty, eh?
453 You might notice that you could use backticks for much the same effect
455 as opening a pipe for reading:
456 print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
458 die "bad netstat" if $?;
459 While this is true on the surface, it's much more efficient to process
461 the file one line or record at a time because then you don't have to
462 read the whole thing into memory at once. It also gives you finer
463 control of the whole process, letting you to kill off the child process
464 early if you'd like.
465 Be careful to check both the open() and the close() return values. If
467 you're writing to a pipe, you should also trap SIGPIPE. Otherwise,
468 think of what happens when you start up a pipe to a command that
469 doesn't exist: the open() will in all likelihood succeed (it only
470 reflects the fork()'s success), but then your output will
471 fail--spectacularly. Perl can't know whether the command worked
472 because your command is actually running in a separate process whose
473 exec() might have failed. Therefore, while readers of bogus commands
474 return just a quick end of file, writers to bogus command will trigger
475 a signal they'd better be prepared to handle. Consider:
476 open(FH, "|bogus") or die "can't fork: $!";
478 print FH "bang\n" or die "can't write: $!";
479 close FH or die "can't close: $!";
480 That won't blow up until the close, and it will blow up with a SIGPIPE.
482 To catch it, you could use this:
483 $SIG{PIPE} = 'IGNORE';
485 open(FH, "|bogus") or die "can't fork: $!";
486 print FH "bang\n" or die "can't write: $!";
487 close FH or die "can't close: status=$?";
488 Filehandles
490 Both the main process and any child processes it forks share the same
491 STDIN, STDOUT, and STDERR filehandles. If both processes try to access
492 them at once, strange things can happen. You may also want to close or
493 reopen the filehandles for the child. You can get around this by
494 opening your pipe with open(), but on some systems this means that the
495 child process cannot outlive the parent.
496 Background Processes
498 You can run a command in the background with:
499 system("cmd &");
501 The command's STDOUT and STDERR (and possibly STDIN, depending on your
503 shell) will be the same as the parent's. You won't need to catch
504 SIGCHLD because of the double-fork taking place (see below for more
505 details).
506 Complete Dissociation of Child from Parent
508 In some cases (starting server processes, for instance) you'll want to
509 completely dissociate the child process from the parent. This is often
510 called daemonization. A well behaved daemon will also chdir() to the
511 root directory (so it doesn't prevent unmounting the filesystem
512 containing the directory from which it was launched) and redirect its
513 standard file descriptors from and to /dev/null (so that random output
514 doesn't wind up on the user's terminal).
515 use POSIX 'setsid';
517 sub daemonize {
519 chdir '/' or die "Can't chdir to /: $!";
520 open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
521 open STDOUT, '>/dev/null'
522 or die "Can't write to /dev/null: $!";
523 defined(my $pid = fork) or die "Can't fork: $!";
524 exit if $pid;
525 die "Can't start a new session: $!" if setsid == -1;
526 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
527 }
528 The fork() has to come before the setsid() to ensure that you aren't a
530 process group leader (the setsid() will fail if you are). If your
531 system doesn't have the setsid() function, open /dev/tty and use the
532 "TIOCNOTTY" ioctl() on it instead. See tty(4) for details.
533 Non-Unix users should check their Your_OS::Process module for other
535 solutions.
536 Safe Pipe Opens
538 Another interesting approach to IPC is making your single program go
539 multiprocess and communicate between (or even amongst) yourselves. The
540 open() function will accept a file argument of either "-|" or "|-" to
541 do a very interesting thing: it forks a child connected to the
542 filehandle you've opened. The child is running the same program as the
543 parent. This is useful for safely opening a file when running under an
544 assumed UID or GID, for example. If you open a pipe to minus, you can
545 write to the filehandle you opened and your kid will find it in his
546 STDIN. If you open a pipe from minus, you can read from the filehandle
547 you opened whatever your kid writes to his STDOUT.
548 use English '-no_match_vars';
550 my $sleep_count = 0;
551 do {
553 $pid = open(KID_TO_WRITE, "|-");
554 unless (defined $pid) {
555 warn "cannot fork: $!";
556 die "bailing out" if $sleep_count++ > 6;
557 sleep 10;
558 }
559 } until defined $pid;
560 if ($pid) { # parent
562 print KID_TO_WRITE @some_data;
563 close(KID_TO_WRITE) || warn "kid exited $?";
564 } else { # child
565 ($EUID, $EGID) = ($UID, $GID); # suid progs only
566 open (FILE, "> /safe/file")
567 || die "can't open /safe/file: $!";
568 while (<STDIN>) {
569 print FILE; # child's STDIN is parent's KID_TO_WRITE
570 }
571 exit; # don't forget this
572 }
573 Another common use for this construct is when you need to execute
575 something without the shell's interference. With system(), it's
576 straightforward, but you can't use a pipe open or backticks safely.
577 That's because there's no way to stop the shell from getting its hands
578 on your arguments. Instead, use lower-level control to call exec()
579 directly.
580 Here's a safe backtick or pipe open for read:
582 # add error processing as above
584 $pid = open(KID_TO_READ, "-|");
585 if ($pid) { # parent
587 while (<KID_TO_READ>) {
588 # do something interesting
589 }
590 close(KID_TO_READ) || warn "kid exited $?";
591 } else { # child
593 ($EUID, $EGID) = ($UID, $GID); # suid only
594 exec($program, @options, @args)
595 || die "can't exec program: $!";
596 # NOTREACHED
597 }
598 And here's a safe pipe open for writing:
600 # add error processing as above
602 $pid = open(KID_TO_WRITE, "|-");
603 $SIG{PIPE} = sub { die "whoops, $program pipe broke" };
604 if ($pid) { # parent
606 for (@data) {
607 print KID_TO_WRITE;
608 }
609 close(KID_TO_WRITE) || warn "kid exited $?";
610 } else { # child
612 ($EUID, $EGID) = ($UID, $GID);
613 exec($program, @options, @args)
614 || die "can't exec program: $!";
615 # NOTREACHED
616 }
617 It is very easy to dead-lock a process using this form of open(), or
619 indeed any use of pipe() and multiple sub-processes. The above example
620 is 'safe' because it is simple and calls exec(). See "Avoiding Pipe
621 Deadlocks" for general safety principles, but there are extra gotchas
622 with Safe Pipe Opens.
623 In particular, if you opened the pipe using "open FH, "|-"", then you
625 cannot simply use close() in the parent process to close an unwanted
626 writer. Consider this code:
627 $pid = open WRITER, "|-";
629 defined $pid or die "fork failed; $!";
630 if ($pid) {
631 if (my $sub_pid = fork()) {
632 close WRITER;
633 # do something else...
634 }
635 else {
636 # write to WRITER...
637 exit;
638 }
639 }
640 else {
641 # do something with STDIN...
642 exit;
643 }
644 In the above, the true parent does not want to write to the WRITER
646 filehandle, so it closes it. However, because WRITER was opened using
647 "open FH, "|-"", it has a special behaviour: closing it will call
648 waitpid() (see "waitpid" in perlfunc), which waits for the sub-process
649 to exit. If the child process ends up waiting for something happening
650 in the section marked "do something else", then you have a deadlock.
651 This can also be a problem with intermediate sub-processes in more
653 complicated code, which will call waitpid() on all open filehandles
654 during global destruction; in no predictable order.
655 To solve this, you must manually use pipe(), fork(), and the form of
657 open() which sets one file descriptor to another, as below:
658 pipe(READER, WRITER);
660 $pid = fork();
661 defined $pid or die "fork failed; $!";
662 if ($pid) {
663 close READER;
664 if (my $sub_pid = fork()) {
665 close WRITER;
666 }
667 else {
668 # write to WRITER...
669 exit;
670 }
671 # write to WRITER...
672 }
673 else {
674 open STDIN, "<&READER";
675 close WRITER;
676 # do something...
677 exit;
678 }
679 Since Perl 5.8.0, you can also use the list form of "open" for pipes :
681 the syntax
682 open KID_PS, "-|", "ps", "aux" or die $!;
684 forks the ps(1) command (without spawning a shell, as there are more
686 than three arguments to open()), and reads its standard output via the
687 "KID_PS" filehandle. The corresponding syntax to write to command
688 pipes (with "|-" in place of "-|") is also implemented.
689 Note that these operations are full Unix forks, which means they may
691 not be correctly implemented on alien systems. Additionally, these are
692 not true multithreading. If you'd like to learn more about threading,
693 see the modules file mentioned below in the SEE ALSO section.
694 Avoiding Pipe Deadlocks
696 In general, if you have more than one sub-process, you need to be very
697 careful that any process which does not need the writer half of any
698 pipe you create for inter-process communication does not have it open.
699 The reason for this is that any child process which is reading from the
701 pipe and expecting an EOF will never receive it, and therefore never
702 exit. A single process closing a pipe is not enough to close it; the
703 last process with the pipe open must close it for it to read EOF.
704 There are some features built-in to unix to help prevent this most of
706 the time. For instance, filehandles have a 'close on exec' flag (set
707 en masse with Perl using the $^F perlvar), so that any filehandles
708 which you didn't explicitly route to the STDIN, STDOUT or STDERR of a
709 child program will automatically be closed for you.
710 So, always explicitly and immediately call close() on the writable end
712 of any pipe, unless that process is actually writing to it. If you
713 don't explicitly call close() then be warned Perl will still close()
714 all the filehandles during global destruction. As warned above, if
715 those filehandles were opened with Safe Pipe Open, they will also call
716 waitpid() and you might again deadlock.
717 Bidirectional Communication with Another Process
719 While this works reasonably well for unidirectional communication, what
720 about bidirectional communication? The obvious thing you'd like to do
721 doesn't actually work:
722 open(PROG_FOR_READING_AND_WRITING, "| some program |")
724 and if you forget to use the "use warnings" pragma or the -w flag, then
726 you'll miss out entirely on the diagnostic message:
727 Can't do bidirectional pipe at -e line 1.
729 If you really want to, you can use the standard open2() library
731 function to catch both ends. There's also an open3() for
732 tridirectional I/O so you can also catch your child's STDERR, but doing
733 so would then require an awkward select() loop and wouldn't allow you
734 to use normal Perl input operations.
735 If you look at its source, you'll see that open2() uses low-level
737 primitives like Unix pipe() and exec() calls to create all the
738 connections. While it might have been slightly more efficient by using
739 socketpair(), it would have then been even less portable than it
740 already is. The open2() and open3() functions are unlikely to work
741 anywhere except on a Unix system or some other one purporting to be
742 POSIX compliant.
743 Here's an example of using open2():
745 use FileHandle;
747 use IPC::Open2;
748 $pid = open2(*Reader, *Writer, "cat -u -n" );
749 print Writer "stuff\n";
750 $got = <Reader>;
751 The problem with this is that Unix buffering is really going to ruin
753 your day. Even though your "Writer" filehandle is auto-flushed, and
754 the process on the other end will get your data in a timely manner, you
755 can't usually do anything to force it to give it back to you in a
756 similarly quick fashion. In this case, we could, because we gave cat a
757 -u flag to make it unbuffered. But very few Unix commands are designed
758 to operate over pipes, so this seldom works unless you yourself wrote
759 the program on the other end of the double-ended pipe.
760 A solution to this is the nonstandard Comm.pl library. It uses pseudo-
762 ttys to make your program behave more reasonably:
763 require 'Comm.pl';
765 $ph = open_proc('cat -n');
766 for (1..10) {
767 print $ph "a line\n";
768 print "got back ", scalar <$ph>;
769 }
770 This way you don't have to have control over the source code of the
772 program you're using. The Comm library also has expect() and
773 interact() functions. Find the library (and we hope its successor
774 IPC::Chat) at your nearest CPAN archive as detailed in the SEE ALSO
775 section below.
776 The newer Expect.pm module from CPAN also addresses this kind of thing.
778 This module requires two other modules from CPAN: IO::Pty and IO::Stty.
779 It sets up a pseudo-terminal to interact with programs that insist on
780 using talking to the terminal device driver. If your system is amongst
781 those supported, this may be your best bet.
782 Bidirectional Communication with Yourself
784 If you want, you may make low-level pipe() and fork() to stitch this
785 together by hand. This example only talks to itself, but you could
786 reopen the appropriate handles to STDIN and STDOUT and call other
787 processes.
788 #!/usr/bin/perl -w
790 # pipe1 - bidirectional communication using two pipe pairs
791 # designed for the socketpair-challenged
792 use IO::Handle; # thousands of lines just for autoflush :-(
793 pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
794 pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
795 CHILD_WTR->autoflush(1);
796 PARENT_WTR->autoflush(1);
797 if ($pid = fork) {
799 close PARENT_RDR; close PARENT_WTR;
800 print CHILD_WTR "Parent Pid $$ is sending this\n";
801 chomp($line = <CHILD_RDR>);
802 print "Parent Pid $$ just read this: `$line'\n";
803 close CHILD_RDR; close CHILD_WTR;
804 waitpid($pid,0);
805 } else {
806 die "cannot fork: $!" unless defined $pid;
807 close CHILD_RDR; close CHILD_WTR;
808 chomp($line = <PARENT_RDR>);
809 print "Child Pid $$ just read this: `$line'\n";
810 print PARENT_WTR "Child Pid $$ is sending this\n";
811 close PARENT_RDR; close PARENT_WTR;
812 exit;
813 }
814 But you don't actually have to make two pipe calls. If you have the
816 socketpair() system call, it will do this all for you.
817 #!/usr/bin/perl -w
819 # pipe2 - bidirectional communication using socketpair
820 # "the best ones always go both ways"
821 use Socket;
823 use IO::Handle; # thousands of lines just for autoflush :-(
824 # We say AF_UNIX because although *_LOCAL is the
825 # POSIX 1003.1g form of the constant, many machines
826 # still don't have it.
827 socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
828 or die "socketpair: $!";
829 CHILD->autoflush(1);
831 PARENT->autoflush(1);
832 if ($pid = fork) {
834 close PARENT;
835 print CHILD "Parent Pid $$ is sending this\n";
836 chomp($line = <CHILD>);
837 print "Parent Pid $$ just read this: `$line'\n";
838 close CHILD;
839 waitpid($pid,0);
840 } else {
841 die "cannot fork: $!" unless defined $pid;
842 close CHILD;
843 chomp($line = <PARENT>);
844 print "Child Pid $$ just read this: `$line'\n";
845 print PARENT "Child Pid $$ is sending this\n";
846 close PARENT;
847 exit;
848 }
849
851 While not limited to Unix-derived operating systems (e.g., WinSock on
852 PCs provides socket support, as do some VMS libraries), you may not
853 have sockets on your system, in which case this section probably isn't
854 going to do you much good. With sockets, you can do both virtual
855 circuits (i.e., TCP streams) and datagrams (i.e., UDP packets). You
856 may be able to do even more depending on your system.
857 The Perl function calls for dealing with sockets have the same names as
859 the corresponding system calls in C, but their arguments tend to differ
860 for two reasons: first, Perl filehandles work differently than C file
861 descriptors. Second, Perl already knows the length of its strings, so
862 you don't need to pass that information.
863 One of the major problems with old socket code in Perl was that it used
865 hard-coded values for some of the constants, which severely hurt
866 portability. If you ever see code that does anything like explicitly
867 setting "$AF_INET = 2", you know you're in for big trouble: An
868 immeasurably superior approach is to use the "Socket" module, which
869 more reliably grants access to various constants and functions you'll
870 need.
871 If you're not writing a server/client for an existing protocol like
873 NNTP or SMTP, you should give some thought to how your server will know
874 when the client has finished talking, and vice-versa. Most protocols
875 are based on one-line messages and responses (so one party knows the
876 other has finished when a "\n" is received) or multi-line messages and
877 responses that end with a period on an empty line ("\n.\n" terminates a
878 message/response).
879 Internet Line Terminators
881 The Internet line terminator is "\015\012". Under ASCII variants of
882 Unix, that could usually be written as "\r\n", but under other systems,
883 "\r\n" might at times be "\015\015\012", "\012\012\015", or something
884 completely different. The standards specify writing "\015\012" to be
885 conformant (be strict in what you provide), but they also recommend
886 accepting a lone "\012" on input (but be lenient in what you require).
887 We haven't always been very good about that in the code in this
888 manpage, but unless you're on a Mac, you'll probably be ok.
889 Internet TCP Clients and Servers
891 Use Internet-domain sockets when you want to do client-server
892 communication that might extend to machines outside of your own system.
893 Here's a sample TCP client using Internet-domain sockets:
895 #!/usr/bin/perl -w
897 use strict;
898 use Socket;
899 my ($remote,$port, $iaddr, $paddr, $proto, $line);
900 $remote = shift || 'localhost';
902 $port = shift || 2345; # random port
903 if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
904 die "No port" unless $port;
905 $iaddr = inet_aton($remote) || die "no host: $remote";
906 $paddr = sockaddr_in($port, $iaddr);
907 $proto = getprotobyname('tcp');
909 socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
910 connect(SOCK, $paddr) || die "connect: $!";
911 while (defined($line = <SOCK>)) {
912 print $line;
913 }
914 close (SOCK) || die "close: $!";
916 exit;
917 And here's a corresponding server to go along with it. We'll leave the
919 address as INADDR_ANY so that the kernel can choose the appropriate
920 interface on multihomed hosts. If you want sit on a particular
921 interface (like the external side of a gateway or firewall machine),
922 you should fill this in with your real address instead.
923 #!/usr/bin/perl -Tw
925 use strict;
926 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
927 use Socket;
928 use Carp;
929 my $EOL = "\015\012";
930 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
932 my $port = shift || 2345;
934 my $proto = getprotobyname('tcp');
935 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
937 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
939 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
940 pack("l", 1)) || die "setsockopt: $!";
941 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
942 listen(Server,SOMAXCONN) || die "listen: $!";
943 logmsg "server started on port $port";
945 my $paddr;
947 $SIG{CHLD} = \&REAPER;
949 for ( ; $paddr = accept(Client,Server); close Client) {
951 my($port,$iaddr) = sockaddr_in($paddr);
952 my $name = gethostbyaddr($iaddr,AF_INET);
953 logmsg "connection from $name [",
955 inet_ntoa($iaddr), "]
956 at port $port";
957 print Client "Hello there, $name, it's now ",
959 scalar localtime, $EOL;
960 }
961 And here's a multithreaded version. It's multithreaded in that like
963 most typical servers, it spawns (forks) a slave server to handle the
964 client request so that the master server can quickly go back to service
965 a new client.
966 #!/usr/bin/perl -Tw
968 use strict;
969 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
970 use Socket;
971 use Carp;
972 my $EOL = "\015\012";
973 sub spawn; # forward declaration
975 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
976 my $port = shift || 2345;
978 my $proto = getprotobyname('tcp');
979 ($port) = $port =~ /^(\d+)$/ or die "invalid port";
981 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
983 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
984 pack("l", 1)) || die "setsockopt: $!";
985 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
986 listen(Server,SOMAXCONN) || die "listen: $!";
987 logmsg "server started on port $port";
989 my $waitedpid = 0;
991 my $paddr;
992 use POSIX ":sys_wait_h";
994 use Errno;
995 sub REAPER {
997 local $!; # don't let waitpid() overwrite current error
998 while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
999 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
1000 }
1001 $SIG{CHLD} = \&REAPER; # loathe SysV
1002 }
1003 $SIG{CHLD} = \&REAPER;
1005 while(1) {
1007 $paddr = accept(Client, Server) || do {
1008 # try again if accept() returned because a signal was received
1009 next if $!{EINTR};
1010 die "accept: $!";
1011 };
1012 my ($port, $iaddr) = sockaddr_in($paddr);
1013 my $name = gethostbyaddr($iaddr, AF_INET);
1014 logmsg "connection from $name [",
1016 inet_ntoa($iaddr),
1017 "] at port $port";
1018 spawn sub {
1020 $|=1;
1021 print "Hello there, $name, it's now ", scalar localtime, $EOL;
1022 exec '/usr/games/fortune' # XXX: `wrong' line terminators
1023 or confess "can't exec fortune: $!";
1024 };
1025 close Client;
1026 }
1027 sub spawn {
1029 my $coderef = shift;
1030 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
1032 confess "usage: spawn CODEREF";
1033 }
1034 my $pid;
1036 if (! defined($pid = fork)) {
1037 logmsg "cannot fork: $!";
1038 return;
1039 }
1040 elsif ($pid) {
1041 logmsg "begat $pid";
1042 return; # I'm the parent
1043 }
1044 # else I'm the child -- go spawn
1045 open(STDIN, "<&Client") || die "can't dup client to stdin";
1047 open(STDOUT, ">&Client") || die "can't dup client to stdout";
1048 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
1049 exit &$coderef();
1050 }
1051 This server takes the trouble to clone off a child version via fork()
1053 for each incoming request. That way it can handle many requests at
1054 once, which you might not always want. Even if you don't fork(), the
1055 listen() will allow that many pending connections. Forking servers
1056 have to be particularly careful about cleaning up their dead children
1057 (called "zombies" in Unix parlance), because otherwise you'll quickly
1058 fill up your process table. The REAPER subroutine is used here to call
1059 waitpid() for any child processes that have finished, thereby ensuring
1060 that they terminate cleanly and don't join the ranks of the living
1061 dead.
1062 Within the while loop we call accept() and check to see if it returns a
1064 false value. This would normally indicate a system error that needs to
1065 be reported. However the introduction of safe signals (see "Deferred
1066 Signals (Safe Signals)" above) in Perl 5.7.3 means that accept() may
1067 also be interrupted when the process receives a signal. This typically
1068 happens when one of the forked sub-processes exits and notifies the
1069 parent process with a CHLD signal.
1070 If accept() is interrupted by a signal then $! will be set to EINTR.
1072 If this happens then we can safely continue to the next iteration of
1073 the loop and another call to accept(). It is important that your
1074 signal handling code doesn't modify the value of $! or this test will
1075 most likely fail. In the REAPER subroutine we create a local version
1076 of $! before calling waitpid(). When waitpid() sets $! to ECHILD (as
1077 it inevitably does when it has no more children waiting), it will
1078 update the local copy leaving the original unchanged.
1079 We suggest that you use the -T flag to use taint checking (see perlsec)
1081 even if we aren't running setuid or setgid. This is always a good idea
1082 for servers and other programs run on behalf of someone else (like CGI
1083 scripts), because it lessens the chances that people from the outside
1084 will be able to compromise your system.
1085 Let's look at another TCP client. This one connects to the TCP "time"
1087 service on a number of different machines and shows how far their
1088 clocks differ from the system on which it's being run:
1089 #!/usr/bin/perl -w
1091 use strict;
1092 use Socket;
1093 my $SECS_of_70_YEARS = 2208988800;
1095 sub ctime { scalar localtime(shift) }
1096 my $iaddr = gethostbyname('localhost');
1098 my $proto = getprotobyname('tcp');
1099 my $port = getservbyname('time', 'tcp');
1100 my $paddr = sockaddr_in(0, $iaddr);
1101 my($host);
1102 $| = 1;
1104 printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
1105 foreach $host (@ARGV) {
1107 printf "%-24s ", $host;
1108 my $hisiaddr = inet_aton($host) || die "unknown host";
1109 my $hispaddr = sockaddr_in($port, $hisiaddr);
1110 socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
1111 connect(SOCKET, $hispaddr) || die "bind: $!";
1112 my $rtime = ' ';
1113 read(SOCKET, $rtime, 4);
1114 close(SOCKET);
1115 my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
1116 printf "%8d %s\n", $histime - time, ctime($histime);
1117 }
1118 Unix-Domain TCP Clients and Servers
1120 That's fine for Internet-domain clients and servers, but what about
1121 local communications? While you can use the same setup, sometimes you
1122 don't want to. Unix-domain sockets are local to the current host, and
1123 are often used internally to implement pipes. Unlike Internet domain
1124 sockets, Unix domain sockets can show up in the file system with an
1125 ls(1) listing.
1126 % ls -l /dev/log
1128 srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
1129 You can test for these with Perl's -S file test:
1131 unless ( -S '/dev/log' ) {
1133 die "something's wicked with the log system";
1134 }
1135 Here's a sample Unix-domain client:
1137 #!/usr/bin/perl -w
1139 use Socket;
1140 use strict;
1141 my ($rendezvous, $line);
1142 $rendezvous = shift || 'catsock';
1144 socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
1145 connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
1146 while (defined($line = <SOCK>)) {
1147 print $line;
1148 }
1149 exit;
1150 And here's a corresponding server. You don't have to worry about silly
1152 network terminators here because Unix domain sockets are guaranteed to
1153 be on the localhost, and thus everything works right.
1154 #!/usr/bin/perl -Tw
1156 use strict;
1157 use Socket;
1158 use Carp;
1159 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
1161 sub spawn; # forward declaration
1162 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
1163 my $NAME = 'catsock';
1165 my $uaddr = sockaddr_un($NAME);
1166 my $proto = getprotobyname('tcp');
1167 socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
1169 unlink($NAME);
1170 bind (Server, $uaddr) || die "bind: $!";
1171 listen(Server,SOMAXCONN) || die "listen: $!";
1172 logmsg "server started on $NAME";
1174 my $waitedpid;
1176 use POSIX ":sys_wait_h";
1178 sub REAPER {
1179 my $child;
1180 while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
1181 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
1182 }
1183 $SIG{CHLD} = \&REAPER; # loathe SysV
1184 }
1185 $SIG{CHLD} = \&REAPER;
1187 for ( $waitedpid = 0;
1190 accept(Client,Server) || $waitedpid;
1191 $waitedpid = 0, close Client)
1192 {
1193 next if $waitedpid;
1194 logmsg "connection on $NAME";
1195 spawn sub {
1196 print "Hello there, it's now ", scalar localtime, "\n";
1197 exec '/usr/games/fortune' or die "can't exec fortune: $!";
1198 };
1199 }
1200 sub spawn {
1202 my $coderef = shift;
1203 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
1205 confess "usage: spawn CODEREF";
1206 }
1207 my $pid;
1209 if (!defined($pid = fork)) {
1210 logmsg "cannot fork: $!";
1211 return;
1212 } elsif ($pid) {
1213 logmsg "begat $pid";
1214 return; # I'm the parent
1215 }
1216 # else I'm the child -- go spawn
1217 open(STDIN, "<&Client") || die "can't dup client to stdin";
1219 open(STDOUT, ">&Client") || die "can't dup client to stdout";
1220 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
1221 exit &$coderef();
1222 }
1223 As you see, it's remarkably similar to the Internet domain TCP server,
1225 so much so, in fact, that we've omitted several duplicate
1226 functions--spawn(), logmsg(), ctime(), and REAPER()--which are exactly
1227 the same as in the other server.
1228 So why would you ever want to use a Unix domain socket instead of a
1230 simpler named pipe? Because a named pipe doesn't give you sessions.
1231 You can't tell one process's data from another's. With socket
1232 programming, you get a separate session for each client: that's why
1233 accept() takes two arguments.
1234 For example, let's say that you have a long running database server
1236 daemon that you want folks from the World Wide Web to be able to
1237 access, but only if they go through a CGI interface. You'd have a
1238 small, simple CGI program that does whatever checks and logging you
1239 feel like, and then acts as a Unix-domain client and connects to your
1240 private server.
1241
1243 For those preferring a higher-level interface to socket programming,
1244 the IO::Socket module provides an object-oriented approach. IO::Socket
1245 is included as part of the standard Perl distribution as of the 5.004
1246 release. If you're running an earlier version of Perl, just fetch
1247 IO::Socket from CPAN, where you'll also find modules providing easy
1248 interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
1249 NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
1250 to name a few.
1251 A Simple Client
1253 Here's a client that creates a TCP connection to the "daytime" service
1254 at port 13 of the host name "localhost" and prints out everything that
1255 the server there cares to provide.
1256 #!/usr/bin/perl -w
1258 use IO::Socket;
1259 $remote = IO::Socket::INET->new(
1260 Proto => "tcp",
1261 PeerAddr => "localhost",
1262 PeerPort => "daytime(13)",
1263 )
1264 or die "cannot connect to daytime port at localhost";
1265 while ( <$remote> ) { print }
1266 When you run this program, you should get something back that looks
1268 like this:
1269 Wed May 14 08:40:46 MDT 1997
1271 Here are what those parameters to the "new" constructor mean:
1273 "Proto"
1275 This is which protocol to use. In this case, the socket handle
1276 returned will be connected to a TCP socket, because we want a
1277 stream-oriented connection, that is, one that acts pretty much like
1278 a plain old file. Not all sockets are this of this type. For
1279 example, the UDP protocol can be used to make a datagram socket,
1280 used for message-passing.
1281 "PeerAddr"
1283 This is the name or Internet address of the remote host the server
1284 is running on. We could have specified a longer name like
1285 "www.perl.com", or an address like "204.148.40.9". For
1286 demonstration purposes, we've used the special hostname
1287 "localhost", which should always mean the current machine you're
1288 running on. The corresponding Internet address for localhost is
1289 "127.1", if you'd rather use that.
1290 "PeerPort"
1292 This is the service name or port number we'd like to connect to.
1293 We could have gotten away with using just "daytime" on systems with
1294 a well-configured system services file,[FOOTNOTE: The system
1295 services file is in /etc/services under Unix] but just in case,
1296 we've specified the port number (13) in parentheses. Using just
1297 the number would also have worked, but constant numbers make
1298 careful programmers nervous.
1299 Notice how the return value from the "new" constructor is used as a
1301 filehandle in the "while" loop? That's what's called an indirect
1302 filehandle, a scalar variable containing a filehandle. You can use it
1303 the same way you would a normal filehandle. For example, you can read
1304 one line from it this way:
1305 $line = <$handle>;
1307 all remaining lines from is this way:
1309 @lines = <$handle>;
1311 and send a line of data to it this way:
1313 print $handle "some data\n";
1315 A Webget Client
1317 Here's a simple client that takes a remote host to fetch a document
1318 from, and then a list of documents to get from that host. This is a
1319 more interesting client than the previous one because it first sends
1320 something to the server before fetching the server's response.
1321 #!/usr/bin/perl -w
1323 use IO::Socket;
1324 unless (@ARGV > 1) { die "usage: $0 host document ..." }
1325 $host = shift(@ARGV);
1326 $EOL = "\015\012";
1327 $BLANK = $EOL x 2;
1328 foreach $document ( @ARGV ) {
1329 $remote = IO::Socket::INET->new( Proto => "tcp",
1330 PeerAddr => $host,
1331 PeerPort => "http(80)",
1332 );
1333 unless ($remote) { die "cannot connect to http daemon on $host" }
1334 $remote->autoflush(1);
1335 print $remote "GET $document HTTP/1.0" . $BLANK;
1336 while ( <$remote> ) { print }
1337 close $remote;
1338 }
1339 The web server handing the "http" service, which is assumed to be at
1341 its standard port, number 80. If the web server you're trying to
1342 connect to is at a different port (like 1080 or 8080), you should
1343 specify as the named-parameter pair, "PeerPort => 8080". The
1344 "autoflush" method is used on the socket because otherwise the system
1345 would buffer up the output we sent it. (If you're on a Mac, you'll
1346 also need to change every "\n" in your code that sends data over the
1347 network to be a "\015\012" instead.)
1348 Connecting to the server is only the first part of the process: once
1350 you have the connection, you have to use the server's language. Each
1351 server on the network has its own little command language that it
1352 expects as input. The string that we send to the server starting with
1353 "GET" is in HTTP syntax. In this case, we simply request each
1354 specified document. Yes, we really are making a new connection for
1355 each document, even though it's the same host. That's the way you
1356 always used to have to speak HTTP. Recent versions of web browsers may
1357 request that the remote server leave the connection open a little
1358 while, but the server doesn't have to honor such a request.
1359 Here's an example of running that program, which we'll call webget:
1361 % webget www.perl.com /guanaco.html
1363 HTTP/1.1 404 File Not Found
1364 Date: Thu, 08 May 1997 18:02:32 GMT
1365 Server: Apache/1.2b6
1366 Connection: close
1367 Content-type: text/html
1368 <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
1370 <BODY><H1>File Not Found</H1>
1371 The requested URL /guanaco.html was not found on this server.<P>
1372 </BODY>
1373 Ok, so that's not very interesting, because it didn't find that
1375 particular document. But a long response wouldn't have fit on this
1376 page.
1377 For a more fully-featured version of this program, you should look to
1379 the lwp-request program included with the LWP modules from CPAN.
1380 Interactive Client with IO::Socket
1382 Well, that's all fine if you want to send one command and get one
1383 answer, but what about setting up something fully interactive, somewhat
1384 like the way telnet works? That way you can type a line, get the
1385 answer, type a line, get the answer, etc.
1386 This client is more complicated than the two we've done so far, but if
1388 you're on a system that supports the powerful "fork" call, the solution
1389 isn't that rough. Once you've made the connection to whatever service
1390 you'd like to chat with, call "fork" to clone your process. Each of
1391 these two identical process has a very simple job to do: the parent
1392 copies everything from the socket to standard output, while the child
1393 simultaneously copies everything from standard input to the socket. To
1394 accomplish the same thing using just one process would be much harder,
1395 because it's easier to code two processes to do one thing than it is to
1396 code one process to do two things. (This keep-it-simple principle a
1397 cornerstones of the Unix philosophy, and good software engineering as
1398 well, which is probably why it's spread to other systems.)
1399 Here's the code:
1401 #!/usr/bin/perl -w
1403 use strict;
1404 use IO::Socket;
1405 my ($host, $port, $kidpid, $handle, $line);
1406 unless (@ARGV == 2) { die "usage: $0 host port" }
1408 ($host, $port) = @ARGV;
1409 # create a tcp connection to the specified host and port
1411 $handle = IO::Socket::INET->new(Proto => "tcp",
1412 PeerAddr => $host,
1413 PeerPort => $port)
1414 or die "can't connect to port $port on $host: $!";
1415 $handle->autoflush(1); # so output gets there right away
1417 print STDERR "[Connected to $host:$port]\n";
1418 # split the program into two processes, identical twins
1420 die "can't fork: $!" unless defined($kidpid = fork());
1421 # the if{} block runs only in the parent process
1423 if ($kidpid) {
1424 # copy the socket to standard output
1425 while (defined ($line = <$handle>)) {
1426 print STDOUT $line;
1427 }
1428 kill("TERM", $kidpid); # send SIGTERM to child
1429 }
1430 # the else{} block runs only in the child process
1431 else {
1432 # copy standard input to the socket
1433 while (defined ($line = <STDIN>)) {
1434 print $handle $line;
1435 }
1436 }
1437 The "kill" function in the parent's "if" block is there to send a
1439 signal to our child process (current running in the "else" block) as
1440 soon as the remote server has closed its end of the connection.
1441 If the remote server sends data a byte at time, and you need that data
1443 immediately without waiting for a newline (which might not happen), you
1444 may wish to replace the "while" loop in the parent with the following:
1445 my $byte;
1447 while (sysread($handle, $byte, 1) == 1) {
1448 print STDOUT $byte;
1449 }
1450 Making a system call for each byte you want to read is not very
1452 efficient (to put it mildly) but is the simplest to explain and works
1453 reasonably well.
1454
1456 As always, setting up a server is little bit more involved than running
1457 a client. The model is that the server creates a special kind of
1458 socket that does nothing but listen on a particular port for incoming
1459 connections. It does this by calling the "IO::Socket::INET->new()"
1460 method with slightly different arguments than the client did.
1461 Proto
1463 This is which protocol to use. Like our clients, we'll still
1464 specify "tcp" here.
1465 LocalPort
1467 We specify a local port in the "LocalPort" argument, which we
1468 didn't do for the client. This is service name or port number for
1469 which you want to be the server. (Under Unix, ports under 1024 are
1470 restricted to the superuser.) In our sample, we'll use port 9000,
1471 but you can use any port that's not currently in use on your
1472 system. If you try to use one already in used, you'll get an
1473 "Address already in use" message. Under Unix, the "netstat -a"
1474 command will show which services current have servers.
1475 Listen
1477 The "Listen" parameter is set to the maximum number of pending
1478 connections we can accept until we turn away incoming clients.
1479 Think of it as a call-waiting queue for your telephone. The low-
1480 level Socket module has a special symbol for the system maximum,
1481 which is SOMAXCONN.
1482 Reuse
1484 The "Reuse" parameter is needed so that we restart our server
1485 manually without waiting a few minutes to allow system buffers to
1486 clear out.
1487 Once the generic server socket has been created using the parameters
1489 listed above, the server then waits for a new client to connect to it.
1490 The server blocks in the "accept" method, which eventually accepts a
1491 bidirectional connection from the remote client. (Make sure to
1492 autoflush this handle to circumvent buffering.)
1493 To add to user-friendliness, our server prompts the user for commands.
1495 Most servers don't do this. Because of the prompt without a newline,
1496 you'll have to use the "sysread" variant of the interactive client
1497 above.
1498 This server accepts one of five different commands, sending output back
1500 to the client. Note that unlike most network servers, this one only
1501 handles one incoming client at a time. Multithreaded servers are
1502 covered in Chapter 6 of the Camel.
1503 Here's the code. We'll
1505 #!/usr/bin/perl -w
1507 use IO::Socket;
1508 use Net::hostent; # for OO version of gethostbyaddr
1509 $PORT = 9000; # pick something not in use
1511 $server = IO::Socket::INET->new( Proto => 'tcp',
1513 LocalPort => $PORT,
1514 Listen => SOMAXCONN,
1515 Reuse => 1);
1516 die "can't setup server" unless $server;
1518 print "[Server $0 accepting clients]\n";
1519 while ($client = $server->accept()) {
1521 $client->autoflush(1);
1522 print $client "Welcome to $0; type help for command list.\n";
1523 $hostinfo = gethostbyaddr($client->peeraddr);
1524 printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
1525 print $client "Command? ";
1526 while ( <$client>) {
1527 next unless /\S/; # blank line
1528 if (/quit|exit/i) { last; }
1529 elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
1530 elsif (/who/i ) { print $client `who 2>&1`; }
1531 elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
1532 elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
1533 else {
1534 print $client "Commands: quit date who cookie motd\n";
1535 }
1536 } continue {
1537 print $client "Command? ";
1538 }
1539 close $client;
1540 }
1541
1543 Another kind of client-server setup is one that uses not connections,
1544 but messages. UDP communications involve much lower overhead but also
1545 provide less reliability, as there are no promises that messages will
1546 arrive at all, let alone in order and unmangled. Still, UDP offers
1547 some advantages over TCP, including being able to "broadcast" or
1548 "multicast" to a whole bunch of destination hosts at once (usually on
1549 your local subnet). If you find yourself overly concerned about
1550 reliability and start building checks into your message system, then
1551 you probably should use just TCP to start with.
1552 Note that UDP datagrams are not a bytestream and should not be treated
1554 as such. This makes using I/O mechanisms with internal buffering like
1555 stdio (i.e. print() and friends) especially cumbersome. Use syswrite(),
1556 or better send(), like in the example below.
1557 Here's a UDP program similar to the sample Internet TCP client given
1559 earlier. However, instead of checking one host at a time, the UDP
1560 version will check many of them asynchronously by simulating a
1561 multicast and then using select() to do a timed-out wait for I/O. To
1562 do something similar with TCP, you'd have to use a different socket
1563 handle for each host.
1564 #!/usr/bin/perl -w
1566 use strict;
1567 use Socket;
1568 use Sys::Hostname;
1569 my ( $count, $hisiaddr, $hispaddr, $histime,
1571 $host, $iaddr, $paddr, $port, $proto,
1572 $rin, $rout, $rtime, $SECS_of_70_YEARS);
1573 $SECS_of_70_YEARS = 2208988800;
1575 $iaddr = gethostbyname(hostname());
1577 $proto = getprotobyname('udp');
1578 $port = getservbyname('time', 'udp');
1579 $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1580 socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
1582 bind(SOCKET, $paddr) || die "bind: $!";
1583 $| = 1;
1585 printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
1586 $count = 0;
1587 for $host (@ARGV) {
1588 $count++;
1589 $hisiaddr = inet_aton($host) || die "unknown host";
1590 $hispaddr = sockaddr_in($port, $hisiaddr);
1591 defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
1592 }
1593 $rin = '';
1595 vec($rin, fileno(SOCKET), 1) = 1;
1596 # timeout after 10.0 seconds
1598 while ($count && select($rout = $rin, undef, undef, 10.0)) {
1599 $rtime = '';
1600 ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
1601 ($port, $hisiaddr) = sockaddr_in($hispaddr);
1602 $host = gethostbyaddr($hisiaddr, AF_INET);
1603 $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
1604 printf "%-12s ", $host;
1605 printf "%8d %s\n", $histime - time, scalar localtime($histime);
1606 $count--;
1607 }
1608 Note that this example does not include any retries and may
1610 consequently fail to contact a reachable host. The most prominent
1611 reason for this is congestion of the queues on the sending host if the
1612 number of list of hosts to contact is sufficiently large.
1613
1615 While System V IPC isn't so widely used as sockets, it still has some
1616 interesting uses. You can't, however, effectively use SysV IPC or
1617 Berkeley mmap() to have shared memory so as to share a variable amongst
1618 several processes. That's because Perl would reallocate your string
1619 when you weren't wanting it to.
1620 Here's a small example showing shared memory usage.
1622 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
1624 $size = 2000;
1626 $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) || die "$!";
1627 print "shm key $id\n";
1628 $message = "Message #1";
1630 shmwrite($id, $message, 0, 60) || die "$!";
1631 print "wrote: '$message'\n";
1632 shmread($id, $buff, 0, 60) || die "$!";
1633 print "read : '$buff'\n";
1634 # the buffer of shmread is zero-character end-padded.
1636 substr($buff, index($buff, "\0")) = '';
1637 print "un" unless $buff eq $message;
1638 print "swell\n";
1639 print "deleting shm $id\n";
1641 shmctl($id, IPC_RMID, 0) || die "$!";
1642 Here's an example of a semaphore:
1644 use IPC::SysV qw(IPC_CREAT);
1646 $IPC_KEY = 1234;
1648 $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1649 print "shm key $id\n";
1650 Put this code in a separate file to be run in more than one process.
1652 Call the file take:
1653 # create a semaphore
1655 $IPC_KEY = 1234;
1657 $id = semget($IPC_KEY, 0 , 0 );
1658 die if !defined($id);
1659 $semnum = 0;
1661 $semflag = 0;
1662 # 'take' semaphore
1664 # wait for semaphore to be zero
1665 $semop = 0;
1666 $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
1667 # Increment the semaphore count
1669 $semop = 1;
1670 $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
1671 $opstring = $opstring1 . $opstring2;
1672 semop($id,$opstring) || die "$!";
1674 Put this code in a separate file to be run in more than one process.
1676 Call this file give:
1677 # 'give' the semaphore
1679 # run this in the original process and you will see
1680 # that the second process continues
1681 $IPC_KEY = 1234;
1683 $id = semget($IPC_KEY, 0, 0);
1684 die if !defined($id);
1685 $semnum = 0;
1687 $semflag = 0;
1688 # Decrement the semaphore count
1690 $semop = -1;
1691 $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
1692 semop($id,$opstring) || die "$!";
1694 The SysV IPC code above was written long ago, and it's definitely
1696 clunky looking. For a more modern look, see the IPC::SysV module which
1697 is included with Perl starting from Perl 5.005.
1698 A small example demonstrating SysV message queues:
1700 use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);
1702 my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
1704 my $sent = "message";
1706 my $type_sent = 1234;
1707 my $rcvd;
1708 my $type_rcvd;
1709 if (defined $id) {
1711 if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
1712 if (msgrcv($id, $rcvd, 60, 0, 0)) {
1713 ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
1714 if ($rcvd eq $sent) {
1715 print "okay\n";
1716 } else {
1717 print "not okay\n";
1718 }
1719 } else {
1720 die "# msgrcv failed\n";
1721 }
1722 } else {
1723 die "# msgsnd failed\n";
1724 }
1725 msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
1726 } else {
1727 die "# msgget failed\n";
1728 }
1729
1731 Most of these routines quietly but politely return "undef" when they
1732 fail instead of causing your program to die right then and there due to
1733 an uncaught exception. (Actually, some of the new Socket conversion
1734 functions croak() on bad arguments.) It is therefore essential to
1735 check return values from these functions. Always begin your socket
1736 programs this way for optimal success, and don't forget to add -T taint
1737 checking flag to the #! line for servers:
1738 #!/usr/bin/perl -Tw
1740 use strict;
1741 use sigtrap;
1742 use Socket;
1743
1745 All these routines create system-specific portability problems. As
1746 noted elsewhere, Perl is at the mercy of your C libraries for much of
1747 its system behaviour. It's probably safest to assume broken SysV
1748 semantics for signals and to stick with simple TCP and UDP socket
1749 operations; e.g., don't try to pass open file descriptors over a local
1750 UDP datagram socket if you want your code to stand a chance of being
1751 portable.
1752
1754 Tom Christiansen, with occasional vestiges of Larry Wall's original
1755 version and suggestions from the Perl Porters.
1756
1758 There's a lot more to networking than this, but this should get you
1759 started.
1760 For intrepid programmers, the indispensable textbook is Unix Network
1762 Programming, 2nd Edition, Volume 1 by W. Richard Stevens (published by
1763 Prentice-Hall). Note that most books on networking address the subject
1764 from the perspective of a C programmer; translation to Perl is left as
1765 an exercise for the reader.
1766 The IO::Socket(3) manpage describes the object library, and the
1768 Socket(3) manpage describes the low-level interface to sockets.
1769 Besides the obvious functions in perlfunc, you should also check out
1770 the modules file at your nearest CPAN site. (See perlmodlib or best
1771 yet, the Perl FAQ for a description of what CPAN is and where to get
1772 it.)
1773 Section 5 of the modules file is devoted to "Networking, Device Control
1775 (modems), and Interprocess Communication", and contains numerous
1776 unbundled modules numerous networking modules, Chat and Expect
1777 operations, CGI programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC,
1778 SNMP, SMTP, Telnet, Threads, and ToolTalk--just to name a few.
1779perl v5.10.1 2009-08-10 PERLIPC(1)