perlipc.pod

MSYS在windows下模拟了一个类unix的终端

	while (defined ($line = <$handle>)) {
	    print STDOUT $line;
	}
	kill("TERM", $kidpid);  		# send SIGTERM to child
    }
    # the else{} block runs only in the child process
    else {
	# copy standard input to the socket
	while (defined ($line = <STDIN>)) {
	    print $handle $line;
	}
    }

The C<kill> function in the parent's C<if> block is there to send a
signal to our child process (current running in the C<else> block)
as soon as the remote server has closed its end of the connection.

If the remote server sends data a byte at time, and you need that
data immediately without waiting for a newline (which might not happen),
you may wish to replace the C<while> loop in the parent with the
following:

    my $byte;
    while (sysread($handle, $byte, 1) == 1) {
	print STDOUT $byte;
    }

Making a system call for each byte you want to read is not very efficient
(to put it mildly) but is the simplest to explain and works reasonably
well.

=head1 TCP Servers with IO::Socket

As always, setting up a server is little bit more involved than running a client.
The model is that the server creates a special kind of socket that
does nothing but listen on a particular port for incoming connections.
It does this by calling the C<< IO::Socket::INET->new() >> method with
slightly different arguments than the client did.

=over 4

=item Proto

This is which protocol to use.  Like our clients, we'll
still specify C<"tcp"> here.

=item LocalPort

We specify a local
port in the C<LocalPort> argument, which we didn't do for the client.
This is service name or port number for which you want to be the
server. (Under Unix, ports under 1024 are restricted to the
superuser.)  In our sample, we'll use port 9000, but you can use
any port that's not currently in use on your system.  If you try
to use one already in used, you'll get an "Address already in use"
message.  Under Unix, the C<netstat -a> command will show
which services current have servers.

=item Listen

The C<Listen> parameter is set to the maximum number of
pending connections we can accept until we turn away incoming clients.
Think of it as a call-waiting queue for your telephone.
The low-level Socket module has a special symbol for the system maximum, which
is SOMAXCONN.

=item Reuse

The C<Reuse> parameter is needed so that we restart our server
manually without waiting a few minutes to allow system buffers to
clear out.

=back

Once the generic server socket has been created using the parameters
listed above, the server then waits for a new client to connect
to it.  The server blocks in the C<accept> method, which eventually an
bidirectional connection to the remote client.  (Make sure to autoflush
this handle to circumvent buffering.)

To add to user-friendliness, our server prompts the user for commands.
Most servers don't do this.  Because of the prompt without a newline,
you'll have to use the C<sysread> variant of the interactive client above.

This server accepts one of five different commands, sending output
back to the client.  Note that unlike most network servers, this one
only handles one incoming client at a time.  Multithreaded servers are
covered in Chapter 6 of the Camel.

Here's the code.  We'll

 #!/usr/bin/perl -w
 use IO::Socket;
 use Net::hostent;		# for OO version of gethostbyaddr

 $PORT = 9000;			# pick something not in use

 $server = IO::Socket::INET->new( Proto     => 'tcp',
                                  LocalPort => $PORT,
                                  Listen    => SOMAXCONN,
                                  Reuse     => 1);

 die "can't setup server" unless $server;
 print "[Server $0 accepting clients]\n";

 while ($client = $server->accept()) {
   $client->autoflush(1);
   print $client "Welcome to $0; type help for command list.\n";
   $hostinfo = gethostbyaddr($client->peeraddr);
   printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
   print $client "Command? ";
   while ( <$client>) {
     next unless /\S/;	     # blank line
     if    (/quit|exit/i)    { last;                                     }
     elsif (/date|time/i)    { printf $client "%s\n", scalar localtime;  }
     elsif (/who/i )         { print  $client `who 2>&1`;                }
     elsif (/cookie/i )      { print  $client `/usr/games/fortune 2>&1`; }
     elsif (/motd/i )        { print  $client `cat /etc/motd 2>&1`;      }
     else {
       print $client "Commands: quit date who cookie motd\n";
     }
   } continue {
      print $client "Command? ";
   }
   close $client;
 }

=head1 UDP: Message Passing

Another kind of client-server setup is one that uses not connections, but
messages.  UDP communications involve much lower overhead but also provide
less reliability, as there are no promises that messages will arrive at
all, let alone in order and unmangled.  Still, UDP offers some advantages
over TCP, including being able to "broadcast" or "multicast" to a whole
bunch of destination hosts at once (usually on your local subnet).  If you
find yourself overly concerned about reliability and start building checks
into your message system, then you probably should use just TCP to start
with.

Note that UDP datagrams are I<not> a bytestream and should not be treated
as such. This makes using I/O mechanisms with internal buffering
like stdio (i.e. print() and friends) especially cumbersome. Use syswrite(),
or better send(), like in the example below.

Here's a UDP program similar to the sample Internet TCP client given
earlier.  However, instead of checking one host at a time, the UDP version
will check many of them asynchronously by simulating a multicast and then
using select() to do a timed-out wait for I/O.  To do something similar
with TCP, you'd have to use a different socket handle for each host.

    #!/usr/bin/perl -w
    use strict;
    use Socket;
    use Sys::Hostname;

    my ( $count, $hisiaddr, $hispaddr, $histime,
	 $host, $iaddr, $paddr, $port, $proto,
	 $rin, $rout, $rtime, $SECS_of_70_YEARS);

    $SECS_of_70_YEARS      = 2208988800;

    $iaddr = gethostbyname(hostname());
    $proto = getprotobyname('udp');
    $port = getservbyname('time', 'udp');
    $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick

    socket(SOCKET, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
    bind(SOCKET, $paddr)                          || die "bind: $!";

    $| = 1;
    printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime time;
    $count = 0;
    for $host (@ARGV) {
	$count++;
	$hisiaddr = inet_aton($host) 	|| die "unknown host";
	$hispaddr = sockaddr_in($port, $hisiaddr);
	defined(send(SOCKET, 0, 0, $hispaddr))    || die "send $host: $!";
    }

    $rin = '';
    vec($rin, fileno(SOCKET), 1) = 1;

    # timeout after 10.0 seconds
    while ($count && select($rout = $rin, undef, undef, 10.0)) {
	$rtime = '';
	($hispaddr = recv(SOCKET, $rtime, 4, 0)) 	|| die "recv: $!";
	($port, $hisiaddr) = sockaddr_in($hispaddr);
	$host = gethostbyaddr($hisiaddr, AF_INET);
	$histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
	printf "%-12s ", $host;
	printf "%8d %s\n", $histime - time, scalar localtime($histime);
	$count--;
    }

Note that this example does not include any retries and may consequently
fail to contact a reachable host. The most prominent reason for this
is congestion of the queues on the sending host if the number of
list of hosts to contact is sufficiently large.

=head1 SysV IPC

While System V IPC isn't so widely used as sockets, it still has some
interesting uses.  You can't, however, effectively use SysV IPC or
Berkeley mmap() to have shared memory so as to share a variable amongst
several processes.  That's because Perl would reallocate your string when
you weren't wanting it to.

Here's a small example showing shared memory usage.

    use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);

    $size = 2000;
    $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
    print "shm key $id\n";

    $message = "Message #1";
    shmwrite($id, $message, 0, 60) || die "$!";
    print "wrote: '$message'\n";
    shmread($id, $buff, 0, 60) || die "$!";
    print "read : '$buff'\n";

    # the buffer of shmread is zero-character end-padded.
    substr($buff, index($buff, "\0")) = '';
    print "un" unless $buff eq $message;
    print "swell\n";

    print "deleting shm $id\n";
    shmctl($id, IPC_RMID, 0) || die "$!";

Here's an example of a semaphore:

    use IPC::SysV qw(IPC_CREAT);

    $IPC_KEY = 1234;
    $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
    print "shm key $id\n";

Put this code in a separate file to be run in more than one process.
Call the file F<take>:

    # create a semaphore

    $IPC_KEY = 1234;
    $id = semget($IPC_KEY,  0 , 0 );
    die if !defined($id);

    $semnum = 0;
    $semflag = 0;

    # 'take' semaphore
    # wait for semaphore to be zero
    $semop = 0;
    $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);

    # Increment the semaphore count
    $semop = 1;
    $opstring2 = pack("s!s!s!", $semnum, $semop,  $semflag);
    $opstring = $opstring1 . $opstring2;

    semop($id,$opstring) || die "$!";

Put this code in a separate file to be run in more than one process.
Call this file F<give>:

    # 'give' the semaphore
    # run this in the original process and you will see
    # that the second process continues

    $IPC_KEY = 1234;
    $id = semget($IPC_KEY, 0, 0);
    die if !defined($id);

    $semnum = 0;
    $semflag = 0;

    # Decrement the semaphore count
    $semop = -1;
    $opstring = pack("s!s!s!", $semnum, $semop, $semflag);

    semop($id,$opstring) || die "$!";

The SysV IPC code above was written long ago, and it's definitely
clunky looking.  For a more modern look, see the IPC::SysV module
which is included with Perl starting from Perl 5.005.

A small example demonstrating SysV message queues:

    use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);

    my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);

    my $sent = "message";
    my $type = 1234;
    my $rcvd;
    my $type_rcvd;

    if (defined $id) {
        if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
            if (msgrcv($id, $rcvd, 60, 0, 0)) {
                ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
                if ($rcvd eq $sent) {
                    print "okay\n";
                } else {
                    print "not okay\n";
                }
            } else {
                die "# msgrcv failed\n";
            }
        } else {
            die "# msgsnd failed\n";
        }
        msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
    } else {
        die "# msgget failed\n";
    }

=head1 NOTES

Most of these routines quietly but politely return C<undef> when they
fail instead of causing your program to die right then and there due to
an uncaught exception.  (Actually, some of the new I<Socket> conversion
functions  croak() on bad arguments.)  It is therefore essential to
check return values from these functions.  Always begin your socket
programs this way for optimal success, and don't forget to add B<-T>
taint checking flag to the #! line for servers:

    #!/usr/bin/perl -Tw
    use strict;
    use sigtrap;
    use Socket;

=head1 BUGS

All these routines create system-specific portability problems.  As noted
elsewhere, Perl is at the mercy of your C libraries for much of its system
behaviour.  It's probably safest to assume broken SysV semantics for
signals and to stick with simple TCP and UDP socket operations; e.g., don't
try to pass open file descriptors over a local UDP datagram socket if you
want your code to stand a chance of being portable.

As mentioned in the signals section, because few vendors provide C
libraries that are safely re-entrant, the prudent programmer will do
little else within a handler beyond setting a numeric variable that
already exists; or, if locked into a slow (restarting) system call,
using die() to raise an exception and longjmp(3) out.  In fact, even
these may in some cases cause a core dump.  It's probably best to avoid
signals except where they are absolutely inevitable.  This 
will be addressed in a future release of Perl.

=head1 AUTHOR

Tom Christiansen, with occasional vestiges of Larry Wall's original
version and suggestions from the Perl Porters.

=head1 SEE ALSO

There's a lot more to networking than this, but this should get you
started.

For intrepid programmers, the indispensable textbook is I<Unix Network
Programming> by W. Richard Stevens (published by Addison-Wesley).  Note
that most books on networking address networking from the perspective of
a C programmer; translation to Perl is left as an exercise for the reader.

The IO::Socket(3) manpage describes the object library, and the Socket(3)
manpage describes the low-level interface to sockets.  Besides the obvious
functions in L<perlfunc>, you should also check out the F<modules> file
at your nearest CPAN site.  (See L<perlmodlib> or best yet, the F<Perl
FAQ> for a description of what CPAN is and where to get it.)

Section 5 of the F<modules> file is devoted to "Networking, Device Control
(modems), and Interprocess Communication", and contains numerous unbundled
modules numerous networking modules, Chat and Expect operations, CGI
programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
Threads, and ToolTalk--just to name a few.