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