/* "socket.c" internet stream socket support for client/server in SCM
    Copyright (C) 1994 Aubrey Jaffer.
    Thanks to Hallvard.Tretteberg@si.sintef.no
    who credits NCSA httpd software by Rob McCool 3/21/93
*/

/* FIXME: for autoconf.  */
#undef MISSING_INET_ATON

#include "scm.h"
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <netdb.h>
#include <arpa/inet.h>

#ifndef STDC_HEADERS
int close P ((int fd));
#endif /* STDC_HEADERS */

/* FIXME  */
#ifdef MISSING_INET_ATON
#include "inet_addr.c"
#endif

#if 0
static char s_inet_aton[] = "%inet-aton";
SCM 
scm_inet_aton (address)
     SCM address;
{
  struct in_addr soka;
  int rv;
  ASSERT (NIMP (address) && STRINGP (address), address, ARG1, s_inet_aton);
  rv = inet_aton (CHARS (address), &soka);
  return rv ? scm_ulong2num (ntohl (soka.s_addr)) : BOOL_F;
}
#endif

static char s_inet_ntoa[] = "inet-ntoa";
SCM 
scm_inet_ntoa (inetid)
     SCM inetid;
{
  struct in_addr addr;
  char *s;
  addr.s_addr = htonl (scm_num2ulong (inetid, (char *) ARG1, s_inet_ntoa));
  s = inet_ntoa (addr);
  return scm_makfromstr (s, strlen (s), 0);
}

static char s_network[] = "inet-netof";
SCM 
scm_network (address)
     SCM address;
{
  struct in_addr addr;
  addr.s_addr = htonl (scm_num2ulong (address, (char *) ARG1, s_network));
  return scm_ulong2num ((unsigned long) inet_netof (addr));
}

static char s_lna[] = "inet-lnaof";
SCM 
scm_lna (address)
     SCM address;
{
  struct in_addr addr;
  addr.s_addr = htonl (scm_num2ulong (address, (char *) ARG1, s_lna));
  return scm_ulong2num ((unsigned long) inet_lnaof (addr));
}

static char s_makeaddr[] = "inet-makeaddr";
SCM 
scm_makeaddr (net, lna)
     SCM net, lna;
{
  struct in_addr addr;
  unsigned long netnum = scm_num2ulong (net, (char *) ARG1, s_makeaddr);
  unsigned long lnanum = scm_num2ulong (lna, (char *) ARG2, s_makeaddr);
  addr = inet_makeaddr (netnum, lnanum);
  return scm_ulong2num (ntohl (addr.s_addr));
}

/* FIXME: Doesn't take address format.
 * Assumes hostent stream isn't reused.
 */
static char s_hostinfo[] = "gethost";
SCM 
l_hostinfo (name)
     SCM name;
{
  SCM ans = scm_make_vector (MAKINUM (5), UNSPECIFIED);
  SCM *ve = VELTS (ans);
  SCM lst = EOL;
  struct hostent *entry;
  struct in_addr inad;
  char **argv;
  int i = 0;
#ifdef HAVE_GETHOSTENT
  if UNBNDP
    (name)
    {
      DEFER_INTS;
      SYSCALL (entry = gethostent (););
    }
  else
#endif
  if (NIMP (name) && STRINGP (name))
    {
      DEFER_INTS;
      SYSCALL (entry = gethostbyname (CHARS (name));
	);
    }
  else
    {
      inad.s_addr = htonl (scm_num2ulong (name, (char *) ARG1, s_hostinfo));
      DEFER_INTS;
      SYSCALL (entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET);
	);
    }
  ALLOW_INTS;
  if (!entry)
    return BOOL_F;
  ve[0] = scm_makfromstr (entry->h_name, (sizet) strlen (entry->h_name), 0);
  ve[1] = makfromstrs (-1, entry->h_aliases);
  ve[2] = MAKINUM (entry->h_addrtype + 0L);
  ve[3] = MAKINUM (entry->h_length + 0L);
  if (sizeof (struct in_addr) != entry->h_length)
    {
      ve[4] = BOOL_F;
      return ans;
    }
  for (argv = entry->h_addr_list; argv[i]; i++);
  while (i--)
    {
      inad = *(struct in_addr *) argv[i];
      lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst);
    }
  ve[4] = lst;
  return ans;
}
static char s_netinfo[] = "getnet";
SCM 
l_netinfo (name)
     SCM name;
{
  SCM ans = scm_make_vector (MAKINUM (4), UNSPECIFIED);
  SCM *ve = VELTS (ans);
  struct netent *entry;
  if UNBNDP
    (name)
    {
      DEFER_INTS;
      SYSCALL (entry = getnetent ();
	);
    }
  else if (NIMP (name) && STRINGP (name))
    {
      DEFER_INTS;
      SYSCALL (entry = getnetbyname (CHARS (name));
	);
    }
  else
    {
      unsigned long netnum;
      netnum = scm_num2ulong (name, (char *) ARG1, s_netinfo);
      DEFER_INTS;
      SYSCALL (entry = getnetbyaddr (netnum, AF_INET);
	);
    }
  ALLOW_INTS;
  if (!entry)
    return BOOL_F;
  ve[0] = scm_makfromstr (entry->n_name, (sizet) strlen (entry->n_name), 0);
  ve[1] = makfromstrs (-1, entry->n_aliases);
  ve[2] = MAKINUM (entry->n_addrtype + 0L);
  ve[3] = scm_ulong2num (entry->n_net + 0L);
  return ans;
}
static char s_protoinfo[] = "getproto";
SCM 
l_protoinfo (name)
     SCM name;
{
  SCM ans = scm_make_vector (MAKINUM (3), UNSPECIFIED);
  SCM *ve = VELTS (ans);
  struct protoent *entry;
  if UNBNDP
    (name)
    {
      DEFER_INTS;
      SYSCALL (entry = getprotoent ();
	);
    }
  else if (NIMP (name) && STRINGP (name))
    {
      DEFER_INTS;
      SYSCALL (entry = getprotobyname (CHARS (name));
	);
    }
  else
    {
      unsigned long protonum;
      protonum = scm_num2ulong (name, (char *) ARG1, s_protoinfo);
      DEFER_INTS;
      SYSCALL (entry = getprotobynumber (protonum);
	);
    }
  ALLOW_INTS;
  if (!entry)
    return BOOL_F;
  ve[0] = scm_makfromstr (entry->p_name, (sizet) strlen (entry->p_name), 0);
  ve[1] = makfromstrs (-1, entry->p_aliases);
  ve[2] = MAKINUM (entry->p_proto + 0L);
  return ans;
}
static char s_servinfo[] = "getserv";
SCM 
l_servinfo (args)
     SCM args;
{
  SCM ans = scm_make_vector (MAKINUM (4), UNSPECIFIED);
  SCM *ve = VELTS (ans);
  SCM name, proto;
  struct servent *entry;
  if NULLP
    (args)
    {
      DEFER_INTS;
      SYSCALL (entry = getservent ();
	);
      goto comlab;
    }
  name = CAR (args);
  proto = CDR (args);
  ASSERT (NIMP (proto) && CONSP (proto), args, WNA, s_servinfo);
  proto = CAR (proto);
  ASSERT (NIMP (proto) && STRINGP (proto), args, ARG2, s_servinfo);
  DEFER_INTS;
  if (NIMP (name) && STRINGP (name))
    SYSCALL (entry = getservbyname (CHARS (name), CHARS (proto));
    );
  else
  {
    ASSERT (INUMP (proto), proto, ARG1, s_servinfo);
    SYSCALL (entry = getservbyport (INUM (proto), CHARS (proto));
      );
  }
comlab:ALLOW_INTS;
  if (!entry)
    return BOOL_F;
  ve[0] = scm_makfromstr (entry->s_name, (sizet) strlen (entry->s_name), 0);
  ve[1] = makfromstrs (-1, entry->s_aliases);
  ve[2] = MAKINUM (ntohs (entry->s_port) + 0L);
  ve[3] = scm_makfromstr (entry->s_proto, (sizet) strlen (entry->s_proto), 0);
  return ans;
}

SCM 
l_sethost (arg)
     SCM arg;
{
  if UNBNDP
    (arg) endhostent ();
  else
    sethostent (NFALSEP (arg));
  return UNSPECIFIED;
}
SCM 
l_setnet (arg)
     SCM arg;
{
  if UNBNDP
    (arg) endnetent ();
  else
    setnetent (NFALSEP (arg));
  return UNSPECIFIED;
}
SCM 
l_setproto (arg)
     SCM arg;
{
  if UNBNDP
    (arg) endprotoent ();
  else
    setprotoent (NFALSEP (arg));
  return UNSPECIFIED;
}
SCM 
l_setserv (arg)
     SCM arg;
{
  if UNBNDP
    (arg) endservent ();
  else
    setservent (NFALSEP (arg));
  return UNSPECIFIED;
}

/* FIXME: can not make a server for UDP packets with this "port not
 * opened for reading or writing" method.
 */
static char s_socket[] = "%socket";
SCM 
scm_socket (family, style, proto)
     SCM family, style, proto;
{
  int fd;
  FILE *f;
  int fam;
  SCM result;
  ASSERT (INUMP (family), family, ARG1, s_socket);
  ASSERT (INUMP (style), style, ARG2, s_socket);
  ASSERT (INUMP (proto), proto, ARG3, s_socket);
  fam = INUM (family);
  NEWCELL (result);
  DEFER_INTS;
  fd = socket (fam, INUM (style), INUM (proto));
  if (fd == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  f = fdopen (fd, "r+");
  if (!f)
    {
      SYSCALL (close (fd));
      ALLOW_INTS;
      return BOOL_F;
    }
  CAR (result) = tc_socket | (fam << 24) | BUF0;
  SETSTREAM (result, f);
  i_setbuf0 (result);
  scm_add_to_port_table (result);
  ALLOW_INTS;
  return result;
}

static char s_socketpair[] = "%socketpair";
SCM 
scm_socketpair (family, style, proto)
     SCM family, style, proto;
{
  int rv;
  int fam;
  int fd[2];
  FILE *f[2];
  SCM port[2];
  ASSERT (INUMP (family), family, ARG1, s_socketpair);
  ASSERT (INUMP (style), style, ARG2, s_socketpair);
  ASSERT (INUMP (proto), proto, ARG3, s_socketpair);
  fam = INUM (family);
  NEWCELL (port[0]);
  NEWCELL (port[1]);
  DEFER_INTS;
  rv = socketpair (fam, INUM (style), INUM (proto), fd);
  if (rv == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  f[0] = fdopen (fd[0], "r+");
  if (!f[0])
    {
      SYSCALL (close (fd[0]));
      SYSCALL (close (fd[1]));
      ALLOW_INTS;
      return BOOL_F;
    }
  f[1] = fdopen (fd[1], "r+");
  if (!f[1])
    {
      fclose (f[0]);
      SYSCALL (close (fd[1]));
      ALLOW_INTS;
      return BOOL_F;
    }
  CAR (port[0]) = CAR (port[1]) = tc16_fport | scm_mode_bits ("r+0");
  SETSTREAM (port[0], f[0]);
  SETSTREAM (port[1], f[1]);
  i_setbuf0 (port[0]);
  i_setbuf0 (port[1]);
  scm_add_to_port_table (port[0]);
  scm_add_to_port_table (port[1]);
  ALLOW_INTS;
  return scm_cons (port[0], port[1]);
}

static char s_getsockopt[] = "%getsockopt";
SCM
scm_getsockopt (port, level, optname)
     SCM port, level, optname;
{
  int rv;
  int fd;
  sizet optlen = sizeof (struct linger); /* Biggest option :-(  */
  char optval[optlen];
  int ilevel, ioptname;
  ASSERT (NIMP (port) && OPPORTP (port), port, ARG1, s_getsockopt);
  ASSERT (INUMP (level), level, ARG2, s_getsockopt);
  ASSERT (INUMP (optname), optname, ARG3, s_getsockopt);
  fd = fileno (STREAM (port));
  if (fd == -1)
    return BOOL_F;
  ilevel = INUM (level);
  ioptname = INUM (optname);
  rv = getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen);
  if (rv == -1)
    return BOOL_F;

#ifdef SO_LINGER
  if (ilevel == SOL_SOCKET && ioptname == SO_LINGER)
    {
      struct linger *ling = (struct linger *) optval;
      return scm_cons (MAKINUM (ling->l_onoff),
		       MAKINUM (ling->l_linger));
    }
#endif
#ifdef SO_SNDBUF
  if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF)
    {
      sizet *bufsize = (sizet *) optval;
      return MAKINUM (*bufsize);
    }
#endif
#ifdef SO_RCVBUF
  if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF)
    {
      sizet *bufsize = (sizet *) optval;
      return MAKINUM (*bufsize);
    }
#endif
  return MAKINUM (*(int *) optval);
}

char s_setsockopt[] = "%setsockopt";
SCM
scm_setsockopt (port, level, optname, value)
     SCM port, level, optname, value;
{
  int rv;
  int fd;
  sizet optlen;
  char optval[sizeof (struct linger)]; /* Biggest option :-(  */
  int ilevel, ioptname;
  ASSERT (NIMP (port) && OPPORTP (port), port, ARG1, s_setsockopt);
  ASSERT (INUMP (level), level, ARG2, s_setsockopt);
  ASSERT (INUMP (optname), optname, ARG3, s_setsockopt);
  fd = fileno (STREAM (port));
  if (fd == -1)
    return BOOL_F;
  ilevel = INUM (level);
  ioptname = INUM (optname);
  if (0);
#ifdef SO_LINGER
  else if (ilevel == SOL_SOCKET && ioptname == SO_LINGER)
    {
      struct linger ling;
      ASSERT (NIMP (value) && CONSP (value) && INUMP (CAR (value))
	      &&  INUMP (CDR (value)),
	      value, ARG4, s_setsockopt);
      ling.l_onoff = INUM (CAR (value));
      ling.l_linger = INUM (CDR (value));
      optlen = sizeof (struct linger);
      memcpy (optval, (void *) &ling, optlen);
    }
#endif
#ifdef SO_SNDBUF
  else if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF)
    {
      ASSERT (INUMP (value), value, ARG4, s_setsockopt);
      optlen = sizeof (sizet);
      (*(sizet *) optval) = (sizet) INUM (value);
    }
#endif
#ifdef SO_RCVBUF
  else if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF)
    {
      ASSERT (INUMP (value), value, ARG4, s_setsockopt);
      optlen = sizeof (sizet);
      (*(sizet *) optval) = (sizet) INUM (value);
    }
#endif
  else
    {
      /* Most options just take an int.  */
      optlen = sizeof (int);
      ASSERT (INUMP (value), value, ARG4, s_setsockopt);
      (*(int *) optval) = (int) INUM (value);
    }
  rv = setsockopt (fd, ilevel, ioptname, (void *) optval, optlen);
  return (rv == -1) ? BOOL_F : BOOL_T;
}

static char s_shutdown[] = "%shutdown";
SCM 
scm_shutdown (port, how)
     SCM port, how;
{
  int rv;
  int fd;
  ASSERT (NIMP (port) && OPPORTP (port), port, ARG1, s_shutdown);
  ASSERT (INUMP (how) && 0 <= INUM (how) && 2 >= INUM (how),
	  how, ARG2, s_shutdown);
  fd = fileno (STREAM (port));
  if (fd == -1)
    return BOOL_F;
  rv = shutdown (fd, INUM (how));
  if (rv == -1)
    return BOOL_F;
  switch (INUM (how))
    {
    case 0:
      CAR (port) &= ~RDNG;
      break;
    case 1:
      CAR (port) &= ~WRTNG;
      break;
    case 2:
      CAR (port) &= ~(RDNG | WRTNG);
    }
  /* Close port if can't read or write.  */
  if (!((RDNG | WRTNG) & CAR(port)))
    scm_close_port (port);
  return BOOL_T;
}

static char s_connect[] = "%connect";
SCM 
scm_connect (sockpt, address, args)
     SCM sockpt, address, args;
{
  int rv;
  int fd;
  ASSERT (NIMP (sockpt) && SOCKP (sockpt), sockpt, ARG1, s_connect);
  switch (SOCKTYP (sockpt))
    {
    case AF_INET:
      ASSERT (NIMP (args) && CONSP (args) && NULLP (CDR (args)),
	      args, ARG3, s_connect);
      args = CAR (args);
      ASSERT (INUMP (args), args, ARG3, s_connect);
      {
	struct sockaddr_in soka;
	soka.sin_addr.s_addr =
	  htonl (scm_num2ulong (address, (char *) ARG2, s_connect));
	soka.sin_family = AF_INET;
	soka.sin_port = htons (INUM (args));
	fd = fileno (STREAM (sockpt));
	if (fd == -1)
	  return BOOL_F;
	rv = connect (fd, (struct sockaddr *) &soka, sizeof (soka));
      }
      break;
    case AF_UNIX:
      ASSERT (NULLP (args), args, WNA, s_connect);
      ASSERT (NIMP (address) && STRINGP (address),
	      address, ARG2, s_connect);
      {
	struct sockaddr_un soka;
	soka.sun_family = AF_UNIX;
	memcpy (&soka.sun_path, CHARS (address), 1 + LENGTH (address));
	fd = fileno (STREAM (sockpt));
	if (fd == -1)
	  return BOOL_F;
	rv = connect (fd, (struct sockaddr *) &soka, sizeof (soka));
      }
      break;
    default:
      return BOOL_F;
    }
  if (rv)
    return BOOL_F;
  CAR (sockpt) = tc16_fport | scm_mode_bits ("r+");
  return BOOL_T;
}

static char s_bind[] = "%bind";
SCM 
scm_bind (sockpt, address)
     SCM sockpt, address;
{
  int rv;
  int fd;
  ASSERT (NIMP (sockpt) && SOCKP (sockpt), sockpt, ARG1, s_bind);
  switch (SOCKTYP (sockpt))
    {
    case AF_UNIX:
      ASSERT (NIMP (address) && STRINGP (address), address, ARG2, s_bind);
      {
	struct sockaddr_un sa_server;
	bzero ((char *) &sa_server, sizeof (sa_server));
	sa_server.sun_family = AF_UNIX;
	memcpy (&sa_server.sun_path, CHARS (address), 1 + LENGTH (address));
	fd = fileno (STREAM (sockpt));
	if (fd == -1)
	  return BOOL_F;
	rv = bind (fd, (struct sockaddr *) &sa_server, sizeof (sa_server));
      }
      break;
    case AF_INET:
      ASSERT (INUMP (address), address, ARG2, s_bind);
      {
	struct sockaddr_in sa_server;
	bzero ((char *) &sa_server, sizeof (sa_server));
	sa_server.sin_family = AF_INET;
	sa_server.sin_addr.s_addr = htonl (INADDR_ANY);
	sa_server.sin_port = htons (INUM (address));
	fd = fileno (STREAM (sockpt));
	if (fd == -1)
	  return BOOL_F;
	rv = bind (fd, (struct sockaddr *) &sa_server, sizeof (sa_server));
      }
      break;
    default:
      return BOOL_F;
    }
  return rv ? BOOL_F : BOOL_T;
}

static char s_listen[] = "%listen";
SCM 
scm_listen (port, backlog)
     SCM port, backlog;
{
  int rv;
  int fd;
  ASSERT (NIMP (port) && SOCKP (port), port, ARG1, s_listen);
  ASSERT (INUMP (backlog), backlog, ARG2, s_listen);
  fd = fileno (STREAM (port));
  if (fd == -1)
    return BOOL_F;
  rv = listen (fd, INUM (backlog));
  return rv ? BOOL_F : BOOL_T;
}

/* Put the components of a sockaddr into a new SCM vector.  */
static SCM
scm_addr_vector (address)
     struct sockaddr *address;
{
  short int fam = address->sa_family;
  SCM result;
  SCM *ve;
  if (fam == AF_UNIX)
    {
      struct sockaddr_un *nad = (struct sockaddr_un *) address;
      result = scm_make_vector (MAKINUM (2), UNSPECIFIED);
      ve = VELTS (result);
      ve[0] = scm_ulong2num ((unsigned long) fam);
      ve[1] = scm_makfromstr (nad->sun_path,
			      (sizet) strlen (nad->sun_path), 0);
    }
  else if (fam == AF_INET)
    {
      struct sockaddr_in *nad = (struct sockaddr_in *) address;
      result = scm_make_vector (MAKINUM (3), UNSPECIFIED);
      ve = VELTS (result);
      ve[0] = scm_ulong2num ((unsigned long) fam);
      ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr));
      ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port));
    }
  else
    result = BOOL_F;

  return result;
}

/* Allocate a buffer large enough to hold any sockaddr type.  */
static char *scm_addr_buffer;
static sizet scm_addr_buffer_size;

void
scm_init_addr_buffer ()
{
  scm_addr_buffer_size = sizeof (struct sockaddr_un);
  if (sizeof (struct sockaddr_in) > scm_addr_buffer_size)
    scm_addr_buffer_size = sizeof (struct sockaddr_in);
  scm_addr_buffer = scm_must_malloc (scm_addr_buffer_size, "address buffer");
}

static char s_accept[] = "%accept";
SCM 
scm_accept (sockpt)
     SCM sockpt;
{
  int oldfd, newfd;
  FILE *f;
  SCM port;
  SCM address;
  int tmp_size;
  ASSERT (NIMP (sockpt) && SOCKP (sockpt), sockpt, ARG1, s_accept);
  oldfd = fileno (STREAM (sockpt));
  if (oldfd == -1)
      return BOOL_F;
  DEFER_INTS;
  tmp_size = scm_addr_buffer_size;
  newfd = accept (oldfd, (struct sockaddr *) scm_addr_buffer, &tmp_size);
  if (newfd == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  f = fdopen (newfd, "r+");
  if (!f)
    {
      SYSCALL (close (newfd));
      ALLOW_INTS;
      return BOOL_F;
    }
  NEWCELL (port);
  NEWCELL (address);
  CAR (port) = tc16_fport | scm_mode_bits ("r+0");
  SETSTREAM (port, f);
  i_setbuf0 (port);
  scm_add_to_port_table (port);
  if (tmp_size > 0)
    address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer);
  else
    address = scm_make_vector (MAKINUM (0), UNSPECIFIED);
  ALLOW_INTS;
  return scm_cons (port, address);
}

static char s_getsockname[] = "%getsockname";
SCM 
scm_getsockname (sockpt)
     SCM sockpt;
{
  int tmp_size;
  int rv;
  int fd;
  SCM result;
  ASSERT (NIMP (sockpt) && OPPORTP (sockpt), sockpt, ARG1, s_getsockname);
  fd = fileno (STREAM (sockpt));
  if (fd == -1)
    return BOOL_F;
  DEFER_INTS;
  tmp_size = scm_addr_buffer_size;
  rv = getsockname (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size);
  if (rv == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  if (tmp_size > 0)
    result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer);
  else
    result = scm_make_vector (MAKINUM (0), UNSPECIFIED);
  ALLOW_INTS;
  return result;
}

static char s_getpeername[] = "%getpeername";
SCM 
scm_getpeername (sockpt)
     SCM sockpt;
{
  int tmp_size;
  int rv;
  int fd;
  SCM result;
  ASSERT (NIMP (sockpt) && OPPORTP (sockpt), sockpt, ARG1, s_getpeername);
  fd = fileno (STREAM (sockpt));
  if (fd == -1)
    return BOOL_F;
  DEFER_INTS;
  tmp_size = scm_addr_buffer_size;
  rv = getpeername (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size);
  if (rv == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  if (tmp_size > 0)
    result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer);
  else
    result = scm_make_vector (MAKINUM (0), UNSPECIFIED);
  ALLOW_INTS;
  return result;
}

static scm_iproc subr1s[] =
{
/*   {s_inet_aton, scm_inet_aton}, */
  {s_inet_ntoa, scm_inet_ntoa},
  {s_network, scm_network},
  {s_lna, scm_lna},
  {s_accept, scm_accept},
  {s_getsockname, scm_getsockname},
  {s_getpeername, scm_getpeername},
  {0, 0}
};

static scm_iproc subr1os[] =
{
  {s_hostinfo, l_hostinfo},
  {s_netinfo, l_netinfo},
  {s_protoinfo, l_protoinfo},
  {"sethostent", l_sethost},
  {"setnetent", l_setnet},
  {"setprotoent", l_setproto},
  {"setservent", l_setserv},
  {0, 0}};

static scm_iproc subr2s[] =
{
  {s_makeaddr, scm_makeaddr},
  {s_shutdown, scm_shutdown},
  {s_bind, scm_bind},
  {s_listen, scm_listen},
  {0, 0}};

static scm_iproc subr3s[] =
{
  {s_socket, scm_socket},
  {s_socketpair, scm_socketpair},
  {s_getsockopt, scm_getsockopt},
  {0, 0}};

void 
scm_init_socket ()
{
  scm_sysintern ("AF_UNIX", MAKINUM (AF_UNIX));
  scm_sysintern ("AF_INET", MAKINUM (AF_INET));
  scm_sysintern ("SOCK_STREAM", MAKINUM (SOCK_STREAM));
  scm_sysintern ("SOCK_DGRAM", MAKINUM (SOCK_DGRAM));
  scm_sysintern ("SOCK_RAW", MAKINUM (SOCK_RAW));

  /* setsockopt level.  */
#ifdef SOL_SOCKET
  scm_sysintern ("SOL_SOCKET", MAKINUM (SOL_SOCKET));
#endif
#ifdef SOL_IP
  scm_sysintern ("SOL_IP", MAKINUM (SOL_IP));
#endif
#ifdef SOL_TCP
  scm_sysintern ("SOL_TCP", MAKINUM (SOL_TCP));
#endif
#ifdef SOL_UDP
  scm_sysintern ("SOL_UDP", MAKINUM (SOL_UDP));
#endif

  /* setsockopt names.  */
#ifdef SO_DEBUG
  scm_sysintern ("SO_DEBUG", MAKINUM (SO_DEBUG));
#endif
#ifdef SO_REUSEADDR
  scm_sysintern ("SO_REUSEADDR", MAKINUM (SO_REUSEADDR));
#endif
#ifdef SO_STYLE
  scm_sysintern ("SO_TYPE", MAKINUM (SO_TYPE));
#endif
#ifdef SO_TYPE
  scm_sysintern ("SO_TYPE", MAKINUM (SO_TYPE));
#endif
#ifdef SO_ERROR
  scm_sysintern ("SO_ERROR", MAKINUM (SO_ERROR));
#endif
#ifdef SO_DONTROUTE
  scm_sysintern ("SO_DONTROUTE", MAKINUM (SO_DONTROUTE));
#endif
#ifdef SO_BROADCAST
  scm_sysintern ("SO_BROADCAST", MAKINUM (SO_BROADCAST));
#endif
#ifdef SO_SNDBUF
  scm_sysintern ("SO_SNDBUF", MAKINUM (SO_SNDBUF));
#endif
#ifdef SO_RCVBUF
  scm_sysintern ("SO_RCVBUF", MAKINUM (SO_RCVBUF));
#endif
#ifdef SO_KEEPALIVE
  scm_sysintern ("SO_KEEPALIVE", MAKINUM (SO_KEEPALIVE));
#endif
#ifdef SO_OOBINLINE
  scm_sysintern ("SO_OOBINLINE", MAKINUM (SO_OOBINLINE));
#endif
#ifdef SO_NO
  scm_sysintern ("SO_NO_check", MAKINUM (SO_NO));
#endif
#ifdef SO_PRIORITY
  scm_sysintern ("SO_PRIORITY", MAKINUM (SO_PRIORITY));
#endif
#ifdef SO_LINGER
  scm_sysintern ("SO_LINGER", MAKINUM (SO_LINGER));
#endif

  scm_init_iprocs (subr1s, tc7_subr_1);
  scm_init_iprocs (subr1os, tc7_subr_1o);
  scm_init_iprocs (subr2s, tc7_subr_2);
  scm_init_iprocs (subr3s, tc7_subr_3);
  scm_make_subr (s_servinfo, tc7_lsubr, l_servinfo);
  scm_make_subr (s_connect, tc7_lsubr_2, scm_connect);
  scm_make_gsubr (s_setsockopt, 4, 0, 0, scm_setsockopt);
  scm_init_addr_buffer ();
  scm_add_feature ("socket");
}
