#ifdef HAVE_CONFIG_H
#include "scmconfig.h"
#endif

#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <netdb.h>
#include <arpa/inet.h>
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#include "scm.h"
#ifdef HAVE_SYS_FILIO_H
#include <sys/filio.h>
#endif
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#endif

/* A high-resolution sleep function.  This one has a precision of 
   microseconds, whereas (sleep) has a precision of seconds.  Returns #f if
   the select() somehow got an error (maybe we were interrupted?), otherwise 
   #t.  Note that select() apparently complains if asked to sleep one second 
   or more via the microsecond argument; rather than require two args to
   every call of this function, we'll just stipulate that you should call
   (sleep), then (usleep), to sleep some number of seconds and then some
   microseconds.  If I _really_ need high-precision sleeping across multiple
   seconds, I may do something different here (like use an optional arg). */
/* This might better go in scm.c, along with (sleep), but all of the
   #includes are here. */

static char s_usleep[] = "usleep";
SCM l_usleep(SCM microseconds)
{
  int result;
  static struct timeval timeout;
  
  ASSERT(INUMP(microseconds), microseconds, ARG1, s_usleep); 
      /* Make it reject < 0 ! */
  timeout.tv_sec  = 0;
  timeout.tv_usec =
    num2ulong(microseconds, "a nonnegative, integral number of microseconds",
	      s_usleep);
  /* Note that we have _not_ surrounded this with DEFER_INTS and ALLOW_INTS!*/
  SYSCALL(result = select(0, NULL, NULL, NULL, &timeout););
  if (result < 0)
    wta(microseconds, "couldn't wait this many microseconds", s_usleep);
  return result ? BOOL_F : BOOL_T;
}

/* Simpleminded implementation of select() as a first cut:
   . Only looks at one port
   . Always times out instantly.
   . Only checks readability (this is enough to guarantee that an accept() 
     won't block)
   --- Foner
*/
/* Returns #t if accept() on the socket would NOT block, and #f if it WOULD 
   block. Note that this can also take a _port_ resulting from an accept
   (e.g., #<input-output-port 6>), as well as a _socket_ resulting from a 
   bind (e.g., #<port 3>); the former case is to support a call by 
   socket:remote-end-closed? */

static char s_conn_ready[] = "socket:conn-ready?"; /* new name --DJB */
static char s_select[] = "socket:select";
SCM l_select(SCM sockpt)
{
  fd_set readfds;
  int fd;
  int result;
  static struct timeval timeout;
  
  ASSERT(NIMP(sockpt) && (SOCKP(sockpt) || OPINPORTP(sockpt)), sockpt, ARG1, 
	 s_select);
  timeout.tv_sec  = 0; 	/* I could probably do this in the initializer, ... */
  timeout.tv_usec = 0;	/* ... but this anticipates settability by the 
			   caller.  */
  fd = fileno(STREAM(sockpt));
  FD_ZERO(&readfds);
  FD_SET(fd, &readfds);
  DEFER_INTS;		/* I probably don't need to do this, since we aren't
			   letting the select block, but... */
  /* Hmmm:  _UNIX Network Programming_ p. 330 uses "(fd_set *) 0", but Ken 
     uses NULL. Unfortunately, HPUX requires "(int *)" (as Ken's code also
     uses). */
#ifdef hpux
  SYSCALL(result = select((1 + fd), (int *) &readfds, NULL, NULL, &timeout););
#else
  SYSCALL(result = select((1 + fd), &readfds, NULL, NULL, &timeout););
#endif
  ALLOW_INTS;
  if (result < 0)
    wta(sockpt, "couldn't", s_select);
  return result ? BOOL_T : BOOL_F;
}

static char s_can_write[] = "socket:can-write?";
SCM l_can_write(SCM sockpt)
{
  fd_set writefds;
  int fd;
  int result;
  static struct timeval timeout;
  
  ASSERT(NIMP(sockpt) && (SOCKP(sockpt) || OPINPORTP(sockpt)), sockpt, ARG1,
	 s_select);
  timeout.tv_sec  = 0;	/* I could probably do this in the initializer, ... */
  timeout.tv_usec = 0;	/* ... but this anticipates settability by the 
			   caller.  */
  fd = fileno(STREAM(sockpt));
  FD_ZERO(&writefds);
  FD_SET(fd, &writefds);
  DEFER_INTS;		/* I probably don't need to do this, since we aren't
			   letting the select block, but... */
  /* Hmmm:  _UNIX Network Programming_ p. 330 uses "(fd_set *) 0", but Ken
     uses NULL. Unfortunately, HPUX requires "(int *)" (as Ken's code also
     uses). */
#ifdef hpux
  SYSCALL(result = select((1 + fd), NULL, (int *) &writefds, NULL,
			  &timeout););
#else
  SYSCALL(result = select((1 + fd), NULL, &writefds, NULL, &timeout););
#endif
  ALLOW_INTS;
  if (result < 0)
    wta(sockpt, "couldn't", s_can_write);
  return result ? BOOL_T : BOOL_F;
}

/* Finding out if the remote end is really closed.  This is an incredible bit
   of black magic, based on Ken's SocketMan implementation (see 
   SocketBase::bytesAvailableOnFD, called from 
   SocketBase::_readWithPollAndTimeout), which in turn was based on a hack of
   Wave's, who got it from god knows where.  Sheesh.  --- Foner */
/* Returns #t if the other end is really closed and hence we won't be able to
   get more input from it. Note that you should hand this a _port_ resulting
   from an accept (e.g., #<input-output-port 6>), and not a _socket_
   resulting from a bind (e.g., #<port 3>).  (It won't let you hand it a
   socket.) */
static char s_remote_end_closed[]="socket:remote-end-closed?";
SCM l_remote_end_closed(SCM port)
{
  int fd, bytes_left;
  SCM select_result;
  ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_remote_end_closed);

  select_result = l_select(port);
  if (select_result == BOOL_F)
    return BOOL_F;

  fd = fileno(STREAM(port));
  DEFER_INTS;	/* I probably don't need to do ths, since we aren't letting 
		   the ioctl block, but... */
  SYSCALL(ioctl(fd, FIONREAD, &bytes_left););
  ALLOW_INTS;

  if (bytes_left == 0)
    return BOOL_T;
  else
    return BOOL_F;
}

static iproc subs1[]=
{
  {s_usleep, l_usleep},
  {s_select, l_select},
  {s_conn_ready, l_select},
  {s_can_write,l_can_write},
  {s_remote_end_closed, l_remote_end_closed},
  {0, 0}
};

void init_sock_ext()
{
  init_iprocs(subs1, tc7_subr_1);
  add_feature("sock-ext");
}
