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 <[email protected]>
Subject: Re: perl code to listen/connect/etc to unix domain sockets ..
Message-ID: <[email protected]>
Originator: [email protected]
Keywords: perl, sockets, unix
Sender: [email protected] (USENET News System)
Reply-To: [email protected] (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, [email protected] (matthew green) writes:
:[email protected] (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      [email protected]
     "Will Hack Perl for Fine Food and Fun"
       Boulder Colorado  303-444-3212

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.