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, just do 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         $SIG{CHLD} = \&REAPER;  # loathe sysV
 107         $waitedpid = wait;
 108     }
 109     $SIG{CHLD} = \&REAPER;
 110     # now do something that forks...
 111
 112 or even the more elaborate:
 113
 114     use POSIX ":wait_h";
 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
 125 Signal handling is also used for timeouts in Unix,   While safely
 126 protected within an C<eval{}> block, you set a signal handler to trap
 127 alarm signals and then schedule to have one delivered to you in some
 128 number of seconds.  Then try your blocking operation, clearing the alarm
 129 when it's done but not before you've exited your C<eval{}> block.  If it
 130 goes off, you'll use die() to jump out of the block, much as you might
 131 using longjmp() or throw() in other languages.
 132
 133 Here'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
 143 For more complex signal handling, you might see the standard POSIX
 144 module.  Lamentably, this is almost entirely undocumented, but
 145 the F<t/lib/posix.t> file from the Perl source distribution has some
 146 examples in it.
 147
 148 =head1 Named Pipes
 149
 150 A named pipe (often referred to as a FIFO) is an old Unix IPC
 151 mechanism for processes communicating on the same machine.  It works
 152 just like a regular, connected anonymous pipes, except that the
 153 processes rendezvous using a filename and don't have to be related.
 154
 155 To create a named pipe, use the Unix command mknod(1) or on some
 156 systems, 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
 168 A fifo is convenient when you want to connect a process to an unrelated
 169 one.  When you open a fifo, the program will block until there's something
 170 on the other end.
 171
 172 For example, let's say you'd like to have your F<.signature> file be a
 173 named pipe that has a Perl program on the other end.  Now every time any
 174 program (like a mailer, newsreader, finger program, etc.) tries to read
 175 from that file, the reading program will block and your program will
 176 supply the the new signature.  We'll use the pipe-checking file test B<-p>
 177 to 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     }
 196
 197
 198 =head1 Using open() for IPC
 199
 200 Perl's basic open() statement can also be used for unidirectional interprocess
 201 communication by either appending or prepending a pipe symbol to the second
 202 argument to open().  Here's how to start something up in a child process you
 203 intend 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
 211 And 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     }
 219     close STATUS || die "bad netstat: $! $?";
 220
 221 If one can be sure that a particular program is a Perl script that is
 222 expecting filenames in @ARGV, the clever programmer can write something
 223 like this:
 224
 225     $ program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
 226
 227 and irrespective of which shell it's called from, the Perl program will
 228 read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
 229 in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
 230 file.  Pretty nifty, eh?
 231
 232 You might notice that you could use backticks for much the
 233 same effect as opening a pipe for reading:
 234
 235     print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
 236     die "bad netstat" if $?;
 237
 238 While this is true on the surface, it's much more efficient to process the
 239 file one line or record at a time because then you don't have to read the
 240 whole thing into memory at once. It also gives you finer control of the
 241 whole process, letting you to kill off the child process early if you'd
 242 like.
 243
 244 Be careful to check both the open() and the close() return values.  If
 245 you're I<writing> to a pipe, you should also trap SIGPIPE.  Otherwise,
 246 think of what happens when you start up a pipe to a command that doesn't
 247 exist: the open() will in all likelihood succeed (it only reflects the
 248 fork()'s success), but then your output will fail--spectacularly.  Perl
 249 can't know whether the command worked because your command is actually
 250 running in a separate process whose exec() might have failed.  Therefore,
 251 while readers of bogus commands just return a quick end of file, writers
 252 to bogus command will trigger a signal they'd better be prepared to
 253 handle.  Consider:
 254
 255     open(FH, "|bogus");
 256     print FH "bang\n";
 257     close FH;
 258
 259 =head2 Safe Pipe Opens
 260
 261 Another interesting approach to IPC is making your single program go
 262 multiprocess and communicate between (or even amongst) yourselves.  The
 263 open() function will accept a file argument of either C<"-|"> or C<"|-">
 264 to do a very interesting thing: it forks a child connected to the
 265 filehandle you've opened.  The child is running the same program as the
 266 parent.  This is useful for safely opening a file when running under an
 267 assumed UID or GID, for example.  If you open a pipe I<to> minus, you can
 268 write to the filehandle you opened and your kid will find it in his
 269 STDIN.  If you open a pipe I<from> minus, you can read from the filehandle
 270 you opened whatever your kid writes to his STDOUT.
 271
 272     use English;
 273     my $sleep_count = 0;
 274
 275     do {
 276         $pid = open(KID_TO_WRITE, "|-");
 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
 285         print KID_TO_WRITE @some_data;
 286         close(KID_TO_WRITE) || warn "kid exited $?";
 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
 297 Another common use for this construct is when you need to execute
 298 something without the shell's interference.  With system(), it's
 299 straightforward, but you can't use a pipe open or backticks safely.
 300 That's because there's no way to stop the shell from getting its hands on
 301 your arguments.   Instead, use lower-level control to call exec() directly.
 302
 303 Here's a safe backtick or pipe open for read:
 304
 305     # add error processing as above
 306     $pid = open(KID_TO_READ, "-|");
 307
 308     if ($pid) {   # parent
 309         while (<KID_TO_READ>) {
 310             # do something interesting
 311         }
 312         close(KID_TO_READ) || warn "kid exited $?";
 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
 322 And here's a safe pipe open for writing:
 323
 324     # add error processing as above
 325     $pid = open(KID_TO_WRITE, "|-");
 326     $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
 327
 328     if ($pid) {  # parent
 329         for (@data) {
 330             print KID_TO_WRITE;
 331         }
 332         close(KID_TO_WRITE) || warn "kid exited $?";
 333
 334     } else {     # child
 335         ($EUID, $EGID) = ($UID, $GID);
 336         exec($program, @options, @args)
 337             || die "can't exec program: $!";
 338         # NOTREACHED
 339     }
 340
 341 Note that these operations are full Unix forks, which means they may not be
 342 correctly implemented on alien systems.  Additionally, these are not true
 343 multithreading.  If you'd like to learn more about threading, see the
 344 F<modules> file mentioned below in the SEE ALSO section.
 345
 346 =head2 Bidirectional Communication
 347
 348 While this works reasonably well for unidirectional communication, what
 349 about bidirectional communication?  The obvious thing you'd like to do
 350 doesn't actually work:
 351
 352     open(PROG_FOR_READING_AND_WRITING, "| some program |")
 353
 354 and if you forget to use the B<-w> flag, then you'll miss out
 355 entirely on the diagnostic message:
 356
 357     Can't do bidirectional pipe at -e line 1.
 358
 359 If you really want to, you can use the standard open2() library function
 360 to catch both ends.  There's also an open3() for tridirectional I/O so you
 361 can also catch your child's STDERR, but doing so would then require an
 362 awkward select() loop and wouldn't allow you to use normal Perl input
 363 operations.
 364
 365 If you look at its source, you'll see that open2() uses low-level
 366 primitives like Unix pipe() and exec() to create all the connections.
 367 While it might have been slightly more efficient by using socketpair(), it
 368 would have then been even less portable than it already is.  The open2()
 369 and open3() functions are  unlikely to work anywhere except on a Unix
 370 system or some other one purporting to be POSIX compliant.
 371
 372 Here'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
 381 The problem with this is that Unix buffering is going to really
 382 ruin your day.  Even though your C<Writer> filehandle is autoflushed,
 383 and the process on the other end will get your data in a timely manner,
 384 you can't usually do anything to force it to actually give it back to you
 385 in a similarly quick fashion.  In this case, we could, because we
 386 gave I<cat> a B<-u> flag to make it unbuffered.  But very few Unix
 387 commands are designed to operate over pipes, so this seldom works
 388 unless you yourself wrote the program on the other end of the
 389 double-ended pipe.
 390
 391 A solution to this is the non-standard F<Comm.pl> library.  It uses
 392 pseudo-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     }
 400
 401 This way you don't have to have control over the source code of the
 402 program you're using.  The F<Comm> library also has expect()
 403 and interact() functions.  Find the library (and hopefully its
 404 successor F<IPC::Chat>) at your nearest CPAN archive as detailed
 405 in the SEE ALSO section below.
 406
 407 =head1 Sockets: Client/Server Communication
 408
 409 While not limited to Unix-derived operating systems (e.g. WinSock on PCs
 410 provides socket support, as do some VMS libraries), you may not have
 411 sockets on your system, in which case this section probably isn't going to do
 412 you much good.  With sockets, you can do both virtual circuits (i.e. TCP
 413 streams) and datagrams (i.e. UDP packets).  You may be able to do even more
 414 depending on your system.
 415
 416 The Perl function calls for dealing with sockets have the same names as
 417 the corresponding system calls in C, but their arguments tend to differ
 418 for two reasons: first, Perl filehandles work differently than C file
 419 descriptors.  Second, Perl already knows the length of its strings, so you
 420 don't need to pass that information.
 421
 422 One of the major problems with old socket code in Perl was that it used
 423 hard-coded values for some of the constants, which severely hurt
 424 portability.  If you ever see code that does anything like explicitly
 425 setting C<$AF_INET = 2>, you know you're in for big trouble:  An
 426 immeasurably superior approach is to use the C<Socket> module, which more
 427 reliably grants access to various constants and functions you'll need.
 428
 429 =head2 Internet TCP Clients and Servers
 430
 431 Use Internet-domain sockets when you want to do client-server
 432 communication that might extend to machines outside of your own system.
 433
 434 Here'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
 459 And here's a corresponding server to go along with it.  We'll
 460 leave the address as INADDR_ANY so that the kernel can choose
 461 the appropriate interface on multihomed hosts.  If you want sit
 462 on a particular interface (like the external side of a gateway
 463 or firewall machine), you should fill this in with your real address
 464 instead.
 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
 497         print Client "Hello there, $name, it's now ",
 498                         scalar localtime, "\n";
 499     }
 500
 501 And here's a multithreaded version.  It's multithreaded in that
 502 like most typical servers, it spawns (forks) a slave server to
 503 handle the client request so that the master server can quickly
 504 go back to service a new client.
 505
 506     #!/usr/bin/perl -Tw
 507     require 5.002;
 508     use strict;
 509     BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
 510     use Socket;
 511     use Carp;
 512
 513     sub spawn;  # forward declaration
 514     sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
 515
 516     my $port = shift || 2345;
 517     my $proto = getprotobyname('tcp');
 518     $port = $1 if $port =~ /(\d+)/; # untaint port number
 519
 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: $!";
 525
 526     logmsg "server started on port $port";
 527
 528     my $waitedpid = 0;
 529     my $paddr;
 530
 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;
 540           ($paddr = accept(Client,Server)) || $waitedpid;
 541           $waitedpid = 0, close Client)
 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";
 550
 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         };
 556
 557     }
 558
 559     sub spawn {
 560         my $coderef = shift;
 561
 562         unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
 563             confess "usage: spawn CODEREF";
 564         }
 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
 576         open(STDIN,  "<&Client")   || die "can't dup client to stdin";
 577         open(STDOUT, ">&Client")   || die "can't dup client to stdout";
 578         ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
 579         exit &$coderef();
 580     }
 581
 582 This server takes the trouble to clone off a child version via fork() for
 583 each incoming request.  That way it can handle many requests at once,
 584 which you might not always want.  Even if you don't fork(), the listen()
 585 will allow that many pending connections.  Forking servers have to be
 586 particularly careful about cleaning up their dead children (called
 587 "zombies" in Unix parlance), because otherwise you'll quickly fill up your
 588 process table.
 589
 590 We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
 591 even if we aren't running setuid or setgid.  This is always a good idea
 592 for servers and other programs run on behalf of someone else (like CGI
 593 scripts), because it lessens the chances that people from the outside will
 594 be able to compromise your system.
 595
 596 Let's look at another TCP client.  This one connects to the TCP "time"
 597 service on a number of different machines and shows how far their clocks
 598 differ 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);
 628     }
 629
 630 =head2 Unix-Domain TCP Clients and Servers
 631
 632 That's fine for Internet-domain clients and servers, but what about local
 633 communications?  While you can use the same setup, sometimes you don't
 634 want to.  Unix-domain sockets are local to the current host, and are often
 635 used internally to implement pipes.  Unlike Internet domain sockets, UNIX
 636 domain 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
 640
 641 You 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
 647 Here'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
 663 And 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
 677     socket(Server,PF_UNIX,SOCK_STREAM,0)        || die "socket: $!";
 678     unlink($NAME);
 679     bind  (Server, $uaddr)                      || die "bind: $!";
 680     listen(Server,SOMAXCONN)                    || die "listen: $!";
 681
 682     logmsg "server started on $NAME";
 683
 684     $SIG{CHLD} = \&REAPER;
 685
 686     for ( $waitedpid = 0;
 687           accept(Client,Server) || $waitedpid;
 688           $waitedpid = 0, close Client)
 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
 698 As you see, it's remarkably similar to the Internet domain TCP server, so
 699 much so, in fact, that we've omitted several duplicate functions--spawn(),
 700 logmsg(), ctime(), and REAPER()--which are exactly the same as in the
 701 other server.
 702
 703 So why would you ever want to use a Unix domain socket instead of a
 704 simpler named pipe?  Because a named pipe doesn't give you sessions.  You
 705 can't tell one process's data from another's.  With socket programming,
 706 you get a separate session for each client: that's why accept() takes two
 707 arguments.
 708
 709 For example, let's say that you have a long running database server daemon
 710 that you want folks from the World Wide Web to be able to access, but only
 711 if they go through a CGI interface.  You'd have a small, simple CGI
 712 program that does whatever checks and logging you feel like, and then acts
 713 as a Unix-domain client and connects to your private server.
 714
 715 =head2 UDP: Message Passing
 716
 717 Another kind of client-server setup is one that uses not connections, but
 718 messages.  UDP communications involve much lower overhead but also provide
 719 less reliability, as there are no promises that messages will arrive at
 720 all, let alone in order and unmangled.  Still, UDP offers some advantages
 721 over TCP, including being able to "broadcast" or "multicast" to a whole
 722 bunch of destination hosts at once (usually on your local subnet).  If you
 723 find yourself overly concerned about reliability and start building checks
 724 into your message system, then you probably should just use TCP to start
 725 with.
 726
 727 Here's a UDP program similar to the sample Internet TCP client given
 728 above.  However, instead of checking one host at a time, the UDP version
 729 will check many of them asynchronously by simulating a multicast and then
 730 using select() to do a timed-out wait for I/O.  To do something similar
 731 with 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
 780 While System V IPC isn't so widely used as sockets, it still has some
 781 interesting uses.  You can't, however, effectively use SysV IPC or
 782 Berkeley mmap() to have shared memory so as to share a variable amongst
 783 several processes.  That's because Perl would reallocate your string when
 784 you weren't wanting it to.
 785
 786
 787 Here's a small example showing shared memory usage.
 788
 789     $IPC_PRIVATE = 0;
 790     $IPC_RMID = 0;
 791     $size = 2000;
 792     $key = shmget($IPC_PRIVATE, $size , 0777 );
 793     die unless defined $key;
 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
 804 Here'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
 813 Put this code in a separate file to be run in more than one process.
 814 Call 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
 837 Put this code in a separate file to be run in more than one process.
 838 Call this file F<give>:
 839
 840     # 'give' the semaphore
 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
 857 =head1 WARNING
 858
 859 The SysV IPC code above was written long ago, and it's definitely clunky
 860 looking.  It should at the very least be made to C<use strict> and
 861 C<require "sys/ipc.ph">.  Better yet, perhaps someone should create an
 862 C<IPC::SysV> module the way we have the C<Socket> module for normal
 863 client-server communications.
 864
 865 (... time passes)
 866
 867 Voila!  Check out the IPC::SysV modules written by Jack Shirazi.  You can
 868 find them at a CPAN store near you.
 869
 870 =head1 NOTES
 871
 872 If you are running under version 5.000 (dubious) or 5.001, you can still
 873 use most of the examples in this document.  You may have to remove the
 874 C<use strict> and some of the my() statements for 5.000, and for both
 875 you'll have to load in version 1.2 or older of the F<Socket.pm> module, which
 876 is included in I<perl5.002>.
 877
 878 Most of these routines quietly but politely return C<undef> when they fail
 879 instead of causing your program to die right then and there due to an
 880 uncaught exception.  (Actually, some of the new I<Socket> conversion
 881 functions  croak() on bad arguments.)  It is therefore essential
 882 that you should check the return values of these functions.  Always begin
 883 your socket programs this way for optimal success, and don't forget to add
 884 B<-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
 894 All these routines create system-specific portability problems.  As noted
 895 elsewhere, Perl is at the mercy of your C libraries for much of its system
 896 behaviour.  It's probably safest to assume broken SysV semantics for
 897 signals and to stick with simple TCP and UDP socket operations; e.g. don't
 898 try to pass open file descriptors over a local UDP datagram socket if you
 899 want your code to stand a chance of being portable.
 900
 901 Because few vendors provide C libraries that are safely
 902 re-entrant, the prudent programmer will do little else within
 903 a handler beyond die() to raise an exception and longjmp(3) out.
 904
 905 =head1 AUTHOR
 906
 907 Tom Christiansen, with occasional vestiges of Larry Wall's original
 908 version.
 909
 910 =head1 SEE ALSO
 911
 912 Besides the obvious functions in L<perlfunc>, you should also check out
 913 the F<modules> file at your nearest CPAN site.  (See L<perlmod> or best
 914 yet, the F<Perl FAQ> for a description of what CPAN is and where to get it.)
 915 Section 5 of the F<modules> file is devoted to "Networking, Device Control
 916 (modems) and Interprocess Communication", and contains numerous unbundled
 917 modules numerous networking modules, Chat and Expect operations, CGI
 918 programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
 919 Threads, and ToolTalk--just to name a few.