##
## Jeffrey Friedl (jfriedl@yahoo-inc.com)
## Copyri.... ah hell, just take it.
##
## July 1994
##

package network;
$version = "980331.12";
## version 980331.12 -- updated my email -- commented out a bind() call
##                      Add back in if things don't seem to work -- it seems
##                      quite strange.
## version 970124.11 -- yet again update how the output of nslookup is parsed.
## version 961205.10 -- removed bind (no sure why was there in the first place)
## version 960731.9 -- added uname to check for hostname. Thanks to
##                     Rusty Hodge <rusty@host.domain.net> for the idea.
## version 960723.8 -- added upper-case version of environmental variables
##                     for OS/2.
## version 960514.7 -- relaxed the check on nslookup's output. Thanks to
##                     Martin Moessel <mm@sybase.com> for helpful feedback.
## version 960206.6 -- have connect_to use 'localhost' if the real host bind
##                     doesn't work (as it doesn't seem to want to under linux)
## version 950311.5 -- turned off warnings when requiring 'socket.ph';
## version 941028.4 -- some changes to quiet perl5 warnings.
## version 940826.3 -- added check for "socket.ph", and alternate use of
## socket STREAM value for SunOS5.x
##

## BLURB:
## A few simple and easy-to-use routines to make internet connections. 
## Similar to "chat2.pl" (but actually commented, and a bit more portable).
## Should work even on SunOS5.x.
##

##>
##
## connect_to() -- make an internet connection to a server.
##
## Two uses:
##	$error = &network'connect_to(*FILEHANDLE, $fromsockaddr, $tosockaddr)
##      $error = &network'connect_to(*FILEHANDLE, $hostname, $portnum)
##
## Makes the given connection and returns an error string, or undef if
## no error.
##
## In the first form, FROMSOCKADDR and TOSOCKADDR are of the form returned
## by SOCKET'GET_ADDR and SOCKET'MY_ADDR.
##
##<
sub connect_to
{
    local(*FD, $arg1, $arg2) = @_;
    local($from, $to)   = ($arg1, $arg2); ## for one interpretation.
    local($host, $port) = ($arg1, $arg2); ## for the other
    local(@from);

    if (defined($to) && length($from)==16 && length($to)==16) {
	@from = ($from);
	## ok just as is
    } elsif (defined $host) {
	$to = &get_addr($host, $port);
	return qq/unknown address "$host"/ unless defined $to;
	@from = ($ENV{'NetworkHost'}, $ENV{'NETWORKHOST'}, &my_addr,
		 $ENV{'HOST'}, 'localhost');
    } else {
	return "unknown arguments to network'connect_to";
    }

    return "connect_to failed (socket: $!)"  unless &my_inet_socket(*FD);
    local($bind_ok) = 0;
    foreach $from (@from) {
	next if !defined $from;
	$from = &ifconfig($1) if $from =~ m/^ifconfig:\s*(.*)/;
	$from = &get_addr($from, 0) if length($from) != 16;
	$bind_ok = 1, last if bind(FD, $from);
    }
    return "connect_to failed (bind: $!)" unless $bind_ok;
    return "connect_to failed (connect: $!)" unless connect(FD, $to);
    local($old) = select(FD); $| = 1; select($old);
    undef;
}

##
## Run ifconfig and try to nab the local IP address from it.  If there's an
## arg (and it's not "any" -- usually eth0 or ppp0, probably), only that
## interface will be checked.
##
## In all cases, any 'lo' (loopback) interface is ignored, even if you
## ask for it.
##
sub ifconfig
{
    local($arg) = @_;
    $arg = '' if (!$arg) || ($arg eq 'any');
    return $ifconfig{$arg} if defined $ifconfig{$arg}; ## check local cache
    local($/) = '';
    foreach (grep(!/^lo/ && /\bRUNNING\b/ && /\bUP\b/, `ifconfig $arg`)) {
	return ($ifconfig{$arg} = $1) if /addr:([\d.]+)/;
    }
    undef;
}

##>
##
## listen_at() - used by a server to indicate that it will accept requests
##               at the port number given.
##
## Used as
##	$error = &network'listen_at(*LISTEN, $portnumber);
## (returns undef upon success)
##
## You can then do something like
##     $addr = accept(REMOTE, LISTEN);
##     print "contact from ", &network'addr_to_ascii($addr), ".\n";
##     while (<REMOTE>) {
##        .... process request....
##     }
##     close(REMOTE);
##
##<
sub listen_at
{
    local(*FD, $port) = @_;
    return "listen_for failed (socket: $!)"  unless &my_inet_socket(*FD);

    ##
    ## It seems that some systems need this, and that some (such as
    ## recent versions of Linix) don't.
    ##
    #
    #local($empty) = pack('S n a4 x8', 2 ,$port, "\0\0\0\0");
    #return "listen_for failed (bind: $!)"    unless bind(FD, $empty);
    #

    return "listen_for failed (listen: $!)"  unless listen(FD, 5);
    local($old) = select(FD); $| = 1; select($old);
    undef;
}


##>
##
## Given an internal packed internet address (as returned by &connect_to
## or &get_addr), return a printable ``1.2.3.4'' version.
##
##<
sub addr_to_ascii
{
    local($addr) = @_;
    return "bad arg" if length $addr != 16;
    return join('.', unpack("CCCC", (unpack('S n a4 x8', $addr))[2]));
}

##
## 
## Given a host and a port name, returns the packed socket addresss.
## Mostly for internal use.
##
##
sub get_addr
{
    local($host, $port) = @_;
    return $addr{$host,$port} if defined $addr{$host,$port};
    local($addr);

    if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/) {
	$addr = pack("C4", split(/\./, $host));
    } elsif ($addr = (gethostbyname($host))[4], !defined $addr) {
        local(@lookup) = `nslookup $host 2>&1`;
	if (@lookup)
	{
#	    local($lookup) = join('', @lookup[2 .. $#lookup]);

	    local($lookup) = join('', @lookup);
	    # remove the nameserver from the output.
	    $lookup =~ s/Server.*\nAddress.*//g;

	    if ($lookup =~ m/Address:\s*(\d+\.\d+\.\d+\.\d+)/) {
	        $addr = pack("C4", split(/\./, $1));
	    }
	}
	if (!defined $addr) {
	    ## warn "$host: SOL, dude\n";
	    return undef;
	}
    }
    $addr{$host,$port} = pack('S n a4 x8', 2, $port, $addr);
}



##
## my_addr()
## Returns the packed socket address of the local host (port 0)
## Mostly for internal use.
##
##
sub my_addr
{
    return $addr{'me'} if defined $addr{'me'};

    {
	local($^W) = 0; ## no -w while checking for the hostname
	chop($_myhostname_ = `uname -n`) if !defined $_myhostname_;
	chop($_myhostname_ = `hostname`) if !defined $_myhostname_;
    }

    $addr{'me'} = &get_addr($_myhostname_, 0);
}


##
## my_inet_socket(*FD);
##
## Local routine to do socket(PF_INET, SOCK_STREAM, AF_NS).
## Takes care of figuring out the proper values for the args. Hopefully.
##
## Returns the same value as 'socket'.
##
sub my_inet_socket
{
    local(*FD) = @_;
    local($socket);

    if (!defined $socket_values_queried)
    {
	## try to load some "socket.ph" or Socket module.
	if (($[ >= 5) && (!defined &main'_SYS_SOCKET_H_)) {
	    eval 'use Socket';
        }

	if (!defined &main'_SYS_SOCKET_H_) {
	  eval 'package main;
	        local($^W) = 0;
                require("sys/socket.ph")||require("socket.ph");';
	}

	## we'll use "the regular defaults" if for PF_INET and AF_NS if unknown
	$PF_INET     = defined &main'PF_INET ? &main'PF_INET : 2;
	$AF_NS       = defined &main'AF_NS   ? &main'AF_NS   : 6;
	$SOCK_STREAM = &main'SOCK_STREAM if defined &main'SOCK_STREAM;

	$socket_values_queried = 1;
    }

    if (defined $SOCK_STREAM) {
	$socket = socket(FD, $PF_INET, $SOCK_STREAM, $AF_NS);
    } else {
	##
	## We'll try the "regular default" of 1. If that returns a
	## "not supported" error, we'll try 2, which SunOS5.x uses.
	##
	$socket = socket(FD, $PF_INET, 1, $AF_NS);
	if ($socket) {
	    $SOCK_STREAM = 1; ## got it.
	} elsif ($! =~ m/not supported/i) {
	    ## we'll just assume from now on that it's 2.
	    $socket = socket(FD, $PF_INET, $SOCK_STREAM = 2, $AF_NS);
	}
    }
    $socket;
}


##
## makeconn (makes a connection between client/server)
##
sub makeconn 
{

   my ($host, $portname, $server, $port, $proto, $servaddr);

   $host = $_[0];
   $portname = $_[1];

   #
   # Server hostname, port and protocol
   #
  $server = gethostbyname($host) or
      die "gethostbyname: cannot locate host: $!";
  $port = getservbyname($portname, 'tcp') or
      die "getservbyname: cannot get port: $!";
  $proto = getprotobyname('tcp') or
      die "getprotobyname: cannot get proto: $!";

   #
   # Build an inet address
   #
 $servaddr = sockaddr_in($port, $server);


   #
   # Create the socket and connect it
   #
 socket(CONNFD, PF_INET, SOCK_STREAM, $proto);
 connect(CONNFD, $servaddr) or die "connect: $!";

 return CONNFD;
}



##
## makelisten (places a socket in the listen state)
##
sub makelisten 
{

    my ($portname, $port, $proto, $servaddr);
    $portname = $_[0];

    #
    # port and protocol
    #
    $port = getservbyname($portname, 'tcp') or
    die "getservbyname: cannot get port : $!";
    $proto = getprotobyname('tcp') or
    die "getprotobyname: cannot get proto : $!";

    #
    # Bind an inet address
    #
    socket(LISTFD, PF_INET, SOCK_STREAM, $proto);
    bind (LISTFD, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
    listen (LISTFD, SOMAXCONN) or die "listen: $!";
    return LISTFD;
}



##
## makeudpcli (sets up a SOCK_DGRAM socket)
##
sub makeudpcli 
{
    
    my ($proto, $servaddr);

    $proto = getprotobyname('udp') or
    die "getprotobyname: cannot get proto : $!";

    #
    # Bind a UDP port
    #
    socket(DGFD, PF_INET, SOCK_DGRAM, $proto);
    bind (DGFD,  sockaddr_in(0, INADDR_ANY)) or die "bind: $!";

    return DGFD;
}



## This here just to quiet -w warnings.
sub dummy {
  1 || $version || &dummy;
}

1;
__END__