/* libsizzle/net.c - Network functions
 
  Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

/* FIXME: The procedures in this file only support IPv4, and the API
   is not well thought out, but rather in a straight hack-away style,
   because I simply needed them for the webserver example in
   ../examples.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#if ENABLE_MAXIMUM_FUNCTIONALITY

#define _GNU_SOURCE
#include <string.h>
#include <sys/types.h>
#if HAVE_SYS_TIME_H
# include <sys/time.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>

#ifdef __MINGW32__
# include <winsock.h>
#else
# include <sys/socket.h>
# include <netinet/in.h>
# include <netdb.h>
# include <arpa/inet.h>
# define closesocket(fd) close (fd)
#endif

#ifdef _AIX
# undef _NO_PROTO
# ifndef _USE_IRS
#  define _USE_IRS 1
# endif
# define _XOPEN_SOURCE_EXTENDED 1
# define _ALL_SOURCE 1
#if HAVE_NETDB_H
# include <netdb.h>
#endif
#endif
#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "node.h"
#include "validate.h"
#include "capi.h"
#include "port.h"
#include "posix.h"
#include "fdport.h"
#include "vector.h"
#include "modules.h"

/* Return a unsigned integer from the location pointed to by P, where
   it is stored in network byte order.  */
#define UINT32(p) ((unsigned char)*p + \
                  ((unsigned char)*(p+1)<<8) + \
                  ((unsigned char)*(p+2)<<16) + \
                  ((unsigned char)*(p+3)<<24))
/* Return a unsigned short from the location pointed to by P, where it
   is stored in network byte order.  */
#define UINT16(p) ((unsigned char)*p + \
                  ((unsigned char)*(p+1)<<8))

/* Module for holding the network procedures.  */
static zzz_scm_t core_net_module;

/* This is the exception tag to which network errors are thrown.  */
static zzz_scm_t zzz_network_error_exception;

/* This is the hstrerror() wrapper, depending on config.h ...
  (thx to ela for this stuff, i stole it from serveez).  */
char *
zzz_hstrerror (void)
{
#if HAVE_HSTRERROR
# if HAVE_H_ERRNO
  return (char *) hstrerror (h_errno);
# else
  return hstrerror (errno);
# endif
#else /* not HAVE_HSTRERROR */
# if HAVE_H_ERRNO
  return strerror (h_errno);
# else
  return strerror (errno);
# endif
#endif /* not HAVE_HSTRERROR */
}

/* Create and return an exception object for the current network
   error.  Tha tag for the exception is `network-error', and the error
   messgae is taken from the runtime library.  */
static zzz_scm_t
zzz_make_network_exception (void)
{
  return zzz_make_exception (zzz_network_error_exception,
			     zzz_make_string (zzz_hstrerror (), -1));
}

/* Return the numerical address for @var{hostname}, which may be
   aither a string with a valid hostname or already an integer value.
   The integer value will simply be passed back, and string hostnames
   are looked up using gethostbyname().  On error, a `network-error'
   exception will be returned in *@var{result}, otherwise the integer
   object for the address will be returned.  */
static result_t
get_address (char * s_func_name, zzz_scm_t hostname, zzz_scm_t * result)
{
  struct hostent *hostent;
  unsigned long addr;

  if (string_p (hostname))
    {
      if((hostent = gethostbyname (string_val (hostname))) == NULL)
	{
	  *result = zzz_make_network_exception ();
	  return RESULT_EXCEPTION;
	}
      /* get the inet address in network byte order */
      if(hostent->h_addrtype == AF_INET && hostent->h_length == 4)
	{
	  addr = UINT32 (hostent->h_addr_list[0]);
	  addr = ntohl (addr);
	}
      else
	{
	  *result = zzz_make_network_exception ();
	  return RESULT_EXCEPTION;
	}
    }
  else if (integer_p (hostname))
    addr = integer_val (hostname);
  else
    abort ();
  *result = zzz_make_integer (addr);
  return RESULT_SUCCESS;
}

/*:doc
  gethostbyname
  (gethostbyname hostname) => integer
  doc:*/
#define FUNC_NAME "gethostbyname"
static result_t
gethostbyname_func (zzz_scm_t env, zzz_scm_t hostname, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  return get_address (s_func_name, hostname, result);
}
#undef FUNC_NAME

/*:doc
  connect
  (connect hostname port) => port
  doc:*/
#define FUNC_NAME "connect"
static result_t
connect_func (zzz_scm_t env, zzz_scm_t hostname, zzz_scm_t port,
	      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  struct sockaddr_in server;
  unsigned long host;
  int client_socket;
  result_t err;

  CHECK_TYPE (1, string_p (hostname) || integer_p (hostname),
	      zzz_string_or_integer_type_name);
  CHECK_TYPE (2, integer_p (port), zzz_integer_type_name);

  if ((err = get_address (s_func_name, hostname, result)) != RESULT_SUCCESS)
    return err;
  host = integer_val (*result);
  if ((client_socket = socket (AF_INET, SOCK_STREAM, 0)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  server.sin_family = AF_INET;
  server.sin_addr.s_addr = htonl (host);
  server.sin_port = htons ((unsigned short) integer_val (port));
  if (connect(client_socket, (struct sockaddr *) &server,
	      sizeof(server)) == -1)
    {
      closesocket (client_socket);
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }

  *result = zzz_make_fdport (client_socket, 1, 1);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  server-socket
  (server-socket port) => port
  doc:*/
#define FUNC_NAME "server-socket"
static result_t
server_socket_func (zzz_scm_t env, zzz_scm_t port,
	      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int server_socket;
  struct sockaddr_in server;
  int optval;                /* value for setsockopt() */

  CHECK_TYPE (1, integer_p (port), zzz_integer_type_name);

  /* First, create a server socket for listening.  */
  if ((server_socket = socket (AF_INET, SOCK_STREAM, 0)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }

  /* Make the socket be reusable (minimize socket dead-time on server
   death).  */
  optval = 1;
  if (setsockopt (server_socket, SOL_SOCKET, SO_REUSEADDR,
		  (void *) &optval, sizeof (optval)) < 0)
    {
      closesocket (server_socket);
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }

  /* Second, bind the socket to a port.  */
  memset (&server, 0, sizeof (server));
  server.sin_family = AF_INET;
  server.sin_addr.s_addr = INADDR_ANY;
  server.sin_port = htons((unsigned short) integer_val (port));
  
  if (bind (server_socket, (struct sockaddr *) &server, sizeof (server)) < 0)
    {
      closesocket (server_socket);
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }

  /* Prepare for listening on that port.  */
  if (listen (server_socket, 1024) < 0)
    {
      closesocket (server_socket);
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_fdport (server_socket, 1, 1);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  server-loop
  (server-loop port proc) => *unspecified*
  doc:*/
#define FUNC_NAME "server-loop"
static result_t
server_loop_func (zzz_scm_t env, zzz_scm_t server_port, zzz_scm_t proc,
		  zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int sport;
  int sock;
  struct sockaddr_in addr;
  result_t err;

  CHECK_TYPE (1, fdport_p (server_port), zzz_fdport_type_name);
  CHECK_TYPE (2, procedure_p (proc), zzz_procedure_type_name);
  sport = fdport_fd (server_port);
  for (;;)
    {
      socklen_t len;
      len = sizeof (addr);
      ZZZ_SYSCALL (sock, accept (sport, (struct sockaddr *) &addr, &len));
      if (sock >= 0)
	{
	  zzz_scm_t inp, outp, tmp;

	  inp = zzz_make_fdport (sock, 1, 0);
	  outp = zzz_make_fdport (sock, 0, 1);
	  err = zzz_apply (env, proc, zzz_make_list (inp, outp, NULL),
			   result);
	  if (err != RESULT_SUCCESS)
	    return err;
	  zzz_port_close (inp, &tmp);
	  zzz_port_close (outp, &tmp);
	}
      else
	{
	  *result = zzz_make_system_exception ();
	  return RESULT_EXCEPTION;
	}
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  socket
  (socket domain type protocol) => port
  doc:*/
#define FUNC_NAME "socket"
static result_t
socket_func (zzz_scm_t env, zzz_scm_t domain, zzz_scm_t type,
	     zzz_scm_t protocol, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int sock;

  CHECK_TYPE (1, integer_p (domain), zzz_integer_type_name);
  CHECK_TYPE (2, integer_p (type), zzz_integer_type_name);
  CHECK_TYPE (3, integer_p (protocol), zzz_integer_type_name);
  if ((sock = socket (integer_val (domain), integer_val (type),
		      integer_val (protocol))) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_fdport (sock, 1, 1);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  bind
  (bind scheme-port family address port) => *unspecified*
  Bind the port @var{scheme-port}, created with a call to
  @code{socket} to the address specified by @var{family},
  @var{address}, and the port number @var{port}.
  doc:*/
#define FUNC_NAME "bind"
static result_t
bind_func (zzz_scm_t env, zzz_scm_t socket, zzz_scm_t family,
	   zzz_scm_t address, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int server_socket;
  struct sockaddr_in server;
  unsigned long host;
  result_t err;

  CHECK_TYPE (1, fdport_p (socket), zzz_fdport_type_name);
  CHECK_TYPE (1, integer_p (family), zzz_integer_type_name);
  CHECK_TYPE (3, integer_p (address) || string_p (address),
	      zzz_string_or_integer_type_name);
  CHECK_TYPE (4, integer_p (port), zzz_integer_type_name);
  server_socket = fdport_fd (socket);

  if ((err = get_address (s_func_name, address, result)) != RESULT_SUCCESS)
    return err;
  host = integer_val (*result);

  /* Bind the socket to a port. */
  memset (&server, 0, sizeof (server));
  server.sin_family = (unsigned short) integer_val (family);
  server.sin_addr.s_addr = htonl (host);
  server.sin_port = htons ((unsigned short) integer_val (port));
  
  if (bind (server_socket, (struct sockaddr *) &server, sizeof (server)) < 0)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }

  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  listen
  (listen port backlog) => *unspecified*
  doc:*/
#define FUNC_NAME "listen"
static result_t
listen_func (zzz_scm_t env, zzz_scm_t socket, zzz_scm_t backlog,
	     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, fdport_p (socket), zzz_fdport_type_name);
  CHECK_TYPE (2, integer_p (backlog), zzz_integer_type_name);
  if (listen (fdport_fd (socket), integer_val (backlog)) < 0)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  accept
  (accept port) => (port . addr)
  doc:*/
#define FUNC_NAME "accept"
static result_t
accept_func (zzz_scm_t env, zzz_scm_t socket, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int sock = 0;
  int client;
  struct sockaddr_in addr;
  socklen_t addr_len;

  CHECK_TYPE (1, fdport_p (socket), zzz_fdport_type_name);
  sock = fdport_fd (socket);

  addr_len = sizeof (addr);
  memset (&addr, 0, sizeof (addr));
  ZZZ_SYSCALL (client, accept (sock, (struct sockaddr *) &addr, &addr_len));
  if (client < 0)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  else
    {
      zzz_scm_t addr_vec;

      addr_vec = zzz_make_vector (3);
      zzz_vector_put (addr_vec, 0, zzz_make_integer (AF_INET));
      zzz_vector_put (addr_vec, 1, zzz_make_integer (addr.sin_addr.s_addr));
      zzz_vector_put (addr_vec, 2, zzz_make_integer (ntohs (addr.sin_port)));
      *result = zzz_cons (zzz_make_fdport (client, 1, 1), addr_vec);
      return RESULT_SUCCESS;
    }
}
#undef FUNC_NAME

static result_t
set_fd_set (fd_set * set, zzz_scm_t zzz_set, int * num, zzz_scm_t * result)
{
  int max = 0;
  unsigned x;

  FD_ZERO (set);
  if (vector_p (zzz_set))
    {
      for (x = 0; x < vector_len (zzz_set); x++)
	{
	  if (!integer_p (zzz_vector_get (zzz_set, x)))
	    {
	      *result = zzz_make_wta_exception
		(zzz_make_list
		 (zzz_make_string
		  (_("invalid file descriptor set in call to `select'"), -1),
		  NULL));
	      return RESULT_EXCEPTION;
	    }
	  FD_SET (integer_val (zzz_vector_get (zzz_set, x)), set);
	  if (integer_val (zzz_vector_get (zzz_set, x)) > max)
	    max = integer_val (zzz_vector_get (zzz_set, x));
	}
      *num = max;
      return RESULT_SUCCESS;
    }
  else if (list_p (zzz_set))
    {
      for (; cons_p (zzz_set); zzz_set = cdr (zzz_set))
	{
	  if (!integer_p (car (zzz_set)))
	    {
	      *result = zzz_make_wta_exception
		(zzz_make_list
		 (zzz_make_string
		  (_("invalid file descriptor set in call to `select'"), -1),
		  NULL));
	      return RESULT_EXCEPTION;
	    }
	  FD_SET (integer_val (car (zzz_set)), set);
	  if (integer_val (car (zzz_set)) > max)
	    max = integer_val (car (zzz_set));
	}
      *num = max;
      return RESULT_SUCCESS;
    }
  else
    {
      *result = zzz_make_wta_exception
	(zzz_make_list
	 (zzz_make_string
	  (_("invalid file descriptor set in call to `select'"), -1),
	  NULL));
      return RESULT_EXCEPTION;
    }
}

static result_t
get_fd_set (fd_set * set, zzz_scm_t zzz_set, int * num, zzz_scm_t * result)
{
  unsigned x;

  if (vector_p (zzz_set))
    {
      for (x = 0; x < vector_len (zzz_set); x++)
	{
	  if (FD_ISSET (integer_val (zzz_vector_get (zzz_set, x)), set))
	    {
	      *num = integer_val (zzz_vector_get (zzz_set, x));
	      return RESULT_SUCCESS;
	    }
	}
      *result = zzz_make_misc_error_exception
	(zzz_make_string (_("cannot find fd returned by `select'"), -1));
      return RESULT_EXCEPTION;
    }
  else if (list_p (zzz_set))
    {
      for (; cons_p (zzz_set); zzz_set = cdr (zzz_set))
	{
	  if (FD_ISSET (integer_val (car (zzz_set)), set))
	    {
	      *num = integer_val (car (zzz_set));
	      return RESULT_SUCCESS;
	    }
	}
      *result = zzz_make_misc_error_exception
	(zzz_make_string (_("cannot find fd returned by `select'"), -1));
      return RESULT_EXCEPTION;
    }
  abort ();
  return RESULT_SUCCESS;
}

/*:doc
  select
  (select rdfd wrfd exfd sec usec) => integer
  Perform the @code{select} system call on the file descriptor sets
  @var{rdfd}, @var{wrdf} and @var{exfd}.  The timeout value is
  calculated from the seconds @var{sec} and the microseconds
  @var{usec}.
  doc:*/
#define FUNC_NAME "select"
static result_t
select_func (zzz_scm_t env, zzz_scm_t rdfds, zzz_scm_t wrfds,
	     zzz_scm_t exfds, zzz_scm_t timeout_sec, zzz_scm_t timeout_usec,
	     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  fd_set readfds, writefds, exceptfds;
  struct timeval to;
  int max0, max1, max2, max = 0;
  result_t err;
  int ret;

  CHECK_TYPE (1, list_p (rdfds) || vector_p (rdfds), 
	      zzz_list_or_vector_type_name);
  CHECK_TYPE (2, list_p (wrfds) || vector_p (wrfds), 
	      zzz_list_or_vector_type_name);
  CHECK_TYPE (3, list_p (exfds) || vector_p (exfds), 
	      zzz_list_or_vector_type_name);
  CHECK_TYPE (4, integer_p (timeout_sec), zzz_integer_type_name);
  CHECK_TYPE (5, integer_p (timeout_usec), zzz_integer_type_name);
  if ((err = set_fd_set (&readfds, rdfds, &max0, result)) != RESULT_SUCCESS)
    return err;
  if ((err = set_fd_set (&writefds, wrfds, &max1, result)) != RESULT_SUCCESS)
    return err;
  if ((err = set_fd_set (&exceptfds, exfds, &max2, result)) != RESULT_SUCCESS)
    return err;
  if (max0 > max)
    max = max0;
  if (max1 > max)
    max = max1;
  if (max2 > max)
    max = max2;
  max++;			/* Must be one bigger than largest fd. */

  to.tv_sec = integer_val (timeout_sec);
  to.tv_usec = integer_val (timeout_usec);
  ret = select (max, &readfds, &writefds, &exceptfds, &to);
  if (ret <= 0)
    *result = zzz_make_integer (ret);
  else
    {
      if ((err = get_fd_set (&readfds, rdfds, &max, result)) == RESULT_SUCCESS)
	{
	  *result = zzz_make_integer (max);
	  return err;
	}
      if ((err = get_fd_set (&writefds, wrfds, &max, result)) ==
	  RESULT_SUCCESS)
	{
	  *result = zzz_make_integer (max);
	  return err;
	}
      if ((err = get_fd_set (&exceptfds, exfds, &max, result)) ==
	  RESULT_SUCCESS)
	{
	  *result = zzz_make_integer (max);
	  return err;
	}
    }
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  shutdown
  (shutdown port how) => *unspecified*
  doc:*/
#define FUNC_NAME "shutdown"
static result_t
shutdown_func (zzz_scm_t env, zzz_scm_t sock, zzz_scm_t how,
	       zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, fdport_p (sock), zzz_fdport_type_name);
  CHECK_TYPE (2, integer_p (how), zzz_integer_type_name);
  if (shutdown (fdport_fd (sock), integer_val (how)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  getsockname
  (getsockname port) => address
  doc:*/
#define FUNC_NAME "getsockname"
static result_t
getsockname_func (zzz_scm_t env, zzz_scm_t sock, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t addr_vec;
  struct sockaddr_in addr;
  socklen_t len;

  CHECK_TYPE (1, fdport_p (sock), zzz_fdport_type_name);
  len = sizeof (addr);
  if (getsockname (fdport_fd (sock), (struct sockaddr *) &addr, &len) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  addr_vec = zzz_make_vector (3);
  zzz_vector_put (addr_vec, 0, zzz_make_integer (AF_INET));
  zzz_vector_put (addr_vec, 1, zzz_make_integer
		  (ntohl (addr.sin_addr.s_addr)));
  zzz_vector_put (addr_vec, 2, zzz_make_integer
		  (ntohs (addr.sin_port)));
  *result = addr_vec;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  getpeername
  (getpeername port) => address
  doc:*/
#define FUNC_NAME "getpeername"
static result_t
getpeername_func (zzz_scm_t env, zzz_scm_t sock, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t addr_vec;
  struct sockaddr_in addr;
  socklen_t len;

  CHECK_TYPE (1, fdport_p (sock), zzz_fdport_type_name);
  len = sizeof (addr);
  if (getpeername (fdport_fd (sock), (struct sockaddr *) &addr, &len) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  addr_vec = zzz_make_vector (3);
  zzz_vector_put (addr_vec, 0, zzz_make_integer (AF_INET));
  zzz_vector_put (addr_vec, 1, zzz_make_integer
		  (ntohl (addr.sin_addr.s_addr)));
  zzz_vector_put (addr_vec, 2, zzz_make_integer
		  (ntohs (addr.sin_port)));
  *result = addr_vec;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  htonl
  (htonl i) => integer
  doc:*/
#define FUNC_NAME "htonl"
static result_t
htonl_func (zzz_scm_t env, zzz_scm_t n, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  CHECK_TYPE (1, integer_p (n), zzz_integer_type_name);
  *result = zzz_make_integer (htonl (integer_val (n)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  ntohl
  (ntohl i) => integer
  doc:*/
#define FUNC_NAME "ntohl"
static result_t
ntohl_func (zzz_scm_t env, zzz_scm_t n, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  CHECK_TYPE (1, integer_p (n), zzz_integer_type_name);
  *result = zzz_make_integer (ntohl (integer_val (n)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  htons
  (htons i) => integer
  doc:*/
#define FUNC_NAME "htons"
static result_t
htons_func (zzz_scm_t env, zzz_scm_t n, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  CHECK_TYPE (1, integer_p (n), zzz_integer_type_name);
  *result = zzz_make_integer (htons ((unsigned short) integer_val (n)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  ntohs
  (ntohs i) => integer
  doc:*/
#define FUNC_NAME "ntohs"
static result_t
ntohs_func (zzz_scm_t env, zzz_scm_t n, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  CHECK_TYPE (1, integer_p (n), zzz_integer_type_name);
  *result = zzz_make_integer (ntohs ((unsigned short) integer_val (n)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

#if HAVE_GETHOSTNAME || defined (__MINGW32__)
/*:doc
  gethostname
  (gethostname) => string
  Get the host name of the local host.
  doc:*/
#define FUNC_NAME "gethostname"
static result_t
gethostname_func (zzz_scm_t env, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  char buffer[1024];

  if (gethostname (buffer, sizeof (buffer)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_string (buffer, -1);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME
#endif /* HAVE_GETHOSTNAME */

#if HAVE_SETHOSTNAME
/*:doc
  sethostname
  (sethostname name) => *unspecified*
  Set the host name of the local host to @var{name}.
  doc:*/
#define FUNC_NAME "sethostname"
static result_t
sethostname_func (zzz_scm_t env, zzz_scm_t name, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, string_p (name), zzz_string_type_name);
  if (sethostname (string_val (name), string_len (name)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME
#endif /* HAVE_SETHOSTNAME */

#if HAVE_GETDOMAINNAME
/*:doc
  getdomainname
  (getdomainname) => string
  Get the domain name of the local host.
  doc:*/
#define FUNC_NAME "getdomainname"
static result_t
getdomainname_func (zzz_scm_t env, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  char buffer[1024];

  if (getdomainname (buffer, sizeof (buffer)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_string (buffer, -1);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME
#endif /* HAVE_GETDOMAINNAME */

#if HAVE_SETDOMAINNAME
/*:doc
  setdomainname
  (setdomainname name) => *unspecified*
  Set the domain name of the local host to @var{name}.
  doc:*/
#define FUNC_NAME "setdomainname"
static result_t
setdomainname_func (zzz_scm_t env, zzz_scm_t name, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, string_p (name), zzz_string_type_name);
  if (setdomainname (string_val (name), string_len (name)) == -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME
#endif /* HAVE_SETDOMAINNAME */

/*:doc
  inet-aton
  (inet-aton addr) => sock-addr
  Convert the internet address @var{addr} from dotted decimal notation
  to binary data.
  doc:*/
#define FUNC_NAME "inet-aton"
static result_t
inet_aton_func (zzz_scm_t env, zzz_scm_t addr, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
#if HAVE_INET_ATON
  struct in_addr iaddr;
#else
  unsigned long iaddr;
#endif

  CHECK_TYPE (1, string_p (addr), zzz_string_type_name);
#if HAVE_INET_ATON
  if (inet_aton (string_val (addr), &iaddr) == 0)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_integer (iaddr.s_addr);
#else /* not HAVE_INET_ATON */
  if ((iaddr = inet_addr (string_val (addr))) == (unsigned long) -1)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_integer (iaddr);
#endif /* not HAVE_INET_ATON */
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  inet-ntoa
  (inet-ntoa addr) => string
  Convert the internet address @var{addr} from binary representation to
  a string.
  doc:*/
#define FUNC_NAME "inet-ntoa"
static result_t
inet_ntoa_func (zzz_scm_t env, zzz_scm_t addr, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
#if !BROKEN_INET_NTOA
  struct in_addr iaddr;
  char * p;
#else
  unsigned long iaddr;
  static char p[16];
#endif

  CHECK_TYPE (1, integer_p (addr), zzz_integer_type_name);
#if !BROKEN_INET_NTOA
  iaddr.s_addr = integer_val (addr);
  if ((p = inet_ntoa (iaddr)) == NULL)
    {
      *result = zzz_make_system_exception ();
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_string (p, -1);
#else /* BROKEN_INET_NTOA */
  iaddr = integer_val (addr);
#if WORDS_BIGENDIAN
  sprintf (p, "%u.%u.%u.%u", 
           (iaddr >> 24) & 0xff, (iaddr >> 16) & 0xff, 
	   (iaddr >> 8) & 0xff, iaddr & 0xff);
#else
  sprintf (p, "%u.%u.%u.%u", 
	   iaddr & 0xff, (iaddr >> 8) & 0xff, 
	   (iaddr >> 16) & 0xff, (iaddr >> 24) & 0xff);
#endif /* not WORDS_BIGENDIAN */
#endif /* BROKEN_INET_NTOA */
return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_net (void)
{
#ifdef __MINGW32__
  WSADATA WSAData;
  
  /*
   * When using WinSock-API you MUST call this first !
   */
  if (WSAStartup (0x0202, &WSAData) == SOCKET_ERROR)
    {
      WSACleanup ();
      /* FIXME: Return some error code. */
      return 0;
    }
#endif /* not __MINGW32__ */

  zzz_c_create_module ("core net", &core_net_module);

  /*:doc
    network-error
    Exception
    Thrown when an error occurs in any of the network procedures.
    doc:*/
  zzz_protect_global (&zzz_network_error_exception);
  zzz_network_error_exception = zzz_make_symbol ("network-error", -1);

  zzz_c_define_constant (core_net_module, "AF_UNIX", zzz_make_integer (AF_UNIX));
  zzz_c_define_constant (core_net_module, "AF_INET", zzz_make_integer (AF_INET));
#ifdef AF_ISO
  zzz_c_define_constant (core_net_module, "AF_ISO", zzz_make_integer (AF_ISO));
#endif
#ifdef AF_NS
  zzz_c_define_constant (core_net_module, "AF_NS", zzz_make_integer (AF_NS));
#endif
#ifdef AF_IMPLINK
  zzz_c_define_constant (core_net_module, "AF_IMPLINK", zzz_make_integer (AF_IMPLINK));
#endif
  zzz_c_define_constant (core_net_module, "SOCK_STREAM", zzz_make_integer (SOCK_STREAM));
  zzz_c_define_constant (core_net_module, "SOCK_DGRAM", zzz_make_integer (SOCK_DGRAM));
  zzz_c_define_constant (core_net_module, "SOCK_RAW", zzz_make_integer (SOCK_RAW));
  zzz_c_define_constant (core_net_module, "SOCK_SEQPACKET", zzz_make_integer (SOCK_SEQPACKET));
  zzz_c_define_constant (core_net_module, "SOCK_RDM", zzz_make_integer (SOCK_RDM));
 
  zzz_c_define_constant (core_net_module, "INADDR_ANY", zzz_make_integer (INADDR_ANY));
#ifdef INADDR_NONE
  zzz_c_define_constant (core_net_module, "INADDR_NONE", zzz_make_integer (INADDR_NONE));
#endif
  zzz_c_define_constant (core_net_module, "INADDR_BROADCAST",
		       zzz_make_integer (INADDR_BROADCAST));
  zzz_c_define_constant (core_net_module, "INADDR_LOOPBACK", zzz_make_integer (INADDR_LOOPBACK));

  zzz_c_define_function (core_net_module, "gethostbyname", (zzz_prim_t) gethostbyname_func,
		       argv_1_0_0);
  zzz_c_define_function (core_net_module, "connect", (zzz_prim_t) connect_func, argv_2_0_0);
  zzz_c_define_function (core_net_module, "server-socket", (zzz_prim_t) server_socket_func,
		       argv_1_0_0);
  zzz_c_define_function (core_net_module, "server-loop", (zzz_prim_t) server_loop_func,
		       argv_2_0_0);
  zzz_c_define_function (core_net_module, "socket", (zzz_prim_t) socket_func, argv_3_0_0);
  zzz_c_define_function (core_net_module, "bind", (zzz_prim_t) bind_func, argv_4_0_0);
  zzz_c_define_function (core_net_module, "listen", (zzz_prim_t) listen_func, argv_2_0_0);
  zzz_c_define_function (core_net_module, "accept", (zzz_prim_t) accept_func, argv_1_0_0);
  zzz_c_define_function (core_net_module, "select", (zzz_prim_t) select_func, argv_5_0_0);
  zzz_c_define_function (core_net_module, "shutdown", (zzz_prim_t) shutdown_func, argv_2_0_0);
  zzz_c_define_function (core_net_module, "getsockname", (zzz_prim_t) getsockname_func,
		       argv_1_0_0);
  zzz_c_define_function (core_net_module, "getpeername", (zzz_prim_t) getpeername_func,
		       argv_1_0_0);
  zzz_c_define_function (core_net_module, "htonl", (zzz_prim_t) htonl_func, argv_1_0_0);
  zzz_c_define_function (core_net_module, "ntohl", (zzz_prim_t) ntohl_func, argv_1_0_0);
  zzz_c_define_function (core_net_module, "htons", (zzz_prim_t) htons_func, argv_1_0_0);
  zzz_c_define_function (core_net_module, "ntohs", (zzz_prim_t) ntohs_func, argv_1_0_0);

#if HAVE_GETHOSTNAME || defined (__MINGW32__)
  zzz_c_define_function (core_net_module, "gethostname", (zzz_prim_t) gethostname_func,
		       argv_0_0_0);
#endif /* HAVE_GETHOSTNAME */
#if HAVE_SETHOSTNAME
  zzz_c_define_function (core_net_module, "sethostname", (zzz_prim_t) sethostname_func,
		       argv_1_0_0);
#endif /* HAVE_SETHOSTNAME */
#if HAVE_GETDOMAINNAME
  zzz_c_define_function (core_net_module, "getdomainname", (zzz_prim_t) getdomainname_func,
		       argv_0_0_0);
#endif /* HAVE_GETDOMAINNAME */
#if HAVE_SETDOMAINNAME
zzz_c_define_function (core_net_module, "setdomainname",
    (zzz_prim_t) setdomainname_func, argv_1_0_0);
#endif /* HAVE_SETDOMAINNAME */
  zzz_c_define_function (core_net_module, "inet-aton",
			 (zzz_prim_t) inet_aton_func, argv_1_0_0);
  zzz_c_define_function (core_net_module, "inet-ntoa",
			 (zzz_prim_t) inet_ntoa_func, argv_1_0_0);
  return RESULT_SUCCESS;
}

int zzz_config_have_net = 1;

#else /* !ENABLE_MAXIMUM_FUNCTIONALITY */

int zzz_config_have_net = 0;

#endif /* !ENABLE_MAXIMUM_FUNCTIONALITY */
