[Summary view] [Print] [Text view]

   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
  14  or references of user-installed signal handlers.  These handlers will
  15  be called with an argument which is the name of the signal that
  16  triggered it.  A signal may be generated intentionally from a
  17  particular keyboard sequence like control-C or control-Z, sent to you
  18  from another process, or triggered automatically by the kernel when
  19  special events transpire, like a child process exiting, your process
  20  running out of stack space, or hitting file size limit.
  21  
  22  For example, to trap an interrupt signal, set up a handler like this:
  23  
  24      sub catch_zap {
  25      my $signame = shift;
  26      $shucks++;
  27      die "Somebody sent me a SIG$signame";
  28      }
  29      $SIG{INT} = 'catch_zap';  # could fail in modules
  30      $SIG{INT} = \&catch_zap;  # best strategy
  31  
  32  Prior to Perl 5.7.3 it was necessary to do as little as you possibly
  33  could in your handler; notice how all we do is set a global variable
  34  and then raise an exception.  That's because on most systems,
  35  libraries are not re-entrant; particularly, memory allocation and I/O
  36  routines are not.  That meant that doing nearly I<anything> in your
  37  handler could in theory trigger a memory fault and subsequent core
  38  dump - see L</Deferred Signals (Safe Signals)> below.
  39  
  40  The names of the signals are the ones listed out by C<kill -l> on your
  41  system, or you can retrieve them from the Config module.  Set up an
  42  @signame list indexed by number to get the name and a %signo table
  43  indexed by name to get the number:
  44  
  45      use Config;
  46      defined $Config{sig_name} || die "No sigs?";
  47      foreach $name (split(' ', $Config{sig_name})) {
  48      $signo{$name} = $i;
  49      $signame[$i] = $name;
  50      $i++;
  51      }
  52  
  53  So to check whether signal 17 and SIGALRM were the same, do just this:
  54  
  55      print "signal #17 = $signame[17]\n";
  56      if ($signo{ALRM}) {
  57      print "SIGALRM is $signo{ALRM}\n";
  58      }
  59  
  60  You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
  61  the handler, in which case Perl will try to discard the signal or do the
  62  default thing.
  63  
  64  On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
  65  has special behavior with respect to a value of C<'IGNORE'>.
  66  Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
  67  not creating zombie processes when the parent process fails to C<wait()>
  68  on its child processes (i.e. child processes are automatically reaped).
  69  Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
  70  C<-1> on such platforms.
  71  
  72  Some signals can be neither trapped nor ignored, such as
  73  the KILL and STOP (but not the TSTP) signals.  One strategy for
  74  temporarily ignoring signals is to use a local() statement, which will be
  75  automatically restored once your block is exited.  (Remember that local()
  76  values are "inherited" by functions called from within that block.)
  77  
  78      sub precious {
  79      local $SIG{INT} = 'IGNORE';
  80      &more_functions;
  81      }
  82      sub more_functions {
  83      # interrupts still ignored, for now...
  84      }
  85  
  86  Sending a signal to a negative process ID means that you send the signal
  87  to the entire Unix process-group.  This code sends a hang-up signal to all
  88  processes in the current process group (and sets $SIG{HUP} to IGNORE so
  89  it doesn't kill itself):
  90  
  91      {
  92      local $SIG{HUP} = 'IGNORE';
  93      kill HUP => -$$;
  94      # snazzy writing of: kill('HUP', -$$)
  95      }
  96  
  97  Another interesting signal to send is signal number zero.  This doesn't
  98  actually affect a child process, but instead checks whether it's alive
  99  or has changed its UID.
 100  
 101      unless (kill 0 => $kid_pid) {
 102      warn "something wicked happened to $kid_pid";
 103      }
 104  
 105  When directed at a process whose UID is not identical to that
 106  of the sending process, signal number zero may fail because
 107  you lack permission to send the signal, even though the process is alive.
 108  You may be able to determine the cause of failure using C<%!>.
 109  
 110      unless (kill 0 => $pid or $!{EPERM}) {
 111      warn "$pid looks dead";
 112      }
 113  
 114  You might also want to employ anonymous functions for simple signal
 115  handlers:
 116  
 117      $SIG{INT} = sub { die "\nOutta here!\n" };
 118  
 119  But that will be problematic for the more complicated handlers that need
 120  to reinstall themselves.  Because Perl's signal mechanism is currently
 121  based on the signal(3) function from the C library, you may sometimes be so
 122  unfortunate as to run on systems where that function is "broken", that
 123  is, it behaves in the old unreliable SysV way rather than the newer, more
 124  reasonable BSD and POSIX fashion.  So you'll see defensive people writing
 125  signal handlers like this:
 126  
 127      sub REAPER {
 128      $waitedpid = wait;
 129      # loathe sysV: it makes us not only reinstate
 130      # the handler, but place it after the wait
 131      $SIG{CHLD} = \&REAPER;
 132      }
 133      $SIG{CHLD} = \&REAPER;
 134      # now do something that forks...
 135  
 136  or better still:
 137  
 138      use POSIX ":sys_wait_h";
 139      sub REAPER {
 140      my $child;
 141      # If a second child dies while in the signal handler caused by the
 142      # first death, we won't get another signal. So must loop here else
 143      # we will leave the unreaped child as a zombie. And the next time
 144      # two children die we get another zombie. And so on.
 145          while (($child = waitpid(-1,WNOHANG)) > 0) {
 146          $Kid_Status{$child} = $?;
 147      }
 148      $SIG{CHLD} = \&REAPER;  # still loathe sysV
 149      }
 150      $SIG{CHLD} = \&REAPER;
 151      # do something that forks...
 152  
 153  Signal handling is also used for timeouts in Unix,   While safely
 154  protected within an C<eval{}> block, you set a signal handler to trap
 155  alarm signals and then schedule to have one delivered to you in some
 156  number of seconds.  Then try your blocking operation, clearing the alarm
 157  when it's done but not before you've exited your C<eval{}> block.  If it
 158  goes off, you'll use die() to jump out of the block, much as you might
 159  using longjmp() or throw() in other languages.
 160  
 161  Here's an example:
 162  
 163      eval {
 164          local $SIG{ALRM} = sub { die "alarm clock restart" };
 165          alarm 10;
 166          flock(FH, 2);   # blocking write lock
 167          alarm 0;
 168      };
 169      if ($@ and $@ !~ /alarm clock restart/) { die }
 170  
 171  If the operation being timed out is system() or qx(), this technique
 172  is liable to generate zombies.    If this matters to you, you'll
 173  need to do your own fork() and exec(), and kill the errant child process.
 174  
 175  For more complex signal handling, you might see the standard POSIX
 176  module.  Lamentably, this is almost entirely undocumented, but
 177  the F<t/lib/posix.t> file from the Perl source distribution has some
 178  examples in it.
 179  
 180  =head2 Handling the SIGHUP Signal in Daemons
 181  
 182  A process that usually starts when the system boots and shuts down
 183  when the system is shut down is called a daemon (Disk And Execution
 184  MONitor). If a daemon process has a configuration file which is
 185  modified after the process has been started, there should be a way to
 186  tell that process to re-read its configuration file, without stopping
 187  the process. Many daemons provide this mechanism using the C<SIGHUP>
 188  signal handler. When you want to tell the daemon to re-read the file
 189  you simply send it the C<SIGHUP> signal.
 190  
 191  Not all platforms automatically reinstall their (native) signal
 192  handlers after a signal delivery.  This means that the handler works
 193  only the first time the signal is sent. The solution to this problem
 194  is to use C<POSIX> signal handlers if available, their behaviour
 195  is well-defined.
 196  
 197  The following example implements a simple daemon, which restarts
 198  itself every time the C<SIGHUP> signal is received. The actual code is
 199  located in the subroutine C<code()>, which simply prints some debug
 200  info to show that it works and should be replaced with the real code.
 201  
 202    #!/usr/bin/perl -w
 203  
 204    use POSIX ();
 205    use FindBin ();
 206    use File::Basename ();
 207    use File::Spec::Functions;
 208  
 209    $|=1;
 210  
 211    # make the daemon cross-platform, so exec always calls the script
 212    # itself with the right path, no matter how the script was invoked.
 213    my $script = File::Basename::basename($0);
 214    my $SELF = catfile $FindBin::Bin, $script;
 215  
 216    # POSIX unmasks the sigprocmask properly
 217    my $sigset = POSIX::SigSet->new();
 218    my $action = POSIX::SigAction->new('sigHUP_handler',
 219                                       $sigset,
 220                                       &POSIX::SA_NODEFER);
 221    POSIX::sigaction(&POSIX::SIGHUP, $action);
 222  
 223    sub sigHUP_handler {
 224        print "got SIGHUP\n";
 225        exec($SELF, @ARGV) or die "Couldn't restart: $!\n";
 226    }
 227  
 228    code();
 229  
 230    sub code {
 231        print "PID: $$\n";
 232        print "ARGV: @ARGV\n";
 233        my $c = 0;
 234        while (++$c) {
 235            sleep 2;
 236            print "$c\n";
 237        }
 238    }
 239    __END__
 240  
 241  
 242  =head1 Named Pipes
 243  
 244  A named pipe (often referred to as a FIFO) is an old Unix IPC
 245  mechanism for processes communicating on the same machine.  It works
 246  just like a regular, connected anonymous pipes, except that the
 247  processes rendezvous using a filename and don't have to be related.
 248  
 249  To create a named pipe, use the C<POSIX::mkfifo()> function.
 250  
 251      use POSIX qw(mkfifo);
 252      mkfifo($path, 0700) or die "mkfifo $path failed: $!";
 253  
 254  You can also use the Unix command mknod(1) or on some
 255  systems, mkfifo(1).  These may not be in your normal path.
 256  
 257      # system return val is backwards, so && not ||
 258      #
 259      $ENV{PATH} .= ":/etc:/usr/etc";
 260      if  (      system('mknod',  $path, 'p')
 261          && system('mkfifo', $path) )
 262      {
 263      die "mk{nod,fifo} $path failed";
 264      }
 265  
 266  
 267  A fifo is convenient when you want to connect a process to an unrelated
 268  one.  When you open a fifo, the program will block until there's something
 269  on the other end.
 270  
 271  For example, let's say you'd like to have your F<.signature> file be a
 272  named pipe that has a Perl program on the other end.  Now every time any
 273  program (like a mailer, news reader, finger program, etc.) tries to read
 274  from that file, the reading program will block and your program will
 275  supply the new signature.  We'll use the pipe-checking file test B<-p>
 276  to find out whether anyone (or anything) has accidentally removed our fifo.
 277  
 278      chdir; # go home
 279      $FIFO = '.signature';
 280  
 281      while (1) {
 282      unless (-p $FIFO) {
 283          unlink $FIFO;
 284          require POSIX;
 285          POSIX::mkfifo($FIFO, 0700)
 286          or die "can't mkfifo $FIFO: $!";
 287      }
 288  
 289      # next line blocks until there's a reader
 290      open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
 291      print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
 292      close FIFO;
 293      sleep 2;    # to avoid dup signals
 294      }
 295  
 296  =head2 Deferred Signals (Safe Signals)
 297  
 298  In Perls before Perl 5.7.3 by installing Perl code to deal with
 299  signals, you were exposing yourself to danger from two things.  First,
 300  few system library functions are re-entrant.  If the signal interrupts
 301  while Perl is executing one function (like malloc(3) or printf(3)),
 302  and your signal handler then calls the same function again, you could
 303  get unpredictable behavior--often, a core dump.  Second, Perl isn't
 304  itself re-entrant at the lowest levels.  If the signal interrupts Perl
 305  while Perl is changing its own internal data structures, similarly
 306  unpredictable behaviour may result.
 307  
 308  There were two things you could do, knowing this: be paranoid or be
 309  pragmatic.  The paranoid approach was to do as little as possible in your
 310  signal handler.  Set an existing integer variable that already has a
 311  value, and return.  This doesn't help you if you're in a slow system call,
 312  which will just restart.  That means you have to C<die> to longjmp(3) out
 313  of the handler.  Even this is a little cavalier for the true paranoiac,
 314  who avoids C<die> in a handler because the system I<is> out to get you.
 315  The pragmatic approach was to say "I know the risks, but prefer the
 316  convenience", and to do anything you wanted in your signal handler,
 317  and be prepared to clean up core dumps now and again.
 318  
 319  In Perl 5.7.3 and later to avoid these problems signals are
 320  "deferred"-- that is when the signal is delivered to the process by
 321  the system (to the C code that implements Perl) a flag is set, and the
 322  handler returns immediately. Then at strategic "safe" points in the
 323  Perl interpreter (e.g. when it is about to execute a new opcode) the
 324  flags are checked and the Perl level handler from %SIG is
 325  executed. The "deferred" scheme allows much more flexibility in the
 326  coding of signal handler as we know Perl interpreter is in a safe
 327  state, and that we are not in a system library function when the
 328  handler is called.  However the implementation does differ from
 329  previous Perls in the following ways:
 330  
 331  =over 4
 332  
 333  =item Long-running opcodes
 334  
 335  As the Perl interpreter only looks at the signal flags when it is about
 336  to execute a new opcode, a signal that arrives during a long-running
 337  opcode (e.g. a regular expression operation on a very large string) will
 338  not be seen until the current opcode completes.
 339  
 340  N.B. If a signal of any given type fires multiple times during an opcode 
 341  (such as from a fine-grained timer), the handler for that signal will
 342  only be called once after the opcode completes, and all the other
 343  instances will be discarded.  Furthermore, if your system's signal queue
 344  gets flooded to the point that there are signals that have been raised
 345  but not yet caught (and thus not deferred) at the time an opcode
 346  completes, those signals may well be caught and deferred during
 347  subsequent opcodes, with sometimes surprising results.  For example, you
 348  may see alarms delivered even after calling C<alarm(0)> as the latter
 349  stops the raising of alarms but does not cancel the delivery of alarms
 350  raised but not yet caught.  Do not depend on the behaviors described in
 351  this paragraph as they are side effects of the current implementation and
 352  may change in future versions of Perl.
 353  
 354  
 355  =item Interrupting IO
 356  
 357  When a signal is delivered (e.g. INT control-C) the operating system
 358  breaks into IO operations like C<read> (used to implement Perls
 359  E<lt>E<gt> operator). On older Perls the handler was called
 360  immediately (and as C<read> is not "unsafe" this worked well). With
 361  the "deferred" scheme the handler is not called immediately, and if
 362  Perl is using system's C<stdio> library that library may re-start the
 363  C<read> without returning to Perl and giving it a chance to call the
 364  %SIG handler. If this happens on your system the solution is to use
 365  C<:perlio> layer to do IO - at least on those handles which you want
 366  to be able to break into with signals. (The C<:perlio> layer checks
 367  the signal flags and calls %SIG handlers before resuming IO operation.)
 368  
 369  Note that the default in Perl 5.7.3 and later is to automatically use
 370  the C<:perlio> layer.
 371  
 372  Note that some networking library functions like gethostbyname() are
 373  known to have their own implementations of timeouts which may conflict
 374  with your timeouts.  If you are having problems with such functions,
 375  you can try using the POSIX sigaction() function, which bypasses the
 376  Perl safe signals (note that this means subjecting yourself to
 377  possible memory corruption, as described above).  Instead of setting
 378  C<$SIG{ALRM}>:
 379  
 380     local $SIG{ALRM} = sub { die "alarm" };
 381  
 382  try something like the following:
 383  
 384      use POSIX qw(SIGALRM);
 385      POSIX::sigaction(SIGALRM,
 386                       POSIX::SigAction->new(sub { die "alarm" }))
 387            or die "Error setting SIGALRM handler: $!\n";
 388  
 389  Another way to disable the safe signal behavior locally is to use
 390  the C<Perl::Unsafe::Signals> module from CPAN (which will affect
 391  all signals).
 392  
 393  =item Restartable system calls
 394  
 395  On systems that supported it, older versions of Perl used the
 396  SA_RESTART flag when installing %SIG handlers.  This meant that
 397  restartable system calls would continue rather than returning when
 398  a signal arrived.  In order to deliver deferred signals promptly,
 399  Perl 5.7.3 and later do I<not> use SA_RESTART.  Consequently, 
 400  restartable system calls can fail (with $! set to C<EINTR>) in places
 401  where they previously would have succeeded.
 402  
 403  Note that the default C<:perlio> layer will retry C<read>, C<write>
 404  and C<close> as described above and that interrupted C<wait> and 
 405  C<waitpid> calls will always be retried.
 406  
 407  =item Signals as "faults"
 408  
 409  Certain signals, e.g. SEGV, ILL, and BUS, are generated as a result of
 410  virtual memory or other "faults". These are normally fatal and there is
 411  little a Perl-level handler can do with them, so Perl now delivers them
 412  immediately rather than attempting to defer them.
 413  
 414  =item Signals triggered by operating system state
 415  
 416  On some operating systems certain signal handlers are supposed to "do
 417  something" before returning. One example can be CHLD or CLD which
 418  indicates a child process has completed. On some operating systems the
 419  signal handler is expected to C<wait> for the completed child
 420  process. On such systems the deferred signal scheme will not work for
 421  those signals (it does not do the C<wait>). Again the failure will
 422  look like a loop as the operating system will re-issue the signal as
 423  there are un-waited-for completed child processes.
 424  
 425  =back
 426  
 427  If you want the old signal behaviour back regardless of possible
 428  memory corruption, set the environment variable C<PERL_SIGNALS> to
 429  C<"unsafe"> (a new feature since Perl 5.8.1).
 430  
 431  =head1 Using open() for IPC
 432  
 433  Perl's basic open() statement can also be used for unidirectional
 434  interprocess communication by either appending or prepending a pipe
 435  symbol to the second argument to open().  Here's how to start
 436  something up in a child process you intend to write to:
 437  
 438      open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
 439              || die "can't fork: $!";
 440      local $SIG{PIPE} = sub { die "spooler pipe broke" };
 441      print SPOOLER "stuff\n";
 442      close SPOOLER || die "bad spool: $! $?";
 443  
 444  And here's how to start up a child process you intend to read from:
 445  
 446      open(STATUS, "netstat -an 2>&1 |")
 447              || die "can't fork: $!";
 448      while (<STATUS>) {
 449      next if /^(tcp|udp)/;
 450      print;
 451      }
 452      close STATUS || die "bad netstat: $! $?";
 453  
 454  If one can be sure that a particular program is a Perl script that is
 455  expecting filenames in @ARGV, the clever programmer can write something
 456  like this:
 457  
 458      % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
 459  
 460  and irrespective of which shell it's called from, the Perl program will
 461  read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
 462  in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
 463  file.  Pretty nifty, eh?
 464  
 465  You might notice that you could use backticks for much the
 466  same effect as opening a pipe for reading:
 467  
 468      print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
 469      die "bad netstat" if $?;
 470  
 471  While this is true on the surface, it's much more efficient to process the
 472  file one line or record at a time because then you don't have to read the
 473  whole thing into memory at once.  It also gives you finer control of the
 474  whole process, letting you to kill off the child process early if you'd
 475  like.
 476  
 477  Be careful to check both the open() and the close() return values.  If
 478  you're I<writing> to a pipe, you should also trap SIGPIPE.  Otherwise,
 479  think of what happens when you start up a pipe to a command that doesn't
 480  exist: the open() will in all likelihood succeed (it only reflects the
 481  fork()'s success), but then your output will fail--spectacularly.  Perl
 482  can't know whether the command worked because your command is actually
 483  running in a separate process whose exec() might have failed.  Therefore,
 484  while readers of bogus commands return just a quick end of file, writers
 485  to bogus command will trigger a signal they'd better be prepared to
 486  handle.  Consider:
 487  
 488      open(FH, "|bogus")    or die "can't fork: $!";
 489      print FH "bang\n"    or die "can't write: $!";
 490      close FH        or die "can't close: $!";
 491  
 492  That won't blow up until the close, and it will blow up with a SIGPIPE.
 493  To catch it, you could use this:
 494  
 495      $SIG{PIPE} = 'IGNORE';
 496      open(FH, "|bogus")  or die "can't fork: $!";
 497      print FH "bang\n"   or die "can't write: $!";
 498      close FH            or die "can't close: status=$?";
 499  
 500  =head2 Filehandles
 501  
 502  Both the main process and any child processes it forks share the same
 503  STDIN, STDOUT, and STDERR filehandles.  If both processes try to access
 504  them at once, strange things can happen.  You may also want to close
 505  or reopen the filehandles for the child.  You can get around this by
 506  opening your pipe with open(), but on some systems this means that the
 507  child process cannot outlive the parent.
 508  
 509  =head2 Background Processes
 510  
 511  You can run a command in the background with:
 512  
 513      system("cmd &");
 514  
 515  The command's STDOUT and STDERR (and possibly STDIN, depending on your
 516  shell) will be the same as the parent's.  You won't need to catch
 517  SIGCHLD because of the double-fork taking place (see below for more
 518  details).
 519  
 520  =head2 Complete Dissociation of Child from Parent
 521  
 522  In some cases (starting server processes, for instance) you'll want to
 523  completely dissociate the child process from the parent.  This is
 524  often called daemonization.  A well behaved daemon will also chdir()
 525  to the root directory (so it doesn't prevent unmounting the filesystem
 526  containing the directory from which it was launched) and redirect its
 527  standard file descriptors from and to F</dev/null> (so that random
 528  output doesn't wind up on the user's terminal).
 529  
 530      use POSIX 'setsid';
 531  
 532      sub daemonize {
 533      chdir '/'        or die "Can't chdir to /: $!";
 534      open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
 535      open STDOUT, '>/dev/null'
 536                  or die "Can't write to /dev/null: $!";
 537      defined(my $pid = fork)    or die "Can't fork: $!";
 538      exit if $pid;
 539      setsid            or die "Can't start a new session: $!";
 540      open STDERR, '>&STDOUT'    or die "Can't dup stdout: $!";
 541      }
 542  
 543  The fork() has to come before the setsid() to ensure that you aren't a
 544  process group leader (the setsid() will fail if you are).  If your
 545  system doesn't have the setsid() function, open F</dev/tty> and use the
 546  C<TIOCNOTTY> ioctl() on it instead.  See tty(4) for details.
 547  
 548  Non-Unix users should check their Your_OS::Process module for other
 549  solutions.
 550  
 551  =head2 Safe Pipe Opens
 552  
 553  Another interesting approach to IPC is making your single program go
 554  multiprocess and communicate between (or even amongst) yourselves.  The
 555  open() function will accept a file argument of either C<"-|"> or C<"|-">
 556  to do a very interesting thing: it forks a child connected to the
 557  filehandle you've opened.  The child is running the same program as the
 558  parent.  This is useful for safely opening a file when running under an
 559  assumed UID or GID, for example.  If you open a pipe I<to> minus, you can
 560  write to the filehandle you opened and your kid will find it in his
 561  STDIN.  If you open a pipe I<from> minus, you can read from the filehandle
 562  you opened whatever your kid writes to his STDOUT.
 563  
 564      use English '-no_match_vars';
 565      my $sleep_count = 0;
 566  
 567      do {
 568      $pid = open(KID_TO_WRITE, "|-");
 569      unless (defined $pid) {
 570          warn "cannot fork: $!";
 571          die "bailing out" if $sleep_count++ > 6;
 572          sleep 10;
 573      }
 574      } until defined $pid;
 575  
 576      if ($pid) {  # parent
 577      print KID_TO_WRITE @some_data;
 578      close(KID_TO_WRITE) || warn "kid exited $?";
 579      } else {     # child
 580      ($EUID, $EGID) = ($UID, $GID); # suid progs only
 581      open (FILE, "> /safe/file")
 582          || die "can't open /safe/file: $!";
 583      while (<STDIN>) {
 584          print FILE; # child's STDIN is parent's KID
 585      }
 586      exit;  # don't forget this
 587      }
 588  
 589  Another common use for this construct is when you need to execute
 590  something without the shell's interference.  With system(), it's
 591  straightforward, but you can't use a pipe open or backticks safely.
 592  That's because there's no way to stop the shell from getting its hands on
 593  your arguments.   Instead, use lower-level control to call exec() directly.
 594  
 595  Here's a safe backtick or pipe open for read:
 596  
 597      # add error processing as above
 598      $pid = open(KID_TO_READ, "-|");
 599  
 600      if ($pid) {   # parent
 601      while (<KID_TO_READ>) {
 602          # do something interesting
 603      }
 604      close(KID_TO_READ) || warn "kid exited $?";
 605  
 606      } else {      # child
 607      ($EUID, $EGID) = ($UID, $GID); # suid only
 608      exec($program, @options, @args)
 609          || die "can't exec program: $!";
 610      # NOTREACHED
 611      }
 612  
 613  
 614  And here's a safe pipe open for writing:
 615  
 616      # add error processing as above
 617      $pid = open(KID_TO_WRITE, "|-");
 618      $SIG{PIPE} = sub { die "whoops, $program pipe broke" };
 619  
 620      if ($pid) {  # parent
 621      for (@data) {
 622          print KID_TO_WRITE;
 623      }
 624      close(KID_TO_WRITE) || warn "kid exited $?";
 625  
 626      } else {     # child
 627      ($EUID, $EGID) = ($UID, $GID);
 628      exec($program, @options, @args)
 629          || die "can't exec program: $!";
 630      # NOTREACHED
 631      }
 632  
 633  Since Perl 5.8.0, you can also use the list form of C<open> for pipes :
 634  the syntax
 635  
 636      open KID_PS, "-|", "ps", "aux" or die $!;
 637  
 638  forks the ps(1) command (without spawning a shell, as there are more than
 639  three arguments to open()), and reads its standard output via the
 640  C<KID_PS> filehandle.  The corresponding syntax to write to command
 641  pipes (with C<"|-"> in place of C<"-|">) is also implemented.
 642  
 643  Note that these operations are full Unix forks, which means they may not be
 644  correctly implemented on alien systems.  Additionally, these are not true
 645  multithreading.  If you'd like to learn more about threading, see the
 646  F<modules> file mentioned below in the SEE ALSO section.
 647  
 648  =head2 Bidirectional Communication with Another Process
 649  
 650  While this works reasonably well for unidirectional communication, what
 651  about bidirectional communication?  The obvious thing you'd like to do
 652  doesn't actually work:
 653  
 654      open(PROG_FOR_READING_AND_WRITING, "| some program |")
 655  
 656  and if you forget to use the C<use warnings> pragma or the B<-w> flag,
 657  then you'll miss out entirely on the diagnostic message:
 658  
 659      Can't do bidirectional pipe at -e line 1.
 660  
 661  If you really want to, you can use the standard open2() library function
 662  to catch both ends.  There's also an open3() for tridirectional I/O so you
 663  can also catch your child's STDERR, but doing so would then require an
 664  awkward select() loop and wouldn't allow you to use normal Perl input
 665  operations.
 666  
 667  If you look at its source, you'll see that open2() uses low-level
 668  primitives like Unix pipe() and exec() calls to create all the connections.
 669  While it might have been slightly more efficient by using socketpair(), it
 670  would have then been even less portable than it already is.  The open2()
 671  and open3() functions are  unlikely to work anywhere except on a Unix
 672  system or some other one purporting to be POSIX compliant.
 673  
 674  Here's an example of using open2():
 675  
 676      use FileHandle;
 677      use IPC::Open2;
 678      $pid = open2(*Reader, *Writer, "cat -u -n" );
 679      print Writer "stuff\n";
 680      $got = <Reader>;
 681  
 682  The problem with this is that Unix buffering is really going to
 683  ruin your day.  Even though your C<Writer> filehandle is auto-flushed,
 684  and the process on the other end will get your data in a timely manner,
 685  you can't usually do anything to force it to give it back to you
 686  in a similarly quick fashion.  In this case, we could, because we
 687  gave I<cat> a B<-u> flag to make it unbuffered.  But very few Unix
 688  commands are designed to operate over pipes, so this seldom works
 689  unless you yourself wrote the program on the other end of the
 690  double-ended pipe.
 691  
 692  A solution to this is the nonstandard F<Comm.pl> library.  It uses
 693  pseudo-ttys to make your program behave more reasonably:
 694  
 695      require 'Comm.pl';
 696      $ph = open_proc('cat -n');
 697      for (1..10) {
 698      print $ph "a line\n";
 699      print "got back ", scalar <$ph>;
 700      }
 701  
 702  This way you don't have to have control over the source code of the
 703  program you're using.  The F<Comm> library also has expect()
 704  and interact() functions.  Find the library (and we hope its
 705  successor F<IPC::Chat>) at your nearest CPAN archive as detailed
 706  in the SEE ALSO section below.
 707  
 708  The newer Expect.pm module from CPAN also addresses this kind of thing.
 709  This module requires two other modules from CPAN: IO::Pty and IO::Stty.
 710  It sets up a pseudo-terminal to interact with programs that insist on
 711  using talking to the terminal device driver.  If your system is
 712  amongst those supported, this may be your best bet.
 713  
 714  =head2 Bidirectional Communication with Yourself
 715  
 716  If you want, you may make low-level pipe() and fork()
 717  to stitch this together by hand.  This example only
 718  talks to itself, but you could reopen the appropriate
 719  handles to STDIN and STDOUT and call other processes.
 720  
 721      #!/usr/bin/perl -w
 722      # pipe1 - bidirectional communication using two pipe pairs
 723      #         designed for the socketpair-challenged
 724      use IO::Handle;    # thousands of lines just for autoflush :-(
 725      pipe(PARENT_RDR, CHILD_WTR);        # XXX: failure?
 726      pipe(CHILD_RDR,  PARENT_WTR);        # XXX: failure?
 727      CHILD_WTR->autoflush(1);
 728      PARENT_WTR->autoflush(1);
 729  
 730      if ($pid = fork) {
 731      close PARENT_RDR; close PARENT_WTR;
 732      print CHILD_WTR "Parent Pid $$ is sending this\n";
 733      chomp($line = <CHILD_RDR>);
 734      print "Parent Pid $$ just read this: `$line'\n";
 735      close CHILD_RDR; close CHILD_WTR;
 736      waitpid($pid,0);
 737      } else {
 738      die "cannot fork: $!" unless defined $pid;
 739      close CHILD_RDR; close CHILD_WTR;
 740      chomp($line = <PARENT_RDR>);
 741      print "Child Pid $$ just read this: `$line'\n";
 742      print PARENT_WTR "Child Pid $$ is sending this\n";
 743      close PARENT_RDR; close PARENT_WTR;
 744      exit;
 745      }
 746  
 747  But you don't actually have to make two pipe calls.  If you
 748  have the socketpair() system call, it will do this all for you.
 749  
 750      #!/usr/bin/perl -w
 751      # pipe2 - bidirectional communication using socketpair
 752      #   "the best ones always go both ways"
 753  
 754      use Socket;
 755      use IO::Handle;    # thousands of lines just for autoflush :-(
 756      # We say AF_UNIX because although *_LOCAL is the
 757      # POSIX 1003.1g form of the constant, many machines
 758      # still don't have it.
 759      socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
 760                  or  die "socketpair: $!";
 761  
 762      CHILD->autoflush(1);
 763      PARENT->autoflush(1);
 764  
 765      if ($pid = fork) {
 766      close PARENT;
 767      print CHILD "Parent Pid $$ is sending this\n";
 768      chomp($line = <CHILD>);
 769      print "Parent Pid $$ just read this: `$line'\n";
 770      close CHILD;
 771      waitpid($pid,0);
 772      } else {
 773      die "cannot fork: $!" unless defined $pid;
 774      close CHILD;
 775      chomp($line = <PARENT>);
 776      print "Child Pid $$ just read this: `$line'\n";
 777      print PARENT "Child Pid $$ is sending this\n";
 778      close PARENT;
 779      exit;
 780      }
 781  
 782  =head1 Sockets: Client/Server Communication
 783  
 784  While not limited to Unix-derived operating systems (e.g., WinSock on PCs
 785  provides socket support, as do some VMS libraries), you may not have
 786  sockets on your system, in which case this section probably isn't going to do
 787  you much good.  With sockets, you can do both virtual circuits (i.e., TCP
 788  streams) and datagrams (i.e., UDP packets).  You may be able to do even more
 789  depending on your system.
 790  
 791  The Perl function calls for dealing with sockets have the same names as
 792  the corresponding system calls in C, but their arguments tend to differ
 793  for two reasons: first, Perl filehandles work differently than C file
 794  descriptors.  Second, Perl already knows the length of its strings, so you
 795  don't need to pass that information.
 796  
 797  One of the major problems with old socket code in Perl was that it used
 798  hard-coded values for some of the constants, which severely hurt
 799  portability.  If you ever see code that does anything like explicitly
 800  setting C<$AF_INET = 2>, you know you're in for big trouble:  An
 801  immeasurably superior approach is to use the C<Socket> module, which more
 802  reliably grants access to various constants and functions you'll need.
 803  
 804  If you're not writing a server/client for an existing protocol like
 805  NNTP or SMTP, you should give some thought to how your server will
 806  know when the client has finished talking, and vice-versa.  Most
 807  protocols are based on one-line messages and responses (so one party
 808  knows the other has finished when a "\n" is received) or multi-line
 809  messages and responses that end with a period on an empty line
 810  ("\n.\n" terminates a message/response).
 811  
 812  =head2 Internet Line Terminators
 813  
 814  The Internet line terminator is "\015\012".  Under ASCII variants of
 815  Unix, that could usually be written as "\r\n", but under other systems,
 816  "\r\n" might at times be "\015\015\012", "\012\012\015", or something
 817  completely different.  The standards specify writing "\015\012" to be
 818  conformant (be strict in what you provide), but they also recommend
 819  accepting a lone "\012" on input (but be lenient in what you require).
 820  We haven't always been very good about that in the code in this manpage,
 821  but unless you're on a Mac, you'll probably be ok.
 822  
 823  =head2 Internet TCP Clients and Servers
 824  
 825  Use Internet-domain sockets when you want to do client-server
 826  communication that might extend to machines outside of your own system.
 827  
 828  Here's a sample TCP client using Internet-domain sockets:
 829  
 830      #!/usr/bin/perl -w
 831      use strict;
 832      use Socket;
 833      my ($remote,$port, $iaddr, $paddr, $proto, $line);
 834  
 835      $remote  = shift || 'localhost';
 836      $port    = shift || 2345;  # random port
 837      if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
 838      die "No port" unless $port;
 839      $iaddr   = inet_aton($remote)         || die "no host: $remote";
 840      $paddr   = sockaddr_in($port, $iaddr);
 841  
 842      $proto   = getprotobyname('tcp');
 843      socket(SOCK, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!";
 844      connect(SOCK, $paddr)    || die "connect: $!";
 845      while (defined($line = <SOCK>)) {
 846      print $line;
 847      }
 848  
 849      close (SOCK)        || die "close: $!";
 850      exit;
 851  
 852  And here's a corresponding server to go along with it.  We'll
 853  leave the address as INADDR_ANY so that the kernel can choose
 854  the appropriate interface on multihomed hosts.  If you want sit
 855  on a particular interface (like the external side of a gateway
 856  or firewall machine), you should fill this in with your real address
 857  instead.
 858  
 859      #!/usr/bin/perl -Tw
 860      use strict;
 861      BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
 862      use Socket;
 863      use Carp;
 864      my $EOL = "\015\012";
 865  
 866      sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
 867  
 868      my $port = shift || 2345;
 869      my $proto = getprotobyname('tcp');
 870  
 871      ($port) = $port =~ /^(\d+)$/                        or die "invalid port";
 872  
 873      socket(Server, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!";
 874      setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
 875                      pack("l", 1))     || die "setsockopt: $!";
 876      bind(Server, sockaddr_in($port, INADDR_ANY))    || die "bind: $!";
 877      listen(Server,SOMAXCONN)                 || die "listen: $!";
 878  
 879      logmsg "server started on port $port";
 880  
 881      my $paddr;
 882  
 883      $SIG{CHLD} = \&REAPER;
 884  
 885      for ( ; $paddr = accept(Client,Server); close Client) {
 886      my($port,$iaddr) = sockaddr_in($paddr);
 887      my $name = gethostbyaddr($iaddr,AF_INET);
 888  
 889      logmsg "connection from $name [",
 890          inet_ntoa($iaddr), "]
 891          at port $port";
 892  
 893      print Client "Hello there, $name, it's now ",
 894              scalar localtime, $EOL;
 895      }
 896  
 897  And here's a multithreaded version.  It's multithreaded in that
 898  like most typical servers, it spawns (forks) a slave server to
 899  handle the client request so that the master server can quickly
 900  go back to service a new client.
 901  
 902      #!/usr/bin/perl -Tw
 903      use strict;
 904      BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
 905      use Socket;
 906      use Carp;
 907      my $EOL = "\015\012";
 908  
 909      sub spawn;  # forward declaration
 910      sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
 911  
 912      my $port = shift || 2345;
 913      my $proto = getprotobyname('tcp');
 914  
 915      ($port) = $port =~ /^(\d+)$/                        or die "invalid port";
 916  
 917      socket(Server, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!";
 918      setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
 919                      pack("l", 1))     || die "setsockopt: $!";
 920      bind(Server, sockaddr_in($port, INADDR_ANY))    || die "bind: $!";
 921      listen(Server,SOMAXCONN)                 || die "listen: $!";
 922  
 923      logmsg "server started on port $port";
 924  
 925      my $waitedpid = 0;
 926      my $paddr;
 927  
 928      use POSIX ":sys_wait_h";
 929      use Errno;
 930  
 931      sub REAPER {
 932          local $!;   # don't let waitpid() overwrite current error
 933          while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
 934              logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
 935          }
 936          $SIG{CHLD} = \&REAPER;  # loathe sysV
 937      }
 938  
 939      $SIG{CHLD} = \&REAPER;
 940  
 941      while(1) {
 942          $paddr = accept(Client, Server) || do {
 943              # try again if accept() returned because a signal was received
 944              next if $!{EINTR};
 945              die "accept: $!";
 946          };
 947          my ($port, $iaddr) = sockaddr_in($paddr);
 948          my $name = gethostbyaddr($iaddr, AF_INET);
 949  
 950          logmsg "connection from $name [",
 951                 inet_ntoa($iaddr),
 952                 "] at port $port";
 953  
 954          spawn sub {
 955              $|=1;
 956              print "Hello there, $name, it's now ", scalar localtime, $EOL;
 957              exec '/usr/games/fortune'       # XXX: `wrong' line terminators
 958                  or confess "can't exec fortune: $!";
 959          };
 960          close Client;
 961      }
 962  
 963      sub spawn {
 964          my $coderef = shift;
 965  
 966          unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
 967              confess "usage: spawn CODEREF";
 968          }
 969  
 970          my $pid;
 971          if (! defined($pid = fork)) {
 972              logmsg "cannot fork: $!";
 973              return;
 974          } 
 975          elsif ($pid) {
 976              logmsg "begat $pid";
 977              return; # I'm the parent
 978          }
 979          # else I'm the child -- go spawn
 980  
 981          open(STDIN,  "<&Client")   || die "can't dup client to stdin";
 982          open(STDOUT, ">&Client")   || die "can't dup client to stdout";
 983          ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
 984          exit &$coderef();
 985      }
 986  
 987  This server takes the trouble to clone off a child version via fork()
 988  for each incoming request.  That way it can handle many requests at
 989  once, which you might not always want.  Even if you don't fork(), the
 990  listen() will allow that many pending connections.  Forking servers
 991  have to be particularly careful about cleaning up their dead children
 992  (called "zombies" in Unix parlance), because otherwise you'll quickly
 993  fill up your process table.  The REAPER subroutine is used here to
 994  call waitpid() for any child processes that have finished, thereby
 995  ensuring that they terminate cleanly and don't join the ranks of the
 996  living dead.
 997  
 998  Within the while loop we call accept() and check to see if it returns
 999  a false value.  This would normally indicate a system error that needs
1000  to be reported.  However the introduction of safe signals (see
1001  L</Deferred Signals (Safe Signals)> above) in Perl 5.7.3 means that
1002  accept() may also be interrupted when the process receives a signal.
1003  This typically happens when one of the forked sub-processes exits and
1004  notifies the parent process with a CHLD signal.  
1005  
1006  If accept() is interrupted by a signal then $! will be set to EINTR.
1007  If this happens then we can safely continue to the next iteration of
1008  the loop and another call to accept().  It is important that your
1009  signal handling code doesn't modify the value of $! or this test will
1010  most likely fail.  In the REAPER subroutine we create a local version
1011  of $! before calling waitpid().  When waitpid() sets $! to ECHILD (as
1012  it inevitably does when it has no more children waiting), it will
1013  update the local copy leaving the original unchanged.
1014  
1015  We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
1016  even if we aren't running setuid or setgid.  This is always a good idea
1017  for servers and other programs run on behalf of someone else (like CGI
1018  scripts), because it lessens the chances that people from the outside will
1019  be able to compromise your system.
1020  
1021  Let's look at another TCP client.  This one connects to the TCP "time"
1022  service on a number of different machines and shows how far their clocks
1023  differ from the system on which it's being run:
1024  
1025      #!/usr/bin/perl  -w
1026      use strict;
1027      use Socket;
1028  
1029      my $SECS_of_70_YEARS = 2208988800;
1030      sub ctime { scalar localtime(shift) }
1031  
1032      my $iaddr = gethostbyname('localhost');
1033      my $proto = getprotobyname('tcp');
1034      my $port = getservbyname('time', 'tcp');
1035      my $paddr = sockaddr_in(0, $iaddr);
1036      my($host);
1037  
1038      $| = 1;
1039      printf "%-24s %8s %s\n",  "localhost", 0, ctime(time());
1040  
1041      foreach $host (@ARGV) {
1042      printf "%-24s ", $host;
1043      my $hisiaddr = inet_aton($host)     || die "unknown host";
1044      my $hispaddr = sockaddr_in($port, $hisiaddr);
1045      socket(SOCKET, PF_INET, SOCK_STREAM, $proto)   || die "socket: $!";
1046      connect(SOCKET, $hispaddr)          || die "bind: $!";
1047      my $rtime = '    ';
1048      read(SOCKET, $rtime, 4);
1049      close(SOCKET);
1050      my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
1051      printf "%8d %s\n", $histime - time, ctime($histime);
1052      }
1053  
1054  =head2 Unix-Domain TCP Clients and Servers
1055  
1056  That's fine for Internet-domain clients and servers, but what about local
1057  communications?  While you can use the same setup, sometimes you don't
1058  want to.  Unix-domain sockets are local to the current host, and are often
1059  used internally to implement pipes.  Unlike Internet domain sockets, Unix
1060  domain sockets can show up in the file system with an ls(1) listing.
1061  
1062      % ls -l /dev/log
1063      srw-rw-rw-  1 root            0 Oct 31 07:23 /dev/log
1064  
1065  You can test for these with Perl's B<-S> file test:
1066  
1067      unless ( -S '/dev/log' ) {
1068      die "something's wicked with the log system";
1069      }
1070  
1071  Here's a sample Unix-domain client:
1072  
1073      #!/usr/bin/perl -w
1074      use Socket;
1075      use strict;
1076      my ($rendezvous, $line);
1077  
1078      $rendezvous = shift || 'catsock';
1079      socket(SOCK, PF_UNIX, SOCK_STREAM, 0)    || die "socket: $!";
1080      connect(SOCK, sockaddr_un($rendezvous))    || die "connect: $!";
1081      while (defined($line = <SOCK>)) {
1082      print $line;
1083      }
1084      exit;
1085  
1086  And here's a corresponding server.  You don't have to worry about silly
1087  network terminators here because Unix domain sockets are guaranteed
1088  to be on the localhost, and thus everything works right.
1089  
1090      #!/usr/bin/perl -Tw
1091      use strict;
1092      use Socket;
1093      use Carp;
1094  
1095      BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
1096      sub spawn;  # forward declaration
1097      sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
1098  
1099      my $NAME = 'catsock';
1100      my $uaddr = sockaddr_un($NAME);
1101      my $proto = getprotobyname('tcp');
1102  
1103      socket(Server,PF_UNIX,SOCK_STREAM,0)     || die "socket: $!";
1104      unlink($NAME);
1105      bind  (Server, $uaddr)             || die "bind: $!";
1106      listen(Server,SOMAXCONN)            || die "listen: $!";
1107  
1108      logmsg "server started on $NAME";
1109  
1110      my $waitedpid;
1111  
1112      use POSIX ":sys_wait_h";
1113      sub REAPER {
1114      my $child;
1115          while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
1116          logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
1117      }
1118      $SIG{CHLD} = \&REAPER;  # loathe sysV
1119      }
1120  
1121      $SIG{CHLD} = \&REAPER;
1122  
1123  
1124      for ( $waitedpid = 0;
1125        accept(Client,Server) || $waitedpid;
1126        $waitedpid = 0, close Client)
1127      {
1128      next if $waitedpid;
1129      logmsg "connection on $NAME";
1130      spawn sub {
1131          print "Hello there, it's now ", scalar localtime, "\n";
1132          exec '/usr/games/fortune' or die "can't exec fortune: $!";
1133      };
1134      }
1135  
1136      sub spawn {
1137      my $coderef = shift;
1138  
1139      unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
1140          confess "usage: spawn CODEREF";
1141      }
1142  
1143      my $pid;
1144      if (!defined($pid = fork)) {
1145          logmsg "cannot fork: $!";
1146          return;
1147      } elsif ($pid) {
1148          logmsg "begat $pid";
1149          return; # I'm the parent
1150      }
1151      # else I'm the child -- go spawn
1152  
1153      open(STDIN,  "<&Client")   || die "can't dup client to stdin";
1154      open(STDOUT, ">&Client")   || die "can't dup client to stdout";
1155      ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
1156      exit &$coderef();
1157      }
1158  
1159  As you see, it's remarkably similar to the Internet domain TCP server, so
1160  much so, in fact, that we've omitted several duplicate functions--spawn(),
1161  logmsg(), ctime(), and REAPER()--which are exactly the same as in the
1162  other server.
1163  
1164  So why would you ever want to use a Unix domain socket instead of a
1165  simpler named pipe?  Because a named pipe doesn't give you sessions.  You
1166  can't tell one process's data from another's.  With socket programming,
1167  you get a separate session for each client: that's why accept() takes two
1168  arguments.
1169  
1170  For example, let's say that you have a long running database server daemon
1171  that you want folks from the World Wide Web to be able to access, but only
1172  if they go through a CGI interface.  You'd have a small, simple CGI
1173  program that does whatever checks and logging you feel like, and then acts
1174  as a Unix-domain client and connects to your private server.
1175  
1176  =head1 TCP Clients with IO::Socket
1177  
1178  For those preferring a higher-level interface to socket programming, the
1179  IO::Socket module provides an object-oriented approach.  IO::Socket is
1180  included as part of the standard Perl distribution as of the 5.004
1181  release.  If you're running an earlier version of Perl, just fetch
1182  IO::Socket from CPAN, where you'll also find modules providing easy
1183  interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
1184  NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
1185  to name a few.
1186  
1187  =head2 A Simple Client
1188  
1189  Here's a client that creates a TCP connection to the "daytime"
1190  service at port 13 of the host name "localhost" and prints out everything
1191  that the server there cares to provide.
1192  
1193      #!/usr/bin/perl -w
1194      use IO::Socket;
1195      $remote = IO::Socket::INET->new(
1196              Proto    => "tcp",
1197              PeerAddr => "localhost",
1198              PeerPort => "daytime(13)",
1199              )
1200            or die "cannot connect to daytime port at localhost";
1201      while ( <$remote> ) { print }
1202  
1203  When you run this program, you should get something back that
1204  looks like this:
1205  
1206      Wed May 14 08:40:46 MDT 1997
1207  
1208  Here are what those parameters to the C<new> constructor mean:
1209  
1210  =over 4
1211  
1212  =item C<Proto>
1213  
1214  This is which protocol to use.  In this case, the socket handle returned
1215  will be connected to a TCP socket, because we want a stream-oriented
1216  connection, that is, one that acts pretty much like a plain old file.
1217  Not all sockets are this of this type.  For example, the UDP protocol
1218  can be used to make a datagram socket, used for message-passing.
1219  
1220  =item C<PeerAddr>
1221  
1222  This is the name or Internet address of the remote host the server is
1223  running on.  We could have specified a longer name like C<"www.perl.com">,
1224  or an address like C<"204.148.40.9">.  For demonstration purposes, we've
1225  used the special hostname C<"localhost">, which should always mean the
1226  current machine you're running on.  The corresponding Internet address
1227  for localhost is C<"127.1">, if you'd rather use that.
1228  
1229  =item C<PeerPort>
1230  
1231  This is the service name or port number we'd like to connect to.
1232  We could have gotten away with using just C<"daytime"> on systems with a
1233  well-configured system services file,[FOOTNOTE: The system services file
1234  is in I</etc/services> under Unix] but just in case, we've specified the
1235  port number (13) in parentheses.  Using just the number would also have
1236  worked, but constant numbers make careful programmers nervous.
1237  
1238  =back
1239  
1240  Notice how the return value from the C<new> constructor is used as
1241  a filehandle in the C<while> loop?  That's what's called an indirect
1242  filehandle, a scalar variable containing a filehandle.  You can use
1243  it the same way you would a normal filehandle.  For example, you
1244  can read one line from it this way:
1245  
1246      $line = <$handle>;
1247  
1248  all remaining lines from is this way:
1249  
1250      @lines = <$handle>;
1251  
1252  and send a line of data to it this way:
1253  
1254      print $handle "some data\n";
1255  
1256  =head2 A Webget Client
1257  
1258  Here's a simple client that takes a remote host to fetch a document
1259  from, and then a list of documents to get from that host.  This is a
1260  more interesting client than the previous one because it first sends
1261  something to the server before fetching the server's response.
1262  
1263      #!/usr/bin/perl -w
1264      use IO::Socket;
1265      unless (@ARGV > 1) { die "usage: $0 host document ..." }
1266      $host = shift(@ARGV);
1267      $EOL = "\015\012";
1268      $BLANK = $EOL x 2;
1269      foreach $document ( @ARGV ) {
1270      $remote = IO::Socket::INET->new( Proto     => "tcp",
1271                       PeerAddr  => $host,
1272                       PeerPort  => "http(80)",
1273                          );
1274      unless ($remote) { die "cannot connect to http daemon on $host" }
1275      $remote->autoflush(1);
1276      print $remote "GET $document HTTP/1.0" . $BLANK;
1277      while ( <$remote> ) { print }
1278      close $remote;
1279      }
1280  
1281  The web server handing the "http" service, which is assumed to be at
1282  its standard port, number 80.  If the web server you're trying to
1283  connect to is at a different port (like 1080 or 8080), you should specify
1284  as the named-parameter pair, C<< PeerPort => 8080 >>.  The C<autoflush>
1285  method is used on the socket because otherwise the system would buffer
1286  up the output we sent it.  (If you're on a Mac, you'll also need to
1287  change every C<"\n"> in your code that sends data over the network to
1288  be a C<"\015\012"> instead.)
1289  
1290  Connecting to the server is only the first part of the process: once you
1291  have the connection, you have to use the server's language.  Each server
1292  on the network has its own little command language that it expects as
1293  input.  The string that we send to the server starting with "GET" is in
1294  HTTP syntax.  In this case, we simply request each specified document.
1295  Yes, we really are making a new connection for each document, even though
1296  it's the same host.  That's the way you always used to have to speak HTTP.
1297  Recent versions of web browsers may request that the remote server leave
1298  the connection open a little while, but the server doesn't have to honor
1299  such a request.
1300  
1301  Here's an example of running that program, which we'll call I<webget>:
1302  
1303      % webget www.perl.com /guanaco.html
1304      HTTP/1.1 404 File Not Found
1305      Date: Thu, 08 May 1997 18:02:32 GMT
1306      Server: Apache/1.2b6
1307      Connection: close
1308      Content-type: text/html
1309  
1310      <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
1311      <BODY><H1>File Not Found</H1>
1312      The requested URL /guanaco.html was not found on this server.<P>
1313      </BODY>
1314  
1315  Ok, so that's not very interesting, because it didn't find that
1316  particular document.  But a long response wouldn't have fit on this page.
1317  
1318  For a more fully-featured version of this program, you should look to
1319  the I<lwp-request> program included with the LWP modules from CPAN.
1320  
1321  =head2 Interactive Client with IO::Socket
1322  
1323  Well, that's all fine if you want to send one command and get one answer,
1324  but what about setting up something fully interactive, somewhat like
1325  the way I<telnet> works?  That way you can type a line, get the answer,
1326  type a line, get the answer, etc.
1327  
1328  This client is more complicated than the two we've done so far, but if
1329  you're on a system that supports the powerful C<fork> call, the solution
1330  isn't that rough.  Once you've made the connection to whatever service
1331  you'd like to chat with, call C<fork> to clone your process.  Each of
1332  these two identical process has a very simple job to do: the parent
1333  copies everything from the socket to standard output, while the child
1334  simultaneously copies everything from standard input to the socket.
1335  To accomplish the same thing using just one process would be I<much>
1336  harder, because it's easier to code two processes to do one thing than it
1337  is to code one process to do two things.  (This keep-it-simple principle
1338  a cornerstones of the Unix philosophy, and good software engineering as
1339  well, which is probably why it's spread to other systems.)
1340  
1341  Here's the code:
1342  
1343      #!/usr/bin/perl -w
1344      use strict;
1345      use IO::Socket;
1346      my ($host, $port, $kidpid, $handle, $line);
1347  
1348      unless (@ARGV == 2) { die "usage: $0 host port" }
1349      ($host, $port) = @ARGV;
1350  
1351      # create a tcp connection to the specified host and port
1352      $handle = IO::Socket::INET->new(Proto     => "tcp",
1353                      PeerAddr  => $host,
1354                      PeerPort  => $port)
1355         or die "can't connect to port $port on $host: $!";
1356  
1357      $handle->autoflush(1);        # so output gets there right away
1358      print STDERR "[Connected to $host:$port]\n";
1359  
1360      # split the program into two processes, identical twins
1361      die "can't fork: $!" unless defined($kidpid = fork());
1362  
1363      # the if{} block runs only in the parent process
1364      if ($kidpid) {
1365      # copy the socket to standard output
1366      while (defined ($line = <$handle>)) {
1367          print STDOUT $line;
1368      }
1369      kill("TERM", $kidpid);          # send SIGTERM to child
1370      }
1371      # the else{} block runs only in the child process
1372      else {
1373      # copy standard input to the socket
1374      while (defined ($line = <STDIN>)) {
1375          print $handle $line;
1376      }
1377      }
1378  
1379  The C<kill> function in the parent's C<if> block is there to send a
1380  signal to our child process (current running in the C<else> block)
1381  as soon as the remote server has closed its end of the connection.
1382  
1383  If the remote server sends data a byte at time, and you need that
1384  data immediately without waiting for a newline (which might not happen),
1385  you may wish to replace the C<while> loop in the parent with the
1386  following:
1387  
1388      my $byte;
1389      while (sysread($handle, $byte, 1) == 1) {
1390      print STDOUT $byte;
1391      }
1392  
1393  Making a system call for each byte you want to read is not very efficient
1394  (to put it mildly) but is the simplest to explain and works reasonably
1395  well.
1396  
1397  =head1 TCP Servers with IO::Socket
1398  
1399  As always, setting up a server is little bit more involved than running a client.
1400  The model is that the server creates a special kind of socket that
1401  does nothing but listen on a particular port for incoming connections.
1402  It does this by calling the C<< IO::Socket::INET->new() >> method with
1403  slightly different arguments than the client did.
1404  
1405  =over 4
1406  
1407  =item Proto
1408  
1409  This is which protocol to use.  Like our clients, we'll
1410  still specify C<"tcp"> here.
1411  
1412  =item LocalPort
1413  
1414  We specify a local
1415  port in the C<LocalPort> argument, which we didn't do for the client.
1416  This is service name or port number for which you want to be the
1417  server. (Under Unix, ports under 1024 are restricted to the
1418  superuser.)  In our sample, we'll use port 9000, but you can use
1419  any port that's not currently in use on your system.  If you try
1420  to use one already in used, you'll get an "Address already in use"
1421  message.  Under Unix, the C<netstat -a> command will show
1422  which services current have servers.
1423  
1424  =item Listen
1425  
1426  The C<Listen> parameter is set to the maximum number of
1427  pending connections we can accept until we turn away incoming clients.
1428  Think of it as a call-waiting queue for your telephone.
1429  The low-level Socket module has a special symbol for the system maximum, which
1430  is SOMAXCONN.
1431  
1432  =item Reuse
1433  
1434  The C<Reuse> parameter is needed so that we restart our server
1435  manually without waiting a few minutes to allow system buffers to
1436  clear out.
1437  
1438  =back
1439  
1440  Once the generic server socket has been created using the parameters
1441  listed above, the server then waits for a new client to connect
1442  to it.  The server blocks in the C<accept> method, which eventually accepts a
1443  bidirectional connection from the remote client.  (Make sure to autoflush
1444  this handle to circumvent buffering.)
1445  
1446  To add to user-friendliness, our server prompts the user for commands.
1447  Most servers don't do this.  Because of the prompt without a newline,
1448  you'll have to use the C<sysread> variant of the interactive client above.
1449  
1450  This server accepts one of five different commands, sending output
1451  back to the client.  Note that unlike most network servers, this one
1452  only handles one incoming client at a time.  Multithreaded servers are
1453  covered in Chapter 6 of the Camel.
1454  
1455  Here's the code.  We'll
1456  
1457   #!/usr/bin/perl -w
1458   use IO::Socket;
1459   use Net::hostent;        # for OO version of gethostbyaddr
1460  
1461   $PORT = 9000;            # pick something not in use
1462  
1463   $server = IO::Socket::INET->new( Proto     => 'tcp',
1464                                    LocalPort => $PORT,
1465                                    Listen    => SOMAXCONN,
1466                                    Reuse     => 1);
1467  
1468   die "can't setup server" unless $server;
1469   print "[Server $0 accepting clients]\n";
1470  
1471   while ($client = $server->accept()) {
1472     $client->autoflush(1);
1473     print $client "Welcome to $0; type help for command list.\n";
1474     $hostinfo = gethostbyaddr($client->peeraddr);
1475     printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
1476     print $client "Command? ";
1477     while ( <$client>) {
1478       next unless /\S/;         # blank line
1479       if    (/quit|exit/i)    { last;                                     }
1480       elsif (/date|time/i)    { printf $client "%s\n", scalar localtime;  }
1481       elsif (/who/i )         { print  $client `who 2>&1`;                }
1482       elsif (/cookie/i )      { print  $client `/usr/games/fortune 2>&1`; }
1483       elsif (/motd/i )        { print  $client `cat /etc/motd 2>&1`;      }
1484       else {
1485         print $client "Commands: quit date who cookie motd\n";
1486       }
1487     } continue {
1488        print $client "Command? ";
1489     }
1490     close $client;
1491   }
1492  
1493  =head1 UDP: Message Passing
1494  
1495  Another kind of client-server setup is one that uses not connections, but
1496  messages.  UDP communications involve much lower overhead but also provide
1497  less reliability, as there are no promises that messages will arrive at
1498  all, let alone in order and unmangled.  Still, UDP offers some advantages
1499  over TCP, including being able to "broadcast" or "multicast" to a whole
1500  bunch of destination hosts at once (usually on your local subnet).  If you
1501  find yourself overly concerned about reliability and start building checks
1502  into your message system, then you probably should use just TCP to start
1503  with.
1504  
1505  Note that UDP datagrams are I<not> a bytestream and should not be treated
1506  as such. This makes using I/O mechanisms with internal buffering
1507  like stdio (i.e. print() and friends) especially cumbersome. Use syswrite(),
1508  or better send(), like in the example below.
1509  
1510  Here's a UDP program similar to the sample Internet TCP client given
1511  earlier.  However, instead of checking one host at a time, the UDP version
1512  will check many of them asynchronously by simulating a multicast and then
1513  using select() to do a timed-out wait for I/O.  To do something similar
1514  with TCP, you'd have to use a different socket handle for each host.
1515  
1516      #!/usr/bin/perl -w
1517      use strict;
1518      use Socket;
1519      use Sys::Hostname;
1520  
1521      my ( $count, $hisiaddr, $hispaddr, $histime,
1522       $host, $iaddr, $paddr, $port, $proto,
1523       $rin, $rout, $rtime, $SECS_of_70_YEARS);
1524  
1525      $SECS_of_70_YEARS      = 2208988800;
1526  
1527      $iaddr = gethostbyname(hostname());
1528      $proto = getprotobyname('udp');
1529      $port = getservbyname('time', 'udp');
1530      $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1531  
1532      socket(SOCKET, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
1533      bind(SOCKET, $paddr)                          || die "bind: $!";
1534  
1535      $| = 1;
1536      printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime time;
1537      $count = 0;
1538      for $host (@ARGV) {
1539      $count++;
1540      $hisiaddr = inet_aton($host)     || die "unknown host";
1541      $hispaddr = sockaddr_in($port, $hisiaddr);
1542      defined(send(SOCKET, 0, 0, $hispaddr))    || die "send $host: $!";
1543      }
1544  
1545      $rin = '';
1546      vec($rin, fileno(SOCKET), 1) = 1;
1547  
1548      # timeout after 10.0 seconds
1549      while ($count && select($rout = $rin, undef, undef, 10.0)) {
1550      $rtime = '';
1551      ($hispaddr = recv(SOCKET, $rtime, 4, 0))     || die "recv: $!";
1552      ($port, $hisiaddr) = sockaddr_in($hispaddr);
1553      $host = gethostbyaddr($hisiaddr, AF_INET);
1554      $histime = unpack("N", $rtime) - $SECS_of_70_YEARS;
1555      printf "%-12s ", $host;
1556      printf "%8d %s\n", $histime - time, scalar localtime($histime);
1557      $count--;
1558      }
1559  
1560  Note that this example does not include any retries and may consequently
1561  fail to contact a reachable host. The most prominent reason for this
1562  is congestion of the queues on the sending host if the number of
1563  list of hosts to contact is sufficiently large.
1564  
1565  =head1 SysV IPC
1566  
1567  While System V IPC isn't so widely used as sockets, it still has some
1568  interesting uses.  You can't, however, effectively use SysV IPC or
1569  Berkeley mmap() to have shared memory so as to share a variable amongst
1570  several processes.  That's because Perl would reallocate your string when
1571  you weren't wanting it to.
1572  
1573  Here's a small example showing shared memory usage.
1574  
1575      use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
1576  
1577      $size = 2000;
1578      $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) || die "$!";
1579      print "shm key $id\n";
1580  
1581      $message = "Message #1";
1582      shmwrite($id, $message, 0, 60) || die "$!";
1583      print "wrote: '$message'\n";
1584      shmread($id, $buff, 0, 60) || die "$!";
1585      print "read : '$buff'\n";
1586  
1587      # the buffer of shmread is zero-character end-padded.
1588      substr($buff, index($buff, "\0")) = '';
1589      print "un" unless $buff eq $message;
1590      print "swell\n";
1591  
1592      print "deleting shm $id\n";
1593      shmctl($id, IPC_RMID, 0) || die "$!";
1594  
1595  Here's an example of a semaphore:
1596  
1597      use IPC::SysV qw(IPC_CREAT);
1598  
1599      $IPC_KEY = 1234;
1600      $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1601      print "shm key $id\n";
1602  
1603  Put this code in a separate file to be run in more than one process.
1604  Call the file F<take>:
1605  
1606      # create a semaphore
1607  
1608      $IPC_KEY = 1234;
1609      $id = semget($IPC_KEY,  0 , 0 );
1610      die if !defined($id);
1611  
1612      $semnum = 0;
1613      $semflag = 0;
1614  
1615      # 'take' semaphore
1616      # wait for semaphore to be zero
1617      $semop = 0;
1618      $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
1619  
1620      # Increment the semaphore count
1621      $semop = 1;
1622      $opstring2 = pack("s!s!s!", $semnum, $semop,  $semflag);
1623      $opstring = $opstring1 . $opstring2;
1624  
1625      semop($id,$opstring) || die "$!";
1626  
1627  Put this code in a separate file to be run in more than one process.
1628  Call this file F<give>:
1629  
1630      # 'give' the semaphore
1631      # run this in the original process and you will see
1632      # that the second process continues
1633  
1634      $IPC_KEY = 1234;
1635      $id = semget($IPC_KEY, 0, 0);
1636      die if !defined($id);
1637  
1638      $semnum = 0;
1639      $semflag = 0;
1640  
1641      # Decrement the semaphore count
1642      $semop = -1;
1643      $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
1644  
1645      semop($id,$opstring) || die "$!";
1646  
1647  The SysV IPC code above was written long ago, and it's definitely
1648  clunky looking.  For a more modern look, see the IPC::SysV module
1649  which is included with Perl starting from Perl 5.005.
1650  
1651  A small example demonstrating SysV message queues:
1652  
1653      use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);
1654  
1655      my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
1656  
1657      my $sent = "message";
1658      my $type_sent = 1234;
1659      my $rcvd;
1660      my $type_rcvd;
1661  
1662      if (defined $id) {
1663          if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
1664              if (msgrcv($id, $rcvd, 60, 0, 0)) {
1665                  ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
1666                  if ($rcvd eq $sent) {
1667                      print "okay\n";
1668                  } else {
1669                      print "not okay\n";
1670                  }
1671              } else {
1672                  die "# msgrcv failed\n";
1673              }
1674          } else {
1675              die "# msgsnd failed\n";
1676          }
1677          msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
1678      } else {
1679          die "# msgget failed\n";
1680      }
1681  
1682  =head1 NOTES
1683  
1684  Most of these routines quietly but politely return C<undef> when they
1685  fail instead of causing your program to die right then and there due to
1686  an uncaught exception.  (Actually, some of the new I<Socket> conversion
1687  functions  croak() on bad arguments.)  It is therefore essential to
1688  check return values from these functions.  Always begin your socket
1689  programs this way for optimal success, and don't forget to add B<-T>
1690  taint checking flag to the #! line for servers:
1691  
1692      #!/usr/bin/perl -Tw
1693      use strict;
1694      use sigtrap;
1695      use Socket;
1696  
1697  =head1 BUGS
1698  
1699  All these routines create system-specific portability problems.  As noted
1700  elsewhere, Perl is at the mercy of your C libraries for much of its system
1701  behaviour.  It's probably safest to assume broken SysV semantics for
1702  signals and to stick with simple TCP and UDP socket operations; e.g., don't
1703  try to pass open file descriptors over a local UDP datagram socket if you
1704  want your code to stand a chance of being portable.
1705  
1706  =head1 AUTHOR
1707  
1708  Tom Christiansen, with occasional vestiges of Larry Wall's original
1709  version and suggestions from the Perl Porters.
1710  
1711  =head1 SEE ALSO
1712  
1713  There's a lot more to networking than this, but this should get you
1714  started.
1715  
1716  For intrepid programmers, the indispensable textbook is I<Unix
1717  Network Programming, 2nd Edition, Volume 1> by W. Richard Stevens
1718  (published by Prentice-Hall).  Note that most books on networking
1719  address the subject from the perspective of a C programmer; translation
1720  to Perl is left as an exercise for the reader.
1721  
1722  The IO::Socket(3) manpage describes the object library, and the Socket(3)
1723  manpage describes the low-level interface to sockets.  Besides the obvious
1724  functions in L<perlfunc>, you should also check out the F<modules> file
1725  at your nearest CPAN site.  (See L<perlmodlib> or best yet, the F<Perl
1726  FAQ> for a description of what CPAN is and where to get it.)
1727  
1728  Section 5 of the F<modules> file is devoted to "Networking, Device Control
1729  (modems), and Interprocess Communication", and contains numerous unbundled
1730  modules numerous networking modules, Chat and Expect operations, CGI
1731  programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1732  Threads, and ToolTalk--just to name a few.