win32/bin/network.pl

   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__