Changed call references of 'stat(...)' to 'TclStat(...)' & 'access(...)' to

  'TclAccess(...)'.
Added the "hookable" functions 'TclStat(...)', 'TclAccess(...)', &
  'Tcl_OpenFileChannel(...)'.
Added appropriate data structure to maintain the linked list of 'TclStat(...)',
  'TclAccess(...)', & 'Tcl_OpenFileChannel(...)'.  Added the appropriate
  "insert" and "delete" routines for each of these.
A test file 'tests/iOUtil.test' has been written to test the hooking function-
  ality of each of the routines.
'tclInt.h' has been updated to include the function prototypes for all new
  functions.

1 files changed, 444 insertions, 1 deletions

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 7d4cff8..2f0ca63 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -18,7 +18,62 @@
 
 #include "tclInt.h"
 #include "tclPort.h"
+
+/*
+ * The following typedef declarations allow for hooking into the chain
+ * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
+ * 'Tcl_OpenFileChannel(...)'.  Basically for each hookable function
+ * a linked list is defined.
+ */
+
+typedef struct StatProc *StatProcPtr;
+typedef struct StatProc {
+    TclStatProc_ *proc;		/* Function to process a 'stat()' call */
+    StatProcPtr next; 		/* The next 'stat()' function to call */
+} StatProc;
 
+typedef struct AccessProc *AccessProcPtr;
+typedef struct AccessProc {
+    TclAccessProc_ *proc;	/* Function to process a 'access()' call */
+    AccessProcPtr next; 	/* The next 'access()' function to call */
+} AccessProc;
+
+typedef struct OpenFileChannelProc *OpenFileChannelProcPtr;
+typedef struct OpenFileChannelProc {
+    TclOpenFileChannelProc_ *proc; /* Function to process a
+				    * 'Tcl_OpenFileChannel()' call */
+    OpenFileChannelProcPtr next;   /* The next 'Tcl_OpenFileChannel()'
+				    * function to call */
+} OpenFileChannelProc;
+
+/*
+ * For each type of hookable function, a static node is declared to
+ * hold the function pointer for the "built-in" routine (e.g.
+ * 'TclpStat(...)') and the respective list is initialized as a pointer
+ * to that node.
+ * 
+ * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that
+ * these statically declared nodes cannot be inadvertently removed.
+ *
+ * This method avoids the need to call any sort of "initialization"
+ * function
+ */
+
+static StatProc defaultStatProc = {
+    &TclpStat, NULL
+};
+static StatProcPtr statProcList = &defaultStatProc;
+
+static AccessProc defaultAccessProc = {
+    &TclpAccess, NULL
+};
+static AccessProcPtr accessProcList = &defaultAccessProc;
+
+static OpenFileChannelProc defaultOpenFileChannelProc = {
+    &TclpOpenFileChannel, NULL
+};
+static OpenFileChannelProcPtr openFileChannelProcList =
+	&defaultOpenFileChannelProc;
 
 /*
  *----------------------------------------------------------------------
@@ -243,7 +298,7 @@ Tcl_EvalFile(interp, fileName)
 	Tcl_DStringAppend(&buffer, nativeName, -1);
 	nativeName = Tcl_DStringValue(&buffer);
     }
-    if (stat(nativeName, &statBuf) == -1) {
+    if (TclStat(nativeName, &statBuf) == -1) {
         Tcl_SetErrno(errno);
 	Tcl_AppendResult(interp, "couldn't read file \"", fileName,
 		"\": ", Tcl_PosixError(interp), (char *) NULL);
@@ -390,3 +445,391 @@ Tcl_PosixError(interp)
     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
     return msg;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStat --
+ *
+ *	This procedure replaces the library version of stat and lsat.
+ *
+ * Results:
+ *      See stat documentation.
+ *
+ * Side effects:
+ *      See stat documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStat(path, buf)
+    CONST char *path;		/* Path of file to stat (in current CP). */
+    TclStat_ *buf;		/* Filled with results of stat call. */
+{
+    StatProcPtr statProcPtr = statProcList;
+    int retVal = -1;
+
+    /*
+     * Call each of the "stat" function in succession.  A non-return
+     * value of -1 indicates the particular function has succeeded.
+     */
+
+    while ((retVal == -1) && (statProcPtr != NULL)) {
+	retVal = (*statProcPtr->proc)(path, buf);
+	statProcPtr = statProcPtr->next;
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccess --
+ *
+ *	This procedure replaces the library version of access.
+ *
+ * Results:
+ *      See access documentation.
+ *
+ * Side effects:
+ *      See access documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccess(path, mode)
+    CONST char *path;		/* Path of file to access (in current CP). */
+    int mode;                   /* Permission setting. */
+{
+    AccessProcPtr accessProcPtr = accessProcList;
+    int retVal = -1;
+
+    /*
+     * Call each of the "access" function in succession.  A non-return
+     * value of -1 indicates the particular function has succeeded.
+     */
+
+    while ((retVal == -1) && (accessProcPtr != NULL)) {
+	retVal = (*accessProcPtr->proc)(path, mode);
+	accessProcPtr = accessProcPtr->next;
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenFileChannel --
+ *
+ *      @@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+Tcl_Channel
+Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;                     /* Name of file to open. */
+    char *modeString;                   /* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;                    /* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    OpenFileChannelProcPtr openFileChannelProcPtr = openFileChannelProcList;
+    Tcl_Channel retVal = NULL;
+
+    /*
+     * Call each of the "Tcl_OpenFileChannel" function in succession.
+     * A non-NULL return value indicates the particular function has
+     * succeeded.
+     */
+
+    while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
+	retVal = (*openFileChannelProcPtr->proc)(interp, fileName,
+		modeString, permissions);
+	openFileChannelProcPtr = openFileChannelProcPtr->next;
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStatInsertProc --
+ *
+ *	@@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStatInsertProc (proc)
+    TclStatProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	StatProcPtr newStatProcPtr;
+
+	newStatProcPtr = (StatProcPtr)Tcl_Alloc(sizeof(StatProc));;
+
+	if (newStatProcPtr != NULL) {
+	    newStatProcPtr->proc = proc;
+	    newStatProcPtr->next = statProcList;
+	    statProcList = newStatProcPtr;
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStatDeleteProc --
+ *
+ *	@@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStatDeleteProc (proc)
+    TclStatProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    StatProcPtr tmpStatProcPtr = statProcList;
+    StatProcPtr prevStatProcPtr = NULL;
+
+    /*
+     * Traverse the 'statProcList' looking for the particular node
+     * whose 'proc' member matches 'proc' and remove that one from
+     * the list.  Ensure that the "default" node cannot be removed.
+     */
+
+    while ((retVal == TCL_ERROR) && (tmpStatProcPtr != &defaultStatProc)) {
+	if (tmpStatProcPtr->proc == proc) {
+	    if (prevStatProcPtr == NULL) {
+		statProcList = tmpStatProcPtr->next;
+	    } else {
+		prevStatProcPtr->next = tmpStatProcPtr->next;
+	    }
+
+	    Tcl_Free((char *)tmpStatProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevStatProcPtr = tmpStatProcPtr;
+	    tmpStatProcPtr = tmpStatProcPtr->next;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccessInsertProc --
+ *
+ *	@@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccessInsertProc(proc)
+    TclAccessProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	AccessProcPtr newAccessProcPtr;
+
+	newAccessProcPtr = (AccessProcPtr)Tcl_Alloc(sizeof(AccessProc));;
+
+	if (newAccessProcPtr != NULL) {
+	    newAccessProcPtr->proc = proc;
+	    newAccessProcPtr->next = accessProcList;
+	    accessProcList = newAccessProcPtr;
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccessDeleteProc --
+ *
+ *	@@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccessDeleteProc(proc)
+    TclAccessProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    AccessProcPtr tmpAccessProcPtr = accessProcList;
+    AccessProcPtr prevAccessProcPtr = NULL;
+
+    /*
+     * Traverse the 'accessProcList' looking for the particular node
+     * whose 'proc' member matches 'proc' and remove that one from
+     * the list.  Ensure that the "default" node cannot be removed.
+     */
+
+    while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != &defaultAccessProc)) {
+	if (tmpAccessProcPtr->proc == proc) {
+	    if (prevAccessProcPtr == NULL) {
+		accessProcList = tmpAccessProcPtr->next;
+	    } else {
+		prevAccessProcPtr->next = tmpAccessProcPtr->next;
+	    }
+
+	    Tcl_Free((char *)tmpAccessProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevAccessProcPtr = tmpAccessProcPtr;
+	    tmpAccessProcPtr = tmpAccessProcPtr->next;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOpenFileChannelInsertProc --
+ *
+ *	@@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOpenFileChannelInsertProc(proc)
+    TclOpenFileChannelProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	OpenFileChannelProcPtr newOpenFileChannelProcPtr;
+
+	newOpenFileChannelProcPtr =
+		(OpenFileChannelProcPtr)Tcl_Alloc(sizeof(OpenFileChannelProc));;
+
+	if (newOpenFileChannelProcPtr != NULL) {
+	    newOpenFileChannelProcPtr->proc = proc;
+	    newOpenFileChannelProcPtr->next = openFileChannelProcList;
+	    openFileChannelProcList = newOpenFileChannelProcPtr;
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOpenFileChannelDeleteProc --
+ *
+ *	@@@
+ *
+ * Results:
+ *      @@@
+ *
+ * Side effects:
+ *      @@@
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOpenFileChannelDeleteProc(proc)
+    TclOpenFileChannelProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    OpenFileChannelProcPtr tmpOpenFileChannelProcPtr = openFileChannelProcList;
+    OpenFileChannelProcPtr prevOpenFileChannelProcPtr = NULL;
+
+    /*
+     * Traverse the 'openFileChannelProcList' looking for the particular
+     * node whose 'proc' member matches 'proc' and remove that one from
+     * the list.  Ensure that the "default" node cannot be removed.
+     */
+
+    while ((retVal == TCL_ERROR) &&
+	    (tmpOpenFileChannelProcPtr != &defaultOpenFileChannelProc)) {
+	if (tmpOpenFileChannelProcPtr->proc == proc) {
+	    if (prevOpenFileChannelProcPtr == NULL) {
+		openFileChannelProcList = tmpOpenFileChannelProcPtr->next;
+	    } else {
+		prevOpenFileChannelProcPtr->next = tmpOpenFileChannelProcPtr->next;
+	    }
+
+	    Tcl_Free((char *)tmpOpenFileChannelProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
+	    tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->next;
+	}
+    }
+
+    return (retVal);
+}