scsh-0.5/scsh/network1.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"

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)
    {
#ifdef HAVE_SYS_UN_H
    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]='\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)));
	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);
	
	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)));

	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);
	
	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)));
	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);
}