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

Moved host-info to new address representation. The record is constructed in C now.

This commit is contained in:
marting 2000-07-12 17:28:56 +00:00
parent d130f23f0d
commit 86fa3f59a4
3 changed files with 230 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

137
scsh/network.scm
View File

@ -21,6 +21,24 @@
"#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
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
@ -112,7 +130,8 @@
;;; Socket Address Routines ;;; Socket Address Routines
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
(define (internet-address->socket-address address32 port16) (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" (error "internet-address->socket-address: address out of range ~s"
address32)) address32))
((not (<= 0 port16 #xffff)) ((not (<= 0 port16 #xffff))
@ -120,8 +139,7 @@
port16)) port16))
(else (else
(make-socket-address address-family/internet (make-socket-address address-family/internet
(string-append (integer->string address32) (cons address32 port16)))))
(integer->string port16))))))
(define (socket-address->internet-address sockaddr) (define (socket-address->internet-address sockaddr)
(if (or (not (socket-address? sockaddr)) (if (or (not (socket-address? sockaddr))
@ -129,10 +147,8 @@
address-family/internet))) address-family/internet)))
(error "socket-address->internet-address: internet socket expected ~s" (error "socket-address->internet-address: internet socket expected ~s"
sockaddr) sockaddr)
(values (string->integer (substring (socket-address:address sockaddr) (values (car (socket-address:address sockaddr))
0 4)) (cdr (socket-address:address sockaddr)))))
(string->integer (substring (socket-address:address sockaddr)
4 8)))))
(define (unix-address->socket-address path) (define (unix-address->socket-address path)
(if (> (string-length path) 108) (if (> (string-length path) 108)
@ -204,13 +220,14 @@
family family
(socket-address:address name))))))) (socket-address:address name)))))))
(define-foreign %bind/errno (define-stubless-foreign %bind (sockfd family name) "scheme_bind")
(scheme_bind (fixnum sockfd) ; socket fdes ;(define-foreign %bind/errno
(fixnum family) ; address family ; (scheme_bind (fixnum sockfd) ; socket fdes
(string-desc name)) ; scheme descriptor ; (fixnum family) ; address family
(to-scheme fixnum errno_or_false)) ; (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 ;;; connect syscall
@ -276,25 +293,26 @@
(define (accept-connection sock) (define (accept-connection sock)
(if (not (socket? sock)) (if (not (socket? sock))
(error "accept-connection: socket expected ~s" sock) (error "accept-connection: socket expected ~s" sock)
(let* ((family (socket:family sock)) (let ((family (socket:family sock)))
(name (make-addr family)))
(let loop () (let loop ()
((structure-ref interrupts disable-interrupts!)) ((structure-ref interrupts disable-interrupts!))
(let ((maybe-fd (%accept (socket->fdes sock) family name))) (display (socket->fdes sock) (current-error-port))
(cond ((number? maybe-fd) (let ((fd-addr (%accept (socket->fdes sock) family)))
(let ((fd maybe-fd)) (cond ((pair? fd-addr)
(let ((fd (car fd-addr))
(addr (cdr fd-addr)))
((structure-ref interrupts ((structure-ref interrupts
enable-interrupts!)) enable-interrupts!))
(let* ((in (make-input-fdport fd 0)) (let* ((in (make-input-fdport fd 0))
(out (dup->outport in))) (out (dup->outport in)))
(values (make-socket family in out) (values (make-socket family in out)
(make-socket-address family name))))) (make-socket-address family addr)))))
(else (wait-for-channel (else (wait-for-channel
(fdport-data:channel (fdport-data:channel
(fdport-data (socket:inport sock)))) (fdport-data (socket:inport sock))))
(loop)))))))) (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))) (not (= (socket:family sock) address-family/internet)))
(error "socket-remote-address: internet socket expected ~s" sock) (error "socket-remote-address: internet socket expected ~s" sock)
(let* ((family (socket:family sock)) (let* ((family (socket:family sock))
(name (make-addr family))) (addr (%peer-name (socket->fdes sock)
(%peer-name (socket->fdes sock) family)))
family (make-socket-address family addr))))
name)
(make-socket-address family name))))
(define-foreign %peer-name/errno (define-stubless-foreign %peer-name (sockfd family) "scheme_peer_name")
(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)
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; getsockname syscall ;;; getsockname syscall
@ -327,20 +337,10 @@
(not (= (socket:family sock) address-family/internet))) (not (= (socket:family sock) address-family/internet)))
(error "socket-local-address: internet socket expected ~s" sock) (error "socket-local-address: internet socket expected ~s" sock)
(let* ((family (socket:family sock)) (let* ((family (socket:family sock))
(name (make-addr family))) (addr (%socket-name (socket->fdes sock) family)))
(%socket-name (socket->fdes sock) (make-socket-address family addr))))
family
name)
(make-socket-address family name))))
(define-foreign %socket-name/errno (define-stubless-foreign %socket-name (sockfd family) "scheme_socket_name")
(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)
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; shutdown syscall ;;; shutdown syscall
@ -748,6 +748,8 @@
((disclose hi) ; Make host-info records print like ((disclose hi) ; Make host-info records print like
(list "host" (host-info:name hi)))) ; #{host clark.lcs.mit.edu}. (list "host" (host-info:name hi)))) ; #{host clark.lcs.mit.edu}.
(define-exported-binding "host-info-type" type/host-info)
(define (host-info arg) (define (host-info arg)
(cond ((string? arg) (name->host-info arg)) (cond ((string? arg) (name->host-info arg))
((socket-address? arg) (address->host-info arg)) ((socket-address? arg) (address->host-info arg))
@ -757,44 +759,25 @@
(if (or (not (socket-address? name)) (if (or (not (socket-address? name))
(not (= (socket-address:family name) address-family/internet))) (not (= (socket-address:family name) address-family/internet)))
(error "address->host-info: internet address expected ~s" name) (error "address->host-info: internet address expected ~s" name)
(receive (herrno name aliases addresses) (let ((res (%host-address->host-info/h-errno
(%host-address->host-info/h-errno (socket-address:address name))))
(socket-address:address name)) (if (number? res)
(if herrno (error "address->host-info: non-zero herrno ~s ~s" res name)
(error "address->host-info: non-zero herrno ~s ~s" name herrno) res))))
(make-host-info name
(vector->list
(C-string-vec->Scheme aliases #f))
(vector->list
(C-long-vec->Scheme addresses #f)))))))
(define-foreign %host-address->host-info/h-errno (define-stubless-foreign %host-address->host-info/h-errno (name)
(scheme_host_address2host_info (string-desc name)) "scheme_host_address2host_info")
(to-scheme fixnum "False_on_zero")
static-string ; host name
(C char**) ; alias list
(C char**)) ; address list
(define (name->host-info name) (define (name->host-info name)
(if (not (string? name)) (if (not (string? name))
(error "name->host-info: string expected ~s" name) (error "name->host-info: string expected ~s" name)
(receive (herrno name aliases addresses) (let ((res (%host-name->host-info/h-errno name)))
(%host-name->host-info/h-errno name) (if (number? res)
(if herrno (error "name->host-info: non-zero herrno ~s ~s" res name)
(error "name->host-info: non-zero herrno ~s ~s" herrno name) res))))
(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
(define-stubless-foreign %host-name->host-info/h-errno (name)
"scheme_host_name2host_info")
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; network lookup ;;; network lookup

265
scsh/network1.c
View File

@ -28,10 +28,30 @@
#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 (long number)
int scheme_bind(int sockfd, int family, s48_value scheme_name)
{ {
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: case AF_UNIX:
{ {
@ -40,25 +60,29 @@ int scheme_bind(int sockfd, int family, s48_value scheme_name)
name.sun_family=AF_UNIX; name.sun_family=AF_UNIX;
if (scheme_length>=(108-1)) /* save space for \0 */ if (scheme_length>=(108-1)) /* save space for \0 */
return(-1); return(-1); // TODO: check this in scheme !
strncpy(name.sun_path, strncpy(name.sun_path,
s48_extract_string(scheme_name), s48_extract_string(scheme_name),
scheme_length); /* copy to c string */ scheme_length); /* copy to c string */
name.sun_path[scheme_length]='\0'; /* add null */ name.sun_path[scheme_length]='\0'; /* add null */
return(bind(sockfd,(struct sockaddr *)&name,sizeof(name))); if ( bind(sockfd,(struct sockaddr *)&name,sizeof(name)) < 0)
break; s48_raise_os_error (errno);
return S48_UNSPECIFIC;
} }
case AF_INET: case AF_INET:
{ {
struct sockaddr_in name; struct sockaddr_in name;
u_long addr=GET_LONG(scheme_name,0); u_long addr = htonl(byte_vector2long (S48_CAR (scheme_name)));
u_short port=htons((u_short)ntohl(GET_LONG(scheme_name,1))); 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_family=AF_INET;
name.sin_addr.s_addr=addr; name.sin_addr.s_addr=addr;
name.sin_port=port; name.sin_port=port;
return(bind(sockfd,(struct sockaddr *)&name,sizeof(name))); if (bind(sockfd,(struct sockaddr *)&name,sizeof(name)) < 0)
break; s48_raise_os_error (errno);
fprintf(stderr, "bound to %d\n", port);
return S48_UNSPECIFIC;
} }
default: default:
return(-1); /* error unknown address family */ 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 */ if (scheme_length>=(108-1)) /* save space for \0 */
return(-1); return(-1);
strncpy(name.sun_path, strncpy(name.sun_path,
S48_ADDRESS_AFTER_HEADER(scheme_name,char), s48_extract_string (scheme_name),
scheme_length); /* copy to c string */ scheme_length); /* copy to c string */
name.sun_path[scheme_length]='\0'; /* add null */ 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))) if (! (s48_add_pending_fd(sockfd, 0)))
s48_raise_out_of_memory_error(); s48_raise_out_of_memory_error();
return S48_FALSE; if (errno == EINPROGRESS)
return s48_enter_fixnum (0);
else return S48_FALSE;
} }
case AF_INET: case AF_INET:
{ {
struct sockaddr_in name; struct sockaddr_in name;
u_long addr=GET_LONG(scheme_name,0); u_long addr= htonl(byte_vector2long (S48_CAR (scheme_name)));
u_short port=htons((u_short)ntohl(GET_LONG(scheme_name,1))); 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;
@ -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); int sockfd = s48_extract_fixnum (sockfd_tagged);
switch(s48_extract_fixnum (family)) 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; struct sockaddr_in name;
int namelen=sizeof(name); int namelen=sizeof(name);
int newsockfd; 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) if (newsockfd < 0)
{ {
@ -169,9 +198,49 @@ s48_value scheme_accept(s48_value sockfd_tagged, s48_value family, s48_value sch
return S48_FALSE; return S48_FALSE;
} }
fcntl(newsockfd, F_SETFL, O_NONBLOCK); fcntl(newsockfd, F_SETFL, O_NONBLOCK);
SET_LONG(scheme_name,0,name.sin_addr.s_addr); S48_GC_PROTECT_2 (result, sock_addr);
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port))); sock_addr = long2byte_vector (ntohl(name.sin_addr.s_addr));
return s48_enter_fixnum (newsockfd);
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; break;
} }
default: 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) 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)
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)
{ {
case AF_INET: case AF_INET:
{ {
@ -213,15 +260,14 @@ int scheme_socket_name(int sockfd, int family, s48_value scheme_name)
int namelen=sizeof(name); int namelen=sizeof(name);
int value=getsockname(sockfd,(struct sockaddr *)&name,&namelen); int value=getsockname(sockfd,(struct sockaddr *)&name,&namelen);
if (value < 0) if (value < 0) s48_raise_os_error (errno);
return(-1);
SET_LONG(scheme_name,0,name.sin_addr.s_addr); return(make_addr (name.sin_addr.s_addr,
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port))); name.sin_port));
return(value);
break; break;
} }
default: 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, StrByte(buf,start), end-start,
flags, flags,
(struct sockaddr *)&name, &namelen); (struct sockaddr *)&name, &namelen);
s48_value result;
S48_DECLARE_GC_PROTECT(1);
if (cc < 0) s48_raise_os_error (errno);
if (cc < 0) result = make_addr (name.sin_addr.s_addr,
return(-1); htonl((u_long)ntohs(name.sin_port)));
SET_LONG(scheme_name,0,name.sin_addr.s_addr); S48_GC_PROTECT_1 (result);
SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port)));
return(cc); result = (s48_cons (s48_enter_fixnum (cc), result));
S48_GC_UNPROTECT();
return result;
break; break;
} }
default: 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 */ if (scheme_length>=(108-1)) /* save space for \0 */
return(-1); return(-1);
strncpy(name.sun_path, strncpy(name.sun_path,
S48_ADDRESS_AFTER_HEADER(scheme_name,char), s48_extract_string(scheme_name),
scheme_length); /* copy to c string */ scheme_length); /* copy to c string */
name.sun_path[scheme_length]='\0'; /* add null */ name.sun_path[scheme_length]='\0'; /* add null */
return(sendto(s, return(sendto(s,
@ -414,58 +465,88 @@ int scheme_setsockopt_timeout (int s,
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
/* Routines for looking up hosts */ /* Routines for looking up hosts */
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
int scheme_host_address2host_info(s48_value scheme_name,
char** hostname, static s48_value host_info_type_binding = S48_FALSE;
char*** aliases,
char*** addresses) s48_value host_ent2host_info (struct hostent * host)
{ {
struct in_addr name; s48_value host_info = S48_FALSE;
struct hostent *host; s48_value temp_vector = S48_FALSE;
long * ptr;
u_long addr=GET_LONG(scheme_name,0); int i;
name.s_addr=addr; S48_DECLARE_GC_PROTECT (2);
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET);
if(host==NULL) if(host==NULL)
{ {
*hostname =NULL; return(s48_enter_fixnum (h_errno));
*aliases =NULL;
*addresses=NULL;
return(h_errno);
} }
*hostname =host->h_name; if (host_info_type_binding == S48_FALSE)
*aliases =host->h_aliases; {
*addresses=host->h_addr_list; S48_GC_PROTECT_GLOBAL(host_info_type_binding);
return(0); host_info_type_binding = s48_get_imported_binding ("host-info-type");
} }
int scheme_host_name2host_info(const char* scheme_name, S48_GC_PROTECT_2 (host_info, temp_vector);
char** hostname,
char*** aliases, host_info = s48_make_record (host_info_type_binding);
char*** addresses) 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 in_addr name;
struct hostent *host; 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) if ((name.s_addr=inet_addr(scheme_name)) != -1)
host=gethostbyaddr((char *)&name,sizeof(name),AF_INET); host=gethostbyaddr((char *)&name,sizeof(name),AF_INET);
else else
host=gethostbyname(scheme_name); host=gethostbyname(scheme_name);
if(host==NULL) return (host_ent2host_info (host));
{
*hostname =NULL;
*aliases =NULL;
*addresses=NULL;
return(h_errno);
}
*hostname =host->h_name;
*aliases =host->h_aliases;
*addresses=host->h_addr_list;
return(0);
} }
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/

21
scsh/network1.h
View File

@ -1,14 +1,15 @@
/* Exports from network1.c. */ /* 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); int scheme_socket_pair(int type, int *s1, int *s2);
@ -47,15 +48,9 @@ int scheme_setsockopt_timeout (int s,
int sec, int sec,
int usec); int usec);
int scheme_host_address2host_info(s48_value scheme_name, s48_value scheme_host_address2host_info(s48_value scheme_byte_vector);
char** hostname,
char*** aliases,
char*** addresses);
int scheme_host_name2host_info(const char* scheme_name, s48_value scheme_host_name2host_info(s48_value scheme_name);
char** hostname,
char*** aliases,
char*** addresses);
int scheme_net_address2net_info(s48_value scheme_name, int scheme_net_address2net_info(s48_value scheme_name,
s48_value scheme_net, s48_value scheme_net,