212 lines
5.4 KiB
Perl
212 lines
5.4 KiB
Perl
##
|
|
## Jeffrey Friedl (jfriedl@omron.co.jp)
|
|
## Copyri.... ah hell, just take it.
|
|
##
|
|
## July 1994
|
|
##
|
|
package network;
|
|
$version = "950311.5";
|
|
|
|
## 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
|
|
|
|
if (defined($to) && length($from)==16 && length($to)==16) {
|
|
## ok just as is
|
|
} elsif (defined($host)) {
|
|
$to = &get_addr($host, $port);
|
|
return qq/unknown address "$host"/ unless defined $to;
|
|
$from = &my_addr;
|
|
} else {
|
|
return "unknown arguments to network'connect_to";
|
|
}
|
|
|
|
return "connect_to failed (socket: $!)" unless &my_inet_socket(*FD);
|
|
return "connect_to failed (bind: $!)" unless bind(FD, $from);
|
|
return "connect_to failed (connect: $!)" unless connect(FD, $to);
|
|
local($old) = select(FD); $| = 1; select($old);
|
|
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) = @_;
|
|
local($empty) = pack('S n a4 x8', 2 ,$port, "\0\0\0\0");
|
|
return "listen_for failed (socket: $!)" unless &my_inet_socket(*FD);
|
|
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]);
|
|
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
|
|
{
|
|
local(@x) = gethostbyname('localhost');
|
|
local(@y) = gethostbyname($x[0]);
|
|
# local($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($x[0]);
|
|
# local(@bytes) = unpack("C4",$addrs[0]);
|
|
# return pack('S n a4 x8', 2 ,0, $addr);
|
|
return pack('S n a4 x8', 2 ,0, $y[4]);
|
|
}
|
|
|
|
|
|
##
|
|
## 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"
|
|
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__
|