home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / pod / perlipc.pod < prev    next >
Text File  |  1996-01-30  |  32KB  |  918 lines

  1. =head1 NAME
  2.  
  3. perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocceses, 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 an 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 with 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 somtimes 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 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 SPOOLER || 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. straigh-forward, 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 L<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 L<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 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.     socket(Server, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!";
  519.     setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 
  520.                     pack("l", 1))     || die "setsockopt: $!";
  521.     bind(Server, sockaddr_in($port, INADDR_ANY))    || die "bind: $!";
  522.     listen(Server,SOMAXCONN)                 || die "listen: $!";
  523.  
  524.     logmsg "server started on port $port";
  525.  
  526.     my $waitedpid = 0;
  527.     my $paddr;
  528.  
  529.     sub REAPER { 
  530.     $SIG{CHLD} = \&REAPER;  # loathe sysV
  531.     $waitedpid = wait;
  532.     logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
  533.     }
  534.  
  535.     $SIG{CHLD} = \&REAPER;
  536.  
  537.     for ( $waitedpid = 0; 
  538.       ($paddr = accept(Client,Server)) || $waitedpid; 
  539.       $waitedpid = 0, close Client) 
  540.     {
  541.     next if $waitedpid;
  542.     my($port,$iaddr) = sockaddr_in($paddr);
  543.     my $name = gethostbyaddr($iaddr,AF_INET);
  544.  
  545.     logmsg "connection from $name [", 
  546.         inet_ntoa($iaddr), "] 
  547.         at port $port";
  548.  
  549.     spawn sub { 
  550.         print "Hello there, $name, it's now ", scalar localtime, "\n";
  551.         exec '/usr/games/fortune' 
  552.         or confess "can't exec fortune: $!";
  553.     };
  554.  
  555.     } 
  556.  
  557.     sub spawn {
  558.     my $coderef = shift;
  559.  
  560.     unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { 
  561.         confess "usage: spawn CODEREF";
  562.     }
  563.  
  564.     my $pid;
  565.     if (!defined($pid = fork)) {
  566.         logmsg "cannot fork: $!";
  567.         return;
  568.     } elsif ($pid) {
  569.         logmsg "begat $pid";
  570.         return; # i'm the parent
  571.     }
  572.     # else i'm the child -- go spawn
  573.  
  574.     open(STDIN,  "<&Client")   || die "can't dup client to stdin";
  575.     open(STDOUT, ">&Client")   || die "can't dup client to stdout";
  576.     ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
  577.     exit &$coderef();
  578.     } 
  579.  
  580. This server takes the trouble to clone off a child version via fork() for
  581. each incoming request.  That way it can handle many requests at once,
  582. which you might not always want.  Even if you don't fork(), the listen()
  583. will allow that many pending connections.  Forking servers have to be
  584. particularly careful about cleaning up their dead children (called
  585. "zombies" in Unix parlance), because otherwise you'll quickly fill up your
  586. process table.
  587.  
  588. We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
  589. even if we aren't running setuid or setgid.  This is always a good idea
  590. for servers and other programs run on behalf of someone else (like CGI
  591. scripts), because it lessens the chances that people from the outside will
  592. be able to compromise your system.
  593.  
  594. Let's look at another TCP client.  This one connects to the TCP "time"
  595. service on a number of different machines and shows how far their clocks
  596. differ from the system on which it's being run:
  597.  
  598.     #!/usr/bin/perl  -w
  599.     require 5.002;
  600.     use strict;
  601.     use Socket;
  602.  
  603.     my $SECS_of_70_YEARS = 2208988800;
  604.     sub ctime { scalar localtime(shift) } 
  605.  
  606.     my $iaddr = gethostbyname('localhost'); 
  607.     my $proto = getprotobyname('tcp');   
  608.     my $port = getservbyname('time', 'tcp');  
  609.     my $paddr = sockaddr_in(0, $iaddr);
  610.     my($host);
  611.  
  612.     $| = 1;
  613.     printf "%-24s %8s %s\n",  "localhost", 0, ctime(time());
  614.  
  615.     foreach $host (@ARGV) {
  616.     printf "%-24s ", $host;
  617.     my $hisiaddr = inet_aton($host)     || die "unknown host";
  618.     my $hispaddr = sockaddr_in($port, $hisiaddr);
  619.     socket(SOCKET, PF_INET, SOCK_STREAM, $proto)   || die "socket: $!";
  620.     connect(SOCKET, $hispaddr)          || die "bind: $!";
  621.     my $rtime = '    ';
  622.     read(SOCKET, $rtime, 4);
  623.     close(SOCKET);
  624.     my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
  625.     printf "%8d %s\n", $histime - time, ctime($histime);
  626.     }
  627.  
  628. =head2 Unix-Domain TCP Clients and Servers
  629.  
  630. That's fine for Internet-domain clients and servers, but what local
  631. communications?  While you can use the same setup, sometimes you don't
  632. want to.  Unix-domain sockets are local to the current host, and are often
  633. used internally to implement pipes.  Unlike Internet domain sockets, UNIX
  634. domain sockets can show up in the file system with an ls(1) listing.
  635.  
  636.     $ ls -l /dev/log
  637.     srw-rw-rw-  1 root            0 Oct 31 07:23 /dev/log
  638.  
  639. You can test for these with Perl's B<-S> file test:
  640.  
  641.     unless ( -S '/dev/log' ) {
  642.     die "something's wicked with the print system";
  643.     } 
  644.  
  645. Here's a sample Unix-domain client:
  646.  
  647.     #!/usr/bin/perl -w
  648.     require 5.002;
  649.     use Socket;
  650.     use strict;
  651.     my ($rendezvous, $line);
  652.  
  653.     $rendezvous = shift || '/tmp/catsock';
  654.     socket(SOCK, PF_UNIX, SOCK_STREAM, 0)    || die "socket: $!";
  655.     connect(SOCK, sockaddr_un($remote))        || die "connect: $!";
  656.     while ($line = <SOCK>) {
  657.     print $line;
  658.     } 
  659.     exit;
  660.  
  661. And here's a corresponding server.  
  662.  
  663.     #!/usr/bin/perl -Tw
  664.     require 5.002;
  665.     use strict;
  666.     use Socket;
  667.     use Carp;
  668.  
  669.     BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
  670.  
  671.     my $NAME = '/tmp/catsock';
  672.     my $uaddr = sockaddr_un($NAME);
  673.     my $proto = getprotobyname('tcp');
  674.  
  675.     socket(Server,PF_UNIX,SOCK_STREAM,0)     || die "socket: $!";
  676.     unlink($NAME);
  677.     bind  (Server, $uaddr)             || die "bind: $!";
  678.     listen(Server,SOMAXCONN)            || die "listen: $!";
  679.  
  680.     logmsg "server started on $NAME";
  681.  
  682.     $SIG{CHLD} = \&REAPER;
  683.  
  684.     for ( $waitedpid = 0; 
  685.       accept(Client,Server) || $waitedpid; 
  686.       $waitedpid = 0, close Client) 
  687.     {
  688.     next if $waitedpid;
  689.     logmsg "connection on $NAME";
  690.     spawn sub { 
  691.         print "Hello there, it's now ", scalar localtime, "\n";
  692.         exec '/usr/games/fortune' or die "can't exec fortune: $!";
  693.     };
  694.     } 
  695.  
  696. As you see, it's remarkably similar to the Internet domain TCP server, so
  697. much so, in fact, that we've omitted several duplicate functions--spawn(),
  698. logmsg(), ctime(), and REAPER()--which are exactly the same as in the
  699. other server.
  700.  
  701. So why would you ever want to use a Unix domain socket instead of a
  702. simpler named pipe?  Because a named pipe doesn't give you sessions.  You
  703. can't tell one process's data from another's.  With socket programming,
  704. you get a separate session for each client: that's why accept() takes two
  705. arguments.
  706.  
  707. For example, let's say that you have a long running database server daemon
  708. that you want folks from the World Wide Web to be able to access, but only
  709. if they go through a CGI interface.  You'd have a small, simple CGI
  710. program that does whatever checks and logging you feel like, and then acts
  711. as a Unix-domain client and connects to your private server.
  712.  
  713. =head2 UDP: Message Passing
  714.  
  715. Another kind of client-server setup is one that uses not connections, but
  716. messages.  UDP communications involve much lower overhead but also provide
  717. less reliability, as there are no promises that messages will arrive at
  718. all, let alone in order and unmangled.  Still, UDP offers some advantages
  719. over TCP, including being able to "broadcast" or "multicast" to a whole
  720. bunch of destination hosts at once (usually on your local subnet).  If you
  721. find yourself overly concerned about reliability and start building checks
  722. into your message system, then you probably should just use TCP to start
  723. with.
  724.  
  725. Here's a UDP program similar to the sample Internet TCP client given
  726. above.  However, instead of checking one host at a time, the UDP version
  727. will check many of them asynchronously by simulating a multicast and then
  728. using select() to do a timed-out wait for I/O.  To do something similar
  729. with TCP, you'd have to use a different socket handle for each host.
  730.  
  731.     #!/usr/bin/perl -w
  732.     use strict;
  733.     require 5.002;
  734.     use Socket;
  735.     use Sys::Hostname;
  736.  
  737.     my ( $count, $hisiaddr, $hispaddr, $histime, 
  738.      $host, $iaddr, $paddr, $port, $proto, 
  739.      $rin, $rout, $rtime, $SECS_of_70_YEARS);
  740.  
  741.     $SECS_of_70_YEARS      = 2208988800;
  742.  
  743.     $iaddr = gethostbyname(hostname());
  744.     $proto = getprotobyname('udp');
  745.     $port = getservbyname('time', 'udp');
  746.     $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
  747.  
  748.     socket(SOCKET, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
  749.     bind(SOCKET, $paddr)                          || die "bind: $!";
  750.  
  751.     $| = 1;
  752.     printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime time;
  753.     $count = 0;
  754.     for $host (@ARGV) {
  755.     $count++;
  756.     $hisiaddr = inet_aton($host)     || die "unknown host";
  757.     $hispaddr = sockaddr_in($port, $hisiaddr);
  758.     defined(send(SOCKET, 0, 0, $hispaddr))    || die "send $host: $!";
  759.     }
  760.  
  761.     $rin = '';
  762.     vec($rin, fileno(SOCKET), 1) = 1;
  763.  
  764.     # timeout after 10.0 seconds
  765.     while ($count && select($rout = $rin, undef, undef, 10.0)) {
  766.     $rtime = '';
  767.     ($hispaddr = recv(SOCKET, $rtime, 4, 0))     || die "recv: $!";
  768.     ($port, $hisiaddr) = sockaddr_in($hispaddr);
  769.     $host = gethostbyaddr($hisiaddr, AF_INET);
  770.     $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
  771.     printf "%-12s ", $host;
  772.     printf "%8d %s\n", $histime - time, scalar localtime($histime);
  773.     $count--;
  774.     }
  775.  
  776. =head1 SysV IPC
  777.  
  778. While System V IPC isn't so widely used as sockets, it still has some
  779. interesting uses.  You can't, however, effectively use SysV IPC or
  780. Berkeley mmap() to have shared memory so as to share a variable amongst
  781. several processes.  That's because Perl would reallocate your string when
  782. you weren't wanting it to.
  783.  
  784.  
  785. Here's a small example showing shared memory usage.  
  786.  
  787.     $IPC_PRIVATE = 0;
  788.     $IPC_RMID = 0;
  789.     $size = 2000;
  790.     $key = shmget($IPC_PRIVATE, $size , 0777 );
  791.     die unless defined $key;
  792.  
  793.     $message = "Message #1";
  794.     shmwrite($key, $message, 0, 60 ) || die "$!";
  795.     shmread($key,$buff,0,60) || die "$!";
  796.  
  797.     print $buff,"\n";
  798.  
  799.     print "deleting $key\n";
  800.     shmctl($key ,$IPC_RMID, 0) || die "$!";
  801.  
  802. Here's an example of a semaphore:
  803.  
  804.     $IPC_KEY = 1234;
  805.     $IPC_RMID = 0;
  806.     $IPC_CREATE = 0001000;
  807.     $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
  808.     die if !defined($key);
  809.     print "$key\n";
  810.  
  811. Put this code in a separate file to be run in more that one process
  812. Call the file F<take>:
  813.  
  814.     # create a semaphore
  815.  
  816.     $IPC_KEY = 1234;
  817.     $key = semget($IPC_KEY,  0 , 0 );
  818.     die if !defined($key);
  819.  
  820.     $semnum = 0;
  821.     $semflag = 0;
  822.  
  823.     # 'take' semaphore
  824.     # wait for semaphore to be zero
  825.     $semop = 0;
  826.     $opstring1 = pack("sss", $semnum, $semop, $semflag);
  827.  
  828.     # Increment the semaphore count
  829.     $semop = 1;
  830.     $opstring2 = pack("sss", $semnum, $semop,  $semflag);
  831.     $opstring = $opstring1 . $opstring2;
  832.  
  833.     semop($key,$opstring) || die "$!";
  834.  
  835. Put this code in a separate file to be run in more that one process
  836. Call this file F<give>:
  837.  
  838.     # 'give' the semaphore
  839.     # run this in the original process and you will see
  840.     # that the second process continues
  841.  
  842.     $IPC_KEY = 1234;
  843.     $key = semget($IPC_KEY, 0, 0);
  844.     die if !defined($key);
  845.  
  846.     $semnum = 0;
  847.     $semflag = 0;
  848.  
  849.     # Decrement the semaphore count
  850.     $semop = -1;
  851.     $opstring = pack("sss", $semnum, $semop, $semflag);
  852.  
  853.     semop($key,$opstring) || die "$!";
  854.  
  855. =head1 WARNING
  856.  
  857. The SysV IPC code above was written long ago, and it's definitely clunky
  858. looking.  It should at the very least be made to C<use strict> and
  859. C<require "sys/ipc.ph">.  Better yet, perhaps someone should create an
  860. C<IPC::SysV> module the way we have the C<Socket> module for normal
  861. client-server communications.
  862.  
  863. (... time passes)  
  864.  
  865. Voila!  Check out the IPC::SysV modules written by Jack Shirazi.  You can
  866. find them at a CPAN store near you.
  867.  
  868. =head1 NOTES
  869.  
  870. If you are running under version 5.000 (dubious) or 5.001, you can still
  871. use most of the examples in this document.  You may have to remove the
  872. C<use strict> and some of the my() statements for 5.000, and for both
  873. you'll have to load in version 1.2 of the F<Socket.pm> module, which
  874. was/is/shall-be included in I<perl5.001o>.
  875.  
  876. Most of these routines quietly but politely return C<undef> when they fail
  877. instead of causing your program to die right then and there due to an
  878. uncaught exception.  (Actually, some of the new I<Socket> conversion
  879. functions  croak() on bad arguments.)  It is therefore essential
  880. that you should check the return values fo these functions.  Always begin
  881. your socket programs this way for optimal success, and don't forget to add
  882. B<-T> taint checking flag to the pound-bang line for servers:
  883.  
  884.     #!/usr/bin/perl -w
  885.     require 5.002;
  886.     use strict;
  887.     use sigtrap;
  888.     use Socket;
  889.  
  890. =head1 BUGS
  891.  
  892. All these routines create system-specific portability problems.  As noted
  893. elsewhere, Perl is at the mercy of your C libraries for much of its system
  894. behaviour.  It's probably safest to assume broken SysV semantics for
  895. signals and to stick with simple TCP and UDP socket operations; e.g. don't
  896. try to pass open filedescriptors over a local UDP datagram socket if you
  897. want your code to stand a chance of being portable.
  898.  
  899. Because few vendors provide C libraries that are safely 
  900. re-entrant, the prudent programmer will do little else within 
  901. a handler beyond die() to raise an exception and longjmp(3) out.
  902.  
  903. =head1 AUTHOR
  904.  
  905. Tom Christiansen, with occasional vestiges of Larry Wall's original
  906. version.
  907.  
  908. =head1 SEE ALSO
  909.  
  910. Besides the obvious functions in L<perlfunc>, you should also check out
  911. the F<modules> file at your nearest CPAN site.  (See L<perlmod> or best
  912. yet, the F<Perl FAQ> for a description of what CPAN is and where to get it.)
  913. Section 5 of the F<modules> file is devoted to "Networking, Device Control
  914. (modems) and Interprocess Communication", and contains numerous unbundled
  915. modules numerous networking modules, Chat and Expect operations, CGI
  916. programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
  917. Threads, and ToolTalk--just to name a few.
  918.