pod/perlipc.pod

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