Moved host-info to new address representation. The record is constructed in C now.
This commit is contained in:
marting
parent
d130f23f0d
commit
86fa3f59a4
137
scsh/network.scm
137
scsh/network.scm
|
|
@ -21,6 +21,24 @@
|
|||
"#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
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
|
|
@ -112,7 +130,8 @@
|
|||
;;; Socket Address Routines
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
(define (internet-address->socket-address address32 port16)
|
||||
(cond ((not (<= 0 address32 #xffffffff))
|
||||
(cond ((not (and (byte-vector? address32)
|
||||
(= (byte-vector-length address32) 4)))
|
||||
(error "internet-address->socket-address: address out of range ~s"
|
||||
address32))
|
||||
((not (<= 0 port16 #xffff))
|
||||
|
|
@ -120,8 +139,7 @@
|
|||
port16))
|
||||
(else
|
||||
(make-socket-address address-family/internet
|
||||
(string-append (integer->string address32)
|
||||
(integer->string port16))))))
|
||||
(cons address32 port16)))))
|
||||
|
||||
(define (socket-address->internet-address sockaddr)
|
||||
(if (or (not (socket-address? sockaddr))
|
||||
|
|
@ -129,10 +147,8 @@
|
|||
address-family/internet)))
|
||||
(error "socket-address->internet-address: internet socket expected ~s"
|
||||
sockaddr)
|
||||
(values (string->integer (substring (socket-address:address sockaddr)
|
||||
0 4))
|
||||
(string->integer (substring (socket-address:address sockaddr)
|
||||
4 8)))))
|
||||
(values (car (socket-address:address sockaddr))
|
||||
(cdr (socket-address:address sockaddr)))))
|
||||
|
||||
(define (unix-address->socket-address path)
|
||||
(if (> (string-length path) 108)
|
||||
|
|
@ -204,13 +220,14 @@
|
|||
family
|
||||
(socket-address:address name)))))))
|
||||
|
||||
(define-foreign %bind/errno
|
||||
(scheme_bind (fixnum sockfd) ; socket fdes
|
||||
(fixnum family) ; address family
|
||||
(string-desc name)) ; scheme descriptor
|
||||
(to-scheme fixnum errno_or_false))
|
||||
(define-stubless-foreign %bind (sockfd family name) "scheme_bind")
|
||||
;(define-foreign %bind/errno
|
||||
; (scheme_bind (fixnum sockfd) ; socket fdes
|
||||
; (fixnum family) ; address family
|
||||
; (string-desc name)) ; scheme descriptor
|
||||
; (to-scheme fixnum errno_or_false))
|
||||
|
||||
(define-errno-syscall (%bind sockfd family name) %bind/errno)
|
||||
;(define-errno-syscall (%bind sockfd family name) %bind/errno)
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; connect syscall
|
||||
|
|
@ -276,25 +293,26 @@
|
|||
(define (accept-connection sock)
|
||||
(if (not (socket? sock))
|
||||
(error "accept-connection: socket expected ~s" sock)
|
||||
(let* ((family (socket:family sock))
|
||||
(name (make-addr family)))
|
||||
(let ((family (socket:family sock)))
|
||||
(let loop ()
|
||||
((structure-ref interrupts disable-interrupts!))
|
||||
(let ((maybe-fd (%accept (socket->fdes sock) family name)))
|
||||
(cond ((number? maybe-fd)
|
||||
(let ((fd maybe-fd))
|
||||
(display (socket->fdes sock) (current-error-port))
|
||||
(let ((fd-addr (%accept (socket->fdes sock) family)))
|
||||
(cond ((pair? fd-addr)
|
||||
(let ((fd (car fd-addr))
|
||||
(addr (cdr fd-addr)))
|
||||
((structure-ref interrupts
|
||||
enable-interrupts!))
|
||||
(let* ((in (make-input-fdport fd 0))
|
||||
(out (dup->outport in)))
|
||||
(values (make-socket family in out)
|
||||
(make-socket-address family name)))))
|
||||
(make-socket-address family addr)))))
|
||||
(else (wait-for-channel
|
||||
(fdport-data:channel
|
||||
(fdport-data (socket:inport sock))))
|
||||
(loop))))))))
|
||||
|
||||
(define-stubless-foreign %accept (sockfd family name) "scheme_accept")
|
||||
(define-stubless-foreign %accept (sockfd family) "scheme_accept")
|
||||
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
|
|
@ -305,19 +323,11 @@
|
|||
(not (= (socket:family sock) address-family/internet)))
|
||||
(error "socket-remote-address: internet socket expected ~s" sock)
|
||||
(let* ((family (socket:family sock))
|
||||
(name (make-addr family)))
|
||||
(%peer-name (socket->fdes sock)
|
||||
family
|
||||
name)
|
||||
(make-socket-address family name))))
|
||||
(addr (%peer-name (socket->fdes sock)
|
||||
family)))
|
||||
(make-socket-address family addr))))
|
||||
|
||||
(define-foreign %peer-name/errno
|
||||
(scheme_peer_name (fixnum sockfd)
|
||||
(fixnum family)
|
||||
(string-desc name))
|
||||
(to-scheme fixnum errno_or_false))
|
||||
|
||||
(define-errno-syscall (%peer-name sock family name) %peer-name/errno)
|
||||
(define-stubless-foreign %peer-name (sockfd family) "scheme_peer_name")
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; getsockname syscall
|
||||
|
|
@ -327,20 +337,10 @@
|
|||
(not (= (socket:family sock) address-family/internet)))
|
||||
(error "socket-local-address: internet socket expected ~s" sock)
|
||||
(let* ((family (socket:family sock))
|
||||
(name (make-addr family)))
|
||||
(%socket-name (socket->fdes sock)
|
||||
family
|
||||
name)
|
||||
(make-socket-address family name))))
|
||||
(addr (%socket-name (socket->fdes sock) family)))
|
||||
(make-socket-address family addr))))
|
||||
|
||||
(define-foreign %socket-name/errno
|
||||
(scheme_socket_name (fixnum sockfd)
|
||||
(fixnum family)
|
||||
(string-desc name))
|
||||
(to-scheme fixnum "False_on_zero"))
|
||||
|
||||
(define-errno-syscall
|
||||
(%socket-name sock family name) %socket-name/errno)
|
||||
(define-stubless-foreign %socket-name (sockfd family) "scheme_socket_name")
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; shutdown syscall
|
||||
|
|
@ -748,6 +748,8 @@
|
|||
((disclose hi) ; Make host-info records print like
|
||||
(list "host" (host-info:name hi)))) ; #{host clark.lcs.mit.edu}.
|
||||
|
||||
(define-exported-binding "host-info-type" type/host-info)
|
||||
|
||||
(define (host-info arg)
|
||||
(cond ((string? arg) (name->host-info arg))
|
||||
((socket-address? arg) (address->host-info arg))
|
||||
|
|
@ -757,44 +759,25 @@
|
|||
(if (or (not (socket-address? name))
|
||||
(not (= (socket-address:family name) address-family/internet)))
|
||||
(error "address->host-info: internet address expected ~s" name)
|
||||
(receive (herrno name aliases addresses)
|
||||
(%host-address->host-info/h-errno
|
||||
(socket-address:address name))
|
||||
(if herrno
|
||||
(error "address->host-info: non-zero herrno ~s ~s" name herrno)
|
||||
(make-host-info name
|
||||
(vector->list
|
||||
(C-string-vec->Scheme aliases #f))
|
||||
(vector->list
|
||||
(C-long-vec->Scheme addresses #f)))))))
|
||||
(let ((res (%host-address->host-info/h-errno
|
||||
(socket-address:address name))))
|
||||
(if (number? res)
|
||||
(error "address->host-info: non-zero herrno ~s ~s" res name)
|
||||
res))))
|
||||
|
||||
(define-foreign %host-address->host-info/h-errno
|
||||
(scheme_host_address2host_info (string-desc name))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; host name
|
||||
(C char**) ; alias list
|
||||
(C char**)) ; address list
|
||||
(define-stubless-foreign %host-address->host-info/h-errno (name)
|
||||
"scheme_host_address2host_info")
|
||||
|
||||
(define (name->host-info name)
|
||||
(if (not (string? name))
|
||||
(error "name->host-info: string expected ~s" name)
|
||||
(receive (herrno name aliases addresses)
|
||||
(%host-name->host-info/h-errno name)
|
||||
(if herrno
|
||||
(error "name->host-info: non-zero herrno ~s ~s" herrno name)
|
||||
(make-host-info name
|
||||
(vector->list
|
||||
(C-string-vec->Scheme aliases #f))
|
||||
(vector->list
|
||||
(C-long-vec->Scheme addresses #f)))))))
|
||||
|
||||
(define-foreign %host-name->host-info/h-errno
|
||||
(scheme_host_name2host_info (string name))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; host name
|
||||
(C char**) ; alias list
|
||||
(C char**)) ; address list
|
||||
(let ((res (%host-name->host-info/h-errno name)))
|
||||
(if (number? res)
|
||||
(error "name->host-info: non-zero herrno ~s ~s" res name)
|
||||
res))))
|
||||
|
||||
(define-stubless-foreign %host-name->host-info/h-errno (name)
|
||||
"scheme_host_name2host_info")
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; network lookup
|
||||
|
|
|
|||
265
scsh/network1.c
265
scsh/network1.c
|
|
@ -28,10 +28,30 @@
|
|||
|
||||
#define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v);
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
int scheme_bind(int sockfd, int family, s48_value scheme_name)
|
||||
s48_value long2byte_vector (long number)
|
||||
{
|
||||
switch(family)
|
||||
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;
|
||||
}
|
||||
|
||||
long byte_vector2long (s48_value bv)
|
||||
{
|
||||
long number = S48_BYTE_VECTOR_REF (bv, 0);
|
||||
number |= (S48_BYTE_VECTOR_REF (bv, 1) << 8);
|
||||
number |= (S48_BYTE_VECTOR_REF (bv, 2) << 16);
|
||||
number |= (S48_BYTE_VECTOR_REF (bv, 3) << 24);
|
||||
return number;
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
s48_value scheme_bind(s48_value sock, s48_value family, s48_value scheme_name)
|
||||
{
|
||||
int sockfd = s48_extract_fixnum (sock);
|
||||
switch(s48_extract_fixnum (family))
|
||||
{
|
||||
case AF_UNIX:
|
||||
{
|
||||
|
|
@ -40,25 +60,29 @@ int scheme_bind(int sockfd, int family, s48_value scheme_name)
|
|||
|
||||
name.sun_family=AF_UNIX;
|
||||
if (scheme_length>=(108-1)) /* save space for \0 */
|
||||
return(-1);
|
||||
return(-1); // TODO: check this in scheme !
|
||||
strncpy(name.sun_path,
|
||||
s48_extract_string(scheme_name),
|
||||
scheme_length); /* copy to c string */
|
||||
name.sun_path[scheme_length]='\0'; /* add null */
|
||||
return(bind(sockfd,(struct sockaddr *)&name,sizeof(name)));
|
||||
break;
|
||||
if ( bind(sockfd,(struct sockaddr *)&name,sizeof(name)) < 0)
|
||||
s48_raise_os_error (errno);
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
case AF_INET:
|
||||
{
|
||||
struct sockaddr_in name;
|
||||
|
||||
u_long addr=GET_LONG(scheme_name,0);
|
||||
u_short port=htons((u_short)ntohl(GET_LONG(scheme_name,1)));
|
||||
u_long addr = htonl(byte_vector2long (S48_CAR (scheme_name)));
|
||||
u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name)));
|
||||
fprintf(stderr, "binding to %d %d %d \n", port, addr,s48_extract_fixnum(S48_CDR (scheme_name)));
|
||||
name.sin_family=AF_INET;
|
||||
name.sin_addr.s_addr=addr;
|
||||
name.sin_port=port;
|
||||
return(bind(sockfd,(struct sockaddr *)&name,sizeof(name)));
|
||||
break;
|
||||
if (bind(sockfd,(struct sockaddr *)&name,sizeof(name)) < 0)
|
||||
s48_raise_os_error (errno);
|
||||
fprintf(stderr, "bound to %d\n", port);
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
|
|
@ -81,7 +105,7 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name
|
|||
if (scheme_length>=(108-1)) /* save space for \0 */
|
||||
return(-1);
|
||||
strncpy(name.sun_path,
|
||||
S48_ADDRESS_AFTER_HEADER(scheme_name,char),
|
||||
s48_extract_string (scheme_name),
|
||||
scheme_length); /* copy to c string */
|
||||
name.sun_path[scheme_length]='\0'; /* add null */
|
||||
|
||||
|
|
@ -95,15 +119,17 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name
|
|||
if (! (s48_add_pending_fd(sockfd, 0)))
|
||||
s48_raise_out_of_memory_error();
|
||||
|
||||
return S48_FALSE;
|
||||
if (errno == EINPROGRESS)
|
||||
return s48_enter_fixnum (0);
|
||||
else return S48_FALSE;
|
||||
|
||||
}
|
||||
case AF_INET:
|
||||
{
|
||||
struct sockaddr_in name;
|
||||
|
||||
u_long addr=GET_LONG(scheme_name,0);
|
||||
u_short port=htons((u_short)ntohl(GET_LONG(scheme_name,1)));
|
||||
u_long addr= htonl(byte_vector2long (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;
|
||||
|
|
@ -130,7 +156,7 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name
|
|||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
s48_value scheme_accept(s48_value sockfd_tagged, s48_value family, s48_value scheme_name)
|
||||
s48_value scheme_accept(s48_value sockfd_tagged, s48_value family)
|
||||
{
|
||||
int sockfd = s48_extract_fixnum (sockfd_tagged);
|
||||
switch(s48_extract_fixnum (family))
|
||||
|
|
@ -158,7 +184,10 @@ s48_value scheme_accept(s48_value sockfd_tagged, s48_value family, s48_value sch
|
|||
struct sockaddr_in name;
|
||||
int namelen=sizeof(name);
|
||||
int newsockfd;
|
||||
newsockfd=accept (sockfd, (struct sockaddr *)&name,&namelen);
|
||||
s48_value result, sock_addr;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
newsockfd = accept (sockfd,
|
||||
(struct sockaddr *)&name,&namelen);
|
||||
|
||||
if (newsockfd < 0)
|
||||
{
|
||||
|
|
@ -169,9 +198,49 @@ s48_value scheme_accept(s48_value sockfd_tagged, s48_value family, s48_value sch
|
|||
return S48_FALSE;
|
||||
}
|
||||
fcntl(newsockfd, F_SETFL, O_NONBLOCK);
|
||||
SET_LONG(scheme_name,0,name.sin_addr.s_addr);
|
||||
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port)));
|
||||
return s48_enter_fixnum (newsockfd);
|
||||
S48_GC_PROTECT_2 (result, sock_addr);
|
||||
sock_addr = long2byte_vector (ntohl(name.sin_addr.s_addr));
|
||||
|
||||
result = s48_cons (sock_addr, s48_enter_fixnum (ntohs(name.sin_port)));
|
||||
|
||||
result = s48_cons (s48_enter_fixnum (newsockfd),
|
||||
result);
|
||||
S48_GC_UNPROTECT();
|
||||
return result;
|
||||
break;
|
||||
}
|
||||
default:
|
||||
s48_raise_argtype_error (family); /* error unknown address family */
|
||||
}
|
||||
}
|
||||
|
||||
s48_value make_addr (long s_addr, int s_port)
|
||||
{
|
||||
s48_value result, sock_addr;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
S48_GC_PROTECT_2 (result, sock_addr);
|
||||
sock_addr = long2byte_vector (ntohl (s_addr));
|
||||
|
||||
result = s48_cons (sock_addr, s48_enter_fixnum (ntohs (s_port)));
|
||||
S48_GC_UNPROTECT();
|
||||
return result;
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
s48_value scheme_peer_name(s48_value sock, s48_value family)
|
||||
{
|
||||
int sockfd = s48_extract_fixnum (sock);
|
||||
switch(s48_extract_fixnum (family))
|
||||
{
|
||||
case AF_INET:
|
||||
{
|
||||
struct sockaddr_in name;
|
||||
int namelen=sizeof(name);
|
||||
int value=getpeername(sockfd,(struct sockaddr *)&name,&namelen);
|
||||
|
||||
if (value < 0) s48_raise_os_error (errno);
|
||||
|
||||
return (make_addr (name.sin_addr.s_addr, name.sin_port));
|
||||
break;
|
||||
}
|
||||
default:
|
||||
|
|
@ -180,32 +249,10 @@ s48_value scheme_accept(s48_value sockfd_tagged, s48_value family, s48_value sch
|
|||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
int scheme_peer_name(int sockfd, int family, s48_value scheme_name)
|
||||
s48_value scheme_socket_name(s48_value sock, s48_value family)
|
||||
{
|
||||
switch(family)
|
||||
{
|
||||
case AF_INET:
|
||||
{
|
||||
struct sockaddr_in name;
|
||||
int namelen=sizeof(name);
|
||||
int value=getpeername(sockfd,(struct sockaddr *)&name,&namelen);
|
||||
|
||||
if (value < 0)
|
||||
return(-1);
|
||||
SET_LONG(scheme_name,0,name.sin_addr.s_addr);
|
||||
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port)));
|
||||
return(value);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
}
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
int scheme_socket_name(int sockfd, int family, s48_value scheme_name)
|
||||
{
|
||||
switch(family)
|
||||
int sockfd = s48_extract_fixnum (sock);
|
||||
switch(s48_extract_fixnum (family))
|
||||
{
|
||||
case AF_INET:
|
||||
{
|
||||
|
|
@ -213,15 +260,14 @@ int scheme_socket_name(int sockfd, int family, s48_value scheme_name)
|
|||
int namelen=sizeof(name);
|
||||
int value=getsockname(sockfd,(struct sockaddr *)&name,&namelen);
|
||||
|
||||
if (value < 0)
|
||||
return(-1);
|
||||
SET_LONG(scheme_name,0,name.sin_addr.s_addr);
|
||||
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port)));
|
||||
return(value);
|
||||
if (value < 0) s48_raise_os_error (errno);
|
||||
|
||||
return(make_addr (name.sin_addr.s_addr,
|
||||
name.sin_port));
|
||||
break;
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
s48_raise_argtype_error (family); /* error unknown address family */
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,16 +309,21 @@ ssize_t recv_substring(int s,
|
|||
StrByte(buf,start), end-start,
|
||||
flags,
|
||||
(struct sockaddr *)&name, &namelen);
|
||||
s48_value result;
|
||||
S48_DECLARE_GC_PROTECT(1);
|
||||
if (cc < 0) s48_raise_os_error (errno);
|
||||
|
||||
if (cc < 0)
|
||||
return(-1);
|
||||
SET_LONG(scheme_name,0,name.sin_addr.s_addr);
|
||||
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port)));
|
||||
return(cc);
|
||||
result = make_addr (name.sin_addr.s_addr,
|
||||
htonl((u_long)ntohs(name.sin_port)));
|
||||
S48_GC_PROTECT_1 (result);
|
||||
|
||||
result = (s48_cons (s48_enter_fixnum (cc), result));
|
||||
S48_GC_UNPROTECT();
|
||||
return result;
|
||||
break;
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
s48_raise_argtype_error (s48_enter_fixnum (-1)); /* error unknown address family */
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -301,7 +352,7 @@ ssize_t send_substring(int s,
|
|||
if (scheme_length>=(108-1)) /* save space for \0 */
|
||||
return(-1);
|
||||
strncpy(name.sun_path,
|
||||
S48_ADDRESS_AFTER_HEADER(scheme_name,char),
|
||||
s48_extract_string(scheme_name),
|
||||
scheme_length); /* copy to c string */
|
||||
name.sun_path[scheme_length]='\0'; /* add null */
|
||||
return(sendto(s,
|
||||
|
|
@ -414,58 +465,88 @@ int scheme_setsockopt_timeout (int s,
|
|||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
/* Routines for looking up hosts */
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
int scheme_host_address2host_info(s48_value scheme_name,
|
||||
char** hostname,
|
||||
char*** aliases,
|
||||
char*** addresses)
|
||||
|
||||
static s48_value host_info_type_binding = S48_FALSE;
|
||||
|
||||
s48_value host_ent2host_info (struct hostent * host)
|
||||
{
|
||||
struct in_addr name;
|
||||
struct hostent *host;
|
||||
|
||||
u_long addr=GET_LONG(scheme_name,0);
|
||||
name.s_addr=addr;
|
||||
|
||||
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET);
|
||||
s48_value host_info = S48_FALSE;
|
||||
s48_value temp_vector = S48_FALSE;
|
||||
long * ptr;
|
||||
int i;
|
||||
S48_DECLARE_GC_PROTECT (2);
|
||||
|
||||
if(host==NULL)
|
||||
{
|
||||
*hostname =NULL;
|
||||
*aliases =NULL;
|
||||
*addresses=NULL;
|
||||
return(h_errno);
|
||||
return(s48_enter_fixnum (h_errno));
|
||||
}
|
||||
|
||||
*hostname =host->h_name;
|
||||
*aliases =host->h_aliases;
|
||||
*addresses=host->h_addr_list;
|
||||
return(0);
|
||||
if (host_info_type_binding == S48_FALSE)
|
||||
{
|
||||
S48_GC_PROTECT_GLOBAL(host_info_type_binding);
|
||||
host_info_type_binding = s48_get_imported_binding ("host-info-type");
|
||||
}
|
||||
|
||||
int scheme_host_name2host_info(const char* scheme_name,
|
||||
char** hostname,
|
||||
char*** aliases,
|
||||
char*** addresses)
|
||||
S48_GC_PROTECT_2 (host_info, temp_vector);
|
||||
|
||||
host_info = s48_make_record (host_info_type_binding);
|
||||
S48_RECORD_SET (host_info, 0, s48_enter_string (host->h_name));
|
||||
|
||||
ptr = (long *)host->h_aliases;
|
||||
temp_vector = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
temp_vector = s48_cons (s48_enter_string (host->h_aliases[i]), temp_vector);
|
||||
ptr++;
|
||||
i ++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (host_info, 1, temp_vector);
|
||||
|
||||
ptr = (long *)host->h_addr_list;
|
||||
temp_vector = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
temp_vector =
|
||||
s48_cons (long2byte_vector (ntohl (*(long *)(host->h_addr_list[i]))),
|
||||
temp_vector);
|
||||
ptr++;
|
||||
i++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (host_info, 2, temp_vector);
|
||||
|
||||
S48_GC_UNPROTECT ();
|
||||
return host_info;
|
||||
}
|
||||
|
||||
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)));
|
||||
name.s_addr = addr;
|
||||
|
||||
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET);
|
||||
return (host_ent2host_info (host));
|
||||
}
|
||||
|
||||
|
||||
s48_value scheme_host_name2host_info(s48_value s_name)
|
||||
{
|
||||
struct in_addr name;
|
||||
struct hostent *host;
|
||||
char * scheme_name = s48_extract_string (s_name);
|
||||
|
||||
if ((name.s_addr=inet_addr(scheme_name)) != -1)
|
||||
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET);
|
||||
else
|
||||
host=gethostbyname(scheme_name);
|
||||
|
||||
if(host==NULL)
|
||||
{
|
||||
*hostname =NULL;
|
||||
*aliases =NULL;
|
||||
*addresses=NULL;
|
||||
return(h_errno);
|
||||
}
|
||||
|
||||
*hostname =host->h_name;
|
||||
*aliases =host->h_aliases;
|
||||
*addresses=host->h_addr_list;
|
||||
return(0);
|
||||
return (host_ent2host_info (host));
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
/* Exports from network1.c. */
|
||||
|
||||
int scheme_bind(int sockfd, int family, s48_value scheme_name);
|
||||
s48_value scheme_bind(s48_value sockfd, s48_value family, s48_value scheme_name);
|
||||
|
||||
s48_value scheme_connect(s48_value sockfd, s48_value family, s48_value scheme_name);
|
||||
s48_value scheme_connect(s48_value sock, s48_value family,
|
||||
s48_value scheme_name);
|
||||
|
||||
s48_value scheme_accept(s48_value sockfd, s48_value family, s48_value scheme_name);
|
||||
s48_value scheme_accept(s48_value sockfd, s48_value family);
|
||||
|
||||
int scheme_peer_name(int sockfd, int family, s48_value scheme_name);
|
||||
s48_value scheme_peer_name(s48_value sockfd, s48_value family);
|
||||
|
||||
int scheme_socket_name(int sockfd, int family, s48_value scheme_name);
|
||||
s48_value scheme_socket_name(s48_value sockfd, s48_value family);
|
||||
|
||||
int scheme_socket_pair(int type, int *s1, int *s2);
|
||||
|
||||
|
|
@ -47,15 +48,9 @@ int scheme_setsockopt_timeout (int s,
|
|||
int sec,
|
||||
int usec);
|
||||
|
||||
int scheme_host_address2host_info(s48_value scheme_name,
|
||||
char** hostname,
|
||||
char*** aliases,
|
||||
char*** addresses);
|
||||
s48_value scheme_host_address2host_info(s48_value scheme_byte_vector);
|
||||
|
||||
int scheme_host_name2host_info(const char* scheme_name,
|
||||
char** hostname,
|
||||
char*** aliases,
|
||||
char*** addresses);
|
||||
s48_value scheme_host_name2host_info(s48_value scheme_name);
|
||||
|
||||
int scheme_net_address2net_info(s48_value scheme_name,
|
||||
s48_value scheme_net,
|
||||
|
|
|
|||
Loading…
Reference in New Issue