Article 9541 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:9541
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!math.ohio-state.edu!sdd.hp.com!sgiblab!idiom.berkeley.ca.us!idiom.berkeley.ca.us!not-for-mail
From: [email protected] (David Muir Sharnoff)
Newsgroups: comp.lang.perl
Subject: Re: perl code to listen/connect/etc to unix domain sockets ..
Date: 7 Jan 1994 12:20:29 -0800
Organization: Idiom Consulting / Berkeley, CA  USA
Lines: 284
Message-ID: <[email protected]>
References: <phone.757844874@cairo>
NNTP-Posting-Host: idiom.berkeley.ca.us
Keywords: perl, sockets, unix

In article <phone.757844874@cairo> [email protected] (matthew green) writes:
>i'm after some perl code to work with unix domain sockets.

I played with this a couple of months ago:

-------------------------------------------------

#  Copyright (c) 1993 David Muir Sharnoff
#  License at bottom of file

package sockets;

# hardcoded constants, should work fine for BSD-based systems
$AF_UNIX = 1;
$AF_INET = 2;
$SOCK_STREAM = 1;
$SOCK_DGRAM  = 2;
$SOCKADDR_IP = 'S n a4 x8';
$SOCKADDR_UN = 'S a108';

#
# &socket is a function that creates, binds, and connects
# sockets.
#
# Arguments:
# $S    - the name of the socket, eg 'SOC'.  Use <SOC> elsewhere.
# $type - datagram (dgram) or stream.
# $them - the remote address (optional)
# $us   - the local address (optional)
#
# Both $us and $them are in a flexible format.  If they look like a
# unix path (begins with /) then it is assumed you want a unix-domain
# socket.  Otherwise an IP socket is assumed.
#
# There is no default port number.   If you specify a $them IP address,
# be sure to specify a port number.
#
# IP $us and $them are in the format "$hostname/$port".  A symbolic
# port name will be looked up.
#

sub main'socket
{
       local($S,$type,$them,$us) = @_;
       local($t,$ip);

       if ("\L$type" eq 'stream' || "\L$type" eq 'tcp' || $type == $SOCK_STREAM) {
               $t = $SOCK_STREAM;
               $ip = 'tcp';
       } elsif ("\L$type" eq 'dgram' || "\L$type" eq 'udp' || $type == $SOCK_DGRAM) {
               $t = $SOCK_DGRAM;
               $ip = 'udp'
       } else {
               die "could not figure out socket type: $type";
       }

       if (($them =~ m,^/,) || ($us =~ m,^/,)) {
               &unix_socket($S,$t,$them,$us);
       } else {
               &ip_socket($S,$t,$ip,$them,$us);
       }
}

sub unix_socket
{
       local($S,$type,$them,$us) = @_;
       local($us_struct,$them_struct);

       print "unix socket $type, $them, $us\n" if $debug;
       socket($S, $AF_UNIX, $t, 0)
           || die "socket: $!";

       if ($us) {
               $us_struct = pack($SOCKADDR_UN, $AF_UNIX, $us);
               bind($S, $us_struct) || die "bind unix socket $us: $!";
       }
       if ($them) {
               $them_struct = pack($SOCKADDR_UN, $AF_UNIX, $them);
               connect($S, $them_struct) || die "connect unix socket $them: $!";
       }
       select((select($S),$| = 1)[0]); # don't buffer output
}

sub ip_socket
{
       local($S,$type,$protocol,$them,$us) = @_;

       local($their_port,$their_host);

       local($our_addr_struct) = &get_IP_addr_struct($protocol,$us);

       socket($S, $AF_INET, $t, &get_proto_number($protocol))
               || die "socket: $!";

       print "us $protocol,$us,$them: ",&unpack_IP_addr_struct($our_addr_struct),"\n" if $debug;
       bind($S, $our_addr_struct)
               || die "bind $hostname,0: $!";

       if ($them) {
               local($their_addr_struct) = &get_IP_addr_struct($protocol,$them);
               print "them $protocol,$us,$them: ",&unpack_IP_addr_struct($their_addr_struct),"\n" if $debug;
               connect($S, $their_addr_struct)
                       || die "connect $host: $!";
       }
       select((select($S),$| = 1)[0]); # don't buffer output
}

#
# Create IP address structures.
#
# The first argument must be 'tcp', or 'udp'.
# The second argument is the host (`hostname` if null) to connect to.
# The third argument is the port to bind to.   Pass 0 if any will do.
#
# The return arguments are a protocol value that can use by socket()
# and a port address that can be used by bind().
#
sub get_IP_addr_struct
{
       local($protocol,$host,$port) = @_;
       local($junk,$host_addr);

       if (! $port && ($host =~ s,([^/]+)/(.+),$1,)) {
               $port = $2;
       }
       $host = &hostname()
               if ! $host;
       ($junk,$junk,$junk,$junk,$host_addr) = gethostbyname($host);

       die "gethostbyname($host): $!"
               unless $host_addr;

       if ($port =~ /[^\d]/) {
               ($junk,$junk,$port) = getservbyname($port,$protocol);
               die "getservbyname($port,$protocol): $!"
                       unless $port;
       }

       return pack($SOCKADDR_IP, $AF_INET, $port, $host_addr);
}

sub get_proto_number
{
       local($protocol) = @_;
       local($junk,$proto);

       ($junk,$junk,$proto) = getprotobyname($protocol);

       die "getprotobyname($protocol): $!"
               unless $proto;

       return $proto;
}

sub hostname
{
       if (! $hostname) {
               chop($hostname = `hostname`);
               if (! $hostname) {
                       chop($hostname = `uname -n`);
                       if (! $hostname) {
                               die "cannot determine hostname";
                       }
               }
       }
       return $hostname;
}

#
# An extra...
#

sub unpack_IP_addr_struct
{
       local($addr) = @_;
       local($name,@junk);
       local($af,$port,$host) = unpack($SOCKADDR_IP,$addr);
       ($name,@junk) = gethostbyaddr($host,$AF_INET);
       if ($name) {
               return $name;
       } else {
               local(@IP) = unpack('C4',$host);
               return join('.',@IP)."/$port";
       }
}

#############################################################################
#
#  Copyright (c) 1993 David Muir Sharnoff
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by the David Muir Sharnoff.
#  4. The name of David Sharnoff may not be used to endorse or promote products
#     derived from this software without specific prior written permission.
#
#  THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
# This copyright notice derrived from material copyrighted by the Regents
# of the University of California.
#
# Contributions accepted.
#
#############################################################################

1;

-------------------------------------------------

Here are some test routines that should show you how to use &socket().

$uport = ....

sub unix_stream_server
{
       &main'socket(ST,STREAM,"",$uport);
       listen(ST,5) || die "listen: $!";
       ($their_addr = accept(NST,ST)) || die "accept: $!";
       if ($debug) {
               ($junk,$their_path) = unpack($SOCKADDR_UN,$their_addr);
               print "Their address: $their_path\n";
       }
       select((select(NST),$| = 1)[0]); # don't buffer output
       print NST "Server here\n";
       $x = <NST>;
       print ($x eq "Client here\n" ? "ok 6\n" : "not ok 6\n");
       close(NST);
       close(ST);
       unlink($uport);
}

sub unix_stream_client
{
       &main'socket(CT,STREAM,$uport,"");
       $x = <CT>;
       print ($x eq "Server here\n" ? "ok 5\n" : "not ok 5\n");
       print CT "Client here\n";
       close(CT);
}

sub unix_dgram_server
{
       &main'socket(ST,DGRAM,"",$uport);
       $their_addr = recv(ST,$x,1024,0);
       if ($debug) {
               ($junk,$their_path) = unpack($SOCKADDR_UN,$their_addr);
               print "Their address: $their_path\n";
       }
       print "their-addr: $their_addr\n" if $debug;
       print ($x eq "Client here\n" ? "ok 7\n" : "not ok 7\n");
       send(ST,"Server here\n",0,$their_addr);
       close(ST);
       unlink($uport);
}

sub unix_dgram_client
{
       &main'socket(CT,DGRAM,$uport,"/tmp/us2.$$");
       print CT "Client here\n";
       $x = <CT>;
       print ($x eq "Server here\n" ? "ok 8\n" : "not ok 8\n");
       close(CT);
       unlink("/tmp/us2.$$");
}

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.