/* Implements a simple TCP socket connection model (forgive the 6 consecutive
 * nouns there). It mostly replaces the socket package, which was quite
 * general, but wasn't guarenteed to work under ANSI C, although it did work
 * under BSD (which was exactly none of the machines we were working on).
 * This version appeals to POSIX, which was designed with this idea in mind.
 * It also attempts to remove as many intermediate stages as possible, to
 * remove access to several objects which need further processing before they
 * are useful (i.e., unbound, unconnected sockets; bound but not listening
 * sockets).
 * -Daniel Barkalow, Jul 1997 */

/* There are two new types: listeners, which are file descriptors of 
 * listening (blocking) ports, and tcps, which are tcp connections, buffered
 * on output to avoid blocking, buffered on input to reduce context shifts,
 * non-blocking on output, with non-blocking versions of connect and accept.
 * The file descriptors associated with tcps are non-blocking. */

/* An exception: since close-port specifies that all data must be sent, this
 * is blocking and may take indefinitely long. */

/* A word of thanks to the developers of Lynx, who provided a nice example of
 * a working TCP socket model: thanks.
 * Conversely, a look of confusion to the official documentation of sockets:
 * How am I supposed to figure out sockaddr? */

/* Since Lynx credited their connect code to Marc Andreesen and Lou Montulli,
 * I'll do the same, even though I rewrote this. */

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

#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>
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#include <fcntl.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef HAVE_MALLOC_H
#include <malloc.h>
#endif

#ifdef HAVE_SYS_FILIO_H
#include <sys/filio.h>
#endif

#include "tcp.h"

#define MOD "tcp:"

unsigned long totalread = 0;
unsigned long totalsent = 0;

/* SELECT() is BSD select() on the current operating system */
#ifdef hpux /* (fd_set *)s are replaced with (int *)s, for some reason */
#define SELECT(num, rd, wr, ex, to) \
  select(num, (int *)rd, (int *)wr, (int *)ex, to)
#else
#define SELECT(num, rd, wr, ex, to) select(num, rd, wr, ex, to)
#endif

/* listener smob functions */

/* listener -- smob.print */
int prinlsnr(SCM exp, SCM port, int writing)
{
  writing = writing;
  if (CDR(exp))
    {
      lputs("#<Listener ", port);
      intprint(CDR(exp), 10, port);
      lputs(">", port);
    }
  else
    lputs("#<Closed-listener>", port);
  return 1;
}

/* listener -- smob.free */
int freelsnr(SCM lsnr)
{
  if (CDR(lsnr))
    close(CDR(lsnr));
  return 0;
}  

/* tcp utilities */

#define TCPBUFSIZE 1024

SCM maktcp(int fd, struct sockaddr_in *info)
     /* allocate and initialize a tcp struct */
{
  tcpobj *obj = (tcpobj *)malloc(sizeof(tcpobj));
  obj->fd = fd;
  obj->info = *info; /* make a local copy */
  obj->buf = (char *)malloc(TCPBUFSIZE);
  obj->oversz = 0; /* this also indicates overflow unallocated */
  obj->overnum = 0;
  obj->bufpos = 0;
  obj->bufmax = 0;
  obj->state = 1; /* if this is not the case, caller will change it */
  obj->charssent = 0;
  obj->charsread = 0;
  return (SCM) obj;
}

int tryover(tcpobj *tcp)
     /* write out more buffer; check tcp->overnum before calling */
{
  int thistime;
  thistime = write(tcp->fd, tcp->overflow + tcp->overstart, tcp->overnum); 

  if ((thistime == -1) && (errno == EAGAIN))
    {
      /* Nothing sent this time, no big deal */
      thistime = 0;
      errno = 0;
    }

  if (thistime == -1) /* we've got problems, probably remote end 
			   * closed; in any case, this can't recover. */
    {
      close(tcp->fd);
      tcp->fd = 0;
#if 0
      printf("tcp: errno=%d, closed port\n", errno);
#endif
      errno = 0;
      return tcp->overnum;
    }
  tcp->charssent += thistime;
  totalsent += thistime;
  if (tcp->overnum -= thistime)
    tcp->overstart += thistime;
  else if (tcp->state == 2)
    shutdown(tcp->fd, 1); /* actually disallow writes / send eof */
  else if (tcp->state == 4)
    close(tcp->fd); /* actually close */
  return tcp->overnum;
}

void bufwrite(tcpobj *tcp, char *buf, size_t bytes)
     /* write to the tcp connection, via fd, buffered if necessary */
{
  int thistime;
  if (!tcp->fd) /* connection has gone, ignore */
    {
      tcp->overnum += bytes; /* keep track of the stuff we don't send */
      return;
    }
  if ((tcp->overnum) && (tryover(tcp))) /* we can't write any more for now */
    {
      if (bytes + tcp->overnum + tcp->overstart > tcp->oversz)
	tcp->overflow = realloc(tcp->overflow,
				tcp->oversz = 
				(tcp->overstart + tcp->overnum + bytes) << 1);
      memcpy(tcp->overflow + tcp->overstart + tcp->overnum, buf, bytes);
      tcp->overnum += bytes;
    }
  else
    {
      thistime = write(tcp->fd, buf, bytes);
      if ((thistime == -1) && (errno == EAGAIN))
	{
	  /* Everything's okay, nothing got sent */
	  thistime = 0;
	  errno = 0;
	}
      if (thistime == -1)
	/* we've got problems, probably remote end 
			       * closed; in any case, this can't recover. */
	{
	  close(tcp->fd);
	  tcp->fd = 0;
#if 0
	  printf("tcp: errno=%d, closed port\n", errno);
#endif
	  errno = 0;
	  tcp->overnum += bytes;
	}
      else if ((tcp->overnum = bytes - thistime)) /* overflow */
	{
	  totalsent += thistime;
	  tcp->charssent += thistime;
	  if (!tcp->oversz)
	    tcp->overflow = malloc(tcp->oversz = tcp->overnum << 1);
	  else if (tcp->overnum > tcp->oversz)
	    tcp->overflow = realloc(tcp->overflow,
				    tcp->oversz = tcp->overnum << 1);
	  memcpy(tcp->overflow, buf + thistime, tcp->overnum);
	  tcp->overstart = 0;
	}
      else
	{
	  totalsent += thistime;
	  tcp->charssent += thistime;
	}
    }
}

static int tcpslurp(tcpobj *tcp)
     /* Read as much as possible out of the connection without blocking.
      * Return value is 0 if buffer is empty and connection is closed,
      * otherwise number of chars we have, or -1 if we have no chars, but
      * connection is still open */
{
  int thistime;
  if (!tcp->fd) /* connection is closed */
    return tcp->bufmax - tcp->bufpos;
  thistime = read(tcp->fd, tcp->buf + tcp->bufmax, TCPBUFSIZE - tcp->bufmax);
  if (thistime != -1) /* size_t is unsigned, remember? */
    {
      tcp->bufmax += thistime;
      tcp->charsread += thistime;
      totalread += thistime;
    }
  else if (tcp->bufmax == tcp->bufpos)
    return -1; /* only mention that it would block if we don't have buffered
                * characters */
  return tcp->bufmax - tcp->bufpos;    
}

/* tcp ptob functions */

/* tcp -- smob.print */
int printcp(SCM exp, SCM port, int writing)
{
  tcpobj *tcp = (tcpobj *)CDR(exp);
  writing = writing; /* in any case... */
  if (tcp->fd)
    switch (tcp->state)
      {
      case 0:
	lputs("#<Pending-tcp>", port);
	break;
      case 1:
	lputs("#<Input-output-tcp ", port);
	intprint(tcp->fd, 10, port);
	lputs(">", port);
	break;
      case 2: /* Assume that writing will happen */
      case 3:
	lputs("#<Input-tcp ", port);
	intprint(tcp->fd, 10, port);
	lputs(">", port);
	break;
      case 4: /* Assume that writing will happen */
	lputs("#<Closed-tcp>", port);
      }
  else if (tcp->state == 5)
    lputs("#<Failed-tcp>", port);
  else
    lputs("#<Closed-tcp>", port);
  return 1;
}

/* tcp -- fclose */
int tcpclose(tcpobj *tcp)
{
  while (tcp->overnum && tcp->fd)
    tryover(tcp);
  /* Keep trying until either it works or we get a real error */

  if (tcp->fd)
    close(tcp->fd);
  tcp->fd = 0;
  tcp->bufmax = tcp->bufpos; /* set the read buffer to empty */
  return 0;
}

/* We assume bufwrite always succeeds. */

/* tcp -- fputc */
int outcpc(int c, tcpobj *tcp)
{
  char ch = c;
  bufwrite(tcp, &ch, 1);
  return c;
}

/* tcp -- fputs */
int outcps(char *s, tcpobj *tcp)
{
  bufwrite(tcp, s, strlen(s));
  return 0;
}

/* tcp -- fwrite */
int outcpwr(char *s, size_t sz, size_t num, tcpobj *tcp)
{
  bufwrite(tcp, s, num*sz);
  return num;
}

/* tcp -- fgetc */
int intcpc(tcpobj *tcp)
{
  fd_set fds;
  int result;
  if (tcp->bufmax == tcp->bufpos)
    {
      tcp->bufpos = tcp->bufmax = 0; /* we've exhausted the buffer, reset it*/
      if ((result = tcpslurp(tcp)) == -1) /* and read some more */
	{ /* we have to block, so block, then try again. */
	  errno = 0; /* get rid of EAGAIN, which we've realized */
	  FD_ZERO(&fds);
	  FD_SET(tcp->fd, &fds);
	  SELECT((tcp->fd + 1), &fds, 0, 0, 0); /* block on read from fd */
	  result = tcpslurp(tcp);
	}
      if (!result)
	return EOF;
    }
  return tcp->buf[tcp->bufpos++];
}

/* tcp -- smob.free */
int freetcp(tcpobj *tcp)
{
  if (tcp->buf)
    free(tcp->buf);
  if (tcp->oversz)
    free(tcp->overflow);
  if (tcp->fd)
    close(tcp->fd); /* ignore return value-- who would we report it to? */
  free(tcp);
  return 0;
}

/* tcp -- flush */

int outcpfl(tcpobj *tcp)
{
  while (tcp->overnum && tcp->fd) /* If we give up, don't keep flushing */
    tryover(tcp);
  tcpslurp(tcp);
  return 0;
}

/**************************/
/* SCM support procedures */
/**************************/

/* accept chars-unread chars-unsent close-listener connect connected? 
 * connect-nonblocking destory done-writing error failed? heard? listen
 * listener remote-ip remote-port tcp?
 */

/*** "tcp:accept" ***/
/*** BETA ***/
static char s_accept[] = MOD "accept";
static SCM p_accept(SCM lsnr)
{
  SCM ret = BOOL_F;
  int newfd;
  struct sockaddr_in addr; /* describes the remote host*/
  int sz = sizeof(addr);

  ASSERT(LSNRP(lsnr) && LSNRFD(lsnr), lsnr, ARG1, s_accept);
  SYSCALL(newfd = accept(LSNRFD(lsnr), (struct sockaddr *)&addr, &sz););
  if (newfd != -1)
    {
      SYSCALL(fcntl(newfd, F_SETFL, O_NONBLOCK););
      ret = MAKTCP(newfd, addr);
    }
  return ret;
}

/*** "tcp:chars-unread" ***/
/*** BETA ***/

static char s_rdcount[] = MOD "chars-unread";
SCM p_rdcount(SCM port)
{
  tcpobj *tcp;
  int result;
  ASSERT(ITCPP(port), port, ARG1, s_rdcount);
  tcp = (tcpobj *)CDR(port);
  if ((result = tcpslurp(tcp)) <= 0) /* zero is EOF, we want 1, block is -1,*/
    return MAKINUM(result + 1);		/* we want 0, so we'll just add 1 */
  return MAKINUM(tcp->bufmax - tcp->bufpos);
}

/*** "tcp:chars-unsent" ***/
/*** BETA ***/
static char s_bufchars[] = MOD "chars-unsent";
SCM p_bufchars(SCM port)
{
  tcpobj *tcp;
  ASSERT(ITCPP(port), port, ARG1, s_bufchars);
  tcp = (tcpobj *)CDR(port);
  if (tcp->fd) /* don't retry if the connection is gone */
    return (tcp->overnum) ? MAKINUM(tryover(tcp)) : INUM0;
  else return MAKINUM(tcp->overnum);
}

/*** "tcp:close-listener" ***/
/*** ALPHA ***/

static char s_close_lsnr[] = MOD "close-listener";
static SCM p_close_lsnr(SCM lsnr)
{
  ASSERT(LSNRP(lsnr), lsnr, ARG1, s_close_lsnr);
  
  if (CDR(lsnr))
    close(CDR(lsnr));
  CDR(lsnr) = 0;
  return UNDEFINED;
}

/*** "tcp:connect" ***/
/*** BETA ***/
static char s_connect[] = MOD "connect";
static SCM p_connect(SCM hostname, SCM portnum)
{
  SCM ret = BOOL_F; /* for rejected connections and failed lookups */
  struct sockaddr_in addr;

  struct hostent *entry;

  int sockfd;

  ASSERT(NIMP(hostname) && STRINGP(hostname), hostname, ARG1, s_connect);
  ASSERT(INUMP(portnum), portnum, ARG2, s_connect);

  DEFER_INTS;
  SYSCALL(entry = gethostbyname(CHARS(hostname)););
  ALLOW_INTS;

  if (!entry)
    return ret;
  
  addr.sin_family = AF_INET;
  addr.sin_port = htons(INUM(portnum));
  addr.sin_addr.s_addr = ((struct in_addr *)entry->h_addr)->s_addr;
  
  SYSCALL(sockfd = socket(AF_INET, SOCK_STREAM, 0););

  if (sockfd == -1)
    return ret;
  
  if (connect(sockfd, (struct sockaddr *)&addr, sizeof(addr)) != -1)
    {
      SYSCALL(fcntl(sockfd, F_SETFL, O_NONBLOCK);); /* non-blocking */
      ret = MAKTCP(sockfd, addr);
    }
  return ret;
}

/*** "tcp:connected?" ***/
/*** BETA ***/
static char s_connected[] = MOD "connected?";
static SCM p_connected(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr), hdr, ARG1, s_connected);
  tcp = (tcpobj *)CDR(hdr);
  if ((!tcp->fd) && (tcp->bufmax == tcp->bufpos))
    return BOOL_F;
  if (tcp->state == 0) /* trying to connect, check on the progress */
    {
      /* NOTE: you can use select() to determine if it's ready yet, but
       * we want to actually do the connection in any case */
      errno = 0;
      if ((connect(tcp->fd, (struct sockaddr *)&tcp->info,
		   sizeof(tcp->info)) != -1) || (errno == EISCONN))
	tcp->state = 1;
      else if ((errno == ECONNREFUSED) || (errno == EINVAL))
	{  /* HP/UX uses EINVAL, Linux used ECONNREFUSED */
	  tcp->state = 5;
	  tcp->err = ECONNREFUSED; /* Eliminate HP/UX's wierdness. */
	  close(tcp->fd);
	  tcp->fd = 0;
	}
      else /* It's an actual interesting error */
	{
	  tcp->state = 5;
	  close(tcp->fd);
	  tcp->fd = 0;
	  tcp->err = errno;
	}
    }
  return (!((tcp->state == 0) || (tcp->state >= 4)) && tcpslurp(tcp)) 
    ? BOOL_T : BOOL_F;
}

/*** "tcp:connect-nonblocking" ***/
/*** BETA ***/
static char s_connect_nb[] = MOD "connect-nonblocking";
static SCM p_connect_nb(SCM hostname, SCM portnum)
{
  SCM ret = BOOL_F; /* for rejected connections and failed lookups */
  struct sockaddr_in addr;

  struct hostent *entry;

  int sockfd;

  ASSERT(NIMP(hostname) && STRINGP(hostname), hostname, ARG1, s_connect);
  ASSERT(INUMP(portnum), portnum, ARG2, s_connect);

  DEFER_INTS;
  SYSCALL(entry = gethostbyname(CHARS(hostname)););
  ALLOW_INTS;

  if (!entry)
    return ret;

  addr.sin_family = AF_INET;
  addr.sin_port = htons(INUM(portnum));
  addr.sin_addr.s_addr = ((struct in_addr *)entry->h_addr)->s_addr;
  
  SYSCALL(sockfd = socket(AF_INET, SOCK_STREAM, 0););

  if (sockfd == -1)
    return ret;

  SYSCALL(fcntl(sockfd, F_SETFL, O_NONBLOCK);); /* non-blocking */
  
  if (connect(sockfd, (struct sockaddr *)&addr, sizeof(addr)) == -1)
    {
      if (errno != EINPROGRESS && errno != EAGAIN)/* something really wrong */
	{
	  close(sockfd);
	  return ret;
	}
      ret = MAKTCP(sockfd, addr);
      ((tcpobj *)(CDR(ret)))->state = 0;
    }
  else /* It connected already */
    ret = MAKTCP(sockfd, addr);

  return ret;
}

/*** "tcp:destroy" ***/
/*** BETA ***/
static char s_destroy[] = MOD "destroy";
SCM p_destroy(SCM port)
{
  tcpobj *tcp;
  ASSERT(ITCPP(port), port, ARG1, s_destroy);
  tcp = (tcpobj *)CDR(port);
  close(tcp->fd);
  tcp->fd = 0;
  free(tcp->buf);
  tcp->buf = NULL;
  if (tcp->oversz)
    free(tcp->overflow);
  tcp->oversz = 0;
  CAR(port) &= ~(RDNG | WRTNG | OPN);
  return BOOL_T; /* why, yes, we did successfully close */
}

/*** "tcp:done-writing" ***/
/*** BETA ***/
static char s_donewr[] = MOD "done-writing";
static SCM p_donewr(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr), hdr, ARG1, s_donewr);
  tcp = (tcpobj *)CDR(hdr);
  
  CAR(hdr) &= ~(WRTNG);
  if (!tcp->fd)
    return BOOL_T; /* it's closed already... */
  if ((tcp->overnum) && (tryover(tcp)))
    {
      tcp->state = 2;
      return BOOL_F;
    }

  shutdown(tcp->fd, 1);
  tcp->state = 3;
  return BOOL_T;
}

/*** "tcp:error" ***/
/*** BETA ***/
static char s_error[] = MOD "error";
static SCM p_error(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr) || (hdr == BOOL_F), hdr, ARG1, s_error);
  if (hdr == BOOL_F) /* Since this is something returned by connect... */
    return makfrom0str(strerror(ECONNREFUSED));
  tcp = (tcpobj *)CDR(hdr);
  if (tcp->state == 5)
    return makfrom0str(strerror(tcp->err));
  return BOOL_F; /* It's fine, why do you ask? */
}

/*** "tcp:failed?" ***/
/*** BETA ***/

static char s_refused[] = MOD "failed?";
static SCM p_refused(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr) || (hdr == BOOL_F), hdr, ARG1, s_refused);
  if (hdr == BOOL_F)
    return BOOL_T;   /* BOOL_F is a connection that was refused at once */
  tcp = (tcpobj *)CDR(hdr);
  if (tcp->state == 5)
    return BOOL_T;
  return BOOL_F;
}

/*** "tcp:heard?" ***/
/*** BETA ***/
static char s_heard[] = MOD "heard?";
static SCM p_heard(SCM lsnr)
{
  fd_set fds;
  int fd;
  struct timeval tv;
  ASSERT(LSNRP(lsnr), lsnr, ARG1, s_heard);
  tv.tv_sec = 0;
  tv.tv_usec = 0;
  fd = (int)CDR(lsnr);
  FD_ZERO(&fds);
  FD_SET(fd, &fds);
  return (SELECT((1+fd), &fds, NULL, NULL, &tv) == 1)
    ? BOOL_T : BOOL_F; /* one readable, no error */
}

/*** "tcp:listen" ***/
/*** BETA ***/
static char s_listen[] = MOD "listen";
static SCM p_listen(SCM portnum, SCM numpending)
{
  struct sockaddr_in addr; /* socket address */
  int sockfd; /* file descriptor for socket */
  int port; /* port to listen on */
  int hold; /* number of connections to put on hold before refusing more */
  int i = 1; /* one in a variable */
  SCM ret = BOOL_F;

  ASSERT(INUMP(portnum), portnum, ARG1, s_listen);
  ASSERT(UNBNDP(numpending) || INUMP(numpending), numpending, ARG2, s_listen);

  DEFER_INTS;
  SYSCALL(sockfd = socket(AF_INET, SOCK_STREAM, 0););
  /* a connection-based internet socket of the default protocol (which is TCP
   * for the other given values */

  port = INUM(portnum);
  hold = UNBNDP(numpending) ? 1 : INUM(numpending);

  if (sockfd != -1) /* did we get this far? */
    {
      addr.sin_family = AF_INET;
      addr.sin_addr.s_addr = htonl(INADDR_ANY);
      addr.sin_port = htons(port);

      if (bind(sockfd, (struct sockaddr *)&addr, sizeof(addr)) ||
	  listen(sockfd, hold))
	close(sockfd); /* the socket didn't work out */
      else
	{
	  ret = MAKLSNR(sockfd);
	  setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &i, sizeof(i));
	}
    }
  ALLOW_INTS;
  return ret;
}

/*** "tcp:listener?" ***/
/*** BETA ***/
static char s_islsnr[] = MOD "listener?";
static SCM p_islsnr(SCM obj)
{
  return LSNRP(obj) ? BOOL_T : BOOL_F;
}

/*** "tcp:meter-port-read" ***/
/*** ALPHA ***/
static char s_mpread[] = MOD "meter-port-read";
static SCM p_mpread(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr), hdr, ARG1, s_donewr);
  
  tcp = (tcpobj *)CDR(hdr);
  tcpslurp(tcp);
  return MAKINUM(tcp->charsread);
}

/*** "tcp:meter-port-sent" ***/
/*** ALPHA ***/
static char s_mpsent[] = MOD "meter-port-sent";
static SCM p_mpsent(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr), hdr, ARG1, s_donewr);
  
  tcp = (tcpobj *)CDR(hdr);
  if (tcp->fd && tcp->overnum)
    tryover(tcp);
  return MAKINUM(tcp->charssent);
}

/*** "tcp:meter-total-read" ***/
/*** ALPHA ***/
static char s_mtread[] = MOD "meter-total-read";
static SCM p_mtread()
{
  return MAKINUM(totalread);
}

/*** "tcp:meter-total-sent" ***/
/*** ALPHA ***/
static char s_mtsent[] = MOD "meter-total-sent";
static SCM p_mtsent()
{
  return MAKINUM(totalsent);
}

/*** "tcp:remote-ip" ***/
/*** BETA ***/
static char s_remoteip[] = MOD "remote-ip";
static SCM p_remoteip(SCM hdr)
{
  tcpobj *tcp;
  SCM ret;
  char *ipname;
  unsigned long ipnum;
  ASSERT(ITCPP(hdr), hdr, ARG1, s_remoteip);
  tcp = (tcpobj *)CDR(hdr);
  ASSERT(tcp->state && tcp->fd, hdr, ARG1, s_remoteip);
  ipname = (char *)malloc(16); /* "aaa.bbb.ccc.ddd0" */
  ipnum = ntohl(tcp->info.sin_addr.s_addr);
  sprintf(ipname, "%d.%d.%d.%d", (int) ipnum>>24, (int) ipnum>>16&0xff,
	  (int) ipnum>>8&0xff, (int) ipnum&0xff);/* turn the num into a str */
  ret = makfrom0str(ipname);
  free(ipname);
  return ret;
}

/*** "tcp:local-ip" ***/
/*** ALPHA ***/
static char s_localip[] = MOD "local-ip";
static SCM p_localip(SCM hdr)
{
  tcpobj *tcp;
  SCM ret;
  char *ipname;
  unsigned long ipnum;
  struct sockaddr_in local;
  int sz = sizeof(local);
  ASSERT(ITCPP(hdr), hdr, ARG1, s_remoteip);
  tcp = (tcpobj *)CDR(hdr);
  ASSERT(tcp->state && tcp->fd, hdr, ARG1, s_remoteip);
  ipname = (char *)malloc(16); /* "aaa.bbb.ccc.ddd0" */
  getsockname(tcp->fd, &local, &sz);
  ipnum = ntohl(local.sin_addr.s_addr);
  sprintf(ipname, "%d.%d.%d.%d", (int) ipnum>>24, (int) ipnum>>16&0xff,
	  (int) ipnum>>8&0xff, (int) ipnum&0xff);/* turn the num into a str */
  ret = makfrom0str(ipname);
  free(ipname);
  return ret;
}

/*** "tcp:local-port" ***/
/*** ALPHA ***/
static char s_localport[] = MOD "local-port";
static SCM p_localport(SCM hdr)
{
  tcpobj *tcp;
  struct sockaddr_in local;
  int sz = sizeof(local);
  ASSERT(ITCPP(hdr), hdr, ARG1, s_remoteip);
  tcp = (tcpobj *)CDR(hdr);
  ASSERT(tcp->state && tcp->fd, hdr, ARG1, s_remoteip);
  getsockname(tcp->fd, &local, &sz);
  return MAKINUM(ntohs(local.sin_port));
}

/*** "tcp:remote-port" ***/
/*** BETA ***/
static char s_remoteport[] = MOD "remote-port";
static SCM p_remoteport(SCM hdr)
{
  tcpobj *tcp;
  ASSERT(ITCPP(hdr), hdr, ARG1, s_remoteip);
  tcp = (tcpobj *)CDR(hdr);
  ASSERT(tcp->state && tcp->fd, hdr, ARG1, s_remoteip);
  return MAKINUM(ntohs(tcp->info.sin_port));
}

/*** "tcp:tcp?" ***/
/*** BETA ***/
static char s_istcp[] = MOD "tcp?";
static SCM p_istcp(SCM obj)
{
  return ITCPP(obj) ? BOOL_T : BOOL_F;
}

/****************************/
/* listener smob definition */
/****************************/

static smobfuns tcplsnr =
{
  mark0,    /* no storage allocated to mark */
  free0,    /* or free */
  prinlsnr, /* custom print */
  0         /* no two listeners can be the same */
};

/***********************/
/* tcp ptob definition */
/***********************/

typedef int (*iFtype)P((FILE *));
typedef int (*iiFtype)P((int, FILE *));
typedef int (*icFtype)P((char *, FILE *));
typedef size_t (*scssFtype)P((char *, size_t, size_t, FILE *));

static ptobfuns tcpport =
/* NOTE: these functions all report success, but may set errno if there was an
 * error; if SCM changes to actually test that the values are correct, this
 * should be fixed-- right now errno is the deciding factor */
{
  mark0,       /* no SCM-servicable parts */
  (iFtype) freetcp,  /* custom free parts */
  printcp,           /* custom print */
  0,          /* no two tcps are the same */
  (iiFtype)outcpc,
  (icFtype)outcps,
  (scssFtype)outcpwr,
  (iFtype)outcpfl,
  (iFtype)intcpc,
  (iFtype)tcpclose
};

/***********************/
/* SCM procedure lists */
/***********************/

#define PROCIFY(pname) {s_ ## pname, p_ ## pname},
#define DONE {0, 0} 

static iproc procs0[] =
{
  PROCIFY(mtread)
  PROCIFY(mtsent)
  DONE
};

static iproc procs1[] =
{
  PROCIFY(connected)
  PROCIFY(close_lsnr)
  PROCIFY(bufchars)
  PROCIFY(rdcount)
  PROCIFY(destroy)
  PROCIFY(heard)
  PROCIFY(accept)
  PROCIFY(istcp)
  PROCIFY(islsnr)
  PROCIFY(remoteip)
  PROCIFY(remoteport)
  PROCIFY(localip)
  PROCIFY(localport)
  PROCIFY(donewr)
  PROCIFY(refused)
  PROCIFY(error)
  PROCIFY(mpread)
  PROCIFY(mpsent)
  DONE
};

static iproc procs2[] =
{
  PROCIFY(connect)
  PROCIFY(connect_nb)
  DONE
};

static iproc procs1o1[] =
{
  PROCIFY(listen)
  DONE
};
  
void init_tcp()
{
  tc16_tcplsnr = newsmob(&tcplsnr);
  tc16_tcp = newptob(&tcpport);
  
  init_iprocs(procs0, tc7_subr_0);
  init_iprocs(procs1, tc7_subr_1);
  init_iprocs(procs2, tc7_subr_2);
  init_iprocs(procs1o1, tc7_subr_2o);

  add_feature("tcp");
}


