Switched back to integers as internet-host-addresses.
This commit is contained in:
mainzelm
parent
12cb27459f
commit
7516a430f8
|
|
@ -1,6 +1,7 @@
|
|||
;;; Networking for the Scheme Shell
|
||||
;;; Copyright (c) 1994-1995 by Brian D. Carlstrom.
|
||||
;;; Copyright (c) 1994 by Olin Shivers.
|
||||
;;; See file COPYING.
|
||||
|
||||
;;; Scheme48 implementation.
|
||||
|
||||
|
|
@ -21,24 +22,6 @@
|
|||
"#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)"
|
||||
"" )
|
||||
|
||||
(define (byte-vector->integer bv)
|
||||
(let ((number (byte-vector-ref bv 0)))
|
||||
(set! number (bitwise-ior number (arithmetic-shift (byte-vector-ref bv 1)
|
||||
8)))
|
||||
(set! number (bitwise-ior number (arithmetic-shift (byte-vector-ref bv 2)
|
||||
16)))
|
||||
(bitwise-ior number (arithmetic-shift (byte-vector-ref bv 3)
|
||||
24))))
|
||||
|
||||
(define (integer->byte-vector number)
|
||||
(let ((bv (make-byte-vector 4 0)))
|
||||
(byte-vector-set! bv 0 (bitwise-and number #xff))
|
||||
(byte-vector-set! bv 1 (bitwise-and (arithmetic-shift number -8) #xff))
|
||||
(byte-vector-set! bv 2 (bitwise-and (arithmetic-shift number -16) #xff))
|
||||
(byte-vector-set! bv 3 (bitwise-and (arithmetic-shift number -24) #xff))
|
||||
bv))
|
||||
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; High Level Prototypes
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
|
|
@ -73,9 +56,9 @@
|
|||
(dynamic-wind
|
||||
(lambda () #f)
|
||||
(lambda () (connect-socket sock addr) (set! connected #t))
|
||||
(lambda () #f
|
||||
;(if (not connected)
|
||||
; (close-socket sock))
|
||||
(lambda ()
|
||||
(if (not connected)
|
||||
(close-socket sock))
|
||||
))
|
||||
(if connected
|
||||
sock
|
||||
|
|
@ -129,45 +112,8 @@
|
|||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; Socket Address Routines
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
(define (internet-host-address-from-number address32)
|
||||
(integer->byte-vector address32))
|
||||
|
||||
(define (internet-host-address-from-bytes b4 b3 b2 b1)
|
||||
(let ((bv (make-byte-vector 4 0)))
|
||||
(byte-vector-set! bv 0 b1)
|
||||
(byte-vector-set! bv 1 b2)
|
||||
(byte-vector-set! bv 2 b3)
|
||||
(byte-vector-set! bv 3 b4)
|
||||
bv))
|
||||
|
||||
(define (internet-host-address-to-bytes address)
|
||||
(list (byte-vector-ref address 3)
|
||||
(byte-vector-ref address 2)
|
||||
(byte-vector-ref address 1)
|
||||
(byte-vector-ref address 0)))
|
||||
|
||||
;;; This proc and its inverse should be in a general IP module.
|
||||
(define (internet-host-address->dotted-string bv)
|
||||
(let* ((byte0 (byte-vector-ref bv 0))
|
||||
(byte1 (byte-vector-ref bv 1))
|
||||
(byte2 (byte-vector-ref bv 2))
|
||||
(byte3 (byte-vector-ref bv 3)))
|
||||
(string-append (number->string byte3) "." (number->string byte2) "."
|
||||
(number->string byte1) "." (number->string byte0))))
|
||||
|
||||
(define (internet-host-address-to-number address)
|
||||
(byte-vector->integer address))
|
||||
|
||||
(set! internet-address/any
|
||||
(internet-host-address-from-number internet-address/any ))
|
||||
(set! internet-address/loopback
|
||||
(internet-host-address-from-number internet-address/loopback ))
|
||||
(set! internet-address/broadcast
|
||||
(internet-host-address-from-number internet-address/broadcast ))
|
||||
|
||||
(define (internet-address->socket-address address32 port16)
|
||||
(cond ((not (and (byte-vector? address32)
|
||||
(= (byte-vector-length address32) 4)))
|
||||
(cond ((not (<= 0 address32 #xffffffff))
|
||||
(error "internet-address->socket-address: address out of range ~s"
|
||||
address32))
|
||||
((not (<= 0 port16 #xffff))
|
||||
|
|
@ -760,8 +706,8 @@
|
|||
(error "network-info: string or socket-address expected ~s" arg))))
|
||||
|
||||
(define (address->network-info addr)
|
||||
(if (not (byte-vector? addr))
|
||||
(error "address->network-info: byte-vector expected ~s" addr)
|
||||
(if (not (integer? addr))
|
||||
(error "address->network-info: integer expected ~s" addr)
|
||||
(%net-address->network-info addr)))
|
||||
|
||||
(define-stubless-foreign %net-address->network-info (addr)
|
||||
|
|
|
|||
|
|
@ -27,25 +27,6 @@
|
|||
|
||||
#define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v);
|
||||
|
||||
s48_value long2byte_vector (u_long number)
|
||||
{
|
||||
s48_value bv = s48_make_byte_vector (4, 0);
|
||||
S48_BYTE_VECTOR_SET(bv, 0, number & 0xff);
|
||||
S48_BYTE_VECTOR_SET(bv, 1, (number >> 8) & 0xff);
|
||||
S48_BYTE_VECTOR_SET(bv, 2, (number >> 16) & 0xff);
|
||||
S48_BYTE_VECTOR_SET(bv, 3, (number >> 24) & 0xff);
|
||||
return bv;
|
||||
}
|
||||
|
||||
u_long byte_vector2long (s48_value bv)
|
||||
{
|
||||
u_long number = (u_char) S48_BYTE_VECTOR_REF (bv, 0);
|
||||
number |= (((u_char) S48_BYTE_VECTOR_REF (bv, 1)) << 8);
|
||||
number |= (((u_char) S48_BYTE_VECTOR_REF (bv, 2)) << 16);
|
||||
number |= (((u_char) S48_BYTE_VECTOR_REF (bv, 3)) << 24);
|
||||
return number;
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
s48_value scheme_bind(s48_value sock, s48_value family, s48_value scheme_name)
|
||||
{
|
||||
|
|
@ -72,7 +53,7 @@ s48_value scheme_bind(s48_value sock, s48_value family, s48_value scheme_name)
|
|||
{
|
||||
struct sockaddr_in name;
|
||||
|
||||
u_long addr = htonl(byte_vector2long (S48_CAR (scheme_name)));
|
||||
u_long addr = htonl(s48_extract_unsigned_integer (S48_CAR (scheme_name)));
|
||||
u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name)));
|
||||
|
||||
name.sin_family=AF_INET;
|
||||
|
|
@ -127,7 +108,7 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name
|
|||
{
|
||||
struct sockaddr_in name;
|
||||
|
||||
u_long addr= htonl(byte_vector2long (S48_CAR (scheme_name)));
|
||||
u_long addr= htonl(s48_extract_unsigned_integer (S48_CAR (scheme_name)));
|
||||
u_short port= htons(s48_extract_fixnum (S48_CDR (scheme_name)));
|
||||
|
||||
name.sin_family=AF_INET;
|
||||
|
|
@ -198,7 +179,7 @@ s48_value scheme_accept(s48_value sockfd_tagged, s48_value family)
|
|||
}
|
||||
fcntl(newsockfd, F_SETFL, O_NONBLOCK);
|
||||
S48_GC_PROTECT_2 (result, sock_addr);
|
||||
sock_addr = long2byte_vector (ntohl(name.sin_addr.s_addr));
|
||||
sock_addr = s48_enter_unsigned_integer (ntohl(name.sin_addr.s_addr));
|
||||
|
||||
result = s48_cons (sock_addr, s48_enter_fixnum (ntohs(name.sin_port)));
|
||||
|
||||
|
|
@ -218,7 +199,7 @@ s48_value make_addr (long net_s_addr, int net_s_port)
|
|||
s48_value result, sock_addr;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
S48_GC_PROTECT_2 (result, sock_addr);
|
||||
sock_addr = long2byte_vector (ntohl (net_s_addr));
|
||||
sock_addr = s48_enter_unsigned_integer (ntohl (net_s_addr));
|
||||
|
||||
result = s48_cons (sock_addr, s48_enter_fixnum (ntohs (net_s_port)));
|
||||
S48_GC_UNPROTECT();
|
||||
|
|
@ -357,7 +338,7 @@ s48_value send_substring(s48_value scm_sockfd,
|
|||
case AF_INET:
|
||||
{
|
||||
struct sockaddr_in name;
|
||||
u_long addr = htonl (byte_vector2long (S48_CAR (scheme_name)));
|
||||
u_long addr = htonl (s48_extract_unsigned_integer (S48_CAR (scheme_name)));
|
||||
u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name)));
|
||||
name.sin_family=AF_INET;
|
||||
name.sin_addr.s_addr=addr;
|
||||
|
|
@ -541,7 +522,7 @@ s48_value host_ent2host_info (struct hostent * host)
|
|||
while (*ptr)
|
||||
{
|
||||
list =
|
||||
s48_cons (long2byte_vector (ntohl (*(long *)(host->h_addr_list[i]))),
|
||||
s48_cons (s48_enter_unsigned_integer (ntohl (*(long *)(host->h_addr_list[i]))),
|
||||
list);
|
||||
ptr++;
|
||||
i++;
|
||||
|
|
@ -558,7 +539,7 @@ s48_value scheme_host_address2host_info(s48_value addr_port)
|
|||
struct in_addr name;
|
||||
struct hostent *host;
|
||||
|
||||
u_long addr = htonl(byte_vector2long (S48_CAR (addr_port)));
|
||||
u_long addr = htonl(s48_extract_unsigned_integer (S48_CAR (addr_port)));
|
||||
name.s_addr = addr;
|
||||
|
||||
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET);
|
||||
|
|
@ -617,7 +598,7 @@ s48_value netent2net_info(struct netent *net)
|
|||
}
|
||||
|
||||
S48_RECORD_SET (network_info, 1, list);
|
||||
S48_RECORD_SET (network_info, 2, long2byte_vector (net->n_net));
|
||||
S48_RECORD_SET (network_info, 2, s48_enter_unsigned_integer (net->n_net));
|
||||
|
||||
S48_GC_UNPROTECT ();
|
||||
|
||||
|
|
@ -628,7 +609,7 @@ s48_value scheme_net_address2net_info(s48_value net_addr)
|
|||
{
|
||||
struct netent *net;
|
||||
// expects host byte order :
|
||||
net=getnetbyaddr(byte_vector2long (net_addr),AF_INET);
|
||||
net=getnetbyaddr(s48_extract_unsigned_integer (net_addr),AF_INET);
|
||||
|
||||
return netent2net_info (net);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue