pod/perlipc.pod

   1 =head1 NAME
   2
   3 perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
   4
   5 =head1 DESCRIPTION
   6
   7 The basic IPC facilities of Perl are built out of the good old Unix
   8 signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
   9 IPC calls.  Each is used in slightly different situations.
  10
  11 =head1 Signals
  12
  13 Perl uses a simple signal handling model: the %SIG hash contains names or
  14 references of user-installed signal handlers.  These handlers will be called
  15 with an argument which is the name of the signal that triggered it.  A
  16 signal may be generated intentionally from a particular keyboard sequence like
  17 control-C or control-Z, sent to you from another process, or
  18 triggered automatically by the kernel when special events transpire, like
  19 a child process exiting, your process running out of stack space, or
  20 hitting file size limit.
  21
  22 For example, to trap an interrupt signal, set up a handler like this.
  23 Notice how all we do is set a global variable and then raise an
  24 exception.  That's because on most systems libraries are not
  25 re-entrant, so calling any print() functions (or even anything that needs to
  26 malloc(3) more memory) could in theory trigger a memory fault
  27 and 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
  37 The names of the signals are the ones listed out by C<kill -l> on your
  38 system, 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
  40 indexed 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
  50 So to check whether signal 17 and SIGALRM were the same, do just this:
  51
  52     print "signal #17 = $signame[17]\n";
  53     if ($signo{ALRM}) {
  54         print "SIGALRM is $signo{ALRM}\n";
  55     }
  56
  57 You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
  58 the handler, in which case Perl will try to discard the signal or do the
  59 default thing.  Some signals can be neither trapped nor ignored, such as
  60 the KILL and STOP (but not the TSTP) signals.  One strategy for
  61 temporarily ignoring signals is to use a local() statement, which will be
  62 automatically restored once your block is exited.  (Remember that local()
  63 values 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
  73 Sending a signal to a negative process ID means that you send the signal
  74 to the entire Unix process-group.  This code send a hang-up signal to all
  75 processes in the current process group I<except for> the current process
  76 itself:
  77
  78     {
  79         local $SIG{HUP} = 'IGNORE';
  80         kill HUP => -$$;
  81         # snazzy writing of: kill('HUP', -$$)
  82     }
  83
  84 Another interesting signal to send is signal number zero.  This doesn't
  85 actually affect another process, but instead checks whether it's alive
  86 or has changed its UID.
  87
  88     unless (kill 0 => $kid_pid) {
  89         warn "something wicked happened to $kid_pid";
  90     }
  91
  92 You might also want to employ anonymous functions for simple signal
  93 handlers:
  94
  95     $SIG{INT} = sub { die "\nOutta here!\n" };
  96
  97 But that will be problematic for the more complicated handlers that need
  98 to re-install themselves.  Because Perl's signal mechanism is currently
  99 based on the signal(3) function from the C library, you may sometimes be so
 100 misfortunate as to run on systems where that function is "broken", that
 101 is, it behaves in the old unreliable SysV way rather than the newer, more
 102 reasonable BSD and POSIX fashion.  So you'll see defensive people writing
 103 signal handlers like this:
 104
 105     sub REAPER {
 106         $waitedpid = wait;
 107         # loathe sysV: it makes us not only reinstate
 108         # the handler, but place it after the wait
 109         $SIG{CHLD} = \&REAPER;
 110     }
 111     $SIG{CHLD} = \&REAPER;
 112     # now do something that forks...
 113
 114 or even the more elaborate:
 115
 116     use POSIX ":sys_wait_h";
 117     sub REAPER {
 118         my $child;
 119         while ($child = waitpid(-1,WNOHANG)) {
 120             $Kid_Status{$child} = $?;
 121         }
 122         $SIG{CHLD} = \&REAPER;  # still loathe sysV
 123     }
 124     $SIG{CHLD} = \&REAPER;
 125     # do something that forks...
 126
 127 Signal handling is also used for timeouts in Unix,   While safely
 128 protected within an C<eval{}> block, you set a signal handler to trap
 129 alarm signals and then schedule to have one delivered to you in some
 130 number of seconds.  Then try your blocking operation, clearing the alarm
 131 when it's done but not before you've exited your C<eval{}> block.  If it
 132 goes off, you'll use die() to jump out of the block, much as you might
 133 using longjmp() or throw() in other languages.
 134
 135 Here'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
 145 For more complex signal handling, you might see the standard POSIX
 146 module.  Lamentably, this is almost entirely undocumented, but
 147 the F<t/lib/posix.t> file from the Perl source distribution has some
 148 examples in it.
 149
 150 =head1 Named Pipes
 151
 152 A named pipe (often referred to as a FIFO) is an old Unix IPC
 153 mechanism for processes communicating on the same machine.  It works
 154 just like a regular, connected anonymous pipes, except that the
 155 processes rendezvous using a filename and don't have to be related.
 156
 157 To create a named pipe, use the Unix command mknod(1) or on some
 158 systems, 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
 170 A fifo is convenient when you want to connect a process to an unrelated
 171 one.  When you open a fifo, the program will block until there's something
 172 on the other end.
 173
 174 For example, let's say you'd like to have your F<.signature> file be a
 175 named pipe that has a Perl program on the other end.  Now every time any
 176 program (like a mailer, news reader, finger program, etc.) tries to read
 177 from that file, the reading program will block and your program will
 178 supply the new signature.  We'll use the pipe-checking file test B<-p>
 179 to 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;
 196         sleep 2;    # to avoid dup signals
 197     }
 198
 199
 200 =head1 Using open() for IPC
 201
 202 Perl's basic open() statement can also be used for unidirectional interprocess
 203 communication by either appending or prepending a pipe symbol to the second
 204 argument to open().  Here's how to start something up in a child process you
 205 intend 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
 213 And 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     }
 221     close STATUS || die "bad netstat: $! $?";
 222
 223 If one can be sure that a particular program is a Perl script that is
 224 expecting filenames in @ARGV, the clever programmer can write something
 225 like this:
 226
 227     $ program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
 228
 229 and irrespective of which shell it's called from, the Perl program will
 230 read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
 231 in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
 232 file.  Pretty nifty, eh?
 233
 234 You might notice that you could use back-ticks for much the
 235 same effect as opening a pipe for reading:
 236
 237     print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
 238     die "bad netstat" if $?;
 239
 240 While this is true on the surface, it's much more efficient to process the
 241 file one line or record at a time because then you don't have to read the
 242 whole thing into memory at once. It also gives you finer control of the
 243 whole process, letting you to kill off the child process early if you'd
 244 like.
 245
 246 Be careful to check both the open() and the close() return values.  If
 247 you're I<writing> to a pipe, you should also trap SIGPIPE.  Otherwise,
 248 think of what happens when you start up a pipe to a command that doesn't
 249 exist: the open() will in all likelihood succeed (it only reflects the
 250 fork()'s success), but then your output will fail--spectacularly.  Perl
 251 can't know whether the command worked because your command is actually
 252 running in a separate process whose exec() might have failed.  Therefore,
 253 while readers of bogus commands return just a quick end of file, writers
 254 to bogus command will trigger a signal they'd better be prepared to
 255 handle.  Consider:
 256
 257     open(FH, "|bogus");
 258     print FH "bang\n";
 259     close FH;
 260
 261 =head2 Safe Pipe Opens
 262
 263 Another interesting approach to IPC is making your single program go
 264 multiprocess and communicate between (or even amongst) yourselves.  The
 265 open() function will accept a file argument of either C<"-|"> or C<"|-">
 266 to do a very interesting thing: it forks a child connected to the
 267 filehandle you've opened.  The child is running the same program as the
 268 parent.  This is useful for safely opening a file when running under an
 269 assumed UID or GID, for example.  If you open a pipe I<to> minus, you can
 270 write to the filehandle you opened and your kid will find it in his
 271 STDIN.  If you open a pipe I<from> minus, you can read from the filehandle
 272 you opened whatever your kid writes to his STDOUT.
 273
 274     use English;
 275     my $sleep_count = 0;
 276
 277     do {
 278         $pid = open(KID_TO_WRITE, "|-");
 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
 287         print KID_TO_WRITE @some_data;
 288         close(KID_TO_WRITE) || warn "kid exited $?";
 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
 299 Another common use for this construct is when you need to execute
 300 something without the shell's interference.  With system(), it's
 301 straightforward, but you can't use a pipe open or back-ticks safely.
 302 That's because there's no way to stop the shell from getting its hands on
 303 your arguments.   Instead, use lower-level control to call exec() directly.
 304
 305 Here's a safe back-tick or pipe open for read:
 306
 307     # add error processing as above
 308     $pid = open(KID_TO_READ, "-|");
 309
 310     if ($pid) {   # parent
 311         while (<KID_TO_READ>) {
 312             # do something interesting
 313         }
 314         close(KID_TO_READ) || warn "kid exited $?";
 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
 324 And here's a safe pipe open for writing:
 325
 326     # add error processing as above
 327     $pid = open(KID_TO_WRITE, "|-");
 328     $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
 329
 330     if ($pid) {  # parent
 331         for (@data) {
 332             print KID_TO_WRITE;
 333         }
 334         close(KID_TO_WRITE) || warn "kid exited $?";
 335
 336     } else {     # child
 337         ($EUID, $EGID) = ($UID, $GID);
 338         exec($program, @options, @args)
 339             || die "can't exec program: $!";
 340         # NOTREACHED
 341     }
 342
 343 Note that these operations are full Unix forks, which means they may not be
 344 correctly implemented on alien systems.  Additionally, these are not true
 345 multi-threading.  If you'd like to learn more about threading, see the
 346 F<modules> file mentioned below in the SEE ALSO section.
 347
 348 =head2 Bidirectional Communication
 349
 350 While this works reasonably well for unidirectional communication, what
 351 about bidirectional communication?  The obvious thing you'd like to do
 352 doesn't actually work:
 353
 354     open(PROG_FOR_READING_AND_WRITING, "| some program |")
 355
 356 and if you forget to use the B<-w> flag, then you'll miss out
 357 entirely on the diagnostic message:
 358
 359     Can't do bidirectional pipe at -e line 1.
 360
 361 If you really want to, you can use the standard open2() library function
 362 to catch both ends.  There's also an open3() for tri-directional I/O so you
 363 can also catch your child's STDERR, but doing so would then require an
 364 awkward select() loop and wouldn't allow you to use normal Perl input
 365 operations.
 366
 367 If you look at its source, you'll see that open2() uses low-level
 368 primitives like Unix pipe() and exec() to create all the connections.
 369 While it might have been slightly more efficient by using socketpair(), it
 370 would have then been even less portable than it already is.  The open2()
 371 and open3() functions are  unlikely to work anywhere except on a Unix
 372 system or some other one purporting to be POSIX compliant.
 373
 374 Here'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
 383 The problem with this is that Unix buffering is really going to
 384 ruin your day.  Even though your C<Writer> filehandle is auto-flushed,
 385 and the process on the other end will get your data in a timely manner,
 386 you can't usually do anything to force it to give it back to you
 387 in a similarly quick fashion.  In this case, we could, because we
 388 gave I<cat> a B<-u> flag to make it unbuffered.  But very few Unix
 389 commands are designed to operate over pipes, so this seldom works
 390 unless you yourself wrote the program on the other end of the
 391 double-ended pipe.
 392
 393 A solution to this is the non-standard F<Comm.pl> library.  It uses
 394 pseudo-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     }
 402
 403 This way you don't have to have control over the source code of the
 404 program you're using.  The F<Comm> library also has expect()
 405 and interact() functions.  Find the library (and we hope its
 406 successor F<IPC::Chat>) at your nearest CPAN archive as detailed
 407 in the SEE ALSO section below.
 408
 409 =head1 Sockets: Client/Server Communication
 410
 411 While not limited to Unix-derived operating systems (e.g., WinSock on PCs
 412 provides socket support, as do some VMS libraries), you may not have
 413 sockets on your system, in which case this section probably isn't going to do
 414 you much good.  With sockets, you can do both virtual circuits (i.e., TCP
 415 streams) and datagrams (i.e., UDP packets).  You may be able to do even more
 416 depending on your system.
 417
 418 The Perl function calls for dealing with sockets have the same names as
 419 the corresponding system calls in C, but their arguments tend to differ
 420 for two reasons: first, Perl filehandles work differently than C file
 421 descriptors.  Second, Perl already knows the length of its strings, so you
 422 don't need to pass that information.
 423
 424 One of the major problems with old socket code in Perl was that it used
 425 hard-coded values for some of the constants, which severely hurt
 426 portability.  If you ever see code that does anything like explicitly
 427 setting C<$AF_INET = 2>, you know you're in for big trouble:  An
 428 immeasurably superior approach is to use the C<Socket> module, which more
 429 reliably grants access to various constants and functions you'll need.
 430
 431 =head2 Internet TCP Clients and Servers
 432
 433 Use Internet-domain sockets when you want to do client-server
 434 communication that might extend to machines outside of your own system.
 435
 436 Here'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
 461 And here's a corresponding server to go along with it.  We'll
 462 leave the address as INADDR_ANY so that the kernel can choose
 463 the appropriate interface on multi-homed hosts.  If you want sit
 464 on a particular interface (like the external side of a gateway
 465 or firewall machine), you should fill this in with your real address
 466 instead.
 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');
 479     $port = $1 if $port =~ /(\d+)/; # untaint port number
 480
 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
 501         print Client "Hello there, $name, it's now ",
 502                         scalar localtime, "\n";
 503     }
 504
 505 And here's a multi-threaded version.  It's multi-threaded in that
 506 like most typical servers, it spawns (forks) a slave server to
 507 handle the client request so that the master server can quickly
 508 go back to service a new client.
 509
 510     #!/usr/bin/perl -Tw
 511     require 5.002;
 512     use strict;
 513     BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
 514     use Socket;
 515     use Carp;
 516
 517     sub spawn;  # forward declaration
 518     sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
 519
 520     my $port = shift || 2345;
 521     my $proto = getprotobyname('tcp');
 522     $port = $1 if $port =~ /(\d+)/; # untaint port number
 523
 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: $!";
 529
 530     logmsg "server started on port $port";
 531
 532     my $waitedpid = 0;
 533     my $paddr;
 534
 535     sub REAPER {
 536         $waitedpid = wait;
 537         $SIG{CHLD} = \&REAPER;  # loathe sysV
 538         logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
 539     }
 540
 541     $SIG{CHLD} = \&REAPER;
 542
 543     for ( $waitedpid = 0;
 544           ($paddr = accept(Client,Server)) || $waitedpid;
 545           $waitedpid = 0, close Client)
 546     {
 547         next if $waitedpid and not $paddr;
 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";
 554
 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         };
 560
 561     }
 562
 563     sub spawn {
 564         my $coderef = shift;
 565
 566         unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
 567             confess "usage: spawn CODEREF";
 568         }
 569
 570         my $pid;
 571         if (!defined($pid = fork)) {
 572             logmsg "cannot fork: $!";
 573             return;
 574         } elsif ($pid) {
 575             logmsg "begat $pid";
 576             return; # I'm the parent
 577         }
 578         # else I'm the child -- go spawn
 579
 580         open(STDIN,  "<&Client")   || die "can't dup client to stdin";
 581         open(STDOUT, ">&Client")   || die "can't dup client to stdout";
 582         ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
 583         exit &$coderef();
 584     }
 585
 586 This server takes the trouble to clone off a child version via fork() for
 587 each incoming request.  That way it can handle many requests at once,
 588 which you might not always want.  Even if you don't fork(), the listen()
 589 will allow that many pending connections.  Forking servers have to be
 590 particularly careful about cleaning up their dead children (called
 591 "zombies" in Unix parlance), because otherwise you'll quickly fill up your
 592 process table.
 593
 594 We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
 595 even if we aren't running setuid or setgid.  This is always a good idea
 596 for servers and other programs run on behalf of someone else (like CGI
 597 scripts), because it lessens the chances that people from the outside will
 598 be able to compromise your system.
 599
 600 Let's look at another TCP client.  This one connects to the TCP "time"
 601 service on a number of different machines and shows how far their clocks
 602 differ 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);
 632     }
 633
 634 =head2 Unix-Domain TCP Clients and Servers
 635
 636 That's fine for Internet-domain clients and servers, but what about local
 637 communications?  While you can use the same setup, sometimes you don't
 638 want to.  Unix-domain sockets are local to the current host, and are often
 639 used internally to implement pipes.  Unlike Internet domain sockets, UNIX
 640 domain 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
 644
 645 You 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
 651 Here'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: $!";
 661     connect(SOCK, sockaddr_un($remote))         || die "connect: $!";
 662     while ($line = <SOCK>) {
 663         print $line;
 664     }
 665     exit;
 666
 667 And 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
 681     socket(Server,PF_UNIX,SOCK_STREAM,0)        || die "socket: $!";
 682     unlink($NAME);
 683     bind  (Server, $uaddr)                      || die "bind: $!";
 684     listen(Server,SOMAXCONN)                    || die "listen: $!";
 685
 686     logmsg "server started on $NAME";
 687
 688     $SIG{CHLD} = \&REAPER;
 689
 690     for ( $waitedpid = 0;
 691           accept(Client,Server) || $waitedpid;
 692           $waitedpid = 0, close Client)
 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
 702 As you see, it's remarkably similar to the Internet domain TCP server, so
 703 much so, in fact, that we've omitted several duplicate functions--spawn(),
 704 logmsg(), ctime(), and REAPER()--which are exactly the same as in the
 705 other server.
 706
 707 So why would you ever want to use a Unix domain socket instead of a
 708 simpler named pipe?  Because a named pipe doesn't give you sessions.  You
 709 can't tell one process's data from another's.  With socket programming,
 710 you get a separate session for each client: that's why accept() takes two
 711 arguments.
 712
 713 For example, let's say that you have a long running database server daemon
 714 that you want folks from the World Wide Web to be able to access, but only
 715 if they go through a CGI interface.  You'd have a small, simple CGI
 716 program that does whatever checks and logging you feel like, and then acts
 717 as a Unix-domain client and connects to your private server.
 718
 719 =head2 UDP: Message Passing
 720
 721 Another kind of client-server setup is one that uses not connections, but
 722 messages.  UDP communications involve much lower overhead but also provide
 723 less reliability, as there are no promises that messages will arrive at
 724 all, let alone in order and unmangled.  Still, UDP offers some advantages
 725 over TCP, including being able to "broadcast" or "multicast" to a whole
 726 bunch of destination hosts at once (usually on your local subnet).  If you
 727 find yourself overly concerned about reliability and start building checks
 728 into your message system, then you probably should use just TCP to start
 729 with.
 730
 731 Here's a UDP program similar to the sample Internet TCP client given
 732 above.  However, instead of checking one host at a time, the UDP version
 733 will check many of them asynchronously by simulating a multicast and then
 734 using select() to do a timed-out wait for I/O.  To do something similar
 735 with 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
 784 While System V IPC isn't so widely used as sockets, it still has some
 785 interesting uses.  You can't, however, effectively use SysV IPC or
 786 Berkeley mmap() to have shared memory so as to share a variable amongst
 787 several processes.  That's because Perl would reallocate your string when
 788 you weren't wanting it to.
 789
 790
 791 Here's a small example showing shared memory usage.
 792
 793     $IPC_PRIVATE = 0;
 794     $IPC_RMID = 0;
 795     $size = 2000;
 796     $key = shmget($IPC_PRIVATE, $size , 0777 );
 797     die unless defined $key;
 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
 808 Here'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
 817 Put this code in a separate file to be run in more than one process.
 818 Call 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
 841 Put this code in a separate file to be run in more than one process.
 842 Call this file F<give>:
 843
 844     # 'give' the semaphore
 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
 861 =head1 WARNING
 862
 863 The SysV IPC code above was written long ago, and it's definitely clunky
 864 looking.  It should at the very least be made to C<use strict> and
 865 C<require "sys/ipc.ph">.  Better yet, perhaps someone should create an
 866 C<IPC::SysV> module the way we have the C<Socket> module for normal
 867 client-server communications.
 868
 869 (... time passes)
 870
 871 Voila!  Check out the IPC::SysV modules written by Jack Shirazi.  You can
 872 find them at a CPAN store near you.
 873
 874 =head1 NOTES
 875
 876 If you are running under version 5.000 (dubious) or 5.001, you can still
 877 use most of the examples in this document.  You may have to remove the
 878 C<use strict> and some of the my() statements for 5.000, and for both
 879 you'll have to load in version 1.2 or older of the F<Socket.pm> module, which
 880 is included in I<perl5.002>.
 881
 882 Most of these routines quietly but politely return C<undef> when they fail
 883 instead of causing your program to die right then and there due to an
 884 uncaught exception.  (Actually, some of the new I<Socket> conversion
 885 functions  croak() on bad arguments.)  It is therefore essential
 886 that you should check the return values of these functions.  Always begin
 887 your socket programs this way for optimal success, and don't forget to add
 888 B<-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
 898 All these routines create system-specific portability problems.  As noted
 899 elsewhere, Perl is at the mercy of your C libraries for much of its system
 900 behaviour.  It's probably safest to assume broken SysV semantics for
 901 signals and to stick with simple TCP and UDP socket operations; e.g., don't
 902 try to pass open file descriptors over a local UDP datagram socket if you
 903 want your code to stand a chance of being portable.
 904
 905 Because few vendors provide C libraries that are safely
 906 re-entrant, the prudent programmer will do little else within
 907 a handler beyond die() to raise an exception and longjmp(3) out.
 908
 909 =head1 AUTHOR
 910
 911 Tom Christiansen, with occasional vestiges of Larry Wall's original
 912 version.
 913
 914 =head1 SEE ALSO
 915
 916 Besides the obvious functions in L<perlfunc>, you should also check out
 917 the F<modules> file at your nearest CPAN site.  (See L<perlmod> or best
 918 yet, the F<Perl FAQ> for a description of what CPAN is and where to get it.)
 919 Section 5 of the F<modules> file is devoted to "Networking, Device Control
 920 (modems), and Interprocess Communication", and contains numerous unbundled
 921 modules numerous networking modules, Chat and Expect operations, CGI
 922 programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
 923 Threads, and ToolTalk--just to name a few.