/* tclTCP.c --
 *
 * 	This file provides basic capabilities to establish a server,
 * attached to a TCP/IP port, that attaches to a Tcl interpreter.
 * Such servers provide a remote-procedure-call mechanism for Tcl
 * without needing to resort to Tk's X-window-based complexities, and
 * also allow access to services that are not bound to any particular
 * display.
 */

/*
 * Copyright (C) 1992...1994 Parallelograms, P. O. Box AA, Pasadena,
 * CA 91102.  All rights reserved.
 * 
 * Permission to use, copy, modify, and distribute this software and its
 * documentation for any purpose and without fee is hereby granted,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear in
 * supporting documentation, and that the name of PARALLELOGRAMS IS CITED
 * IN ALL ADVERTISING OR PUBLICITY PERTAINING TO DISTRIBUTION OF THE SOFTWARE.
 * Parallelograms makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without express or
 * implied warranty.
 */

/*
  "Copyright (C) 1992 General Electric. All rights reserved."		;
*/

/*
 *   Permission to use, copy, modify, and distribute this
 *   software and its documentation for any purpose and without
 *   fee is hereby granted, provided that the above copyright
 *   notice appear in all copies and that both that copyright
 *   notice and this permission notice appear in supporting
 *   documentation, and that the name of General Electric not be used in
 *   advertising or publicity pertaining to distribution of the
 *   software without specific, written prior permission.
 *   General Electric makes no representations about the suitability of
 *   this software for any purpose.  It is provided "as is"
 *   without express or implied warranty.
 *
 *   This work was supported by the DARPA Initiative in Concurrent
 *   Engineering (DICE) through DARPA Contract MDA972-88-C-0047.
 */

#include "tclInt.h"
#include "tclUnix.h"

#define Ckstrdup(x) strcpy((char *) ckalloc(strlen(x)+1), x)
#define Ckrealloc(x,y) ((x) ? ckrealloc(x,y) : ckalloc(y))

#if defined _AIX
#include <sys/select.h>
#include <time.h>
#endif
#if defined ksr
#include <sys/select.h>
#include <sys/time.h>
#endif /* ksr */
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
#include <arpa/inet.h>

/* Only some copies of netinet/in.h have the following defined. */

#ifndef INADDR_LOOPBACK
#ifdef __STDC__
#define INADDR_LOOPBACK 0x7f000001UL
#else
#define INADDR_LOOPBACK (unsigned long) 0x7f000001L
#endif /* __STDC__ */
#endif /* INADDR_LOOPBACK */

#include "tclTCP.h"
#include "simpleEvent.h"


/* Configuration parameters */

/*
 * TCP_LISTEN_BACKLOG gives the maximum backlog of connection requests
 * that may be queued for any server
 */

#define TCP_LISTEN_BACKLOG 3

/* Internal data structures */

/*
 * For each server that is established in any interpreter, there's a
 * record of the following type.  Note that only one server may be
 * running at a time in any interpreter, unless the Tk services are
 * available for event management.
 */

typedef struct tcp_ServerData {
  Tcl_Interp *		interp;	/* Interpreter in which connections */
				/* are processed. */
  char			name[ 16 ];
				/* Name of the server object. */
  int			socketfd;
				/* Filedescriptor of the socket at */
				/* which the server listens for connections */
  char *		command;
				/* Command to be executed (using */
				/* Tcl_Eval) when a connection request */
				/* arrives. */
  int			stopFlag;
				/* Flag == TRUE if the server is trying */
  				/* to shut down. */
  struct tcp_ClientData * firstClient;
				/* First in the list of clients at this */
				/* server */
  struct tcp_ServerData * next, * prev;
				/* Linkage in the list of all active servers */
} Tcp_ServerData;

/*
 * Each client of a server will have a record of the following type.
 */

typedef struct tcp_ClientData {
  struct tcp_ServerData * server;
				/* Server to which the client belongs */
  char			name [16];
				/* Name of the client */
  int			doNotClose; /* Used by tcpClientToConn - closes client
				     * without shutting down connection */
  int			socketfd;
				/* Filedescriptor of the socket of the */
				/* the client's connection. */
  struct sockaddr_in	peeraddr;
				/* IP address from which the client */
				/* established the connection. */
  char *		command;
				/* Command to execute when the client */
				/* sends a message */
  Tcl_DString		inputBuffer;
				/* Buffer where client commands are stored */
  char *		resultString;
				/* Result of executing a command on the */
				/* client */
  char *		resultPointer;
				/* Pointer to the portion of resultString */
				/* that remains to be transmitted back */
				/* to the client */
  int			activeFlag;
				/* Flag == 1 iff a command is pending on */
				/* this client. */
  int			closeFlag;
				/* Flag == 1 if the client should be closed */
				/* once its result has been returned. */
  struct tcp_ClientData *next, *prev;
				/* Next and previous entries in the list of */
				/* clients at this server */
} Tcp_ClientData;

/*
 * Each connection object on the client has a record of the following type.
 */
typedef struct Tcp_ConnectionObject {
  Tcl_Interp   *interp;
  int		f;		/* File descriptor for the socket connection */
  int		pid;		/* Process id of server if it is a child (-1 if not) */
  char	        name[24];	/* Name of this connection object - used to clean out
				 * tcp_greeting */
} Tcp_ConnectionObject;


/* Structure associated with events created by tcp timer command */
typedef struct {
  Tcl_Interp *interp;
  int repeat;		/* Indicates whether this event should be repeated */
  struct timeval interval; /* Interval between successive command invocations */
  struct timeval time;	/* Duplicate of that in simpleTimerQueue, but necessary since
			 * invoked procs don't have access to that data */
			/* Eventually add extra structure for cron type specifications */
  char *command;	/* Arbitrary command together with all its args */
  Tcp_ClientData *client; /* Associated tcp client (NULL if detached) */
  int  *donePtr;	/* Used if treating 'tcp timer after' as a simple sleep */
}   Tcp_TimerEvent;

/* Static variables in this file */

static Tcp_ClientData * tcpCurrentClient = NULL;
				/* Pointer to the client for which a */
				/* command is being processed. (either from TCP connection
				 * or for a timer event registered to that client */
static Tcp_ServerData * tcpFirstServer = NULL;
				/* Pointer to the first in a list of */
				/* servers active in the current process. */

/* Declarations for static functions within this file. */

static int
tcpTimerCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			     int argc, char * * argv));

static int
tcpTimerAfterCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				  int argc, char * * argv));

static int
tcpTimerVariableCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				     int argc, char * * argv));

static int
tcpClientCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			      int argc, char * * argv));

static int
tcpConnectCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			      int argc, char * * argv));

static int
tcpEvalCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			    int argc, char * * argv));

static int
tcpInetdCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			     int argc, char * * argv));

static int
tcpLoginCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			     int argc, char * * argv));

static int
tcpMainLoopCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				int argc, char * * argv));

static int
tcpPollCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			    int argc, char * * argv));

static int
tcpServerCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			      int argc, char * * argv));

static int
tcpServersCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			      int argc, char * * argv));

static int
tcpShutdownCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				int argc, char * * argv));

static int
tcpSpawnServerCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			      int argc, char * * argv));

static int
tcpWaitCommand _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
			     int argc, char * * argv));

static int
tcpServerObjectCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				int argc, char * * argv));
static void
deleteTcpServerObjectCmd _ANSI_ARGS_((ClientData clientData));

static int
tcpServerObjectAcceptCmd _ANSI_ARGS_((ClientData clientData,
				      Tcl_Interp * interp, int argc,
				      char * * argv));

static int
tcpServerObjectClientsCmd _ANSI_ARGS_((ClientData clientData,
				       Tcl_Interp * interp, int argc,
				       char * * argv));

static int
tcpServerObjectConfigCmd _ANSI_ARGS_((ClientData clientData,
				      Tcl_Interp * interp, int argc,
				      char * * argv));

static int
tcpServerObjectStartCmd _ANSI_ARGS_((ClientData clientData,
				     Tcl_Interp * interp, int argc,
				     char * * argv));

static int
tcpServerObjectStopCmd _ANSI_ARGS_((ClientData clientData,
				    Tcl_Interp * interp, int argc,
				    char * * argv));

static void
tcpDeleteServer _ANSI_ARGS_((Tcp_ServerData * server));

static int
tcpServerObjectConfig _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				   int argc, char * * argv));

static int
tcpClientObjectCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp,
				int argc, char * * argv));

static int
tcpClientObjectCloseCmd _ANSI_ARGS_((ClientData clientData,
				     Tcl_Interp * interp,
				     int argc, char * * argv));

static int
tcpClientObjectCommandCmd _ANSI_ARGS_((ClientData clientData,
				       Tcl_Interp * interp,
				       int argc, char * * argv));

static int
tcpClientDoit _ANSI_ARGS_((Tcp_ClientData * client, Tcl_Interp * interp,
			   char *command, int logout));

static Tcp_ClientData *
tcpDupClient _ANSI_ARGS_((Tcl_Interp *interp, int fd, char *command));

static int
tcpClientObjectHostnameCmd _ANSI_ARGS_((ClientData clientData,
					Tcl_Interp * interp,
					int argc, char * * argv));

static int
tcpClientObjectPrivilegedCmd _ANSI_ARGS_((ClientData clientData,
					  Tcl_Interp * interp,
					  int argc, char * * argv));

static int
tcpClientObjectServerCmd _ANSI_ARGS_((ClientData clientData,
				      Tcl_Interp * interp,
				      int argc, char * * argv));

static void
deleteTcpClientObjectCmd _ANSI_ARGS_((ClientData clientData));

static int
tcpConnectionObjectCmd _ANSI_ARGS_((ClientData clientData,
				    Tcl_Interp * interp,
				    int argc, char * * argv));

static int
tcpConnectionObjectCloseCmd _ANSI_ARGS_((ClientData clientData,
					 Tcl_Interp * interp,
					 int argc, char * * argv));

static int
tcpConnectionObjectHostnameCmd _ANSI_ARGS_((ClientData clientData,
					    Tcl_Interp * interp,
					    int argc, char * * argv));

static int
tcpConnectionObjectSendCmd _ANSI_ARGS_((ClientData clientData,
					Tcl_Interp * interp,
					int argc, char * * argv));

static void
deleteTcpConnectionObjectCmd _ANSI_ARGS_((ClientData clientData));

static void
tcpServerAcceptConnection _ANSI_ARGS_((ClientData clientData, int mask));

static void
tcpReturnResultToClient _ANSI_ARGS_((Tcp_ClientData * client,
				     Tcl_Interp * interp,
				     int status, int closeflag));

static void
tcpWriteResultToClient _ANSI_ARGS_((ClientData clientData, int mask));

static void
tcpClientReadError _ANSI_ARGS_((Tcp_ClientData * client));

static void
tcpClientWriteError _ANSI_ARGS_((Tcp_ClientData * client));

static void
tcpPrepareClientForInput _ANSI_ARGS_((Tcp_ClientData * client));

static void
tcpReceiveClientInput _ANSI_ARGS_((ClientData clientData, int mask));

static void
tcpCloseClient _ANSI_ARGS_((Tcp_ClientData * client));

int
tcpTrustedHost _ANSI_ARGS_((char * hostname));

static int
tcpReceiveResultFromServer _ANSI_ARGS_((Tcl_Interp * interp, Tcp_ConnectionObject *conobj));

static int tcpCompareTimerClient _ANSI_ARGS_((ClientData c1, ClientData c2));
static int tcpCompareTimerCommand _ANSI_ARGS_((ClientData c1, ClientData c2));
static int tcpCompareTimerEvent _ANSI_ARGS_((ClientData c1, ClientData c2));

static void tcpDeleteTimerEvent _ANSI_ARGS_((ClientData clientData));

static char *tcpPrintTimerEvent _ANSI_ARGS_((ClientData clientData));

static void tcpTimerEventProc _ANSI_ARGS_((ClientData clientData));

static int tcpGetPortNumber _ANSI_ARGS_((Tcl_Interp *interp, char *portName, int *portNumber));

/* tcpGetPortNumber --
 *
 *	Convert a user specified port number in a network correct int ordering.
 * If the first character of the port number is a string, try it as a service name.
 */

static int
tcpGetPortNumber (interp, portName, portNumber)
     Tcl_Interp * interp;
     char *portName;
     int *portNumber;
{
  int status;
  struct servent *service;

  if (!isalpha(portName[0])) {
    status = Tcl_GetInt (interp, portName, portNumber);
    if (status != TCL_OK)
      return status;
    *portNumber = htonl(*portNumber);
    return TCL_OK;
  } else {
    service = getservbyname(portName, "tcp");
    if (!service) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "unknown service name \"", portName,
		       "\": ", Tcl_PosixError(interp), (char *)NULL);
      return TCL_ERROR;
    }
    *portNumber = service->s_port;
    return TCL_OK;
  }
}


static int restricted;
/*
 *----------------------------------------------------------------------
 * tcpCommand:
 *
 * This procedure implements a `tcp' command for Tcl.  It provides the
 * top-level actions for TCP/IP connections.
 *
 * This command is divided into variants, each with its own procedure:
 *
 *	tcp client
 *		Returns the current active client, or an error if there is
 *		none.
 *	tcp connect host port
 *		Establish a connection to a server running at `port' on
 *		`host.'
 *	tcp eval client command
 *		Do default command processing for command "$command",
 *		originating at client "$client".
 *	tcp inetd 'login cmd'
 *		Used to create a channel on stdin/out. This is typically
 *		a command argument provided to clients started by inetd.
 *	tcp login client
 *		Do default login processing for $client.
 *	tcp mainloop
 *		Start the main loop for a server or group of servers.
 *	tcp poll
 *		Poll for whether servers have work to do.
 *	tcp restrict
 *		Used in sensitive (e.g. running as root servers). Restricts the
 *		available tcp command services to client, eval, login,
 *		mainloop, poll, servers, timer and wait.
 *	tcp shutdown
 *		Shuts down all servers
 *	tcp servers
 *		Returns a list of the currently active servers.
 *	tcp server ?args?
 *		Set up a server to run in the current interpreter.
 *	tcp spawnserver 'server cmd'
 *		Returns a connection object to a process created with
 *		the UNIX command 'server cmd'.
 *	tcp timer after/cancel/delete/list - Eventually add at for cron stuff.
 *		Create asynchronous timer events a la TK after.
 *	tcp wait
 *		Wait for a server to have work to do.
 *----------------------------------------------------------------------
 */

int
tcpCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  char c;
  unsigned length;

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [0],
		      " command ?args?\"", (char *) NULL);
    return TCL_ERROR;
  }

  c = argv [1] [0];
  length = strlen (argv [1]);

  if ((c == 'c') && (strcmp (argv [1], "client") == 0)) {
    return tcpClientCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 'e') && (strncmp (argv [1], "eval", length) == 0)) {
    return tcpEvalCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 'l') && (strncmp (argv [1], "login", length) == 0)) {
    return tcpLoginCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 'm') && (strncmp (argv [1], "mainloop", length) == 0)) {
    return tcpMainLoopCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 'p') && (strncmp (argv [1], "poll", length) == 0)) {
    return tcpPollCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 'r') && (strncmp (argv [1], "restrict", length) == 0)) {
    /* Let ourselves get restricted multiple times (doesn't hurt) */
    restricted = 1;
    return TCL_OK;
  }
  if ((c == 's') && (strcmp (argv [1], "servers") == 0)) { /* Must have exact match (otherwise server! */
    return tcpServersCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 's') && (length >= 2) &&
      (strncmp (argv [1], "shutdown", length) == 0)) {
    return tcpShutdownCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 't') && (strncmp (argv [1], "timer", length) == 0)) {
    return tcpTimerCommand (clientData, interp, argc-1, argv+1);
  }
  if ((c == 'w') && (strncmp (argv [1], "wait", length) == 0)) {
    return tcpWaitCommand (clientData, interp, argc-1, argv+1);
  }
  if (restricted) {
    Tcl_AppendResult (interp, "bad option \"", argv [1],
		      "\": should be client, eval, login,",
		      " mainloop, poll, restrict, servers, shutdown, timer or wait", (char *) NULL);
  } else {
    if ((c == 'c') && (length >= 2) &&
	(strncmp (argv [1], "connect", length) == 0)) {
      return tcpConnectCommand (clientData, interp, argc-1, argv+1);
    }
    if ((c == 'i') && (strncmp (argv [1], "inetd", length) == 0)) {
      return tcpInetdCommand (clientData, interp, argc-1, argv+1);
    }
    if ((c == 's') && (strncmp (argv [1], "server", length) == 0)) {
      return tcpServerCommand (clientData, interp, argc-1, argv+1);
    }
    if ((c == 's') && (length >= 2) &&
	(strncmp (argv [1], "spawnserver", length) == 0)) {
      return tcpSpawnServerCommand (clientData, interp, argc-1, argv+1);
    }
    Tcl_AppendResult (interp, "bad option \"", argv [1],
		      "\": should be client, connect, eval, login,",
		      " mainloop, poll, restrict, servers, server, shutdown, spawnserver, timer or wait",
		      (char *) NULL);
  }
  return TCL_ERROR;
}

/*
 * tcpTimerCommand --
 *
 *	This procedure is invoked to process the "tcp timer" Tcl command.
 * It is modelled after the tk after command to support requesting events to be
 * triggered after a specified number of milliseconds. It is more general in that
 * it supports periodicaly repeating events, together with pending event deletion/
 * listing by command, together with the ability to register events with tcp clients.
 */
static int CancelCurrentTimerEvent;   /* Used to implement the tcp timer cancel command */

/* ARGSUSED */
static int
tcpTimerCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  char c;
  unsigned length;
  enum { TimerCancel, TimerDelete, TimerList } action;
  Tcp_TimerEvent tEvent;

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv[0], " command ?args?\"", (char *) NULL);
    return TCL_ERROR;
  }

  c = argv[1][0];
  length = strlen(argv[1]);

  if ((c == 'a') && !strncmp(argv[1], "after", length))
    return tcpTimerAfterCommand(clientData, interp, argc-1, argv+1);
  else if ((c == 'c') && !strncmp(argv[1], "cancel", length))
    action = TimerCancel;
  else if ((c == 'd') && !strncmp(argv[1], "delete", length))
    action = TimerDelete;
  else if ((c == 'l') && !strncmp(argv[1], "list", length))
    action = TimerList;
  else if ((c == 'v') && !strncmp(argv[1], "variable", length))
    return tcpTimerVariableCommand(clientData, interp, argc-1, argv+1);
  else {
    Tcl_AppendResult (interp, argv[-1], " ", argv[0], ": unknown command \"", argv[1],
		      "\": should be \"after, cancel, delete, list or variable\"", (char *) NULL);
    return TCL_ERROR;
  }

  switch (action) {
  case TimerCancel:
    CancelCurrentTimerEvent = 1;
    return TCL_OK;
    break;
  case TimerDelete:
  case TimerList:
    tEvent.command = argc-2 ? Tcl_Concat(argc-2, argv+2) : NULL;
    /* Only work with events that are bound to the current client (or detached if no current client) */
    tEvent.client = tcpCurrentClient;

    /* Note tcpCompareTimerCommand compares both command and client */
    if (action == TimerList) {
      char *res;
      res = simpleListTimerHandler(tcpTimerEventProc, (ClientData) &tEvent,
				   tcpCompareTimerCommand, tcpPrintTimerEvent);
      Tcl_SetResult(interp, res, TCL_DYNAMIC);
    } else
      simpleDeleteTimerHandler(tcpTimerEventProc, (ClientData) &tEvent,
			       tcpCompareTimerCommand, tcpDeleteTimerEvent);
    return TCL_OK;
    break;
  }
  abort();
}  

/*
 * tcpTimerAfterCommand --
 *
 *	This procedure is invoked to process the "tcp timer after" Tcl command.
 * It is modelled after the tk after command to support requesting events to be
 * triggered after a specified number of milliseconds. It is more general in that
 * it supports periodicaly repeating events, together with pending event deletion/
 * listing by command, together with the ability to register events with tcp clients.
 */
/* ARGSUSED */
static int
tcpTimerAfterCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  int status, length;
  char **newArgv;
  Tcp_TimerEvent *tEventPtr;
  int detached = 0, immediate = 0, repeat = 0, synchronize = 0;
  int ms, sleepDone;
  enum { SyncSecond, SyncMinute, SyncHour, SyncDay } syncType;

  if (argc < 2)
    goto Usage;

  for (newArgv = argv + 1, argc--; argc && **newArgv == '-'; argc--, newArgv++) {
    length = strlen(*newArgv);
    if (!strncmp(*newArgv, "-detached", length)) {
      detached = 1;
      if (restricted) {
	Tcl_AppendResult(interp, argv[-1], " ", argv[0], ": -detached option is not permitted for restricted servers",
			 (char *) NULL);
	return TCL_ERROR;
      }
    } else if (!strncmp(*newArgv, "-immediate", length))
      immediate = 1;
    else if (!strncmp(*newArgv, "-repeat", length))
      repeat = 1;
    else if (!strncmp(*newArgv, "-synchronize", length)) {
      synchronize = 1;
      newArgv++;
      length = strlen(*newArgv);
      if (!strncmp(*newArgv, "second", length))
	syncType = SyncSecond;
      else if (!strncmp(*newArgv, "minute", length))
	syncType = SyncMinute;
      else if (!strncmp(*newArgv, "hour", length))
	syncType = SyncHour;
      else if (!strncmp(*newArgv, "day", length))
	syncType = SyncDay;
      else {
	Tcl_AppendResult(interp, "unknown synchronization type: \"", newArgv[0],
			 "\", should be \"day, hour, minute or second\"", (char *) NULL);
	return TCL_ERROR;
      }
    } else {
      Tcl_AppendResult(interp, "unknown modifier: \"", newArgv[0],
		       "\", should be \"-detached, -immediate, -repeat or -synchronize\"", (char *) NULL);
      return TCL_ERROR;
    }
  }

  if (!argc)
  /* Need at least the ms spec */
    goto Usage;

  if ((Tcl_GetInt(interp, newArgv[0], &ms) != TCL_OK) || (ms < 0)) {
    Tcl_AppendResult(interp, "; bad milliseconds value \"",
		     newArgv[0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  if (argc == 1 && repeat) {
    Tcl_AppendResult(interp, "may only specify -repeat if a command is given", (char *) NULL);
    return TCL_ERROR;
  }

  if (!ms && repeat) {
    Tcl_AppendResult(interp, "may not specify -repeat with a zero repeat interval", (char *) NULL);
    return TCL_ERROR;
  }

  if (immediate && !repeat) {
    Tcl_AppendResult(interp, "may only specify -immediate with -repeat option", (char *) NULL);
    return TCL_ERROR;
  }

  if (immediate && synchronize) {
    Tcl_AppendResult(interp, "may only specify one of -immediate and -synchronize options", (char *) NULL);
    return TCL_ERROR;
  }

  tEventPtr = (Tcp_TimerEvent *) ckalloc(sizeof(Tcp_TimerEvent));
  tEventPtr->interp = interp;
  tEventPtr->repeat = repeat;
  if (repeat) {
    tEventPtr->interval.tv_sec = ms/1000;
    tEventPtr->interval.tv_usec = (ms%1000)*1000;
  }

  if (synchronize) {
    /*
     * Desire to synchronize on next second, minute, etc.
     * We compute a modified initial interval (ms)
     */
    struct tm *curTime;

    (void) gettimeofday(&tEventPtr->time, (struct timezone *) NULL);
    curTime = localtime(&tEventPtr->time.tv_sec);

    ms = 0;
    /*
     * Note since day needs sync'ed hour and hour needs sync'ed min, etc.
     * we can reuse the code.
     * Note the minus one stuff. That is because we will also round
     * up the lower unit (e.g. hour) to the next one.
     */
    switch (syncType) {
    case SyncDay:
      ms += 1000 * 3600 * (24 - 1 - curTime->tm_hour);
    case SyncHour:
      ms += 1000 * 60 * (60 - 1 - curTime->tm_min);
    case SyncMinute:
      ms += 1000 * (60 - 1 - curTime->tm_sec);
    case SyncSecond:
      ms += (1000000 - tEventPtr->time.tv_usec) / 1000;
      break;
    }
  }

  if (repeat) {
    /* Only need to know desired exec time if need to then add subseq events */
    (void) gettimeofday(&tEventPtr->time, (struct timezone *) NULL);
    if (!immediate) {
      tEventPtr->time.tv_sec += ms/1000;
      tEventPtr->time.tv_usec += (ms%1000)*1000;
      if (tEventPtr->time.tv_usec > 1000000) {
	tEventPtr->time.tv_usec -= 1000000;
	tEventPtr->time.tv_sec += 1;
      }
    }
  }

  /* Specifies the client that this event is attached to if any */
  tEventPtr->client = detached ? NULL : tcpCurrentClient;

  if (argc-1) {
    tEventPtr->command = Tcl_Concat(argc-1, newArgv+1);
    tEventPtr->donePtr = NULL;
  } else {
    sleepDone = 0;
    tEventPtr->command = NULL;
    tEventPtr->donePtr = &sleepDone;
  }

  simpleCreateTimerHandler(immediate ? 0 : ms, tcpTimerEventProc,
			   (ClientData) tEventPtr, NULL);

  if (!(argc-1)) {
    /* Sleep command - stay here processing events until get error or complete sleep */
    do {
      status = simpleSelect (interp, SIMPLE_WAIT | SIMPLE_DO_EVENTS);
    } while (status >= 0 && !sleepDone);
      
    if (status == -1 && errno != 0) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult (interp, "select: ", Tcl_PosixError (interp), (char *) NULL);
      return TCL_ERROR;
    }
  }

  return TCL_OK;

 Usage:
  Tcl_AppendResult (interp, "wrong # args: should be \"",
		    " ?-detached? ?-immediate? ?-repeat? ?-synchronize type? ms ?cmd ...?\"", (char *) NULL);
  return TCL_ERROR;
}  

/*
 * tcpTimerVariableCommand --
 *
 * This procedure is invoked to process the "tcp timer variable" Tcl command.
 * It remains until a particular variable has been deleted
 * (or the timeout expires)
 */
/* ARGSUSED */
static int
tcpTimerVariableCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  int detached = 0;  /* NOTE:  JNH check this - it was undefined */
  int status;
  Tcp_TimerEvent *tEventPtr;
  int ms, sleepDone, varExists;
  enum { SyncSecond, SyncMinute, SyncHour, SyncDay } syncType;

  if (argc < 2 || argc > 3) {
    Tcl_AppendResult (interp, "wrong # args: should be \"",
		      argv[-2], " ", argv[-1], " ", argv[0],
		      " varName ?ms?", (char *) NULL);
    return TCL_ERROR;
  }

  /*
   * Check that the variable initially exists!
   */
  if (!Tcl_GetVar(interp, argv[1], 0)) {
    Tcl_AppendResult (interp, argv[-2], " ", argv[-1], " ", argv[0],
		      ": No such variable \"", argv[1], "\"",
		      (char *) NULL);
    return TCL_ERROR;
  }

  if (argc == 3) {
    /*
     * We have a timeout - so create a event handler that
     * will set sleepDone to 1 when it is triggered
     */
    if ((Tcl_GetInt(interp, argv[2], &ms) != TCL_OK) || (ms < 0)) {
      Tcl_AppendResult(interp, "; bad milliseconds value \"",
		       argv[2], "\"", (char *) NULL);
      return TCL_ERROR;
    }

    tEventPtr = (Tcp_TimerEvent *) ckalloc(sizeof(Tcp_TimerEvent));
    tEventPtr->interp = interp;
    tEventPtr->repeat = 0;

    /* Specifies the client that this event is attached to if any */
    tEventPtr->client = detached ? NULL : tcpCurrentClient;

    tEventPtr->command = NULL;
    tEventPtr->donePtr = &sleepDone;

    simpleCreateTimerHandler(ms, tcpTimerEventProc,
			     (ClientData) tEventPtr, NULL);
  }

  sleepDone = 0;

  do {
    status = simpleSelect(interp, SIMPLE_WAIT | SIMPLE_DO_EVENTS);
    varExists = Tcl_GetVar(interp, argv[1], 0) ? 1 : 0;
  } while (varExists && status >= 0 && !sleepDone);
      
  if (status == -1) {
    if (errno != 0) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult (interp, "select: ", Tcl_PosixError (interp), (char *) NULL);
      return TCL_ERROR;
    } else {
      Tcl_ResetResult(interp);
      Tcl_AppendResult (interp, "no more select events", (char *) NULL);
      return TCL_ERROR;
    }
  }

  if (varExists) {
    /* Variable still exists after timeout */
    Tcl_ResetResult(interp);
    Tcl_AppendResult (interp, argv[-2], " ", argv[-1], " ", argv[0],
		      ": Variable still exists", (char *) NULL);
    return TCL_ERROR;
  } else if (argc == 3 && !sleepDone) {
    /* Need to delete event handler - Compare on actual pointer value */
    simpleDeleteTimerHandler(tcpTimerEventProc, (ClientData) tEventPtr,
			     tcpCompareTimerEvent, tcpDeleteTimerEvent);
  }

  return TCL_OK;
}  

/*
 * tcpClientCommand --
 *
 *	This procedure is invoked to process the "tcp client" Tcl command.
 * It returns the name of the currently-active client, or an error if there
 * is none.
 */

/* ARGSUSED */
static int
tcpClientCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  /* Check syntax */

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Make sure there is a current client */

  if (tcpCurrentClient == NULL) {
    Tcl_SetResult (interp, "no current client", TCL_STATIC);
    return TCL_ERROR;
  }

  Tcl_SetResult (interp, tcpCurrentClient->name, TCL_STATIC);
  return TCL_OK;
}

/* tcpConnectCommand --
 *
 *	This procedure is invoked to process the "tcp connect" Tcl command.
 * It takes two arguments: a host name and a port.  It tries to establish a
 * connection to the specified port and host.
 */

/* ARGSUSED */
static int
tcpConnectCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  struct hostent * host;
  struct sockaddr_in sockaddr;
  int haddr;
  int port;
  int status;
  int f;
  int privileged = 0;
  Tcp_ConnectionObject *conobj;

  /* Check syntax */

  if (argc != 3 && argc != 4) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], " ?-privileged? hostname port\"", (char *) NULL);
    return TCL_ERROR;
  }

  if (argc == 4)
    if (!strcmp(argv[1], "-privileged")) {
      if (geteuid()) {
	Tcl_AppendResult(interp, "privileged connections are only permitted to root users",
			 (char *) NULL);
	return TCL_ERROR;
      }
      privileged = 1;
      argv++;
    } else {
      Tcl_AppendResult(interp, "invalid arg: \"", argv[1], "\"; should be \"", argv [-1], " ",
		      argv [0], " ?-privileged? hostname port\"", (char *) NULL);
      return TCL_ERROR;
    }

  /* Decode the host name */

  sockaddr.sin_family = AF_INET;
  host = gethostbyname (argv [1]);
  if (host != NULL) {
    memcpy ((char *) &(sockaddr.sin_addr.s_addr),
	    (char *) (host -> h_addr_list [0]),
	    (size_t) (host -> h_length));
  } else {
    haddr = inet_addr (argv [1]);
    if (haddr == -1) {
      Tcl_AppendResult (interp, argv[1], ": host unknown", (char *) NULL);
      return TCL_ERROR;
    }
    sockaddr.sin_addr.s_addr = haddr;
  }

  /* Decode the port number */

  status = tcpGetPortNumber (interp, argv [2], &port);
  if (status != TCL_OK) return status;
  sockaddr.sin_port = port;

  /* Make a socket to talk to the server */

  f = socket (AF_INET, SOCK_STREAM, 0);
  if (f < 0) {
    Tcl_AppendResult (interp, "can't create socket: ",
		      Tcl_PosixError (interp), (char *) NULL);
    return TCL_ERROR;
  }

  if (privileged) {
    /* attempt to bind client socket to a reserved port */
    int not_bound;
    int curport = 512;
    struct sockaddr_in clientaddr;

    clientaddr.sin_family = AF_INET;
    clientaddr.sin_addr.s_addr = INADDR_ANY;
    clientaddr.sin_port = htonl(curport);

    while (curport < IPPORT_RESERVED &&
	   (not_bound =
	    bind(f, &clientaddr, sizeof(struct sockaddr_in)))) {
      clientaddr.sin_port = htonl(curport);
      curport++;
    }

    if (not_bound) {
      Tcl_AppendResult(interp, "can't find reserved port: ",
		       Tcl_PosixError(interp), (char *)NULL);
      (void)close(f);
      return TCL_ERROR;
    }
  }

  /* Connect to the server */

  status = connect (f, (struct sockaddr *) &sockaddr, sizeof sockaddr);
  if (status < 0) {
    Tcl_AppendResult (interp, "can't connect to server: ",
		      Tcl_PosixError (interp), (char *) NULL);
    (void) close (f);
    return TCL_ERROR;
  }

  /* Get the server's greeting message */
  conobj = (Tcp_ConnectionObject *) ckalloc(sizeof (Tcp_ConnectionObject));
  conobj -> interp = interp;
  conobj -> f = f;
  conobj -> pid = -1;
  sprintf(conobj->name, "tcp_connection_%d", f);

  status = tcpReceiveResultFromServer (interp, conobj);

  if (status == TCL_OK) {

    /* Stash the greeting, make the connection object and return it. */
    (void) Tcl_SetVar2 (interp, "tcp_greeting", conobj->name,
			interp->result, TCL_GLOBAL_ONLY);
    Tcl_CreateCommand (interp, conobj->name, tcpConnectionObjectCmd,
		       (ClientData) conobj, deleteTcpConnectionObjectCmd);
    Tcl_SetResult (interp, conobj->name, TCL_STATIC);
    return TCL_OK;
  } else {

    /* Error reading greeting, quit */
    deleteTcpConnectionObjectCmd((ClientData) conobj);
    return TCL_ERROR;
  }
}    

/*
 * tcpEvalCommand --
 *
 *	This procedure is invoked to process the "tcp eval" Tcl command.
 * "tcp eval" is the default command invoked to process connections once
 * a connection has been accepted by "tcp login".
 */

/* ARGSUSED */
static int
tcpEvalCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int status;

  /* Argc == 2 means that we're logging out a client.  Default is to ignore
   * the logout.
   */

  if (argc == 2) {
    return TCL_OK;
  }

  /* Three-argument form is a command from a client.  Default is to eval
   * the command */

  if (argc != 3) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv [0], " client command\"", (char *) NULL);
    return TCL_ERROR;
  }

  status = Tcl_Eval (interp, argv [2]);
  return status;
}  

/* tcpInetdCommand
 *
 *    This procedure is invoked by tcp inetd.
 * It assumes that the server has been started in such a way
 * that stdin/stdout are the connection to the client.
 *
 *    We create a dummy server with the stopFlag set to TRUE
 * so that when the client is killed the server exits also.
 *
 *
 * Syntax:
 *      tcp inetd ?login command?
 *
 * Results:
 *	None
 */

/* ARGSUSED */
static int
tcpInetdCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  Tcp_ClientData *client;
  int status;

  if (argc > 2) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv [0], " ?login command?\"", (char *) NULL);
    return TCL_ERROR;
  }
    
  if (!(client = tcpDupClient(interp, 0,
			      argc == 2 ? argv[1] : "tcp login")))
    return TCL_ERROR;

  /* Execute the login command */
  status = tcpClientDoit(client, interp, NULL, 0);

  /* Client may have been closed at this point.  Don't refer to it again. */
  return status;
}

/* tcpDupClient
 *
 *    This procedure is invoked by tcpInetdCmd and TcpConnectionObjectReverseCmd.
 * It creates a client and server object given a pre-existing
 * connection file descriptor. The server is a dummy object (since
 * there is no server file descriptor).
 */

static Tcp_ClientData *
tcpDupClient (interp, fd, command)
     Tcl_Interp * interp;
     int fd;
     char *command;
{
  register Tcp_ClientData *client;
  Tcp_ServerData *server;
  int unixStatus, size;

  client = (Tcp_ClientData *) ckalloc (sizeof (Tcp_ClientData));
  client -> socketfd = fd; /* stdin */
  client -> doNotClose = 0;

  size = sizeof (struct sockaddr_in);
  client->peeraddr.sin_family = AF_UNIX;
  unixStatus = getpeername(client -> socketfd,
			   (struct sockaddr *) &(client -> peeraddr),
			   &size);
  if (unixStatus < 0) {
    Tcl_AppendResult (interp,
		      "can't get peername on client's socket: ",
		      Tcl_PosixError (interp), (char *) NULL);
    ckfree ((char *) client);
    return NULL;
  }

  /* Create a structure to hold the tcp server's description. */
  server = (Tcp_ServerData *) ckalloc (sizeof (Tcp_ServerData));
  bzero(server, sizeof *server);
  server -> interp = interp;

  server->command = Ckstrdup(command);

  /* Link the server on the list */
  if (tcpFirstServer)
    tcpFirstServer -> prev = server;
  server -> next = tcpFirstServer;
  tcpFirstServer = server;

  server -> stopFlag = 1;
  server -> firstClient = client;
  server -> socketfd = -1;

  client -> server = server;
  sprintf (client -> name, "tcp_client_%d", client -> socketfd);
  client -> command = Ckstrdup(server->command);
  Tcl_DStringInit(&client -> inputBuffer);
  client -> resultString = client -> resultPointer = (char *) NULL;
  client -> activeFlag = 0;
  client -> closeFlag = 0;
  client -> next = NULL;
  client -> prev = NULL;

  /* Create the Tcl command for the client */
  
  Tcl_CreateCommand (interp, client -> name,
		     (Tcl_CmdProc *) tcpClientObjectCmd,
		     (ClientData) client,
		     (Tcl_CmdDeleteProc *) deleteTcpClientObjectCmd);
  return client;
}

/*
 * tcpLoginCommand --
 *
 *	This procedure is invoked to process the "tcp login" Tcl command.
 * It is the default command procedure at initial connection to a server.
 * It is invoked with the name of a client.  It returns TCL_OK, together
 * with a greeting message, if the login succeeds, and TCL_ERROR, together
 * with a denial message, if it fails.
 *
 *	The authentication procedure is as follows:
 *
 * - If the client is on the local host, the connection is accepted.
 * - If the client's IP address is the same as the local host's IP address,
 *   the connection is accepted.
 * - Otherwise, the connection is refused.
 *
 * 	Obviously, there are other authentication techniques.  The use can
 * replace this command with an arbitrary Tcl script.
 */

/*ARGSUSED*/
static int
tcpLoginCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  char * hostName;		/* Name of the client's host */
  int status;

  /* Check command syntax */

  if (argc != 2) {
    Tcl_AppendResult (interp, "wrong # args; should be \"", argv [-1], " ",
		      argv [0], " clientName\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Get the hostname by doing $client hostname */

  status = Tcl_VarEval (interp, argv [1], " hostname", (char *) NULL);
  if (status == TCL_OK) {
    hostName = Ckstrdup(interp -> result);

    /* Check that the host is trusted */
    
    if (tcpTrustedHost (hostName)) {

      /* Change the command to `tcp eval' for next time */

      status = Tcl_VarEval (interp, argv [1], " command {tcp eval}",
			    (char *) NULL);


      if (status == TCL_OK) {

	/* Return a greeting message */

	Tcl_ResetResult (interp);
	Tcl_AppendResult (interp, "Tcl-based server\n", (char *) NULL);

	return TCL_OK;

      }

    }

    ckfree ((char *) hostName);
  }

  /* Host isn't trusted or one of the commands failed. */

  Tcl_SetResult (interp, "Permission denied", TCL_STATIC);
  return TCL_ERROR;
}

/*
 * tcpMainLoopCommand:
 *
 *	This procedure is invoked in a non-Tk environment when the server
 * implementor wishes to use a main loop built into the library.  It
 * repeatedly polls for work to be done, returning only when the last server
 * is closed.
 *
 *	In a Tk environment, the procedure returns immediately.
 */

/*ARGSUSED*/
static int
tcpMainLoopCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  static int MainLoopCnt = 0;
  int status;

  if (MainLoopCnt) {
    Tcl_AppendResult(interp, argv[-1], " ", argv[0], ": recursive call not permitted",
		     (char *) NULL);
    return TCL_ERROR;
  }

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  MainLoopCnt++;
  do {
    status = simpleSelect (interp, SIMPLE_WAIT | SIMPLE_DO_EVENTS);
  } while (status >= 0);
  MainLoopCnt--;

  /* In a non-Tk environment, errno has a Unix error or 0 for no clients
   * or servers.  In a Tk environment, errno is zero at this point.
   */

  if (errno != 0) {
    Tcl_AppendResult (interp, "select: ", Tcl_PosixError (interp),
		      (char *) NULL);
    return TCL_ERROR;
  }

  return TCL_OK;
}


/*
 * tcpPollCommand:
 *
 *	This procedure is invoked to process the "tcp poll" Tcl
 * command.  It requests that pending events for the servers be processed.
 * It returns a count of events that were processed successfully.
 *
 *	In a Tk environment, the procedure reports that no servers are known
 * to the event handler.  This is correct -- servers register with Tk, not
 * with the simple event handler.
 */

/*ARGSUSED*/
static int
tcpPollCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int status;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Do the poll */

  status = simpleSelect (interp, SIMPLE_DO_EVENTS);

  /* Check for trouble */

  if (status < 0) {
    if (errno == 0) {
      Tcl_SetResult (interp, "no servers known to event handler", TCL_STATIC);
    } else {
      Tcl_AppendResult (interp, "select: ", Tcl_PosixError (interp),
			(char *) NULL);
    }
    return TCL_ERROR;
  }

  /* Return the number of events processed. */

  sprintf (interp -> result, "%d", status);
  return TCL_OK;
}

/* tcpServerCommand:
 *
 *	This procedure is invoked to process the "tcp server" Tcl
 * command.  It requests that a server be created to listen at a
 * TCP/IP port, whose number may be assigned by the system or
 * specified by the user with the "-port" option.
 *
 *	A command string is supplied for use when the server begins to
 * accept connections.  See the documentation of tcpServerObjectCmd
 * for a description of the command string.
 *
 *	If the server is created successfully, the return value will
 * be the name of a "server object" that can be used for future
 * actions upon the server.  This object will be usable as a Tcl
 * command; the command is processed by the tcpServerObjectCmd function.
 *
 * Syntax:
 *	tcp server ?-port #? ?-command string?
 * 
 * Results:
 *	A standard Tcl result.  Return value is the name of the server
 *	object, which may be invoked as a Tcl command (see
 *	tcpServerObjectCmd for details).
 */

/* ARGSUSED */
static int
tcpServerCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int unixStatus;
  char * message;
  char * nargv [3];
  int nargc;

  /* Create a structure to hold the tcp server's description. */

  Tcp_ServerData * server =
    (Tcp_ServerData *) ckalloc (sizeof (Tcp_ServerData));

  /* Set up the interpreter and the default command. Clear the list of
   * clients. */

  server -> interp = interp;
  server->command = Ckstrdup("tcp login");
  server -> stopFlag = 0;
  server -> firstClient = (Tcp_ClientData *) NULL;

  /* Create the socket at which the server will listen. */

  server -> socketfd = socket (AF_INET, SOCK_STREAM, 0);
  if (server -> socketfd < 0) {
    Tcl_AppendResult (interp, "can't create socket: ",
		      Tcl_PosixError (interp), (char *) NULL);
  } else {

    /* Server structure has been created and socket has been opened.
     * Now configure the server.
     */

    if (tcpServerObjectConfig ((ClientData) server, interp, argc, argv)
	== TCL_OK) {

      /* Link the server on the list of active servers */

      if (tcpFirstServer)
	tcpFirstServer -> prev = server;
      server -> next = tcpFirstServer;
      tcpFirstServer = server;
      server -> prev = NULL;

      /* Add the server object command */
	  
      sprintf (server -> name, "tcp_server_%d", server -> socketfd);

      Tcl_CreateCommand (interp, server -> name,
			 (Tcl_CmdProc *) tcpServerObjectCmd,
			 (ClientData) server,
			 (Tcl_CmdDeleteProc *) deleteTcpServerObjectCmd);

      Tcl_SetResult (interp, server -> name, TCL_STATIC);
	  
      return TCL_OK;

    }

    /* Error in configuring the server.  Trash the socket. */
    
    unixStatus = close (server -> socketfd);
    if (unixStatus < 0) {
      nargc = 3;
      nargv [0] = "(also failed to close socket: ";
      nargv [1] = Tcl_PosixError (interp);
      nargv [2] = ")";
      message = Tcl_Concat (nargc, nargv);
      Tcl_AddErrorInfo (interp, message);
      ckfree (message);
    }
  }
      
  /* Error in creating the server -- get rid of the data structure */

  ckfree (server->command);
  ckfree ((char *) server);
  return TCL_ERROR;
}

/*
 * tcpServersCommand:
 *
 *	The following procedure is invoked to process the `tcp servers' Tcl
 * command.  It returns a list of the servers that are currently known.
 */

/* ARGSUSED */
static int
tcpServersCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  Tcp_ServerData * server;

  /* Check syntax */

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  for (server = tcpFirstServer; server != NULL; server = server -> next) {
    if (*server->name)
      Tcl_AppendElement (interp, server -> name);
  }

  return TCL_OK;
}

/*
 * tcpShutdownCommand:
 *
 *	The following procedure is invoked to process the `tcp shutdown' Tcl
 * command.  It shuts down all servers. After the last server is shutdown
 * it will purge all remaining detached events.
 */

/* ARGSUSED */
static int
tcpShutdownCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  /* Check syntax */

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  while (tcpFirstServer) {
    if (*tcpFirstServer->name)
      Tcl_DeleteCommand(tcpFirstServer->interp, tcpFirstServer->name);
    else
      deleteTcpServerObjectCmd((ClientData) tcpFirstServer);
  }

  return TCL_OK;
}

/* tcpSpawnServerCommand --
 *
 *	This procedure is invoked to process the "tcp spawnserver" Tcl command.
 * It takes a set of arguments: a UNIX command to execute as the server.
 * This command functions similarly to tcpConnectCommand, except that the server
 * is handled as a child.
 */

/* ARGSUSED */
static int
tcpSpawnServerCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  Tcp_ConnectionObject *conobj;
  int fd[2];
  int f, pid;
  int status;

  /* Check syntax */

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], " server_command ?args?\"", (char *) NULL);
    return TCL_ERROR;
  }

  if (socketpair(AF_UNIX, SOCK_STREAM, 0, fd) == -1) {
    Tcl_AppendResult (interp, "Socketpair call failed: ",
		      Tcl_PosixError (interp), (char *) NULL);
    return TCL_ERROR;
  }

  if ((pid = fork()) == 0) {
    /* Child 
     * 1) Dup half of socket pair to stdin/out
     * 2) close all remaining file descriptors
     * 3) execvp UNIX server command
     */
    int   i, maxfd;
    char *slash, *command;
    Tcl_DString buffer;

    dup2(fd[1], 0);
    dup2(0, 1);
    maxfd = fd[1] > fd[0] ? fd[1] : fd[0];
    for (i = 3; i <= maxfd; i++)
      (void) close(i);

    command = Tcl_TildeSubst(interp, argv[1], &buffer);
    argv[1] = (slash = strrchr(argv[1], '/')) ? slash + 1 : argv[1];
    execvp(command, argv + 1);
    /*
     * Maybe should add a write on unit 1 to print error.
     * Would then have to spruce up check further down on tcpReceiveResult return!
     */
    exit(1);
  } else if (pid == -1) {
    close(fd[0]);
    close(fd[1]);
    Tcl_AppendResult (interp, "Unable to fork: ",
		      Tcl_PosixError (interp), (char *) NULL);
    return TCL_ERROR;
  }

  f = fd[0];
  close(fd[1]);

  conobj = (Tcp_ConnectionObject *) ckalloc(sizeof (Tcp_ConnectionObject));
  conobj->interp = interp;
  conobj->f = f;
  conobj->pid = pid;
  sprintf (conobj->name, "tcp_connection_%d", f);

  /* Get the server's greeting message */
  status = tcpReceiveResultFromServer (interp, conobj);

  if (status == TCL_OK) {

    /* Stash the greeting, make the connection object and return it. */
    (void) Tcl_SetVar2 (interp, "tcp_greeting", conobj->name,
			interp->result, TCL_GLOBAL_ONLY);

    Tcl_CreateCommand (interp, conobj->name, (Tcl_CmdProc *) tcpConnectionObjectCmd,
		       (ClientData) conobj, deleteTcpConnectionObjectCmd);
    Tcl_SetResult (interp, conobj->name, TCL_STATIC);
    return TCL_OK;
  } else {
    char *command;

    /* Error reading greeting, quit */
    deleteTcpConnectionObjectCmd ((ClientData) conobj);

    /* Bit of a kluge */
    if (!strcmp(interp->result, "Connection closed."))
      Tcl_SetResult(interp, "Unable to find command:", TCL_STATIC);

    command = argc == 2 ? Ckstrdup(argv[1]) : Tcl_Merge(argc-1, argv+1);

    Tcl_AppendResult (interp, " (creating server \"", command, "\")", (char *) NULL);
    ckfree(command);

    return TCL_ERROR;
  }
}    

/*
 * tcpWaitCommand:
 *
 *	This procedure is invoked to process the "tcp wait" Tcl
 * command.  It requests that the process delay until an event is
 * pending for a TCP server.
 *
 * It returns a count of pending events.
 *
 *	In a Tk environment, the procedure returns an error message stating
 * that no servers are known to the event handler.  This is correct.  The
 * servers register with Tk's event handler, and are not known to the simple
 * event handler.
 */

/*ARGSUSED*/
static int
tcpWaitCommand (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int status;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Do the poll */

  status = simpleSelect (interp, SIMPLE_WAIT);

  /* Check for trouble */

  if (status < 0) {
    if (errno == 0) {
      Tcl_SetResult (interp, "no servers known to event handler", TCL_STATIC);
    } else {
      Tcl_AppendResult (interp, "select: ", Tcl_PosixError (interp),
			(char *) NULL);
    }
    return TCL_ERROR;
  }

  /* Return the number of events pending. */

  sprintf (interp -> result, "%d", status);
  return TCL_OK;
}

/*
 * tcpServerObjectCmd --
 *
 *	This procedure is invoked when a command is called on a server
 *	object directly.  It dispatches to the appropriate command processing
 *	procedure to handle the command.
 *
 * $server accept
 *	[Internal call] - Accept a connection.
 * $server clients
 *	Return a list of all clients connected to a server.
 * $server configure ?args?
 *	Revise or query a server's configuration.
 * $server start
 *	Start a server running.
 * $server stop
 *	Terminate a server.
 */

static int
tcpServerObjectCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int c;
  unsigned length;

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [0],
		      " command ?args?\"", (char *) NULL);
    return TCL_ERROR;
  }

  c = argv [1] [0];
  length = strlen (argv [1]);
  
  if (c == 'a' && strncmp (argv [1], "accept", length) == 0) {
    return tcpServerObjectAcceptCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 'c' && length >= 2 && strncmp (argv [1], "clients", length) == 0) {
    return tcpServerObjectClientsCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 'c' && length >= 2
      && strncmp (argv [1], "configure", length) == 0) {
    return tcpServerObjectConfigCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 's' && length >= 3 && strncmp (argv [1], "start", length) == 0) {
    return tcpServerObjectStartCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 's' && length >= 3 && strncmp (argv [1], "stop", length) == 0) {
    return tcpServerObjectStopCmd (clientData, interp, argc-1, argv+1);
  }
  Tcl_AppendResult (interp, argv [0], ": ", "bad option \"", argv [1],
		    "\": should be clients, configure, start, or stop",
		    (char *) NULL);
  return TCL_ERROR;
}

/*
 * tcpServerObjectAcceptCmd --
 *
 *	The following procedure handles the `accept' command on a
 *	server object.  It is called in the background by
 *	tcpServerAcceptConnection when a connection request appears on
 *	a server.  It is responsible for creating the client and
 *	accepting the connection request.
 *
 * Results:
 *	Returns a standard TCL result.  The return value is the name
 *	of the client if the call is successful.
 *
 * Side effects:
 *	A Tcl command named after the client object is created.
 */

static int
tcpServerObjectAcceptCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ServerData * server = (Tcp_ServerData *) clientData;
  register Tcp_ClientData * client;
  int rubbish;

  /* Check command syntax */

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Create the client data structure */

  client = (Tcp_ClientData *) ckalloc (sizeof (Tcp_ClientData));

  /* Accept the client's connection request */

  rubbish = sizeof (struct sockaddr_in);
  client -> socketfd = accept (server -> socketfd,
			       (struct sockaddr *) &(client -> peeraddr),
			       &rubbish);
  if (client -> socketfd < 0) {
    Tcl_AppendResult (interp, "can't accept connection: ",
		      Tcl_PosixError (interp), (char *) NULL);
    ckfree ((char *) client);
    return TCL_ERROR;
  }
  client -> doNotClose = 0;

  /* Set up the client's description */

  client -> server = server;
  sprintf (client -> name, "tcp_client_%d", client -> socketfd);
  client->command = Ckstrdup(server->command);
  Tcl_DStringInit(&client -> inputBuffer);
  client -> resultString = client -> resultPointer = (char *) NULL;
  client -> activeFlag = 0;
  client -> closeFlag = 0;
  client -> next = server -> firstClient;
  if (client -> next != NULL) {
    client -> next -> prev = client;
  }
  client -> prev = NULL;
  server -> firstClient = client;

  /* Create the Tcl command for the client */
  
  Tcl_CreateCommand (interp, client -> name,
		     (Tcl_CmdProc *) tcpClientObjectCmd,
		     (ClientData) client,
		     (Tcl_CmdDeleteProc *) deleteTcpClientObjectCmd);

  /* Return the client's name */

  Tcl_SetResult (interp, client -> name, TCL_STATIC);
  return TCL_OK;
}

/*
 * tcpServerObjectClientsCmd --
 *
 *	This procedure in invoked in response to the `clients' command
 * on a TCP server object.  It returns a list of clients for the server.
 */

static int
tcpServerObjectClientsCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  Tcp_ServerData * server = (Tcp_ServerData *) clientData;
  Tcp_ClientData * client;

  /* Check syntax */

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args, should be\"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  for (client = server -> firstClient; client != NULL;
       client = client -> next) {
    Tcl_AppendElement (interp, client -> name);
  }

  return TCL_OK;
}

/*
 * tcpServerObjectConfigCmd --
 *
 *	This procedure is invoked in response to the `config' command
 *	on a TCP server object.  With no arguments, it returns a list
 *	of valid arguments.  With one argument, it returns the current
 *	value of that option.  With multiple arguments, it attempts to
 *	configure the server according to that argument list.
 * Results:
 *	Returns a standard Tcl result.
 */

static int
tcpServerObjectConfigCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int unixStatus;
  int c;
  unsigned length;

  /* No arguments -- return a list of valid options. */

  if (argc <= 1) {
    Tcl_SetResult (interp, "-command -port", TCL_STATIC);
    return TCL_OK;
  }

  /* One argument -- query a particular option */

  if (argc == 2) {
    register Tcp_ServerData * server = (Tcp_ServerData *) clientData;
    char * arg = argv [1];

    if (arg [0] != '-') {
      Tcl_AppendResult (interp, argv [-1], " ", argv [0],
			": bad option \"", arg,
			"\" -- each option must begin with a hyphen.",
			(char *) NULL);
      return TCL_ERROR;

    }

    length = strlen (++arg);
    c = arg [0];

    if (c == 'c' && strncmp (arg, "command", length) == 0) {

      /* Command option -- Get the command name */

      Tcl_SetResult (interp, server->command, TCL_STATIC);
      return TCL_OK;

    }

    if (c == 'p' && strncmp (arg, "port", length) == 0) {

      /* Port option -- Get the port number */

      struct sockaddr_in portaddr;
      int rubbish = sizeof (struct sockaddr_in);

      unixStatus = getsockname (server -> socketfd,
				(struct sockaddr *) &portaddr, &rubbish);
      if (unixStatus < 0) {
	Tcl_AppendResult (interp, argv [-1], ": can't read port #: ",
			  Tcl_PosixError (interp), (char *) NULL);
	return TCL_ERROR;
      }
      Tcl_ResetResult (interp);
      sprintf (interp -> result, "%d", (int) ntohs (portaddr.sin_port));
      return TCL_OK;
    }
	
    /* Unknown option */

    Tcl_AppendResult (interp, argv [-1], ": unknown option \"", arg,
		      "\" -- must be -command or -port", (char *) NULL);
    return TCL_ERROR;
  }

  if (restricted) {
    Tcl_AppendResult(interp, "It is not permitted to re-configure a server object in a restricted server",
		     (char *) NULL);
    return TCL_ERROR;
  }
  return tcpServerObjectConfig (clientData, interp, argc, argv);
}  

/*
 * tcpServerObjectStartCmd --
 *
 *	This procedure is invoked to process the "start" command on a
 *	TCP server object.  It sets the server up so that new
 *	connection requests will create "server-client" objects and
 *	invoke the server's command with them.
 *
 *	If Tk is available, the "start" command returns to the caller.
 *	If Tk is not available, the "start" command immediately enters
 *	a loop that attempts to process the connection events (and
 *	other file events as well).  The loop may be exited by
 *	executing a `stop' command on the server object.  (The `stop'
 *	command also exists in the Tk environment, since there is more
 *	to stopping a server than just breaking out of its event
 *	loop.)
*/

static int
tcpServerObjectStartCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ServerData * server = (Tcp_ServerData *) clientData;
  int unixStatus;

  /* Check command syntax */

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Listen at the server's socket */

  unixStatus = listen (server -> socketfd, TCP_LISTEN_BACKLOG);
  if (unixStatus < 0) {
    Tcl_AppendResult (interp, argv [-1], ": can't listen at socket: ",
		      Tcl_PosixError (interp), (char *) NULL);
    return TCL_ERROR;
  }

  /* Add a file handler to gain control at tcpServerAcceptConnection
   * whenever a client attempts to connect.
   */

  simpleCreateFileHandler (server -> socketfd, SIMPLE_READABLE,
			   (Simple_FileProc *) tcpServerAcceptConnection,
			   clientData);
  return TCL_OK;
}

/*
 * tcpServerObjectStopCmd
 *
 *	This procedure is invoked in response to the `$server stop' Tcl
 * command.  It destroys the server's object command.  Destroying the object
 * command, in turn, attempts to shut down the server in question.  It closes
 * the listen socket, closes all the clients, and sets the `stop' flag for
 * the server itself.  It then calls `tcpServerClose' to try to get rid of
 * the server.
 *
 *	If one or more clients are active, the server does not shut down
 * until they can be closed properly.
 */

static int
tcpServerObjectStopCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ServerData * server = (Tcp_ServerData *) clientData;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1],
		      " ", argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Delete the server command */

  Tcl_DeleteCommand (interp, server -> name);

  return TCL_OK;
}

/*
 * deleteTcpServerObjectCmd --
 *
 *	This procedure is called when a server's object command is deleted.
 *
 *	It is the first procedure called when a server is shut down.  It
 * closes the listen socket and deletes its file handler.  It also attempts
 * to close all the clients.
 *
 *	It may be that a client needs to be able to complete a data transfer
 * before it can be closed.  In this case, the `close flag' for the client is
 * set.  The client will be deleted when it reaches a quiescent point.
 *
 *	Once all the clients are gone, tcpDeleteServer removes the server's
 * client data structure.
 */

static void
deleteTcpServerObjectCmd (clientData)
     ClientData clientData;
{
  register Tcp_ServerData * server = (Tcp_ServerData *) clientData;
  register Tcp_ClientData * client, * nextClient;

  /* Close the listen socket and delete its handler */

  simpleDeleteFileHandler (server -> socketfd);
  (void) close (server -> socketfd);
  server -> socketfd = -1;

  /*
   * Close all clients
   * This reset for stopFlag is necessary so that for inetd type
   * servers, the client does not recursively try to delete the
   * server!
   */
  server->stopFlag = 0;

  for (client = server -> firstClient; client != NULL; client = nextClient) {
    nextClient = client -> next;
    if (client -> activeFlag)
      client -> closeFlag = 1;
    else
      tcpCloseClient (client);
  }

  /* Remove the server from the list of servers. */

  if (server -> next != NULL)
    server -> next -> prev = server -> prev;
  if (server -> prev != NULL)
    server -> prev -> next = server -> next;
  else
    tcpFirstServer = server -> next;

  /* If all clients are closed, get to tcpDeleteServer now.  Otherwise, set
   * the server's stop flag and return.
   */

  if (server -> firstClient == NULL) {
    tcpDeleteServer (server);
  } else {
    server -> stopFlag = 1;
  }
}

/*
 * tcpDeleteServer --
 *
 *	This procedure is invoked as the final phase of deleting a TCP server.
 * When execution gets here, the server's listen socket has been closed and
 * the handler has been removed.  The server's object command has been deleted.
 * The server has been removed from the list of active servers.  All the
 * server's clients have been closed. All that remains is to deallocate the
 * server's data structures.
 */

static void
tcpDeleteServer (server)
     Tcp_ServerData * server;
{
  /* Get rid of the server's initial command */
  ckfree(server->command);

  /* Get rid of the server's own data structure */

  (void) ckfree ((char *) server);

  /*
   * If we are deleting the last server (e.g. on closedown of a server process)
   * ensure that we clean out the event queue of any detached processes
   * Otherwise things like tcp mainloop would remain indefinitely although they've
   * now lost all contact with the outside world!
   * Need to think carefully about whether we really want to do this.
   */
  if (!tcpFirstServer)
    simpleDeleteTimerHandler(tcpTimerEventProc, NULL, NULL, tcpDeleteTimerEvent);
}

/*
 * tcpServerObjectConfig --
 *
 *	This procedure is invoked to configure a TCP server object.
 *	It may be called from tcpServerCommand when the server is
 *	first being created, or else from tcpServerObjectCmd if the
 *	server object is called with the "config" option.
 *
 *	In any case, the arguments are expected to contain zero or
 *	more of the following:
 *
 *	-port <number>
 *		Requests that the server listen at a specific port.
 *		Default is whatever the system assigns.
 *
 *	-command <string>
 *		Specifies the initial command used when a client
 *		first connects to the server.  The command is
 *		concatenated with the name of a "server-client" object
 *		that identifies the client, and then called:
 *			command client
 *		Default is "tcp login"
 *
 * Result:
 *	A standard TCL result.
 */

static int
tcpServerObjectConfig (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{

  register Tcp_ServerData * server = (Tcp_ServerData *) clientData;

  int status;
  int unixStatus;

  /* On entry, argc shows one plus the number of parameters.  Argv[-1] */
  /* and argv[0] give the command that got us here: either "tcp */
  /* server" or else "serverName config" */

  int a;
  unsigned length;
  int c;

  /* Step through the parameters */

  for (a = 1; a < argc; ++a) {
    char * arg = argv [a];

    if (arg [0] != '-') {
      Tcl_AppendResult (interp, argv [-1], ": bad option \"", arg,
			"\" -- each option must begin with a hyphen.",
			(char *) NULL);
      return TCL_ERROR;
    } else {

      length = strlen (++arg);
      c = arg [0];

      if (c == 'c' && strncmp (arg, "command", length) == 0) {

	/* Command option -- Get the command name */

	++a;
	if (a >= argc) {
	  Tcl_AppendResult (interp, argv [-1],
			    ": \"-command\" must be followed by a string.",
			    (char *) NULL);
	  return TCL_ERROR;
	}

	/* Free the old command name */
	ckfree(server->command);

	/* Put in the new command name */
	server->command = Ckstrdup(argv[a]);

      } else if (c == 'p' && strncmp (arg, "port", length) == 0) {

	/* Port option -- get the port number */

	char * portstr;
	int portno;
	struct sockaddr_in portaddr;

	++a;
	if (a >= argc) {
	  Tcl_AppendResult (interp, argv [-1],
			    ": \"-port\" must be followed by a number.",
			    (char *) NULL);
	  return TCL_ERROR;
	}
	portstr = argv [a];
	status = tcpGetPortNumber (interp, portstr, &portno);
	if (status != TCL_OK) return status;

	/* Set the port number */

	memset ((void *) & portaddr, 0, sizeof (struct sockaddr_in));
	portaddr.sin_port = portno;
	unixStatus = bind (server -> socketfd,
			   (struct sockaddr *) &portaddr,
			   sizeof (struct sockaddr_in));
	if (unixStatus < 0) {
	  Tcl_AppendResult (interp, argv [-1],
			    ": can't set port number: ",
			    Tcl_PosixError (interp), (char *) NULL);
	  return TCL_ERROR;
	}

      } else {

	/* Unknown option */

	Tcl_AppendResult (interp, argv [-1],
			  ": unknown option \"", arg - 1,
			  "\" -- must be -command or -port", (char *) NULL);
	return TCL_ERROR;
      }
    }
  }

  Tcl_SetResult (interp, server -> name, TCL_STATIC);
  return TCL_OK;
}

/*
 * tcpClientObjectCmd --
 *
 *	This procedure handles the object command for a Tcp client (on
 *	the server side).  It takes several forms:
 *		$client command ?command?
 *			With no arguments, returns the client's
 *			current command.  With arguments, replaces the
 *			client's command with the arguments
 *		$client close
 *			Deletes the client.  If a command is being
 *			processed on the client's behalf, the client
 *			will not be deleted until the command's result
 *			is returned.
 *		$client do ?args?
 *			Concatenate the client's command with ?args?,
 *			and execute the result.  Called in background
 *			when a command arrives and on initial
 *			connection.
 *		$client hostname
 *			Returns the name of the host where the client
 *			is running.
 *		$client privileged
 *			Returns 1 if the client is connected on a reserved port
 *			(i.e. is a root process that requested privileged access).
 *		$client server
 *			Returns the name of the server to which the client
 *			is connected.
 */

static int
tcpClientObjectCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  int c;
  unsigned length;

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [0],
		      " command ?args?\"", (char *) NULL);
    return TCL_ERROR;
  }

  c = argv [1] [0];
  length = strlen (argv [1]);
  
  if (c == 'c' && length >= 2 && strncmp (argv [1], "close", length) == 0) {
    return tcpClientObjectCloseCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 'c' && length >= 2 && strncmp (argv [1], "command", length) == 0) {
    return tcpClientObjectCommandCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 'h' && strncmp (argv [1], "hostname", length) == 0) {
    return tcpClientObjectHostnameCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 'p' && strncmp (argv [1], "privileged", length) == 0) {
    return tcpClientObjectPrivilegedCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 's' && strncmp (argv [1], "server", length) == 0) {
    return tcpClientObjectServerCmd (clientData, interp, argc-1, argv+1);
  }

  Tcl_AppendResult (interp, "bad option \"", argv [1],
		    "\": should be close, command, do, hostname, privileged or server",
		    (char *) NULL);
  return TCL_ERROR;
}

/* 
 * tcpClientObjectCloseCmd --
 *
 * 	This procedure is called when the Tcl program wants to close a client.
 * If the client is active, it sets a flag to close the client when it
 * becomes quiescent.  Otherwise, it closes the client immediately.
 */

static int
tcpClientObjectCloseCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  if (client -> activeFlag)
    client -> closeFlag = 1;
  else
    tcpCloseClient (client);

  return TCL_OK;
}

/* 
 * tcpClientObjectCommandCmd --
 *
 * 	Query/change the command associated with a client object
 *
 * Syntax:
 *	$client command ?newcommand?
 *
 * Return:
 *	A standard Tcl result containing the client's command.
 */

static int
tcpClientObjectCommandCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;

  /* Check syntax */

  if (argc > 2) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], " ?command?\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Set command if necessary */

  if (argc == 2) {
    if (restricted) {
      Tcl_AppendResult(interp, "It is not permitted to change the client command in a restricted server",
		       (char *) NULL);
      return TCL_ERROR;
    }

    ckfree(client->command);
    client->command = Ckstrdup(argv[1]);
  }

  /* Return command in any case */

  Tcl_SetResult (interp, client -> command, TCL_STATIC);

  return TCL_OK;
}

/*
 * tcpClientDoit --
 *
 *	The following procedure actually performs client commands.
 *      It was tcpClientObjectDoCmd but this way saves an
 *	extra TCL command evaluation when run from client.
 *	object.  It is called 
 *		(a) with no command and logout = 0, at login.
 *		(b) with command and logout = 0, when the client 
 *			sends a command. 
 *		(c) with no command and logout = 1, when
 *			the connection is closed.
 *
 *	It concatenates the client's saved command string with the
 *	client's name, and then with the passed command, resulting in
 *	a command:
 *		saved_command client passed_command
 *	which is then passed to Tcl_Eval for processing.
 *      During the processing of the command, the `active' flag is set for
 *	the client, to avoid having the client closed prematurely.
 */
static int
tcpClientDoit (client, interp, command, logout)
     Tcp_ClientData *client;
     Tcl_Interp *    interp;
     char       *    command;
     int	     logout;
{
  int status;
  int closeflag;
  Tcp_ClientData *prevClient;

  prevClient = tcpCurrentClient;
  tcpCurrentClient = client;

  /* Evaluate the client's command, passing the client name and message */

  closeflag = 0;
  client->activeFlag++;

  if (command)
    status = Tcl_VarEval (interp, client -> command, " ", client -> name, " {",
			  command, "}", (char *) NULL);
  else
    status = Tcl_VarEval (interp, client -> command, " ", client -> name,
			  (char *) NULL);

  if (status != TCL_OK && !command) {
    closeflag = 1;
  }

  client->activeFlag--;
  tcpCurrentClient = prevClient;

  /* If the client command throws an error on login or logout,
   * the client should be disconnected.
   * In the case of login only, the result is reported back to the client.
   */

  if (!logout)
    tcpReturnResultToClient (client, interp, status, closeflag);

  /* The client may have been closed by the ReturnResult operation. DON'T
   * USE IT AFTER THIS POINT.
   */

  return TCL_OK;
}

/*
 * tcpClientObjectHostnameCmd --
 *
 *	This procedure is invoked in response to the `$client hostname'
 * Tcl command.  It returns the name of the peer host on which the client
 * runs.
 */

static int
tcpClientObjectHostnameCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;

  struct hostent * hostdesc;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  if (client->peeraddr.sin_family != AF_INET) {
    /* From a socketpair connection by tcp spawnserver */
    Tcl_SetResult(interp, "localhost", TCL_STATIC);
    return TCL_OK;
  }
  hostdesc = gethostbyaddr ((char *) &(client -> peeraddr.sin_addr.s_addr),
			    sizeof (client -> peeraddr.sin_addr.s_addr),
			    AF_INET);
  
  if (hostdesc != (struct hostent *) NULL) {
    Tcl_SetResult (interp, hostdesc -> h_name, TCL_VOLATILE);
  } else {
    Tcl_SetResult (interp, inet_ntoa (client -> peeraddr.sin_addr),
		   TCL_VOLATILE);
  }

  return TCL_OK;
}

/*
 * tcpClientObjectPrivilegedCmd --
 *
 *	This procedure is invoked in response to the `$client privilege'
 * Tcl command.  It returns 1 if the client is attached to a reserved port.
 */

static int
tcpClientObjectPrivilegedCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;
  int privileged;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  /*
   * If connection family is AF_INET, this means a TCP/IP connection.
   * Therefore, we look at the port number of the client - only
   * privileged connections have port # < IPPORT_RESERVED.
   * Otherwise we are generated by a spawnserver. In this case
   * geteuid determines whether or not we are privileged
   * ###TERRY### think about this. geteuid does not necessarily give any
   * info about parent process (since we could be a setuid process).
   * Therefore, should we check ruid. Of course, this would not
   * show a setuid to root parent in good light, but we probably
   * only want real uid == 0 to connote privileged?
   */
  privileged = client->peeraddr.sin_family == AF_INET ? 
    (ntohs(client->peeraddr.sin_port) < IPPORT_RESERVED) : !geteuid();

  Tcl_SetResult(interp, privileged ? "1" : "0", TCL_STATIC);
  return TCL_OK;
}

/*
 * tcpClientObjectServerCmd --
 *
 *	This procedure is invoked in response to the `$client server'
 * Tcl command.  It returns the name of the server to which the client
 * is connected.
 */

static int
tcpClientObjectServerCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args: should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  Tcl_SetResult (interp, client -> server -> name, TCL_STATIC);

  return TCL_OK;
}

/*
 * deleteTcpClientObjectCmd --
 *
 *	This procedure is invoked when a client object's command has
 * been deleted.  WARNING -- deleting a client object command when the
 * client is active is a FATAL error that cannot be reported through the
 * Tcl interpreter.
 *
 *	This procedure does all the cleanup necessary to get rid of the
 * client.
 */

static void
deleteTcpClientObjectCmd (clientData)
     ClientData clientData;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;
  register Tcp_ServerData * server = client -> server;
  Tcp_TimerEvent tEvent;

  /* Make sure the client is really dead. */

  if (client -> activeFlag)
    panic("attempt to delete an active TCP client!\n\n");

  /* Remove any handler for data on the client's socket. */

  simpleDeleteFileHandler (client -> socketfd);

  /* Now it's safe to close the socket -
   * but only do it if this flag (see tcpClientDoConn) unset */

  if (!client -> doNotClose)
    (void) close (client -> socketfd);

  /* Get rid of the command */

  ckfree(client->command);

  /* Get rid of the input buffer */

  Tcl_DStringFree(&client -> inputBuffer);

  /* Get rid of any pending result */

  if (client -> resultString != NULL)
    ckfree (client -> resultString);

  /* Unlink the client from the list of active clients */

  if (client -> prev == NULL)
    client -> server -> firstClient = client -> next;
  else
    client -> prev -> next = client -> next;

  if (client -> next != NULL)
    client -> next -> prev = client -> prev;

  /* Delete any event handlers setup for this client */
  tEvent.client = client;
  simpleDeleteTimerHandler(tcpTimerEventProc, (ClientData) &tEvent,
			   tcpCompareTimerClient, tcpDeleteTimerEvent);

  /* Now it's ok to destroy the client's data structure */

  ckfree ((char *) client);

  /* Handle a deferred close on the server if necessary */

  if (server -> stopFlag && server -> firstClient == NULL)
    tcpDeleteServer (server);
}

/*
 * tcpConnectionObjectCmd --
 *
 *	This procedure is invoked to process the object command for a client-
 * side connection object.  It takes a couple of diferent forms:
 *
 *	$connection close
 *		Closes the connection.
 *	$connection hostname
 *		Returns the name of the host on which the server at
 *		the other end of the connection is running.
 *	$connection send arg ?arg....?
 *		Catenates the arguments into a Tcl command, and sends them
 *		to the server.
 */

static int
tcpConnectionObjectCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  unsigned length;
  int c;
  char * arg;

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [0], " ",
		      "command ?args?\"", (char *) NULL);
    return TCL_ERROR;
  }

  arg = argv [1];
  c = arg [0];
  length = strlen (arg);

  if (c == 'c' && strncmp (arg, "close", length) == 0) {
    return tcpConnectionObjectCloseCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 'h' && strncmp (arg, "hostname", length) == 0) {
    return tcpConnectionObjectHostnameCmd (clientData, interp, argc-1, argv+1);
  }
  if (c == 's' && strncmp (arg, "send", length) == 0) {
    return tcpConnectionObjectSendCmd (clientData, interp, argc-1, argv+1);
  }

  Tcl_AppendResult (interp, "unknown command \"", arg,
		    "\": must be close, hostname or send", (char *) NULL);
  return TCL_ERROR;
}

/*
 * tcpConnectionObjectCloseCmd --
 *
 *	This procedure is invoked in response to a `close' command on a
 * client-side connection object.  It closes the socket and deletes the
 * object command.
 */

/* ARGSUSED */
static int
tcpConnectionObjectCloseCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  Tcl_DeleteCommand (interp, argv [-1]);
  return TCL_OK;
}

/*
 * tcpConnectionObjectHostnameCmd --
 *
 *	This procedure is invoked in response to a `Hostname' command on a
 * client-side connection object.  It returns the name of the host on which
 * the server is running. This is particularly useful for reversing connections
 * since the 'tcpReverse' procedure is just given a connection object.
 */

static int
tcpConnectionObjectHostnameCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  Tcp_ConnectionObject *conobj = (Tcp_ConnectionObject *) clientData;
  struct hostent *hostdesc;
  struct sockaddr_in peeraddr;
  int unixStatus, len;

  if (argc != 1) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], "\"", (char *) NULL);
    return TCL_ERROR;
  }

  len = sizeof(struct sockaddr_in);
  peeraddr.sin_family = AF_UNIX;
  unixStatus = getpeername(conobj->f, (struct sockaddr *) &peeraddr,
			   &len);
  if (unixStatus < 0) {
    Tcl_AppendResult (interp, argv[-1], " ", argv[0],
		      ": can't get peername on server's socket: ",
		      Tcl_PosixError (interp), (char *) NULL);
    return TCL_ERROR;
  }

  if (peeraddr.sin_family != AF_INET) {
    /* From a socketpair connection by tcp spawnserver */
    Tcl_SetResult(interp, "localhost", TCL_STATIC);
    return TCL_OK;
  }
  hostdesc = gethostbyaddr ((char *) &(peeraddr.sin_addr.s_addr),
			    sizeof (peeraddr.sin_addr.s_addr),
			    AF_INET);
  
  if (hostdesc != (struct hostent *) NULL)
    Tcl_SetResult (interp, hostdesc -> h_name, TCL_VOLATILE);
  else
    Tcl_SetResult (interp, inet_ntoa(peeraddr.sin_addr), TCL_VOLATILE);

  return TCL_OK;
}

/*
 * tcpConnectionObjectSendCmd --
 *
 *	This procedure is invoked in response to a `send' command on a client-
 * side connection object.  It catenates the `send' arguments into a single
 * string, presents that string to the server as a command, and returns the
 * server's reply.
 */

static int
tcpConnectionObjectSendCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp * interp;
     int argc;
     char * * argv;
{
  char * message;
  Tcp_ConnectionObject *conobj = (Tcp_ConnectionObject *) clientData;
  int status, length;

  if (argc < 2) {
    Tcl_AppendResult (interp, "wrong # args, should be \"", argv [-1], " ",
		      argv [0], " command\"", (char *) NULL);
    return TCL_ERROR;
  }

  /* Paste together the message */

  /*
   * OK - if we only give one argument to tcp send leave it as is.
   * If we give multiple args compact them into a single string.
   * In either case we don't wish to wrap the whole thing into a
   * single arg (would happen with a multi word argv[1] if we had
   * only 1 arg and put Tcl_Merge on it) since it won't get broken
   * apart correctly at the other end.
   */
  if (argc == 2)
    message = Ckstrdup(argv[1]);
  else
    message = Tcl_Merge (argc-1, argv+1);

  /*
   * Send the command to the server
   * Note - since we don't need the Null-termination we
   * can 'cheat' here and override it with newline
   */
  length = strlen(message);
  message[length++] = '\n';

  errno = 0;
  status = write (conobj->f, message, length);
  if (status < length) {
    Tcl_AppendResult (interp, "can't send message to server: ",
		      Tcl_PosixError (interp), (char *) NULL);
    /* If we get EPIPE should close the connection! */
    ckfree(message);
    return TCL_ERROR;
  }
  ckfree(message);

  /* Get the server's reply */

  return tcpReceiveResultFromServer (interp, conobj);
}

/*
 * deleteTcpConnectionObjectCmd --
 *
 *	This procedure is called when a connection object is to be
 * deleted.  It just has to close the socket that the object uses.
 */

static void
deleteTcpConnectionObjectCmd (clientData)
     ClientData clientData;
{
  Tcp_ConnectionObject *conobj = (Tcp_ConnectionObject *) clientData;

  (void) close (conobj->f);

  /* Execute a wait on the child process */
  if (conobj->pid != -1) {
    WAIT_STATUS_TYPE waitStatus;
    waitpid(conobj->pid, (int *) &waitStatus, 0);
  }

  (void) Tcl_UnsetVar2(conobj->interp, "tcp_greeting",
		       conobj->name, TCL_GLOBAL_ONLY);

  ckfree((char *) conobj);
}

/*
 * tcpCloseClient --
 *
 *	This procedure is called when the program is completely done with
 * a client object.  If the `active' flag is set, there is still a reference
 * to the dead client, but we shouldn't have come here in that case.
 *
 * It is now possible to call tcpCloseClient from the tcpClientDoit termination
 * even with the activeFlag set. This would be if the client command arrived while
 * processing a timer event for this client.
 * activeflag now massaged in 2 places - tcpClientDoit and tcpTimerEventProc
 */

static void
tcpCloseClient (client)
     Tcp_ClientData * client;
{
  if (client -> activeFlag) 
    return;

  /* Deleting the client command is all we need to do -- the delete
   * procedure does everything else.
   */

  Tcl_DeleteCommand (client -> server -> interp, client -> name);
}

/*
 * tcpServerAcceptConnection --
 *
 *	This procedure is invoked as a file handler whenever a server's
 *	socket is ready for `reading' -- i.e., has a connection request
 *	outstanding.
 *
 *	It calls the `accept' command on the server to create a client.
 *	If the `accept' is successful, it then calls the `do'
 *	command on the client.  If either call fails, a background error
 *	is reported.
 */

/* ARGSUSED */
static void
tcpServerAcceptConnection (clientData, mask)
     ClientData clientData;
     int mask;
{
  register Tcp_ServerData * server = (Tcp_ServerData *) clientData;
  /*
   * Need to cache this because if the login command invoked
   * by tcpClientDoit is tcpClientToConnCommand the server will have
   * been deleted by the time we get to the Tcl_ResetResult at the
   * end of this function!
   */
  Tcl_Interp *interp = server->interp;
  int status;

  /* Accept the connection with `$server accept' */

  status = Tcl_VarEval (server -> interp, server -> name, " accept",
		     (char *) NULL);

  /* On success, try to execute the client's login command */

  if (status == TCL_OK) {
    status = tcpClientDoit(server->firstClient, server->interp, NULL, 0);

    /* Client may have been closed at this point.  Don't refer to it again. */
  }

  if (status != TCL_OK) {
    simpleReportBackgroundError (interp);
  }
  Tcl_ResetResult (interp);
}

/*
 * tcpTrustedHost --
 *
 *	This procedure is invoked whenever the code must determine whether
 * a host is trusted.  A host is considered trusted only if it is the local
 * host.
 *
 * Results:
 *	Returns a Boolean value that is TRUE iff the host is trusted.
 */

/* The HOSTCMP macro is just strcmp, but puts its args on stderr if
 * the DEBUG_TRUSTED_HOST flag is #define'd.  It's used because this
 * code can be a little flaky; if `hostname' returns a name that is
 * completely unknown in the database, this macro will trace what happened.
 */

#ifdef DEBUG_TRUSTED_HOST
#define HOSTCMP( name1, name2 )					\
  (fprintf (stderr, "tcpTrustedHost: comparing %s with %s\n",	\
	    (name1), (name2)), 					\
   strcmp ((name1), (name2)))
#else
#define HOSTCMP( name1, name2 )					\
  strcmp ((name1), (name2))
#endif

int
tcpTrustedHost (hostName)
     char * hostName;
{
  char localName [128];
  struct hostent * hostEnt;
  struct in_addr hostAddr;
  int unixStatus;
  int i;

  /* This procedure really has to do things the hard way.  The problem is
   * that the hostname() kernel call returns the host name set by the system
   * administrator, which may not be the host's primary name as known to
   * the domain name system.  Furthermore, the host presented may be one
   * of the names for the loopback port, 127.0.0.1, and this must be checked,
   * too.
   */

  /* Start assembling a list of possibilities for the host name.  First
   * possibility is the name that the kernel returns as hostname ().
   */

  unixStatus = gethostname (localName, 127);
  if (unixStatus >= 0) {

    if (!HOSTCMP( hostName, localName )) return 1;

    /* Next possibility is a.b.c.d notation for all of the local addresses,
     * plus all the nicknames for the host. 
     */

    hostEnt = gethostbyname (localName);
    if (hostEnt != (struct hostent *) NULL) {
      if (!HOSTCMP( hostName, hostEnt -> h_name )) return 1;
      if (hostEnt -> h_aliases != (char * *) NULL) {
	for (i = 0; hostEnt -> h_aliases [i] != (char *) NULL; ++i) {
	  if (!HOSTCMP( hostName, hostEnt -> h_aliases [i] )) return 1;
	}
      }
      if (hostEnt -> h_addr_list != (char * *) NULL) {
	for (i = 0; hostEnt -> h_addr_list [i] != (char *) NULL; ++i) {
	  /* note that the address doesn't have to be word-aligned (!) */
	  memcpy ((char *) &hostAddr,
		  hostEnt -> h_addr_list [i],
		  hostEnt -> h_length);
	  if (!HOSTCMP( hostName, inet_ntoa (hostAddr) )) return 1;
	}
      }
    }
  }

  /* Finally, there's the possibility of the loopback address, and all of 
   * its aliases.*/

  if (!HOSTCMP( hostName, "0.0.0.0" )) return 1;
  if (!HOSTCMP( hostName, "127.0.0.1" )) return 1;
  hostAddr.s_addr = htonl (INADDR_LOOPBACK);
  hostEnt = gethostbyaddr ((char *) &hostAddr, sizeof hostAddr, AF_INET);
  if (hostEnt != (struct hostent *) NULL) {
    if (!HOSTCMP( hostName, hostEnt -> h_name )) return 1;
    if (hostEnt -> h_aliases != (char * *) NULL) {
      for (i = 0; hostEnt -> h_aliases [i] != (char *) NULL; ++i) {
	if (!HOSTCMP( hostName, hostEnt -> h_aliases [i] )) return 1;
      }
    }
    if (hostEnt -> h_addr_list != (char * *) NULL) {
      for (i = 0; hostEnt -> h_addr_list [i] != (char *) NULL; ++i) {
	/* note that the address doesn't have to be word-aligned (!) */
	memcpy ((char *) &hostAddr,
		hostEnt -> h_addr_list [i],
		hostEnt -> h_length);
	if (!HOSTCMP( hostName, inet_ntoa (hostAddr) )) return 1;
      }
    }
  }

  return 0;
}

/*
 * tcpReturnResultToClient --
 *
 *	This procedure is invoked to return a result to a client.  It
 * extracts the interpreter's result string, bundles it with the return
 * status, and stores it in the client's `resultString' area.
 *
 *	It then calls tcpWriteResultToClient to try to start sending the
 * result.
 */

static void
tcpReturnResultToClient (client, interp, status, closeflag)
     Tcp_ClientData * client;
     Tcl_Interp * interp;
     int status;
     int closeflag;
{
  char * argv [2];
  char rint [16];
  unsigned length;
  char * result = NULL;
  
  /* Put together a message comprising the return status and the interpreter
   * result */

  if (status != TCL_OK)
    result = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);

  sprintf (rint, "%d", status);
  argv [0] = rint;
  /*
  argv [1] = result ? result : interp -> result;
  */
  argv [1] = interp -> result;
  result = Tcl_Merge (2, argv);
  length = strlen (result);
  client -> resultString = (char *) ckalloc (length + 2);
  strcpy (client -> resultString, result);
  strcpy (client -> resultString + length, "\n");
  ckfree (result);
  client -> resultPointer = client -> resultString;

  Tcl_ResetResult (interp);
  client -> closeFlag |= closeflag;
  
  /* Now try to send the reply. */

  tcpWriteResultToClient ((ClientData) client, SIMPLE_WRITABLE);

  /* tcpWriteResultToClient closes the client if it fails; don't depend on
   * having the client still be usable. */
}

/*
 * tcpWriteResultToClient --
 *
 *	This procedure is invoked to issue a write on a client socket.
 * It can be called directly by tcpReturnResultToClient, to attempt the
 * initial write of results.  It can also be called as a file handler,
 * to retry a write that was previously blocked.
 */

/* ARGSUSED */
static void
tcpWriteResultToClient (clientData, mask)
     ClientData clientData;
     int mask;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;

  int unixStatus;
  int length;

  length = strlen (client -> resultPointer);

  /* Issue the write */

  unixStatus = write (client -> socketfd, client -> resultPointer,
		      length);
  
  /* Test for a total failure */

  if (unixStatus < 0) {
    if (errno != EWOULDBLOCK) {
      tcpClientWriteError (client);
      /* tcpClientWriteError closes the client as a side effect.  Don't depend
       * on the client still being there.
       */
      return;
    } else {
      unixStatus = 0;		/* Pretend that EWOULDBLOCK succeeded at
				 * writing zero characters. */
    }
  }

  /* Test for a partial success */

  if (unixStatus < length) {
    client -> resultPointer += unixStatus;
    simpleCreateFileHandler (client -> socketfd, SIMPLE_WRITABLE,
			     (Simple_FileProc *) tcpWriteResultToClient,
			     clientData);
  }

  /* Total success -- prepare the client for the next input */

  else {
/*
    fprintf(stderr, "Successsfully sent %d bytes to client\n", length);
*/
    if (client -> resultString != NULL)
      ckfree (client -> resultString);
    client -> resultString = client -> resultPointer = (char *) NULL;
    simpleDeleteFileHandler (client -> socketfd);
    if (client -> closeFlag) {
      tcpCloseClient (client);

      /* After tcpCloseClient executes, the client goes away.  Don't depend
	 on it's still being there. */

    } else {
      tcpPrepareClientForInput (client);
    }
  }
}   

/*
 * tcpPrepareClientForInput --
 *
 *	This procedure is invoked to prepare a client to accept command
 * input.  It establishes a handler, tcpReceiveClientInput, that does the
 * actual command buffering.
 */

static void
tcpPrepareClientForInput (client)
     Tcp_ClientData * client;
{
  Tcl_DStringTrunc(&client->inputBuffer, 0);

  simpleCreateFileHandler (client -> socketfd, SIMPLE_READABLE,
			   (Simple_FileProc *) tcpReceiveClientInput,
			   (ClientData) client);
}

/*
 * tcpReceiveClientInput --
 *
 *	This procedure is called when a server is awaiting input from a client
 * and the client socket tests to be `ready to read'.  It reads a bufferload
 * of data from the client, and places it in the client's command buffer.  If
 * the command is complete, it then tries to invoke the command.
 */

/* ARGSUSED */
static void
tcpReceiveClientInput (clientData, mask)
     ClientData clientData;
     int mask;
{
  register Tcp_ClientData * client = (Tcp_ClientData *) clientData;
  register Tcp_ServerData * server = client -> server;
  register Tcl_Interp * interp = server -> interp;

  static char buffer [BUFSIZ+1];
  int unixStatus;
  char * command;
  int status;

  /* Try to read from the client */

  errno = 0;
  unixStatus = read (client -> socketfd, buffer, BUFSIZ);
  if (unixStatus <= 0 && errno != EWOULDBLOCK)
    tcpClientReadError (client);

  /* tcpClientReadError closes the client and reports the error.
     In any case, if the read failed, we want to return. */

  if (unixStatus <= 0)
    return;

  /* Assemble the received data into the buffer */

  buffer [unixStatus] = '\0';
  command = Tcl_DStringAppend (&client -> inputBuffer, buffer, -1);
  if (Tcl_CommandComplete(command)) {
    /* Process the received command. */

    simpleDeleteFileHandler (client -> socketfd);
    /* Strip off the newline */
    command[strlen(command)-1] = '\0';
    status = tcpClientDoit(client, interp, command, 0);

    /* At this point, the client may have been closed.  Don't try to
       refer to it. */

    if (status != TCL_OK) {
      simpleReportBackgroundError (interp);
    }
  }
}

/* tcpClientReadError --
 *
 *	This procedure is called when an attempt to read the command from a
 * client fails.  There are two possibilities:
 *
 *	The first is that there really was a read error, originating in the
 * socket system.  In this case, the error should be reported at background
 * level, and the client should be closed.
 *
 *	The second is that the read reached the end-of-information marker in
 * the client's stream.  In this case, the `do' command should be called on
 * the client one last time, and then the client should be closed.
 *
 *	If the application needs to clean the client up after a read error,
 * it must define the `tcperror' procedure and process the error.
 */

static void
tcpClientReadError (client)
     Tcp_ClientData * client;
{
  Tcp_ServerData * server = client -> server;
  Tcl_Interp * interp = server -> interp;
  int status;

  if (errno != 0) {

    /* Read error */

    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, client->name, ": read error: ",
		     Tcl_PosixError (interp), (char *) NULL);
    simpleReportBackgroundError (interp);
    
  } else {

    /* End of file - execute client 'logout procedure' */

    status = tcpClientDoit(client, interp, NULL, 1);
    if (status != TCL_OK)
      simpleReportBackgroundError (interp);
  }

  tcpCloseClient (client);
}

/* tcpClientWriteError --
 *
 *	This procedure is invoked when an attempt to return results to a client
 * has failed.  It reports the error at background level and closes the client.
 *
 *	If the application needs to clean up the client after a write error,
 * it must define the `tcperror' procedure to catch the error.
 */

static void
tcpClientWriteError (client)
     Tcp_ClientData * client;
{
  Tcp_ServerData * server = client -> server;
  Tcl_Interp * interp = server -> interp;

  Tcl_ResetResult(interp);
  Tcl_AppendResult(interp, client->name, ": write error: ",
		   Tcl_PosixError (interp), (char *) NULL);
  simpleReportBackgroundError (interp);
  tcpCloseClient (client);
}

/*
 * tcpReceiveResultFromServer --
 *
 *	This procedure is invoked to get the result transmitted from
 * a remote server, either on establishing the connection or on processing
 * a command.  It returns a standard Tcl result that is usually the result
 * returned by the server.
 */

static int
tcpReceiveResultFromServer (interp, conobj)
     Tcl_Interp * interp;
     Tcp_ConnectionObject *conobj;
{
  int status;
  int unixStatus;
  Tcl_DString cmdbuf;
  struct timeval tick;
  struct timeval * tickp;
  fd_set readfds;
  char buf [BUFSIZ+1];
  char * reply;
  int rargc;
  char * * rargv;
  int rstatus;

  /* Make a buffer to receive the result */

  Tcl_DStringInit(&cmdbuf);

  /* Wait for the result to appear */

  tickp = (struct timeval *) 0;
  FD_ZERO( &readfds );
  FD_SET( conobj->f, &readfds );
  for ( ; ; ) {

    unixStatus = select (conobj->f + 1, &readfds, (fd_set *) NULL, (fd_set *) NULL,
			 tickp);

    if (unixStatus < 0) {
      status = TCL_ERROR;
      Tcl_AppendResult (interp, "error selecting socket for reply: ",
			Tcl_PosixError (interp), (char *) NULL);
      break;
    }

    if (unixStatus == 0) {
      status = TCL_ERROR;
      Tcl_SetResult (interp, "timed out waiting for server reply", TCL_STATIC);
      break;
    }

    /* Read the result */

    unixStatus = read (conobj->f, buf, BUFSIZ);

    if (unixStatus < 0) {
      status = TCL_ERROR;
      Tcl_AppendResult (interp, "error reading server reply: ",
			Tcl_PosixError (interp), (char *) NULL);
      break;
    }

    if (unixStatus == 0) {
      status = TCL_ERROR;
      Tcl_SetResult (interp, "Connection closed.", TCL_STATIC);
      break;
    }

    /* Parse the (partial) command */
    
    buf [unixStatus] = '\0';
    reply = Tcl_DStringAppend(&cmdbuf, buf, -1);
    if (Tcl_CommandComplete(reply)) {
      status = TCL_OK;
      break;
    }

    /* Partial command not yet complete.  Set timeout for reading the
     * rest of the result. */

    tick.tv_sec = 30;
    tick.tv_usec = 0;
    tickp = &tick;
  }

  /* When we come here, either the status is TCL_ERROR and the error
   * message is already set, or else the status is TCL_OK and `reply'
   * contains the result that we have to return.  The first element of
   * `reply' has the status, and the second has the result string. */

  /* Split the list elements */

  if (status == TCL_OK) {
    status = Tcl_SplitList (interp, reply, &rargc, &rargv);
    if (status != TCL_OK) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "server returned malformed list \"",
		       reply, "\"", (char *) NULL);
      status = TCL_ERROR;
    }
  }

  /* Verify the element count */

  if (status == TCL_OK) {
    if (rargc != 2) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "server returned malformed list \"",
		       reply, "\"", (char *) NULL);
      status = TCL_ERROR;
      ckfree ((char *) rargv);
    } else {
      status = Tcl_GetInt (interp, rargv [0], &rstatus);
      if (status != TCL_OK) {
	Tcl_SetResult (interp, "server returned unrecognizable status",
		       TCL_STATIC);
	status = TCL_ERROR;
	ckfree ((char *) rargv);
      }
    }
  }

  /* Return the result reported by the server */

  if (status == TCL_OK) {
    Tcl_SetResult (interp, rargv [1], TCL_VOLATILE);

    status = rstatus;
    ckfree ((char *) rargv);
  }

  Tcl_DStringFree(&cmdbuf);
  return status;
}

/*
 * tcpCompareTimerClient --
 *
 *   Compares the client ptr in 2 timerhandlers. Returns non-zero if they are the same
 *   Will handle correctly NULL clients (i.e. events detached from their client)
 */

static int
tcpCompareTimerClient (c1, c2)
     ClientData c1;
     ClientData c2;
{
  Tcp_TimerEvent *t1 = (Tcp_TimerEvent *) c1;
  Tcp_TimerEvent *t2 = (Tcp_TimerEvent *) c2;

  return t1->client == t2->client;
}


/*
 * tcpCompareTimerCommand --
 *
 *   Compares the Command ptr in 2 timerhandlers. Returns non-zero if they are the same
 *   Also compares client - restricts comparison to current client.
 */

static int
tcpCompareTimerCommand (c1, c2)
     ClientData c1;
     ClientData c2;
{
  Tcp_TimerEvent *t1 = (Tcp_TimerEvent *) c1;
  Tcp_TimerEvent *t2 = (Tcp_TimerEvent *) c2;

  if (t1->client != t2->client)
    return 0;

  if (!t2->command)
    return 1;

  return t1->command && !strcmp(t1->command, t2->command);
}


/*
 * tcpCompareTimerEvent --
 *
 *   Used by inline commands (e.g. tcpTimerVariableCommand)
 *   Matches actual timer event pointer.
 */

static int
tcpCompareTimerEvent (c1, c2)
     ClientData c1;
     ClientData c2;
{
  return c1 == c2;
}


/*
 * tcpDeleteTimerCommand --
 *
 *   Deletes the timer event data structure associated with a timerhandler.
 */

static void
tcpDeleteTimerEvent (clientData)
     ClientData clientData;
{
  Tcp_TimerEvent *tEventPtr = (Tcp_TimerEvent *) clientData;

  if (tEventPtr->command)
    ckfree(tEventPtr->command);
  ckfree((char *) tEventPtr);
}


/*
 * tcpPrintTimerCommand --
 *
 *   Return a list with period (zero if not-repeat) client ("Detached" if so) and command
 */

static char *
tcpPrintTimerEvent (clientData)
     ClientData clientData;
{
  Tcp_TimerEvent *tEventPtr = (Tcp_TimerEvent *) clientData;
  char *argv[3], period[16];

  if (tEventPtr->repeat)
    sprintf(period, "%ld",
	    tEventPtr->interval.tv_sec * 1000 + tEventPtr->interval.tv_usec / 1000);
  else
    sprintf(period, "0");
  argv[0] = period;

  if (tEventPtr->client)
    argv[1] = tEventPtr->client->name;
  else
    argv[1] = "Detached";

  argv[2] = tEventPtr->command;

  return Tcl_Merge(3, argv);
}

/*
 * tcpTimerEventProc --
 *
 *   Procedure called to execute Tcp after timer events. Resubmits them if periodic.
 */

static void
tcpTimerEventProc (clientData)
     ClientData clientData;
{
  Tcp_TimerEvent *tEventPtr = (Tcp_TimerEvent *) clientData;
  Tcp_ClientData *prevClient;
  int result, ms;
  struct timeval now;

  /* Test for null command used for that sleep thing if we implement it! */
  if (tEventPtr->command) {
    /*
     * Ok - need to do stuff to ensure that our client is still around, etc.
     * Record for use of tcp client command name of current client.
     * Also set active flag so it can't be deleted.
     */
    prevClient = tcpCurrentClient;
    tcpCurrentClient = tEventPtr->client;
    if (tEventPtr->client)
      tEventPtr->client->activeFlag++;

    result = Tcl_GlobalEval(tEventPtr->interp, tEventPtr->command);

    if (tEventPtr->client) {
      /*
       * If this is the last active event on this client and it is
       * marked for deletion, kill it! AND ensure that my repeat flag
       * is reset so I don't repeat myself with no client!
       */
      tEventPtr->client->activeFlag--;
      if (!tEventPtr->client->activeFlag && tEventPtr->client->closeFlag) {
	tcpCloseClient(tEventPtr->client);
	tEventPtr->repeat = 0;
      }
    }
    tcpCurrentClient = prevClient;

    if (result != TCL_OK)
      simpleReportBackgroundError (tEventPtr->interp);
  }

  if (tEventPtr->donePtr)
    /* This is used for sleep command (tcp after ms [no cmd]) */
    *tEventPtr->donePtr = 1;

  if (tEventPtr->repeat && !CancelCurrentTimerEvent) {
    /* This is a repeated event */

    /* First find out how much time elapsed during execution of the procedure */
    gettimeofday(&now, NULL);
    TIMEVAL_SUB(now, tEventPtr->time);

    /* Subtract elapsed time from interval to determine how long we should actually wait */
    now.tv_sec = tEventPtr->interval.tv_sec - now.tv_sec;
    now.tv_usec = tEventPtr->interval.tv_usec - now.tv_usec;
    if (now.tv_usec < 0) {
      now.tv_sec -= 1;
      now.tv_usec += 1000000;
    }
    ms = now.tv_sec < 0 ? 0 : now.tv_sec * 1000 + now.tv_usec / 1000;

    /* Ok store time at which we should execute next event (fictional of course if we have already taken longer than interval!) */
    TIMEVAL_ADD(tEventPtr->time, tEventPtr->interval);

    /* As well as ms interval, also pass in desired time. This will only help for
     * non-tk event handling. It's purpose is to save yet another gettimeofday sys call
     * and remove race conditions where the time changes b/n the 2 calls and I end
     * up registering an event that is 1 tick too late!
     * Note we will not provide a new time that is in the past. If this happened
     * a process with a short period and long execution could get in many copies of
     * itself in a space of time equal to that of a few periods of another process
     * with longer period, but shorter exec time
     */
    simpleCreateTimerHandler(ms, tcpTimerEventProc, (ClientData) tEventPtr,
			     now.tv_sec >= 0 ? &tEventPtr->time : NULL);
  } else {
    /* Clean out the structure */
    if (tEventPtr->command)
      ckfree(tEventPtr->command);
    ckfree((char *) tEventPtr);
  }

  CancelCurrentTimerEvent = 0;
}
