A
all mail refused
I've been trying to put bidirectional traffic through a
local domain (aka Unix domain) socket by adapting code
from "man perlipc" as seen at
http://perl.active-venture.com/pod/perlipc-sockets.html
where the local stuff comes near the end of the page.
The original code works unidirectional - i.e. the client
reads something from the server but after making what look
to me like suitable changes I've been unable to get the server
to obtain the request from the client. I see the original
server opens STDIN from <&Client but doesn't use it.
I've also simplified it by taking the multithread stuff
out of the server. Tested so far on Linux but aiming to
go on multiple Unix versions.
Can someone show me where I'm falling down?
Client
======
#!/usr/bin/perl -w
use Socket;
use strict;
my ($rendezvous, $line);
$rendezvous = shift || 'catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die();
connect(SOCK, sockaddr_un($rendezvous)) or die();
printf(SOCK "Request something\n");
shutdown(SOCK,1); # finished writing
$line = <SOCK>;
print $line;
exit;
Server
======
#!/usr/bin/perl -Tw
use strict;
use sigtrap;
use Socket;
use Carp;
BEGIN {%ENV=('PATH'=>'/usr/ucb:/bin')}
sub spawn; # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $NAME = 'catsock';
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');
socket(Server,PF_UNIX,SOCK_STREAM,0) or die();
unlink($NAME);
bind(Server, $uaddr) or die();
listen(Server,SOMAXCONN) or die();
logmsg "server started on $NAME";
accept(Client,Server) or die("accept $!");
# Is Client now bidirectional?
logmsg "connection on $NAME";
spawn sub {
my $input=shift;
printf("(%s): Reply=XXXX\n", $input);
};
sub spawn {
my $coderef = shift;
my $input;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
close(STDIN);
open(STDIN, "<&Client") or die("open STDIN $!");
# lsof here shows we do have fd0 dup from one of the previous fds
open(STDOUT, ">&Client") or die("open STDOUT $!");
$input=<STDIN>;
$input="sample" unless (defined($input));
chomp($input);
printf(STDERR "Now executing coderef(%s)...\n", $input);
exit &$coderef($input);
}
local domain (aka Unix domain) socket by adapting code
from "man perlipc" as seen at
http://perl.active-venture.com/pod/perlipc-sockets.html
where the local stuff comes near the end of the page.
The original code works unidirectional - i.e. the client
reads something from the server but after making what look
to me like suitable changes I've been unable to get the server
to obtain the request from the client. I see the original
server opens STDIN from <&Client but doesn't use it.
I've also simplified it by taking the multithread stuff
out of the server. Tested so far on Linux but aiming to
go on multiple Unix versions.
Can someone show me where I'm falling down?
Client
======
#!/usr/bin/perl -w
use Socket;
use strict;
my ($rendezvous, $line);
$rendezvous = shift || 'catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die();
connect(SOCK, sockaddr_un($rendezvous)) or die();
printf(SOCK "Request something\n");
shutdown(SOCK,1); # finished writing
$line = <SOCK>;
print $line;
exit;
Server
======
#!/usr/bin/perl -Tw
use strict;
use sigtrap;
use Socket;
use Carp;
BEGIN {%ENV=('PATH'=>'/usr/ucb:/bin')}
sub spawn; # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $NAME = 'catsock';
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');
socket(Server,PF_UNIX,SOCK_STREAM,0) or die();
unlink($NAME);
bind(Server, $uaddr) or die();
listen(Server,SOMAXCONN) or die();
logmsg "server started on $NAME";
accept(Client,Server) or die("accept $!");
# Is Client now bidirectional?
logmsg "connection on $NAME";
spawn sub {
my $input=shift;
printf("(%s): Reply=XXXX\n", $input);
};
sub spawn {
my $coderef = shift;
my $input;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
close(STDIN);
open(STDIN, "<&Client") or die("open STDIN $!");
# lsof here shows we do have fd0 dup from one of the previous fds
open(STDOUT, ">&Client") or die("open STDOUT $!");
$input=<STDIN>;
$input="sample" unless (defined($input));
chomp($input);
printf(STDERR "Now executing coderef(%s)...\n", $input);
exit &$coderef($input);
}