Intial commit

tcl-dp/generic/dp.h

@@ -0,0 +1,101 @@
+/*
+ * dp.h --
+ *
+ *	Declarations for Dp-related things that are visible
+ *	outside of the Dp module itself.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _DP
+#define _DP
+
+#define DP_VERSION "4.0"
+#define DP_MAJOR_VERSION 4
+#define DP_MINOR_VERSION 0
+
+#ifndef _TCL
+#include <tcl.h>
+#endif
+
+/*
+ * Procedure types defined by DP:
+ */
+
+typedef Tcl_Channel (Dp_ChanCreateProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	int argc, char ** argv));
+
+/*
+ * The following structure is used to register channel types which become
+ * available to various DP commands.
+ */
+
+typedef struct Dp_ChannelType {
+    struct Dp_ChannelType * nextPtr;	/* Links to the next channel type
+					 * record in the list of types.
+					 * Must be set to NULL by the caller
+					 * of Dp_RegisterChannelType() */
+    char * name;                        /* Name of this type of channel */
+    Dp_ChanCreateProc *createProc;      /* Procedure to create a channel
+                                         * of this type */
+} Dp_ChannelType;
+
+
+/*
+ * Type for plug-in function.
+ */
+
+typedef int (Dp_PlugInFilterProc)  _ANSI_ARGS_((char *inBuf, int inLength,
+                                                char **outBuf, int *outLength,
+						void **data, Tcl_Interp *interp,
+						int mode)); 
+
+/*
+ * Any new filter that is registered should provide a (ckallock-ed) pointer to
+ * such a structure, whose "name" and "plugProc" fields must be set.
+ */
+
+typedef struct _Dp_PlugInFilter {
+    struct _Dp_PlugInFilter * nextPtr;
+    char                    * name;
+    Dp_PlugInFilterProc     * plugProc;
+} Dp_PlugInFilter;
+  
+
+/*
+ * Modes for the plug-in filter functions.
+ */
+
+#define DP_FILTER_NORMAL   0
+#define DP_FILTER_FLUSH    1
+#define DP_FILTER_CLOSE    3
+#define DP_FILTER_SET      4
+#define DP_FILTER_GET      5
+#define DP_FILTER_EOF      6
+
+/*
+ * Exported DP functions.
+ */
+
+EXTERN char *           Dp_ListChannelTypes    _ANSI_ARGS_((void));
+EXTERN Dp_ChannelType * Dp_GetChannelType _ANSI_ARGS_((
+        		    Tcl_Interp * interp, char * name));
+EXTERN int		Dp_RegisterChannelType _ANSI_ARGS_((
+    			    Tcl_Interp * interp, Dp_ChannelType *newTypePtr));
+
+EXTERN int              Dp_RegisterPlugInFilter  _ANSI_ARGS_((
+    			    Tcl_Interp * interp, Dp_PlugInFilter *plugInPtr));
+
+EXTERN Dp_PlugInFilterProc *Dp_GetFilterPtr  _ANSI_ARGS_((
+                            Tcl_Interp * interp, char * name));
+
+EXTERN char            *Dp_GetFilterName  _ANSI_ARGS_((
+			    Dp_PlugInFilterProc *filter));
+
+ 
+#endif /* _DP */
+

tcl-dp/generic/dpChan.c

@@ -0,0 +1,515 @@
+/* 
+ * dpChan.c --
+ *
+ *	Routines for managing install-able channel types.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tcl.h>
+#include <stdlib.h>
+#include "generic/dpPort.h"
+#include "generic/dpInt.h"
+
+
+/*
+ * This variable holds the list of channel types.
+ */
+
+static Dp_ChannelType * chanTypeList = (Dp_ChannelType *) NULL;
+
+/*
+ * All the DP built-in channel types.
+ */
+
+static Dp_ChannelType builtInTypes[] = {
+    {NULL,	"ipm",		DpOpenIpmChannel},
+    {NULL,	"tcp",		DpOpenTcpChannel},
+#ifndef _WIN32
+    {NULL,	"email",	DpCreateEmailChannel},
+#endif
+    {NULL,      "identity",     DpCreateIdChannel},
+    {NULL,      "plugfilter",   DpCreatePlugFChannel},
+    {NULL,	"udp",		DpOpenUdpChannel},
+    {NULL,      "serial",       DpOpenSerialChannel},
+    {NULL,      "packoff",      DpCreatePOChannel},
+    /*
+     * This array must end with the following element.
+     */
+    {NULL,	NULL,		NULL}
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  Dp_RegisterChannelType --
+ *
+ *	Registers a new type of channel that can be used in the DP
+ *	user-level commands. newTypePtr must points to a Dp_ChannelType
+ *	structure in *static memory*, the contents of which must not
+ *	be modified after calling this function.
+ *
+ * Results:
+ *	Standard TCL return value. Fails if a channel type with the
+ *	same name has already been registered.
+ *
+ * Side effects:
+ *	On success, newTypePtr is inserted to the head of the list
+ *	of channel types. Also, the next pointer of newTypePtr is
+ *	modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Dp_RegisterChannelType(interp, newTypePtr)
+    Tcl_Interp * interp;        /* Interpreter to report errors. */
+    Dp_ChannelType * newTypePtr;/* The DP channel type record */
+{
+    Dp_ChannelType * chanTypePtr;
+
+    for (chanTypePtr = chanTypeList; chanTypePtr;
+	    chanTypePtr=chanTypePtr->nextPtr) {
+
+	if (strcmp(chanTypePtr->name, newTypePtr->name)==0) {
+	    Tcl_AppendResult(interp, "Channel type \"", newTypePtr->name,
+		"\" already exists", NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    newTypePtr->nextPtr = chanTypeList;
+    chanTypeList = newTypePtr;
+
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  Dp_GetChannelType --
+ *
+ *	Returns a registered channel type.
+ *
+ * Results:
+ *	Standard TCL return value.
+ *
+ * Side effects:
+ *	None.
+ *--------------------------------------------------------------
+ */
+
+Dp_ChannelType *
+Dp_GetChannelType(interp, name)
+    Tcl_Interp * interp;        /* Interpreter to report errors. */
+    char * name;		/* String name of the channel type */
+{
+    Dp_ChannelType * chanTypePtr;
+
+    for (chanTypePtr = chanTypeList; chanTypePtr;
+	    chanTypePtr=chanTypePtr->nextPtr) {
+
+	if (strcmp(chanTypePtr->name, name)==0) {
+	    return chanTypePtr;
+	}
+    }
+
+    return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  Dp_ListChannelTypes --
+ *
+ *	Returns a list of valid channel types.   The string is
+ *      dynamically allocated, and must be freed by the caller.
+ *
+ * Results:
+ *	Dynamically allocated string with valid channel types.
+ *
+ * Side effects:
+ *	Return value must be free'd by caller.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Dp_ListChannelTypes()
+{
+    char *str;
+    int maxLen, currLen, len;
+    Dp_ChannelType *chanTypePtr;
+
+    maxLen = 1024;
+    currLen = 0;
+    str = ckalloc (maxLen);
+
+    for (chanTypePtr = chanTypeList; chanTypePtr != NULL;
+	    chanTypePtr = chanTypePtr->nextPtr) {
+        len = strlen(chanTypePtr->name);
+        if ((len + currLen + 2) > maxLen) {
+	    char *newStr;
+            maxLen += max (1024,len+512);
+            newStr = ckalloc (maxLen);
+            memcpy (newStr, str, currLen);
+            ckfree (str);
+            str = newStr;
+	}
+        sprintf (str + currLen, "%s ", chanTypePtr->name);
+        currLen += len + 1;
+    }
+    return str;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  DpClose --
+ *
+ *	Closes a channel.  We just eval "close" in case the
+ *	close command has been overloaded a la dp_atclose.
+ *
+ * Results:
+ *
+ *	TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ *	
+ *	Closes a channel.  It is no longer available in this
+ *	interpreter.
+ *.
+ *--------------------------------------------------------------
+ */
+
+int
+DpClose(interp, chan)
+    Tcl_Interp *interp;
+    Tcl_Channel chan;
+{
+    char cmd[30];
+
+    sprintf(cmd, "close %s", Tcl_GetChannelName(chan));
+    return Tcl_GlobalEval(interp, cmd);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  DpInitChannels --
+ *
+ *	Registers all the built-in channels supported by DP.
+ *
+ * Results:
+ *	Standard TCL return value.
+ *
+ * Side effects:
+ *	Built-in channels are registered in the channel type list.
+ *--------------------------------------------------------------
+ */
+
+int
+DpInitChannels(interp)
+    Tcl_Interp * interp;        /* Interpreter to report errors. */
+{
+    int i;
+
+    for (i=0; ; i++) {
+	if (builtInTypes[i].name == NULL) {
+	    break;
+	} else {
+	    if (Dp_RegisterChannelType(interp, &builtInTypes[i]) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DpTranslateOption --
+ *
+ *	This function translates a standard option name (e.g.,
+ *	"sendBuffer") into a key (e.g., DP_SEND_BUFFER_SIZE)
+ *
+ * Results:
+ *	value of option (see dpInt.h for valid keys -- search on
+ *	DP_SEND_BUFFER_SIZE) if the option was found, -1 if not.
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+int
+DpTranslateOption (name)
+    char *name;			/* The name to translate */
+{
+    char c;
+    int len;
+
+    c = name[0];
+    len = strlen(name);
+
+    if ((c == 'b') && (strncmp(name, "baudrate", len) == 0)) {
+	return DP_BAUDRATE;
+    } else if ((c == 'c') && (strncmp(name, "charsize", len) == 0)) {
+	return DP_CHARSIZE;
+    } else if ((c == 'g') && (strncmp(name, "group", len) == 0)) {
+	return DP_GROUP;
+    } else if ((c == 'h') && (strncmp(name, "host", len) == 0)) {
+	return DP_HOST;
+    } else if ((c == 'k') && (strncmp(name, "keepAlive", len) == 0)) {
+	return DP_KEEP_ALIVE;
+    } else if ((c == 'l') && (strncmp(name, "linger", len) == 0)) {
+	return DP_LINGER;
+    } else if ((c == 'l') && (strncmp(name, "loopback", len) == 0)) {
+	return DP_MULTICAST_LOOP;
+    } else if ((c == 'm') && (strncmp(name, "myport", len) == 0)) {
+	return DP_MYPORT;
+    } else if ((c == 'p') && (strncmp(name, "parity", len) == 0)) {
+	return DP_PARITY;
+    } else if ((c == 'p') && (strncmp(name, "peek", len) == 0)) {
+	return DP_PEEK;
+    } else if ((c == 'p') && (strncmp(name, "port", len) == 0)) {
+	return DP_PORT;
+    } else if ((c == 'r') && (strncmp(name, "recvBuffer", len) == 0)) {
+	return DP_RECV_BUFFER_SIZE;
+    } else if ((c == 'r') && (strncmp(name, "reuseAddr", len) == 0)) {
+	return DP_REUSEADDR;
+    } else if ((c == 's') && (strncmp(name, "sendBuffer", len) == 0)) {
+	return DP_SEND_BUFFER_SIZE;
+    } else if ((c == 's') && (strncmp(name, "stopbits", len) == 0)) {
+	return DP_STOPBITS;
+    } else if ((c == 'm') && (strncmp(name, "myIpAddr", len) == 0)) {
+	return DP_MYIPADDR;
+    } else if ((c == 'd') && (strncmp(name, "destIpAddr", len) == 0)) {
+	return DP_REMOTEIPADDR;
+    } else if ((c == 'd') && (strncmp(name, "destport", len) == 0)) {
+	return DP_REMOTEPORT;
+    } else if ((c == 'a') && (strncmp(name, "address", len) == 0)) {
+	return DP_ADDRESS;
+    } else if ((c == 'i') && (strncmp(name, "identifier", len) == 0)) {
+	return DP_IDENTIFIER;
+    } else if ((c == 's') && (strncmp(name, "sequence", len) == 0)) {
+	return DP_SEQUENCE;
+    } else if ((c == 'c') && (strncmp(name, "channel", len) == 0)) {
+	return DP_CHANNEL;
+    } else if ((c == 'i') && (strncmp(name, "infilter", len) == 0)) {
+	return DP_INFILTER;
+    } else if ((c == 'o') && (strncmp(name, "outfilter", len) == 0)) {
+	return DP_OUTFILTER;
+    } else if ((c == 'i') && (strncmp(name, "inset", len) == 0)) {
+	return DP_INSET;
+    } else if ((c == 'o') && (strncmp(name, "outset", len) == 0))
+	return DP_OUTSET;
+
+    return -1;
+}
+
+
+
+
+/*
+ * This variable holds the list of registered plug-in filters.
+ */
+
+static Dp_PlugInFilter *plugInList = (Dp_PlugInFilter *) NULL;
+
+
+/*
+ * All the built-in plug-in functions.
+ */
+
+static Dp_PlugInFilter builtInPlugs[] = {
+
+    {NULL,     "identity",     Identity},
+    {NULL,     "plug1to2",     Plug1to2},
+    {NULL,     "plug2to1",     Plug2to1},
+    {NULL,     "xor",          Xor},
+    {NULL,     "packon",       PackOn},
+    {NULL,     "uuencode",     Uuencode},
+    {NULL,     "uudecode",     Uudecode},
+    {NULL,     "tclfilter",    TclFilter},
+    {NULL,     "hexout",    HexOut},
+    {NULL,     "hexin",    HexIn},
+
+    /*
+     * This array must end with the following element.
+     */
+
+    {NULL,	NULL,		NULL}
+};
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Dp_RegisterPlugInFilter --
+ *
+ *	Registers a new type of filter that can be used in the DP
+ *	user-level commands. newPlugInPtr must point to a Dp_PlugInFilter
+ *	structure in *static memory*, the contents of which must not
+ *	be modified after calling this function.
+ *
+ * Results:
+ *
+ *	Standard TCL return value. Fails if a filter with the
+ *	same name has already been registered.
+ *
+ * Side effects:
+ *	On success,  newPlugInPtr is inserted to the head of the list
+ *	of filter. Also, the next pointer of newPlugInPtr is
+ *	modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Dp_RegisterPlugInFilter (interp, newPlugInPtr)
+    Tcl_Interp      * interp;       /* (in) Interpreter to report errors to. */
+    Dp_PlugInFilter * newPlugInPtr; /* (in) Pointer to the filter function. */
+{
+    Dp_PlugInFilter *plugInPtr;
+
+    for (plugInPtr = plugInList; plugInPtr;
+	    plugInPtr = plugInPtr->nextPtr) {
+
+	if (strcmp(plugInPtr->name, newPlugInPtr->name)==0) {
+	    Tcl_AppendResult(interp, "Plug-in filter  \"", newPlugInPtr->name,
+		"\" already exists", NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    newPlugInPtr->nextPtr = plugInList;
+    plugInList = newPlugInPtr;
+
+    return TCL_OK;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Dp_GetFilterPtr --
+ *
+ *	Returns a pointer to the filter function whose name was given.
+ *
+ * Results:
+ *
+ *	Pointer to the filter function or NULL if the name is not the name of
+ *	a registered filter function.
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+Dp_PlugInFilterProc *
+Dp_GetFilterPtr  (interp, name)
+    Tcl_Interp  *interp;        /* (in) Interpreter to report errors to. */
+    char        *name;		/* (in) Name of the filter function. */
+{
+    Dp_PlugInFilter *plugInPtr;
+
+    for (plugInPtr = plugInList; plugInPtr;
+	    plugInPtr = plugInPtr->nextPtr) {
+	if (strcmp(plugInPtr->name, name) == 0) {
+            return plugInPtr->plugProc;
+        }
+    }
+
+    Tcl_AppendResult(interp, "unknown plug-in function \"", name, "\"", NULL);
+    return NULL;
+}
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Dp_GetFilterName --
+ *
+ *	Returns the name of the given filter function.
+ *
+ * Results:
+ *
+ *	A pointer to the name of the filter function or NULL if the function
+ *	pointer does not appear in the list of registered filter functions.
+ *
+ * Side effects:
+ *
+ *	None. 
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+char *
+Dp_GetFilterName  (filter)
+    Dp_PlugInFilterProc *filter;    /* (in) Pointer to the filter function. */
+{
+    Dp_PlugInFilter *plugInPtr;
+
+    for (plugInPtr = plugInList; plugInPtr;
+	    plugInPtr = plugInPtr->nextPtr) {
+	if (filter, plugInPtr->plugProc) {
+            return plugInPtr->name;
+        }
+    }
+
+    return NULL;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Dp_DpInitPlugIn --
+ *
+ *	Registers all the built-in channels supported by DP.
+ *
+ * Results:
+ *
+ *	Standard TCL return value.
+ *
+ * Side effects:
+ *
+ *	Built-in filter functions are registered in the plug-in filter list. 
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+DpInitPlugIn(interp)
+    Tcl_Interp * interp;        /* (in) Interpreter to report errors to. */
+{
+    int i;
+
+    for (i=0; ; i++) {
+	if (builtInPlugs[i].name == NULL) {
+	    break;
+	} else {
+	    if (Dp_RegisterPlugInFilter(interp, &builtInPlugs[i]) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+    }
+
+    return TCL_OK;
+}
+
+
+

tcl-dp/generic/dpCmds.c

@@ -0,0 +1,527 @@
+/*
+ * dpCmd.c --
+ *
+ *	This file contains the command routines for most of
+ *	the DP built-in commands.
+ *
+ * Copyright (c) 1995-1996 The Regents of Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "generic/dpInt.h"
+#include <tclInt.h>
+ 
+/*
+ * The default number of bytes for "dp_copy" to read in each call
+ * to Tcl_Read().
+ */
+
+#define	TCL_READ_CHUNK_SIZE	4096
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dp_AcceptCmd --
+ *
+ *	This procedure is invoked to process the "dp_accept" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Dp_AcceptCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Channel chan;
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " channelId\"", NULL);
+	return TCL_ERROR;
+    }
+
+    if ((chan = Dp_TcpAccept(interp, argv[1])) == NULL) {
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dp_ConnectCmd --
+ *
+ *	This procedure is invoked to process the "dp_connect" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Dp_ConnectCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Dp_ChannelType * chanTypePtr;
+    Tcl_Channel chan;
+    char *validTypes;
+
+    if (argc < 2) {
+        validTypes = Dp_ListChannelTypes();
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+            " channelType ?args ...?\"\nValid channel types are: ", validTypes, NULL);
+        ckfree (validTypes);
+	return TCL_ERROR;
+    }
+
+    chanTypePtr = Dp_GetChannelType(interp, argv[1]);
+    if (chanTypePtr == NULL) {
+        validTypes = Dp_ListChannelTypes();
+	Tcl_AppendResult(interp, "Unknown channel type \"", argv[1],
+            "\"\nValid channel types are: ", validTypes, NULL);
+        ckfree (validTypes);
+	return TCL_ERROR;
+    }
+
+    chan = chanTypePtr->createProc(interp, argc-2, argv+2);
+    if (chan == NULL) {
+	return TCL_ERROR;
+    } else {
+        Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dp_CopyCmd --
+ *
+ *	This procedure is invoked to process the "dp_copy" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Dp_CopyCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Channel inChan;
+    Tcl_Channel *outChans = NULL;
+    int numOutChans;
+    int i, m;
+    int requested = INT_MAX;
+    char *bufPtr = NULL;
+    int actuallyRead, actuallyWritten, totalRead, toReadNow, mode;
+
+
+    /*
+     * 1. Get the optional -size argument.
+     */
+
+    m = 1;
+    if (argc > 2) {
+	if (argv[1][0] == '-' && strcmp(argv[1], "-size")==0) {
+	    if (argc == 2) {
+		Tcl_AppendResult(interp, "value missing for \"-size\"", NULL);
+		goto error;
+	    }
+	    if (Tcl_GetInt(interp, argv[2], &requested) != TCL_OK) {
+		goto error;
+	    }
+	    if (requested < 0) {
+		requested = INT_MAX;
+	    }
+
+	    /*
+	     * argv[m] is the in channel and argv[m+1, ...] are the out
+	     * channels.
+	     */
+	    m = 3;
+	}
+    }
+
+    if (argc-m < 2) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"",
+                argv[0], " ?-size size? inChanId outChanId ?outChanId ...?\"",
+		(char *) NULL);
+	goto error;
+    }
+
+    /*
+     * 2. Get the in channel.
+     */
+
+    inChan = Tcl_GetChannel(interp, argv[m], &mode);
+    if (inChan == (Tcl_Channel) NULL) {
+	goto error;
+    }
+    if ((mode & TCL_READABLE) == 0) {
+        Tcl_AppendResult(interp, "channel \"", argv[m],
+                "\" wasn't opened for reading", (char *) NULL);
+	goto error;
+    }
+
+    /*
+     * 3. Get the out channel(s).
+     */
+
+    numOutChans = argc - m - 1;
+    outChans = (Tcl_Channel*)ckalloc(sizeof(Tcl_Channel) * numOutChans);
+    for (i=0; i<numOutChans; i++) {
+	outChans[i] = Tcl_GetChannel(interp, argv[i + m+1], &mode);
+	if (outChans[i] == (Tcl_Channel) NULL) {
+	    goto error;
+	}
+	if ((mode & TCL_WRITABLE) == 0) {
+	    Tcl_AppendResult(interp, "channel \"", argv[i + m+1],
+                    "\" wasn't opened for writing", (char *) NULL);
+	    goto error;
+	}
+    }
+
+    /*
+     * 4. Copy the data.
+     */
+
+    bufPtr = ckalloc((unsigned) TCL_READ_CHUNK_SIZE);
+    for (totalRead = 0;
+            requested > 0;
+            totalRead += actuallyRead, requested -= actuallyRead) {
+        toReadNow = requested;
+        if (toReadNow > TCL_READ_CHUNK_SIZE) {
+            toReadNow = TCL_READ_CHUNK_SIZE;
+        }
+        actuallyRead = Tcl_Read(inChan, bufPtr, toReadNow);
+        if (actuallyRead < 0) {
+	    Tcl_AppendResult(interp, argv[0], ": ", Tcl_GetChannelName(inChan), 
+		    " ", Tcl_PosixError(interp), (char *) NULL);
+	    goto error;
+        }
+        if (actuallyRead == 0) {
+            sprintf(interp->result, "%d", totalRead);
+	    goto done;
+        }
+	for (i=0; i<numOutChans; i++) {
+	    actuallyWritten = Tcl_Write(outChans[i], bufPtr, actuallyRead);
+	    if (actuallyWritten < 0) {
+		Tcl_AppendResult(interp, argv[0], ": ", 
+			Tcl_GetChannelName(outChans[i]), " ",
+			Tcl_PosixError(interp), (char *) NULL);
+		goto error;
+	    }
+        }
+    }
+
+done:
+    if (bufPtr != NULL) {
+	ckfree(bufPtr);
+    }
+    if (outChans != NULL) {
+	ckfree((char*)outChans);
+    }
+    sprintf(interp->result, "%d", totalRead);
+    return TCL_OK;
+
+error:
+    if (bufPtr != NULL) {
+	ckfree(bufPtr);
+    }
+    if (outChans != NULL) {
+	ckfree((char*)outChans);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dp_NetInfoCmd --
+ *
+ *	This procedure is invoked to process the "dp_netinfo" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Dp_NetInfoCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+	    " option arg\"", NULL);
+	return TCL_ERROR;
+    }
+
+    if (strlen(argv[1]) > 1) {
+	char c = argv[1][1];
+	switch (c) {
+	case 's': {
+	    /* 
+	     * Get the service entry for service name or port number 
+	     */
+	    if (strcmp(argv[1], "-service") == 0) {
+		struct servent *serviceEntry = NULL;
+		char port[10];
+		int portNum;
+		/* 
+		 * First try argv[2] as a name 
+		 */
+		serviceEntry = getservbyname(argv[2], (char *) NULL);
+		if (serviceEntry == NULL) {
+		    /* 
+		     * Now try argv[2] as a port number 
+		     */
+		    portNum = atoi(argv[2]);
+		    serviceEntry = getservbyport(htons((unsigned short)portNum), 
+					(char *) NULL);
+		    if (serviceEntry == NULL) {
+			Tcl_AppendResult(interp, argv[0], 
+				" -service unknown service/port# \"",
+				argv[2], "\"", (char *) NULL);
+			return TCL_ERROR;
+		    }
+		}
+		sprintf(port, "%4d", ntohs(serviceEntry->s_port));
+		Tcl_AppendResult(interp, serviceEntry->s_name, " ", port, " ", 
+				(char *) NULL);
+		return TCL_OK;
+	    }
+	} 
+	break;
+
+	case 'a': {
+	    /* 
+	     * Translate between host name and IP address.
+	     */
+	    if (strcmp(argv[1], "-address") == 0) {
+		char hostName[120];
+		char addrStr[16];
+		int addr;
+		/* 
+		 * try argv[2] as an IP address first
+		 */
+		if ((addr = inet_addr(argv[2])) != -1) {
+		    if (DpIpAddrToHost(addr, hostName)) {
+			Tcl_AppendResult(interp, hostName, (char *) NULL);
+			return TCL_OK;
+		    } else {
+			Tcl_AppendResult(interp, argv[0], 
+				" -address unknown host \"",
+				argv[2], "\"", (char *) NULL);
+			return TCL_ERROR;
+		    }
+		} else {
+		    if (DpHostToIpAddr(argv[2], &addr)) {
+			sprintf(addrStr, "%d.%d.%d.%d", (addr>>24)&0xFF, 
+				(addr>>16)&0xFF, (addr>>8)&0xFF, addr&0xFF);
+			Tcl_AppendResult(interp, addrStr, (char *) NULL);
+			return TCL_OK;
+		    } else {
+			Tcl_AppendResult(interp, argv[0], 
+				" -address unknown host \"",
+				argv[2], "\"", (char *) NULL);
+			return TCL_ERROR;
+		    }
+		}
+	    }
+	}
+	break;
+
+	}
+    }
+    Tcl_AppendResult(interp, argv[0], ":  unknown option \"",
+	    argv[1], "\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/* ----------------------------------------------------
+ *
+ *    Dp_SendCmd --
+ *
+ *	Implements a send-like command for channels.
+ *	The Tcl I/O system has serious problems because
+ *	it does internal buffering.  One can use this
+ *	command to bypass the Tcl I/O subsystem.
+ *
+ *    Returns
+ *
+ *	TCL_OK with the amount sent or TCL_ERROR.
+ *
+ *    Side Effects
+ *
+ *	The channel is written to.
+ *
+ * -----------------------------------------------------
+ */
+
+int
+Dp_SendCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Channel chan;
+    char writ[10];
+    int errorCode = 0, toWrite, written = 0, mode;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " channelId string\"", NULL);
+	return TCL_ERROR;
+    }
+
+    if ((chan = Tcl_GetChannel(interp, argv[1], &mode)) == NULL) {
+	return TCL_ERROR;
+    }
+
+    toWrite = strlen(argv[2]);
+
+    while (toWrite > written) {
+	written += (Tcl_GetChannelType(chan)->outputProc) 
+		(Tcl_GetChannelInstanceData(chan), argv[2] + written,
+		toWrite - written, &errorCode);
+	if (errorCode > 0) {
+	    break;
+	}
+    }
+
+    if (errorCode > 0) {
+	/*
+	 * Translate error code to POSIX
+	 */
+	DppGetErrno();
+        Tcl_AppendResult(interp, "Error sending on channel \"", argv[1], "\":",
+		Tcl_PosixError(interp), (char *)NULL);
+	return TCL_ERROR;
+    }
+    sprintf(writ, "%d", written);
+
+    Tcl_AppendResult(interp, writ, (char *)NULL);
+    return TCL_OK;
+}
+
+/* ----------------------------------------------------
+ *
+ *    Dp_RecvCmd --
+ *
+ *	Implements a recv-like command for channels.
+ *	The Tcl I/O system has serious problems because
+ *	it does internal buffering.  One can use this
+ *	command to bypass the Tcl I/O subsystem.
+ *
+ *    Returns
+ *
+ *	TCL_OK with the message recv'd or TCL_ERROR.
+ *
+ *    Side Effects
+ *
+ *	The channel is read.
+ *
+ * -----------------------------------------------------
+ */
+
+int
+Dp_RecvCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Channel chan;
+    Tcl_DString dstr;
+    int errorCode = 0, nread = 0, mode;
+    char buff[4096];
+    int blocking;
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " channelId\"", NULL);
+	return TCL_ERROR;
+    }
+
+    if ((chan = Tcl_GetChannel(interp, argv[1], &mode)) == NULL) {
+	return TCL_ERROR;
+    }
+    memset(buff, 0, sizeof(buff));
+
+    nread = (Tcl_GetChannelType(chan)->inputProc) (Tcl_GetChannelInstanceData(chan),
+            (char *)buff, sizeof(buff)-1, &errorCode);
+
+    if (nread == DP_SOCKET_ERROR) {
+	Tcl_DStringInit(&dstr);
+	Tcl_GetChannelOption(
+#ifdef _TCL80
+				interp,
+#endif
+				chan, "-blocking", &dstr);
+	Tcl_GetBoolean(interp, Tcl_DStringValue(&dstr), &blocking);
+        Tcl_DStringFree(&dstr);
+	if ((blocking == 0) && (DppGetErrno() == EWOULDBLOCK)) {
+	    /*
+	     * If the channel is non-blocking and we returned because
+	     * there was nothing to read, then there is no error.
+	     */
+	} else { 
+	    /*
+	     * The error code has already been translated by the above call
+	     * to DppGetErrno().
+	     */
+	    Tcl_AppendResult(interp, "Error receiving on channel \"", argv[1],
+		    "\":", Tcl_PosixError(interp), (char *)NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    Tcl_AppendResult(interp, buff, (char *)NULL);
+    return TCL_OK;
+}
+
+

tcl-dp/generic/dpIdentity.c

@@ -0,0 +1,632 @@
+/*  
+ * generic/dpIdentity.c --
+ *
+ * This file contains the implementation of the identity filter channels.
+ * These are channels that are created by evaluating "dp_connect identity".
+ *
+ */
+
+
+#include <string.h>
+#include <errno.h>
+#include <tcl.h>
+#include <generic/dpInt.h>
+
+
+/*
+ * Prototypes for functions referenced only in this file.
+ */
+
+static int	CloseIdChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     Tcl_Interp *interp));
+
+static int      InputIdChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     char *buf, int bufsize,
+                                                     int  *errorCodePtr));
+
+static int      OutputIdChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                      char *buf, int toWrite,
+                                                      int *errorCodePtr));
+
+static int      SOPIdChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     Tcl_Interp *interp,
+                                                     char *optionName,
+                                                     char *optionValue));
+
+#ifdef _TCL76
+static int	GOPIdChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     char *optionName,
+                                                     Tcl_DString *dsPtr)); 
+#else
+static int	GOPIdChannel		_ANSI_ARGS_((ClientData instanceData,
+						     Tcl_Interp *interp,
+                                                     char *optionName,
+                                                     Tcl_DString *dsPtr)); 
+#endif
+
+#ifndef _TCL76
+static int	GFPIdChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int direction,
+                                                     FileHandle *handlePtr));
+#else
+static Tcl_File	GFPIdChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int direction));
+#endif
+
+static int	CRPIdChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int mask));
+
+static void	WCPIdChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     int mask));
+
+/*
+ * This structure stores the names of the functions that Tcl calls when certain
+ * actions have to be performed on an identity channel. To understand this entry,
+ * please refer to the documentation of the Tcl_CreateChannel and its associated
+ * functions in the Tcl 7.6 documentation.
+ *
+ * An identity channel will always be non-blocking.
+ * Seek on an identity channel is not allowed.
+ */
+
+
+Tcl_ChannelType idChannelType = {
+    "idfilter",
+    NULL, 	       /* blockModeProc    */
+    CloseIdChannel,    /* closeProc        */
+    InputIdChannel,    /* inputProc        */
+    OutputIdChannel,   /* outputProc       */
+    NULL,              /* seekProc         */
+    SOPIdChannel,      /* setOptionProc    */
+    GOPIdChannel,      /* getOptionProc    */
+    WCPIdChannel,      /* watchChannelProc */
+#ifdef _TCL76
+    CRPIdChannel,      /* channelReadyProc */
+#endif
+    GFPIdChannel       /* getFileProc      */
+};
+
+
+/*
+ * Structure that stores the data needed to manage an identity filter.
+ */
+
+typedef struct {
+
+    /* Pointer to the subordinated channel. */
+    Tcl_Channel channelPtr;
+
+    /* If peek = 0 consume input, otherwise not. */
+    int         peek;
+}
+    IdentityInfo;
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DpCreateIdChannel --
+ *
+ *	Creates an identity filter channel.
+ *
+ * Results:
+ *
+ *	Returns a channel data structure. If an error happens, NULL 
+ *      is returned.
+ *
+ * Side effects:
+ *
+ *	Alocates memory for the instance data that is associated
+ *	with the channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+Tcl_Channel
+DpCreateIdChannel (interp, argc, argv)
+    Tcl_Interp *interp;		/* (in) Pointer to tcl interpreter. */
+    int         argc;		/* (in) Number of arguments. */
+    char      **argv;           /* (in) Argument strings. */
+{
+    static int    openedChannels = 0;
+    int           i;
+    IdentityInfo *instanceData;
+    Tcl_Channel   newChannel;
+    char          chanName [20];
+        
+    
+    instanceData = (IdentityInfo *)ckalloc(sizeof(IdentityInfo));
+
+    if(instanceData == NULL) {
+        Tcl_AppendResult(interp, "unable to allocate memory for identity ",
+			 "filter channel", NULL);
+        return NULL;
+    }
+
+    instanceData->channelPtr = NULL;
+
+    for (i = 0; i < argc; i += 2) {
+        int v = i+1;
+	size_t len = strlen(argv[i]);
+        
+	if (strncmp(argv[i], "-channel", len)==0) {
+	    if (v == argc) {
+                goto error2;
+            }
+
+            instanceData->channelPtr = Tcl_GetChannel(interp, argv[v], NULL);
+            
+            if(instanceData->channelPtr == NULL) {
+                goto error1;
+            }
+	} else {
+    	    Tcl_AppendResult(interp, "unknown option \"", 
+                             argv[i], "\", must be -channel", NULL);
+	    goto error1;
+	}
+    }
+
+    if(instanceData->channelPtr == NULL) {
+        Tcl_AppendResult(interp, "-channel must be defined for an identity ",
+			 "channel", NULL);
+        goto error1;
+    }
+
+    /* No peek by default. */
+    instanceData->peek = 0;
+
+
+    /* Identity filters are both readable and writable. */
+    sprintf(chanName, "idfilter%d", openedChannels++);
+    newChannel = Tcl_CreateChannel(&idChannelType, chanName, 
+    		(ClientData)instanceData, TCL_READABLE | TCL_WRITABLE);
+    if(newChannel == NULL) {
+        Tcl_AppendResult(interp, "tcl unable to create identity channel", NULL);
+        goto error1;
+    }
+    Tcl_RegisterChannel(interp, newChannel); 
+    
+    return newChannel;
+    
+
+error2:
+    Tcl_AppendResult(interp, "option value missing for -channel", NULL);
+    /* continues with error1 */
+
+error1:
+    ckfree((char *)instanceData);
+    return NULL;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CloseIdChannel --
+ *
+ *	Closes the given identity filter channel.
+ *
+ * Results:
+ *
+ *	If everything goes well, returns 0. If any error happens,
+ *      it returns a POSIX error code.
+ *
+ * Side effects:
+ *
+ *	It frees the instance data associated with the channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+CloseIdChannel (instanceData, interp)
+    ClientData  instanceData;  /* (in) Pointer to IdentityInfo struct. */
+    Tcl_Interp *interp;        /* Pointer to the tcl interpreter. */
+{
+    ckfree((char *)instanceData);
+    return 0;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * InputIdChannel --
+ *
+ *	Reads min(requested data, available data) from the subordinated channel.
+ *
+ * Results:
+ *
+ *	Number of bytes of data read from the subordinated filter. If an error
+ *	happened, it returns -1.
+ *
+ * Side effects:
+ *
+ *	1. Calls the read procedure of the subordinated channel.
+ *	2. Stores a POSIX code at errorBuffer if an error occurs.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+InputIdChannel (instanceData, buf, bufsize, errorCodePtr)
+    ClientData	instanceData;	   /* (in) Pointer to IdentityInfo struct. */
+    char       *buf;		   /* (in/out) Buffer to fill. */
+    int	        bufsize;	   /* (in) Size of buffer. */
+    int	       *errorCodePtr;	   /* (out) POSIX error code (if any). */
+{
+    int tmp;
+    
+    Tcl_Channel channelPtr = ((IdentityInfo *)instanceData)->channelPtr;
+
+    tmp = Tcl_Read(channelPtr, buf, bufsize);
+    
+    if(tmp == -1) {
+        *errorCodePtr = Tcl_GetErrno();
+    }
+    
+    return tmp;
+    
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * OutputIdChannel --
+ *
+ *	Writes the data to the subordinated channel.
+ *
+ * Results:
+ *
+ *	Number of writes written, or -1 if an error is signalled from the 
+ *	subordinated filter.
+ *
+ * Side effects:
+ *
+ *	1. Calls the write procedure of the subordinated channel.
+ *	2. Stores a POSIX code at errorBuffer if an error occurs.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+OutputIdChannel	(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;	/* channel to send the message to */
+    char *buf;			/* output buffer */
+    int   toWrite;		/* number of characters to write */
+    int  *errorCodePtr;		/* place to store the POSIX error code */
+{
+    int tmp;
+    
+    Tcl_Channel channelPtr = ((IdentityInfo *)instanceData)->channelPtr;
+        
+    tmp = Tcl_Write(channelPtr, buf, toWrite);
+    
+    if(tmp == -1) {
+        *errorCodePtr = Tcl_GetErrno();
+    }
+    
+    return tmp;
+    
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GFPIdChannel --
+ *
+ *	"Get file" function for identity channels. Since there are no files
+ *	associated with filters, it always returns NULL.
+ *
+ * Results:
+ *
+ *	Always NULL.
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+#ifndef _TCL76
+static int
+GFPIdChannel (instanceData, direction, handlePtr)
+    ClientData	instanceData;
+    int		direction;
+    FileHandle *handlePtr;
+{
+    *handlePtr = NULL;
+    return TCL_OK;
+}
+#else
+static Tcl_File
+GFPIdChannel (instanceData, direction)
+    ClientData	instanceData;
+    int		direction;
+{
+    return NULL;
+}
+#endif
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SOPIdChannel --
+ *
+ *	"Set option" procedure for identity channels.
+ *
+ * Results:
+ *
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *
+ *	Sets the value of the specified option.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+SOPIdChannel (instanceData, interp, optionName, optionValue)
+    ClientData	 instanceData;	 /* (in) Pointer to IdentityInfo struct. */
+    Tcl_Interp	*interp;	 /* (in) Pointer to tcl interpreter. */
+    char	*optionName;
+    char	*optionValue;
+{
+    int option;
+    int value;
+
+    IdentityInfo data;
+    memcpy((void *)&data, (void *)instanceData, sizeof(IdentityInfo));
+
+    /*
+     * Set the option specified by optionName
+     */
+
+    if (optionName[0] == '-') {
+        option = DpTranslateOption(optionName+1);
+    } else {
+        option = -1;
+    }
+
+    switch(option) {
+
+    case DP_PEEK:
+
+        if (Tcl_GetBoolean(interp, optionValue, &value) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (value == 0) {
+            data.peek = 0;
+	    if (Tcl_SetChannelOption(interp, data.channelPtr, 
+		    "-peek", "no") == TCL_ERROR) {
+                Tcl_AppendResult(interp, ": subordinated channel error in ",
+                                 Tcl_GetChannelName(data.channelPtr), NULL);
+                return TCL_ERROR;
+            }
+        } else {
+	    data.peek = 1;
+	    if (Tcl_SetChannelOption(interp, data.channelPtr, 
+		    "-peek", "yes") == TCL_ERROR) {
+                Tcl_AppendResult(interp, ": subordinated channel error in ",
+                                 Tcl_GetChannelName(data.channelPtr), NULL);
+                return TCL_ERROR;
+            }
+        }
+        break;
+        
+    case DP_CHANNEL:
+
+	Tcl_AppendResult(interp, "can't set channel after identity channel ",
+			 "is opened", NULL);
+	return TCL_ERROR;
+
+    default:
+        Tcl_AppendResult (interp, "illegal option \"", optionName, "\" -- ",
+			  "must be peek, or a standard fconfigure option", NULL);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+
+
+/*
+ *--------------------------------------------------------------------------
+ *
+ * GOPIdChannel --
+ *
+ *	"Get option" function for identity filters.
+ *
+ * Results:
+ *
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *
+ *	Returns the value of a non-standard option. If no option is specified,
+ *	a list of all options, together with their values, is returned.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static int
+GOPIdChannel (instanceData, 
+#ifdef _TCL80
+	    interp,
+#endif
+	    optionName, dsPtr)
+    ClientData instanceData;
+#ifdef _TCL80
+    Tcl_Interp *interp; 
+#endif
+    char	*optionName;
+    Tcl_DString *dsPtr;		/* (out) String to store the result in. */
+{
+    int option;
+    int size;
+
+    /*
+     * If optionName is NULL, then store an alternating list of
+     * all supported options and their current values in dsPtr.
+     */
+
+#ifdef _TCL80
+#define IGO(a, b, c) GOPIdChannel(a, interp, b, c)
+#else
+#define IGO(a, b, c) GOPIdChannel(a, b, c)
+#endif
+    if (optionName == NULL) {
+     	Tcl_DStringAppend (dsPtr, " -channel ", -1);
+	IGO (instanceData, "-channel", dsPtr);
+     	Tcl_DStringAppend (dsPtr, " -peek ", -1);
+	IGO (instanceData, "-peek", dsPtr);
+        return TCL_OK;
+    }
+#undef IGO
+
+    /*
+     * Retrieve the value of the option specified by optionName
+     */
+
+    if (optionName[0] == '-') {
+        option = DpTranslateOption(optionName+1);
+    } else {
+        option = -1;
+    }
+
+    switch (option) {
+
+    case DP_PEEK:
+
+        if (((IdentityInfo *)instanceData)->peek) {
+            Tcl_DStringAppend (dsPtr, "1", -1);
+        } else {
+            Tcl_DStringAppend (dsPtr, "0", -1);
+        }
+        break;
+
+    case DP_CHANNEL:
+
+        Tcl_DStringAppend (dsPtr,
+	    Tcl_GetChannelName(((IdentityInfo *)instanceData)->channelPtr), -1);
+        break;
+
+    default:
+#ifndef _TCL76
+	Tcl_AppendResult(interp, 
+		"bad option \"", optionName,"\": must be -blocking,",
+		" -buffering, -buffersize, -eofchar, -translation,",
+		" or a channel type specific option", NULL);
+#else
+	{
+	    char errStr[128];
+	    sprintf(errStr, "bad option \"%s\": must be -blocking,"
+		    "-buffering, -buffersize, -eofchar, -translation,"
+		    " or a channel type specific option", optionName);
+	    Tcl_DStringAppend(dsPtr, errStr, -1);
+	}
+#endif
+        Tcl_SetErrno (EINVAL);
+        return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * WCPIdChannel --
+ *
+ *	This is the "watch channel" procedure for identity filters. It is
+ *	assumed that no events are generated internally in the filter channel,
+ *	so the procedure only calls the corresponding procedure of the
+ *	subordinated channel.
+ *
+ * Results:
+ *
+ *	None.
+ *
+ * Side effects:
+ *
+ *	Calls the "watch channel" procedure of the subordinated channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static void
+WCPIdChannel (instanceData, mask)
+    ClientData  instanceData;	/* (in) Pointer to PlugFInfo struct. */
+    int         mask;		/* (in) ORed combination of TCL_READABLE,
+                                 * TCL_WRITABLE and TCL_EXCEPTION. It designates
+                                 * the event categories that have to be watched.
+                                 */
+{
+    Tcl_Channel channelPtr = ((IdentityInfo *)instanceData)->channelPtr;
+
+#ifdef _TCL76
+    (Tcl_GetChannelType(channelPtr)->watchChannelProc) 
+                         (Tcl_GetChannelInstanceData(channelPtr), mask);
+#endif
+
+    return;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CRPIdChannel --
+ *
+ *	This is the "channel ready" procedure for identity filters. It is
+ *	assumed that no events are generated internally in the filter channel,
+ *	so the procedure only calls the corresponding procedure of the
+ *	subordinated channel. 
+ *
+ * Results:
+ *
+ *	The value returned by the "channel ready" procedure of the subordinated
+ *	channel.
+ *
+ * Side effects:
+ *
+ *	Calls the "channel ready" procedure of the subordinated channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+CRPIdChannel (instanceData, mask)
+    ClientData  instanceData;	/* (in) Pointer to IdentityInfo struct. */
+    int         mask;		/* (in) ORed combination of TCL_READABLE,
+                                 * TCL_WRITABLE and TCL_EXCEPTION. It designates
+                                 * the event categories whose occurence has to
+                                 * be signalled.
+                                 */
+{
+    Tcl_Channel channelPtr = ((IdentityInfo *)instanceData)->channelPtr;
+
+#ifdef _TCL76
+    return (Tcl_GetChannelType(channelPtr)->channelReadyProc)
+                         (Tcl_GetChannelInstanceData(channelPtr), mask);
+#else
+    return TCL_OK;
+#endif
+}
+
+

tcl-dp/generic/dpInit.c

@@ -0,0 +1,99 @@
+/* 
+ * dpInit.c --
+ *
+ *	Initialize the Tcl-DP extension.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "generic/dpPort.h"
+#include "generic/dpPatch.h"
+#include "generic/dpInt.h"
+
+/*
+ * The following structure defines all of the commands supported by
+ * Dp, and the C procedures that execute them.
+ */
+
+typedef struct {
+    char *name;			/* Name of command. */
+    Tcl_CmdProc *cmdProc;	/* Command procedure. */
+} DpCmd;
+
+static DpCmd commands[] = {
+    {"dp_accept",	Dp_AcceptCmd},
+    {"dp_connect",	Dp_ConnectCmd},
+    {"dp_copy",		Dp_CopyCmd},
+    {"dp_netinfo",	Dp_NetInfoCmd},
+    {"dp_RDO",		Dp_RDOCmd},
+    {"dp_RPC",		Dp_RPCCmd},
+    {"dp_admin",	Dp_AdminCmd},
+    {"dp_CancelRPC",	Dp_CancelRPCCmd},
+    {"dp_send",		Dp_SendCmd},
+    {"dp_recv",		Dp_RecvCmd},
+    {(char *) NULL,	(Tcl_CmdProc *) NULL}
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dp_Init --
+ *
+ *	This procedure is invoked to add DP to an interpreter. It
+ *	incorporates all of DP's commands into the interpreter.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code and sets interp->result
+ *	if there is an error.
+ *
+ * Side effects:
+ *	Depends on various initialization scripts that get invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+EXPORT(int,Dp_Init)(interp)
+    Tcl_Interp *interp;		/* (in) Interpreter to initialize. */
+{
+    DpCmd *cmdPtr;
+
+    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+	return TCL_ERROR;
+    }
+    if (TclHasSockets(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    Tcl_SetVar(interp, "dp_patchLevel", DP_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "dp_version", DP_VERSION, TCL_GLOBAL_ONLY);
+
+    if (Tcl_PkgProvide(interp, "dp", DP_VERSION) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+	Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
+		(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    }
+
+    if (DpInitChannels(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (DppInit(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (DpRPCInit(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (DpInitPlugIn(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+

tcl-dp/generic/dpInt.h

@@ -0,0 +1,248 @@
+/*
+ * generic/dpInt.h --
+ *
+ *	Declarations for things used internally by Dp
+ *	procedures but not exported outside the module.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _DPINT
+#define _DPINT
+
+
+#ifdef SOCKDEBUG
+#define SDBG(a)		printf("0x%X - ", getpid()); printf a
+#else
+#define SDBG(a)
+#endif
+
+
+#ifndef _DP
+#include "dp.h"
+#endif
+#ifndef _TCL
+#include "tcl.h"
+#endif
+#ifndef _DPPORT
+#include "generic/dpPort.h"
+#endif
+
+#ifndef max
+#  define max(a, b)  (((a) > (b)) ? (a) : (b)) 
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ * Constant definitions
+ *----------------------------------------------------------------------
+ */
+
+#define SOCKET_IPM		(1<<31)
+
+/*
+ * The following are used by the various SetSocketOption and
+ * GetSocketOption functions
+ */
+
+/*
+ * UDP/TCP/Generic
+ */
+#define DP_SEND_BUFFER_SIZE	 1
+#define DP_RECV_BUFFER_SIZE	 2
+#define DP_BLOCK		 3
+#define DP_REUSEADDR		 4
+#define DP_PEEK			 6
+#define DP_HOST			 7
+#define DP_PORT			 8
+#define DP_MYPORT		 9
+#define DP_KEEP_ALIVE		10
+#define DP_LINGER		11
+#define DP_REMOTEPORT		12
+#define DP_MYIPADDR		13
+#define DP_REMOTEIPADDR		14
+
+#define DP_GROUP		20
+#define DP_MULTICAST_TTL	21
+#define DP_MULTICAST_LOOP	22
+#define DP_ADD_MEMBERSHIP	23
+#define DP_DROP_MEMBERSHIP	24
+#define DP_BROADCAST		25
+
+/*
+ * Serial port options
+ */
+#define DP_STOPBITS             101
+#define DP_CHARSIZE             102
+#define DP_BAUDRATE             103
+#define DP_PARITY               104
+#define DP_DEVICENAME		105
+
+/*
+ * Email channel
+ */
+#define DP_ADDRESS		205
+#define DP_IDENTIFIER		206
+#define DP_SEQUENCE		207
+
+/*
+ * Identity filter and other filters
+ */
+#define DP_CHANNEL		210
+#define DP_INFILTER		211
+#define DP_OUTFILTER		212
+#define DP_INSET                213
+#define DP_OUTSET               214
+
+#ifndef _TCL80
+typedef Tcl_File FileHandle;
+#endif
+
+#if !defined(_TCL80) || !defined(_WIN32)
+typedef struct SocketInfo {int dummy;} SocketInfo;
+#endif
+/*
+ * A collection of all the data necessary for
+ * all the different types of sockets.  We buy
+ * reusibility at the cost of size.
+ */
+typedef struct SocketState {
+    Tcl_Interp *	interp;
+    DpSocket 		sock;
+    FileHandle		sockFile;
+    Tcl_Channel		channel;
+    Tcl_DString		groupList;	/* IPM */
+    DpSocketAddressIP	sockaddr;	/* UDP/IPM */
+    SocketInfo *	sockInfo;
+    int 		flags;
+    int			myIpAddr;
+    int			myPort;
+    int			recvBufSize;	/* UDP/IPM */
+    int			groupAddr;	/* IPM */
+    int 		groupPort;	/* IPM */
+    int			destIpAddr;	/* TCP */
+    int			destPort;	/* TCP */
+} SocketState;
+
+
+
+typedef struct SerialState {
+    SerialHandle 	fd;
+    FileHandle 		theFile;
+    char 		deviceName[20];
+    Tcl_Channel		channel;
+} SerialState;
+
+/*
+ *----------------------------------------------------------------------
+ * Internal procedures shared among DP modules but not exported
+ * to the outside world:
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * Library routines that aren't part of any particular protocol (or support
+ * multiple protocols)
+ */
+
+EXTERN int              DpTranslateOption _ANSI_ARGS_((char *optionName));
+EXTERN int              DpHostToIpAddr _ANSI_ARGS_((char *hostname,
+				int *ipAddrPtr));
+EXTERN int              DpIpAddrToHost _ANSI_ARGS_((int ipAddr,
+				char *hostPtr));
+
+EXTERN int		DppCloseSocket _ANSI_ARGS_((DpSocket sock));
+EXTERN int		DppSetBlock _ANSI_ARGS_((DpSocket sock, int block));
+EXTERN int		DppGetErrno _ANSI_ARGS_(());
+EXTERN int		DppInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ *----------------------------------------------------------------------
+ * Externally visible procedures that form the C API:
+ *----------------------------------------------------------------------
+ */
+
+EXTERN int		DpInitChannels _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN int		DpInitPlugIn   _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN int		DpRPCInit _ANSI_ARGS_((Tcl_Interp * interp));
+
+EXTERN Tcl_Channel	DpCreateEmailChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN Tcl_Channel	DpCreateIdChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN Tcl_Channel	DpCreatePlugFChannel _ANSI_ARGS_((Tcl_Interp *interp,
+   			    int argc, char **argv));
+EXTERN Tcl_Channel	DpCreatePOChannel _ANSI_ARGS_((Tcl_Interp *interp,
+   			    int argc, char **argv));
+EXTERN Tcl_Channel	DpOpenUdpChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN Tcl_Channel	DpOpenSerialChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN Tcl_Channel	DpOpenIpmChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN Tcl_Channel	DpOpenTcpChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN Tcl_Channel      Dp_TcpAccept _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *channelId));
+
+/*
+ *----------------------------------------------------------------------
+ * Command procedures in the generic core:
+ *----------------------------------------------------------------------
+ */
+
+EXTERN int	Dp_AcceptCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_ConnectCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_CopyCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_FromCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_NetInfoCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_RDOCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_RPCCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_AdminCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int     	Dp_CancelRPCCmd _ANSI_ARGS_((ClientData clientData,
+	            Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_SendCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Dp_RecvCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ * Plug-in filters.
+ */
+
+extern Dp_PlugInFilterProc Identity;
+extern Dp_PlugInFilterProc Plug1to2;
+extern Dp_PlugInFilterProc Plug2to1;
+extern Dp_PlugInFilterProc Xor;
+extern Dp_PlugInFilterProc PackOn;
+extern Dp_PlugInFilterProc Uuencode;
+extern Dp_PlugInFilterProc Uudecode;
+extern Dp_PlugInFilterProc TclFilter;
+extern Dp_PlugInFilterProc HexOut;
+extern Dp_PlugInFilterProc HexIn;
+
+
+/*
+ * Locking functions used in implementing email channels.
+ */
+
+extern int	PutLock	_ANSI_ARGS_((char *lockFilePath));
+extern int	RemoveLock _ANSI_ARGS_((char *lockFilePath));
+
+#endif /* _DPINT */
+
+
+

tcl-dp/generic/dpPackOff.c

@@ -0,0 +1,686 @@
+/*  
+ * generic/dpPackOff.c --
+ *
+ * This file contains the implementation of the packoff channel. This type of
+ * filter identifies packets generated by the packon plugin filter and separates
+ * them from the input stream, returning them separately. Since this operation
+ * makes sense only when reading data, this channel is not writable. 
+ * These are channels that are created by evaluating "dp_connect dpPackOff".
+ *
+ */
+
+
+#include <string.h>
+#include <errno.h>
+#include <tcl.h>
+#include <generic/dpInt.h>
+
+
+/*
+ * Prototypes for functions referenced only in this file.
+ */
+
+static int	ClosePOChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     Tcl_Interp *interp));
+
+static int      InputPOChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     char *buf, int bufsize,
+                                                     int  *errorCodePtr));
+
+static int      OutputPOChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                      char *buf, int toWrite,
+                                                      int *errorCodePtr));
+
+static int      SOPPOChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     Tcl_Interp *interp,
+                                                     char *optionName,
+                                                     char *optionValue));
+
+#ifndef _TCL76
+static int	GOPPOChannel		_ANSI_ARGS_((ClientData instanceData,
+						     Tcl_Interp *interp,
+                                                     char *optionName,
+                                                     Tcl_DString *dsPtr)); 
+#else
+static int	GOPPOChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     char *optionName,
+                                                     Tcl_DString *dsPtr)); 
+#endif
+
+#ifndef _TCL76
+static int	GFPPOChannel		_ANSI_ARGS_((ClientData instanceData, 
+						     int direction, 
+						     FileHandle *handlePtr));
+#else
+static Tcl_File	GFPPOChannel		_ANSI_ARGS_((ClientData instanceData, 
+						     int direction));
+#endif
+
+static int	CRPPOChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int mask));
+
+static void	WCPPOChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     int mask));
+
+
+
+/* memmove does not seem to be available on all systems */
+static void	mymove 		_ANSI_ARGS_((char *to, char *from, int number));
+
+/*
+ * This structure stores the names of the functions that tcl calls when certain
+ * actions have to be performed on a packoff channel. To understand this entry,
+ * please refer to the documentation of the Tcl_CreateChannel and its associated
+ * functions in the tcl 7.6 documentation.
+ *
+ * A packoff channel will always be non-blocking, and non-writable.
+ * Seek on a packoff channel is not allowed.
+ */
+
+
+Tcl_ChannelType poChannelType = {
+    "packoff",
+    NULL, 	       /* blockModeProc    */
+    ClosePOChannel,    /* closeProc        */
+    InputPOChannel,    /* inputProc        */
+    OutputPOChannel,   /* outputProc       */
+    NULL,              /* seekProc         */
+    SOPPOChannel,      /* setOptionProc    */
+    GOPPOChannel,      /* getOptionProc    */
+    WCPPOChannel,      /* watchChannelProc */
+#ifdef _TCL76
+    CRPPOChannel,      /* channelReadyProc */
+#endif
+    GFPPOChannel       /* getFileProc      */
+};
+
+
+/*
+ * Structure that stores the data needed to manage a packoff filter.
+ */
+
+typedef struct {
+    /* Pointer to the subordinated channel. */
+    Tcl_Channel channelPtr;
+
+    /* If peek = 0 consume input, otherwise not. */
+    int   peek;
+
+    /* The variables below are used in managing the input. Please refer to the
+     * input function to understand their meaning.
+     */
+
+    char *buffer;
+    int   bufLength;
+    int   used;
+    int   dataLength;
+    int   precRead;
+    int   ignoreNextRead;
+
+} PackOffInfo;
+
+
+/* Arbitrary value, it should not be less then the tcl's buffer size. */
+
+#define BUFFER_CHUNK 8 * 1024
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DpCreatePOChannel --
+ *
+ *	Creates a packoff filter channel.
+ *
+ * Results:
+ *
+ *	Returns a channel data structure. If an error happens, NULL 
+ *      is returned.
+ *
+ * Side effects:
+ *
+ *	Alocates memory for the instance data that is associated
+ *	with the channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+Tcl_Channel
+DpCreatePOChannel (interp, argc, argv)
+    Tcl_Interp *interp;		/* (in) Pointer to tcl interpreter. */
+    int         argc;		/* (in) Number of arguments. */
+    char      **argv;           /* (in) Argument strings. */
+{
+    static int    openedChannels = 0;
+    int           i;
+    PackOffInfo  *instanceData;
+    Tcl_Channel   newChannel;
+    char          chanName [20];
+        
+    
+    instanceData = (PackOffInfo *)ckalloc(sizeof(PackOffInfo));
+
+    if(instanceData == NULL) {
+        Tcl_AppendResult(interp, "unable to allocate memory for packoff ",
+			 "filter channel", NULL);
+        return NULL;
+    }
+
+    instanceData->channelPtr = NULL;
+
+    for (i = 0; i < argc; i += 2) {
+        int v = i+1;
+	size_t len = strlen(argv[i]);
+        
+	if (strncmp(argv[i], "-channel", len)==0) {
+	    if (v == argc) {
+                goto error2;
+            }
+
+            instanceData->channelPtr = Tcl_GetChannel(interp, argv[v], NULL);
+            
+            if(instanceData->channelPtr == NULL) {
+                goto error1;
+            }
+	} else {
+    	    Tcl_AppendResult(interp, "unknown option \"", 
+                             argv[i], "\", must be -channel", NULL);
+	    goto error1;
+	}
+    }
+
+    if(instanceData->channelPtr == NULL) {
+        Tcl_AppendResult(interp, "-channel must be defined for a packoff ",
+			 "channel", NULL);
+        goto error1;
+    }
+
+    /* No peek by default. */
+    instanceData->peek = 0;
+
+    /* Variables related to buffer management (see input function). */
+
+    instanceData->buffer     = (char *)ckalloc(BUFFER_CHUNK);
+
+    if(instanceData->buffer == NULL) {
+        Tcl_AppendResult(interp, "unable to allocate memory for packoff ",
+                         "filter channel buffer", NULL);
+        goto error1;
+    }
+
+    instanceData->used       = 0;
+    instanceData->bufLength  = BUFFER_CHUNK;
+    instanceData->dataLength = 0;
+    instanceData->ignoreNextRead = 0;
+
+    /* Packoff filters are only readable. */
+    sprintf(chanName, "pofilter%d", openedChannels++);
+    newChannel = Tcl_CreateChannel(&poChannelType, chanName,
+	    (ClientData)instanceData, TCL_READABLE);
+
+    if(newChannel == NULL) {
+        Tcl_AppendResult(interp, "tcl unable to create packoff channel", NULL);
+        goto error1;
+    }
+    Tcl_RegisterChannel(interp, newChannel); 
+    
+    return newChannel;
+    
+
+error2:
+    Tcl_AppendResult(interp, "option value missing for -channel", NULL);
+    /* continues with error1 */
+
+error1:
+    ckfree((char *)instanceData);
+    return NULL;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ClosePOChannel --
+ *
+ *	Closes the given packoff filter channel.
+ *
+ * Results:
+ *
+ *	If everything goes well, returns 0. If any error happens,
+ *      it returns a POSIX error code.
+ *
+ * Side effects:
+ *
+ *	It frees the instance data associated with the channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+ClosePOChannel (instanceData, interp)
+    ClientData  instanceData;  /* (in) Pointer to PackOffInfo struct. */
+    Tcl_Interp *interp;        /* Pointer to the tcl interpreter. */
+{
+    PackOffInfo *pd = (PackOffInfo *) instanceData;
+    ckfree((char *)pd->buffer);
+    ckfree((char *)instanceData);
+    return 0;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * InputPOChannel --
+ *
+ *	Reads in a stream of data that was generated using the packon plugin
+ *	filter (or a similar algorithm), and separates the packets, returning them
+ *	separately to the tcl level.
+ *
+ * Results:
+ *
+ *	Number of bytes read if no error happened, -1 otherwise.
+ *
+ * Side effects:
+ *
+ *	1. Calls the read procedure of the subordinated channel.
+ *	2. Stores a POSIX code at errorBuffer if an error occurs.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+InputPOChannel (instanceData, buf, bufsize, errorCodePtr)
+    ClientData	instanceData;	   /* (in) Pointer to PackOffInfo struct. */
+    char       *buf;		   /* (in/out) Buffer to fill. */
+    int	        bufsize;	   /* (in) Size of buffer. */
+    int	       *errorCodePtr;	   /* (out) POSIX error code (if any). */
+{
+
+    PackOffInfo *pD = (PackOffInfo *)instanceData;
+
+    char      temp [7], inBufX [BUFFER_CHUNK];
+    int       messLength, inLength;
+
+    char *inBuf = inBufX;
+
+    inLength = Tcl_Read(pD->channelPtr, inBuf, BUFFER_CHUNK);
+
+    if (inLength == -1) {
+        *errorCodePtr = Tcl_GetErrno();
+        return -1;
+    }
+      
+    /* Do we have at least a message header in the buffer? */
+
+    if (pD->dataLength - pD->used < 6) {
+
+	/* No. Can we make up a header using the input? */
+
+	int available = pD->dataLength - pD->used;
+
+	if (inLength >= 6 - available) {
+
+            /* Yes. Transfer rest of header and adjust local structures. */
+
+            mymove(pD->buffer, pD->buffer + pD->used, 6 - available);
+            mymove(pD->buffer + available, inBuf, 6 - available);
+
+            pD->dataLength = 6;
+            pD->used = 0;
+
+            inBuf += 6 - available;
+            inLength -= 6 - available;
+
+	} else {
+
+            /* No. Transfer input and return. */
+
+            mymove(pD->buffer, pD->buffer + pD->used, inLength);
+            pD->dataLength += inLength;
+            pD->used = 0;
+
+            *errorCodePtr = EAGAIN;
+            return 0;
+	}
+
+    }
+
+    /* See how many bytes we need for the next message. */
+	
+    memcpy(temp, pD->buffer + pD->used, 6);
+    temp[6] = '\0';
+      
+    if((messLength = atoi(temp)) <= 0) {
+        return -1;
+    }
+      
+    /* Do not allow packet sizes that are bigger than what the size of buf is.
+     * This is because we want a packet to be returned as a unit.
+     */
+
+    if(messLength > bufsize) {
+        *errorCodePtr = EINVAL;
+        return -1;
+    }
+
+    /* Do we have enough data in the buffer? */
+      
+    if(pD->dataLength - pD->used >= 6 + messLength) {
+	
+	/* Yes. Output data and adjust local structures. */
+	
+	memcpy(buf, pD->buffer + pD->used + 6, messLength);
+	pD->used += 6 + messLength;
+        pD->ignoreNextRead = 1;
+
+    } else if(pD->dataLength - pD->used + inLength >= 6 + messLength) {
+	
+	/* Do we have enough data in buffer and inBuf together? */
+	
+	int useful = pD->dataLength - pD->used - 6;
+	
+	memcpy(buf, pD->buffer + pD->used + 6, useful);
+	memcpy(buf +  useful, inBuf, messLength - useful);
+	  
+	pD->used = pD->dataLength = 0;
+	  
+	inBuf += messLength - useful;
+	inLength -= messLength - useful;
+
+        pD->ignoreNextRead = 1;
+
+    } else {
+
+        messLength = 0;
+    }
+
+    /* Is there enough space to hold the data? */
+      
+    if(pD->bufLength - (pD->dataLength - pD->used) >= inLength) {
+	
+	/* If yes, just put everything in place. */
+	
+	if(pD->dataLength - pD->used > 0) {
+            mymove(pD->buffer, pD->buffer + pD->used, pD->dataLength - pD->used);
+	}
+	
+	mymove(pD->buffer + pD->dataLength - pD->used, inBuf, inLength); 
+	
+	pD->dataLength = pD->dataLength - pD->used + inLength;
+	pD->used = 0;
+	
+    } else {
+	
+	/* If no, create a bigger buffer. */
+	
+	int   neededSpace = inLength - (pD->bufLength - (pD->dataLength - pD->used));
+	
+	char *temp = ckalloc(pD->bufLength + neededSpace + BUFFER_CHUNK);
+	
+	if(temp == NULL) {
+            return ENOMEM;
+	}
+	
+	memcpy(temp, pD->buffer + pD->used, pD->dataLength - pD->used);
+        memcpy(temp + pD->dataLength - pD->used, inBuf, inLength);
+          
+        pD->dataLength = pD->dataLength - pD->used + inLength;
+        pD->bufLength = pD->bufLength + neededSpace + BUFFER_CHUNK;
+        pD->used = 0;
+          
+        ckfree(pD->buffer);
+        pD->buffer = temp;
+
+    }
+
+    return messLength;
+    
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * OutputPOChannel --
+ *
+ *	A packoff channel is not writable.
+ *
+ * Results:
+ *
+ *	Error code EINVAL.
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ * ----------------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+static int
+OutputPOChannel	(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;	/* channel to send the message to */
+    char *buf;			/* output buffer */
+    int   toWrite;		/* number of characters to write */
+    int  *errorCodePtr;		/* place to store the POSIX error code */
+{
+    return -1;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GFPPOChannel --
+ *
+ *	"Get file" function for packoff channels. Since there are no files
+ *	associated with filters, it always returns NULL.
+ *
+ * Results:
+ *
+ *	TCL_OK
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ * ----------------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+#ifndef _TCL76
+static int
+GFPPOChannel (instanceData, direction, handlePtr)
+    ClientData	instanceData;
+    int		direction;
+    FileHandle *handlePtr;
+{
+    *handlePtr = NULL;
+    return TCL_OK;
+}
+#else
+static Tcl_File
+GFPPOChannel (instanceData, direction)
+    ClientData	instanceData;
+    int		direction;
+{
+    return NULL;
+}
+#endif
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SOPPOChannel --
+ *
+ *	There is no non-standard option allowed for packoff filters.
+ *
+ * Results:
+ *
+ *	Tcl error code.
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ * ----------------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+static int
+SOPPOChannel (instanceData, interp, optionName, optionValue)
+    ClientData	 instanceData;	 /* (in) Pointer to PackOffInfo struct. */
+    Tcl_Interp	*interp;	 /* (in) Pointer to tcl interpreter. */
+    char	*optionName;
+    char	*optionValue;
+{
+    Tcl_AppendResult (interp, "illegal option \"", optionName, "\" -- ",
+                      "must be a standard fconfigure option", NULL);
+    return TCL_ERROR;
+
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GOPPOChannel --
+ *
+ *	There are no non-standard options for a packoff channel.
+ *
+ * Results:
+ *
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+GOPPOChannel (instanceData, 
+#ifdef _TCL80
+		interp,
+#endif
+		optionName, dsPtr)
+    ClientData instanceData;
+#ifdef _TCL80
+    Tcl_Interp *interp; 
+#endif
+    char	*optionName;
+    Tcl_DString *dsPtr;		/* (out) String to store the result in. */
+{
+    if (optionName != NULL) {
+        Tcl_SetErrno(EINVAL);
+        return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * WCPPOChannel --
+ *
+ *	This is the "watch channel" procedure for packoff filters. It is
+ *	assumed that no events are generated internally in the filter channel,
+ *	so the procedure only calls the corresponding procedure of the
+ *	subordinated channel.
+ *
+ * Results:
+ *
+ *	None.
+ *
+ * Side effects:
+ *
+ *	Calls the "watch channel" procedure of the subordinated channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static void
+WCPPOChannel (instanceData, mask)
+    ClientData  instanceData;	/* (in) Pointer to PlugFInfo struct. */
+    int         mask;		/* (in) ORed combination of TCL_READABLE,
+                                 * TCL_WRITABLE and TCL_EXCEPTION. It designates
+                                 * the event categories that have to be watched.
+                                 */
+{
+    Tcl_Channel channelPtr = ((PackOffInfo *)instanceData)->channelPtr;
+
+#ifdef _TCL76
+    (Tcl_GetChannelType(channelPtr)->watchChannelProc) 
+                         (Tcl_GetChannelInstanceData(channelPtr), mask);
+#endif
+
+    return;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CRPPOChannel --
+ *
+ *	This is the "channel ready" procedure for packoff filters. It is
+ *	assumed that no events are generated internally in the filter channel,
+ *	so the procedure only calls the corresponding procedure of the
+ *	subordinated channel. 
+ *
+ * Results:
+ *
+ *	The value returned by the "channel ready" procedure of the subordinated
+ *	channel.
+ *
+ * Side effects:
+ *
+ *	Calls the "channel ready" procedure of the subordinated channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+static int
+CRPPOChannel (instanceData, mask)
+    ClientData  instanceData;	/* (in) Pointer to PackOffInfo struct. */
+    int         mask;		/* (in) ORed combination of TCL_READABLE,
+                                 * TCL_WRITABLE and TCL_EXCEPTION. It designates
+                                 * the event categories whose occurence has to
+                                 * be signalled.
+                                 */
+{
+    Tcl_Channel channelPtr = ((PackOffInfo *)instanceData)->channelPtr;
+
+#ifdef _TCL76
+    return (Tcl_GetChannelType(channelPtr)->channelReadyProc)
+                         (Tcl_GetChannelInstanceData(channelPtr), mask);
+#else
+    return TCL_OK;
+#endif
+}
+
+
+/* memmove does not seem to be available on all systems */
+static void
+mymove (to, from, number)
+     char *to;
+     char *from;
+     int   number;
+{
+
+  for(/* empty */; number--; *to++ = *from++);
+
+}
+
+
+

tcl-dp/generic/dpPatch.h

@@ -0,0 +1,31 @@
+/*
+ * dpPatch.h --
+ *
+ *	This file does nothing except define a "patch level" for DP.
+ *	The patch level has the form "X.YpZ" where X.Y is the base
+ *	release, and Z is a serial number that is used to sequence
+ *	patches for a given release.  Thus 4.0p1 is the first patch to
+ *	release 4.0, 4.0p2 is the patch that follows 4.0p1, and so on.
+ *	The "pZ" is omitted in an original new release, and it is
+ *	replaced with "bZ" for beta releases or "aZ" for alpha
+ *	releases (e.g. 4.0b1 is the first beta release of Tk 4.0).
+ *	The patch level ensures that patches are applied in the
+ *	correct order and only to appropriate sources.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _DPPATCH
+
+#define DP_PATCH_LEVEL "4.0"
+
+#endif
+
+
+
+
+

tcl-dp/generic/dpPlugF.c

@@ -0,0 +1,987 @@
+/*  
+ * generic/dpPlugF.c --
+ *
+ * This file contains the implementation of the plug-in filter (PIF)
+ * channel. These are channels that are created by evaluating 
+ * "dp_connect filter".
+ */
+
+/*
+ * Major unsolved problems:
+ *
+ * 1. Should the PIF channel set the nonblocking option for the subordinated
+ * channel?
+ */
+
+#include <generic/dpInt.h>
+
+#define DP_ARBITRARY_LIMIT 500
+
+typedef struct {
+    char *outBuf;
+    int   outLength;
+    int   outUsed;
+    int   eof;
+} FiltBuffer;
+
+typedef struct {
+    Tcl_Channel channelPtr;
+    int         peek;
+    FiltBuffer  i;
+    Tcl_Interp *interp;
+    Dp_PlugInFilterProc *inFilter;
+    Dp_PlugInFilterProc *outFilter;
+    void       *inData;
+    void       *outData;
+} PlugFInfo;
+
+
+/*
+ * Prototypes for functions referenced only in this file.
+ */
+
+static int	ClosePlugFChannel	_ANSI_ARGS_((ClientData instanceData,
+                                                     Tcl_Interp *interp));
+
+static int      InputPlugFChannel	_ANSI_ARGS_((ClientData instanceData,
+                                                     char *buf, int bufsize,
+                                                     int  *errorCodePtr));
+
+static int      OutputPlugFChannel	_ANSI_ARGS_((ClientData instanceData,
+                                                      char *buf, int toWrite,
+                                                      int *errorCodePtr));
+
+static int      SOPPlugFChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     Tcl_Interp *interp,
+                                                     char *optionName,
+                                                     char *optionValue));
+
+#ifdef _TCL76
+static int	GOPPlugFChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     char *optionName,
+                                                     Tcl_DString *dsPtr)); 
+#else
+static int	GOPPlugFChannel		_ANSI_ARGS_((ClientData instanceData,
+						     Tcl_Interp *interp,
+                                                     char *optionName,
+                                                     Tcl_DString *dsPtr)); 
+#endif
+
+#ifndef _TCL76
+static int	GFPPlugFChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int direction,
+                                                     FileHandle *handlePtr));
+#else
+static Tcl_File	GFPPlugFChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int direction));
+#endif
+
+static int	CRPPlugFChannel		_ANSI_ARGS_((ClientData instanceData, 
+                                                     int mask));
+
+static void	WCPPlugFChannel		_ANSI_ARGS_((ClientData instanceData,
+                                                     int mask));
+
+
+/*
+ * This structure stores the names of the functions that Tcl calls when certain
+ * actions have to be performed on a PIF channel. To understand this entry,
+ * please refer to the documentation of the Tcl_CreateChannel and its associated
+ * functions in the Tcl 7.6 documentation.
+ *
+ * A PIF channel will always be non-blocking.
+ * Seek on a PIF channel is not allowed.
+ */
+
+Tcl_ChannelType plugFChannelType = {
+    "plugfilter",
+    NULL, 	          /* blockModeProc    */
+    ClosePlugFChannel,    /* closeProc        */
+    InputPlugFChannel,    /* inputProc        */
+    OutputPlugFChannel,   /* outputProc       */
+    NULL,                 /* seekProc         */
+    SOPPlugFChannel,      /* setOptionProc    */
+    GOPPlugFChannel,      /* getOptionProc    */
+    WCPPlugFChannel,      /* watchChannelProc */
+#ifdef _TCL76
+    CRPPlugFChannel,      /* channelReadyProc */
+#endif
+    GFPPlugFChannel       /* getFileProc      */
+};
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DpCreatePlugFChannel --
+ *
+ *	Creates a PIF channel.
+ *
+ * Results:
+ *
+ *	Returns a channel data structure. If an error happens, NULL 
+ *      is returned.
+ *
+ * Side effects:
+ *
+ *	Alocates memory for the instance data that is associated
+ *	with the channel.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+Tcl_Channel
+DpCreatePlugFChannel (interp, argc, argv)
+    Tcl_Interp *interp;		/* (in) Pointer to tcl interpreter. */
+    int         argc;		/* (in) Number of arguments. */
+    char      **argv;           /* (in) Argument strings. */
+{
+    static int    openedChannels = 0;
+    int           i;
+    PlugFInfo    *instanceData;
+    Tcl_Channel   newChannel;
+    char          chanName [20];
+        
+    
+    instanceData = (PlugFInfo *)ckalloc(sizeof(PlugFInfo));
+
+    if (instanceData == NULL) {
+        Tcl_SetErrno(ENOMEM);
+        Tcl_AppendResult(interp, "unable to allocate memory for plug-in filter ",
+		"channel", NULL);
+        return NULL;
+    }
+
+    /* Install the default identity filters. */
+
+    instanceData->channelPtr = NULL;
+    instanceData->inFilter   = Dp_GetFilterPtr (interp, "identity");
+
+    if (instanceData->inFilter == NULL) {
+        Tcl_AppendResult(interp, "unable to find identity plug-in filter",
+		 NULL); 
+        return NULL;
+    }
+
+    instanceData->outFilter = Dp_GetFilterPtr (interp, "identity");
+
+    if (instanceData->outFilter == NULL) {
+        Tcl_AppendResult(interp, "unable to find identity plug-in filter",
+		 NULL); 
+        return NULL;
+    }
+
+    /* Identify the given options and take appropriate actions. */
+
+    for (i = 0; i < argc; i += 2) {
+        int v = i+1;
+	size_t len = strlen(argv[i]);
+        
+	if (strncmp(argv[i], "-channel", len)==0) {
+	    if (v == argc) {goto error2;}
+
+            instanceData->channelPtr = Tcl_GetChannel(interp, argv[v], NULL);
+            if (instanceData->channelPtr == NULL) {
+                goto error1;
+            }
+        } else if (strncmp(argv[i], "-infilter", len)==0) {
+	    if (v == argc) {goto error2;}
+
+            instanceData->inFilter =  Dp_GetFilterPtr (interp, argv[v]);
+            if (instanceData->inFilter == NULL) {
+                Tcl_AppendResult(interp, "unable to find plug-in filter ",
+			argv[v], NULL);
+                goto error1;
+            }
+        } else if (strncmp(argv[i], "-outfilter", len)==0) {
+	    if (v == argc) {goto error2;}
+
+            instanceData->outFilter =  Dp_GetFilterPtr (interp, argv[v]);
+            if (instanceData->outFilter == NULL) {
+                Tcl_AppendResult(interp, "unable to find plug-in filter ",
+			argv[v], NULL);
+                goto error1;
+            }
+	} else {
+    	    Tcl_AppendResult(interp, "unknown option \"", 
+		    argv[i], "\", must be -channel", NULL);
+	    goto error1;
+	}
+    }
+
+    if(instanceData->channelPtr == NULL) {
+        Tcl_AppendResult(interp, "-channel must be defined for a plug-in",
+		" channel", NULL);
+        goto error1;
+    }
+
+    /* No peek by default. */
+    instanceData->peek = 0;
+
+    /* 
+     * A PIF channel is always both writable and readable. The real behavior
+     * depends on the properties of the subordinated channel. 
+     */
+
+    sprintf(chanName, "plugfilter%d", openedChannels++);
+    newChannel = Tcl_CreateChannel(&plugFChannelType, chanName, 
+    		(ClientData)instanceData, TCL_READABLE | TCL_WRITABLE);
+    if (newChannel == NULL) {
+        Tcl_AppendResult(interp, "Unable to create plug-in channel", NULL);
+        goto error1;
+    }
+    Tcl_RegisterChannel(interp, newChannel); 
+
+    /* 
+     * Initialize the data related to buffering. Notice the asymmetry 
+     * between the handling of input and output buffers.
+     */
+
+    instanceData->i.outBuf      = NULL;
+    instanceData->i.outLength   = 0;
+    instanceData->i.outUsed     = 0;
+    instanceData->i.eof         = 0;
+
+    instanceData->interp        = interp;
+
+    instanceData->inData        = NULL;
+    instanceData->outData       = NULL;
+
+    return newChannel;
+
+error2:
+    Tcl_AppendResult(interp, "option value missing for -channel", NULL);
+    /* continues with error1 */
+
+error1:
+    ckfree((char *)instanceData);
+    return NULL;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ClosePlugFChannel --
+ *
+ *	Closes the given PIF channel.
+ *
+ * Results:
+ *
+ *	If everything goes well, returns 0. If any error happens,
+ *      it returns a POSIX error code.
+ *
+ * Side effects:
+ *
+ *	1. It calls the plug-in filters indicating that there
+ *	they should release all the memory they allocated and should 
+ *	return the data they might still buffer internally.
+ *	2. It writes the data that it returned by the output filter on the
+ *	subordinated channel.
+ *	3. It frees all the internal channel buffers.
+ *	4. It frees the instance data associated with the channel.
+ * 
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ClosePlugFChannel (instanceData, interp)
+    ClientData  instanceData;  /* (in) Pointer to PlugFInfo struct. */
+    Tcl_Interp *interp;        /* (in) Pointer to tcl interpreter. */
+{
+    char *outBuf;
+    int   outLength, error, status, tmp;
+
+    PlugFInfo *data = (PlugFInfo *)instanceData;
+
+    status = 0;
+
+    if (data->i.outBuf != NULL) {
+        ckfree(data->i.outBuf);
+        /* 
+         * If close fails, and is repeated later, this will prevent
+         * freeing the buffer again.
+         */
+        data->i.outBuf = NULL;
+    }
+
+    /* 
+     * In case the data was incomplete, and the filter was waiting for
+     * more data, this will signal that now it is the last chance to
+     * write to the subordinated channel. Also, all memory allocated
+     * by the filter should be released now.
+     */
+
+    error = (data->outFilter) (NULL, 0, &outBuf, &outLength, 
+                               &(data->outData), data->interp, DP_FILTER_CLOSE);
+    Tcl_SetErrno(error);
+
+    if (error != 0) {
+        Tcl_SetErrno(error);
+
+        /*
+         * Do not free instance data - the user might take some corrective
+         * action based on the POSIX error code, could even write to the
+         * channel, and then attept to close it again.
+         */
+
+        return -1;
+    }
+
+    if (outLength > 0) {
+        tmp = Tcl_Write(data->channelPtr, outBuf, outLength);
+        
+        if (tmp == -1) {
+            status = -1;
+        } else if (tmp != outLength) {
+            /* 
+             * We could not write everything to the subordinated channel.
+             * Try again, if it fails, report the error.
+             */
+            int tmp1;
+
+            tmp1 = Tcl_Write(data->channelPtr, outBuf + tmp, outLength - tmp);
+            if (tmp1 != (outLength - tmp)) {
+                Tcl_SetErrno(ENOSPC);
+                status = -1;
+            }
+        }
+	ckfree(outBuf);
+    }
+
+    /* If the channel is closed, nobody is interested in reading from 
+     * it anymore. Signall to the filter and ignore the output.
+     */
+
+    error = (data->inFilter) (NULL, 0, &outBuf, &outLength,
+                               &(data->inData), data->interp, DP_FILTER_CLOSE);
+    Tcl_SetErrno(error);
+
+    if (error != 0) {
+        Tcl_SetErrno(error);
+
+        /*
+         * Do not free instance data - the user might take some corrective
+         * action based on the POSIX error code, could even write to the
+         * channel, and then attept to close it again.
+         */
+
+        return -1;
+    }
+
+    if (outLength > 0) {
+        ckfree(outBuf);
+    }
+
+    if (instanceData != NULL) {
+        ckfree((char *)instanceData);
+    }
+
+    return status;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * InputPlugFChannel --
+ *
+ *	Reads data from the subordinated channel and feeds it into the input
+ *	filter. It continues until the filter outputs at least as much data
+ *	as it was requested, or until there is no more data to be read from
+ *	the subordinated channel.
+ *
+ * Results:
+ *
+ *	Number of bytes output by the filter, which is at most the amount
+ *	requested. If the filter returns more bytes that requested, the
+ *	difference is buffered internally. If an error happened, the return
+ *	is -1.
+ *
+ * Side effects:
+ *
+ *	1. Calls the read procedure of the subordinated channel.
+ *	2. Modifies the buffers associated with the input filter.
+ *	3. Stores a POSIX code at errorBuffer if an error occurs.
+ *	4. The data that is returned is stored in buf.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+InputPlugFChannel (instanceData, buf, bufsize, errorCodePtr)
+    ClientData	instanceData;     /* (in) Pointer to PlugFInfo struct. */
+    char       *buf;		  /* (in/out) Buffer to fill. */
+    int	        bufsize;	  /* (in) Size of buffer. */
+    int	       *errorCodePtr;	  /* (out) POSIX error code (if any). */
+{
+    int transferred, count, inUsed, inBufLength;
+    char inBuf [20 * DP_ARBITRARY_LIMIT];
+    FiltBuffer *x;
+
+    PlugFInfo *data = (PlugFInfo *)instanceData;
+
+    inBufLength    = sizeof(inBuf);
+    x              = &(data->i);
+    inUsed         = 0;
+    
+    transferred = 0;
+    count = 0;
+
+    while (transferred < bufsize) {
+        if (x->outLength > 0) {
+            if (bufsize - transferred < x->outLength - x->outUsed) {
+                memcpy(buf + transferred, x->outBuf + x->outUsed,
+		       bufsize - transferred);
+                x->outUsed += (bufsize  - transferred);
+                transferred += (bufsize  - transferred);
+            } else {
+                memcpy(buf + transferred, x->outBuf + x->outUsed,
+		       x->outLength - x->outUsed);
+                transferred += (x->outLength - x->outUsed);
+                x->outUsed = x->outLength;
+            }
+
+            if (x->outUsed == x->outLength) {
+                x->outLength = 0;
+                x->outUsed = 0;
+                if (x->outBuf != NULL) {
+                    ckfree(x->outBuf);
+		}
+                x->outBuf = NULL;
+            }
+        } else { /* outLength == 0 */
+            /* Try to get some output from the filter. */
+
+            int error;
+
+            if(!(x->eof)) {
+                error = (data->inFilter) (inBuf, inUsed, &(x->outBuf),
+                                          &(x->outLength), &(data->inData),
+                                          data->interp, DP_FILTER_NORMAL);
+            } else {
+                error = (data->inFilter) (inBuf, inUsed, &(x->outBuf),
+                                          &(x->outLength), &(data->inData),
+                                          data->interp, DP_FILTER_EOF);
+            }
+
+	    inUsed = 0;
+
+            if (error != 0) {
+                *errorCodePtr = error;
+                return -1;
+            }
+                
+            if(x->outLength == 0) {
+                /* 
+                 * We got no data from the filter. Try to read something from
+                 * the subordinated channel, and pipe it later in the filter.
+                 */
+
+                int newData;
+
+                if(!(x->eof)) {
+                    newData = Tcl_Read(data->channelPtr, inBuf, inBufLength);
+                } else {
+                    newData = 0;
+                }
+
+                if (newData == -1) {
+                    *errorCodePtr = Tcl_GetErrno();
+                    return -1;
+                } else if (newData == 0) {
+
+                    /* No data available in the subordinated channel. */
+
+                    /* Did the underlying channel reach eof? */
+                    if(!(x->eof)) {
+                        if(Tcl_Eof(data->channelPtr)) {
+                            x->eof = 1;
+                        }
+                    }
+
+                    count++;
+                    if ((count == 2) || (x->eof == 1)) {
+                        return transferred;
+                    }
+                } else {
+                    count = 0;
+                }
+		inUsed = newData;
+            }
+        }
+    }
+    
+    return transferred;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * OutputPlugFChannel --
+ *
+ *	Feeds the data through the output filter. If the filter produces any
+ *	output it writes it to the subordinated channel. If the filter
+ *	can not process the data completely, the difference is buffered
+ *	internally. 
+ *
+ * Results:
+ *
+ *	Number of bytes "written" (fed into the filter), or -1 if an error
+ *	is signalled. If there is no error, the returned value always coincides
+ *	with the request amount.
+ *
+ * Side effects:
+ *
+ *	1. Calls the write procedure of the subordinated channel.
+ *	2. Modifies the buffers associated with the output filter.
+ *	3. Stores a POSIX code at errorBuffer if an error occurs.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+OutputPlugFChannel	(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;	/* (in) Pointer to PlugFInfo struct. */
+    char *buf;			/* (in) Buffer to write. */
+    int   toWrite;		/* (in) Number of bytes to write. */
+    int  *errorCodePtr;		/* (out) POSIX error code (if any). */
+{
+    int   tmp, error, outLength, mode;
+    char *outBuf = NULL;
+    Tcl_DString option;
+
+    char *cx;
+
+    PlugFInfo *data = (PlugFInfo *)instanceData;
+
+    Tcl_DStringInit(&option);
+    Tcl_GetChannelOption(
+#ifdef _TCL80
+			data->interp,
+#endif
+			data->channelPtr, "-buffering", &option);
+    cx = Tcl_DStringValue(&option);
+
+    if (strcmp(cx, "none")) {
+        /* Buffering is "line" or "full". */
+        mode = DP_FILTER_FLUSH;
+    } else {
+        /* Buffering is "none". */
+        mode = DP_FILTER_NORMAL;
+    }
+    Tcl_DStringFree(&option);
+
+    error = (data->outFilter) (buf, toWrite, &outBuf, &outLength,
+                               &(data->outData), data->interp, mode);
+
+    if (error != 0) {
+        *errorCodePtr = error;
+        goto error1;
+    }
+
+    if (outLength > 0) {
+        tmp = Tcl_Write(data->channelPtr, outBuf, outLength);
+       
+        if (tmp == -1) {
+            *errorCodePtr = Tcl_GetErrno();
+            goto error1;
+        } else if (tmp != outLength) {
+            /* 
+             * We could not write everything to the subordinated channel.
+             * Try again, if it fails, report the error.
+             */
+            int tmp1;
+
+            tmp1 = Tcl_Write(data->channelPtr, outBuf + tmp, outLength - tmp);
+
+            if (tmp1 != outLength - tmp) {
+                *errorCodePtr = ENOSPC;
+                goto error1;
+            }
+        }
+    }
+        
+    if (outBuf != NULL) {
+        ckfree(outBuf);
+    }
+    return toWrite;
+
+error1:
+    if (outBuf != NULL) {
+        ckfree(outBuf);
+    }
+    return -1;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GFPPlugFChannel --
+ *
+ *	"Get file" function for PIF channels. Since there are no files
+ *	associated with filters, it always returns NULL.
+ *
+ * Results:
+ *
+ *	Always NULL.
+ *
+ * Side effects:
+ *
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+#ifndef _TCL76
+static int
+GFPPlugFChannel (instanceData, direction, handlePtr)
+    ClientData	instanceData;
+    int		direction;
+    FileHandle *handlePtr;
+{
+    *handlePtr = NULL;
+    return TCL_OK;
+}
+#else
+static Tcl_File
+GFPPlugFChannel (instanceData, direction)
+    ClientData	instanceData;
+    int		direction;
+{
+    return NULL;
+}
+#endif
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SOPPlugFChannel --
+ *
+ *	"Set option" procedure for PIF channels.
+ *
+ * Results:
+ *
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *
+ *	Sets the value of the specified option.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+SOPPlugFChannel (instanceData, interp, optionName, optionValue)
+    ClientData	 instanceData;  /* (in) Pointer to PlugFInfo struct. */
+    Tcl_Interp	*interp;        /* (in) Pointer to tcl interpreter. */
+    char	*optionName;
+    char	*optionValue;
+{
+    int option, value, error;
+
+    PlugFInfo *data = (PlugFInfo *)instanceData;
+
+    /*
+     * Set the option specified by optionName.
+     */
+
+    if (optionName[0] == '-') {
+        option = DpTranslateOption(optionName+1);
+    } else {
+        option = -1;
+    }
+
+    switch(option) {
+	case DP_PEEK:
+	    if (Tcl_GetBoolean(interp, optionValue, &value) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (value == 0) {
+		data->peek = 0;
+		if (Tcl_SetChannelOption(interp, data->channelPtr, "-peek", 
+			"no") == TCL_ERROR) {
+		    Tcl_AppendResult(interp, 
+			    ": subordinated channel error in ",
+                            Tcl_GetChannelName(data->channelPtr), NULL);
+		    return TCL_ERROR;
+		}
+	    } else {
+		data->peek = 1;
+		if (Tcl_SetChannelOption(interp, data->channelPtr, "-peek", 
+			"yes") == TCL_ERROR) {
+		    Tcl_AppendResult(interp, 
+			    ": subordinated channel error in ",
+			    Tcl_GetChannelName(data->channelPtr), NULL);
+		    return TCL_ERROR;
+		}
+	    }
+	    break;
+        
+	case DP_CHANNEL:
+	    Tcl_AppendResult(interp, "can't set channel after plug-in",
+		    " channel is opened", NULL);
+	    return TCL_ERROR;
+
+	case DP_INFILTER:
+	    Tcl_AppendResult(interp, "can't set infilter after plug-in",
+		    " channel is opened", NULL);
+	    return TCL_ERROR;
+
+	case DP_OUTFILTER:
+	    Tcl_AppendResult(interp, "can't set outfilter after plug-in",
+		    " channel is opened", NULL);
+	    return TCL_ERROR;
+
+	case DP_OUTSET:
+	    error = (data->outFilter) (optionValue, strlen(optionValue), NULL,
+			NULL, &(data->outData), data->interp, DP_FILTER_SET);
+ 
+	    if (error != 0) {
+		Tcl_AppendResult(interp, "can't set option ", optionValue, 
+			" for output filter",  NULL);
+		return TCL_ERROR;
+	    }
+	    break;
+
+	case DP_INSET:
+	    error = (data->inFilter) (optionValue, strlen(optionValue), NULL,
+		       NULL, &(data->inData), data->interp, DP_FILTER_SET);
+
+	    if (error != 0) {
+		Tcl_AppendResult(interp, "can't set option ", optionValue, 
+			" for input filter",  NULL);
+		return TCL_ERROR;
+	    }
+	    break;
+
+	default:
+	    Tcl_AppendResult (interp, "bad option \"", optionName,
+		    "\": must be peek, infilter, outfilter or a standard",
+		    "fconfigure option", NULL);
+	    return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GOPPlugFChannel --
+ *
+ *	"Get option" function for PIF channels.
+ *
+ * Results:
+ *
+ *	Standard Tcl result.
+ *	
+ * Side effects:
+ *
+ *	Returns the value of a non-standard option. If no option is specified,
+ *	a list of all options, together with their values, is returned.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GOPPlugFChannel (instanceData, 
+#ifdef _TCL80
+		interp,
+#endif
+		optionName, dsPtr)
+    ClientData instanceData;
+#ifdef _TCL80
+    Tcl_Interp *interp; 
+#endif
+    char	*optionName;
+    Tcl_DString *dsPtr;		/* (out) String to store the result in. */
+{
+    int option;
+    char *internal;
+
+    PlugFInfo *data = (PlugFInfo *)instanceData;
+
+    /*
+     * If optionName is NULL, then store an alternating list of
+     * all supported options and their current values in dsPtr.
+     */
+#ifdef _TCL80
+#define IGO(a, b, c) GOPPlugFChannel(a, interp, b, c)
+#else
+#define IGO(a, b, c) GOPPlugFChannel(a, b, c)
+#endif
+    if (optionName == NULL) {
+     	Tcl_DStringAppend (dsPtr, " -channel ", -1);
+	IGO (instanceData, "-channel", dsPtr);
+     	Tcl_DStringAppend (dsPtr, " -peek ", -1);
+	IGO (instanceData, "-peek", dsPtr);
+     	Tcl_DStringAppend (dsPtr, " -inset ", -1);
+	IGO (instanceData, "-inset", dsPtr);
+     	Tcl_DStringAppend (dsPtr, " -outset ", -1);
+	IGO (instanceData, "-outset", dsPtr);
+        return TCL_OK;
+    }
+#undef IGO
+
+    /*
+     * Retrieve the value of the option specified by optionName.
+     */
+
+    if (optionName[0] == '-') {
+        option = DpTranslateOption(optionName+1);
+    } else {
+        option = -1;
+    }
+
+    switch (option) {
+	case DP_PEEK:
+	    if (data->peek) {
+		Tcl_DStringAppend (dsPtr, "1", -1);
+	    } else {
+		Tcl_DStringAppend (dsPtr, "0", -1);
+	    }
+	    break;
+
+	case DP_CHANNEL:
+	    Tcl_DStringAppend (dsPtr, Tcl_GetChannelName(data->channelPtr), -1);
+	    break;
+
+	case DP_INFILTER:
+	    Tcl_DStringAppend (dsPtr, Dp_GetFilterName(data->inFilter), -1);
+	    break;
+
+	case DP_OUTFILTER:
+	    Tcl_DStringAppend (dsPtr, Dp_GetFilterName(data->outFilter), -1);
+	    break;
+
+	case DP_INSET:
+	    (data->inFilter) (NULL, 0, &internal, NULL,
+                              &(data->inData), data->interp, DP_FILTER_GET);
+	    Tcl_DStringAppend (dsPtr, internal, -1);
+	    break;
+
+	case DP_OUTSET:
+	    (data->outFilter) (NULL, 0, &internal, NULL,
+                               &(data->outData), data->interp, DP_FILTER_GET);
+	    Tcl_DStringAppend (dsPtr, internal, -1);
+	    break;
+
+	default:
+#ifndef _TCL76
+	    Tcl_AppendResult(interp, 
+		    "bad option \"", optionName,"\": must be -blocking,",
+		    " -buffering, -buffersize, -eofchar, -translation,",
+		    " or a channel type specific option", NULL);
+#else
+	    {
+		char errStr[128];
+		sprintf(errStr, "bad option \"%s\": must be -blocking,"
+			"-buffering, -buffersize, -eofchar, -translation,"
+			" or a channel type specific option", optionName);
+		Tcl_DStringAppend(dsPtr, errStr, -1);
+	    }
+#endif
+	    Tcl_SetErrno (EINVAL);
+	    return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * WCPPlugFChannel --
+ *
+ *	This is the "watch channel" procedure for PIF channels. It is assumed
+ *	that no events are generated internally in the filter channel, so the
+ *	procedure only calls the corresponding procedure of the subordinated
+ *	channel. 
+ *
+ * Results:
+ *
+ *	None.
+ *
+ * Side effects:
+ *
+ *	Calls the "watch channel" procedure of the subordinated channel.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+WCPPlugFChannel (instanceData, mask)
+    ClientData  instanceData;	/* (in) Pointer to PlugFInfo struct. */
+    int         mask;		/* (in) ORed combination of TCL_READABLE,
+                                 * TCL_WRITABLE and TCL_EXCEPTION. It designates
+                                 * the event categories that have to be watched.
+                                 */
+{
+    Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr;
+
+#ifdef _TCL76
+    (Tcl_GetChannelType(channelPtr)->watchChannelProc) 
+                         (Tcl_GetChannelInstanceData(channelPtr), mask);
+#endif
+    return;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CRPPlugFChannel --
+ *
+ *	This is the "channel ready" procedure for PIF channels. It is assumed
+ *	that no events are generated internally in the filter channel, so the
+ *	procedure only calls the corresponding procedure of the subordinated
+ *	channel. 
+ *
+ * Results:
+ *
+ *	The value returned by the "channel ready" procedure of the subordinated
+ *	channel.
+ *
+ * Side effects:
+ *
+ *	Calls the "channel ready" procedure of the subordinated channel.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CRPPlugFChannel (instanceData, mask)
+    ClientData  instanceData;	/* (in) Pointer to PlugFInfo struct. */
+    int         mask;		/* (in) ORed combination of TCL_READABLE,
+                                 * TCL_WRITABLE and TCL_EXCEPTION. It designates
+                                 * the event categories whose occurence has to
+                                 * be signalled.
+                                 */
+{
+    Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr;
+
+#ifdef _TCL76
+    return (Tcl_GetChannelType(channelPtr)->channelReadyProc)
+                         (Tcl_GetChannelInstanceData(channelPtr), mask);
+#else
+    return 1; 	/* to prevent compilation errors - Tcl 8.0 doesn't use
+    		// this function so this should never be executed */
+#endif
+}
+
+
+
+
+

tcl-dp/generic/dpPort.h

@@ -0,0 +1,56 @@
+/*
+ * dpPort.h --
+ *
+ *	This header file handles porting issues that occur because of
+ *	differences between systems.  It reads in platform specific
+ *	portability files.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _DPPORT
+#define _DPPORT
+
+#ifndef _TCL
+#   include "tcl.h"
+#endif
+
+#ifndef _TCLPORT
+#    ifdef __SUNOS__
+#	define NO_FLOAT_H
+#    endif
+#include "tclPort.h"
+#endif
+
+#ifndef _DP
+#   include "dp.h"
+#endif
+
+#if defined(__WIN32__) || defined(_WIN32)
+#   define WIN32_LEAN_AND_MEAN
+#   include <windows.h>
+#   undef WIN32_LEAN_AND_MEAN
+#   include "win/dpPort.h"
+#else
+#   define EXPORT(a,b) a b
+#   if defined(MAC_TCL)
+    /*
+     * (ToDo): there is currently no Mac Port of DP.
+     */
+#	include "mac/dpPort.h"
+#   else
+#	include "unix/dpPort.h"
+#   endif
+#endif
+
+
+#endif /* _DPPORT */
+
+
+
+
+

tcl-dp/generic/dpSerial.c

@@ -0,0 +1,578 @@
+/*
+ * This file holds the functions necessary for the generic layer
+ * of the DP serial channel driver.  Platform-specific functions
+ * in %OS%/dpSerial.c do most of the work since there really is no
+ * standard serial port API.
+ *
+ * DP knows a serial port by two names: the OS specific name (i.e
+ * COM1 or /dev/ttya) and DP's own naming scheme that can be used
+ * on every platform for portable Tcl code: serialX where X is a
+ * number.  Please see %OS%/dpSerial.c for more details.
+ *
+ * On Win32, serial2 cooresponds to COM2.  On Unix, serial2
+ * cooresponds to the second serial port.
+ *
+ * YOU CAN ONLY USE ONE NAME TO OPEN A CONNECTION WITH DP_CONNECT:
+ * 	dp_connect serial -device serialX
+ *
+ */
+
+#include "generic/dpPort.h"
+#include "generic/dpInt.h"
+
+static unsigned int serialCount = 0;
+
+static int 	SerialBlock _ANSI_ARGS_((ClientData instanceData,
+                                int mode));
+static int      SerialInput _ANSI_ARGS_((ClientData instanceData,
+                                char *bufPtr, int bufSize, int *errorPtr));
+static int      SerialOutput _ANSI_ARGS_((ClientData instanceData,
+				char *bufPtr, int toWrite, int *errorPtr));
+static int      SerialClose _ANSI_ARGS_((ClientData instanceData,
+                                Tcl_Interp *interp));
+static int      SerialSetOption _ANSI_ARGS_((ClientData instanceData,
+                                Tcl_Interp *interp, char *nameStr, char *val));
+
+#ifndef _TCL76
+static int	SerialGetOption _ANSI_ARGS_((ClientData instanceData,
+			    	Tcl_Interp *interp, char *optionName, 
+			    	Tcl_DString *dsPtr));
+#else
+static int	SerialGetOption _ANSI_ARGS_((ClientData instanceData,
+			    	char *optionName, Tcl_DString *dsPtr));
+#endif
+
+#ifndef _TCL76
+static int     	SerialGetFile _ANSI_ARGS_((ClientData instanceData,
+                                int direction, FileHandle *handlePtr));
+#else
+static Tcl_File SerialGetFile _ANSI_ARGS_((ClientData instanceData,
+                                int direction));
+#endif
+
+#ifdef _TCL76
+static int      SerialReady _ANSI_ARGS_((ClientData instanceData,
+                                int direction));
+#endif
+
+static void     SerialWatch _ANSI_ARGS_((ClientData instanceData,
+                                int mask));
+
+static Tcl_ChannelType serialChannelType = {
+    "serial",
+    SerialBlock,
+    SerialClose,
+    SerialInput,
+    SerialOutput,
+    NULL,         		/* Can't seek! */
+    SerialSetOption,
+    SerialGetOption,
+    SerialWatch,
+#ifdef _TCL76
+    SerialReady,
+#endif
+    SerialGetFile
+};
+
+
+/* --------------------------------------------------
+ *
+ *    DpOpenSerialChannel --
+ *
+ *        Generic routine to open a serial channel
+ *
+ *    Returns
+ *
+ *        A Tcl_Channel.
+ *    
+ *    Side Effects
+ *
+ *        Opens the serial port and allocates memory. 
+ *
+ * ---------------------------------------------------
+ */
+
+Tcl_Channel
+DpOpenSerialChannel(interp, argc, argv)
+    Tcl_Interp *interp;
+    int argc;
+    char **argv;
+{
+    Tcl_Channel chan;
+    SerialState *ssPtr;
+    char devStr[15];
+    char channelNameStr[10];
+    int block, ro;
+    int i, flags, mode;
+
+    block = 0;
+    ro = 0;
+    flags = 0;
+    strcpy(devStr, "");
+
+    for (i=0; i<argc; i+=2) {
+    	int len = strlen(argv[i]);
+
+    	if (strncmp(argv[i], "-device", len) == 0) {
+	    if (i+1 == argc) goto arg_missing;
+	    strcpy(devStr, argv[i+1]);
+	} else if (strncmp(argv[i], "-block", len) == 0) {
+	    if (i+1 == argc) goto arg_missing;
+	    if (Tcl_GetBoolean(interp, argv[i+1], &block) == TCL_ERROR) {
+	    	return NULL;
+	    }
+	} else if (strncmp(argv[i], "-readonly", len) == 0) {
+	    if (i+1 == argc) goto arg_missing;
+	    if (Tcl_GetBoolean(interp, argv[i+1], &ro) == TCL_ERROR) {
+	    	return NULL;
+	    }
+	} else {
+	    Tcl_AppendResult(interp, "Unknown option \"", argv[i], 
+		    "\", must be -device, -block, or -readonly", NULL);
+	    return NULL;
+	}
+    }
+
+    /*
+     * Combine the two flags into a bitmask
+     */
+    if (block) {
+	flags = 1;
+    }
+
+    mode = TCL_READABLE | TCL_WRITABLE;
+    if (ro) {
+	flags |= 2;
+	mode &= ~(TCL_WRITABLE);
+    }
+    
+    ssPtr = (SerialState *) ckalloc(sizeof(SerialState));
+    if (DppOpenSerialChannel(interp, (ClientData)ssPtr, devStr, flags)
+	    != TCL_OK) {
+	ckfree((char *)ssPtr);
+	return NULL;
+    }
+#ifdef _TCL76
+    ssPtr->theFile = Tcl_GetFile((ClientData)ssPtr->fd, SERIAL_HANDLE);
+#else
+    ssPtr->theFile = (FileHandle)ssPtr->fd;
+#endif
+
+    /*
+     * Setup the serial channel to flush every line
+     */
+
+    sprintf(channelNameStr, "serial%d", serialCount++);
+    chan = Tcl_CreateChannel(&serialChannelType, channelNameStr,
+	    (ClientData) ssPtr, mode);
+	Tcl_RegisterChannel(interp, chan);            
+     
+    if (Tcl_SetChannelOption(interp, chan, "-buffering", "line")
+	    != TCL_OK) {
+        DpClose(interp, chan);
+	return NULL;
+    }
+
+    ssPtr->channel = chan;
+
+    return chan;
+
+arg_missing:
+    Tcl_AppendResult(interp, "Value for \"", argv[i],
+    	"\" missing", NULL);
+    return NULL;
+}
+
+
+/* --------------------------------------------------
+ *
+ *    SerialBlock --
+ *
+ *        Generic routine to set I/O to blocking or
+ *	  non-blocking.
+ *
+ *    Returns
+ *
+ *        TCL_OK or TCL_ERROR.
+ *    
+ *    Side Effects
+ *
+ *        None.
+ *
+ * ---------------------------------------------------
+ */
+
+static int
+SerialBlock(instanceData, mode)
+    ClientData instanceData;
+    int mode;			/* (in) Block or not */
+{
+    return DppSerialBlock(instanceData, mode);
+}
+
+
+/* --------------------------------------------------
+ *
+ *    SerialInput --
+ *
+ *        Generic read routine for serial ports
+ *
+ *    Returns
+ *
+ *        Amount read or -1 with errorcode in errorPtr.
+ *    
+ *    Side Effects
+ *
+ *        Buffer is updated. 
+ *
+ * ---------------------------------------------------
+ */
+
+static int
+SerialInput(instanceData, bufPtr, bufSize, errorPtr)
+    ClientData instanceData;
+    char *bufPtr;		/* (in) Ptr to buffer */
+    int bufSize;		/* (in) sizeof buffer */
+    int *errorPtr;		/* (out) error code */
+{
+    return DppSerialInput(instanceData, bufPtr, bufSize, errorPtr);
+}
+
+
+/* --------------------------------------------------
+ *
+ *    SerialOutput --
+ *
+ *        Generic write routine for serial ports
+ *
+ *    Returns
+ *
+ *        Amount written or -1 with errorcode in errorPtr
+ *    
+ *    Side Effects
+ *
+ *        None. 
+ *
+ * ---------------------------------------------------
+ */
+
+static int
+SerialOutput(instanceData, bufPtr, toWrite, errorPtr)
+    ClientData instanceData;
+    char *bufPtr;		/* (in) Ptr to buffer */
+    int toWrite;		/* (in) amount to write */
+    int *errorPtr;		/* (out) error code */
+{
+    return DppSerialOutput(instanceData, bufPtr, toWrite, errorPtr);
+}
+
+
+/* --------------------------------------------------
+ *
+ *    SerialClose --
+ *
+ *        Generic routine to close the serial port
+ *
+ *    Returns
+ *
+ *        0 if successful or a POSIX errorcode with
+ *        interp updated.
+ *    
+ *    Side Effects
+ *
+ *        Channel is deleted.
+ *
+ * ---------------------------------------------------
+ */
+
+static int
+SerialClose(instanceData, interp)
+    ClientData instanceData;
+    Tcl_Interp *interp;
+{
+    SerialState *ssPtr = (SerialState *) instanceData;
+    int rc = TCL_OK;
+
+    rc = DppSerialClose(instanceData);
+    if ((rc != 0) && (interp != NULL)) {
+    	Tcl_SetErrno(rc);
+    	Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_VOLATILE);
+    }
+    ckfree((char *)ssPtr);
+    return rc; 
+}
+
+
+/* --------------------------------------------------
+ *
+ *    SerialSetOptions --
+ *
+ *        Sets "name" to "val".  Possible
+ *        options with valid arguments are:
+ *
+ *            -parity [odd|even|none]
+ *            -charsize [7|8]
+ *            -stopbits [1|2]
+ *	      -baudrate [rate]
+ *            -sendBuffer [size]
+ *            -recvBuffer [size]
+ *
+ *    Returns
+ *
+ *        TCL_OK or TCL_ERROR with interp->result updated
+ *    
+ *    Side Effects
+ *
+ *        Changes parameters for this channel
+ *
+ * ---------------------------------------------------
+ */
+
+static int
+SerialSetOption(instanceData, interp, nameStr, valStr)
+    ClientData instanceData;
+    Tcl_Interp *interp;
+    char *nameStr;		/* (in) Name of option */
+    char *valStr;		/* (in) New value of option */
+{
+    SerialState *ssPtr = (SerialState *) instanceData;
+    int optVal, option;
+    char errorStr[80];
+    int optBool;
+
+    if (nameStr[0] != '-') {
+        option = -1;
+    } else {
+        option = DpTranslateOption(nameStr+1);
+    }
+
+    switch (option) {
+        case DP_PARITY:
+            if (!strcmp(valStr, "none")) {
+                optVal = PARITY_NONE;
+            } else if (!strcmp(valStr, "even")) {
+                optVal = PARITY_EVEN;
+            } else if (!strcmp(valStr, "odd")) {
+                optVal = PARITY_ODD;
+            } else {
+                sprintf(errorStr, "Parity must be \"even\", \"odd\" or \"none\"");
+                goto argError;
+            }
+            return DppSerialSetOption(ssPtr, DP_PARITY, optVal);
+        case DP_CHARSIZE:
+            if (Tcl_GetInt(interp, valStr, &optVal) == TCL_ERROR) {
+		return TCL_ERROR;	
+            }
+            if (optVal != 7 && optVal != 8) {
+                sprintf(errorStr, "Charsize must be 7 or 8");
+                goto argError;
+            }
+            return DppSerialSetOption(ssPtr, DP_CHARSIZE, optVal);
+        case DP_STOPBITS:
+            if (Tcl_GetInt(interp, valStr, &optVal) == TCL_ERROR) {
+                return TCL_ERROR;
+	    }
+            if (optVal != 1 && optVal != 2) {
+                sprintf(errorStr, "Stopbits must be 1 or 2");
+                goto argError;
+            } 
+            return DppSerialSetOption(ssPtr, DP_STOPBITS, optVal);
+        case DP_BAUDRATE:
+            if (Tcl_GetInt(interp, valStr, &optVal) == TCL_ERROR) {
+                return TCL_ERROR;
+            }
+            return DppSerialSetOption(ssPtr, DP_BAUDRATE, optVal);
+	case DP_BLOCK:
+	    if (Tcl_GetBoolean(interp, valStr, &optBool) == TCL_ERROR) {
+	    	return TCL_ERROR;
+	    }
+	    return DppSerialSetOption(ssPtr, DP_BLOCK, optBool);
+        default:
+            Tcl_AppendResult (interp, "Illegal option \"", nameStr,
+                    "\" -- must be charsize, stopbits, parity, baudrate, \
+                     or a standard channel option", NULL);
+            return TCL_ERROR;
+    }
+
+argError:
+    Tcl_AppendResult(interp, errorStr, (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/* ----------------------------------------------------
+ *
+ *    SerialGetOption --
+ *
+ *	Queries serial channel for the current value of
+ *      the given option.
+ *
+ *    Returns
+ *
+ *	TCL_OK and dsPtr updated with the value or 
+ *	TCL_ERROR.
+ *
+ *    Side Effects
+ *
+ *	None.
+ *
+ * -----------------------------------------------------
+ */
+
+static int
+SerialGetOption(instanceData, 
+#ifdef _TCL80
+		interp,
+#endif
+		optionName, dsPtr)
+    ClientData instanceData;
+#ifdef _TCL80
+    Tcl_Interp *interp; 
+#endif
+    char *optionName;		/* (in) Name of option to retrieve */		
+    Tcl_DString *dsPtr;		/* (in) String to place value */
+{
+    SerialState *ssPtr = (SerialState *) instanceData;
+    int option;
+
+    if (optionName != NULL) {
+	if (optionName[0] != '-') {
+	    option = -1;
+	} else {
+	    option = DpTranslateOption(optionName+1);
+	}
+    } else {
+	Tcl_DStringAppend(dsPtr, " -charsize ", -1);
+	DppSerialGetOption(ssPtr, DP_CHARSIZE, dsPtr);
+	Tcl_DStringAppend(dsPtr, " -stopbits ", -1);
+	DppSerialGetOption(ssPtr, DP_STOPBITS, dsPtr);
+	Tcl_DStringAppend(dsPtr, " -baudrate ", -1);
+	DppSerialGetOption(ssPtr, DP_BAUDRATE, dsPtr);
+	Tcl_DStringAppend(dsPtr, " -parity ", -1);
+	DppSerialGetOption(ssPtr, DP_PARITY, dsPtr);
+	Tcl_DStringAppend(dsPtr, " -device ", -1);
+	DppSerialGetOption(ssPtr, DP_DEVICENAME, dsPtr);
+        return TCL_OK;
+    }
+
+    if (option == -1)
+    {
+#ifndef _TCL76
+	Tcl_AppendResult(interp, 
+		"bad option \"", optionName,"\": must be -blocking,",
+		" -buffering, -buffersize, -eofchar, -translation,",
+		" or a channel type specific option", NULL);
+#else
+	char errStr[128];
+	sprintf(errStr, "bad option \"%s\": must be -blocking,"
+		"-buffering, -buffersize, -eofchar, -translation,"
+		" or a channel type specific option", optionName);
+	Tcl_DStringAppend(dsPtr, errStr, -1);
+#endif
+	Tcl_SetErrno(EINVAL);
+	return TCL_ERROR;
+    }
+
+    return DppSerialGetOption(ssPtr, option, optionName, dsPtr);
+}
+
+/* ----------------------------------------------------
+ *
+ *    SerialGetFile --
+ *
+ *	See below
+ *
+ *    Returns
+ *
+ *	TCL_OK
+ *
+ *    Side Effects
+ *
+ *	None.
+ *
+ * -----------------------------------------------------
+ */
+
+#ifndef _TCL76
+static int
+SerialGetFile(instanceData, direction, handlePtr)
+    ClientData instanceData;
+    int direction;
+    FileHandle *handlePtr;
+{
+    SerialState *statePtr = (SerialState *)instanceData;
+
+    *handlePtr = statePtr->theFile;
+    return TCL_OK;
+}
+
+#else
+
+static Tcl_File
+SerialGetFile(instanceData, direction)
+    ClientData instanceData;
+    int direction;
+{
+    SerialState *statePtr = (SerialState *)instanceData;
+
+    return statePtr->theFile;
+}
+#endif
+
+
+/* ----------------------------------------------------
+ *
+ *    SerialReady --
+ *
+ *	Determines whether serial port has data to be
+ *	read or is OK for writing.
+ *
+ *    Returns
+ *
+ *	A bitmask of the events that were found (i.e.
+ *	TCL_FILE_READABLE | TCL_FILE_WRITABLE).
+ *
+ *    Side Effects
+ *
+ *	None.
+ *
+ * -----------------------------------------------------
+ */
+
+#ifdef _TCL76
+static int
+SerialReady(instanceData, direction)
+    ClientData instanceData;
+    int direction;
+{
+    return DppSerialFileReady(instanceData, direction);
+}
+#endif
+
+
+/* ----------------------------------------------------
+ *
+ *    SerialWatch --
+ *
+ *	Sets up event handling on a serial port Tcl_Channel
+ *
+ *    Returns
+ *
+ *	Nothing
+ *
+ *    Side Effects
+ *
+ *	None.
+ *
+ * -----------------------------------------------------
+ */
+
+static void
+SerialWatch(instanceData, mask)
+    ClientData instanceData;
+    int mask;
+{
+    DppSerialWatchFile(instanceData, mask);
+}
+
+

tcl-dp/generic/dpSock.c

@@ -0,0 +1,124 @@
+/*
+ * generic/dpSock.c --
+ *
+ *  This file implements the socket code for various channel drivers.
+ *  In other words, platforms that support Berkeley sockets can use routines
+ *  in this module as part of their platform specific driver.
+ *  This code is supported by the routines in the file dpSock.c in the
+ *  platform directories (i.e., win/dpSock.c, unix/dpSock.c, mac/dpSock.c)
+ *  which handle platform-specific error translation and other non-portable
+ *  functions.
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "generic/dpInt.h"
+#include "generic/dpPort.h"
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DpHostToIpAddr --
+ *
+ *	Find the IP address corresponding to a hostname.
+ *
+ * Results:
+ *	1 on success, 0 if host is unknown
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+int
+DpHostToIpAddr (host, ipAddrPtr)
+    char *host;			/* (in) Hostname (human readable) */
+    int *ipAddrPtr;		/* (out) IP address of host */
+{
+    struct hostent *hostent;
+
+    if (strcmp (host, "localhost") == 0) {
+	*ipAddrPtr = 0x7F000001;
+	return 1;
+    }
+
+    /*
+     * Gotta watch this one -- on NT, gethostbyname on "" goes out
+     * to lunch
+     */
+    if ((host == NULL) || (host[0] == 0)) {
+        return 0;
+    }
+
+    /*
+     * Try looking host up by address (i.e., host is something
+     * like "128.84.253.1").  Since the value is returned in
+     * network byte order, we change it to host byte order.
+     * We do this first because it's much faster (doesn't require
+     * a trip to the DNS).
+     */
+    *ipAddrPtr = inet_addr(host);
+    if (*ipAddrPtr != DP_INADDR_NONE) {
+	*ipAddrPtr = ntohl(*ipAddrPtr);
+	return 1;
+    }
+
+    /*
+     * Looking up the host by address failed.  Try looking it up by
+     * name. If successful, the IP address is in network byte order
+     * in hostent->h_addr_list[0]
+     */
+    hostent = gethostbyname(host);
+    if (hostent != NULL) {
+	memcpy ((char *)ipAddrPtr,
+	       (char *) hostent->h_addr_list[0],
+	       (size_t) hostent->h_length);
+	*ipAddrPtr = ntohl(*ipAddrPtr);
+	return 1;
+    }
+
+    /*
+     * Total failure
+     */
+    return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DpIpAddrToHost --
+ *
+ *	Find the hostname corresponding to an IP address
+ *
+ * Results:
+ *	1 on success, 0 for failure
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+int
+DpIpAddrToHost (ipAddr, hostPtr)
+    int ipAddr;			/* (in) IP addr */
+    char *hostPtr;		/* (out) Corresponding hostname */
+{
+    struct hostent *hEnt;
+
+    if (ipAddr == 0x7F000001) {
+    	strcpy(hostPtr, "localhost");
+    } else {
+    	hEnt = gethostbyaddr((char *)&ipAddr, sizeof(int), AF_INET);
+    	if (hEnt == NULL) {
+	    return 0;
+	}
+    	strcpy(hostPtr, hEnt->h_name);
+    }
+    return 1;
+}
+

tcl-dp/generic/dpUdp.c

@@ -0,0 +1,885 @@
+/*
+ * generic/dpUdp.c --
+ *
+ *  This file implements the generic code for a udp channel driver.  These
+ *  are channels that are created by evaluating "dp_connect udp".
+ *
+ *  The architecture consists of a generic layer and a platform specific
+ *  layer.  The rational is that platform specific code goes in its layer,
+ *  while platform independent code goes in its layer.  However, most
+ *  socket implementations use the Berkeley sockets interface, which is
+ *  similar across platforms with a few annoying differences.  These are
+ *  separated into two files, dpSockUdp.c contains the generic socket code,
+ *  which makes calls on routines in win/dpSock.c, which contains the
+ *  platform specific code.  We retain the two level architecture, though,
+ *  so non-Berkeley socket interfaces can be built (if any still exist).
+ *
+ * Copyright (c) 1995-1996 Cornell University.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "generic/dpInt.h"
+#include "generic/dpPort.h"
+
+/*
+ * Below are all the channel driver procedures that must be supplied for
+ * a channel.  Replace Udp with the name of this channel type.
+ * In many cases, the DpGeneric driver procedures can be used (e.g.,
+ * "DpGenericBlockMode)"
+ */
+
+static int		    UdpBlockMode _ANSI_ARGS_((ClientData instanceData,
+					int mode));
+static int		    UdpInput _ANSI_ARGS_((ClientData instanceData, 
+					char *buf, int bufSize, 
+					int *errorCodePtr));
+static int		    UdpOutput _ANSI_ARGS_((ClientData instanceData, 
+					char *buf, int toWrite, 
+					int *errorCodePtr));
+static int		    UdpClose _ANSI_ARGS_((ClientData instanceData,
+					Tcl_Interp *interp));
+static int		    UdpSetOption _ANSI_ARGS_((ClientData instanceData,
+					Tcl_Interp *interp, char *optionName,
+					char *optionValue));
+static int		    UdpGetOption _ANSI_ARGS_((ClientData instanceData,
+					char *optionName, Tcl_DString *dsPtr));
+
+static void		    UdpWatch _ANSI_ARGS_((ClientData instanceData, 
+					int mask));
+static int		    UdpReady _ANSI_ARGS_((ClientData instanceData, 
+					int mask));
+
+static Tcl_File	    UdpGetFile _ANSI_ARGS_((ClientData instanceData,
+					int direction));
+
+typedef SocketState UdpState;
+
+static Tcl_ChannelType udpChannelType = {
+     "udp",		/* Name of channel */
+     UdpBlockMode,	/* Proc to set blocking mode on socket */
+     UdpClose,		/* Proc to close a socket */
+     UdpInput,		/* Proc to get input from a socket */
+     UdpOutput,		/* Proc to send output to a socket */
+     NULL,              /* Can't seek on a socket! */
+     UdpSetOption,	/* Proc to set a socket option */
+     UdpGetOption,	/* Proc to set a socket option */
+     UdpWatch,		/* Proc called to set event loop wait params */
+     UdpReady,		/* Proc called to check if socket has input */
+     UdpGetFile		/* Proc to return a handle assoc with socket */
+};
+
+#define	PEEK_MODE	(1<<1)	/* Read without consuming? */
+
+static int udpCount = 0;        /* Number of udp files opened -- used to
+                                 * generate unique ids for channels */
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpBlockMode --
+ *
+ *	Sets the udp socket to blocking or non-blocking.  Just
+ *	a wrapper around the platform specific function.
+ *
+ * Results:
+ *	Zero if the operation was successful, or a nonzero POSIX
+ *	error code if the operation failed.	
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpBlockMode (instanceData, mode)
+    ClientData instanceData;	/* Pointer to udpState struct */
+    int mode;			/* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */
+{
+    if (mode == TCL_MODE_BLOCKING) {
+	return DpUdpSetSocketOption(instanceData, DP_BLOCK, 1);
+    } else {
+	return DpUdpSetSocketOption(instanceData, DP_BLOCK, 0);
+    }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpClose --
+ *
+ *	This function is called by the Tcl channel driver when
+ *	the caller want to close the socket.
+ *	It releases the instanceData and closes the scoket
+ *	All queued output will have been flushed to the device
+ *	before this function is called.
+ *
+ * Results:
+ *	Zero for success, otherwise a nonzero POSIX error code and,
+ *	if interp is not NULL, an error message in interp->result
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpClose (instanceData, interp)
+    ClientData instanceData;	/* (in) Pointer to udpState struct */
+    Tcl_Interp *interp;		/* (in) For error reporting */
+{
+    UdpState *statePtr = (UdpState *)instanceData;
+    int result;
+
+    result = DppCloseSocket(statePtr->sock);
+    if ((result != 0) && (interp != NULL)) {
+        DppGetErrno();
+        Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_STATIC);
+    }
+    ckfree((char *)statePtr);
+    return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpInput --
+ *
+ *	This function is called by the Tcl channel driver whenever
+ *	the user wants to get input from the UDP socket.  
+ *	If the socket has some data available but
+ *	less than requested by the bufSize argument, we only read
+ *	as much data as is available and return without blocking.
+ *	If the socket has no data available whatsoever and is
+ *	blocking, we block until at least one byte of data can be
+ *	read from the socket.
+ *
+ * Results:
+ *	A nonnegative integer indicating how many bytes were read,
+ *	or -1 in case of error (with errorCodePtr set to the POSIX
+ *	error code).
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpInput (instanceData, buf, bufSize, errorCodePtr)
+    ClientData instanceData;	/* (in) Pointer to udpState struct */
+    char *buf;			/* (in/out) Buffer to fill */
+    int bufSize;		/* (in) Size of buffer */
+    int *errorCodePtr;		/* (out) POSIX error code (if any) */
+{
+    UdpState *statePtr = (UdpState *)instanceData;
+    int result, peek;
+    int fromHost, fromPort;
+    char str[256];
+    DpSocketAddressIP fromAddr;
+    int bytesRead, flags = 0, fromLen;
+
+    peek = (statePtr->flags & PEEK_MODE);
+    if (peek) {
+        flags = MSG_PEEK;
+    } else {
+        flags = 0;
+    }
+    fromLen = sizeof(fromAddr);
+    bytesRead = recvfrom(statePtr->sock, buf, bufSize, flags,
+	    (DpSocketAddress *)&fromAddr, &fromLen);
+    if (bytesRead == DP_SOCKET_ERROR) {
+	*errorCodePtr = DppGetErrno();
+	return -1;
+    }
+    if (statePtr->interp != NULL) {
+	fromHost = ntohl(fromAddr.sin_addr.s_addr);
+	fromPort = ntohs(fromAddr.sin_port);
+    
+	sprintf (str, "{%d.%d.%d.%d %d}",  (fromHost>>24),
+		(fromHost>>16) & 0xFF, (fromHost>>8) & 0xFF, fromHost & 0xFF,
+		fromPort);
+	Tcl_SetVar(statePtr->interp, "dp_from", str, TCL_GLOBAL_ONLY);
+    }
+    return bytesRead;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpOutput --
+ *
+ *	This function is called by the Tcl channel driver whenever
+ *	the user wants to send output to the UDP socket.
+ *	The function writes toWrite bytes from buf to the socket.
+ *
+ * Results:
+ *	A nonnegative integer indicating how many bytes were written
+ *	to the socket. The return value is normally the same as toWrite,
+ *	but may be less in some cases such as if the output operation
+ *	is interrupted by a signal.  
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpOutput (instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;	/* (in) Pointer to udpState struct */
+    char *buf;			/* (in) Buffer to write */
+    int toWrite;		/* (in) Number of bytes to write */
+    int *errorCodePtr;		/* (out) POSIX error code (if any) */
+{
+    UdpState *statePtr = (UdpState *) instanceData;
+    DpSocketAddressIP dsa;
+    int result;
+
+    dsa.sin_family = AF_INET;
+    dsa.sin_addr.s_addr = htonl(statePtr->destIpAddr);
+    dsa.sin_port = htons((unsigned short)statePtr->destPort);
+
+    result = sendto(statePtr->sock, buf, toWrite, 0,
+	    (DpSocketAddress *)&dsa, sizeof(dsa));
+    if (result == DP_SOCKET_ERROR) {
+	*errorCodePtr = DppGetErrno();
+    }
+    return result;
+
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpSetOption --
+ *
+ *	This function is called by the Tcl channel driver
+ *	whenever Tcl evaluates and fconfigure call to set
+ *	some property of the udp socket (e.g., the buffer
+ *	size).  The valid options are "sendBuffer" and
+ *	"recvBuffer"
+ *
+ * Results:
+ *	Standard Tcl return value.
+ *
+ * Side effects:
+ *	Depends on the option.  Generally changes the maximum
+ *	message size that can be sent/received.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpSetOption (instanceData, interp, optionName, optionValue)
+    ClientData instanceData;
+    Tcl_Interp *interp;
+    char *optionName;
+    char *optionValue;
+{
+    int option;
+    int value;
+    UdpState *statePtr = (UdpState *)instanceData;
+
+    /*
+     * Set the option specified by optionName
+     */
+    if (optionName[0] == '-') {
+        option = DpTranslateOption(optionName+1);
+    } else {
+        option = -1;
+    }
+    switch (option) {
+	case DP_SEND_BUFFER_SIZE:
+	case DP_RECV_BUFFER_SIZE:
+	    if (Tcl_GetInt(interp, optionValue, &value) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (value <=0) {
+		Tcl_AppendResult (interp, "Buffer size must be > 0", NULL);
+		return TCL_ERROR;
+	    }
+	    return DpUdpSetSocketOption (statePtr, option, value);
+	
+	case DP_PEEK:
+	    if (Tcl_GetBoolean(interp, optionValue, &value) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (value == 0) {
+		statePtr->flags &= ~PEEK_MODE;
+	    } else {
+		statePtr->flags |= PEEK_MODE;
+	    }
+	    break;
+
+	case DP_HOST:
+	    if (DpHostToIpAddr (optionValue, &value) == 0) {
+		Tcl_AppendResult (interp,
+			"Expected IP address or hostname but got \"",
+			optionValue, "\"", NULL);
+		return TCL_ERROR;
+	    } 
+	    statePtr->destIpAddr = value;
+	    break;
+
+	case DP_PORT:
+	    if (Tcl_GetInt(interp, optionValue, &value) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (value <= 0) {
+		Tcl_AppendResult (interp, "Port number must be > 0", NULL);
+		return TCL_ERROR;
+	    }
+	    statePtr->destPort = (unsigned short) value;
+	    break;
+
+	case DP_MYPORT:
+	    Tcl_AppendResult (interp, "Can't set port after socket is opened",
+		    NULL);
+	    return TCL_ERROR;
+
+	default:
+	    Tcl_AppendResult (interp, "Illegal option \"", optionName,
+		    "\" -- must be sendBuffer, recvBuffer, peek, ",
+		    "host, port, or a standard fconfigure option", NULL);
+	    return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpGetOption --
+ *
+ *	This function is called by the Tcl channel code to
+ *	retrieve a parameter of the socket (e.g., a buffer size).
+ *	The valid options are "sendBuffer" and "recvBuffer"
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpGetOption (instanceData, optionName, dsPtr)
+    ClientData instanceData;
+    char *optionName;
+    Tcl_DString *dsPtr;
+{
+    int option;
+    int size;
+    unsigned int addr;
+    char str[256];
+    UdpState *statePtr = (UdpState *)instanceData;
+
+    /*
+     * If optionName is NULL, then store an alternating list of
+     * all supported options and their current values in dsPtr
+     */
+    if (optionName == NULL) {
+	Tcl_DStringAppend (dsPtr, " -sendBuffer ", -1);
+	UdpGetOption(instanceData, "-sendBuffer", dsPtr);
+	Tcl_DStringAppend (dsPtr, " -recvBuffer ", -1);
+	UdpGetOption(instanceData, "-recvBuffer", dsPtr);
+	Tcl_DStringAppend (dsPtr, " -peek ", -1);
+	UdpGetOption(instanceData, "-peek", dsPtr);
+	Tcl_DStringAppend (dsPtr, " -host ", -1);
+	UdpGetOption(instanceData, "-host", dsPtr);
+	Tcl_DStringAppend (dsPtr, " -port ", -1);
+	UdpGetOption(instanceData, "-port", dsPtr);
+	Tcl_DStringAppend (dsPtr, " -myport ", -1);
+	UdpGetOption(instanceData, "-myport", dsPtr);
+        return TCL_OK;
+    }
+
+    /*
+     * Retrive the value of the option specified by optionName
+     */
+
+    if (optionName[0] == '-') {
+        option = DpTranslateOption(optionName+1);
+    } else {
+        option = -1;
+    }
+
+    switch (option) {
+	case DP_SEND_BUFFER_SIZE:
+	case DP_RECV_BUFFER_SIZE:
+	    DpUdpGetSocketOption (statePtr, option, &size);
+	    sprintf (str, "%d", size);
+	    Tcl_DStringAppend (dsPtr, str, -1);
+	    break;
+
+	case DP_PEEK:
+	    if (statePtr->flags & PEEK_MODE) {
+		Tcl_DStringAppend (dsPtr, "1", -1);
+	    } else {
+		Tcl_DStringAppend (dsPtr, "0", -1);
+	    }
+	    break;
+
+	case DP_HOST:
+	    addr = statePtr->destIpAddr;
+	    sprintf (str, "%d.%d.%d.%d",
+		    (addr >>24), (addr >>16) & 0xff,
+		    (addr >> 8) & 0xff, (addr) & 0xff);
+	    Tcl_DStringAppend (dsPtr, str, -1);
+	    break;
+
+	case DP_PORT:
+	    sprintf (str, "%d", (unsigned short) statePtr->destPort);
+	    Tcl_DStringAppend (dsPtr, str, -1);
+	    break;
+
+	case DP_MYPORT:
+	    sprintf (str, "%d", (unsigned short) statePtr->myPort);
+	    Tcl_DStringAppend (dsPtr, str, -1);
+	    break;
+
+	default:
+	    {
+	    	char errStr[128];
+	    	sprintf(errStr, "bad option \"%s\": must be -blocking,"
+	    		"-buffering, -buffersize, -eofchar, -translation,"
+	    		" or a channel type specific option", optionName);
+	    	Tcl_DStringAppend(dsPtr, errStr, -1);
+	    }
+	    Tcl_SetErrno (EINVAL);
+	    return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  DpOpenUdpChannel --
+ *
+ *	Opens a new channel that uses the UDP protocol.
+ *
+ * Results:
+ *	Returns a pointer to the newly created Tcl_Channel.  This
+ *	is the structure with all the function pointers Tcl needs
+ *	to communicate with (read, write, close, etc) the channel.
+ *
+ * Side effects:
+ *	A socket is created with the specified port.  No other
+ *	socket can use that port until this channel is closed.
+ *
+ *--------------------------------------------------------------
+ */
+Tcl_Channel
+DpOpenUdpChannel(interp, argc, argv)
+    Tcl_Interp *interp;		/* For error reporting; can be NULL. */
+    int argc;			/* Number of arguments. */
+    char **argv;                /* Argument strings. */
+{
+    Tcl_Channel chan;
+    UdpState *statePtr;
+    char channelName[20];
+    int i, result;
+
+    /*
+     * The default values for the value-option pairs
+     */
+
+    int hostIp = 0;
+    int port = 0;
+    int myIpAddr = DP_INADDR_ANY;
+    int myport = 0;
+
+    for (i=0; i<argc; i+=2) {
+        int v = i+1;
+	size_t len = strlen(argv[i]);
+
+	if (strncmp(argv[i], "-host", len)==0) {
+	    if (v==argc) {goto arg_missing;}
+	    if (!DpHostToIpAddr (argv[v], &hostIp)) {
+	        Tcl_AppendResult (interp, "Unknown host \"", argv[v],
+	        	"\"", NULL);
+		return NULL;
+	    }
+	} else if (strncmp(argv[i], "-port", len)==0) {
+	    if (v==argc) {goto arg_missing;}
+	    if (Tcl_GetInt(interp, argv[v], &port) != TCL_OK) {
+		return NULL;
+	    }
+	    if (port <= 0) {
+		Tcl_AppendResult (interp, "Port number must be > 0", NULL);
+		return NULL;
+	    }
+	} else if (strncmp(argv[i], "-myaddr", len)==0) {
+	    if (v==argc) {goto arg_missing;}
+	    if (strcmp (argv[v], "any") == 0) {
+		myIpAddr = DP_INADDR_ANY;
+	    } else if (!DpHostToIpAddr (argv[v], &myIpAddr)) {
+		Tcl_AppendResult (interp, "Illegal value for -myaddr \"",
+			 argv[v], "\"", NULL);
+		return NULL;
+	    }
+	} else if (strncmp(argv[i], "-myport", len)==0) {
+	    if (v==argc) {goto arg_missing;}
+	    if (Tcl_GetInt(interp, argv[v], &myport) != TCL_OK) {
+		return NULL;
+	    }
+	    if (myport <= 0) {
+		Tcl_AppendResult (interp,
+			"Port number for -myport must be > 0", NULL);
+		return NULL;
+	    }
+	} else {
+    	    Tcl_AppendResult(interp, "unknown option \"", 
+		    argv[i], "\", must be -host, -myaddr, -myport ",
+		    "or -port", NULL);
+	    return NULL;
+	}
+    }
+
+    /*
+     * Create a new socket and wrap it in a channel.
+     */
+
+    statePtr		    = (UdpState *)ckalloc(sizeof(UdpState));
+    statePtr->flags	    = 0;
+    statePtr->interp	    = interp;
+    statePtr->myPort	    = myport;
+    statePtr->destIpAddr    = hostIp;
+    statePtr->destPort	    = port;
+    result = DpCreateUdpSocket(interp, myIpAddr, statePtr);
+
+    if (result != TCL_OK) {
+	ckfree((char *)statePtr);
+	return NULL;
+    }
+    sprintf(channelName, "udp%d", udpCount++);
+    chan = Tcl_CreateChannel(&udpChannelType, channelName, 
+	    (ClientData)statePtr, TCL_READABLE|TCL_WRITABLE);
+	Tcl_RegisterChannel(interp, chan);            
+
+    /*
+     * Set the initial state of the channel.
+     * Make sure the socket's blocking, set the default buffer sizes,
+     * set the destination address as specified, disable Tcl buffering
+     * and translation.
+     */
+
+    DpUdpSetSocketOption(statePtr, DP_SEND_BUFFER_SIZE, 8192);
+    DpUdpSetSocketOption(statePtr, DP_RECV_BUFFER_SIZE, 8192);
+
+    DpUdpGetSocketOption(statePtr, DP_RECV_BUFFER_SIZE,
+    	    &statePtr->recvBufSize);
+
+    if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") !=
+            TCL_OK) {
+        DpClose(interp, chan);
+        ckfree((char *)statePtr);
+        return NULL;
+    }
+    if (Tcl_SetChannelOption(interp, chan, "-blocking", "1") !=
+            TCL_OK) {
+        DpClose(interp, chan);
+        ckfree((char *)statePtr);
+	return NULL;
+    }
+    if (Tcl_SetChannelOption(interp, chan, "-buffering", "none") !=
+            TCL_OK) {
+        DpClose(interp, chan);
+        ckfree((char *)statePtr);
+        return NULL;
+    }
+
+    return chan;
+
+arg_missing:
+    Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", NULL);
+    return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpWatch --
+ *
+ *	Gives a short overview (a few sentences), what other
+ *	functions are related to this one.
+ *
+ *	All changes to the module made that decrease resource usage,
+ *	but make the function harder to understand, modify, and debug.
+ *
+ * Results:
+ *	Description of return values.
+ *
+ * Side effects:
+ *	Global variables touched.
+ *	I/O operations performed.
+ *	Delayed effects.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+UdpWatch (instanceData, mask)
+    ClientData instanceData;
+    int mask;
+{
+    UdpState *infoPtr = (UdpState *) instanceData;
+
+    Tcl_WatchFile(infoPtr->sockFile, mask);
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpReady --
+ *
+ *	Gives a short overview (a few sentences), what other
+ *	functions are related to this one.
+ *
+ *	All changes to the module made that decrease resource usage,
+ *	but make the function harder to understand, modify, and debug.
+ *
+ * Results:
+ *	Description of return values.
+ *
+ * Side effects:
+ *	Global variables touched.
+ *	I/O operations performed.
+ *	Delayed effects.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+UdpReady (instanceData, mask)
+    ClientData instanceData;
+    int mask;
+{
+    UdpState *statePtr = (UdpState *) instanceData;
+    return Tcl_FileReady(statePtr->sockFile, mask);
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UdpGetFile --
+ *
+ *	Gives a short overview (a few sentences), what other
+ *	functions are related to this one.
+ *
+ *	All changes to the module made that decrease resource usage,
+ *	but make the function harder to understand, modify, and debug.
+ *
+ * Results:
+ *	Description of return values.
+ *
+ * Side effects:
+ *	Global variables touched.
+ *	I/O operations performed.
+ *	Delayed effects.
+ *
+ *--------------------------------------------------------------
+ */
+static Tcl_File
+UdpGetFile(instanceData, direction)
+    ClientData instanceData;
+    int direction;
+{
+    UdpState *statePtr = (UdpState *)instanceData;
+
+    return statePtr->sockFile;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DpUdpSetSocketOption --
+ *
+ *	Sets a socket option.  The allowable options for UDP
+ *	sockets are
+ *		DP_SEND_BUFFER_SIZE	(int)
+ *		DP_RECV_BUFFER_SIZE	(int)
+ *		DP_BLOCK		(T/F)
+ *
+ * Results:
+ *	Zero if the operation was successful, or a nonzero POSIX
+ *	error code if the operation failed.	
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+int
+DpUdpSetSocketOption (clientData, option, value)
+    ClientData clientData;	/* (in) UdpState structure */
+    int option;			/* (in) Option to set */
+    int value;			/* (in) new value for option */
+{
+    UdpState *statePtr = (UdpState *)clientData;
+    int sock, result;
+
+    sock = statePtr->sock;
+    switch (option) {
+        case DP_SEND_BUFFER_SIZE:
+	    result = setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&value,
+	    	   sizeof(value));
+	    break;
+
+	case DP_RECV_BUFFER_SIZE:
+	    result = setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&value,
+	    	   sizeof(value));
+	    break;
+
+	case DP_BLOCK:
+	    result = DppSetBlock (sock, value);
+	    break;
+
+	default:
+	    return EINVAL;
+    }
+
+    if (result != 0) {
+	return Tcl_GetErrno();
+    }
+    return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DpUdpGetSocketOption --
+ *
+ *	Sets a socket option.  The allowable options for UDP
+ *	sockets are
+ *		DP_SEND_BUFFER_SIZE	(int)
+ *		DP_RECV_BUFFER_SIZE	(int)
+ *	Note that we can't determine whether a socket is blocking,
+ *	so DP_BLOCK is not allowed.
+ *
+ * Results:
+ *	Zero if the operation was successful, or a nonzero POSIX
+ *	error code if the operation failed.	
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+int
+DpUdpGetSocketOption (clientData, option, valuePtr)
+    ClientData clientData;	/* (in) UdpState structure */
+    int option;			/* (in) Option to set */
+    int *valuePtr;		/* (out) current value of option */
+{
+    UdpState *statePtr = (UdpState *)clientData;
+    int sock, result, len;
+
+    sock = statePtr->sock;
+    len = sizeof(int);
+    switch (option) {
+        case DP_SEND_BUFFER_SIZE:
+	    result = getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)valuePtr,
+	    	   &len);
+	    break;
+
+	case DP_RECV_BUFFER_SIZE:
+	    result = getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)valuePtr,
+	    	   &len);
+	    break;
+
+	default:
+	    return EINVAL;
+    }
+
+    if (result != 0) {
+	return Tcl_GetErrno();
+    }
+    return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ *  DpCreateUdpSocket  --
+ *
+ *	Create a udp socket.
+ *
+ * Results:
+ *	A standard Tcl result.	
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+int
+DpCreateUdpSocket(interp, myIpAddr, statePtr)
+    Tcl_Interp *interp;			/* (in) For error reporting. */
+    int myIpAddr;			/* (in) IP addr of interface to use.
+    					 *   DP_INADDR_ANY = default port */
+    UdpState *statePtr;			/* (out) Pointer to local structure */
+{
+    DpSocketAddressIP sockAddr;
+    DpSocket sock;
+    int len;
+
+    sock = socket(PF_INET, SOCK_DGRAM, 0);
+    if (sock == DP_SOCKET_ERROR) {
+	goto socketError;
+    }
+    statePtr->sock = sock;
+
+    /*
+     * Bind the socket.
+     * This is a bit of a mess, but it's Berkeley sockets.  The sin_family
+     * is set to AF_INET, indicating IP addressing.  The sin_addr.s_addr 
+     * field says what interface to use.  It can be INADDR_ANY to let
+     * the system choose a default interface.  The port number can be
+     * zero (which tells the system to choose a port number) or > 1024,
+     * which is then used as the port number
+     */
+
+    memset((char *)&sockAddr, 0, sizeof(sockAddr));
+    sockAddr.sin_family = AF_INET;
+    if (myIpAddr == DP_INADDR_ANY) {
+	sockAddr.sin_addr.s_addr = INADDR_ANY; 
+    } else {
+	sockAddr.sin_addr.s_addr = htonl(myIpAddr);
+    }
+    sockAddr.sin_port = htons((unsigned short) statePtr->myPort);
+    if (bind(sock, (DpSocketAddress *)&sockAddr, sizeof(sockAddr)) ==
+	    DP_SOCKET_ERROR) {
+        goto bindError;
+    }
+
+    /*
+     * Figure out what port number we got if we let the system chose it.
+     */
+
+    if (statePtr->myPort == 0) {
+	len = sizeof(sockAddr);
+	getsockname (sock, (DpSocketAddress *)&sockAddr, &len);
+	statePtr->myPort = ntohs(sockAddr.sin_port);
+    }
+    statePtr->sockFile = Tcl_GetFile((ClientData)statePtr->sock, DP_SOCKET);
+
+    return TCL_OK;
+
+bindError:
+    DppGetErrno();
+    Tcl_AppendResult(interp, "Error binding UDP socket to port: ", 
+	    Tcl_PosixError(interp), NULL);
+    DppCloseSocket (sock);
+    return TCL_ERROR;
+
+socketError:
+    DppGetErrno();
+    Tcl_AppendResult(interp, "Error creating UDP socket: ", 
+	    Tcl_PosixError(interp), NULL);
+    return TCL_ERROR;
+}