perlipc.pod

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

	    warn "cannot fork: $!";
	    die "bailing out" if $sleep_count++ > 6;
	    sleep 10;
	}
    } until defined $pid;

    if ($pid) {  # parent
	print KID_TO_WRITE @some_data;
	close(KID_TO_WRITE) || warn "kid exited $?";
    } else {     # child
	($EUID, $EGID) = ($UID, $GID); # suid progs only
	open (FILE, "> /safe/file")
	    || die "can't open /safe/file: $!";
	while (<STDIN>) {
	    print FILE; # child's STDIN is parent's KID
	}
	exit;  # don't forget this
    }

Another common use for this construct is when you need to execute
something without the shell's interference.  With system(), it's
straightforward, but you can't use a pipe open or backticks safely.
That's because there's no way to stop the shell from getting its hands on
your arguments.   Instead, use lower-level control to call exec() directly.

Here's a safe backtick or pipe open for read:

    # add error processing as above
    $pid = open(KID_TO_READ, "-|");

    if ($pid) {   # parent
	while (<KID_TO_READ>) {
	    # do something interesting
	}
	close(KID_TO_READ) || warn "kid exited $?";

    } else {      # child
	($EUID, $EGID) = ($UID, $GID); # suid only
	exec($program, @options, @args)
	    || die "can't exec program: $!";
	# NOTREACHED
    }


And here's a safe pipe open for writing:

    # add error processing as above
    $pid = open(KID_TO_WRITE, "|-");
    $SIG{ALRM} = sub { die "whoops, $program pipe broke" };

    if ($pid) {  # parent
	for (@data) {
	    print KID_TO_WRITE;
	}
	close(KID_TO_WRITE) || warn "kid exited $?";

    } else {     # child
	($EUID, $EGID) = ($UID, $GID);
	exec($program, @options, @args)
	    || die "can't exec program: $!";
	# NOTREACHED
    }

Note that these operations are full Unix forks, which means they may not be
correctly implemented on alien systems.  Additionally, these are not true
multithreading.  If you'd like to learn more about threading, see the
F<modules> file mentioned below in the SEE ALSO section.

=head2 Bidirectional Communication with Another Process

While this works reasonably well for unidirectional communication, what
about bidirectional communication?  The obvious thing you'd like to do
doesn't actually work:

    open(PROG_FOR_READING_AND_WRITING, "| some program |")

and if you forget to use the C<use warnings> pragma or the B<-w> flag,
then you'll miss out entirely on the diagnostic message:

    Can't do bidirectional pipe at -e line 1.

If you really want to, you can use the standard open2() library function
to catch both ends.  There's also an open3() for tridirectional I/O so you
can also catch your child's STDERR, but doing so would then require an
awkward select() loop and wouldn't allow you to use normal Perl input
operations.

If you look at its source, you'll see that open2() uses low-level
primitives like Unix pipe() and exec() calls to create all the connections.
While it might have been slightly more efficient by using socketpair(), it
would have then been even less portable than it already is.  The open2()
and open3() functions are  unlikely to work anywhere except on a Unix
system or some other one purporting to be POSIX compliant.

Here's an example of using open2():

    use FileHandle;
    use IPC::Open2;
    $pid = open2(*Reader, *Writer, "cat -u -n" );
    print Writer "stuff\n";
    $got = <Reader>;

The problem with this is that Unix buffering is really going to
ruin your day.  Even though your C<Writer> filehandle is auto-flushed,
and the process on the other end will get your data in a timely manner,
you can't usually do anything to force it to give it back to you
in a similarly quick fashion.  In this case, we could, because we
gave I<cat> a B<-u> flag to make it unbuffered.  But very few Unix
commands are designed to operate over pipes, so this seldom works
unless you yourself wrote the program on the other end of the
double-ended pipe.

A solution to this is the nonstandard F<Comm.pl> library.  It uses
pseudo-ttys to make your program behave more reasonably:

    require 'Comm.pl';
    $ph = open_proc('cat -n');
    for (1..10) {
	print $ph "a line\n";
	print "got back ", scalar <$ph>;
    }

This way you don't have to have control over the source code of the
program you're using.  The F<Comm> library also has expect()
and interact() functions.  Find the library (and we hope its
successor F<IPC::Chat>) at your nearest CPAN archive as detailed
in the SEE ALSO section below.

The newer Expect.pm module from CPAN also addresses this kind of thing.
This module requires two other modules from CPAN: IO::Pty and IO::Stty.
It sets up a pseudo-terminal to interact with programs that insist on
using talking to the terminal device driver.  If your system is 
amongst those supported, this may be your best bet.

=head2 Bidirectional Communication with Yourself

If you want, you may make low-level pipe() and fork()
to stitch this together by hand.  This example only
talks to itself, but you could reopen the appropriate
handles to STDIN and STDOUT and call other processes.

    #!/usr/bin/perl -w
    # pipe1 - bidirectional communication using two pipe pairs
    #         designed for the socketpair-challenged
    use IO::Handle;	# thousands of lines just for autoflush :-(
    pipe(PARENT_RDR, CHILD_WTR);		# XXX: failure?
    pipe(CHILD_RDR,  PARENT_WTR);		# XXX: failure?
    CHILD_WTR->autoflush(1);
    PARENT_WTR->autoflush(1);

    if ($pid = fork) {
	close PARENT_RDR; close PARENT_WTR;
	print CHILD_WTR "Parent Pid $$ is sending this\n";
	chomp($line = <CHILD_RDR>);
	print "Parent Pid $$ just read this: `$line'\n";
	close CHILD_RDR; close CHILD_WTR;
	waitpid($pid,0);
    } else {
	die "cannot fork: $!" unless defined $pid;
	close CHILD_RDR; close CHILD_WTR;
	chomp($line = <PARENT_RDR>);
	print "Child Pid $$ just read this: `$line'\n";
	print PARENT_WTR "Child Pid $$ is sending this\n";
	close PARENT_RDR; close PARENT_WTR;
	exit;
    }

But you don't actually have to make two pipe calls.  If you 
have the socketpair() system call, it will do this all for you.

    #!/usr/bin/perl -w
    # pipe2 - bidirectional communication using socketpair
    #   "the best ones always go both ways"

    use Socket;
    use IO::Handle;	# thousands of lines just for autoflush :-(
    # We say AF_UNIX because although *_LOCAL is the
    # POSIX 1003.1g form of the constant, many machines
    # still don't have it.
    socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
				or  die "socketpair: $!";

    CHILD->autoflush(1);
    PARENT->autoflush(1);

    if ($pid = fork) {
	close PARENT;
	print CHILD "Parent Pid $$ is sending this\n";
	chomp($line = <CHILD>);
	print "Parent Pid $$ just read this: `$line'\n";
	close CHILD;
	waitpid($pid,0);
    } else {
	die "cannot fork: $!" unless defined $pid;
	close CHILD;
	chomp($line = <PARENT>);
	print "Child Pid $$ just read this: `$line'\n";
	print PARENT "Child Pid $$ is sending this\n";
	close PARENT;
	exit;
    }

=head1 Sockets: Client/Server Communication

While not limited to Unix-derived operating systems (e.g., WinSock on PCs
provides socket support, as do some VMS libraries), you may not have
sockets on your system, in which case this section probably isn't going to do
you much good.  With sockets, you can do both virtual circuits (i.e., TCP
streams) and datagrams (i.e., UDP packets).  You may be able to do even more
depending on your system.

The Perl function calls for dealing with sockets have the same names as
the corresponding system calls in C, but their arguments tend to differ
for two reasons: first, Perl filehandles work differently than C file
descriptors.  Second, Perl already knows the length of its strings, so you
don't need to pass that information.

One of the major problems with old socket code in Perl was that it used
hard-coded values for some of the constants, which severely hurt
portability.  If you ever see code that does anything like explicitly
setting C<$AF_INET = 2>, you know you're in for big trouble:  An
immeasurably superior approach is to use the C<Socket> module, which more
reliably grants access to various constants and functions you'll need.

If you're not writing a server/client for an existing protocol like
NNTP or SMTP, you should give some thought to how your server will
know when the client has finished talking, and vice-versa.  Most
protocols are based on one-line messages and responses (so one party
knows the other has finished when a "\n" is received) or multi-line
messages and responses that end with a period on an empty line
("\n.\n" terminates a message/response).

=head2 Internet Line Terminators

The Internet line terminator is "\015\012".  Under ASCII variants of
Unix, that could usually be written as "\r\n", but under other systems,
"\r\n" might at times be "\015\015\012", "\012\012\015", or something
completely different.  The standards specify writing "\015\012" to be
conformant (be strict in what you provide), but they also recommend
accepting a lone "\012" on input (but be lenient in what you require).
We haven't always been very good about that in the code in this manpage,
but unless you're on a Mac, you'll probably be ok.

=head2 Internet TCP Clients and Servers

Use Internet-domain sockets when you want to do client-server
communication that might extend to machines outside of your own system.

Here's a sample TCP client using Internet-domain sockets:

    #!/usr/bin/perl -w
    use strict;
    use Socket;
    my ($remote,$port, $iaddr, $paddr, $proto, $line);

    $remote  = shift || 'localhost';
    $port    = shift || 2345;  # random port
    if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
    die "No port" unless $port;
    $iaddr   = inet_aton($remote) 		|| die "no host: $remote";
    $paddr   = sockaddr_in($port, $iaddr);

    $proto   = getprotobyname('tcp');
    socket(SOCK, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
    connect(SOCK, $paddr)    || die "connect: $!";
    while (defined($line = <SOCK>)) {
	print $line;
    }

    close (SOCK)	    || die "close: $!";
    exit;

And here's a corresponding server to go along with it.  We'll
leave the address as INADDR_ANY so that the kernel can choose
the appropriate interface on multihomed hosts.  If you want sit
on a particular interface (like the external side of a gateway
or firewall machine), you should fill this in with your real address
instead.

    #!/usr/bin/perl -Tw
    use strict;
    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    use Socket;
    use Carp;
    my $EOL = "\015\012";

    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

    my $port = shift || 2345;
    my $proto = getprotobyname('tcp');

    ($port) = $port =~ /^(\d+)$/                        or die "invalid port";

    socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
					pack("l", 1)) 	|| die "setsockopt: $!";
    bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
    listen(Server,SOMAXCONN) 				|| die "listen: $!";

    logmsg "server started on port $port";

    my $paddr;

    $SIG{CHLD} = \&REAPER;

    for ( ; $paddr = accept(Client,Server); close Client) {
	my($port,$iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr,AF_INET);

	logmsg "connection from $name [",
		inet_ntoa($iaddr), "]
		at port $port";

	print Client "Hello there, $name, it's now ",
			scalar localtime, $EOL;
    }

And here's a multithreaded version.  It's multithreaded in that
like most typical servers, it spawns (forks) a slave server to
handle the client request so that the master server can quickly
go back to service a new client.

    #!/usr/bin/perl -Tw
    use strict;
    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    use Socket;
    use Carp;
    my $EOL = "\015\012";

    sub spawn;  # forward declaration
    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

    my $port = shift || 2345;
    my $proto = getprotobyname('tcp');

    ($port) = $port =~ /^(\d+)$/                        or die "invalid port";

    socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
					pack("l", 1)) 	|| die "setsockopt: $!";
    bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
    listen(Server,SOMAXCONN) 				|| die "listen: $!";

    logmsg "server started on port $port";

    my $waitedpid = 0;
    my $paddr;

    sub REAPER {
	$waitedpid = wait;
	$SIG{CHLD} = \&REAPER;  # loathe sysV
	logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
    }

    $SIG{CHLD} = \&REAPER;

    for ( $waitedpid = 0;
	  ($paddr = accept(Client,Server)) || $waitedpid;
	  $waitedpid = 0, close Client)
    {
	next if $waitedpid and not $paddr;
	my($port,$iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr,AF_INET);

	logmsg "connection from $name [",
		inet_ntoa($iaddr), "]
		at port $port";

	spawn sub {
	    $|=1;
	    print "Hello there, $name, it's now ", scalar localtime, $EOL;
	    exec '/usr/games/fortune'		# XXX: `wrong' line terminators
		or confess "can't exec fortune: $!";
	};

    }

    sub spawn {