/*
 * This file is based on a contribution of David Tolpin (dvd@pizza.msk.su)
 *
 * Bugs correction (conversion between host and network byte order) by
 * Marc Furrer (Marc.Furrer@di.epfl.ch)
 *
 * Reworked  by Erick Gallesio for 2.2 release. Some additions and simplifications
 * (I hope). 
 * 
 * Win32 support by Caleb Deupree <cdeupree@erinet.com>
 *
 * Last file update: 31-Jan-1998 10:29
 */


#ifdef WIN32
#  include <fcntl.h>
#  include <tclWinPort.h>
#  define BAD_SOCKET(s) ((s) == INVALID_SOCKET)
#  ifndef _O_WRONLY
#    define _O_WRONLY O_WRONLY
#  endif
#  ifndef _O_RDONLY
#    define _O_RDONLY O_RDONLY
#  endif 
#else 
#  include <sys/types.h>
#  include <sys/socket.h>
#  include <netinet/in.h>
#  include <arpa/inet.h>
#  include <netdb.h>
#  include <memory.h>
#  define BAD_SOCKET(s) ((s) < 0)
#endif

#include "stk.h"
#include <errno.h>

struct socket_type {
  int portnum;
  SCM hostname, hostip;
  int fd;
  SCM input, output;
  SCM ready_event;
};

static int tc_socket;

#define SOCKET(x)   ((struct socket_type*)(x->storage_as.extension.data))
#define LSOCKET(x)  (x->storage_as.extension.data)
#define SOCKETP(x)  (TYPEP(x,tc_socket))
#define NSOCKETP(x) (NTYPEP(x,tc_socket))

/******************************************************************************
 *
 *   U t i l i t i e s
 *
 ******************************************************************************/

static void system_error(char *who)
{
  char buffer[512]; /* should suffice */
  
  sprintf(buffer, "%s: %s", who, strerror(errno));
  Err(buffer, NIL);
}

static void socket_error(char *who, char *message, SCM object)
{
  char buffer[512]; /* should suffice */
  
  sprintf(buffer, "%s: %s", who, message);
  Err(buffer, object);
}

static void set_socket_io_ports(int s, SCM sock, char *who)
{
  int t, len, port;
  char *hostname, *fname;
  FILE *fs, *ft;
  char buffer[200];

  STk_disallow_sigint();

#ifdef WIN32
  {
    int r;

    if (((t = _open_osfhandle(s, _O_WRONLY)) == -1) || 
	((r = _open_osfhandle(s, _O_RDONLY)) == -1)) {
      sprintf(buffer, "%s: cannot open osfhandle", who);
      Err(buffer, NIL);
    }
    
    if(!((fs = fdopen(r, "r")) && (ft = fdopen(t, "w")))) {
      sprintf(buffer, "%s: cannot create socket io ports", who);
      Err(buffer, NIL);
    }
  }
#else
  t = dup(s); /* duplicate handles so that we are able to access one 
		 socket channel via two scheme ports */

  if (t == -1) {
    sprintf(buffer, "%s: cannot duplicate io port", who);
    Err(buffer,  STk_makeinteger(errno));
  }

  if(!((fs = fdopen(s, "r")) && (ft = fdopen(t, "w")))) {
    sprintf(buffer, "%s: cannot create socket io ports", who);
    Err(buffer, NIL);
  }
#endif

  port     = SOCKET(sock)->portnum;
  hostname = CHARS(SOCKET(sock)->hostname);
  len      = strlen(hostname) + 20;
  fname    = (char*) must_malloc(len);
  sprintf(fname, "%s:%d", hostname, port);

  /* Create input port */
  SOCKET(sock)->input = STk_Cfile2port(fname, fs, tc_iport, 0);

  /* Create output port */
  SOCKET(sock)->output = STk_Cfile2port(strdup(fname), ft, tc_oport, 0);

  STk_allow_sigint();
}

/******************************************************************************
 *
 *   m a k e - c l i e n t - s o c k e t
 *
 ******************************************************************************/

static PRIMITIVE make_client_socket(SCM hostname, SCM port)
{
  char str[] = "make-client-socket";
  struct hostent *hp;
  struct sockaddr_in server;
  struct in_addr local_ip;
  SCM z, local_host;
  int s;

  /* Verify arguments */
  if(NSTRINGP(hostname)) 
    socket_error(str, "bad hostname", hostname);
  if(NINTEGERP(port))
    socket_error(str, "bad port number", port);

  /* Locate the host IP address */
  if ((hp=gethostbyname(CHARS(hostname))) == NULL)
    socket_error(str, "unknown or misspelled host name", hostname);

  /* Get a socket */
  if (BAD_SOCKET(s=socket(AF_INET,SOCK_STREAM,0)))
    socket_error(str, "cannot create socket", NIL);
  
  /* Setup a connect address */
  memset(&server, 0, sizeof(server));
  memcpy((char*)&server.sin_addr, hp->h_addr, hp->h_length);
  server.sin_family = AF_INET;
  server.sin_port   = htons(INTEGER(port));

  /* Try to connect */
  if (connect(s, (struct sockaddr *) &server, sizeof(server)) < 0) {
    close(s);
    system_error(str);
  }

  /* Create a new Scheme socket object */
  NEWCELL(z, tc_socket);
  LSOCKET(z) = (struct socket_type*) 
    				must_malloc(sizeof (struct socket_type));

  SOCKET(z)->portnum	 = ntohs(server.sin_port); /* Query true value */
  SOCKET(z)->hostname    = STk_makestring((char *) hp->h_name);
  SOCKET(z)->hostip      = STk_makestring((char *) inet_ntoa(server.sin_addr));
  SOCKET(z)->fd 	 = s;
  SOCKET(z)->input 	 = Ntruth;
  SOCKET(z)->output 	 = Ntruth;
  SOCKET(z)->ready_event = Ntruth;

  set_socket_io_ports(s, z, str);
  return z;
}

/******************************************************************************
 *
 *   m a k e - s e r v e r - s o c k e t
 *
 ******************************************************************************/

static PRIMITIVE make_server_socket(SCM port)
{
  char msg[] = "make-server-socket";
  struct sockaddr_in sin;
  int s, portnum, len;
  SCM local_host;
  struct in_addr local_ip;
  SCM z;

  /* Determine port to use */
  portnum = (port == UNBOUND) ? 0 : STk_integer_value(port);
  if (portnum < 0)  Err("make-server-socket: bad port number", port);

  /* Create a socket */
  if (BAD_SOCKET(s = socket(AF_INET, SOCK_STREAM, 0)))
    Err("Cannot create socket", NIL);
  
  /* Bind the socket to a name */
  sin.sin_family      = AF_INET;
  sin.sin_port 	      = htons(portnum);
  sin.sin_addr.s_addr = INADDR_ANY;

  if (bind(s, (struct sockaddr *) &sin, sizeof(sin)) < 0) {
    close(s);
    system_error(msg);
  }

  /* Query the socket name (permits to get the true socket number if 0 was given */
  len = sizeof(sin);
  if (getsockname(s, (struct sockaddr *) &sin, (int *) &len) < 0) {
    close(s);
    system_error(msg);
  }

  /* Indicate that we are ready to listen */
  if (listen(s, 5) < 0) {
    close(s);
    system_error(msg);
  }

  /* Now we can create the socket object */
  NEWCELL(z, tc_socket);
  LSOCKET(z) = (struct socket_type*) 
    				must_malloc(sizeof (struct socket_type));
  SOCKET(z)->portnum      = ntohs(sin.sin_port);
  SOCKET(z)->hostname     = Ntruth;
  SOCKET(z)->hostip	  = Ntruth;
  SOCKET(z)->fd	 	  = s;
  SOCKET(z)->input	  = Ntruth;
  SOCKET(z)->output	  = Ntruth;
  SOCKET(z)->ready_event  = Ntruth;

  return z;
}

/******************************************************************************
 *
 *   s o c k e t - a c c e p t - c o n n e c t i o n
 *
 ******************************************************************************/

static PRIMITIVE socket_accept_connection(SCM sock)
{
  char buff[50], *s;
  char str[]= "socket-accept-connection";
  struct sockaddr_in sin;
  struct hostent *host;
  int len = sizeof(sin);
  int new_s;

  if (NSOCKETP(sock)) 
    socket_error(str, "bad socket", sock);

  if (BAD_SOCKET(new_s = accept(SOCKET(sock)->fd, (struct sockaddr *) &sin, &len)))
    system_error(str);
  
  /* Set the client info (if possible its name, otherwise its IP number) */
  host = gethostbyaddr((char *) &sin.sin_addr, sizeof(sin.sin_addr), AF_INET);
  s    = (char *) inet_ntoa(sin.sin_addr);
  
  SOCKET(sock)->hostip   = STk_makestring(s);
  SOCKET(sock)->hostname = STk_makestring(host? (char*) (host->h_name): s);

  set_socket_io_ports(new_s, sock, str);
  return UNDEFINED;
}

/******************************************************************************
 *
 *   w h e n - s o c k e t - r e a d y 
 *
 ******************************************************************************/
static void apply_socket_closure(SCM closure)
{
  Apply(closure, NIL);
}
 
static PRIMITIVE when_socket_ready(SCM s, SCM closure)
{
  char str[50];
  int fd;

  if (NSOCKETP(s))
    Err("when-socket-ready: bad socket", s);
  
  if (closure == UNBOUND) {
    /* Return the current handler closure */
    return SOCKET(s)->ready_event;
  }
  
  fd = SOCKET(s)->fd;
 
  if (closure == Ntruth) {
    Tcl_DeleteFileHandler(fd);    
    SOCKET(s)->ready_event = Ntruth;
  }
  else {
    if (STk_procedurep(closure) == Ntruth) 
      Err("when-socket-ready: bad closure", closure);

    Tcl_CreateFileHandler(fd, TCL_READABLE, (Tcl_FileProc *) apply_socket_closure, 
			  (ClientData) closure);
    SOCKET(s)->ready_event = closure;
  }
  return UNDEFINED;
}

static PRIMITIVE buggy_handler(SCM s, SCM closure)
{
  Err("when-socket-ready: cannot be used with snow", NIL);
}

/******************************************************************************
 *
 *   s o c k e t - s h u t d o w n
 *
 ******************************************************************************/

static PRIMITIVE socket_shutdown(SCM sock, SCM close_socket)
{
  SCM tmp1, tmp2;

  if (close_socket == UNBOUND) close_socket = Truth;

  if (NSOCKETP(sock)) 	       Err("socket-shutdown: bad socket", sock);
  if (NBOOLEANP(close_socket)) Err("socket-shutdown: bad boolean", close_socket);

  if (close_socket == Truth && SOCKET(sock)->fd > 0) {
    int fd = SOCKET(sock)->fd;

    if (!STk_snow_is_running)
      /* We cannot use #ifdef USE_TK here to have the same socket.so
       * for both snow and stk. So we have to test if we are running 
       * snow dynamically
       */
      Tcl_DeleteFileHandler(fd);
    /* close(fd); */
    shutdown(fd, 2);
    SOCKET(sock)->fd = -1;
  }
 
  /* 
   * Warning: input and output can have already be garbaged :if the socket is 
   * no more used, the input and output are not marked as used and can
   * (eventually) be released before the call to shutdown (through free_socket)
   * be done. One way could be to just set SOCKET(sock)->{in|out}put to #t
   * and wait that next GC frees the ports if not already down. However,
   * this will really disconnect the peer when the GC occurs rather than when
   * the call to shutdown is done. This is not important if this function 
   * is called by the GC, but could be annoying when it is called by the user
   */

  if (INP(SOCKET(sock)->input)) {
    STk_close_port(SOCKET(sock)->input);
    SOCKET(sock)->input = Ntruth;
  }
  if (OUTP(SOCKET(sock)->output)) {
    STk_close_port(SOCKET(sock)->output);
    SOCKET(sock)->output = Ntruth;
  }

  return UNDEFINED;
}

/******************************************************************************
 *
 *   O t h e r   s o c k e t   p r i m i t i v e s
 *
 ******************************************************************************/

static PRIMITIVE socketp(SCM sock)
{
  return SOCKETP(sock)? Truth: Ntruth;
}

static PRIMITIVE socket_port_number(SCM sock)
{
  if (NSOCKETP(sock)) Err("socket-port-number: bad socket", sock);
  return STk_makeinteger(SOCKET(sock)->portnum);
}

static PRIMITIVE socket_input(SCM sock)
{
  if (NSOCKETP(sock)) Err("socket-input: bad socket", sock);
  return SOCKET(sock)->input;
}

static PRIMITIVE socket_output(SCM sock)
{
  if (NSOCKETP(sock)) Err("socket-output: bad socket", sock);
  return SOCKET(sock)->output;
}

static PRIMITIVE socket_hostname(SCM sock)
{
  if (NSOCKETP(sock)) Err("socket-hostname: bad socket", sock);
  return SOCKET(sock)->hostname;
}

static PRIMITIVE socket_host_address(SCM sock)
{
  if (NSOCKETP(sock)) Err("socket-host-address: bad socket", sock);
  return SOCKET(sock)->hostip;
}

static PRIMITIVE socket_downp(SCM sock)
{
  if (NSOCKETP(sock)) Err("socket-down?: bad socket", sock);
  return (SOCKET(sock)->fd == -1) ? Truth: Ntruth;
}

static PRIMITIVE socket_dup(SCM socket)
{
  SCM z;
  int new_fd;
#ifdef WIN32
  HANDLE process;
#endif

  if (NSOCKETP(socket)) Err("socket-dup: bad socket", socket);

#ifdef WIN32
  process = GetCurrentProcess();
  if (!DuplicateHandle(process, 
		       (HANDLE) SOCKET(socket)->fd, process,
		       (HANDLE*) &new_fd,
		       0, 
		       TRUE, 
		       DUPLICATE_SAME_ACCESS))
    Err("socket-dup: cannot duplicate socket", STk_makeinteger(GetLastError()));
#else
  if ((new_fd=dup(SOCKET(socket)->fd)) < 0)
    Err("socket-dup: cannot duplicate socket", socket);
#endif
  
  NEWCELL(z, tc_socket);
  LSOCKET(z) = (struct socket_type*) must_malloc(sizeof (struct socket_type));

  *SOCKET(z) = *SOCKET(socket);
  SOCKET(z)->fd = new_fd;  

  return z;
}


static PRIMITIVE socket_local_addr(SCM sock)
{
  struct sockaddr_in sin;
  int len = sizeof(sin);

  if (NSOCKETP(sock)) Err("socket-local-address: bad socket", sock);

  if (getsockname(SOCKET(sock)->fd, (struct sockaddr *) &sin, &len))
    Err("socket-local-address: cannot get socket name", sock);

  return STk_makestring((char *) inet_ntoa(sin.sin_addr));
}
  

/******************************************************************************/


static void mark_socket(SCM sock)
{
  STk_gc_mark(SOCKET(sock)->hostname);
  STk_gc_mark(SOCKET(sock)->hostip);
  STk_gc_mark(SOCKET(sock)->input);
  STk_gc_mark(SOCKET(sock)->output);
  STk_gc_mark(SOCKET(sock)->ready_event);
}

static void free_socket(SCM sock)
{
  socket_shutdown(sock, Truth);
  free(SOCKET(sock));
}

static void displ_socket(SCM sock, SCM port, int mode)
{
  struct socket_type *s = SOCKET(sock);

  sprintf(STk_tkbuffer, "#[socket %s %d]", 
	  		(s->hostname == Ntruth)?"*none*": CHARS(s->hostname),
	  		s->portnum);
  Puts(STk_tkbuffer, PORT_FILE(port));
}

static STk_extended_scheme_type socket_type = {
  "socket",		/* name */
  0, 			/* is_procp */
  mark_socket, 		/* gc_mark_fct */
  free_socket,		/* gc_free_fct */
  NULL,			/* apply_fct */
  displ_socket,		/* display_fct */
  NULL			/* compare function */
};

/******************************************************************************/

PRIMITIVE STk_init_socket(void)
{
#ifdef WIN32
  int rc;
  WSADATA wsadata;
  int optionValue = SO_OPENTYPE;
    
  if ((rc = WSAStartup(MAKEWORD(1,1), &wsadata)) != 0) {
    Err("Socket initialisation failed", STk_makeinteger(rc));
  }

  /* All sockets have to be synchronous to be readable with stdio. */
  if ((rc = setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
                       (char *)&optionValue, sizeof(optionValue))) != NO_ERROR) {
    /* failed for some reason... */
    Err("Synchronous socket option setting failed", 
	STk_makeinteger(WSAGetLastError()));
  }
#endif

  tc_socket = STk_add_new_type(&socket_type);

  STk_add_new_primitive("make-client-socket",  tc_subr_2,      make_client_socket);
  STk_add_new_primitive("make-server-socket",  tc_subr_0_or_1, make_server_socket);
  STk_add_new_primitive("socket-accept-connection",
		    		               tc_subr_1, socket_accept_connection);
  STk_add_new_primitive("socket?",	       tc_subr_1,      socketp);
  STk_add_new_primitive("socket-port-number",  tc_subr_1,      socket_port_number);
  STk_add_new_primitive("socket-input",        tc_subr_1,      socket_input);
  STk_add_new_primitive("socket-output",       tc_subr_1,      socket_output);
  STk_add_new_primitive("socket-host-name",    tc_subr_1,      socket_hostname);
  STk_add_new_primitive("socket-host-address", tc_subr_1,      socket_host_address);
  STk_add_new_primitive("socket-shutdown",     tc_subr_1_or_2, socket_shutdown);
  STk_add_new_primitive("socket-down?",        tc_subr_1,      socket_downp);
  STk_add_new_primitive("socket-local-address",tc_subr_1,      socket_local_addr);
  STk_add_new_primitive("socket-dup", 	       tc_subr_1,      socket_dup);

  STk_add_new_primitive("when-socket-ready",   tc_subr_1_or_2, 
			(STk_snow_is_running)? buggy_handler:  when_socket_ready);

  return UNDEFINED;
}