Article 9529 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:9529
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!corpgate!bnrgate!bnr.co.uk!pipex!uunet!MathWorks.Com!europa.eng.gtefsd.com!news.umbc.edu!eff!news.kei.com!ub!csn!boulder!wraeththu.cs.colorado.edu!tchrist
From: Tom Christiansen <tchrist@cs.Colorado.EDU>
Subject: Re: perl code to listen/connect/etc to unix domain sockets ..
Message-ID: <CJ9q4s.78x@Colorado.EDU>
Originator: tchrist@wraeththu.cs.colorado.edu
Keywords: perl, sockets, unix
Sender: news@Colorado.EDU (USENET News System)
Reply-To: tchrist@cs.colorado.edu (Tom Christiansen)
Organization: University of Colorado, Boulder
References: <phone.757844874@cairo> <phone.757924958@cairo>
Date: Fri, 7 Jan 1994 16:36:26 GMT
Lines: 185

:-> In comp.lang.perl, phone@cairo.anu.edu.au (matthew green) writes:
:phone@cairo.anu.edu.au (matthew green) writes:
:
:>i'm after some perl code to work with unix domain sockets.
:
:please note that this is -not- covered in chat2.pl, nor anywhere
:else i can fine.  i'm talking about AF_UNIX, struct sockaddr_un,
:etc.

Look at these....


# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by  on Thu Jan  6 23:51:57 MST 1994
# Contents:  in.client un.client in.server un.server sockfuncs.pl
 
echo x - in.client
sed 's/^@//' > "in.client" <<'@//E*O*F in.client//'
require 'sys/socket.ph';
require 'sockfuncs.pl';

$remote  = shift || 'localhost';
$proto = (getprotobyname('tcp'))[2];

$iaddr = (gethostbyname($remote))[4] 		|| die "no host: $remote";
$paddr = &sockaddr_in(7778, $iaddr);

socket(SOCK, &PF_INET, &SOCK_STREAM, $proto)	|| die "socket: $!";
connect(SOCK, $paddr)				|| die "connect: $!";

print while <SOCK>;
exit;
@//E*O*F in.client//
chmod u=rw,g=rw,o=r in.client
 
echo x - un.client
sed 's/^@//' > "un.client" <<'@//E*O*F un.client//'
require 'sys/socket.ph';
require 'sockfuncs.pl';

$remote = shift || '/tmp/catsock';
socket(SOCK, &PF_UNIX, &SOCK_STREAM, 0)		|| die "socket: $!";
connect(SOCK, &sockaddr_un($remote))		|| die "connect: $!";
print while <SOCK>;
exit;
@//E*O*F un.client//
chmod u=rw,g=rw,o=r un.client
 
echo x - in.server
sed 's/^@//' > "in.server" <<'@//E*O*F in.server//'
require 'sys/socket.ph';
require 'sockfuncs.pl';
require 'ctime.pl';

#####################
$proto = (getprotobyname('tcp'))[2];


socket(SERVER, &PF_INET, &SOCK_STREAM, $proto)	|| die "socket: $!";
setsockopt(SERVER, &SOL_SOCKET, &SO_REUSEADDR, 1)
    || die "setsockopt: $!";
bind(SERVER, &sockaddr_in(7778, "\0" x 4))	|| die "bind: $!";
listen(SERVER,5) 				|| die "listen: $!";

print "$0: server started at ", &ctime(time);

for (; ($paddr = accept(CLIENT,SERVER)); close CLIENT) {
    ($port,$iaddr) = &sockaddr_in($paddr);
    ($name) = gethostbyaddr($iaddr,&AF_INET);
    print "$0: connection from $name ", &fmtaddr($iaddr), " at ", &ctime(time);

    if (!defined($pid = fork)) {
	warn "$0: cannot fork: $!";
	next;
    } elsif ($pid == 0) {
	&spawn;
    } 
    # else parent
} 

sub spawn {
    open(STDIN,  "<&CLIENT") || die "can't dup client to stdin";
    open(STDOUT, ">&CLIENT") || die "can't dup client to stdout";
    open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
    print "Hello there, $name, it's now ", &ctime(time);
    exec '/usr/games/fortune';
    die "can't exec fortune: $!";
} 
@//E*O*F in.server//
chmod u=rw,g=rw,o=r in.server
 
echo x - un.server
sed 's/^@//' > "un.server" <<'@//E*O*F un.server//'
#!/usr/bin/perl
require 'ctime.pl';
require 'sys/socket.ph';
require 'sockfuncs.pl';

$NAME = '/tmp/catsock';

$uaddr = &sockaddr_un($NAME);
$proto = (getprotobyname('tcp'))[2];

socket(SERVER,&PF_UNIX,&SOCK_STREAM,0) 	|| die "socket: $!";
unlink($NAME);
bind  (SERVER, $uaddr) 			|| die "bind: $!";
listen(SERVER,5)			 || die "listen: $!";

print "$0: server started at ", &ctime(time);

for (; accept(CLIENT,SERVER); close CLIENT) {
    print "$0: connection at ", &ctime(time);
    if (!defined($pid = fork)) {
	warn "$0: cannot fork: $!";
	next;
    } elsif ($pid == 0) {
	&spawn;
    } 
    # else parent
} 
die "accept: $!";

sub spawn {
    open(STDIN, "<&CLIENT")  || die "can't dup client to stdin";
    open(STDOUT, ">&CLIENT") || die "can't dup client to stdout";
    open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
    print "Hello there, $name, it's now ", &ctime(time);
    exec '/usr/games/fortune';
    die "can't exec fortune: $!";
} 
@//E*O*F un.server//
chmod u=rw,g=rw,o=r un.server
 
echo x - sockfuncs.pl
sed 's/^@//' > "sockfuncs.pl" <<'@//E*O*F sockfuncs.pl//'
require 'sys/socket.ph';
require 'sys/syscall.ph';

package sockfuncs;

$sockaddr_un_t = 'S a*';
$sockaddr_in_t = 'S n a4 x8';
$inetaddr_t    = 'C4';

sub main'sockaddr_un {
    wantarray
	? unpack($sockaddr_un_t, $_[0])
	: pack($sockaddr_un_t, &'AF_UNIX, @_)
}

sub main'sockaddr_in {
    wantarray 
	? (unpack($sockaddr_in_t, $_[0]))[1,2]
	: pack($sockaddr_in_t, &'AF_INET, @_)
}

sub main'inetaddr {
    wantarray
	? unpack($inetaddr_t, $_[0])
	: pack($inetaddr_t, @_)
} 

sub main'hostname {
    local($h) = "\0" x 100;
    syscall(&'SYS_gethostname,$h,length($h))
	&& die "gethostname: $!";
    $h =~ s/\0.*//;
    return $h;
}

sub main'fmtaddr {
    sprintf("[%d.%d.%d.%d]", &main'inetaddr);
} 

1;
@//E*O*F sockfuncs.pl//
chmod u=rw,g=rw,o=r sockfuncs.pl
 
exit 0
-- 
    Tom Christiansen      tchrist@cs.colorado.edu       
      "Will Hack Perl for Fine Food and Fun"
	Boulder Colorado  303-444-3212