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