On Wed, Feb 16, 2005 at 10:04:09AM +0000, Nicholas Clark wrote:
> It would be simple to convert that code to perl, ship it as part of IPC::Run,
This seems to be portable OS wise (well OS X, FreeBSD and Solaris), and works
on perl 5.005 as well as 5.8.
Nicholas Clark
#!/usr/bin/perl -w
use strict;
use Socket;
# The C prototype is int family, int type, int protocol, int fd[2]
# We're always going to generate a pair of TCP/IP sockets.
sub stream_socketpair {
# Is this really generating 3 independent anonymous filehandles?
my ($listener, $connector, $acceptor) = map {local *H; *H} 1..3;
my $tcp = getprotobyname('tcp');
socket $listener, AF_INET, SOCK_STREAM, $tcp
or die "First socket failed: $!";
# 0 for port means kernel chooses
bind $listener, sockaddr_in(0, INADDR_LOOPBACK) or die "Bind failed: $!";
listen $listener, 1 or die "Listen failed: $!";
socket $connector, AF_INET, SOCK_STREAM, $tcp
or die "Second socket failed: $!";
my $connect_addr = getsockname($listener);
if (!$connect_addr) {
die "first getsockname failed: $!";
}
connect $connector, $connect_addr or die "connect failed: $!";
accept $acceptor, $listener or die "accept failed: $!";
close $listener or die "close failed: $!";
# Paranoia check - are we really talking to ourselves
my $accepted_from = getpeername($acceptor);
if (!$accepted_from) {
die "getpeername failed: $!";
}
# Note that this is not going to be the same port number as the listening
# socket, so we can't just use the address we connected to above.
my $connected_to = getsockname($connector);
if (!$connected_to) {
die "second getsockname failed: $!";
}
if ($accepted_from ne $connected_to) {
die "Consistency check failed - sockets not connected to each other "
. unpack ("H*", $accepted_from) . ' '
. unpack ("H*", $connected_to);
}
return ($connector, $acceptor);
}
my ($left, $right) = stream_socketpair;
select $left; $| = 1;
select $right; $| = 1;
select STDOUT;
print $left "Hello ";
print $right "World\n";
# Read 6 bytes on each. Else we hang
$/ = \6;
print scalar <$right>;
print scalar <$left>;
