/* LINTLIBRARY */
/*
 *	Copyright (c) 1995, 1996, 1997, 1998, Sun Microsystems, Inc.
 *
 * This software is provided by Sun ``AS IS'' and any express or implied
 * warranties, including, but not limited to, the implied warranties of
 * merchantability and fitness for a particular purpose are disclaimed.
 * In no event shall Sun Microsystems be liable for any direct, indirect,
 * incidental, special, exemplary, or consequential damages.
 *
 * This software is not a product, and is provided for evaluation purposes
 * only.
 *
 * This software may not be resold without the express permission of
 * Sun Microsystems.
 *
 * Feedback on this tool may be sent to packet-shell-owner@sunroof.eng.sun.com.
 *
 * Packet Shell
 *
 */

#pragma ident	"@(#)psh.c	1.75	00/01/14 SMI"

#include <stdio.h>
#include <stdlib.h>
#include <fcntl.h>
#include <ctype.h>
#include <errno.h>
#include <dirent.h>
#include <dlfcn.h>
#include <string.h>
#include <strings.h>
#include <stdlib.h>
#include <unistd.h>
#include <limits.h>
#include <netdb.h>

/*
 * Most BSD-derived systems have machine/endian.h, but Solaris is different.
 */
#ifdef	SOLARIS
#include <sys/byteorder.h>
#else
#include <machine/endian.h>
#endif

#include <tcl.h>
#ifdef WINDOWS
#include <tk.h>
#include <blt.h>
#endif

#include "psh.h"
#include "proto.h"
#include "version.h"

/*
 * SunOS prior to 5.6 did not have RTLD_DEFAULT defined
 */

#ifndef	RTLD_DEFAULT
#define	RTLD_DEFAULT	RTLD_NEXT
#endif

/*
 * Define a macro used for strdup with a nice error message
 * since we use this construct everywhere.
 */

#define	psh_strdup(a, b)	if ((a = strdup(b)) == NULL) { \
					Tcl_AppendResult(interp, \
					    "Internal Error: ", \
					    "malloc: no space", NULL); \
					return (TCL_ERROR); \
				}

static Tcl_Interp *interp;

static Tcl_HashTable packets;
static Tcl_HashTable protocols;
static Tcl_HashTable endpoints;

static char dirname[PATH_MAX];
static char psh_home[PATH_MAX];

static void init_psh_proto(Tcl_Interp *interp);

/*
 * In order to keep the floating point elapsed time from being gratuitously
 * large, this value is subtracted from the seconds field of all time-of-day
 * readings taken.
 */
int	seconds_bias;

/*
 * SunOS prior to 5.8 did not have IPv6 support functions:
 *	inet_ntop();
 *	inet_pton();
 *	getipnodebyname().
 */

static	int (*getipnodebynameptr)();
static	int (*inet_ntopptr)();
static	int (*inet_ptonptr)();

struct hostent	*
getipnodebyname(const char *name, int af, int flags, int *error_num)
{
	struct hostent	*hp = NULL;

	if (getipnodebynameptr != NULL) {
		hp = (struct hostent *)(*getipnodebynameptr)(name, af, flags,
			&error_num);
	} else {
		(void) printf("The OS doesn't support getipnodebyname()\n");
	}
	return (hp);
}

const char *
inet_ntop(int af, const void *ap, char *cp, size_t len)
{
	char *p = NULL;

	if (inet_ntopptr != NULL) {
		p = (char *)(*inet_ntopptr)(af, ap, cp, len);
	} else {
		(void) printf("The OS doesn't support inet_ntop()\n");
	}
	return (p);
}

int
inet_pton(int af, const char *cp, void *ap)
{
	int i = 0;

	if (inet_ptonptr != NULL) {
		i = (int)(*inet_ptonptr)(af, cp, ap);
	} else {
		(void) printf("The OS doesn't support inet_pton()\n");
	}
	return (i);
}


/*
 * psh_new_ep allocates a new endpoint based on the size given as
 * proto_epsize in the proto_tbl.  It returns a pointer to the
 * new endpoint, or NULL if it could not allocate memory.
 */
ep_t *
psh_new_ep(char *name, struct proto_tbl *prototbl)
{
	ep_t *new_ep;

	if ((new_ep = (ep_t *)malloc(prototbl->proto_epsize)) == NULL) {
		return (NULL);
	}
	(void) memset(new_ep, 0, prototbl->proto_epsize);

	if (NULL == (new_ep->ep_name = strdup(name))) {
		free(new_ep);
		return (NULL);
	}

	new_ep->ep_prototbl = prototbl;
	new_ep->ep_action_head = NULL;
	new_ep->ep_action_count = 0;

	return (new_ep);
}

/*
 * psh_free_ep frees an endpoint structure.
 */
static void
psh_free_ep(ep_t *ep)
{
	free(ep->ep_name);
	free(ep);
}

/*
 * psh_find_ep finds an end point in the global list, and returns a
 * pointer to it.
 */
ep_t *
psh_find_ep(char *name)
{
	Tcl_HashEntry *entryPtr;

	entryPtr = Tcl_FindHashEntry(&endpoints, name);
	if (entryPtr == NULL) {
		return (NULL);
	} else {
		return ((ep_t *)Tcl_GetHashValue(entryPtr));
	}
}

/*
 * psh_add_ep adds an end-point to the table.
 */
ep_t *
psh_add_ep(ep_t *ep)
{
	Tcl_HashEntry *entryPtr;
	int epexists;

	entryPtr = Tcl_CreateHashEntry(&endpoints, ep->ep_name, &epexists);
	if (epexists == TCL_OK) {
		return (NULL);
	} else {
		Tcl_SetHashValue(entryPtr, ep);
		return (ep);
	}
}

/*
 * psh_remove_ep finds the end-point of the given name, and removes
 * it from the global linked list.  It DOES NOT free the end-point, but
 * rather returns the end-point to the caller with NULL next and prev pointers.
 */
static ep_t *
psh_remove_ep(char *name)
{
	Tcl_HashEntry *entryPtr;
	ep_t *ep;

	entryPtr = Tcl_FindHashEntry(&endpoints, name);
	if (entryPtr == NULL) {
		return (NULL);
	}

	ep = (ep_t *)Tcl_GetHashValue(entryPtr);
	Tcl_DeleteHashEntry(entryPtr);
	return (ep);
}

static uint_t
pshaction_get_action_count(ep_t *ep)
{
	return (ep->ep_action_count);
}

int
pshaction_add_action(ClientData clientData, Tcl_Interp *interp, int argc,
    char *argv[])
{
	struct auto_action *aap;
	struct auto_action *last_actionp;
	ep_t *ep;
	int index;
	int i;
	uchar_t tflag;

	if ((argc < 5) || (argc > 6)) {
usage:
		Tcl_AppendResult(interp, "add action: ",
		    "Usage: ", argv[0], " <index> <id>"
		    " <filter command> <action command>"
		    " [continue] ", NULL);
		return (TCL_ERROR);
	}

	ep = (ep_t *)clientData;

	/*
	 * If the user specifies the "end" index, find that end.
	 * Note that the index starts at 1.
	 */

	if (strcmp(argv[1], "end") == 0) {
		index = pshaction_get_action_count(ep) + 1;
	} else if (Tcl_GetInt(interp, argv[1], &index) != TCL_OK) {
		Tcl_AppendResult(interp, "add action: ", argv[1],
		    " is not a valid index", NULL);
		return (TCL_ERROR);
	} else if (index < 1) {
		Tcl_AppendResult(interp, "add action: ",
		    "minimum index is 1", NULL);
	}

	/*
	 * If the user has specified that this is a nonterminal
	 * condition, prepare the appropriate flag for the
	 * auto-action struct.
	 */

	tflag = 1;
	if (argc == 6) {
		if (strcmp(argv[5], "continue") == 0 ||
		    strcmp(argv[5], "noterm") == 0) {
			tflag = 0;
		} else {
			goto usage;
		}
	}

	/* Allocate and insert an auto-action structure into the list */

	aap = ep->ep_action_head;
	last_actionp = ep->ep_action_head;
	for (i = 1; i < index; i++) {
		if (aap == NULL) {
			Tcl_AppendResult(interp, "add action: ",
			    "index ", argv[1], " is too large ", NULL);
			return (TCL_ERROR);
		} else {
			last_actionp = aap;
			aap = aap->aa_next;
		}
	}

	aap = (struct auto_action *)malloc(sizeof (struct auto_action));
	if (aap == NULL) {
		Tcl_AppendResult(interp, "Error: out of memory.", NULL);
		return (TCL_ERROR);
	}

	/* Fill in the auto-action structure with the provided information. */

	aap->aa_id = strdup(argv[2]);
	aap->aa_filter_comm = strdup(argv[3]);
	aap->aa_action_comm = strdup(argv[4]);
	if (aap->aa_id == NULL || aap->aa_filter_comm == NULL ||
	    aap->aa_action_comm == NULL) {
		Tcl_AppendResult(interp, "Error: out of memory.", NULL);
		free(aap);
		return (TCL_ERROR);
	}
	aap->aa_terminal = tflag;

	if (ep->ep_action_head == NULL || index == 1) {
		aap->aa_next = ep->ep_action_head;
		ep->ep_action_head = aap;
	} else {
		aap->aa_next = last_actionp->aa_next;
		last_actionp->aa_next = aap;
	}

	return (TCL_OK);
}

static void
pshaction_delete_all_actions(struct auto_action *head)
{
	struct auto_action *temp;
	struct auto_action *action_ptr = head;

	while (action_ptr != NULL) {
		temp = action_ptr;
		free(action_ptr->aa_id);
		free(action_ptr->aa_action_comm);
		free(action_ptr->aa_filter_comm);
		action_ptr = action_ptr->aa_next;
		free(temp);
	}
}

/*
 * pshaction_del_action --
 *                  Called by <ep>.del_action <action id> from tcl.
 *                  Removes the action (if found) from the action list.
 */
int
pshaction_del_action(ClientData clientData, Tcl_Interp *interp, int argc,
    char *argv[])
{
	ep_t		   *epsp;
	struct auto_action *aatp;
	struct auto_action *aatnp;

	epsp = (ep_t *)clientData;
	if (argc != 2) {
		Tcl_AppendResult(interp, "del action: ",
		    "Usage: ", argv[0], " <id>", NULL);
		return (TCL_ERROR);
	}

	if (epsp->ep_action_head == NULL) {
		goto notfound;
	}

	aatp = epsp->ep_action_head;

	if (strcmp(aatp->aa_id, argv[1]) == 0) {
		epsp->ep_action_head = aatp->aa_next;
		free(aatp->aa_filter_comm);
		free(aatp->aa_action_comm);
		free(aatp->aa_id);
		free(aatp);
		return (TCL_OK);
	}
	while (aatp->aa_next != NULL) {
		if (strcmp(aatp->aa_next->aa_id, argv[1]) == 0) {
			aatnp = aatp->aa_next;
			aatp->aa_next = aatp->aa_next->aa_next;
			free(aatnp->aa_filter_comm);
			free(aatnp->aa_action_comm);
			free(aatnp->aa_id);
			free(aatnp);
			return (TCL_OK);
		} else {
			aatp = aatp->aa_next;
		}
	}

	/* The action id has not been found */
notfound:
	Tcl_AppendResult(interp, "del action: ",
	    "action ", argv[0], " not found", NULL);
	return (TCL_ERROR);
}

/*
 * pshaction_apply_actions --
 *	Given a packet and an end-point, apply the filter/action
 *	pairs to the packet.  The processing is as follows:
 *	The filter/action pairs are applied in the order that they are found
 *	in the list of actions.  If a filter returns a value other than zero,
 *	the associated action is performed.  The Tcl variable PSH_FILTER_STATUS
 *	is initialized to hold the return value of the filter in case the
 *	action needs this information.  If this is a "terminal" action (the
 *	action was not added with the "continue" argument), the Tcl result
 *	is set to "packet" and processing stops.  If the result of the filter
 *	is 0, or if this is not a terminal action (the action was added with
 *	the "continue" argument), the next filter/action pair is processed.
 *	If no "terminal" filters match, the Tcl result is set to "nomatch".
 */
int
pshaction_apply_actions(Tcl_Interp *interp, struct packet *pckt,
    ep_t *epsp, int *tcl_retval)
{
	struct auto_action *action_tempp;
	int filter_match;
	char *filter_status_string;
	int filter_has_matched = 0;

	/* Iterate through all the filter/action pairs */
	for (action_tempp = epsp->ep_action_head; action_tempp != NULL;
	    action_tempp = action_tempp->aa_next) {
		*tcl_retval = Tcl_Eval(interp, action_tempp->aa_filter_comm);

		/*
		 * if Tcl_Eval didn't return TCL_OK, the filter command
		 * must have been bad.
		 */
		if (*tcl_retval != TCL_OK) {
			Tcl_AppendResult(interp, " Filter command ",
			    action_tempp->aa_filter_comm, " is bad", NULL);
			return (0);
		}

		/*
		 * save the return value of the filter so that we can
		 * put it into the Tcl variable PSH_FILTER_STATUS.
		 */
		filter_status_string = strdup(interp->result);

		/*
		 * Check the return value of the filter.  If it's not an
		 * integer, than obviously it's not "0" so by default, it's
		 * a match.  We then set filter_match to 1.
		 */
		if (Tcl_GetInt(interp, filter_status_string, &filter_match) !=
		    TCL_OK) {
			filter_match = 1;
		}

		/*
		 * If the filter returned "0", continue to the next
		 * filter.
		 */
		if (filter_match == 0) {
			continue;
		}

		filter_has_matched = 1;

		/*
		 * Save filter_status into the Tcl variable PSH_FILTER_STATUS.
		 */
		if (Tcl_SetVar(interp, "PSH_FILTER_STATUS",
		    filter_status_string, TCL_LIST_ELEMENT) == NULL) {
			Tcl_AppendResult(interp, "Could not set "
			    "PSH_FILTER_STATUS.", NULL);
			*tcl_retval = TCL_ERROR;
			return (0);
		}

		/* Perform the action associated with the filter */
		*tcl_retval = Tcl_Eval(interp, action_tempp->aa_action_comm);
		/*
		 * if Tcl_Eval didn't return TCL_OK, the action
		 * must have been bad.
		 */
		if (*tcl_retval != TCL_OK) {
			Tcl_AppendResult(interp, " Action command ",
			    action_tempp->aa_action_comm, "is bad ", NULL);
			return (0);
		}

		if (action_tempp->aa_terminal) {
			Tcl_ResetResult(interp);
			Tcl_AppendResult(interp, "packet", NULL);
			*tcl_retval = TCL_OK;
			return (0);
		}

		/*
		 * If we're here, it means that the filter matched,
		 * but this is a non-terminal filter (ie, it was added
		 * with the "continue" flag.  In this case, we simply go
		 * on to the next filter.
		 */
	}

	if (filter_has_matched == 0) {
		Tcl_AppendResult(interp, "nomatch", NULL);
		*tcl_retval = TCL_OK;
		return (0);
	}
	return (1);
}

int
pshaction_wait_action(ClientData clientData, Tcl_Interp *interp, int argc,
    char *argv[])
{
	ep_t *epsp = (ep_t *)clientData;

	if (argc < 2 || argc > 3) {
		Tcl_AppendResult(interp, "Usage: ", argv[0],
		    " <pckt> [<timeout>] ;# <timeout> in milliseconds", NULL);
		return (TCL_ERROR);
	}

	/* Make sure we have something to wait for */
	if (epsp->ep_action_head == NULL) {
		Tcl_AppendResult(interp, "wait action: no actions found",
		    NULL);
		return (TCL_ERROR);
	}

	/*
	 * We need to set $PSH_ACTION_PACKET to the packet passed in
	 * as the first argument to the <ep>.wait_action call.
	 */
	if (Tcl_SetVar(interp, "PSH_ACTION_PACKET", argv[1],
	    TCL_LIST_ELEMENT) == NULL) {
		Tcl_AppendResult(interp, "Could not set "
		    "PSH_ACTION_PACKET.", NULL);
		return (TCL_ERROR);
	}

	/* Call the protocol specific proto_waitaction if present */
	if (NULL == epsp->ep_prototbl->proto_waitaction) {
		Tcl_AppendResult(interp, "wait action is not supported ",
		    "for ", epsp->ep_prototbl->proto_name, NULL);
		return (TCL_ERROR);
	} else {
		return ((epsp->ep_prototbl->proto_waitaction)(clientData,
		    interp, argc, argv));
	}
}

int
pshaction_actions(ClientData clientData, Tcl_Interp *interp, int argc,
    char *argv[])
{
	ep_t *epsp = (ep_t *)clientData;
	struct auto_action *aap;
	int index;

	if (epsp->ep_action_head == NULL) {
		Tcl_AppendResult(interp, "None.", NULL);
		return (TCL_OK);
	}

	for (aap = epsp->ep_action_head, index = 1; aap != NULL;
	    aap = aap->aa_next, index++) {
		(void) printf("%d\n", index);
		(void) printf("action id:      %s\n", aap->aa_id);
		(void) printf("filter command: %s\n", aap->aa_filter_comm);
		(void) printf("action command: %s\n", aap->aa_action_comm);
		(void) printf("continue?:      %s\n",
		    aap->aa_terminal ? "no\n" : "yes\n");
	}

	return (TCL_OK);
}

/*
 * This function is used to build the string to pass to Tcl_Eval
 * which is composed of a Tcl procedure and it's arguments.  Name
 * represents the dynamic protocol's Tcl procedure name for set or
 * get, and pktname refers to the name of the packet.  Offset and
 * size are the corresponding size and offset of the field in the
 * dynamic protocol.  You can specify optional arguments in addition
 * with the pset/pget command and this concatenated to the string.
 */
static int
evalcommand(Tcl_Interp *interp, char *name, char *pktname, int offset,
    int size, int argc, char *argv[])
{
	Tcl_DString command;
	char tmp[BUFSIZ];
	int i, retval;

	Tcl_DStringInit(&command);
	(void) Tcl_DStringAppend(&command, name, strlen(name));
	(void) Tcl_DStringAppendElement(&command, pktname);
	(void) Tcl_DStringAppendElement(&command, argv[2]);
	(void) sprintf(tmp, "%d", offset);
	(void) Tcl_DStringAppendElement(&command, tmp);
	(void) sprintf(tmp, "%d", size);
	(void) Tcl_DStringAppendElement(&command, tmp);
	for (i = 4; i < argc; i++)
		(void) Tcl_DStringAppendElement(&command, argv[i]);
	/*
	 * Note we are using the same interp as passed in from the
	 * caller.  Need to check whether we can create a new interpreter
	 * that inherits variables, procedures from the parent otherwise
	 * stick with this.
	 */
	retval = Tcl_Eval(interp, Tcl_DStringValue(&command));
	Tcl_DStringFree(&command);
	return (retval);
}

/*
 * This function is used to check the get/set function argument to
 * the pdefine command.  The variable procname represents the name
 * of the Tcl procedure.  We return TCL_OK if we find one in the Tcl
 * interpreter environment, otherwise TCL_ERROR.
 */

static int
checkTclcommand(Tcl_Interp *interp, char *procname)
{
	Tcl_CmdInfo infoPtr;

	if (Tcl_GetCommandInfo(interp, procname, &infoPtr) == 1) {
		return (TCL_OK);
	} else {
		return (TCL_ERROR);
	}
}

/*
 * This function is used to check the get/set function argument to
 * the pdefine command.  The variable funcname represents the name
 * of a C function in the Packet Shell source code (i.e., psh_utils.c)
 * and the ptr variable is where we store the address to the function.
 * We return TCL_OK if we find one, otherwise we output a diagnostic
 * message indicating the argument isn't a Tcl procedure or C function
 * and return TCL_ERROR.
 */

static int
checkCfunc(Tcl_Interp *interp, char *funcname, int (**ptr)())
{
	int (*temp)();

	if (ptr == NULL)
		ptr = &temp;
	*ptr = (int (*)())dlsym(RTLD_DEFAULT, funcname);
	if (*ptr == NULL) {
		Tcl_AppendResult(interp, "Warning: Unknown ",
		    "Tcl procedure or C function: ", funcname, NULL);
		return (TCL_ERROR);
	}
	return (TCL_OK);
}

/*
 * Update a packet's packet table.  Called with the possibly new protocol
 * name, and the possibly new offset.  The protocol name is referenced,
 * but a freshly allocated copy is kept in the packet table itself, which
 * we take care to free when changed, or when the packet is freed.
 * The special value PTBL_KEEP_OFFSET, passed as the offset, is used to
 * indicate that the offset value should not be changed.  Presumably
 * that's because the operation is only to change the name of a segment.
 */
int
ptbl_update(struct packet *pckt, int index, const char *name, ssize_t offset)
{
	char *elemname;

	/*
	 * Make sure the packet table is large enough.  Note that we can't
	 * check p_lptbl, because p_lptbl is momentarily too low if the
	 * overall packet table is growing.
	 */
	if (index >= pckt->p_nptbl) {
		/*
		 * It's likely that the caller is broken.  They've asked
		 * to replace an element beyond the end of the table.
		 * The simplicity of how it's coded now also means that
		 * you can't grow the table implicitly by a ptbl_update()
		 * which should work.
		 */
		(void) fprintf(stderr,
		    "Internal Error: ptbl_update: index `%d' too large\n",
		    index);
		return (0);
	}

	/*
	 * Update the name.
	 */
	if (name != NULL) {
		if ((elemname = strdup(name)) == NULL) {
			(void) fprintf(stderr,
			    "Internal Error: ptbl_update: strdup failed\n");
			return (0);
		}

		/*
		 * if we deleted an "end" and we're not an end ourself,
		 * put it back on
		 */
		if (pckt->p_tbl[index].pt_name != NULL &&
		    (strcmp(pckt->p_tbl[index].pt_name, "end") == 0) &&
		    (strcmp(name, "end") != 0)) {
			if (ptbl_update(pckt, index + 1, "end", pckt->p_len) ==
			    0) {
				return (0);
			}
		}
		if (pckt->p_tbl[index].pt_name != NULL) {
			free(pckt->p_tbl[index].pt_name);
			pckt->p_tbl[index].pt_name = NULL;
		}
		pckt->p_tbl[index].pt_name = elemname;
	}

	/*
	 * Update the offset
	 */
	if (index > pckt->p_lptbl || (name != NULL && strcmp(name, "end") == 0))
		pckt->p_lptbl = index;

	if (offset != PTBL_KEEP_OFFSET)
		pckt->p_tbl[index].pt_offset = offset;

	return (1);
}


/*
 * Packet table destructor - Free all packet table resources.
 */
static void
ptbl_dtor(struct packet *pckt)
{
	size_t i;

	if (pckt != NULL) {
		for (i = 0; i <= pckt->p_lptbl; i++) {
			free(pckt->p_tbl[i].pt_name);
			pckt->p_tbl[i].pt_name = NULL;
		}
	}
	free(pckt->p_tbl);
	pckt->p_tbl = NULL;
}

/*
 * Packet table constructor - Create a new packet table, allocating
 * space, and beginning life with only an "end" segment, beginning at
 * offset zero.
 */
static bool_t
ptbl_ctor(struct packet *pckt, const char *proto_name, int nptbl)
{
	if (pckt->p_tbl != NULL) {
		int i;

		for (i = 0; i <= pckt->p_nptbl; i++) {
			free(pckt->p_tbl[i].pt_name);
		}
		free(pckt->p_tbl);
	}
	pckt->p_tbl = calloc(nptbl, sizeof (struct ptbl));
	if (pckt->p_tbl == NULL) {
		return (BFALSE);
	}

	pckt->p_lptbl = 1;
	pckt->p_nptbl = nptbl;
	if (ptbl_update(pckt, 0, proto_name, 0) == 0) {
		ptbl_dtor(pckt);
		return (BFALSE);
	}

	if (ptbl_update(pckt, 1, "end", 0) == 0) {
		ptbl_dtor(pckt);
		return (BFALSE);
	}
	return (BTRUE);
}
/*
 * Packet table initialization
 */
int
ptbl_init(struct packet *pckt, const char *name)
{
	ptbl_dtor(pckt);
	if (!ptbl_ctor(pckt, name, PTBL_INCR)) {
		return (0);
	}

	/*
	 * The constructor above has set the first packet element to 'name'.
	 * Now call the decode functions in turn work out the boundaries
	 * and components of this packet, filling out the packet table
	 * as we go.
	 */
	return (bootstrap_packet(pckt, 0));
}

/*
 * ptbl_fix_length --
 *	Given a length for a ptbl element of a packet, tries to give that
 *	element the specified length.  Following protocols are copied "down"
 *	if necessary.  Returns TCL_OK if successful, TCL_ERROR on failure.
 */

int
ptbl_fix_length(struct packet *pckt, int element, int length)
{
	int currlen;
	int needlen;
	int copylen;
	char *tempbuf;
	char *copystart;
	int i;

	currlen = pckt->p_tbl[element+1].pt_offset -
	    pckt->p_tbl[element].pt_offset;
	needlen = length - currlen;
	copylen = pckt->p_len - pckt->p_tbl[element+1].pt_offset;
	copystart = pckt->p_buf + pckt->p_tbl[element+1].pt_offset;

	if (needlen <= 0) {
		return (TCL_OK);
	}
	if ((pckt->p_len + needlen) > pckt->p_maxlen) {
		return (TCL_ERROR);
	}
	pckt->p_len += needlen;
	for (i = element + 1; i <= pckt->p_lptbl; i++) {
		pckt->p_tbl[i].pt_offset += needlen;
	}
	if (copylen > 0) {
		tempbuf = malloc(copylen);
		(void) memcpy(tempbuf, copystart, copylen);
		(void) memcpy(copystart + needlen, tempbuf, copylen);
	}
	return (TCL_OK);
}

/*
 * In proto_lookup(), Tcl_FindHashEntry() expects a char * so we can't
 * be const but we don't modify it.
 */
struct proto_tbl *
proto_lookup(char *name)
{
	Tcl_HashEntry	*entryPtr;

	entryPtr = Tcl_FindHashEntry(&protocols, name);
	if (entryPtr == NULL)
		return (NULL);
	else
		return ((struct proto_tbl *)Tcl_GetHashValue(entryPtr));
}

struct packet *
pckt_lookup(char *name)
{
	Tcl_HashEntry *entryPtr;

	entryPtr = Tcl_FindHashEntry(&packets, name);
	if (entryPtr == NULL)
		return (NULL);
	else
		return ((struct packet *)Tcl_GetHashValue(entryPtr));
}

static void
delete_pckt(char *name)
{
	Tcl_HashEntry *entryPtr;
	struct packet *p;

	entryPtr = Tcl_FindHashEntry(&packets, name);
	if (entryPtr == NULL)
		return;
	p = (struct packet *)Tcl_GetHashValue(entryPtr);
	Tcl_DeleteHashEntry(entryPtr);
	ptbl_dtor(p);
	free(p->p_name);
	free(p->p_buf);
	free(p);
}

/*
 * Given a <prlayer>, parse it and find out what protocol table entry
 * corresponds to it, if possible.
 *
 * We rely on modifying the 'name' argument while parsing.  This is okay
 * since this is an internal routine, and all callers either pass arguments
 * that Tcl ensures are copies (argv elements from a command), or constants
 * that do not require modification to parse.
 */
static struct proto_tbl *
get_prlayer(char *name, struct packet *pckt, int *element)
{
	struct proto_tbl	*p;
	struct ptbl		*ptp;
	char			*sep;
	int			el;

	if (pckt == NULL)
		return (NULL);
	if ((sep = strchr(name, ':')) != NULL) {
		/*
		 * Input must have the form PROTO:INDEX
		 */
		el = atoi(sep + 1);
		*sep = '\0';
		for (ptp = pckt->p_tbl; ptp < pckt->p_tbl + pckt->p_lptbl;
		    ptp++) {
			if (strcmp(name, ptp->pt_name) == 0) {
				if (el > 0) {
					el--;
					continue;
				}
				/*
				 * Got it!
				 */
				*element = ptp - pckt->p_tbl;
				*sep = ':';
				return (proto_lookup(ptp->pt_name));
			}
		}
	/*
	 * Input is a protocol name so we do a proto_lookup().
	 */
	} else if ((p = proto_lookup(name)) != NULL) {
		for (el = 0; el <= pckt->p_lptbl; el++)
			if (strcmp(name, pckt->p_tbl[el].pt_name) == 0) {
				*element = el;
				return (p);
			}
	} else if (isdigit(*name)) {
		/*
		 * Input is a numerical index.  Lookup is easy.
		 */
		el = atoi(name);
		if (el >= 0 && el <= pckt->p_lptbl) {
			*element = el;
			return (proto_lookup(pckt->p_tbl[el].pt_name));
		}
	}
	return (NULL);
}

/*
 * "Bootstrap" the packet.  Called when something fundamental changes
 * in the packet, and what protocols and offsets have to be recomputed.
 * Each decode routine is called in turn, beginning at the indicated
 * element in the packet table.  Note that element's identity cannot
 * be changed--that is the bootstrapping protocool and the caller must
 * have set this correctly.  Each element from that point is a chain.
 * For example, if 'ether' is element 0, and ether's decode function
 * returns that IP follows, then IP's decode function is called, and
 * so on until a decode function returns the special protocol name "end".
 *
 * Because protocols' decode functions are written and maintained independently
 * it is also possible that one function's decode will return the name of
 * a protocol not present in the current packet shell.  In this case, the
 * special protocol name "data" is returned.  The data protocol library
 * just allows hexadecimal dumps of the unknown regions.
 */
int
bootstrap_packet(struct packet *pckt, int element)
{
	struct proto_tbl *p;
	char *name, *q;
	int next_offset;
	Tcl_DString command;
	char tmp[BUFSIZ];

	for (; element < pckt->p_lptbl; element++) {

		if ((p = proto_lookup(pckt->p_tbl[element].pt_name)) == NULL) {
			if (strcmp(pckt->p_tbl[element].pt_name, "end") != 0) {
				/*
				 * No protocol found, so fallback to 'data'
				 */
				if (ptbl_update(pckt, element, "data",
				    PTBL_KEEP_OFFSET) == 0) {
					(void) fprintf(stderr, "Internal Error:"
					    " ptbl_udpate failed\n");
					return (1);
				}
				element++;
			}
			/*
			 * We've hit the end.  Just make sure final offset
			 * is correct and we're done.
			 */
			return (ptbl_update(pckt, element, "end", pckt->p_len));
		}
		if (p->proto_tcl_decode != NULL) {
			/*
			 * The protocol has a Tcl procedure name defined
			 * for the decode routine, so evaluate the Tcl
			 * procedure
			 *
			 * Format:
			 * <Tcl proc> <pkt> <current offset>
			 *
			 * Needs to return a string of the following
			 * format: <name> <next_offset>
			 *
			 * This could be a candidate for a function but
			 * since we parse the return string for continuing
			 * the next layer in decoding the packet - this
			 * functionality should remain here for clarity.
			 */
			Tcl_DStringInit(&command);
			(void) Tcl_DStringAppend(&command, p->proto_tcl_decode,
			    strlen(p->proto_tcl_decode));
			(void) Tcl_DStringAppendElement(&command, pckt->p_name);
			(void) sprintf(tmp, "%d",
			    pckt->p_tbl[element].pt_offset);
			(void) Tcl_DStringAppendElement(&command, tmp);
			/*
			 * XXX: what to do here?  Tcl_Eval might not return
			 * TCL_OK, but what if it returns valid info anyway?
			 */
			(void) Tcl_Eval(interp, Tcl_DStringValue(&command));
			Tcl_DStringFree(&command);
			/*
			 * String result is returned in interp->result
			 */
			q = strchr(interp->result, ' ');
			next_offset = atoi(q + 1);
			*q = '\0';
			name = interp->result;
			if (ptbl_update(pckt, element + 1, name,
			    next_offset) == 0)
				return (0);
			pckt->p_len = next_offset;
		} else if (p->proto_decode == NULL) {
			Tcl_AppendResult(interp, "Protocol has no decode "
			    "function defined: ", p->proto_name, NULL);
			return (0);
		} else if ((p->proto_decode)(pckt, element, &name,
		    &next_offset) == 0) {
			if (ptbl_update(pckt, element + 1, "end",
			    next_offset) == 0) {
				return (0);
			}
			pckt->p_len = next_offset;
		}
		/* Identified a new protocol layer */
		if (ptbl_update(pckt, element + 1, name, next_offset) == 0)
			return (0);
		if (strcmp(name, "end") == 0)
			return (1);
	}
	return (1);
}

int
Tcl_AppInit(Tcl_Interp *interpreter)
{
	struct timeval tv;
	char psh_startup_path[PATH_MAX];

	/*
	 * We keep this around as a global for laziness.  Right now only
	 * bootstrap_packet uses it.
	 */
	interp = interpreter;
	if (Tcl_Init(interp) == TCL_ERROR) {
		return (TCL_ERROR);
	}
#ifdef	WINDOWS
	if (Tk_Init(interp) == TCL_ERROR) {
		return (TCL_ERROR);
	}
	Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
	(void) Tk_MainWindow(interp);
	if (Blt_Init(interp) != TCL_OK) {
		return (TCL_ERROR);
	}
#endif

	/*
	 * Load the protocol libraries.
	 */
	Tcl_InitHashTable(&protocols, TCL_STRING_KEYS);
	init_psh_proto(interp);

	/*
	 * Initialize the table of protocol names and protocol
	 * numbers for Network layer protocols.
	 */
	init_ip_protos();

	/*
	 * Set default Tcl initialization file to ~/.pshrc
	 */
	(void) Tcl_SetVar(interp, "tcl_rcFileName", "~/.pshrc",
	    TCL_GLOBAL_ONLY);
	/*
	 * Set maximum packet buffer length variable to default
	 */
	(void) Tcl_SetVar(interp, "pktlength", PSH_PKT_DEFAULT_LEN,
	    TCL_GLOBAL_ONLY);
	(void) gettimeofday(&tv, NULL);
	seconds_bias = tv.tv_sec;
	/*
	 * Set version variable to SCCS ident from version.h
	 */
	(void) Tcl_SetVar(interp, "psh_version", sccsid, TCL_GLOBAL_ONLY);
	/*
	 * Set the PSH_TCLLIB environment variable to the location of
	 * the Packet Shell Tcl/Tk Resource Directory, by default
	 * "/opt/psh/tcllib"
	 */
	(void) Tcl_SetVar(interp, PSH_TCLLIB_ENV, PSH_TCLLIB_DIR,
	    TCL_GLOBAL_ONLY);
	/*
	 * Load and execute the Packet Shell Tcl/Tk Resource file,
	 * by default "pshrc"
	 */
	strcpy(psh_startup_path, psh_home);
	strcat(psh_startup_path, PSH_STARTUP);
	if ((Tcl_EvalFile(interp, psh_startup_path)) != TCL_OK) {
		/*
		 * String result is returned in interp->result
		 */
		return (TCL_ERROR);
	}
	Tcl_InitHashTable(&packets, TCL_STRING_KEYS);
	Tcl_InitHashTable(&endpoints, TCL_STRING_KEYS);
	return (TCL_OK);
}

static int
psh_popen(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	char tmp[128];
	ep_t *new_ep;

	Tcl_ResetResult(interp);
	if (argc < 3) {
		Tcl_AppendResult(interp, "Usage: popen <protocol> <ep>  ...",
		    NULL);
		return (TCL_ERROR);
	}
	if (psh_find_ep(argv[2]) != NULL) {
		Tcl_AppendResult(interp, "Error: end-point ", argv[2],
		    " already in use.", NULL);
		return (NULL);
	}

	p = proto_lookup(argv[1]);
	if (p == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	if (p->proto_open == NULL) {
		Tcl_AppendResult(interp, "Error: popen for ", argv[1],
		    " not defined", NULL);
		return (TCL_ERROR);
	}

	/*
	 * Create a new endpoint structure.
	 */
	new_ep = psh_new_ep(argv[2], p);
	if (new_ep == NULL) {
		Tcl_AppendResult(interp, "Error: not enough memory.", NULL);
		return (TCL_ERROR);
	}

	/*
	 * initialize this new end-point by calling the protocol's propen().
	 */
	if (TCL_ERROR ==
	    (p->proto_open)((ClientData *)new_ep, interp, argc - 2, argv + 2)) {
		psh_free_ep(new_ep);
		return (TCL_ERROR);
	}

	/*
	 * add the new end-point to the global table.
	 */
	if (psh_add_ep(new_ep) == NULL) {
		psh_free_ep(new_ep);
		Tcl_AppendResult(interp, "Error: Unable to add new end-point.",
		    NULL);
		return (TCL_ERROR);
	}

	/* create the action commands */
	(void) sprintf(tmp, "%s.add_action", argv[2]);
	(void) Tcl_CreateCommand(interp, tmp, pshaction_add_action,
	    new_ep, NULL);
	(void) sprintf(tmp, "%s.del_action", argv[2]);
	(void) Tcl_CreateCommand(interp, tmp, pshaction_del_action,
	    new_ep, NULL);
	(void) sprintf(tmp, "%s.wait_action", argv[2]);
	(void) Tcl_CreateCommand(interp, tmp, pshaction_wait_action,
	    new_ep, NULL);
	(void) sprintf(tmp, "%s.actions", argv[2]);
	(void) Tcl_CreateCommand(interp, tmp, pshaction_actions,
	    new_ep, NULL);

	return (TCL_OK);
}

static int
psh_pclose(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	ep_t *ep;
	char tmp[128];
	char *name;
	int prclose_status;

	Tcl_ResetResult(interp);
	/*
	 * The reason we don't complain about argc == 3 is for backward
	 * compatibility with the old usage: pclose <proto> <ep>.  The
	 * proto argument is not needed, so it was dropped.
	 */
	if (argc < 2 || argc > 3) {
		Tcl_AppendResult(interp, "Usage: pclose <ep> ...",
		    NULL);
		return (TCL_ERROR);
	}

	name = argv[argc - 1];

	/*
	 * Try to remove the end-point from the global list.  If this
	 * fails, it means that there's no end-point with the given name.
	 */
	if (NULL == (ep = psh_remove_ep(name))) {
		Tcl_AppendResult(interp, "Error: ", name,
		    ": No such end-point", NULL);
		return (TCL_ERROR);
	}

	(void) sprintf(tmp, "%s.add_action", name);
	(void) Tcl_DeleteCommand(interp, tmp);
	(void) sprintf(tmp, "%s.del_action", name);
	(void) Tcl_DeleteCommand(interp, tmp);
	(void) sprintf(tmp, "%s.wait_action", name);
	(void) Tcl_DeleteCommand(interp, tmp);
	(void) sprintf(tmp, "%s.actions", name);
	(void) Tcl_DeleteCommand(interp, tmp);

	/*
	 * delete all actions in the action list.
	 */
	pshaction_delete_all_actions(ep->ep_action_head);

	/* Only call the proto_close() function if it exists. */
	if (ep->ep_prototbl->proto_close != NULL) {
		prclose_status = (ep->ep_prototbl->proto_close)((ClientData)ep,
		    interp, 1, argv + argc - 1);
		psh_free_ep(ep);
		return (prclose_status);
	} else {
		return (TCL_OK);
	}
}

static int
getpktlength(Tcl_Interp *interp)
{
	char *var;
	int value;

	if ((var = Tcl_GetVar(interp, "pktlength",
	    TCL_GLOBAL_ONLY)) == NULL) {
		Tcl_AppendResult(interp, "Warning: Couldn't find global ",
		    "pktlength variable", NULL);
		return (-1);
	}
	if ((value = atoi(var)) == 0) {
		Tcl_AppendResult(interp, "Error: Expected integer, ",
		    "pktlength variable is corrupted", NULL);
		return (-1);
	}
	return (value);
}

/*
 * Pinit command is responsible for creating a new packet.  The sequence
 * looks like this:
 *
 * - Validate no packet of that name exists
 * - Create the new packet
 * - If optional maximum length is supplied, make the packet buffer that size
 * - If an optional protocol segment size is supplied, start the packet at
 *   size, otherwise start the current size at zero.
 * - If a Tcl pinit command is supplied, call it to initialize the segment
 * - If a C pinit function is supplied, call it to initialize the segment
 * - If the pinit function failed, then toss the packet and return an error.
 */
static int
psh_pinit(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	struct packet *pckt;
	int protolen = 0;
	Tcl_HashEntry *entryPtr;
	Tcl_DString command;
	int i, hashexists, pktlength;
	int retval = TCL_OK;
	int argindex = 3;

	Tcl_ResetResult(interp);
	if (argc < 3 || strlen(argv[2]) == 0) {
		Tcl_AppendResult(interp, "Usage: pinit <protocol> <pkt> ",
		    "[<max. length> [<protocol length>]] ...", NULL);
		Tcl_AppendResult(interp, "\n       pinit <protocol> <pkt> ",
		    "- - ...", NULL);
		Tcl_AppendResult(interp, "\n\nNote: Use - to indicate a ",
		    "default value for length argument", NULL);
		return (TCL_ERROR);
	}
	p = proto_lookup(argv[1]);
	if (p == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	entryPtr = Tcl_CreateHashEntry(&packets, argv[2], &hashexists);
	if (hashexists == TCL_OK) {
		Tcl_AppendResult(interp, "Warning: packet exists: ",
		    argv[2], NULL);
		return (TCL_ERROR);
	}

	/*
	 * Automatically set the protocol length correctly for dynamic
	 * protocols, i.e. pckt->p_len
	 */
	protolen = p->proto_len;

	if (argc > 3) {
		if (strcmp(argv[3], "-") == 0) {
			if ((pktlength = getpktlength(interp)) == -1) {
				Tcl_DeleteHashEntry(entryPtr);
				return (TCL_ERROR);
			}
		} else if (Tcl_GetInt(interp, argv[3], &pktlength) != TCL_OK) {
				Tcl_DeleteHashEntry(entryPtr);
				return (TCL_ERROR);
		}
		if (argc > 4)  {
			if ((strcmp(argv[4], "-") != 0) &&
			    (Tcl_GetInt(interp, argv[4],
			    &protolen) != TCL_OK)) {
				Tcl_DeleteHashEntry(entryPtr);
				return (TCL_ERROR);
			}
			if (protolen > pktlength) {
				Tcl_AppendResult(interp, "Error: Can't have ",
					"protocol length larger than packet",
					" length", NULL);
				Tcl_DeleteHashEntry(entryPtr);
				return (TCL_ERROR);
			}
		}
		argindex = argc;
	} else {
		/*
		 * Automatically set the maximum packet buffer length to
		 * the value in the Tcl variable pktlength or the argument
		 * specified in input to the pinit command, i.e. pckt->p_maxlen
		 */
		if ((pktlength = getpktlength(interp)) == -1) {
			Tcl_DeleteHashEntry(entryPtr);
			return (TCL_ERROR);
		}
	}

	if ((pckt = (struct packet *)malloc(sizeof (struct packet))) == NULL) {
		Tcl_DeleteHashEntry(entryPtr);
		Tcl_AppendResult(interp, "Internal Error: malloc: no space",
		    NULL);
		return (TCL_ERROR);
	}

	(void) memset(pckt, 0, sizeof (*pckt));
	if ((pckt->p_name = strdup(argv[2])) == NULL) {
		Tcl_DeleteHashEntry(entryPtr);
		free(pckt);
		Tcl_AppendResult(interp, "Internal Error: malloc: no space",
		    NULL);
		return (TCL_ERROR);
	}
	Tcl_SetHashValue(entryPtr, pckt);
	if (!ptbl_ctor(pckt, p->proto_name, PTBL_INCR)) {
		(void) delete_pckt(pckt->p_name);
		Tcl_AppendResult(interp, "Internal Error: ptbl_ctor: ",
		    "cannot init ptbl", NULL);
		return (TCL_ERROR);
	}
	if ((pckt->p_buf = malloc(pktlength)) == NULL) {
		(void) delete_pckt(pckt->p_name);
		Tcl_AppendResult(interp, "Internal Error: malloc: no space",
		    NULL);
		return (TCL_ERROR);
	}
	(void) memset(pckt->p_buf, 0, sizeof (*pckt->p_buf));
	pckt->p_maxlen = pktlength;
	pckt->p_len = protolen;
	pckt->p_pat.tv_sec = seconds_bias;
	/*
	 * Need to check if it's a dynamic protocol (i.e., pdefine) and
	 * we can do that if p->proto_len is set (the automatically
	 * calculated structure length) and then call ptbl_update()
	 * accordingly.
	 */
	if (p->proto_len > 0) {
		if (ptbl_update(pckt, 1, NULL, pckt->p_len) == 0) {
			delete_pckt(pckt->p_name);
			return (TCL_ERROR);
		}
	}
	if (p->proto_tcl_pinit != NULL) {
		/*
		 * This protocol has a Tcl procedure name defined
		 * for the pinit routine, don't call the C procedure
		 * instead evaluate the Tcl procedure
		 *
		 * Format:
		 * <Tcl proc> <protocol> <pkt> [<args> ...]
		 *
		 * This is for per-protocol initialization of dynamically
		 * created protocols using pdefine.
		 */
		Tcl_DStringInit(&command);
		(void) Tcl_DStringAppend(&command, p->proto_tcl_pinit,
		    strlen(p->proto_tcl_pinit));
		(void) Tcl_DStringAppendElement(&command, p->proto_name);
		(void) Tcl_DStringAppendElement(&command, pckt->p_name);
		for (i = argindex; i <= argc; i++)
			(void) Tcl_DStringAppendElement(&command, argv[i]);
		/*
		 * String result is returned in interp->result
		 */
		retval = Tcl_Eval(interp, Tcl_DStringValue(&command));
		Tcl_DStringFree(&command);
		goto end;
	}
	if (p->proto_init != NULL) {
		/*
		 * This protocol library has a C function defined for
		 * pinit (for compatability with older protocol libraries)
		 *
		 * The function most likely copies in a data structure to
		 * the pckt->p_buf and sets the component's length correctly
		 * in pckt->p_len and then calls ptbl_update()
		 */
		retval = (p->proto_init)(clientData, interp, pckt, argc - 2,
		    argv + 2);
	}
end:
	if (retval != TCL_OK) {
		(void) delete_pckt(pckt->p_name);
		return (TCL_ERROR);
	}
	return (TCL_OK);
}

static int
psh_pfree(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet *pckt;
	struct proto_tbl *p;
	int element;

	Tcl_ResetResult(interp);
	if (argc < 2) {
		Tcl_AppendResult(interp, "Usage: pfree <pkt> ...", NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ",
		    argv[1], NULL);
		return (TCL_ERROR);
	}
	p = get_prlayer(pckt->p_tbl[0].pt_name, pckt, &element);
	if (p == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol/layer: ",
		    argv[1], NULL);
		return (TCL_ERROR);
	}
	/*
	 * It's okay if a protocol library doesn't have a pfree defined,
	 * because delete_pckt() below takes care of everything currently
	 */
	if (p->proto_free) {
		return ((p->proto_free)(clientData, interp, pckt,
		    --argc, ++argv));
	}
	(void) delete_pckt(pckt->p_name);
	return (TCL_OK);
}

static int
psh_pset(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	struct packet *pckt;
	struct pdefine_tbl *q;
	Tcl_HashEntry *entryPtr;
	int element;

	Tcl_ResetResult(interp);
	if (argc < 3) {
		Tcl_AppendResult(interp, "Usage: pset <pkt> <prlayer> ",
		    "<fieldname> <value> ...", NULL);
		return (TCL_ERROR);
	}
	pckt = pckt_lookup(argv[1]);
	if (pckt == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	p = get_prlayer(argv[2], pckt, &element);
	if (p == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol/layer: ",
		    argv[2], NULL);
		return (TCL_ERROR);
	}
	entryPtr = Tcl_FindHashEntry(&p->proto_defines, argv[3]);
	/*
	 * Order of precedence:
	 *
	 *	Dynamic protocol - Tcl procedure defined using pdefine
	 *	and value is stored in q->setName (per field specific)
	 *
	 *	Dynamic protocol - C function defined using pdefine
	 *	and value is stored in q->set (per field specific)
	 *
	 * 	C function for set() in protocol library exists and
	 *	value is stored in p->set (per protocol specific)
	 */
	if (entryPtr != NULL) {
		q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
		if (q->pd_setName != NULL && q->pd_set == NULL) {
			/*
			 * The protocol has a Tcl procedure name defined
			 * for the pset routine, and a C funtion has not
			 * been defined, so evaluate the Tcl procedure
			 *
			 * Format:
			 * <Tcl proc> <pkt> <proto> <offset> <size> [<args> ...]
			 */
			return (evalcommand(interp, q->pd_setName, pckt->p_name,
			    q->pd_offset, q->pd_size, argc, argv));
		} else if (q->pd_set != NULL) {
			/*
			 * The dynamic protocol has a C function defined
			 */
			return ((q->pd_set)(clientData, interp, pckt, element,
			    q->pd_offset, q->pd_size, argc, argv));
			}
	} else if (p->proto_set != NULL) {
		/*
		 * The protocol has a C function defined (for
		 * compatability with older protocol libraries)
		 */
		return ((p->proto_set)(element, clientData, interp, pckt,
		    argc - 3, argv + 3));
	} else {
		/*
		 * Nothing defined or found for the protocol library
		 */
		Tcl_AppendResult(interp, "Error: pset for ", argv[2],
		    " not defined on field ", argv[3], NULL);
		return (TCL_ERROR);
	}
	return (TCL_OK);
}

static int
psh_pget(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	struct packet *pckt;
	struct pdefine_tbl *q;
	Tcl_HashEntry *entryPtr;
	int element;

	Tcl_ResetResult(interp);
	if (argc <= 3) {
		Tcl_AppendResult(interp, "Usage: pget <pkt> <prlayer> ",
		    "<fieldname> ...", NULL);
		return (TCL_ERROR);
	}
	pckt = pckt_lookup(argv[1]);
	if (pckt == NULL) {
		Tcl_AppendResult(interp, "Unknown packet: ", argv[1], NULL);
		return (TCL_ERROR);
	}
	p = get_prlayer(argv[2], pckt, &element);
	if (p == NULL) {
		Tcl_AppendResult(interp, "Unknown protocol/layer: ",
		    argv[2], NULL);
		return (TCL_ERROR);
	}
	entryPtr = Tcl_FindHashEntry(&p->proto_defines, argv[3]);
	/*
	 * Order of precedence:
	 *
	 *	Dynamic protocol - Tcl procedure defined using pdefine
	 *	and value is stored in q->getName (per field specific)
	 *
	 * 	Dynamic protocol - C function defined using pdefine
	 *	and value is stored in q->get (per field specific)
	 *
	 * 	C function get() in protocol library exists and
	 *	value is stored in p->get (per protocol specific)
	 */
	if (entryPtr != NULL) {
		q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
		if (q->pd_getName != NULL && q->pd_get == NULL) {
			/*
			 * The protocol has a Tcl procedure name defined
			 * for the pget routine, and a C function has not
			 * been defined, so evaluate the Tcl procedure
			 *
			 * Format:
			 * <Tcl proc> <pkt> <proto> <offset> <size> [<args> ...]
			 */
			return (evalcommand(interp, q->pd_getName, pckt->p_name,
			    q->pd_offset, q->pd_size, argc, argv));
		} else if (q->pd_get != NULL) {
			/*
			 * The dynamic protocol has a C function defined
			 */
			return ((q->pd_get)(clientData, interp, pckt, element,
			    q->pd_offset, q->pd_size, argc, argv));
		}
	} else if (p->proto_get != NULL) {
		/*
		 * The protocol has a C function defined (for
		 * compatability with older protocol libraries)
		 */
		return ((p->proto_get)(element, clientData, interp, pckt,
		    argc - 3, argv + 3));
	} else {
		/*
		 * Nothing defined or found for the protocol library
		 */
		Tcl_AppendResult(interp, "Error: pget for ", argv[2],
		    " not defined on field", argv[3], NULL);
		return (TCL_ERROR);
	}
	return (TCL_OK);
}

static int
psh_plist(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	struct packet *pckt;
	int element, retval;
	Tcl_DString command;

	Tcl_ResetResult(interp);
	if (argc < 2) {
		Tcl_AppendResult(interp, "Usage: plist <pkt> [<prlayer>] ",
		    "...", NULL);
		return (TCL_ERROR);
	}
	pckt = pckt_lookup(argv[1]);
	if (pckt == NULL) {
		Tcl_AppendResult(interp, "Unknown packet: ", argv[1], NULL);
		return (TCL_ERROR);
	}
	argc -= 2;
	argv += 2;
	if (argc >= 1) {
		/*
		 * Check for PRLAYER present.  If not don't treat this
		 * as an error, and let the protocol's routine decide...
		 */

		p = get_prlayer(argv[0], pckt, &element);
		if (p != NULL) {
			argc--; argv++;
		} else {
			Tcl_AppendResult(interp, "Internal Error: ",
			    "No prlayer ", argv[0], " in packet",
			    " or protocol unknown", NULL);
			return (TCL_ERROR);
		}
	} else {
		p = proto_lookup(pckt->p_tbl->pt_name);
		element = 0;
	}
	/*
	 * Order of precedence:
	 *
	 *	Dynamic protocol - Tcl procedure defined using pdefine
	 *	and value is stored in p->proto_tcl_list
	 *
	 *	C function for list() in protocol library exists and
	 *	value is stored in p->list
	 */
	if (p->proto_tcl_list != NULL) {
		/*
		 * The protocol has a Tcl procedure name defined
		 * for the plist routine, so evaluate the Tcl procedure
		 *
		 * Format:
		 * <Tcl proc> <pkt> <protocol>
		 */
		Tcl_DStringInit(&command);
		(void) Tcl_DStringAppend(&command, p->proto_tcl_list,
		    strlen(p->proto_tcl_list));
		(void) Tcl_DStringAppendElement(&command, pckt->p_name);
		(void) Tcl_DStringAppendElement(&command, p->proto_name);
		retval = Tcl_Eval(interp, Tcl_DStringValue(&command));
		Tcl_DStringFree(&command);
		return (retval);
	}
	if (p->proto_list == NULL) {
		/*
		 * Nothing defined or found for the protocol library
		 */
		Tcl_AppendResult(interp, "Error: plist for ", argv[2],
		    " not defined", NULL);
		return (TCL_ERROR);
	}
	/*
	 * The protocol has a C function defined (for compatability
	 * with older protocol libraries
	 */
	return ((p->proto_list)(element, clientData, interp, pckt,
	    argc, argv));
}

/*
 * psh_prawcopy -- Used for copying the contents of one packet into another
 *                 packet without changing the packet table structure of the
 *                 destination packet.  This is mainly expected to be useful
 *                 for copying info into the "data" portion of a packet.  If
 *                 the copy operation would increase the length of the packet,
 *                 a ptbl entry of "data" is used to contain the extra bytes.
 */

int
psh_prawcopy(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet *dpckt, *spckt;
	char *dstoffsetstr, *srcoffsetstr, *p;
	int srcoffset, dstoffset;
	char *dstpname, *srcpname;
	int copylen;

	Tcl_ResetResult(interp);

	if (argc < 4) {
		Tcl_AppendResult(interp, "Bad usage: prawcopy <dst> <src> ",
		    "<length>", NULL);
		Tcl_AppendResult(interp, "\n\tcomponents: "
		    "packet_name:packet_offset", NULL);
		return (TCL_ERROR);
	}
	dstpname = argv[1];
	srcpname = argv[2];
	if (Tcl_GetInt(interp, argv[3], &copylen) != TCL_OK) {
		Tcl_AppendResult(interp, "Bad length: ", argv[3], NULL);
		return (TCL_ERROR);
	}

	if ((p = strchr(dstpname, ':')) == NULL) {
		dstoffsetstr = "0";
	} else {
		dstoffsetstr = p + 1;
		*p = '\0';
	}
	if ((dpckt = pckt_lookup(dstpname)) == NULL) {
		Tcl_AppendResult(interp, "Bad packet name: ", dstpname, NULL);
		return (TCL_ERROR);
	}
	if ((Tcl_GetInt(interp, dstoffsetstr, &dstoffset) != TCL_OK) ||
	    ((dstoffset + copylen) > dpckt->p_maxlen)) {
		Tcl_AppendResult(interp, "Bad offset: ", dstoffsetstr, NULL);
		return (TCL_ERROR);
	}

	if ((p = strchr(srcpname, ':')) == NULL) {
		srcoffsetstr = "0";
	} else {
		srcoffsetstr = p + 1;
		*p = '\0';
	}
	if ((spckt = pckt_lookup(srcpname)) == NULL) {
		Tcl_AppendResult(interp, "Bad packet name: ", srcpname, NULL);
		return (TCL_ERROR);
	}
	if ((Tcl_GetInt(interp, srcoffsetstr, &srcoffset) != TCL_OK) ||
	    ((srcoffset + copylen) > spckt->p_maxlen)) {
		Tcl_AppendResult(interp, "Bad offset/len: ", srcoffsetstr,
		    "/", argv[3], NULL);
		return (TCL_ERROR);
	}

	/*
	 * We have the packets, the offsets, and the copy length.  We may need
	 * to extend the length of the packet and change the offset of the
	 * final element of the packet table.
	 */


	if (dpckt->p_len < (dstoffset + copylen)) {
		/* The last "proto" of the packet should be "end", right ? */
		if (strcmp(dpckt->p_tbl[dpckt->p_lptbl - 1].pt_name,
		    "data") != 0) {
			free(dpckt->p_tbl[dpckt->p_lptbl].pt_name);
			dpckt->p_tbl[dpckt->p_lptbl].pt_name = strdup("data");
			dpckt->p_lptbl++;
			dpckt->p_tbl[dpckt->p_lptbl].pt_name = strdup("end");
		}
		dpckt->p_len = dstoffset + copylen;
		dpckt->p_tbl[dpckt->p_lptbl].pt_offset = dstoffset + copylen;
	}
	memcpy(dpckt->p_buf + dstoffset, spckt->p_buf + srcoffset, copylen);

	return (TCL_OK);
}


static int
psh_pcopy(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet	*dpckt, *spckt;
	char	*dstpname, *srcpname;
	char	*dstprlayer, *srcprlayer_start, *srcprlayer_end;
	char	*p, *r, *srcptr;
	int	delement, selement_start, selement_end, srcsize, i;

	Tcl_ResetResult(interp);
	if (argc < 3) {
		Tcl_AppendResult(interp, "Usage: pcopy <dstpkt> <src1pkt> ",
		    "[<src2pkt> ...]", NULL);
		Tcl_AppendResult(interp, "\n\nNote: Valid syntax for packet ",
		    "<pkt> also includes the component <pkt>/<prlayer>", NULL);
		Tcl_AppendResult(interp, "\n       Forms for <prlayer>:",
		    NULL);
		Tcl_AppendResult(interp, "\n\t\t<prlayer> = all", NULL);
		Tcl_AppendResult(interp, "\n\t\t<prlayer> = <start_prlayer>:",
		    "<end_prlayer>", NULL);
		return (TCL_ERROR);
	}
	dstpname = argv[1];
	if ((p = strchr(dstpname, '/')) == NULL) {
		dstprlayer = "0";
	} else {
		dstprlayer = p + 1;
		*p = '\0';
	}
	if ((dpckt = pckt_lookup(dstpname)) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown destination packet: ",
		    dstpname, NULL);
		return (TCL_ERROR);
	}
	/*
	 * Since 'end' isn't a protocol, must fake it out here, and catch
	 * that one by hand.
	 */
	if (strcmp(dstprlayer, "end") == 0)
		delement = dpckt->p_lptbl;
	else if (get_prlayer(dstprlayer, dpckt, &delement) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown destination "
		    "protocol/layer: ", dstprlayer, NULL);
		return (TCL_ERROR);
	}
	for (argv += 2, argc -= 2; argc > 0; argv++, argc--) {
		srcpname = argv[0];
		if ((p = strchr(srcpname, '/')) == NULL) {
			/* srcprlayer_start = "0"; */
			selement_start = 0;
			selement_end = 1;
			if ((spckt = pckt_lookup(srcpname)) == NULL) {
				Tcl_AppendResult(interp, "Error: Unknown ",
				    "source packet: ", srcpname, NULL);
				return (TCL_ERROR);
			}
		} else {
			srcprlayer_start = p + 1;
			*p = '\0';
			if ((spckt = pckt_lookup(srcpname)) == NULL) {
				Tcl_AppendResult(interp, "Error: Unknown ",
				    "source packet: ", srcpname, NULL);
				return (TCL_ERROR);
			}
			if (strcmp(srcprlayer_start, "all") == 0) {
				selement_start = 0;
				selement_end = spckt->p_lptbl;
			} else {
				if ((r = strchr(srcprlayer_start,
				    ':')) == NULL) {
					if (get_prlayer(srcprlayer_start,
					    spckt, &selement_start) == NULL) {
						Tcl_AppendResult(interp,
						    "Error: Unknown source ",
						    "protocol/layer: ",
						    srcprlayer_start, NULL);
						return (TCL_ERROR);
					}
					selement_end = selement_start + 1;
				}
			}
			if ((r = strchr(srcprlayer_start, ':')) != NULL) {
				srcprlayer_end = r + 1;
				*r = '\0';
				if (get_prlayer(srcprlayer_start, spckt,
				    &selement_start) == NULL) {
					Tcl_AppendResult(interp, "Error: ",
					    "Unknown source protocol/layer: ",
					    srcprlayer_start, NULL);
					return (TCL_ERROR);
				}
				if (get_prlayer(srcprlayer_end, spckt,
				    &selement_end) == NULL) {
					Tcl_AppendResult(interp, "Error: ",
					    "Unknown source protocol/layer: ",
					    srcprlayer_end, NULL);
					return (TCL_ERROR);
				}
				if (selement_start >= selement_end) {
					Tcl_AppendResult(interp, "Error: ",
					    "start_prlayer has to come before",
					    " end_prlayer", NULL);
					return (TCL_ERROR);
				}
			}
		}
		srcptr = spckt->p_buf + spckt->p_tbl[selement_start].pt_offset;
		srcsize = spckt->p_tbl[selement_end].pt_offset -
		    spckt->p_tbl[selement_start].pt_offset;

		/*
		 * If we are appending to the packet, and the size of the
		 * source is larger than the extra space remaining in
		 * the packet buffer, it won't go.  Also, if we are
		 * not appending, then the source size must be less than
		 * or equal to the size of the layer you're replacing.
		 */
		if ((delement == dpckt->p_lptbl &&
		    (srcsize > (dpckt->p_maxlen - dpckt->p_len))) ||
		    (delement != dpckt->p_lptbl &&
		    (srcsize > (dpckt->p_tbl[delement + 1].pt_offset -
		    dpckt->p_tbl[delement].pt_offset)))) {
			Tcl_AppendResult(interp, "Error: Growth code not ",
			    "implemented yet", NULL);
			return (TCL_ERROR);
		}
		(void) memcpy(dpckt->p_buf + dpckt->p_tbl[delement].pt_offset,
		    srcptr, srcsize);
		for (i = selement_start; i < selement_end; i++) {
			dpckt->p_tbl[delement].pt_name =
			    strdup(spckt->p_tbl[i].pt_name);
			srcsize = spckt->p_tbl[i+1].pt_offset -
			    spckt->p_tbl[i].pt_offset;
			dpckt->p_tbl[delement+1].pt_offset =
			    dpckt->p_tbl[delement].pt_offset + srcsize;
			delement++;
		}
	}
	/*
	 * We must strdup(), since ptbl_dtor will eventually free this, so
	 * it better be allocated memory.
	 */
	dpckt->p_tbl[delement].pt_name = strdup("end");
	dpckt->p_lptbl = delement;
	dpckt->p_len = dpckt->p_tbl[delement].pt_offset;
	return (TCL_OK);
}

static int
psh_poffset(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet		*pckt;
	int			element;
	char			buf[20];

	Tcl_ResetResult(interp);
	if (argc != 3) {
		Tcl_AppendResult(interp, "Usage: poffset <pkt> <prlayer>",
		    NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	if (get_prlayer(argv[2], pckt, &element) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol/layer: ",
		    argv[2], NULL);
		return (TCL_ERROR);
	}
	(void) sprintf(buf, "%d", pckt->p_tbl[element].pt_offset);
	Tcl_AppendResult(interp, buf, NULL);
	return (TCL_OK);
}

static int
psh_pproto(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet		*pckt;
	int			element;
	char			buf[20];

	Tcl_ResetResult(interp);
	if (argc != 3) {
		Tcl_AppendResult(interp, "Usage: pproto <pkt> <prlayer>",
		    NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	if (get_prlayer(argv[2], pckt, &element) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol/layer: ",
		    argv[2], NULL);
		return (TCL_ERROR);
	}
	Tcl_AppendResult(interp, pckt->p_tbl[element].pt_name, " ", NULL);
	(void) sprintf(buf, "%d", element);
	Tcl_AppendResult(interp, buf, NULL);
	return (TCL_OK);
}

static int
psh_plen(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet		*pckt;
	int			element, len, newlen;
	char			buf[20];

	Tcl_ResetResult(interp);
	if (argc < 2 || argc > 4) {
		Tcl_AppendResult(interp, "Usage: plen <pkt> [<prlayer>]",
		    " [<length>]", NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ",
		    argv[1], NULL);
		return (TCL_ERROR);
	}
	if (argc == 2) {
		(void) sprintf(buf, "%d", pckt->p_len);
		Tcl_AppendResult(interp, buf, NULL);
		return (TCL_OK);
	}
	if (strcmp(argv[2], "end") == 0) {
		Tcl_AppendResult(interp, "Error: Cannot change length of "
		    "'end' marker", NULL);
		return (TCL_ERROR);
	}
	if (get_prlayer(argv[2], pckt, &element) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol/layer: ",
		    argv[2], NULL);
		return (TCL_ERROR);
	}
	if (argc == 3) {
		/*
		 * Show the current length
		 */
		if (element >= pckt->p_lptbl) {
			len = 0;
		} else {
			len = pckt->p_tbl[element+1].pt_offset -
			    pckt->p_tbl[element].pt_offset;
		}
		(void) sprintf(buf, "%d", len);
		Tcl_AppendResult(interp, buf, NULL);
	} else {
		/*
		 * Set the length.  Copy the remainder up or down as indicated
		 * so the the content of subsequent layers isn't disturbed.
		 */
		int delta;

		if (Tcl_GetInt(interp, argv[3], &newlen) != TCL_OK) {
			return (TCL_ERROR);
		}
		if (newlen < 0) {
			Tcl_AppendResult(interp, "Invalid negative length: ",
			    argv[3], NULL);
			return (TCL_ERROR);
		}
		delta = newlen - (pckt->p_tbl[element+1].pt_offset -
		    pckt->p_tbl[element].pt_offset);
		if (strcmp(pckt->p_tbl[element+1].pt_name, "end") != 0) {
			bcopy(pckt->p_buf + pckt->p_tbl[element+1].pt_offset,
			    pckt->p_buf + pckt->p_tbl[element+1].pt_offset +
			    delta,
			    pckt->p_len - pckt->p_tbl[element+1].pt_offset);
		}

		for (element++; element <= pckt->p_lptbl; element++) {
			pckt->p_tbl[element].pt_offset += delta;
		}
		pckt->p_len = pckt->p_tbl[pckt->p_lptbl].pt_offset;
	}
	return (TCL_OK);
}

static int
psh_pcast(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet		*pckt;
	int			element;

	Tcl_ResetResult(interp);
	if (argc != 4) {
		Tcl_AppendResult(interp, "Usage: pcast <pcktname> <prlayer>",
		    " <protocol>", NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	if (proto_lookup(argv[3]) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol: ",
		    argv[3], NULL);
		return (TCL_ERROR);
	}
	if (get_prlayer(argv[2], pckt, &element) == NULL) {
		if (strcmp(argv[2], "end") == 0)
			element = pckt->p_lptbl;
		else {
			Tcl_AppendResult(interp, "Error: Unknown",
			    " protocol/layer: ", argv[2], NULL);
			return (TCL_ERROR);
		}
	}

	/*
	 * XXX pcast doesn't work correctly if the following line isn't
	 * commented out.  This line was added in version 1.52 as part
	 * of a Code review putback.  Anyone remember the history behind
	 * this next line?
	 */
	/*
	pckt->p_lptbl = element + 1;
	*/
	if (ptbl_update(pckt, element, argv[3], PTBL_KEEP_OFFSET) == 0) {
		Tcl_AppendResult(interp, "Internal Error: ptbl_update: failed",
		    NULL);
		return (TCL_ERROR);
	}

	if (element >= pckt->p_lptbl) {
		if (ptbl_update(pckt, element + 1, "end", pckt->p_len) == 0) {
			Tcl_AppendResult(interp, "Internal Error:",
			    " ptbl_update: failed", NULL);
			return (TCL_ERROR);
		}
	}

	return (bootstrap_packet(pckt, element) ? TCL_OK : TCL_ERROR);
}


static int
psh_pcktime(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	char	buf[128];
	struct packet *p;

	Tcl_ResetResult(interp);
	if (argc > 2) {
		Tcl_AppendResult(interp, "Usage: pckttime <pkt>", NULL);
		return (TCL_ERROR);
	}
	if (argc == 1) { /* Return the current time */
		struct timeval tv;

		(void) gettimeofday(&tv, NULL);
		tv.tv_sec -= seconds_bias;
		(void) sprintf(buf, "%f", (float)tv.tv_sec +
		    ((float)tv.tv_usec)/1.0e+6);
		Tcl_AppendResult(interp, buf, NULL);
		return (TCL_OK);
	}
	if ((p = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ",
		    argv[1], NULL);
		return (TCL_ERROR);
	}
	(void) sprintf(buf, "%f", (float)(p->p_pat.tv_sec - seconds_bias) +
	    ((float)p->p_pat.tv_usec)/1.0e+6);
	Tcl_AppendResult(interp, buf, NULL);
	return (TCL_OK);
}

static int
psh_psleep(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	int timeval;

	Tcl_ResetResult(interp);
	if (argc != 2) {
		Tcl_AppendResult(interp, "Usage: psleep <time>", NULL);
		return (TCL_ERROR);
	}
	if (Tcl_GetInt(interp, argv[1], &timeval) != TCL_OK) {
		return (TCL_ERROR);
	}
	/*
	 * Sleep() might tell us a signal woke us up early, but that's
	 * not something we'll deal with here.  The caller can consult
	 * the time if needed.  Since nothing in the packet shell is
	 * currently signal driven, this should be fine.
	 */
	(void) sleep((unsigned)timeval);
	Tcl_ResetResult(interp);
	return (TCL_OK);
}

static int
psh_pread(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet	*pckt;
	int		offset, nbytes, count, i, element;
	char		tmp[20], *p, *prlayer, *pname;

	Tcl_ResetResult(interp);
	if (argc < 4 ||
	    (strchr(argv[2], 'b') == NULL && strchr(argv[2], 'w') &&
	    strchr(argv[2], 'l') == NULL && strchr(argv[2], 'p'))) {
		Tcl_AppendResult(interp, "Usage: pread <pckt>[/<prlayer>] ",
		    "<b|w|l|p> <offset> <len>", NULL);
		return (TCL_ERROR);
	}
	pname = argv[1];
	if ((p = strchr(pname, '/')) == NULL) {
		prlayer = "0";
		element = 0;
		if ((pckt = pckt_lookup(pname)) == NULL) {
			Tcl_AppendResult(interp, "Unknown packet: ", pname,
			    NULL);
			return (TCL_ERROR);
		}
	} else {
		prlayer = p + 1;
		*p = '\0';
		if ((pckt = pckt_lookup(pname)) == NULL) {
			Tcl_AppendResult(interp, "Unknown packet: ", pname,
			    NULL);
			return (TCL_ERROR);
		}
		if (get_prlayer(prlayer, pckt, &element) == NULL) {
			Tcl_AppendResult(interp, "Error: Unknown protocol/",
			    "layer: ", prlayer, NULL);
			return (TCL_ERROR);
		}
	}
	if (Tcl_GetInt(interp, argv[3], &offset) != TCL_OK) {
		Tcl_AppendResult(interp, "Bad offset: ", argv[3], NULL);
		return (TCL_ERROR);
	}
	switch (argv[2][0]) {
	case 'b':
		nbytes = sizeof (char);
		break;
	case 'w':
		nbytes = sizeof (short);
		break;
	case 'l':
		nbytes = sizeof (int);
		break;
	case 'p':
		nbytes = sizeof (void *);
		break;
	}
	if (argc == 5) {
		if (Tcl_GetInt(interp, argv[4], &count) != TCL_OK) {
			return (TCL_ERROR);
		}

	} else {
		count = 1;
	}
	while (count-- > 0) {
		Tcl_AppendResult(interp, "0x", NULL);
		for (i = nbytes; i > 0; i--) {
			(void) sprintf(tmp, "%.2x",
			    (pckt->p_tbl[element].pt_offset +
			    pckt->p_buf[(offset*nbytes)+(nbytes-i)] & 0xff));
			Tcl_AppendResult(interp, tmp, NULL);
		}
		offset++;
		if (count > 0) {
			Tcl_AppendResult(interp, " ", NULL);
		}
	}
	return (TCL_OK);
}

static int
psh_pwrite(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet	*pckt;
	int		offset, nbytes, value, element;
	char		*dstp, *srcp, *p, *prlayer, *pname;
	short		svalue;
	char		cvalue;

	Tcl_ResetResult(interp);
	if (argc < 5 ||
	    (strchr(argv[2], 'b') == NULL && strchr(argv[2], 'w') &&
	    strchr(argv[2], 'l') == NULL && strchr(argv[2], 'p'))) {
		Tcl_AppendResult(interp, "Usage: pwrite <pckt>[/<prlayer>] ",
		"<b|w|l|p> <offset> <value> ...", NULL);
		return (TCL_ERROR);
	}
	pname = argv[1];
	if ((p = strchr(pname, '/')) == NULL) {
		prlayer = "0";
		element = 0;
		if ((pckt = pckt_lookup(pname)) == NULL) {
			Tcl_AppendResult(interp, "Unknown packet: ", pname,
			    NULL);
			return (TCL_ERROR);
		}
	} else {
		prlayer = p + 1;
		*p = '\0';
		if ((pckt = pckt_lookup(pname)) == NULL) {
			Tcl_AppendResult(interp, "Unknown packet: ", pname,
			    NULL);
			return (TCL_ERROR);
		}
		if (get_prlayer(prlayer, pckt, &element) == NULL) {
			Tcl_AppendResult(interp, "Error: Unknown protocol/",
			    "layer: ", prlayer, NULL);
			return (TCL_ERROR);
		}
	}
	if (Tcl_GetInt(interp, argv[3], &offset) != TCL_OK) {
		Tcl_AppendResult(interp, "Bad offset: ", argv[3], NULL);
		return (TCL_ERROR);
	}

	switch (argv[2][0]) {
	case 'b':
		nbytes = sizeof (char);
		break;
	case 'w':
		nbytes = sizeof (short);
		break;
	case 'l':
		nbytes = sizeof (int);
		break;
	case 'p':
		nbytes = sizeof (void *);
		break;
	}
	dstp = pckt->p_buf + pckt->p_tbl[element].pt_offset + (offset * nbytes);
	if (argv[2][0] == 'p') {
		/* Handle Pointer Type */
		if (Tcl_GetInt(interp, argv[4], &value) != TCL_OK) {
			return (TCL_ERROR);
		}
		dstp = pckt->p_buf + pckt->p_tbl[element].pt_offset + offset;
		srcp = pckt->p_buf + pckt->p_tbl[element].pt_offset + value;
		(void) memcpy(dstp, &srcp, nbytes);
		return (TCL_OK);
	}
	for (argc -= 4, argv += 4; argc > 0; argc--, argv++) {
		if (Tcl_GetInt(interp, argv[0], &value) != TCL_OK) {
			return (TCL_ERROR);
		}
		switch (nbytes) {
		case sizeof (int):
			srcp = (char *)&value;
			value = htonl(value);
			break;
		case sizeof (short):
			/*
			 * We don't know which two bytes of the longer
			 * integer 'value' are the "correct" ones, without
			 * knowing our byte sex.  Instead we cast it into
			 * a short temporary, since the compiler knows.
			 */
			srcp = (char *)&svalue;
			svalue = (short)value;
			svalue = htons(svalue);
			break;
		case sizeof (char):
			srcp = &cvalue;
			cvalue = value;
			break;
		}
		(void) memcpy(dstp, srcp, nbytes);
		dstp += nbytes;
	}
	return (TCL_OK);
}

static int
psh_pdump(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet *pckt;
	int	i;
	char	tmp[128];

	Tcl_ResetResult(interp);
	if (argc < 2) {
		Tcl_AppendResult(interp, "Usage: pdump <pckt>", NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown packet: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}

	for (i = 0; i < pckt->p_len; i++) {
		(void) sprintf(tmp, (i & 1) ? "%.2x" : " %.2x",
		    (pckt->p_buf[i]) & 0xff);
		Tcl_AppendResult(interp, tmp, NULL);
		if (((i & 0xf) == 0xf) && (i+1 < pckt->p_len)) {
			Tcl_AppendResult(interp, "\n", NULL);
		}
	}
	return (TCL_OK);
}

static int
psh_protocols(ClientData clientData, Tcl_Interp *interp, int argc,
    char *argv[])
{
	struct proto_tbl *p;
	Tcl_HashEntry *entryPtr;
	Tcl_HashSearch search;
	char *result;
	char tmp[BUFSIZ];

	Tcl_ResetResult(interp);
	if (argc != 1) {
		Tcl_AppendResult(interp, "Usage: ", argv[0], NULL);
		return (TCL_ERROR);
	}
	for (entryPtr = Tcl_FirstHashEntry(&protocols, &search);
	    entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
		p = (struct proto_tbl *)Tcl_GetHashValue(entryPtr);
		if (strcmp(p->proto_name, "end") != NULL) {
			if (interp->result[0] != '\0') {
				Tcl_AppendResult(interp, "\n", NULL);
			}
			(void) sprintf(tmp, "protocolInfo(%s)", p->proto_name);
			result = Tcl_GetVar(interp, tmp, NULL);
			if (result == NULL) {
				Tcl_AppendResult(interp, p->proto_name, NULL);
			} else {
				(void) sprintf(tmp, "%s - %s",
				    p->proto_name, result);
				Tcl_AppendResult(interp, tmp, NULL);
			}
		}
	}
	return (TCL_OK);
}

static int
psh_packets(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet *p;
	Tcl_HashEntry *entryPtr;
	Tcl_HashSearch search;

	if (argc != 1) {
		Tcl_AppendResult(interp, "Usage: ", argv[0], NULL);
		return (TCL_ERROR);
	}
	for (entryPtr = Tcl_FirstHashEntry(&packets, &search);
	    entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
		p = (struct packet *)Tcl_GetHashValue(entryPtr);
		(void) printf("Packet: %s len %d maxlen %d\n",
		    p->p_name, p->p_len, p->p_maxlen);
	}
	return (TCL_OK);
}

static int
psh_endpoints(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	ep_t *ep;
	Tcl_HashEntry *entryPtr;
	Tcl_HashSearch search;

	if (argc != 1) {
		Tcl_AppendResult(interp, "Usage: ", argv[0], NULL);
		return (TCL_ERROR);
	}
	for (entryPtr = Tcl_FirstHashEntry(&endpoints, &search);
	    entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
		ep = (ep_t *)Tcl_GetHashValue(entryPtr);
		(void) printf("%-7s%s\n", ep->ep_name,
		    ep->ep_prototbl->proto_name);
	}
	return (TCL_OK);
}

static int
psh_pretrieve(ClientData clientData, Tcl_Interp *interp, int argc,
    char *argv[])
{
	struct proto_tbl *p;
	struct pdefine_tbl *q;
	Tcl_HashEntry *entryPtr;
	Tcl_HashSearch search;
	Tcl_DString command;
	char tmp[BUFSIZ];

	Tcl_ResetResult(interp);
	if (argc < 2 || argc > 4) {
usage:		Tcl_AppendResult(interp, "Usage: pretrieve <protocol>\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " pinit\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " decode\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " list\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " fieldnames\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " <fieldname> desc\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " <fieldname> offset\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " <fieldname> size\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " <fieldname> get\n", NULL);
		Tcl_AppendResult(interp, "       pretrieve <protocol>",
		    " <fieldname> set", NULL);
		return (TCL_ERROR);
	}
	if ((p = proto_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown Protocol: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	if (argc == 3) {
		if (strcmp(argv[2], "pinit") == 0) {
			Tcl_AppendResult(interp, p->proto_tcl_pinit, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[2], "decode") == 0) {
			Tcl_AppendResult(interp, p->proto_tcl_decode, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[2], "list") == 0) {
			Tcl_AppendResult(interp, p->proto_tcl_list, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[2], "fieldnames") == 0) {
			Tcl_DStringInit(&command);
			for (entryPtr = Tcl_FirstHashEntry(&p->proto_defines,
			    &search); entryPtr != NULL;
			    entryPtr = Tcl_NextHashEntry(&search)) {
				q = (struct pdefine_tbl *)
				    Tcl_GetHashValue(entryPtr);
				(void) Tcl_DStringAppendElement(&command,
				    q->pd_fieldname);
			}
			Tcl_AppendResult(interp, Tcl_DStringValue(&command),
			    NULL);
			Tcl_DStringFree(&command);
			return (TCL_OK);
		} else {
			goto usage;
		}
	}
	if (argc == 4) {
		entryPtr = Tcl_FindHashEntry(&p->proto_defines, argv[2]);
		if (entryPtr == NULL) {
			Tcl_AppendResult(interp, "Error: Unknown fieldname: ",
			    argv[2], NULL);
			return (TCL_ERROR);
		}
		q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
		if (strcmp(argv[3], "desc") == 0) {
			Tcl_AppendResult(interp, q->pd_desc, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[3], "offset") == 0) {
			(void) sprintf(tmp, "%d", q->pd_offset);
			Tcl_AppendResult(interp, tmp, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[3], "size") == 0) {
			(void) sprintf(tmp, "%d", q->pd_size);
			Tcl_AppendResult(interp, tmp, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[3], "get") == 0) {
			Tcl_AppendResult(interp, q->pd_getName, NULL);
			return (TCL_OK);
		} else if (strcmp(argv[3], "set") == 0) {
			Tcl_AppendResult(interp, q->pd_setName, NULL);
			return (TCL_OK);
		} else goto usage;
	}

	Tcl_AppendResult(interp, "Protocol: ", p->proto_name, NULL);
	if (strlen(p->proto_name) > 5)
		Tcl_AppendResult(interp, "\t\t\t", NULL);
	else
		Tcl_AppendResult(interp, "\t\t\t\t", NULL);
	Tcl_AppendResult(interp, "Name for <pinit>: ", p->proto_tcl_pinit,
	    NULL);
	Tcl_AppendResult(interp, "\n", NULL);
	Tcl_AppendResult(interp, "Name for <decode>: ", p->proto_tcl_decode,
	    NULL);
	Tcl_AppendResult(interp, "\t\t\tName for <list>: ", p->proto_tcl_list,
	    NULL);

	for (entryPtr = Tcl_FirstHashEntry(&p->proto_defines,
	    &search); entryPtr != NULL;
	    entryPtr = Tcl_NextHashEntry(&search)) {
		q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
		Tcl_AppendResult(interp, "\n", NULL);
		Tcl_AppendResult(interp, "\nFieldname: ", q->pd_fieldname,
		    "\t\tDescription: ", q->pd_desc, NULL);
		Tcl_AppendResult(interp, "\n", NULL);
		(void) sprintf(tmp, "Offset:  %d\t\t\tSize:  %d", q->pd_offset,
		    q->pd_size);
		Tcl_AppendResult(interp, tmp, NULL);
		Tcl_AppendResult(interp, "\n", NULL);
		Tcl_AppendResult(interp, "Set Function: ", q->pd_setName, NULL);
		if (q->pd_setName == NULL)
			Tcl_AppendResult(interp, "\t\t\t", NULL);
		else
			Tcl_AppendResult(interp, "\t\t", NULL);
		Tcl_AppendResult(interp, "Get Function: ", q->pd_getName, NULL);
	}
	return (TCL_OK);
}

static int
psh_pdelete(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	Tcl_HashEntry *entryPtr;
	Tcl_HashSearch search;
	struct pdefine_tbl *q;

	if (argc < 2 || argc > 3) {
		Tcl_AppendResult(interp, "Usage: pdelete <protocol>",
		    " [<fieldname>]", NULL);
		return (TCL_ERROR);
	}
	p = proto_lookup(argv[1]);
	if (p == NULL) {
		Tcl_AppendResult(interp, "Error: Unknown protocol: ", argv[1],
		    NULL);
		return (TCL_ERROR);
	}
	if (argc == 3) {
		entryPtr = Tcl_FindHashEntry(&p->proto_defines, argv[2]);
		if (entryPtr == NULL) {
			Tcl_AppendResult(interp, "Error: Unknown fieldname: ",
			    argv[2], NULL);
			return (TCL_ERROR);
		}
		q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
		Tcl_DeleteHashEntry(entryPtr);
		free(q->pd_desc);
		free(q->pd_setName);
		free(q->pd_getName);
		free((char *)q);
	} else {
		for (entryPtr = Tcl_FirstHashEntry(&p->proto_defines,
		    &search); entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
			q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
			free(q->pd_desc);
			free(q->pd_setName);
			free(q->pd_getName);
			Tcl_DeleteHashEntry(entryPtr);
			free((char *)q);
		}
		Tcl_DeleteHashTable(&p->proto_defines);
		entryPtr = Tcl_FindHashEntry(&protocols, argv[1]);
		p = (struct proto_tbl *)Tcl_GetHashValue(entryPtr);
		free(p->proto_name);
		Tcl_DeleteHashEntry(entryPtr);
		free((char *)p);
	}
	return (TCL_OK);
}

static int
psh_pdefine(ClientData clientData,  Tcl_Interp *interp, int argc, char *argv[])
{
	struct proto_tbl *p;
	struct pdefine_tbl *q, *r;
	Tcl_HashEntry *entryPtr, *entryPtr2;
	Tcl_HashSearch search;
	int retval, maxsize = 0;
	char tmp[BUFSIZ];

	Tcl_ResetResult(interp);
	if (argc <= 4 || argc > 8) {
usage:		Tcl_AppendResult(interp, "Usage: pdefine <protocol> ",
		    "<fieldname> <desc> <offset> <size> [<set> [<get>]]\n",
		    NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "<fieldname> desc <desc>\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "<fieldname> offset <offset>\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "<fieldname> size <size>\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "<fieldname> set [<set>]\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "<fieldname> get [<get>]\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "pinit <pinit>\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "decode <decode>\n", NULL);
		Tcl_AppendResult(interp, "       pdefine <protocol> ",
		    "list <list>", NULL);
		return (TCL_ERROR);
	}
	if ((p = proto_lookup(argv[1])) == NULL) {
		/*
		 * New protocol being created, no C protocol library
		 * exists already so create proto_tbl entry, etc...
		 */
		p = (struct proto_tbl *)malloc(sizeof (struct proto_tbl));
		if (p == NULL) {
			Tcl_AppendResult(interp, "Internal Error: malloc: no",
			    " space", NULL);
			return (TCL_ERROR);
		}
		(void) memset(p, 0, sizeof (*p));
		psh_strdup(p->proto_name, argv[1]);
		entryPtr = Tcl_CreateHashEntry(&protocols, p->proto_name,
		    &retval);
		Tcl_SetHashValue(entryPtr, p);
		Tcl_InitHashTable(&p->proto_defines, TCL_STRING_KEYS);
	}
	if (argc == 4) {
		/*
		 * Handle case of	pdefine <protocol> pinit <pinit>
		 * 			pdefine <protocol> decode <decode>
		 *			pdefine <protocol> list <list>
		 */
		if (strcmp(argv[2], "pinit") == 0) {
			if (strlen(argv[3]) == 0) {
				free(p->proto_tcl_pinit);
				return (TCL_OK);
			}
			if (checkTclcommand(interp, argv[3]) == TCL_OK) {
				free(p->proto_tcl_pinit);
				psh_strdup(p->proto_tcl_pinit, argv[3]);
				return (TCL_OK);
			} else {
				return (TCL_ERROR);
			}
		} else if (strcmp(argv[2], "decode") == 0) {
			if (strlen(argv[3]) == 0) {
				free(p->proto_tcl_decode);
				return (TCL_OK);
			}
			if (checkTclcommand(interp, argv[3]) == TCL_OK) {
				free(p->proto_tcl_decode);
				psh_strdup(p->proto_tcl_decode, argv[3]);
				return (TCL_OK);
			} else {
				return (TCL_ERROR);
			}
		} else if (strcmp(argv[2], "list") == 0) {
			if (strlen(argv[3]) == 0) {
				free(p->proto_tcl_list);
				return (TCL_OK);
			}
			if (checkTclcommand(interp, argv[3]) == TCL_OK) {
				free(p->proto_tcl_list);
				psh_strdup(p->proto_tcl_list, argv[3]);
				return (TCL_OK);
			} else {
				return (TCL_ERROR);
			}
		} else {
			goto usage;
		}
	}
	entryPtr = Tcl_CreateHashEntry(&p->proto_defines, argv[2], &retval);
	if (retval == 1) {
		/*
		 * Doesn't exist in pdefine_tbl structure so add it
		 */
		q = (struct pdefine_tbl *)malloc(sizeof (struct pdefine_tbl));
		if (q == NULL) {
			Tcl_AppendResult(interp, "Internal Error: malloc: no",
			    " space", NULL);
			Tcl_DeleteHashEntry(entryPtr);
			return (TCL_ERROR);
		}
		(void) memset(q, 0, sizeof (*q));
		if ((q->pd_fieldname = strdup(argv[2])) == NULL) {
			Tcl_AppendResult(interp, "Internal Error: malloc: no",
			    " space", NULL);
			Tcl_DeleteHashEntry(entryPtr);
			free(q);
			return (TCL_ERROR);
		}
		Tcl_SetHashValue(entryPtr, q);
		if ((q->pd_desc = strdup(argv[3])) == NULL) {
			Tcl_AppendResult(interp, "Internal Error: malloc: no",
			    " space", NULL);
			Tcl_DeleteHashEntry(entryPtr);
			free(q->pd_fieldname);
			free(q);
			return (TCL_ERROR);
		}
		(void) Tcl_GetInt(interp, argv[4], &q->pd_offset);
		(void) Tcl_GetInt(interp, argv[5], &q->pd_size);
		for (entryPtr2 = Tcl_FirstHashEntry(&p->proto_defines,
		    &search); entryPtr2 != NULL;
		    entryPtr2 = Tcl_NextHashEntry(&search)) {
			r = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr2);
			maxsize = max((r->pd_size + r->pd_offset), maxsize);
		}
		p->proto_len = max((q->pd_size + q->pd_offset), maxsize);
		if (argc == 6) {
			(void) sprintf(tmp, "setu%d", (q->pd_size * 8));
		} else if (argc == 7) {
			(void) strcpy(tmp, argv[6]);
		}
		if (strlen(tmp) != 0) {
			if (checkTclcommand(interp, tmp) == TCL_OK) {
				psh_strdup(q->pd_setName, tmp);
			} else {
				if ((checkCfunc(interp, tmp,
				    &q->pd_set)) == TCL_OK) {
					psh_strdup(q->pd_setName, tmp);
				} else {
					return (TCL_ERROR);
				}
			}
		}
		if (argc == 6 || argc == 7) {
			(void) sprintf(tmp, "getu%d", (q->pd_size * 8));
		} else if (argc == 8) {
			(void) strcpy(tmp, argv[7]);
		}
		if (strlen(tmp) != 0) {
			if (checkTclcommand(interp, tmp) == TCL_OK) {
				psh_strdup(q->pd_getName, tmp);
			} else {
				if ((checkCfunc(interp, tmp,
				    &q->pd_get)) == TCL_OK) {
					psh_strdup(q->pd_getName, tmp);
				} else {
					return (TCL_ERROR);
				}
			}
		}
	} else {
		/*
		 * It exists in pdefine_tbl structure, so time to modify
		 */
		entryPtr = Tcl_FindHashEntry(&p->proto_defines, argv[2]);
		q = (struct pdefine_tbl *)Tcl_GetHashValue(entryPtr);
		if (strcmp(argv[3], "offset") == 0) {
			if (Tcl_GetInt(interp, argv[4],
			    &q->pd_offset) != TCL_OK)
				return (TCL_ERROR);
		} else if (strcmp(argv[3], "size") == 0) {
			if (Tcl_GetInt(interp, argv[4], &q->pd_size) != TCL_OK)
				return (TCL_ERROR);
		} else if (strcmp(argv[3], "set") == 0) {
			if (strlen(argv[4]) == 0) {
				free(q->pd_setName);
				q->pd_set = NULL;
				return (TCL_OK);
			}
			if (strcmp(argv[4], "-") == 0) {
				(void) sprintf(tmp, "setu%d", (q->pd_size * 8));
			} else {
				(void) strcpy(tmp, argv[4]);
			}
			if (checkTclcommand(interp, tmp) == TCL_OK) {
				free(q->pd_setName);
				q->pd_set = NULL;
				psh_strdup(q->pd_setName, tmp);
				return (TCL_OK);
			} else {
				if ((checkCfunc(interp, tmp,
				    &q->pd_set)) == TCL_OK) {
					free(q->pd_setName);
					psh_strdup(q->pd_setName, tmp);
					return (TCL_OK);
				} else {
					return (TCL_ERROR);
				}
			}
		} else if (strcmp(argv[3], "get") == 0) {
			if (strlen(argv[4]) == 0) {
				free(q->pd_getName);
				q->pd_get = NULL;
				return (TCL_OK);
			}
			if (strcmp(argv[4], "-") == 0) {
				(void) sprintf(tmp, "getu%d", (q->pd_size * 8));
			} else {
				(void) strcpy(tmp, argv[4]);
			}
			if (checkTclcommand(interp, tmp) == TCL_OK) {
				free(q->pd_getName);
				q->pd_get = NULL;
				psh_strdup(q->pd_getName, tmp);
				return (TCL_OK);
			} else {
				if ((checkCfunc(interp, tmp,
					&q->pd_get)) == TCL_OK) {
					free(q->pd_getName);
					psh_strdup(q->pd_getName, tmp);
					return (TCL_OK);
				} else {
					return (TCL_ERROR);
				}
			}
		} else if (strcmp(argv[3], "desc") == 0) {
			free(q->pd_desc);
			psh_strdup(q->pd_desc, argv[4]);
		}
	}
	return (TCL_OK);
}

static int
psh_pinfo(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{

	char *result;

	static const char *strmatch =
	    "popen pclose pinit pfree pget pset plist";

	switch (argc) {
	case 1:
		Tcl_AppendResult(interp, "Usage: pinfo ...\n\n", NULL);
		Tcl_AppendResult(interp, "General Information: ",
		    " (Concepts and Commands)\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo packet\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo protocol\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo prlayer\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo commands\n\n", NULL);
		Tcl_AppendResult(interp, "Command Information:",
		    " (General)\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo <command>\n\n", NULL);
		Tcl_AppendResult(interp, "Command Information:",
		    " (Protocol Specific)\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo <protocol> ",
		    "<command>\n", NULL);
		Tcl_AppendResult(interp, "\tpinfo <protocol> ",
		    "<command> <fieldname>", NULL);
		break;
	case 2:
		result = Tcl_GetVar2(interp, "pinfoHelp", argv[1],
		    TCL_GLOBAL_ONLY);
		if (result == NULL) {
			Tcl_AppendResult(interp, "Error: No help is available",
			    " for ", argv[1], NULL);
			return (TCL_ERROR);
		}
		Tcl_AppendResult(interp, result, NULL);
		if (strstr(strmatch, argv[1]) != NULL) {
			result = Tcl_GetVar(interp, argv[1], NULL);
			if (result != NULL) {
				Tcl_AppendResult(interp, "\n\n",
				    "Protocols: ", NULL);
				Tcl_AppendResult(interp, result, NULL);
			}
		}
		break;
	}
	return (TCL_OK);
}



/*
 * ptbl command - report the current packet table of a packet.  In support
 * of scripts like the packet builder, it also sets the global Tcl variable
 * pshptbl with the results.
 *
 * XXX: should document this.
 */
static int
psh_ptbl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	struct packet *pckt;
	int i;
	char tmp[128];
	int flags;

	flags = TCL_LIST_ELEMENT|TCL_APPEND_VALUE;
	(void) Tcl_UnsetVar(interp, "pshptbl", flags);
	Tcl_ResetResult(interp);
	if (argc < 2) {
		Tcl_AppendResult(interp, "Usage: ptbl <pckt>", NULL);
		return (TCL_ERROR);
	}
	if ((pckt = pckt_lookup(argv[1])) == NULL) {
		Tcl_AppendResult(interp, "ptbl: invalid packet name: ",
		    argv[1], NULL);
		return (TCL_ERROR);
	}
	for (i = 0; i <= pckt->p_lptbl; i++) {
		(void) sprintf(tmp, "\n%s @ 0x%x", pckt->p_tbl[i].pt_name,
		    pckt->p_tbl[i].pt_offset);
		(void) Tcl_SetVar(interp, "pshptbl", pckt->p_tbl[i].pt_name,
		    flags);
		Tcl_AppendResult(interp, tmp, NULL);
	}
	return (TCL_OK);
}

static void
init_psh_proto(Tcl_Interp *interp)
{
	DIR *dir;
	struct dirent *dp;
	void *dobj;
	char name[128];
	char *env_val;
	proto_tbl_t *new;
	int retval;
	Tcl_HashEntry *entryPtr;
	void *lnsl_handle;
	char *p;

	/*
	 * Make a fake entry for 'end', so that get_prlayer() can return
	 * something with the name when called from, e.g., pproto.
	 */
	if ((new = malloc(sizeof (struct proto_tbl))) == NULL) {
		(void) fprintf(stderr, "Internal Error: malloc: no space\n");
		exit(1);
	}
	(void) memset(new, 0, sizeof (*new));
	if ((new->proto_name = strdup("end")) == NULL) {
		(void) fprintf(stderr, "Internal Error: malloc: no space\n");
		exit(1);
	}

	new->proto_epsize = sizeof (ep_t);

	entryPtr = Tcl_CreateHashEntry(&protocols, new->proto_name, &retval);
	Tcl_SetHashValue(entryPtr, new);

	(void) Tcl_CreateCommand(interp, "popen", psh_popen, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pclose", psh_pclose, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pinit", psh_pinit, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pfree", psh_pfree, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pset", psh_pset, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pget", psh_pget, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "plist", psh_plist, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pcopy", psh_pcopy, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "prawcopy", psh_prawcopy, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "poffset", psh_poffset, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pproto", psh_pproto, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "plen", psh_plen, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pcast", psh_pcast, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pread", psh_pread, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "psleep", psh_psleep, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pwrite", psh_pwrite, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pdump", psh_pdump, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pcktime", psh_pcktime, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "ptbl", psh_ptbl, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "packets", psh_packets, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "protocols", psh_protocols, NULL,
	    NULL);
	(void) Tcl_CreateCommand(interp, "endpoints", psh_endpoints, NULL,
	    NULL);
	(void) Tcl_CreateCommand(interp, "pdelete", psh_pdelete, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pretrieve", psh_pretrieve, NULL,
	    NULL);
	(void) Tcl_CreateCommand(interp, "pdefine", psh_pdefine, NULL, NULL);
	(void) Tcl_CreateCommand(interp, "pinfo", psh_pinfo, NULL, NULL);

	/*
	 * Getting pointers to IPv6 support functions:
	 *	inet_ntop();
	 *	inet_pton();
	 *	getipnodebyname().
	 */

	getipnodebynameptr = NULL;
	inet_ntopptr = NULL;
	inet_ptonptr = NULL;
#ifdef	SOLARIS
	lnsl_handle = dlopen("/lib/libnsl.so.1", RTLD_NOW);
	if (lnsl_handle != (void*) NULL) {
		getipnodebynameptr = (int (*)())dlsym(lnsl_handle,
			"getipnodebyname");
		inet_ntopptr = (int (*)())dlsym(lnsl_handle, "inet_ntop");
		inet_ptonptr = (int (*)())dlsym(lnsl_handle, "inet_pton");
	}
#endif

	(void) strcpy(dirname, PSH_LIB_DIR);

	env_val = getenv(PSH_LIB_ENV);
	if (env_val) {
		(void) strcpy(dirname, env_val);
	}
	(void) strcat(dirname, "/");
	dir = opendir(dirname);
	if (!dir) {
		(void) fprintf(stderr, "Warning: Can't open protocols directory"
		    " %s\n", dirname);
		return;
	}

	if ((p = strstr(dirname, PSH_SYLLABLE)) == NULL) {
		(void) fprintf(stderr, "Proto directory path does not contain"
		    " %s\n", PSH_SYLLABLE);
		return;
	}

	while ((dp = readdir(dir)) != NULL) {
		if (strchr(dp->d_name, '.') != NULL) {
			continue;
		}
		(void) strcpy(name, dirname);
		(void) strcat(name, dp->d_name);
		/*
		 * This RTLD_GLOBAL stuff is Solaris specific.  What it does
		 * is allow dynamic objects to share common functions.
		 * Unfortunately, RTLD_GLOBAL functionality isn't portable,
		 * so we only go through this if the system defines it.
		 *
		 * A protocol library writer might want to take this under
		 * consideration.  They can't be sure of shareability
		 * between protocol libraries.
		 */
#ifdef	RTLD_GLOBAL
		dobj = dlopen(name, RTLD_NOW|RTLD_GLOBAL);
		/*
		 * Use 0 as the pathname so that dlopen()
		 * provides a handle on a global system object.  This
		 * object provides access to the symbols from an ordered
		 * set of objects consisting of the original program image
		 * file, any other dependencies loaded at startup, and any
		 * objects that were loaded using dlopen() with the
		 * RTLD_GLOBAL file.
		 */
		(void) dlopen(0, RTLD_NOW|RTLD_GLOBAL);
#else
		dobj = dlopen(name, RTLD_NOW);
#endif
		if (dobj == NULL) {
			(void) fprintf(stderr, "Error: Bad object library: %s "
			    "%s\n", dp->d_name, dlerror());
			continue;
		}
		new = (struct proto_tbl *)malloc(sizeof (struct proto_tbl));
		if (new == NULL ||
		    (new->proto_name = strdup(dp->d_name)) == NULL) {
			(void) fprintf(stderr, "Internal Error: malloc: "
			    "no space\n");
			exit(1);
		}
		new->proto_libinit = (int (*)())dlsym(dobj, PSH_INIT_SYM);

		if ((new->proto_open = (int (*)())dlsym(dobj, PSH_OPEN_SYM)) !=
		    NULL)
			(void) Tcl_SetVar(interp, "popen", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		if ((new->proto_close =
		    (int (*)())dlsym(dobj, PSH_CLOSE_SYM)) != NULL)
			(void) Tcl_SetVar(interp, "pclose", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		if ((new->proto_init = (int (*)())dlsym(dobj, PSH_PINIT_SYM)) !=
		    NULL)
			(void) Tcl_SetVar(interp, "pinit", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		if ((new->proto_free = (int (*)())dlsym(dobj, PSH_PFREE_SYM)) !=
		    NULL)
			(void) Tcl_SetVar(interp, "pfree", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		new->proto_decode = (int (*)())dlsym(dobj, PSH_DECODE_SYM);
		/*
		 * Historically C protocol libraries called the 'decode'
		 * function 'next_offset'--a horribly bad name.  Just in
		 * case this is a historic library we try the old name if
		 * the new name doesn't exist.
		 */
		if (new->proto_decode == NULL) {
			new->proto_decode = (int (*)())dlsym(dobj,
			    "next_offset");
		}
		if ((new->proto_get = (int (*)())dlsym(dobj, PSH_GET_SYM)) !=
		    NULL)
			(void) Tcl_SetVar(interp, "pget", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		if ((new->proto_set = (int (*)())dlsym(dobj, PSH_SET_SYM)) !=
		    NULL)
			(void) Tcl_SetVar(interp, "pset", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		if ((new->proto_list = (int (*)())dlsym(dobj, PSH_LIST_SYM)) !=
		    NULL)
			(void) Tcl_SetVar(interp, "plist", new->proto_name,
			    TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
		if ((new->proto_waitaction =
		    (int (*)())dlsym(dobj, PSH_WACTION_SYM)) != NULL)
			(void) Tcl_SetVar(interp, "wait_action",
			    new->proto_name, TCL_LIST_ELEMENT|TCL_APPEND_VALUE);

		/*
		 * Initialize dynamic protocol definitions to NULL
		 * by default for pinit, decode, and list routines
		 */
		new->proto_tcl_pinit = NULL;
		new->proto_tcl_decode = NULL;
		new->proto_tcl_list = NULL;

		new->proto_len = 0;

		entryPtr = Tcl_CreateHashEntry(&protocols, dp->d_name,
		    &retval);
		Tcl_SetHashValue(entryPtr, new);
		Tcl_InitHashTable(&new->proto_defines, TCL_STRING_KEYS);

		if (new->proto_libinit != NULL &&
		    (new->proto_libinit)(new, interp) == NULL) {
			free(new->proto_name);
			free(new);
			(void) fprintf(stderr,
			    "Warning: Unsuccessful setup: %s\n", dp->d_name);
		}
	}
	(void) closedir(dir);
	*p++ = '\0';
	strcpy(psh_home, dirname);
	strcat(psh_home, PSH_SYLLABLE);
}

int
main(int argc, char **argv)
{

#ifndef	WINDOWS
	Tcl_Main(argc, argv, Tcl_AppInit);
#else
	Tk_Main(argc, argv, Tcl_AppInit);
#endif
	/* UNREACHABLE */
	return (0);
}
