795 lines
20 KiB
C
795 lines
20 KiB
C
/*
|
|
* Scheme48/scsh network interface.
|
|
* Routines that require custom C support.
|
|
* Copyright (c) 1994 by Brian D. Carlstrom
|
|
* Copyright (c) 1994 by Olin Shivers
|
|
*/
|
|
#include "sysdep.h"
|
|
#include "cstuff.h"
|
|
#include <sys/types.h>
|
|
#include <sys/time.h>
|
|
#include <sys/socket.h>
|
|
#include <sys/un.h>
|
|
#include <errno.h>
|
|
#include <netdb.h>
|
|
#include <netinet/in.h>
|
|
#include <arpa/inet.h>
|
|
#include <string.h>
|
|
#include <stdio.h>
|
|
#include <fcntl.h>
|
|
/* Make sure our exports match up w/the implementation: */
|
|
#include "network1.h"
|
|
#include "scheme48.h"
|
|
extern int h_errno;
|
|
|
|
/* to extract a 4 byte long value from a scheme string */
|
|
|
|
#define GET_LONG(x,n) (*((u_long *)(S48_ADDRESS_AFTER_HEADER((x),unsigned char)+(n*4))))
|
|
|
|
#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)
|
|
{
|
|
int sockfd = s48_extract_fixnum (sock);
|
|
switch(s48_extract_fixnum (family))
|
|
{
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int scheme_length=S48_STRING_LENGTH(scheme_name);
|
|
|
|
name.sun_family=AF_UNIX;
|
|
if (scheme_length>=(108-1)) /* save space for \0 */
|
|
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 */
|
|
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 = 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;
|
|
name.sin_port=port;
|
|
if (bind(sockfd,(struct sockaddr *)&name,sizeof(name)) < 0)
|
|
s48_raise_os_error (errno);
|
|
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
default:
|
|
s48_raise_argtype_error (family);
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name)
|
|
{
|
|
int sockfd = s48_extract_fixnum (sock);
|
|
switch(s48_extract_fixnum (family))
|
|
{
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int ret;
|
|
int scheme_length=S48_STRING_LENGTH(scheme_name);
|
|
|
|
name.sun_family=AF_UNIX;
|
|
if (scheme_length>=(108-1)) /* save space for \0 */
|
|
return(-1);
|
|
strncpy(name.sun_path,
|
|
s48_extract_string (scheme_name),
|
|
scheme_length); /* copy to c string */
|
|
name.sun_path[scheme_length]='\0'; /* add null */
|
|
|
|
if (connect(sockfd,(struct sockaddr *)&name,sizeof(name)) == 0)
|
|
return S48_TRUE;
|
|
|
|
if (errno != EWOULDBLOCK && errno != EINTR && errno != EALREADY
|
|
&& errno != EINPROGRESS && errno != EAGAIN)
|
|
s48_raise_os_error(errno);
|
|
|
|
if (! (s48_add_pending_fd(sockfd, 0)))
|
|
s48_raise_out_of_memory_error();
|
|
|
|
if (errno == EINPROGRESS)
|
|
return s48_enter_fixnum (0);
|
|
else return S48_FALSE;
|
|
|
|
}
|
|
case AF_INET:
|
|
{
|
|
struct sockaddr_in name;
|
|
|
|
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;
|
|
name.sin_port=port;
|
|
|
|
if (connect(sockfd,(struct sockaddr *)&name,sizeof(name)) == 0)
|
|
return S48_TRUE;
|
|
|
|
if (errno != EWOULDBLOCK && errno != EINTR && errno != EALREADY
|
|
&& errno != EINPROGRESS && errno != EAGAIN)
|
|
s48_raise_os_error(errno);
|
|
|
|
if (! (s48_add_pending_fd(sockfd, 0)))
|
|
s48_raise_out_of_memory_error();
|
|
|
|
if (errno == EINPROGRESS)
|
|
return s48_enter_fixnum (0);
|
|
else return S48_FALSE;
|
|
|
|
}
|
|
default:
|
|
s48_raise_argtype_error (family); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
s48_value scheme_accept(s48_value sockfd_tagged, s48_value family)
|
|
{
|
|
int sockfd = s48_extract_fixnum (sockfd_tagged);
|
|
switch(s48_extract_fixnum (family))
|
|
{
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
socklen_t namelen=sizeof(name);
|
|
int newsockfd=accept(sockfd,(struct sockaddr *)&name,&namelen);
|
|
|
|
if (newsockfd < 0)
|
|
{
|
|
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
|
|
s48_raise_os_error(errno);
|
|
if (! s48_add_pending_fd(sockfd, 1))// 1 for is_input
|
|
s48_raise_out_of_memory_error();
|
|
return S48_FALSE;
|
|
}
|
|
|
|
return(s48_enter_fixnum (newsockfd));
|
|
break;
|
|
}
|
|
case AF_INET:
|
|
{
|
|
struct sockaddr_in name;
|
|
socklen_t namelen=sizeof(name);
|
|
int newsockfd;
|
|
s48_value result, sock_addr;
|
|
S48_DECLARE_GC_PROTECT(2);
|
|
newsockfd = accept (sockfd,
|
|
(struct sockaddr *)&name,&namelen);
|
|
|
|
if (newsockfd < 0)
|
|
{
|
|
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
|
|
s48_raise_os_error(errno);
|
|
if (! s48_add_pending_fd(sockfd, 1))// 1 for is_input
|
|
s48_raise_out_of_memory_error();
|
|
return S48_FALSE;
|
|
}
|
|
fcntl(newsockfd, F_SETFL, O_NONBLOCK);
|
|
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;
|
|
socklen_t 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:
|
|
s48_raise_argtype_error (family); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
s48_value scheme_socket_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;
|
|
socklen_t namelen=sizeof(name);
|
|
int value=getsockname(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:
|
|
s48_raise_argtype_error (family); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_socket_pair(int type, int *s1, int *s2)
|
|
{
|
|
int sv[2];
|
|
if( socketpair(PF_UNIX,type,0,sv) ) {
|
|
*s1 = 0; *s2 = 0;
|
|
return errno;
|
|
}
|
|
*s1 = sv[0]; *s2 = sv[1];
|
|
return 0;
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
s48_value
|
|
recv_substring(s48_value scm_sockfd, s48_value flags, s48_value buf,
|
|
s48_value scm_start, s48_value scm_end)
|
|
{
|
|
struct sockaddr_in name;
|
|
socklen_t namelen=sizeof(name);
|
|
int sockfd = s48_extract_fixnum (scm_sockfd);
|
|
int start = s48_extract_fixnum (scm_start);
|
|
int end = s48_extract_fixnum (scm_end);
|
|
char* buf_part = s48_extract_string (buf) + start;
|
|
|
|
int cc=recvfrom(sockfd,
|
|
buf_part, end-start,
|
|
s48_extract_fixnum (flags),
|
|
(struct sockaddr *)&name, &namelen);
|
|
s48_value result;
|
|
|
|
if (cc >= 0)
|
|
return (s48_cons (s48_enter_fixnum (cc),
|
|
s48_cons (make_addr (name.sin_addr.s_addr,
|
|
htonl((u_long)ntohs(name.sin_port))),
|
|
S48_NULL)));
|
|
|
|
|
|
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
|
|
s48_raise_os_error(errno);
|
|
if (! s48_add_pending_fd(sockfd, 1))// 1 for is_input
|
|
s48_raise_out_of_memory_error();
|
|
return S48_FALSE;
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
s48_value send_substring(s48_value scm_sockfd,
|
|
s48_value scm_flags,
|
|
s48_value buf,
|
|
s48_value scm_start,
|
|
s48_value scm_end,
|
|
s48_value scm_family,
|
|
s48_value scheme_name)
|
|
{
|
|
int n;
|
|
int s = s48_extract_fixnum (scm_sockfd);
|
|
int flags = s48_extract_fixnum (scm_flags);
|
|
int start = s48_extract_fixnum (scm_start);
|
|
int end = s48_extract_fixnum (scm_end);
|
|
char* buf_part = s48_extract_string (buf) + start;
|
|
|
|
switch(s48_extract_fixnum (scm_family))
|
|
{
|
|
case 0: /* only with connected sockets */
|
|
{
|
|
n = send(s, buf_part, end-start, flags);
|
|
break;
|
|
}
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int scheme_length=S48_STRING_LENGTH(scheme_name);
|
|
|
|
name.sun_family=AF_UNIX;
|
|
if (scheme_length>=(108-1)) /* save space for \0 */
|
|
return(-1);
|
|
strncpy(name.sun_path,
|
|
s48_extract_string(scheme_name),
|
|
scheme_length); /* copy to c string */
|
|
name.sun_path[scheme_length]='\0'; /* add null */
|
|
n = sendto(s,
|
|
buf_part, end-start,
|
|
flags,
|
|
(struct sockaddr *)&name, sizeof(name));
|
|
break;
|
|
}
|
|
case AF_INET:
|
|
{
|
|
struct sockaddr_in name;
|
|
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;
|
|
name.sin_port=port;
|
|
|
|
n = sendto(s,
|
|
buf_part, end-start,
|
|
flags,
|
|
(struct sockaddr *)&name, sizeof(name));
|
|
break;
|
|
}
|
|
default:
|
|
s48_raise_argtype_error (s48_extract_fixnum (scm_family));
|
|
/* error unknown address family */
|
|
}
|
|
|
|
if (n >= 0)
|
|
return s48_enter_fixnum (n);
|
|
|
|
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
|
|
s48_raise_os_error(errno);
|
|
|
|
if (! s48_add_pending_fd(s, 0))// 0 for is_input
|
|
s48_raise_out_of_memory_error();
|
|
|
|
return S48_FALSE;
|
|
}
|
|
|
|
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_getsockopt (int s,
|
|
int level,
|
|
int optname)
|
|
{
|
|
int optval;
|
|
int optlen=sizeof(optval);
|
|
|
|
if (getsockopt(s,level,optname,(char *)&optval,&optlen) == -1)
|
|
return(-1);
|
|
return(optval);
|
|
|
|
}
|
|
|
|
int scheme_getsockopt_linger (int s,
|
|
int level,
|
|
int optname,
|
|
int *out_time)
|
|
{
|
|
struct linger optval;
|
|
int optlen=sizeof(optval);
|
|
|
|
if (getsockopt(s,level,optname,(char *)&optval,&optlen) == -1) {
|
|
out_time = 0;
|
|
return(-1);
|
|
}
|
|
*out_time=optval.l_linger;
|
|
return(optval.l_onoff);
|
|
}
|
|
|
|
int scheme_getsockopt_timeout (int s,
|
|
int level,
|
|
int optname,
|
|
int *out_usec)
|
|
{
|
|
struct timeval optval;
|
|
size_t optlen=sizeof(optval);
|
|
|
|
if (getsockopt(s,level,optname,(char *)&optval,&optlen) == -1) {
|
|
out_usec = 0;
|
|
return(-1);
|
|
}
|
|
*out_usec=optval.tv_usec;
|
|
return(optval.tv_sec);
|
|
}
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_setsockopt (int s,
|
|
int level,
|
|
int optname,
|
|
int optval)
|
|
{
|
|
return(setsockopt(s,level,optname,(char *)&optval,sizeof(optval)));
|
|
}
|
|
|
|
int scheme_setsockopt_linger (int s,
|
|
int level,
|
|
int optname,
|
|
int onoff,
|
|
int linger)
|
|
{
|
|
struct linger optval;
|
|
|
|
optval.l_onoff=onoff;
|
|
optval.l_linger=linger;
|
|
|
|
return(setsockopt(s,level,optname,(char *)&optval,sizeof(optval)));
|
|
}
|
|
|
|
int scheme_setsockopt_timeout (int s,
|
|
int level,
|
|
int optname,
|
|
int sec,
|
|
int usec)
|
|
{
|
|
struct timeval optval;
|
|
optval.tv_sec=sec;
|
|
optval.tv_usec=usec;
|
|
|
|
return(setsockopt(s,level,optname,(char *)&optval,sizeof(optval)));
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up hosts */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
|
|
static s48_value host_info_type_binding = S48_FALSE;
|
|
|
|
s48_value host_ent2host_info (struct hostent * host)
|
|
{
|
|
s48_value host_info = S48_FALSE;
|
|
s48_value list = S48_FALSE;
|
|
long * ptr;
|
|
int i;
|
|
S48_DECLARE_GC_PROTECT (2);
|
|
|
|
if(host==NULL)
|
|
{
|
|
return(s48_enter_fixnum (h_errno));
|
|
}
|
|
|
|
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");
|
|
}
|
|
|
|
S48_GC_PROTECT_2 (host_info, list);
|
|
|
|
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;
|
|
list = S48_NULL;
|
|
i = 0;
|
|
while (*ptr)
|
|
{
|
|
list = s48_cons (s48_enter_string (host->h_aliases[i]), list);
|
|
ptr++;
|
|
i ++;
|
|
}
|
|
|
|
S48_RECORD_SET (host_info, 1, list);
|
|
|
|
ptr = (long *)host->h_addr_list;
|
|
list = S48_NULL;
|
|
i = 0;
|
|
while (*ptr)
|
|
{
|
|
list =
|
|
s48_cons (long2byte_vector (ntohl (*(long *)(host->h_addr_list[i]))),
|
|
list);
|
|
ptr++;
|
|
i++;
|
|
}
|
|
|
|
S48_RECORD_SET (host_info, 2, list);
|
|
|
|
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);
|
|
|
|
return (host_ent2host_info (host));
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up networks */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
static s48_value network_info_type_binding = S48_FALSE;
|
|
|
|
s48_value netent2net_info(struct netent *net)
|
|
{
|
|
s48_value network_info = S48_FALSE;
|
|
s48_value list = S48_FALSE;
|
|
long * ptr;
|
|
int i;
|
|
S48_DECLARE_GC_PROTECT (2);
|
|
|
|
if (net==NULL) return S48_FALSE;
|
|
|
|
if (network_info_type_binding == S48_FALSE)
|
|
{
|
|
S48_GC_PROTECT_GLOBAL(network_info_type_binding);
|
|
network_info_type_binding =
|
|
s48_get_imported_binding ("network-info-type");
|
|
}
|
|
S48_GC_PROTECT_2 (network_info, list);
|
|
|
|
network_info = s48_make_record (network_info_type_binding);
|
|
S48_RECORD_SET (network_info, 0, s48_enter_string (net->n_name));
|
|
|
|
ptr = (long *)net->n_aliases;
|
|
list = S48_NULL;
|
|
i = 0;
|
|
while (*ptr)
|
|
{
|
|
list = s48_cons (s48_enter_string (net->n_aliases[i]), list);
|
|
ptr++;
|
|
i++;
|
|
}
|
|
|
|
S48_RECORD_SET (network_info, 1, list);
|
|
S48_RECORD_SET (network_info, 2, long2byte_vector (net->n_net));
|
|
|
|
S48_GC_UNPROTECT ();
|
|
|
|
return network_info;
|
|
}
|
|
|
|
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);
|
|
|
|
return netent2net_info (net);
|
|
}
|
|
|
|
s48_value scheme_net_name2net_info(s48_value scheme_name)
|
|
{
|
|
struct netent *net = getnetbyname(s48_extract_string (scheme_name));
|
|
return netent2net_info (net);
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up services */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
|
|
|
|
static s48_value service_info_type_binding = S48_FALSE;
|
|
|
|
s48_value servent2service_info(struct servent *serv)
|
|
{
|
|
s48_value service_info = S48_FALSE;
|
|
s48_value list = S48_FALSE;
|
|
long * ptr;
|
|
int i;
|
|
S48_DECLARE_GC_PROTECT (2);
|
|
|
|
if (serv==NULL) return S48_FALSE;
|
|
|
|
if (service_info_type_binding == S48_FALSE)
|
|
{
|
|
S48_GC_PROTECT_GLOBAL(service_info_type_binding);
|
|
service_info_type_binding =
|
|
s48_get_imported_binding ("service-info-type");
|
|
}
|
|
S48_GC_PROTECT_2 (service_info, list);
|
|
|
|
service_info = s48_make_record (service_info_type_binding);
|
|
|
|
S48_RECORD_SET (service_info, 0, s48_enter_string (serv->s_name));
|
|
|
|
ptr = (long *)serv->s_aliases;
|
|
list = S48_NULL;
|
|
i = 0;
|
|
while (*ptr)
|
|
{
|
|
list = s48_cons (s48_enter_string (serv->s_aliases[i]), list);
|
|
ptr++;
|
|
i++;
|
|
}
|
|
|
|
S48_RECORD_SET (service_info, 1, list);
|
|
S48_RECORD_SET (service_info, 2, s48_enter_fixnum (ntohs (serv->s_port)));
|
|
S48_RECORD_SET (service_info, 3, s48_enter_string (serv->s_proto));
|
|
|
|
S48_GC_UNPROTECT ();
|
|
|
|
return service_info;
|
|
}
|
|
|
|
s48_value scheme_serv_port2serv_info(s48_value in_port,
|
|
s48_value in_proto)
|
|
{
|
|
struct servent *serv;
|
|
char * proto;
|
|
if (in_proto == S48_FALSE) proto = NULL;
|
|
else proto = s48_extract_string (in_proto);
|
|
|
|
serv = getservbyport(ntohs(s48_extract_fixnum (in_port)),
|
|
proto);
|
|
|
|
return servent2service_info (serv);
|
|
}
|
|
|
|
s48_value scheme_serv_name2serv_info(s48_value in_name,
|
|
s48_value in_proto)
|
|
{
|
|
struct servent *serv;
|
|
char * proto;
|
|
|
|
if (in_proto == S48_FALSE) proto = NULL;
|
|
else proto = s48_extract_string (in_proto);
|
|
|
|
serv = getservbyname(s48_extract_string (in_name),
|
|
proto);
|
|
|
|
return servent2service_info (serv);
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up protocols */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
|
|
static s48_value protocol_info_type_binding = S48_FALSE;
|
|
|
|
s48_value protoent2protocol_info(struct protoent *proto)
|
|
{
|
|
s48_value protocol_info = S48_FALSE;
|
|
s48_value list = S48_FALSE;
|
|
long * ptr;
|
|
int i;
|
|
S48_DECLARE_GC_PROTECT (2);
|
|
|
|
if (proto==NULL) return S48_FALSE;
|
|
|
|
if (protocol_info_type_binding == S48_FALSE)
|
|
{
|
|
S48_GC_PROTECT_GLOBAL(protocol_info_type_binding);
|
|
protocol_info_type_binding =
|
|
s48_get_imported_binding ("protocol-info-type");
|
|
}
|
|
S48_GC_PROTECT_2 (protocol_info, list);
|
|
|
|
protocol_info = s48_make_record (protocol_info_type_binding);
|
|
|
|
S48_RECORD_SET (protocol_info, 0, s48_enter_string (proto->p_name));
|
|
|
|
ptr = (long *)proto->p_aliases;
|
|
list = S48_NULL;
|
|
i = 0;
|
|
while (*ptr)
|
|
{
|
|
list = s48_cons (s48_enter_string (proto->p_aliases[i]), list);
|
|
ptr++;
|
|
i++;
|
|
}
|
|
|
|
S48_RECORD_SET (protocol_info, 1, list);
|
|
S48_RECORD_SET (protocol_info, 2, s48_enter_fixnum (proto->p_proto));
|
|
|
|
S48_GC_UNPROTECT ();
|
|
|
|
return protocol_info;
|
|
}
|
|
|
|
s48_value scheme_proto_num2proto_info(s48_value in_proto)
|
|
{
|
|
struct protoent *proto;
|
|
|
|
proto=getprotobynumber(s48_extract_fixnum (in_proto));
|
|
|
|
return protoent2protocol_info (proto);
|
|
}
|
|
|
|
s48_value scheme_proto_name2proto_info(s48_value in_name)
|
|
{
|
|
struct protoent *proto=getprotobyname(s48_extract_string (in_name));
|
|
|
|
return protoent2protocol_info (proto);
|
|
}
|
|
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Low Level Junk */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* svec is a Scheme vector of C carriers. Scan over the C longs
|
|
** in cvec, and initialise the corresponding carriers in svec.
|
|
*/
|
|
void set_longvec_carriers(s48_value svec, long const * const * cvec)
|
|
{
|
|
int svec_len = S48_VECTOR_LENGTH(svec);
|
|
long const * const *cv = cvec;
|
|
s48_value s = S48_VECTOR_REF(svec,0); //JMG hack
|
|
s48_value *sv = &s;
|
|
|
|
for(; svec_len > 0; cv++, sv++, svec_len-- ) {
|
|
/* *sv is a (make-string 4) */
|
|
s48_value carrier = *sv;
|
|
(*((u_long *)(S48_ADDRESS_AFTER_HEADER(carrier,unsigned char))))
|
|
=(long)**cv;
|
|
}
|
|
}
|
|
|
|
/* One arg, a zero-terminated C word vec. Returns length.
|
|
** The terminating null is not counted. Returns #f on NULL.
|
|
*/
|
|
|
|
s48_value veclen(const long *vec)
|
|
{
|
|
const long *vptr = vec;
|
|
if( !vptr ) return S48_FALSE;
|
|
while( *vptr ) vptr++;
|
|
return s48_enter_fixnum(vptr - vec);
|
|
}
|
|
|
|
|
|
|