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