www.pudn.com > madengine.zip > network.pl
##
## 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 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 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 () {
## .... 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;
}
## This here just to quiet -w warnings.
sub dummy {
1 || $version || &dummy;
}
1;
__END__