640 lines
15 KiB
C
640 lines
15 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 "cstuff.h"
|
|
#include <sys/types.h>
|
|
#include <sys/time.h>
|
|
#include <sys/socket.h>
|
|
#ifdef HAVE_SYS_UN_H
|
|
#include <sys/un.h>
|
|
#endif
|
|
#include <errno.h>
|
|
#include <netdb.h>
|
|
#include <netinet/in.h>
|
|
#include <arpa/inet.h>
|
|
#include <string.h>
|
|
#include <stdio.h>
|
|
|
|
/* Make sure our exports match up w/the implementation: */
|
|
#include "network1.h"
|
|
|
|
#if !defined(__CYGWIN__) && !defined(_AIX)
|
|
extern int h_errno;
|
|
#endif
|
|
|
|
/* to extract a 4 byte long value from a scheme string */
|
|
|
|
#define GET_LONG(x,n) (*((u_long *)(ADDRESS_AFTER_HEADER((x),unsigned char)+(n*4))))
|
|
|
|
#define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v);
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_bind(int sockfd, int family, scheme_value scheme_name)
|
|
{
|
|
switch(family)
|
|
{
|
|
#ifdef HAVE_SYS_UN_H
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int scheme_length=STRING_LENGTH(scheme_name);
|
|
|
|
memset(&name, 0, sizeof(name));
|
|
|
|
name.sun_family=AF_UNIX;
|
|
if (scheme_length>=(108-1)) /* save space for \0 */
|
|
return(-1);
|
|
strncpy(name.sun_path,
|
|
ADDRESS_AFTER_HEADER(scheme_name,char),
|
|
scheme_length); /* copy to c string */
|
|
name.sun_path[scheme_length]='\0'; /* add null */
|
|
return(bind(sockfd,(struct sockaddr *)&name,sizeof(name)));
|
|
break;
|
|
}
|
|
#endif
|
|
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)));
|
|
|
|
memset(&name, 0, sizeof(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;
|
|
}
|
|
default:
|
|
return(-1); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_connect(int sockfd, int family, scheme_value scheme_name)
|
|
{
|
|
switch(family)
|
|
{
|
|
#ifdef HAVE_SYS_UN_H
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int scheme_length=STRING_LENGTH(scheme_name);
|
|
|
|
memset(&name, 0, sizeof(name));
|
|
|
|
name.sun_family=AF_UNIX;
|
|
if (scheme_length>=(108-1)) /* save space for \0 */
|
|
return(-1);
|
|
strncpy(name.sun_path,
|
|
ADDRESS_AFTER_HEADER(scheme_name,char),
|
|
scheme_length); /* copy to c string */
|
|
name.sun_path[scheme_length]='\0'; /* add null */
|
|
return(connect(sockfd,(struct sockaddr *)&name,sizeof(name)));
|
|
break;
|
|
}
|
|
#endif
|
|
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)));
|
|
|
|
memset(&name, 0, sizeof(name));
|
|
|
|
name.sin_family=AF_INET;
|
|
name.sin_addr.s_addr=addr;
|
|
name.sin_port=port;
|
|
|
|
return(connect(sockfd,(struct sockaddr *)&name,sizeof(name)));
|
|
|
|
break;
|
|
}
|
|
default:
|
|
return(-1);
|
|
/* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_accept(int sockfd, int family, scheme_value scheme_name)
|
|
{
|
|
switch(family)
|
|
{
|
|
#ifdef HAVE_SYS_UN_H
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int namelen=sizeof(name);
|
|
int newsockfd=accept(sockfd,(struct sockaddr *)&name,&namelen);
|
|
|
|
if (newsockfd < 0)
|
|
return(-1);
|
|
|
|
return(newsockfd);
|
|
break;
|
|
}
|
|
#endif
|
|
case AF_INET:
|
|
{
|
|
struct sockaddr_in name;
|
|
int namelen=sizeof(name);
|
|
int newsockfd=accept(sockfd,(struct sockaddr *)&name,&namelen);
|
|
|
|
if (newsockfd < 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(newsockfd);
|
|
break;
|
|
}
|
|
default:
|
|
return(-1); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_peer_name(int sockfd, int family, scheme_value scheme_name)
|
|
{
|
|
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, scheme_value scheme_name)
|
|
{
|
|
switch(family)
|
|
{
|
|
case AF_INET:
|
|
{
|
|
struct sockaddr_in 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);
|
|
break;
|
|
}
|
|
default:
|
|
return(-1); /* 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;
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int recv_substring(int s,
|
|
int flags,
|
|
scheme_value buf,
|
|
int start,
|
|
int end,
|
|
scheme_value scheme_name)
|
|
{
|
|
|
|
switch(STRING_LENGTH(scheme_name))
|
|
{
|
|
#ifdef NOTUSED
|
|
/* no longer used. always return remote socket info */
|
|
case 0: /* only with connected sockets */
|
|
{
|
|
return recv(s, StrByte(buf,start), end-start, flags);
|
|
}
|
|
#endif
|
|
case 8: /* AF_INET */
|
|
{
|
|
struct sockaddr_in name;
|
|
int namelen=sizeof(name);
|
|
int cc=recvfrom(s,
|
|
StrByte(buf,start), end-start,
|
|
flags,
|
|
(struct sockaddr *)&name, &namelen);
|
|
|
|
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);
|
|
break;
|
|
}
|
|
default:
|
|
return(-1); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int send_substring(int s,
|
|
int flags,
|
|
scheme_value buf,
|
|
int start,
|
|
int end,
|
|
int family,
|
|
scheme_value scheme_name)
|
|
{
|
|
|
|
switch(family)
|
|
{
|
|
case 0: /* only with connected sockets */
|
|
{
|
|
return send(s, StrByte(buf,start), end-start, flags);
|
|
}
|
|
#ifdef HAVE_SYS_UN_H
|
|
case AF_UNIX:
|
|
{
|
|
struct sockaddr_un name;
|
|
int scheme_length=STRING_LENGTH(scheme_name);
|
|
|
|
memset(&name, 0, sizeof(name));
|
|
|
|
name.sun_family=AF_UNIX;
|
|
if (scheme_length>=(108-1)) /* save space for \0 */
|
|
return(-1);
|
|
strncpy(name.sun_path,
|
|
ADDRESS_AFTER_HEADER(scheme_name,char),
|
|
scheme_length); /* copy to c string */
|
|
name.sun_path[scheme_length]='\0'; /* add null */
|
|
return(sendto(s,
|
|
StrByte(buf,start), end-start,
|
|
flags,
|
|
(struct sockaddr *)&name, sizeof(name)));
|
|
break;
|
|
}
|
|
#endif
|
|
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)));
|
|
|
|
memset(&name, 0, sizeof(name));
|
|
|
|
name.sin_family=AF_INET;
|
|
name.sin_addr.s_addr=addr;
|
|
name.sin_port=port;
|
|
|
|
return(sendto(s,
|
|
StrByte(buf,start), end-start,
|
|
flags,
|
|
(struct sockaddr *)&name, sizeof(name)));
|
|
break;
|
|
}
|
|
default:
|
|
return(-1); /* error unknown address family */
|
|
}
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
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;
|
|
int 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 */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_host_address2host_info(scheme_value scheme_name,
|
|
char** hostname,
|
|
char*** aliases,
|
|
char*** addresses)
|
|
{
|
|
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);
|
|
|
|
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);
|
|
}
|
|
|
|
int scheme_host_name2host_info(const char* scheme_name,
|
|
char** hostname,
|
|
char*** aliases,
|
|
char*** addresses)
|
|
{
|
|
struct in_addr name;
|
|
struct hostent *host;
|
|
|
|
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);
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up networks */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_net_address2net_info(scheme_value scheme_name,
|
|
scheme_value scheme_net,
|
|
char** netname,
|
|
char*** aliases)
|
|
{
|
|
struct netent *net;
|
|
|
|
net=getnetbyaddr(ntohl(GET_LONG(scheme_name,0)),AF_INET);
|
|
|
|
if(net==NULL)
|
|
{
|
|
*netname=NULL;
|
|
*aliases=NULL;
|
|
return(-1);
|
|
}
|
|
|
|
*netname=net->n_name;
|
|
*aliases=net->n_aliases;
|
|
SET_LONG(scheme_net,0,net->n_net);
|
|
return(0);
|
|
}
|
|
|
|
int scheme_net_name2net_info(const char* scheme_name,
|
|
scheme_value scheme_net,
|
|
char** netname,
|
|
char*** aliases)
|
|
{
|
|
struct netent *net=getnetbyname(scheme_name);
|
|
|
|
if(net==NULL)
|
|
{
|
|
*netname=NULL;
|
|
*aliases=NULL;
|
|
return(-1);
|
|
}
|
|
|
|
*netname=net->n_name;
|
|
*aliases=net->n_aliases;
|
|
SET_LONG(scheme_net,0,net->n_net); /* ??? -Olin */
|
|
return(0);
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up services */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
|
|
/* in_port should be declared u_short, but cig doesn't know about them. */
|
|
int scheme_serv_port2serv_info(int in_port,
|
|
const char* in_proto,
|
|
char** out_servname,
|
|
char*** out_aliases,
|
|
int* out_port,
|
|
char** out_protocol)
|
|
{
|
|
struct servent *serv;
|
|
|
|
serv=getservbyport(ntohs(in_port),in_proto);
|
|
|
|
if(serv==NULL)
|
|
{
|
|
*out_servname=NULL;
|
|
*out_aliases=NULL;
|
|
*out_port=0;
|
|
*out_protocol=NULL;
|
|
return(-1);
|
|
}
|
|
|
|
*out_servname=serv->s_name;
|
|
*out_aliases =serv->s_aliases;
|
|
*out_port =(int)ntohs(serv->s_port);
|
|
*out_protocol=serv->s_proto;
|
|
return(0);
|
|
}
|
|
|
|
int scheme_serv_name2serv_info(const char* in_name,
|
|
const char* in_proto,
|
|
char** out_servname,
|
|
char*** out_aliases,
|
|
int* out_port,
|
|
char** out_protocol)
|
|
{
|
|
struct servent *serv=getservbyname(in_name,in_proto);
|
|
|
|
if(serv==NULL)
|
|
{
|
|
*out_servname=NULL;
|
|
*out_aliases=NULL;
|
|
*out_port=0;
|
|
*out_protocol=NULL;
|
|
return(-1);
|
|
}
|
|
|
|
*out_servname=serv->s_name;
|
|
*out_aliases =serv->s_aliases;
|
|
*out_port =(int)ntohs(serv->s_port);
|
|
*out_protocol=serv->s_proto;
|
|
return(0);
|
|
}
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* Routines for looking up protocols */
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
int scheme_proto_num2proto_info(int in_proto,
|
|
char** out_protoname,
|
|
char*** out_aliases,
|
|
int* out_protocol)
|
|
{
|
|
struct protoent *proto;
|
|
|
|
proto=getprotobynumber(in_proto);
|
|
|
|
if(proto==NULL)
|
|
{
|
|
*out_protoname=NULL;
|
|
*out_aliases=NULL;
|
|
*out_protocol=0;
|
|
return(-1);
|
|
}
|
|
|
|
*out_protoname=proto->p_name;
|
|
*out_aliases =proto->p_aliases;
|
|
*out_protocol =proto->p_proto;
|
|
return(0);
|
|
}
|
|
|
|
int scheme_proto_name2proto_info(const char* in_name,
|
|
char** out_protoname,
|
|
char*** out_aliases,
|
|
int* out_protocol)
|
|
{
|
|
struct protoent *proto=getprotobyname(in_name);
|
|
|
|
if(proto==NULL)
|
|
{
|
|
*out_protoname=NULL;
|
|
*out_aliases=NULL;
|
|
*out_protocol=0;
|
|
return(-1);
|
|
}
|
|
|
|
*out_protoname=proto->p_name;
|
|
*out_aliases =proto->p_aliases;
|
|
*out_protocol =proto->p_proto;
|
|
return(0);
|
|
}
|
|
|
|
|
|
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
|
/* 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(scheme_value svec, long const * const * cvec)
|
|
{
|
|
int svec_len = VECTOR_LENGTH(svec);
|
|
long const * const *cv = cvec;
|
|
scheme_value *sv = &VECTOR_REF(svec,0);
|
|
|
|
for(; svec_len > 0; cv++, sv++, svec_len-- ) {
|
|
/* *sv is a (make-string 4) */
|
|
scheme_value carrier = *sv;
|
|
(*((u_long *)(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.
|
|
*/
|
|
|
|
scheme_value veclen(const long *vec)
|
|
{
|
|
const long *vptr = vec;
|
|
if( !vptr ) return SCHFALSE;
|
|
while( *vptr ) vptr++;
|
|
return ENTER_FIXNUM(vptr - vec);
|
|
}
|