Commit | Line | Data |
0a753a76 |
1 | ## |
2 | ## Jeffrey Friedl (jfriedl@omron.co.jp) |
3 | ## Copyri.... ah hell, just take it. |
4 | ## |
5 | ## July 1994 |
6 | ## |
7 | package network; |
8 | $version = "950311.5"; |
9 | |
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 |
14 | ## |
15 | |
16 | ## BLURB: |
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. |
20 | ## |
21 | |
22 | ##> |
23 | ## |
24 | ## connect_to() -- make an internet connection to a server. |
25 | ## |
26 | ## Two uses: |
27 | ## $error = &network'connect_to(*FILEHANDLE, $fromsockaddr, $tosockaddr) |
28 | ## $error = &network'connect_to(*FILEHANDLE, $hostname, $portnum) |
29 | ## |
30 | ## Makes the given connection and returns an error string, or undef if |
31 | ## no error. |
32 | ## |
33 | ## In the first form, FROMSOCKADDR and TOSOCKADDR are of the form returned |
34 | ## by SOCKET'GET_ADDR and SOCKET'MY_ADDR. |
35 | ## |
36 | ##< |
37 | sub connect_to |
38 | { |
39 | local(*FD, $arg1, $arg2) = @_; |
40 | local($from, $to) = ($arg1, $arg2); ## for one interpretation. |
41 | local($host, $port) = ($arg1, $arg2); ## for the other |
42 | |
43 | if (defined($to) && length($from)==16 && length($to)==16) { |
44 | ## ok just as is |
45 | } elsif (defined($host)) { |
46 | $to = &get_addr($host, $port); |
47 | return qq/unknown address "$host"/ unless defined $to; |
48 | $from = &my_addr; |
49 | } else { |
50 | return "unknown arguments to network'connect_to"; |
51 | } |
52 | |
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); |
57 | undef; |
58 | } |
59 | |
60 | |
61 | |
62 | ##> |
63 | ## |
64 | ## listen_at() - used by a server to indicate that it will accept requests |
65 | ## at the port number given. |
66 | ## |
67 | ## Used as |
68 | ## $error = &network'listen_at(*LISTEN, $portnumber); |
69 | ## (returns undef upon success) |
70 | ## |
71 | ## You can then do something like |
72 | ## $addr = accept(REMOTE, LISTEN); |
73 | ## print "contact from ", &network'addr_to_ascii($addr), ".\n"; |
74 | ## while (<REMOTE>) { |
75 | ## .... process request.... |
76 | ## } |
77 | ## close(REMOTE); |
78 | ## |
79 | ##< |
80 | sub listen_at |
81 | { |
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); |
88 | undef; |
89 | } |
90 | |
91 | |
92 | ##> |
93 | ## |
94 | ## Given an internal packed internet address (as returned by &connect_to |
95 | ## or &get_addr), return a printable ``1.2.3.4'' version. |
96 | ## |
97 | ##< |
98 | sub addr_to_ascii |
99 | { |
100 | local($addr) = @_; |
101 | return "bad arg" if length $addr != 16; |
102 | return join('.', unpack("CCCC", (unpack('S n a4 x8', $addr))[2])); |
103 | } |
104 | |
105 | ## |
106 | ## |
107 | ## Given a host and a port name, returns the packed socket addresss. |
108 | ## Mostly for internal use. |
109 | ## |
110 | ## |
111 | sub get_addr |
112 | { |
113 | local($host, $port) = @_; |
114 | return $addr{$host,$port} if defined $addr{$host,$port}; |
115 | local($addr); |
116 | |
117 | if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/) |
118 | { |
119 | $addr = pack("C4", split(/\./, $host)); |
120 | } |
121 | elsif ($addr = (gethostbyname($host))[4], !defined $addr) |
122 | { |
123 | local(@lookup) = `nslookup $host 2>&1`; |
124 | if (@lookup) |
125 | { |
126 | local($lookup) = join('', @lookup[2 .. $#lookup]); |
127 | if ($lookup =~ m/^Address:\s*(\d+\.\d+\.\d+\.\d+)/) { |
128 | $addr = pack("C4", split(/\./, $1)); |
129 | } |
130 | } |
131 | if (!defined $addr) { |
132 | ## warn "$host: SOL, dude\n"; |
133 | return undef; |
134 | } |
135 | } |
136 | $addr{$host,$port} = pack('S n a4 x8', 2 ,$port, $addr); |
137 | } |
138 | |
139 | |
140 | ## |
141 | ## my_addr() |
142 | ## Returns the packed socket address of the local host (port 0) |
143 | ## Mostly for internal use. |
144 | ## |
145 | ## |
146 | sub my_addr |
147 | { |
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]); |
154 | } |
155 | |
156 | |
157 | ## |
158 | ## my_inet_socket(*FD); |
159 | ## |
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. |
162 | ## |
163 | ## Returns the same value as 'socket'. |
164 | ## |
165 | sub my_inet_socket |
166 | { |
167 | local(*FD) = @_; |
168 | local($socket); |
169 | |
170 | if (!defined $socket_values_queried) |
171 | { |
172 | ## try to load some "socket.ph" |
173 | if (!defined &main'_SYS_SOCKET_H_) { |
174 | eval 'package main; |
175 | local($^W) = 0; |
176 | require("sys/socket.ph")||require("socket.ph");'; |
177 | } |
178 | |
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; |
183 | |
184 | $socket_values_queried = 1; |
185 | } |
186 | |
187 | if (defined $SOCK_STREAM) { |
188 | $socket = socket(FD, $PF_INET, $SOCK_STREAM, $AF_NS); |
189 | } else { |
190 | ## |
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. |
193 | ## |
194 | $socket = socket(FD, $PF_INET, 1, $AF_NS); |
195 | if ($socket) { |
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); |
200 | } |
201 | } |
202 | $socket; |
203 | } |
204 | |
205 | ## This here just to quiet -w warnings. |
206 | sub dummy { |
207 | 1 || $version || &dummy; |
208 | } |
209 | |
210 | 1; |
211 | __END__ |