2 ## Jeffrey Friedl (jfriedl@omron.co.jp)
3 ## Copyri.... ah hell, just take it.
10 ## version 950311.5 -- turned off warnings when requiring 'socket.ph';
11 ## version 941028.4 -- some changes to quiet perl5 warnings.
12 ## version 940826.3 -- added check for "socket.ph", and alternate use of
13 ## socket STREAM value for SunOS5.x
17 ## A few simple and easy-to-use routines to make internet connections.
18 ## Similar to "chat2.pl" (but actually commented, and a bit more portable).
19 ## Should work even on SunOS5.x.
24 ## connect_to() -- make an internet connection to a server.
27 ## $error = &network'connect_to(*FILEHANDLE, $fromsockaddr, $tosockaddr)
28 ## $error = &network'connect_to(*FILEHANDLE, $hostname, $portnum)
30 ## Makes the given connection and returns an error string, or undef if
33 ## In the first form, FROMSOCKADDR and TOSOCKADDR are of the form returned
34 ## by SOCKET'GET_ADDR and SOCKET'MY_ADDR.
39 local(*FD, $arg1, $arg2) = @_;
40 local($from, $to) = ($arg1, $arg2); ## for one interpretation.
41 local($host, $port) = ($arg1, $arg2); ## for the other
43 if (defined($to) && length($from)==16 && length($to)==16) {
45 } elsif (defined($host)) {
46 $to = &get_addr($host, $port);
47 return qq/unknown address "$host"/ unless defined $to;
50 return "unknown arguments to network'connect_to";
53 return "connect_to failed (socket: $!)" unless &my_inet_socket(*FD);
54 return "connect_to failed (bind: $!)" unless bind(FD, $from);
55 return "connect_to failed (connect: $!)" unless connect(FD, $to);
56 local($old) = select(FD); $| = 1; select($old);
64 ## listen_at() - used by a server to indicate that it will accept requests
65 ## at the port number given.
68 ## $error = &network'listen_at(*LISTEN, $portnumber);
69 ## (returns undef upon success)
71 ## You can then do something like
72 ## $addr = accept(REMOTE, LISTEN);
73 ## print "contact from ", &network'addr_to_ascii($addr), ".\n";
75 ## .... process request....
82 local(*FD, $port) = @_;
83 local($empty) = pack('S n a4 x8', 2 ,$port, "\0\0\0\0");
84 return "listen_for failed (socket: $!)" unless &my_inet_socket(*FD);
85 return "listen_for failed (bind: $!)" unless bind(FD, $empty);
86 return "listen_for failed (listen: $!)" unless listen(FD, 5);
87 local($old) = select(FD); $| = 1; select($old);
94 ## Given an internal packed internet address (as returned by &connect_to
95 ## or &get_addr), return a printable ``1.2.3.4'' version.
101 return "bad arg" if length $addr != 16;
102 return join('.', unpack("CCCC", (unpack('S n a4 x8', $addr))[2]));
107 ## Given a host and a port name, returns the packed socket addresss.
108 ## Mostly for internal use.
113 local($host, $port) = @_;
114 return $addr{$host,$port} if defined $addr{$host,$port};
117 if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/)
119 $addr = pack("C4", split(/\./, $host));
121 elsif ($addr = (gethostbyname($host))[4], !defined $addr)
123 local(@lookup) = `nslookup $host 2>&1`;
126 local($lookup) = join('', @lookup[2 .. $#lookup]);
127 if ($lookup =~ m/^Address:\s*(\d+\.\d+\.\d+\.\d+)/) {
128 $addr = pack("C4", split(/\./, $1));
131 if (!defined $addr) {
132 ## warn "$host: SOL, dude\n";
136 $addr{$host,$port} = pack('S n a4 x8', 2 ,$port, $addr);
142 ## Returns the packed socket address of the local host (port 0)
143 ## Mostly for internal use.
148 local(@x) = gethostbyname('localhost');
149 local(@y) = gethostbyname($x[0]);
150 # local($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($x[0]);
151 # local(@bytes) = unpack("C4",$addrs[0]);
152 # return pack('S n a4 x8', 2 ,0, $addr);
153 return pack('S n a4 x8', 2 ,0, $y[4]);
158 ## my_inet_socket(*FD);
160 ## Local routine to do socket(PF_INET, SOCK_STREAM, AF_NS).
161 ## Takes care of figuring out the proper values for the args. Hopefully.
163 ## Returns the same value as 'socket'.
170 if (!defined $socket_values_queried)
172 ## try to load some "socket.ph"
173 if (!defined &main'_SYS_SOCKET_H_) {
176 require("sys/socket.ph")||require("socket.ph");';
179 ## we'll use "the regular defaults" if for PF_INET and AF_NS if unknown
180 $PF_INET = defined &main'PF_INET ? &main'PF_INET : 2;
181 $AF_NS = defined &main'AF_NS ? &main'AF_NS : 6;
182 $SOCK_STREAM = &main'SOCK_STREAM if defined &main'SOCK_STREAM;
184 $socket_values_queried = 1;
187 if (defined $SOCK_STREAM) {
188 $socket = socket(FD, $PF_INET, $SOCK_STREAM, $AF_NS);
191 ## We'll try the "regular default" of 1. If that returns a
192 ## "not supported" error, we'll try 2, which SunOS5.x uses.
194 $socket = socket(FD, $PF_INET, 1, $AF_NS);
196 $SOCK_STREAM = 1; ## got it.
197 } elsif ($! =~ m/not supported/i) {
198 ## we'll just assume from now on that it's 2.
199 $socket = socket(FD, $PF_INET, $SOCK_STREAM = 2, $AF_NS);
205 ## This here just to quiet -w warnings.
207 1 || $version || &dummy;