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