/* Dbgtk.c -- Code for Tk debugger interface.
 * tromey Fri Jul 15 1994
 */


#include <assert.h>
#include <malloc.h>
#include <netdb.h>
#include <string.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/stat.h>
#include <sys/un.h>

#include "tcl.h"
#include "tk.h"
#include "Dbg.h"
#include "Dbgtkint.h"



/*
 * This section has functions that return the name of the debugger
 * directory (for this user) and the debugger file (for a particular
 * process).
 */

/* FIXME should be dynamically sized.  But this works. */
static char name[256];

/*
 * Return pointer to name of Unix socket, given uid and pid.
 * Name is static, so make sure you use it "quickly".
 */
static char *get_server_name (uid, pid)
uid_t uid;
pid_t pid;
{
  sprintf (name, "/tmp/.debug%d/%d", (int) uid, (int) pid);
  return (name);
}

/*
 * Return pointer to name of Unix directory that our socket will be
 * in.  Return is static.
 */
static char *get_directory_name (uid)
uid_t uid;
{
  sprintf (name, "/tmp/.debug%d", (int) uid);
  return (name);
}



/*
 * Try to connect to some debuggable process.  PID is the process id
 * of the debugee.  Returns fd if all went well.  Returns -1 and puts
 * error message in interpreter otherwise.
 */
int Dbg_connect_to_server (interp, pid)
Tcl_Interp *interp;
pid_t pid;
{
  uid_t uid = getuid ();
  char *server = get_server_name (uid, pid);
  struct sockaddr_un address;
  int fd;
  struct protoent *proto;

  address.sun_family = AF_UNIX;
  strcpy (address.sun_path, server);

  fd = socket (PF_UNIX, SOCK_STREAM, 0);
  if (fd == -1)
    {
      Tcl_AppendResult (interp, "could not make socket: ",
			Tcl_PosixError (interp), NULL);
      return (-1);
    }

  if (connect (fd, &address, sizeof (struct sockaddr_un)) == -1)
    {
      Tcl_AppendResult (interp, "could not connect to server: ",
		       Tcl_PosixError (interp), NULL);
      close (fd);
      return (-1);
    }

  return (fd);
}



/*
 * Write to a pipe.  Keep going until done.  Return 0 on error.
 */
static int write_to_pipe (fd, string, n)
int fd;
char *string;
int n;
{
  int done = 0;
  while (n > 0)
    {
      int r = write (fd, string + done, n);
      if (r == -1)
	return (0);
      n -= r;
      done += r;
    }
  return (1);
}

/*
 * Write counted string to fd.  Return 0 on error.
 */
int Dbg_write (fd, string)
int fd;
char *string;
{
  int len = strlen (string);
  int done;

  /* Never write an empty string, because it will be misinterpreted as */
  /* a mark. */
  if (len == 0)
    return;

  /* Write length of string first.  Since we are operating only on the */
  /* local machine, we can make assumptions about byte ordering. */
  /* Sick. */
  if (!write_to_pipe (fd, &len, sizeof (int))
      || !write_to_pipe (fd, string, len))
    return (0);
  return (1);
}

/*
 * Write a mark.  Return 0 on error.
 */
int Dbg_mark (fd)
int fd;
{
  int len = 0;
  return (write_to_pipe (fd, &len, sizeof (int)));
}

/*
 * Read from a pipe.  First reads length, and then reads that many
 * bytes.  Returns "" when 
 */
char *Dbg_read (fd)
int fd;
{
  int len;
  char *buffer;
  int done = 0;
  int amt;

  amt = read (fd, &len, sizeof (int));
  if (amt != sizeof (int))
    return (NULL);

  /* If we have a mark, return a non-malloc'd empty string. */
  if (len == 0)
    return ("");

  buffer = malloc (len + 1);
  buffer[len] = '\0';

  while (len > 0)
    {
      int r = read (fd, buffer + done, len);
      if (r < 0)
	{
	  free (buffer);
	  return (NULL);
	}
      done += r;
      len -= r;
    }

  return (buffer);
}



/* State definitions. */
#define WAITING 0		/* Waiting for connection. */
#define IDLE    1		/* Connection made, not debugging. */
#define INDEBUG 2		/* Debugging. */

/* Struct to hold info we need. */
struct info
{
  Tcl_Interp *interp;		/* Tcl interpreter. */
  int fd;			/* fd we accept connections on. */
  int accepted;			/* Accepted fd, or -1. */
  int state;			/* State. */

  Dbg_InterStruct old_inter;	/* Old interactor. */
  Dbg_OutputStruct old_out;	/* Old output handler. */
};



/*
 * Output proc.  This is passed output as a string.  It just sends it
 * through the socket.
 */
static void output (interp, string, data)
Tcl_Interp *interp;
char *string;
ClientData data;
{
  struct info *info = (struct info *) data;

  /* Just ignore errors. */
  Dbg_write (info->accepted, string);
}

/*
 * Interaction proc.  This reads user input from the socket and writes
 * the output back to the socket.
 */
static int interactor (interp, data)
Tcl_Interp *interp;
ClientData data;
{
  int rc;
  char *ccmd;
  char line[BUFSIZ + 1];
  int leave = 0;
  int result;
  Tcl_DString dstring;
  struct info *info = (struct info *) data;

  Tcl_DStringInit (&dstring);

  /* Mark here because debugger prints some stuff on startup. */
  Dbg_mark (info->accepted);
  while (!leave)
    {
      while (1)
	{
	  char *line = Dbg_read (info->accepted);
	  if (line == NULL)
	    {
	      /* Error of some sort.  What to do now? */
	      Dbg_Off (interp);
	      info->state = WAITING;
	      close (info->accepted);
	      info->accepted = -1;

	      /* Restore old interactors in case another debuger is running. */
	      Dbg_Interactor (info->interp, info->old_inter.func,
			      info->old_inter.data);
	      Dbg_Output (info->interp, info->old_out.func,
			  info->old_out.data);
	      return (TCL_ERROR);
	    }
	  if (*line == '\0')
	    break;

	  ccmd = Tcl_DStringAppend (&dstring, line, -1);
	  free (line);
	}

      if (!Tcl_CommandComplete (ccmd))
	continue;

      rc = Tcl_RecordAndEval (interp, ccmd, 0);
      Tcl_DStringFree (&dstring);

      switch (rc)
	{
	case TCL_OK:
	  Dbg_write (info->accepted, interp->result);
	  break;

	case TCL_ERROR:
	  {
	    char *error = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
	    Dbg_write (info->accepted, error);
	    break;
	  }

	case TCL_BREAK:
	case TCL_CONTINUE:
	  result = rc;
	  leave = 1;
	  break;

	case TCL_RETURN:
	  result = TCL_OK;
	  leave = 1;
	  break;

	default:
	  {
	    char msg[100];
	    sprintf (msg, "error %d: ", rc);
	    Dbg_write (info->accepted, msg);
	    break;
	  }
	}

      /* Tell remote that printing is over.  Only do this if we are */
      /* looping. */
      if (!leave)
	Dbg_mark (info->accepted);
    }

  Tcl_DStringFree (&dstring);
  return (result);
}

/*
 * Handle whatever information comes over the socket we are reading.
 */
static void handle_file (cd, mask)
ClientData cd;
int mask;
{
  struct info *info = (struct info *) cd;
  int newfd;
  int len = sizeof (struct sockaddr_un);
  struct sockaddr_un dummy;

  assert (mask == TK_READABLE);

  newfd = accept (info->fd, &dummy, &len);
  if (newfd == -1)
    {
      /* FIXME print error here. */
      return;
    }

  if (info->state == WAITING)
    {
      char command[256];

      info->state = INDEBUG;
      info->accepted = newfd;

      info->old_inter = Dbg_Interactor (info->interp,
					interactor, (ClientData) info);
      info->old_out = Dbg_Output (info->interp, output, (ClientData) info);

      /* We do a Tcl_Eval here so that the interactor is guaranteed to */
      /* never run its commands at top level (at top level, TCL_RETURN */
      /* is changed to TCL_OK, which messes things up. */
      /* FIXME if using gcc, must use -fwritable-strings because of */
      /* Tcl bug . */
      sprintf (command, "%s -now 1", Dbg_DefaultCmdName);
      Tcl_Eval (info->interp, command);

      info->state = IDLE;
    }
  else
    {
      /* We are already being debugged.  Kill other "client" */
      /* connection. */
      close (newfd);
    }
}

/*
 * Clean up when the interpreter is deleted.
 */
static void handle_deletion (cd, interp)
ClientData cd;
Tcl_Interp *interp;
{
  struct info *info = (struct info *) cd;
  uid_t uid = getuid ();
  pid_t pid = getpid ();
  char *name;

  assert (info->interp == interp);

  /* Close our socket. */
  if (info->accepted != -1)
    close (info->accepted);
  close (info->fd);
  free (info);

  /* Now unlink the socket.  Ignore errors -- what difference does it */
  /* make? */
  name = get_server_name (uid, pid);
  unlink (name);
}

/*
 * Call this to initialize the interpreter for debugging.  This calls
 * Dbg_Init, so you needn't bother.  This assumes you are using Tk.
 */
int Dbg_InitTk (interp)
Tcl_Interp *interp;
{
  char *name;
  uid_t uid = getuid ();
  pid_t pid = getpid ();
  struct protoent *proto;
  struct sockaddr_un address;
  int fd;
  struct info *info;
  struct stat dummy;

  /* Make directory that contains our Unix socket. */
  name = get_directory_name (uid);
  if (stat (name, &dummy) == -1)
    {
      if (mkdir (name, 0700) == -1)
	{
	  Tcl_AppendResult (interp, "couldn't make directory: ",
			    Tcl_PosixError (interp), NULL);
	  return (TCL_ERROR);
	}
    }

  fd = socket (PF_UNIX, SOCK_STREAM, 0);
  if (fd == -1)
    {
      Tcl_AppendResult (interp, "could not make socket: ",
			Tcl_PosixError (interp), NULL);
      return (TCL_ERROR);
    }

  name = get_server_name (uid, pid);
  address.sun_family = AF_UNIX;
  strcpy (address.sun_path, name);
  if (bind (fd, &address, sizeof (struct sockaddr_un)) == -1)
    {
      Tcl_AppendResult (interp, "could not bind to server address: ",
			Tcl_PosixError (interp), NULL);
      close (fd);
      return (TCL_ERROR);
    }

  if (listen (fd, 5) == -1)
    {
      Tcl_AppendResult (interp, "could not listen on server port: ",
			Tcl_PosixError (interp), NULL);
      close (fd);
      return (TCL_ERROR);
    }

  info = (struct info *) malloc (sizeof (struct info));
  info->interp = interp;
  info->fd = fd;
  info->accepted = -1;
  info->state = WAITING;

  /* Now "fd" is the server socket.  Set up a listening function, and */
  /* return. */
  Tk_CreateFileHandler (fd, TK_READABLE, handle_file, (ClientData) info);

  /* Arrange to clean up when interpreter deleted. */
  Tcl_CallWhenDeleted (interp, handle_deletion, (ClientData) info);

  return (Dbg_Init (interp));
}
