scsh-0.5/scsh/network1.c

610 lines
14 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>
#include <sys/un.h>
#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"
extern int h_errno;
/* 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)
{
case AF_UNIX:
{
struct sockaddr_un name;
int scheme_length=STRING_LENGTH(scheme_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+1]='\0'; /* add null */
return(bind(sockfd,(struct sockaddr *)&name,sizeof(name)));
break;
}
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)));
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)
{
case AF_UNIX:
{
struct sockaddr_un name;
int scheme_length=STRING_LENGTH(scheme_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+1]='\0'; /* add null */
return(connect(sockfd,(struct sockaddr *)&name,sizeof(name)));
break;
}
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)));
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)
{
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;
}
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 6: /* 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);
}
case AF_UNIX:
{
struct sockaddr_un name;
int scheme_length=STRING_LENGTH(scheme_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+1]='\0'; /* add null */
return(sendto(s,
StrByte(buf,start), end-start,
flags,
(struct sockaddr *)&name, sizeof(name)));
break;
}
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)));
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)
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)
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(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);
}