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