| 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__ |
projects / p5sagit/p5-mst-13.2.git / blame