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