#
# SYNOPSIS 
#
# require "sockets.pl";
#
# &socket(SOCKET_FD, 'dgram',  $connect_to, $bind_to)
# &socket(SOCKET_FD, 'udp',    $connect_to, $bind_to)
# &socket(SOCKET_FD, 'stream', $connect_to, $bind_to)
# &socket(SOCKET_FD, 'tcp',    $connect_to, $bind_to)
#
# print &unpack_IP_addr_struct(getsockname(SOME_SOCKET));
#
# DESCRIPTION
#
# &socket is a function that creates, binds, and connects sockets.
#
# You must specify a $connect_to or a $bind_to or both.  
#
# Both $connect_to and $bind_to 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 $connect_to IP 
# address, be sure to specify a port number.  
#
# IP $connect_to and $bind_to are in the format "$hostname:$port".  
# A symbolic port name will be looked up.
# 
# AUTHOR
# 
# David Muir Sharnoff <muir@idiom.com>
#

#  Copyright (c) 1993 David Muir Sharnoff

package sockets;
#$debug = 1;

require "sys/socket.ph";

# hardcoded constants, should work fine for BSD-based systems
$SOCKADDR_IP = 'S n a4 x8';
$SOCKADDR_UN = 'S a108';


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

	print "socket S: $S, type: $type, them: $them, us: $us\n" if $debug;
	if ($S !~ /'/) {
		local($p) = caller(1);
		$S = "$p'$S";
		print "S = $S\n" if $debug;
	}
	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: $!";

	print "us sockname: ",&unpack_IP_addr_struct(getsockname($S)),"\n" if $debug;

	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 $them: $!";
		print "connected\n" if $debug;
	}
	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) {
		local($op) = $ENV{'PATH'};
		$ENV{'PATH'} = "/usr/ucb:/usr/bin:/bin";
		chop($hostname = `hostname 2> /dev/null`);
		if (! $hostname) {
			chop($hostname = `uname -n`);
			if (! $hostname) {
				die "cannot determine hostname";
			}
		}
		$ENV{'PATH'} = $op;
	}
	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:$port";
	} else {
		local(@IP) = unpack('C4',$host);
		return join('.',@IP).":$port";
	}
}

1;