Commit | Line | Data |
a0d0e21e |
1 | =head1 NAME |
2 | |
4633a7c4 |
3 | perlipc - Perl interprocess communication (signals, fifos, pipes, safe |
4 | subprocceses, sockets, and semaphores) |
a0d0e21e |
5 | |
6 | =head1 DESCRIPTION |
7 | |
4633a7c4 |
8 | The basic IPC facilities of Perl are built out of the good old Unix |
9 | signals, named pipes, pipe opens, the Berkeley socket routines, and SysV |
10 | IPC calls. Each is used in slightly different situations. |
11 | |
12 | =head1 Signals |
13 | |
14 | Perl uses a simple signal handling model: the %SIG hash contains names or |
15 | references of user-installed signal handlers. These handlers will be called |
16 | with an argument which is the name of the signal that triggered it. A |
17 | signal may be generated intentionally from a particular keyboard sequence like |
18 | control-C or control-Z, sent to you from an another process, or |
19 | triggered automatically by the kernel when special events transpire, like |
20 | a child process exiting, your process running out of stack space, or |
21 | hitting file size limit. |
22 | |
23 | For example, to trap an interrupt signal, set up a handler like this. |
24 | Notice how all we do is set with a global variable and then raise an |
25 | exception. That's because on most systems libraries are not |
26 | re-entrant, so calling any print() functions (or even anything that needs to |
27 | malloc(3) more memory) could in theory trigger a memory fault |
28 | and subsequent core dump. |
29 | |
30 | sub catch_zap { |
31 | my $signame = shift; |
32 | $shucks++; |
33 | die "Somebody sent me a SIG$signame"; |
34 | } |
35 | $SIG{INT} = 'catch_zap'; # could fail in modules |
36 | $SIG{INT} = \&catch_zap; # best strategy |
37 | |
38 | The names of the signals are the ones listed out by C<kill -l> on your |
39 | system, or you can retrieve them from the Config module. Set up an |
40 | @signame list indexed by number to get the name and a %signo table |
41 | indexed by name to get the number: |
42 | |
43 | use Config; |
44 | defined $Config{sig_name} || die "No sigs?"; |
45 | foreach $name (split(' ', $Config{sig_name})) { |
46 | $signo{$name} = $i; |
47 | $signame[$i] = $name; |
48 | $i++; |
49 | } |
50 | |
51 | So to check whether signal 17 and SIGALRM were the same, just do this: |
52 | |
53 | print "signal #17 = $signame[17]\n"; |
54 | if ($signo{ALRM}) { |
55 | print "SIGALRM is $signo{ALRM}\n"; |
56 | } |
57 | |
58 | You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as |
59 | the handler, in which case Perl will try to discard the signal or do the |
60 | default thing. Some signals can be neither trapped nor ignored, such as |
61 | the KILL and STOP (but not the TSTP) signals. One strategy for |
62 | temporarily ignoring signals is to use a local() statement, which will be |
63 | automatically restored once your block is exited. (Remember that local() |
64 | values are "inherited" by functions called from within that block.) |
65 | |
66 | sub precious { |
67 | local $SIG{INT} = 'IGNORE'; |
68 | &more_functions; |
69 | } |
70 | sub more_functions { |
71 | # interrupts still ignored, for now... |
72 | } |
73 | |
74 | Sending a signal to a negative process ID means that you send the signal |
75 | to the entire Unix process-group. This code send a hang-up signal to all |
76 | processes in the current process group I<except for> the current process |
77 | itself: |
78 | |
79 | { |
80 | local $SIG{HUP} = 'IGNORE'; |
81 | kill HUP => -$$; |
82 | # snazzy writing of: kill('HUP', -$$) |
83 | } |
a0d0e21e |
84 | |
4633a7c4 |
85 | Another interesting signal to send is signal number zero. This doesn't |
86 | actually affect another process, but instead checks whether it's alive |
87 | or has changed its UID. |
a0d0e21e |
88 | |
4633a7c4 |
89 | unless (kill 0 => $kid_pid) { |
90 | warn "something wicked happened to $kid_pid"; |
91 | } |
a0d0e21e |
92 | |
4633a7c4 |
93 | You might also want to employ anonymous functions for simple signal |
94 | handlers: |
a0d0e21e |
95 | |
4633a7c4 |
96 | $SIG{INT} = sub { die "\nOutta here!\n" }; |
a0d0e21e |
97 | |
4633a7c4 |
98 | But that will be problematic for the more complicated handlers that need |
99 | to re-install themselves. Because Perl's signal mechanism is currently |
100 | based on the signal(3) function from the C library, you may somtimes be so |
101 | misfortunate as to run on systems where that function is "broken", that |
102 | is, it behaves in the old unreliable SysV way rather than the newer, more |
103 | reasonable BSD and POSIX fashion. So you'll see defensive people writing |
104 | signal handlers like this: |
a0d0e21e |
105 | |
4633a7c4 |
106 | sub REAPER { |
107 | $SIG{CHLD} = \&REAPER; # loathe sysV |
108 | $waitedpid = wait; |
109 | } |
110 | $SIG{CHLD} = \&REAPER; |
111 | # now do something that forks... |
112 | |
113 | or even the more elaborate: |
114 | |
115 | use POSIX "wait_h"; |
116 | sub REAPER { |
117 | my $child; |
118 | $SIG{CHLD} = \&REAPER; # loathe sysV |
119 | while ($child = waitpid(-1,WNOHANG)) { |
120 | $Kid_Status{$child} = $?; |
121 | } |
122 | } |
123 | $SIG{CHLD} = \&REAPER; |
124 | # do something that forks... |
125 | |
126 | Signal handling is also used for timeouts in Unix, While safely |
127 | protected within an C<eval{}> block, you set a signal handler to trap |
128 | alarm signals and then schedule to have one delivered to you in some |
129 | number of seconds. Then try your blocking operation, clearing the alarm |
130 | when it's done but not before you've exited your C<eval{}> block. If it |
131 | goes off, you'll use die() to jump out of the block, much as you might |
132 | using longjmp() or throw() in other languages. |
133 | |
134 | Here's an example: |
135 | |
136 | eval { |
137 | local $SIG{ALRM} = sub { die "alarm clock restart" }; |
138 | alarm 10; |
139 | flock(FH, 2); # blocking write lock |
140 | alarm 0; |
141 | }; |
142 | if ($@ and $@ !~ /alarm clock restart/) { die } |
143 | |
144 | For more complex signal handling, you might see the standard POSIX |
145 | module. Lamentably, this is almost entirely undocumented, but |
146 | the F<t/lib/posix.t> file from the Perl source distribution has some |
147 | examples in it. |
148 | |
149 | =head1 Named Pipes |
150 | |
151 | A named pipe (often referred to as a FIFO) is an old Unix IPC |
152 | mechanism for processes communicating on the same machine. It works |
153 | just like a regular, connected anonymous pipes, except that the |
154 | processes rendezvous using a filename and don't have to be related. |
155 | |
156 | To create a named pipe, use the Unix command mknod(1) or on some |
157 | systems, mkfifo(1). These may not be in your normal path. |
158 | |
159 | # system return val is backwards, so && not || |
160 | # |
161 | $ENV{PATH} .= ":/etc:/usr/etc"; |
162 | if ( system('mknod', $path, 'p') |
163 | && system('mkfifo', $path) ) |
164 | { |
165 | die "mk{nod,fifo} $path failed; |
166 | } |
167 | |
168 | |
169 | A fifo is convenient when you want to connect a process to an unrelated |
170 | one. When you open a fifo, the program will block until there's something |
171 | on the other end. |
172 | |
173 | For example, let's say you'd like to have your F<.signature> file be a |
174 | named pipe that has a Perl program on the other end. Now every time any |
175 | program (like a mailer, newsreader, finger program, etc.) tries to read |
176 | from that file, the reading program will block and your program will |
177 | supply the the new signature. We'll use the pipe-checking file test B<-p> |
178 | to find out whether anyone (or anything) has accidentally removed our fifo. |
179 | |
180 | chdir; # go home |
181 | $FIFO = '.signature'; |
182 | $ENV{PATH} .= ":/etc:/usr/games"; |
183 | |
184 | while (1) { |
185 | unless (-p $FIFO) { |
186 | unlink $FIFO; |
187 | system('mknod', $FIFO, 'p') |
188 | && die "can't mknod $FIFO: $!"; |
189 | } |
190 | |
191 | # next line blocks until there's a reader |
192 | open (FIFO, "> $FIFO") || die "can't write $FIFO: $!"; |
193 | print FIFO "John Smith (smith\@host.org)\n", `fortune -s`; |
194 | close FIFO; |
195 | sleep 2; # to avoid dup sigs |
196 | } |
a0d0e21e |
197 | |
a0d0e21e |
198 | |
4633a7c4 |
199 | =head1 Using open() for IPC |
200 | |
201 | Perl's basic open() statement can also be used for unidirectional interprocess |
202 | communication by either appending or prepending a pipe symbol to the second |
203 | argument to open(). Here's how to start something up a child process you |
204 | intend to write to: |
205 | |
206 | open(SPOOLER, "| cat -v | lpr -h 2>/dev/null") |
207 | || die "can't fork: $!"; |
208 | local $SIG{PIPE} = sub { die "spooler pipe broke" }; |
209 | print SPOOLER "stuff\n"; |
210 | close SPOOLER || die "bad spool: $! $?"; |
211 | |
212 | And here's how to start up a child process you intend to read from: |
213 | |
214 | open(STATUS, "netstat -an 2>&1 |") |
215 | || die "can't fork: $!"; |
216 | while (<STATUS>) { |
217 | next if /^(tcp|udp)/; |
218 | print; |
219 | } |
220 | close SPOOLER || die "bad netstat: $! $?"; |
221 | |
222 | If one can be sure that a particular program is a Perl script that is |
223 | expecting filenames in @ARGV, the clever programmer can write something |
224 | like this: |
225 | |
226 | $ program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile |
227 | |
228 | and irrespective of which shell it's called from, the Perl program will |
229 | read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile> |
230 | in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3> |
231 | file. Pretty nifty, eh? |
232 | |
233 | You might notice that you could use backticks for much the |
234 | same effect as opening a pipe for reading: |
235 | |
236 | print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`; |
237 | die "bad netstat" if $?; |
238 | |
239 | While this is true on the surface, it's much more efficient to process the |
240 | file one line or record at a time because then you don't have to read the |
241 | whole thing into memory at once. It also gives you finer control of the |
242 | whole process, letting you to kill off the child process early if you'd |
243 | like. |
244 | |
245 | Be careful to check both the open() and the close() return values. If |
246 | you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise, |
247 | think of what happens when you start up a pipe to a command that doesn't |
248 | exist: the open() will in all likelihood succeed (it only reflects the |
249 | fork()'s success), but then your output will fail--spectacularly. Perl |
250 | can't know whether the command worked because your command is actually |
251 | running in a separate process whose exec() might have failed. Therefore, |
252 | while readers of bogus commands just return a quick end of file, writers |
253 | to bogus command will trigger a signal they'd better be prepared to |
254 | handle. Consider: |
255 | |
256 | open(FH, "|bogus"); |
257 | print FH "bang\n"; |
258 | close FH; |
259 | |
260 | =head2 Safe Pipe Opens |
261 | |
262 | Another interesting approach to IPC is making your single program go |
263 | multiprocess and communicate between (or even amongst) yourselves. The |
264 | open() function will accept a file argument of either C<"-|"> or C<"|-"> |
265 | to do a very interesting thing: it forks a child connected to the |
266 | filehandle you've opened. The child is running the same program as the |
267 | parent. This is useful for safely opening a file when running under an |
268 | assumed UID or GID, for example. If you open a pipe I<to> minus, you can |
269 | write to the filehandle you opened and your kid will find it in his |
270 | STDIN. If you open a pipe I<from> minus, you can read from the filehandle |
271 | you opened whatever your kid writes to his STDOUT. |
272 | |
273 | use English; |
274 | my $sleep_count = 0; |
275 | |
276 | do { |
277 | $pid = open(KID, "-|"); |
278 | unless (defined $pid) { |
279 | warn "cannot fork: $!"; |
280 | die "bailing out" if $sleep_count++ > 6; |
281 | sleep 10; |
282 | } |
283 | } until defined $pid; |
284 | |
285 | if ($pid) { # parent |
286 | print KID @some_data; |
287 | close(KID) || warn "kid exited $?"; |
288 | } else { # child |
289 | ($EUID, $EGID) = ($UID, $GID); # suid progs only |
290 | open (FILE, "> /safe/file") |
291 | || die "can't open /safe/file: $!"; |
292 | while (<STDIN>) { |
293 | print FILE; # child's STDIN is parent's KID |
294 | } |
295 | exit; # don't forget this |
296 | } |
297 | |
298 | Another common use for this construct is when you need to execute |
299 | something without the shell's interference. With system(), it's |
300 | straigh-forward, but you can't use a pipe open or backticks safely. |
301 | That's because there's no way to stop the shell from getting its hands on |
302 | your arguments. Instead, use lower-level control to call exec() directly. |
303 | |
304 | Here's a safe backtick or pipe open for read: |
305 | |
306 | # add error processing as above |
307 | $pid = open(KID, "-|"); |
308 | |
309 | if ($pid) { # parent |
310 | while (<KID>) { |
311 | # do something interesting |
312 | } |
313 | close(KID) || warn "kid exited $?"; |
314 | |
315 | } else { # child |
316 | ($EUID, $EGID) = ($UID, $GID); # suid only |
317 | exec($program, @options, @args) |
318 | || die "can't exec program: $!"; |
319 | # NOTREACHED |
320 | } |
321 | |
322 | |
323 | And here's a safe pipe open for writing: |
324 | |
325 | # add error processing as above |
326 | $pid = open(KID, "|-"); |
327 | $SIG{ALRM} = sub { die "whoops, $program pipe broke" }; |
328 | |
329 | if ($pid) { # parent |
330 | for (@data) { |
331 | print KID; |
332 | } |
333 | close(KID) || warn "kid exited $?"; |
334 | |
335 | } else { # child |
336 | ($EUID, $EGID) = ($UID, $GID); |
337 | exec($program, @options, @args) |
338 | || die "can't exec program: $!"; |
339 | # NOTREACHED |
340 | } |
341 | |
342 | Note that these operations are full Unix forks, which means they may not be |
343 | correctly implemented on alien systems. Additionally, these are not true |
344 | multithreading. If you'd like to learn more about threading, see the |
345 | F<modules> file mentioned below in the L<SEE ALSO> section. |
346 | |
347 | =head2 Bidirectional Communication |
348 | |
349 | While this works reasonably well for unidirectional communication, what |
350 | about bidirectional communication? The obvious thing you'd like to do |
351 | doesn't actually work: |
352 | |
353 | open(KID, "| some program |") |
354 | |
355 | and if you forgot to use the B<-w> flag, then you'll miss out |
356 | entirely on the diagnostic message: |
357 | |
358 | Can't do bidirectional pipe at -e line 1. |
359 | |
360 | If you really want to, you can use the standard open2() library function |
361 | to catch both ends. There's also an open3() for tridirectional I/O so you |
362 | can also catch your child's STDERR, but doing so would then require an |
363 | awkward select() loop and wouldn't allow you to use normal Perl input |
364 | operations. |
365 | |
366 | If you look at its source, you'll see that open2() uses low-level |
367 | primitives like Unix pipe() and exec() to create all the connections. |
368 | While it might have been slightly more efficient by using socketpair(), it |
369 | would have then been even less portable than it already is. The open2() |
370 | and open3() functions are unlikely to work anywhere except on a Unix |
371 | system or some other one purporting to be POSIX compliant. |
372 | |
373 | Here's an example of using open2(): |
374 | |
375 | use FileHandle; |
376 | use IPC::Open2; |
377 | $pid = open2( \*Reader, \*Writer, "cat -u -n" ); |
378 | Writer->autoflush(); # default here, actually |
379 | print Writer "stuff\n"; |
380 | $got = <Reader>; |
381 | |
382 | The problem with this is that Unix buffering is going to really |
383 | ruin your day. Even though your C<Writer> filehandle is autoflushed, |
384 | and the process on the other end will get your data in a timely manner, |
385 | you can't usually do anything to force it to actually give it back to you |
386 | in a similarly quick fashion. In this case, we could, because we |
387 | gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix |
388 | commands are designed to operate over pipes, so this seldom works |
389 | unless you yourself wrote the program on the other end of the |
390 | double-ended pipe. |
391 | |
392 | A solution to this is the non-standard F<Comm.pl> library. It uses |
393 | pseudo-ttys to make your program behave more reasonably: |
394 | |
395 | require 'Comm.pl'; |
396 | $ph = open_proc('cat -n'); |
397 | for (1..10) { |
398 | print $ph "a line\n"; |
399 | print "got back ", scalar <$ph>; |
400 | } |
a0d0e21e |
401 | |
4633a7c4 |
402 | This way you don't have to have control over the source code of the |
403 | program you're using. The F<Comm> library also has expect() |
404 | and interact() functions. Find the library (and hopefully its |
405 | successor F<IPC::Chat>) at your nearest CPAN archive as detailed |
406 | in the L<SEE ALSO> section below. |
a0d0e21e |
407 | |
4633a7c4 |
408 | =head1 Sockets: Client/Server Communication |
a0d0e21e |
409 | |
4633a7c4 |
410 | While not limited to Unix-derived operating systems (e.g. WinSock on PCs |
411 | provides socket support, as do some VMS libraries), you may not have |
412 | sockets on your system, in which this section probably isn't going to do |
413 | you much good. With sockets, you can do both virtual circuits (i.e. TCP |
414 | streams) and datagrams (i.e. UDP packets). You may be able to do even more |
415 | depending on your system. |
416 | |
417 | The Perl function calls for dealing with sockets have the same names as |
418 | the corresponding system calls in C, but their arguments tend to differ |
419 | for two reasons: first, Perl filehandles work differently than C file |
420 | descriptors. Second, Perl already knows the length of its strings, so you |
421 | don't need to pass that information. |
a0d0e21e |
422 | |
4633a7c4 |
423 | One of the major problems with old socket code in Perl was that it used |
424 | hard-coded values for some of the constants, which severely hurt |
425 | portability. If you ever see code that does anything like explicitly |
426 | setting C<$AF_INET = 2>, you know you're in for big trouble: An |
427 | immeasurably superior approach is to use the C<Socket> module, which more |
428 | reliably grants access to various constants and functions you'll need. |
a0d0e21e |
429 | |
4633a7c4 |
430 | =head2 Internet TCP Clients and Servers |
a0d0e21e |
431 | |
4633a7c4 |
432 | Use Internet-domain sockets when you want to do client-server |
433 | communication that might extend to machines outside of your own system. |
434 | |
435 | Here's a sample TCP client using Internet-domain sockets: |
436 | |
437 | #!/usr/bin/perl -w |
438 | require 5.002; |
439 | use strict; |
440 | use Socket; |
441 | my ($remote,$port, $iaddr, $paddr, $proto, $line); |
442 | |
443 | $remote = shift || 'localhost'; |
444 | $port = shift || 2345; # random port |
445 | if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') } |
446 | die "No port" unless $port; |
447 | $iaddr = inet_aton($remote) || die "no host: $remote"; |
448 | $paddr = sockaddr_in($port, $iaddr); |
449 | |
450 | $proto = getprotobyname('tcp'); |
451 | socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; |
452 | connect(SOCK, $paddr) || die "connect: $!"; |
453 | while ($line = <SOCK>) { |
454 | print $line; |
455 | } |
456 | |
457 | close (SOCK) || die "close: $!"; |
458 | exit; |
459 | |
460 | And here's a corresponding server to go along with it. We'll |
461 | leave the address as INADDR_ANY so that the kernel can choose |
462 | the appropriate interface on multihomed hosts: |
463 | |
464 | #!/usr/bin/perl -Tw |
465 | require 5.002; |
466 | use strict; |
467 | BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } |
a0d0e21e |
468 | use Socket; |
4633a7c4 |
469 | use Carp; |
a0d0e21e |
470 | |
4633a7c4 |
471 | sub spawn; # forward declaration |
472 | sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } |
a0d0e21e |
473 | |
4633a7c4 |
474 | my $port = shift || 2345; |
475 | my $proto = getprotobyname('tcp'); |
476 | socket(SERVER, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; |
477 | setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1) || die "setsockopt: $!"; |
478 | bind(SERVER, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; |
479 | listen(SERVER,5) || die "listen: $!"; |
a0d0e21e |
480 | |
4633a7c4 |
481 | logmsg "server started on port $port"; |
a0d0e21e |
482 | |
4633a7c4 |
483 | my $waitedpid = 0; |
484 | my $paddr; |
a0d0e21e |
485 | |
4633a7c4 |
486 | sub REAPER { |
487 | $SIG{CHLD} = \&REAPER; # loathe sysV |
488 | $waitedpid = wait; |
489 | logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); |
490 | } |
491 | |
492 | $SIG{CHLD} = \&REAPER; |
493 | |
494 | for ( $waitedpid = 0; |
495 | ($paddr = accept(CLIENT,SERVER)) || $waitedpid; |
496 | $waitedpid = 0, close CLIENT) |
497 | { |
498 | next if $waitedpid; |
499 | my($port,$iaddr) = sockaddr_in($paddr); |
500 | my $name = gethostbyaddr($iaddr,AF_INET); |
501 | |
502 | logmsg "connection from $name [", |
503 | inet_ntoa($iaddr), "] |
504 | at port $port"; |
a0d0e21e |
505 | |
4633a7c4 |
506 | spawn sub { |
507 | print "Hello there, $name, it's now ", scalar localtime, "\n"; |
508 | exec '/usr/games/fortune' |
509 | or confess "can't exec fortune: $!"; |
510 | }; |
a0d0e21e |
511 | |
4633a7c4 |
512 | } |
a0d0e21e |
513 | |
4633a7c4 |
514 | sub spawn { |
515 | my $coderef = shift; |
a0d0e21e |
516 | |
4633a7c4 |
517 | unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { |
518 | confess "usage: spawn CODEREF"; |
a0d0e21e |
519 | } |
4633a7c4 |
520 | |
521 | my $pid; |
522 | if (!defined($pid = fork)) { |
523 | logmsg "cannot fork: $!"; |
524 | return; |
525 | } elsif ($pid) { |
526 | logmsg "begat $pid"; |
527 | return; # i'm the parent |
528 | } |
529 | # else i'm the child -- go spawn |
530 | |
531 | open(STDIN, "<&CLIENT") || die "can't dup client to stdin"; |
532 | open(STDOUT, ">&CLIENT") || die "can't dup client to stdout"; |
533 | ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; |
534 | exit &$coderef(); |
535 | } |
536 | |
537 | This server takes the trouble to clone off a child version via fork() for |
538 | each incoming request. That way it can handle many requests at once, |
539 | which you might not always want. Even if you don't fork(), the listen() |
540 | will allow that many pending connections. Forking servers have to be |
541 | particularly careful about cleaning up their dead children (called |
542 | "zombies" in Unix parlance), because otherwise you'll quickly fill up your |
543 | process table. |
544 | |
545 | We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>) |
546 | even if we aren't running setuid or setgid. This is always a good idea |
547 | for servers and other programs run on behalf of someone else (like CGI |
548 | scripts), because it lessens the chances that people from the outside will |
549 | be able to compromise your system. |
550 | |
551 | Let's look at another TCP client. This one connects to the TCP "time" |
552 | service on a number of different machines and shows how far their clocks |
553 | differ from the system on which it's being run: |
554 | |
555 | #!/usr/bin/perl -w |
556 | require 5.002; |
557 | use strict; |
558 | use Socket; |
559 | |
560 | my $SECS_of_70_YEARS = 2208988800; |
561 | sub ctime { scalar localtime(shift) } |
562 | |
563 | my $iaddr = gethostbyname('localhost'); |
564 | my $proto = getprotobyname('tcp'); |
565 | my $port = getservbyname('time', 'tcp'); |
566 | my $paddr = sockaddr_in(0, $iaddr); |
567 | my($host); |
568 | |
569 | $| = 1; |
570 | printf "%-24s %8s %s\n", "localhost", 0, ctime(time()); |
571 | |
572 | foreach $host (@ARGV) { |
573 | printf "%-24s ", $host; |
574 | my $hisiaddr = inet_aton($host) || die "unknown host"; |
575 | my $hispaddr = sockaddr_in($port, $hisiaddr); |
576 | socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; |
577 | connect(SOCKET, $hispaddr) || die "bind: $!"; |
578 | my $rtime = ' '; |
579 | read(SOCKET, $rtime, 4); |
580 | close(SOCKET); |
581 | my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ; |
582 | printf "%8d %s\n", $histime - time, ctime($histime); |
a0d0e21e |
583 | } |
584 | |
4633a7c4 |
585 | =head2 Unix-Domain TCP Clients and Servers |
586 | |
587 | That's fine for Internet-domain clients and servers, but what local |
588 | communications? While you can use the same setup, sometimes you don't |
589 | want to. Unix-domain sockets are local to the current host, and are often |
590 | used internally to implement pipes. Unlike Internet domain sockets, UNIX |
591 | domain sockets can show up in the file system with an ls(1) listing. |
592 | |
593 | $ ls -l /dev/log |
594 | srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log |
a0d0e21e |
595 | |
4633a7c4 |
596 | You can test for these with Perl's B<-S> file test: |
597 | |
598 | unless ( -S '/dev/log' ) { |
599 | die "something's wicked with the print system"; |
600 | } |
601 | |
602 | Here's a sample Unix-domain client: |
603 | |
604 | #!/usr/bin/perl -w |
605 | require 5.002; |
606 | use Socket; |
607 | use strict; |
608 | my ($rendezvous, $line); |
609 | |
610 | $rendezvous = shift || '/tmp/catsock'; |
611 | socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!"; |
612 | connect(SOCK, sockaddr_un($remote)) || die "connect: $!"; |
613 | while ($line = <SOCK>) { |
614 | print $line; |
615 | } |
616 | exit; |
617 | |
618 | And here's a corresponding server. |
619 | |
620 | #!/usr/bin/perl -Tw |
621 | require 5.002; |
622 | use strict; |
623 | use Socket; |
624 | use Carp; |
625 | |
626 | BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } |
627 | |
628 | my $NAME = '/tmp/catsock'; |
629 | my $uaddr = sockaddr_un($NAME); |
630 | my $proto = getprotobyname('tcp'); |
631 | |
632 | socket(SERVER,PF_UNIX,SOCK_STREAM,0) || die "socket: $!"; |
633 | unlink($NAME); |
634 | bind (SERVER, $uaddr) || die "bind: $!"; |
635 | listen(SERVER,5) || die "listen: $!"; |
636 | |
637 | logmsg "server started on $NAME"; |
638 | |
639 | $SIG{CHLD} = \&REAPER; |
640 | |
641 | for ( $waitedpid = 0; |
642 | accept(CLIENT,SERVER) || $waitedpid; |
643 | $waitedpid = 0, close CLIENT) |
644 | { |
645 | next if $waitedpid; |
646 | logmsg "connection on $NAME"; |
647 | spawn sub { |
648 | print "Hello there, it's now ", scalar localtime, "\n"; |
649 | exec '/usr/games/fortune' or die "can't exec fortune: $!"; |
650 | }; |
651 | } |
652 | |
653 | As you see, it's remarkably similar to the Internet domain TCP server, so |
654 | much so, in fact, that we've omitted several duplicate functions--spawn(), |
655 | logmsg(), ctime(), and REAPER()--which are exactly the same as in the |
656 | other server. |
657 | |
658 | So why would you ever want to use a Unix domain socket instead of a |
659 | simpler named pipe? Because a named pipe doesn't give you sessions. You |
660 | can't tell one process's data from another's. With socket programming, |
661 | you get a separate session for each client: that's why accept() takes two |
662 | arguments. |
663 | |
664 | For example, let's say that you have a long running database server daemon |
665 | that you want folks from the World Wide Web to be able to access, but only |
666 | if they go through a CGI interface. You'd have a small, simple CGI |
667 | program that does whatever checks and logging you feel like, and then acts |
668 | as a Unix-domain client and connects to your private server. |
669 | |
670 | =head2 UDP: Message Passing |
671 | |
672 | Another kind of client-server setup is one that uses not connections, but |
673 | messages. UDP communications involve much lower overhead but also provide |
674 | less reliability, as there are no promises that messages will arrive at |
675 | all, let alone in order and unmangled. Still, UDP offers some advantages |
676 | over TCP, including being able to "broadcast" or "multicast" to a whole |
677 | bunch of destination hosts at once (usually on your local subnet). If you |
678 | find yourself overly concerned about reliability and start building checks |
679 | into your message system, then you probably should just use TCP to start |
680 | with. |
681 | |
682 | Here's a UDP program similar to the sample Internet TCP client given |
683 | above. However, instead of checking one host at a time, the UDP version |
684 | will check many of them asynchronously by simulating a multicast and then |
685 | using select() to do a timed-out wait for I/O. To do something similar |
686 | with TCP, you'd have to use a different socket handle for each host. |
687 | |
688 | #!/usr/bin/perl -w |
689 | use strict; |
690 | require 5.002; |
691 | use Socket; |
692 | use Sys::Hostname; |
693 | |
694 | my ( $count, $hisiaddr, $hispaddr, $histime, |
695 | $host, $iaddr, $paddr, $port, $proto, |
696 | $rin, $rout, $rtime, $SECS_of_70_YEARS); |
697 | |
698 | $SECS_of_70_YEARS = 2208988800; |
699 | |
700 | $iaddr = gethostbyname(hostname()); |
701 | $proto = getprotobyname('udp'); |
702 | $port = getservbyname('time', 'udp'); |
703 | $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick |
704 | |
705 | socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!"; |
706 | bind(SOCKET, $paddr) || die "bind: $!"; |
707 | |
708 | $| = 1; |
709 | printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time; |
710 | $count = 0; |
711 | for $host (@ARGV) { |
712 | $count++; |
713 | $hisiaddr = inet_aton($host) || die "unknown host"; |
714 | $hispaddr = sockaddr_in($port, $hisiaddr); |
715 | defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!"; |
716 | } |
717 | |
718 | $rin = ''; |
719 | vec($rin, fileno(SOCKET), 1) = 1; |
720 | |
721 | # timeout after 10.0 seconds |
722 | while ($count && select($rout = $rin, undef, undef, 10.0)) { |
723 | $rtime = ''; |
724 | ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!"; |
725 | ($port, $hisiaddr) = sockaddr_in($hispaddr); |
726 | $host = gethostbyaddr($hisiaddr, AF_INET); |
727 | $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ; |
728 | printf "%-12s ", $host; |
729 | printf "%8d %s\n", $histime - time, scalar localtime($histime); |
730 | $count--; |
731 | } |
732 | |
733 | =head1 SysV IPC |
734 | |
735 | While System V IPC isn't so widely used as sockets, it still has some |
736 | interesting uses. You can't, however, effectively use SysV IPC or |
737 | Berkeley mmap() to have shared memory so as to share a variable amongst |
738 | several processes. That's because Perl would reallocate your string when |
739 | you weren't wanting it to. |
740 | |
741 | |
742 | Here's a small example showing shared memory usage. |
a0d0e21e |
743 | |
744 | $IPC_PRIVATE = 0; |
745 | $IPC_RMID = 0; |
746 | $size = 2000; |
747 | $key = shmget($IPC_PRIVATE, $size , 0777 ); |
4633a7c4 |
748 | die unless defined $key; |
a0d0e21e |
749 | |
750 | $message = "Message #1"; |
751 | shmwrite($key, $message, 0, 60 ) || die "$!"; |
752 | shmread($key,$buff,0,60) || die "$!"; |
753 | |
754 | print $buff,"\n"; |
755 | |
756 | print "deleting $key\n"; |
757 | shmctl($key ,$IPC_RMID, 0) || die "$!"; |
758 | |
759 | Here's an example of a semaphore: |
760 | |
761 | $IPC_KEY = 1234; |
762 | $IPC_RMID = 0; |
763 | $IPC_CREATE = 0001000; |
764 | $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE ); |
765 | die if !defined($key); |
766 | print "$key\n"; |
767 | |
768 | Put this code in a separate file to be run in more that one process |
769 | Call the file F<take>: |
770 | |
771 | # create a semaphore |
772 | |
773 | $IPC_KEY = 1234; |
774 | $key = semget($IPC_KEY, 0 , 0 ); |
775 | die if !defined($key); |
776 | |
777 | $semnum = 0; |
778 | $semflag = 0; |
779 | |
780 | # 'take' semaphore |
781 | # wait for semaphore to be zero |
782 | $semop = 0; |
783 | $opstring1 = pack("sss", $semnum, $semop, $semflag); |
784 | |
785 | # Increment the semaphore count |
786 | $semop = 1; |
787 | $opstring2 = pack("sss", $semnum, $semop, $semflag); |
788 | $opstring = $opstring1 . $opstring2; |
789 | |
790 | semop($key,$opstring) || die "$!"; |
791 | |
792 | Put this code in a separate file to be run in more that one process |
793 | Call this file F<give>: |
794 | |
4633a7c4 |
795 | # 'give' the semaphore |
a0d0e21e |
796 | # run this in the original process and you will see |
797 | # that the second process continues |
798 | |
799 | $IPC_KEY = 1234; |
800 | $key = semget($IPC_KEY, 0, 0); |
801 | die if !defined($key); |
802 | |
803 | $semnum = 0; |
804 | $semflag = 0; |
805 | |
806 | # Decrement the semaphore count |
807 | $semop = -1; |
808 | $opstring = pack("sss", $semnum, $semop, $semflag); |
809 | |
810 | semop($key,$opstring) || die "$!"; |
811 | |
4633a7c4 |
812 | =head1 WARNING |
813 | |
814 | The SysV IPC code above was written long ago, and it's definitely clunky |
815 | looking. It should at the very least be made to C<use strict> and |
816 | C<require "sys/ipc.ph">. Better yet, perhaps someone should create an |
817 | C<IPC::SysV> module the way we have the C<Socket> module for normal |
818 | client-server communications. |
819 | |
820 | (... time passes) |
821 | |
822 | Voila! Check out the IPC::SysV modules written by Jack Shirazi. You can |
823 | find them at a CPAN store near you. |
824 | |
825 | =head1 NOTES |
826 | |
827 | If you are running under version 5.000 (dubious) or 5.001, you can still |
828 | use most of the examples in this document. You may have to remove the |
829 | C<use strict> and some of the my() statements for 5.000, and for both |
830 | you'll have to load in version 1.2 of the F<Socket.pm> module, which |
831 | was/is/shall-be included in I<perl5.001o>. |
832 | |
833 | Most of these routines quietly but politely return C<undef> when they fail |
834 | instead of causing your program to die right then and there due to an |
835 | uncaught exception. (Actually, some of the new I<Socket> conversion |
836 | functions croak() on bad arguments.) It is therefore essential |
837 | that you should check the return values fo these functions. Always begin |
838 | your socket programs this way for optimal success, and don't forget to add |
839 | B<-T> taint checking flag to the pound-bang line for servers: |
840 | |
841 | #!/usr/bin/perl -w |
842 | require 5.002; |
843 | use strict; |
844 | use sigtrap; |
845 | use Socket; |
846 | |
847 | =head1 BUGS |
848 | |
849 | All these routines create system-specific portability problems. As noted |
850 | elsewhere, Perl is at the mercy of your C libraries for much of its system |
851 | behaviour. It's probably safest to assume broken SysV semantics for |
852 | signals and to stick with simple TCP and UDP socket operations; e.g. don't |
853 | try to pass open filedescriptors over a local UDP datagram socket if you |
854 | want your code to stand a chance of being portable. |
855 | |
856 | Because few vendors provide C libraries that are safely |
857 | re-entrant, the prudent programmer will do little else within |
858 | a handler beyond die() to raise an exception and longjmp(3) out. |
859 | |
860 | =head1 AUTHOR |
861 | |
862 | Tom Christiansen, with occasional vestiges of Larry Wall's original |
863 | version. |
864 | |
865 | =head1 SEE ALSO |
866 | |
867 | Besides the obvious functions in L<perlfunc>, you should also check out |
868 | the F<modules> file at your nearest CPAN site. (See L<perlmod> or best |
869 | yet, the F<Perl FAQ> for a description of what CPAN is and where to get it.) |
870 | Section 5 of the F<modules> file is devoted to "Networking, Device Control |
871 | (modems) and Interprocess Communication", and contains numerous unbundled |
872 | modules numerous networking modules, Chat and Expect operations, CGI |
873 | programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet, |
874 | Threads, and ToolTalk--just to name a few. |