scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Switched back to integers as internet-host-addresses.

This commit is contained in:
mainzelm 2001-04-02 14:57:25 +00:00
parent 12cb27459f
commit 7516a430f8
2 changed files with 16 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
scsh/network.scm
View File

@ -1,6 +1,7 @@
;;; Networking for the Scheme Shell ;;; Networking for the Scheme Shell
;;; Copyright (c) 1994-1995 by Brian D. Carlstrom. ;;; Copyright (c) 1994-1995 by Brian D. Carlstrom.
;;; Copyright (c) 1994 by Olin Shivers. ;;; Copyright (c) 1994 by Olin Shivers.
;;; See file COPYING.
;;; Scheme48 implementation. ;;; Scheme48 implementation.
@ -21,24 +22,6 @@
"#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)" "#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 ;;; High Level Prototypes
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
@ -73,9 +56,9 @@
(dynamic-wind (dynamic-wind
(lambda () #f) (lambda () #f)
(lambda () (connect-socket sock addr) (set! connected #t)) (lambda () (connect-socket sock addr) (set! connected #t))
(lambda () #f (lambda ()
;(if (not connected) (if (not connected)
; (close-socket sock)) (close-socket sock))
)) ))
(if connected (if connected
sock sock
@ -129,45 +112,8 @@
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; Socket Address Routines ;;; 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) (define (internet-address->socket-address address32 port16)
(cond ((not (and (byte-vector? address32) (cond ((not (<= 0 address32 #xffffffff))
(= (byte-vector-length address32) 4)))
(error "internet-address->socket-address: address out of range ~s" (error "internet-address->socket-address: address out of range ~s"
address32)) address32))
((not (<= 0 port16 #xffff)) ((not (<= 0 port16 #xffff))
@ -760,8 +706,8 @@
(error "network-info: string or socket-address expected ~s" arg)))) (error "network-info: string or socket-address expected ~s" arg))))
(define (address->network-info addr) (define (address->network-info addr)
(if (not (byte-vector? addr)) (if (not (integer? addr))
(error "address->network-info: byte-vector expected ~s" addr) (error "address->network-info: integer expected ~s" addr)
(%net-address->network-info addr))) (%net-address->network-info addr)))
(define-stubless-foreign %net-address->network-info (addr) (define-stubless-foreign %net-address->network-info (addr)

37
scsh/network1.c
View File

@ -27,25 +27,6 @@
#define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v); #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) 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; 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))); u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name)));
name.sin_family=AF_INET; 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; 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))); u_short port= htons(s48_extract_fixnum (S48_CDR (scheme_name)));
name.sin_family=AF_INET; 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); fcntl(newsockfd, F_SETFL, O_NONBLOCK);
S48_GC_PROTECT_2 (result, sock_addr); 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))); 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_value result, sock_addr;
S48_DECLARE_GC_PROTECT(2); S48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2 (result, sock_addr); 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))); result = s48_cons (sock_addr, s48_enter_fixnum (ntohs (net_s_port)));
S48_GC_UNPROTECT(); S48_GC_UNPROTECT();
@ -357,7 +338,7 @@ s48_value send_substring(s48_value scm_sockfd,
case AF_INET: case AF_INET:
{ {
struct sockaddr_in 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))); u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name)));
name.sin_family=AF_INET; name.sin_family=AF_INET;
name.sin_addr.s_addr=addr; name.sin_addr.s_addr=addr;
@ -541,7 +522,7 @@ s48_value host_ent2host_info (struct hostent * host)
while (*ptr) while (*ptr)
{ {
list = 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); list);
ptr++; ptr++;
i++; i++;
@ -558,7 +539,7 @@ s48_value scheme_host_address2host_info(s48_value addr_port)
struct in_addr name; struct in_addr name;
struct hostent *host; 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; name.s_addr = addr;
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET); 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, 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 (); S48_GC_UNPROTECT ();
@ -628,7 +609,7 @@ s48_value scheme_net_address2net_info(s48_value net_addr)
{ {
struct netent *net; struct netent *net;
// expects host byte order : // 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); return netent2net_info (net);
} }