summaryrefslogtreecommitdiffstats
path: root/win/tclWinChan.c
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-03-26 14:56:55 (GMT)
committerrjohnson <rjohnson>1998-03-26 14:56:55 (GMT)
commit72d823b9193f9ee2b0318563b49363cd08c11f24 (patch)
treec168cc164a71f320db9dcdfe7518ba7bd0d2c8d9 /win/tclWinChan.c
parent2b5738da524e944cda39e24c0a87b745a43bd8c3 (diff)
downloadtcl-72d823b9193f9ee2b0318563b49363cd08c11f24.zip
tcl-72d823b9193f9ee2b0318563b49363cd08c11f24.tar.gz
tcl-72d823b9193f9ee2b0318563b49363cd08c11f24.tar.bz2
Initial revision
Diffstat (limited to 'win/tclWinChan.c')
-rw-r--r--win/tclWinChan.c1185
1 files changed, 1185 insertions, 0 deletions
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
new file mode 100644
index 0000000..248e14b
--- /dev/null
+++ b/win/tclWinChan.c
@@ -0,0 +1,1185 @@
+/*
+ * tclWinChan.c
+ *
+ * Channel drivers for Windows channels based on files, command
+ * pipes and TCP sockets.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclWinChan.c 1.75 97/09/26 16:17:46
+ */
+
+#include "tclWinInt.h"
+
+/*
+ * This is the size of the channel name for File based channels
+ */
+
+#define CHANNEL_NAME_SIZE 64
+static char channelName[CHANNEL_NAME_SIZE+1];
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * State flags used in the info structures below.
+ */
+
+#define FILE_PENDING (1<<0) /* Message is pending in the queue. */
+#define FILE_ASYNC (1<<1) /* Channel is non-blocking. */
+#define FILE_APPEND (1<<2) /* File is in append mode. */
+
+/*
+ * The following structure contains per-instance data for a file based channel.
+ */
+
+typedef struct FileInfo {
+ Tcl_Channel channel; /* Pointer to channel structure. */
+ int validMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which operations are valid on the file. */
+ int watchMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which events should be reported. */
+ int flags; /* State flags, see above for a list. */
+ HANDLE handle; /* Input/output file. */
+ struct FileInfo *nextPtr; /* Pointer to next registered file. */
+} FileInfo;
+
+/*
+ * List of all file channels currently open.
+ */
+
+static FileInfo *firstFilePtr;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file events are generated.
+ */
+
+typedef struct FileEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ FileInfo *infoPtr; /* Pointer to file info structure. Note
+ * that we still have to verify that the
+ * file exists before dereferencing this
+ * pointer. */
+} FileEvent;
+
+/*
+ * Static routines for this file:
+ */
+
+static int ComGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ Tcl_DString *dsPtr));
+static int ComInputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ComSetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ char *value));
+static int FileBlockProc _ANSI_ARGS_((ClientData instanceData,
+ int mode));
+static void FileChannelExitHandler _ANSI_ARGS_((
+ ClientData clientData));
+static void FileCheckProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+static void FileInit _ANSI_ARGS_((void));
+static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
+ long offset, int mode, int *errorCode));
+static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+
+
+/*
+ * This structure describes the channel type structure for file based IO.
+ */
+
+static Tcl_ChannelType fileChannelType = {
+ "file", /* Type name. */
+ FileBlockProc, /* Set blocking or non-blocking mode.*/
+ FileCloseProc, /* Close proc. */
+ FileInputProc, /* Input proc. */
+ FileOutputProc, /* Output proc. */
+ FileSeekProc, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ FileWatchProc, /* Set up the notifier to watch the channel. */
+ FileGetHandleProc, /* Get an OS handle from channel. */
+};
+
+static Tcl_ChannelType comChannelType = {
+ "com", /* Type name. */
+ FileBlockProc, /* Set blocking or non-blocking mode.*/
+ FileCloseProc, /* Close proc. */
+ ComInputProc, /* Input proc. */
+ FileOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ ComSetOptionProc, /* Set option proc. */
+ ComGetOptionProc, /* Get option proc. */
+ FileWatchProc, /* Set up notifier to watch the channel. */
+ FileGetHandleProc /* Get an OS handle from channel. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInit --
+ *
+ * This function creates the window used to simulate file events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new window and creates an exit handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileInit()
+{
+ initialized = 1;
+ firstFilePtr = NULL;
+ Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+ Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileChannelExitHandler --
+ *
+ * This function is called to cleanup the channel driver before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the communication window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileChannelExitHandler(clientData)
+ ClientData clientData; /* Old window proc */
+{
+ Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSetupProc --
+ *
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ * for an event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FileSetupProc(data, flags)
+ ClientData data; /* Not used. */
+ int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ FileInfo *infoPtr;
+ Tcl_Time blockTime = { 0, 0 };
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Check to see if there is a ready file. If so, poll.
+ */
+
+ for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->watchMask) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCheckProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent to check the file
+ * event source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileCheckProc(data, flags)
+ ClientData data; /* Not used. */
+ int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ FileEvent *evPtr;
+ FileInfo *infoPtr;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Queue events for any ready files that don't already have events
+ * queued (caused by persistent states that won't generate WinSock
+ * events).
+ */
+
+ for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
+ infoPtr->flags |= FILE_PENDING;
+ evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
+ evPtr->header.proc = FileEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * FileEventProc --
+ *
+ * This function is invoked by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure invokes
+ * Tcl_NotifyChannel on the file.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ FileEvent *fileEvPtr = (FileEvent *)evPtr;
+ FileInfo *infoPtr;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the list of watched files for the one whose handle
+ * matches the event. We do this rather than simply dereferencing
+ * the handle in the event so that files can be deleted while the
+ * event is in the queue.
+ */
+
+ for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (fileEvPtr->infoPtr == infoPtr) {
+ infoPtr->flags &= ~(FILE_PENDING);
+ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
+ break;
+ }
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockProc --
+ *
+ * Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ * 0 if successful, errno when failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileBlockProc(instanceData, mode)
+ ClientData instanceData; /* Instance data for channel. */
+ int mode; /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+
+ /*
+ * Files on Windows can not be switched between blocking and nonblocking,
+ * hence we have to emulate the behavior. This is done in the input
+ * function by checking against a bit in the state. We set or unset the
+ * bit here to cause the input function to emulate the correct behavior.
+ */
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= FILE_ASYNC;
+ } else {
+ infoPtr->flags &= ~(FILE_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCloseProc --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * 0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ * Closes the physical channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileCloseProc(instanceData, interp)
+ ClientData instanceData; /* Pointer to FileInfo structure. */
+ Tcl_Interp *interp; /* Not used. */
+{
+ FileInfo *fileInfoPtr = (FileInfo *) instanceData;
+ FileInfo **nextPtrPtr;
+ int errorCode = 0;
+
+ /*
+ * Remove the file from the watch list.
+ */
+
+ FileWatchProc(instanceData, 0);
+
+ if (CloseHandle(fileInfoPtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
+ for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+ nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+ if ((*nextPtrPtr) == fileInfoPtr) {
+ (*nextPtrPtr) = fileInfoPtr->nextPtr;
+ break;
+ }
+ }
+ ckfree((char *)fileInfoPtr);
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeekProc --
+ *
+ * Seeks on a file-based channel. Returns the new position.
+ *
+ * Results:
+ * -1 if failed, the new position if successful. If failed, it
+ * also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ * Moves the location at which the channel will be accessed in
+ * future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileSeekProc(instanceData, offset, mode, errorCodePtr)
+ ClientData instanceData; /* File state. */
+ long offset; /* Offset to seek to. */
+ int mode; /* Relative to where
+ * should we seek? */
+ int *errorCodePtr; /* To store error code. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ DWORD moveMethod;
+ DWORD newPos;
+
+ *errorCodePtr = 0;
+ if (mode == SEEK_SET) {
+ moveMethod = FILE_BEGIN;
+ } else if (mode == SEEK_CUR) {
+ moveMethod = FILE_CURRENT;
+ } else {
+ moveMethod = FILE_END;
+ }
+
+ newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
+ if (newPos == 0xFFFFFFFF) {
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ return newPos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInputProc --
+ *
+ * Reads input from the IO channel into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileInputProc(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* File state. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ FileInfo *infoPtr;
+ DWORD bytesRead;
+
+ *errorCode = 0;
+ infoPtr = (FileInfo *) instanceData;
+
+ /*
+ * Note that we will block on reads from a console buffer until a
+ * full line has been entered. The only way I know of to get
+ * around this is to write a console driver. We should probably
+ * do this at some point, but for now, we just block. The same
+ * problem exists for files being read over the network.
+ */
+
+ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ (LPOVERLAPPED) NULL) != FALSE) {
+ return bytesRead;
+ }
+
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ if (errno == EPIPE) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileOutputProc --
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileOutputProc(instanceData, buf, toWrite, errorCode)
+ ClientData instanceData; /* File state. */
+ char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCode; /* Where to store error code. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ DWORD bytesWritten;
+
+ *errorCode = 0;
+
+ /*
+ * If we are writing to a file that was opened with O_APPEND, we need to
+ * seek to the end of the file before writing the current buffer.
+ */
+
+ if (infoPtr->flags & FILE_APPEND) {
+ SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
+ }
+
+ if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
+ (LPOVERLAPPED) NULL) == FALSE) {
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
+ }
+ FlushFileBuffers(infoPtr->handle);
+ return bytesWritten;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWatchProc --
+ *
+ * Called by the notifier to set up to watch for events on this
+ * channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileWatchProc(instanceData, mask)
+ ClientData instanceData; /* File state. */
+ int mask; /* What events to watch for; OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ Tcl_Time blockTime = { 0, 0 };
+
+ /*
+ * Since the file is always ready for events, we set the block time
+ * to zero so we will poll.
+ */
+
+ infoPtr->watchMask = mask & infoPtr->validMask;
+ if (infoPtr->watchMask) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileGetHandleProc --
+ *
+ * Called from Tcl_GetChannelFile to retrieve OS handles from
+ * a file based channel.
+ *
+ * Results:
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ * there is no handle for the specified direction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileGetHandleProc(instanceData, direction, handlePtr)
+ ClientData instanceData; /* The file state. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr; /* Where to store the handle. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+
+ if (direction & infoPtr->validMask) {
+ *handlePtr = (ClientData) infoPtr->handle;
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComInputProc --
+ *
+ * Reads input from the IO channel into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComInputProc(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* File state. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ FileInfo *infoPtr;
+ DWORD bytesRead;
+ DWORD dw;
+ COMSTAT cs;
+
+ *errorCode = 0;
+ infoPtr = (FileInfo *) instanceData;
+
+ if (ClearCommError(infoPtr->handle, &dw, &cs)) {
+ if (dw != 0) {
+ *errorCode = EIO;
+ return -1;
+ }
+ if (cs.cbInQue != 0) {
+ if ((DWORD) bufSize > cs.cbInQue) {
+ bufSize = cs.cbInQue;
+ }
+ } else {
+ if (infoPtr->flags & FILE_ASYNC) {
+ errno = *errorCode = EAGAIN;
+ return -1;
+ } else {
+ bufSize = 1;
+ }
+ }
+ }
+
+ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ (LPOVERLAPPED) NULL) == FALSE) {
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
+ }
+
+ return bytesRead;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComSetOptionProc --
+ *
+ * Sets an option on a channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets interp->result on error if
+ * interp is not NULL.
+ *
+ * Side effects:
+ * May modify an option on a device.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComSetOptionProc(instanceData, interp, optionName, value)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Which option to set? */
+ char *value; /* New value for option. */
+{
+ FileInfo *infoPtr;
+ DCB dcb;
+ int len;
+
+ infoPtr = (FileInfo *) instanceData;
+
+ len = strlen(optionName);
+ if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
+ if (GetCommState(infoPtr->handle, &dcb)) {
+ if ((BuildCommDCB(value, &dcb) == FALSE) ||
+ (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
+ /*
+ * one should separate the 2 errors...
+ */
+ if (interp) {
+ Tcl_AppendResult(interp, "bad value for -mode: should be ",
+ "baud,parity,data,stop", NULL);
+ }
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
+ }
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComGetOptionProc --
+ *
+ * Gets a mode associated with an IO channel. If the optionName arg
+ * is non NULL, retrieves the value of that option. If the optionName
+ * arg is NULL, retrieves a list of alternating option names and
+ * values for the given channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets the supplied DString to the
+ * string value of the option(s) returned.
+ *
+ * Side effects:
+ * The string returned by this function is in static storage and
+ * may be reused at any time subsequent to the call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComGetOptionProc(instanceData, interp, optionName, dsPtr)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Option to get. */
+ Tcl_DString *dsPtr; /* Where to store value(s). */
+{
+ FileInfo *infoPtr;
+ DCB dcb;
+ int len;
+
+ infoPtr = (FileInfo *) instanceData;
+
+ if (optionName == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "-mode");
+ len = 0;
+ } else {
+ len = strlen(optionName);
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+ if (GetCommState(infoPtr->handle, &dcb) == 0) {
+ /*
+ * shouldn't we flag an error instead ?
+ */
+ Tcl_DStringAppendElement(dsPtr, "");
+ } else {
+ char parity;
+ char *stop;
+ char buf[32];
+
+ parity = 'n';
+ if (dcb.Parity < 4) {
+ parity = "noems"[dcb.Parity];
+ }
+
+ stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
+ (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
+
+ wsprintf(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
+ stop);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ return TCL_OK;
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenFileChannel --
+ *
+ * Open an File based channel on Unix systems.
+ *
+ * Results:
+ * The new channel or NULL. If NULL, the output argument
+ * errorCodePtr is set to a POSIX error.
+ *
+ * Side effects:
+ * May open the channel and may cause creation of a file on the
+ * file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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? */
+{
+ FileInfo *infoPtr;
+ int seekFlag, mode, channelPermissions;
+ DWORD accessMode, createMode, shareMode, flags;
+ char *nativeName;
+ Tcl_DString buffer;
+ DCB dcb;
+ Tcl_ChannelType *channelTypePtr;
+ HANDLE handle;
+
+ if (!initialized) {
+ FileInit();
+ }
+
+ mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ if (mode == -1) {
+ return NULL;
+ }
+
+ nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (nativeName == NULL) {
+ return NULL;
+ }
+
+ switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+ case O_RDONLY:
+ accessMode = GENERIC_READ;
+ channelPermissions = TCL_READABLE;
+ break;
+ case O_WRONLY:
+ accessMode = GENERIC_WRITE;
+ channelPermissions = TCL_WRITABLE;
+ break;
+ case O_RDWR:
+ accessMode = (GENERIC_READ | GENERIC_WRITE);
+ channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+ break;
+ default:
+ panic("Tcl_OpenFileChannel: invalid mode value");
+ break;
+ }
+
+ /*
+ * Map the creation flags to the NT create mode.
+ */
+
+ switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
+ case (O_CREAT | O_EXCL):
+ case (O_CREAT | O_EXCL | O_TRUNC):
+ createMode = CREATE_NEW;
+ break;
+ case (O_CREAT | O_TRUNC):
+ createMode = CREATE_ALWAYS;
+ break;
+ case O_CREAT:
+ createMode = OPEN_ALWAYS;
+ break;
+ case O_TRUNC:
+ case (O_TRUNC | O_EXCL):
+ createMode = TRUNCATE_EXISTING;
+ break;
+ default:
+ createMode = OPEN_EXISTING;
+ break;
+ }
+
+ /*
+ * If the file is being created, get the file attributes from the
+ * permissions argument, else use the existing file attributes.
+ */
+
+ if (mode & O_CREAT) {
+ if (permissions & S_IWRITE) {
+ flags = FILE_ATTRIBUTE_NORMAL;
+ } else {
+ flags = FILE_ATTRIBUTE_READONLY;
+ }
+ } else {
+ flags = GetFileAttributes(nativeName);
+ if (flags == 0xFFFFFFFF) {
+ flags = 0;
+ }
+ }
+
+ /*
+ * Set up the file sharing mode. We want to allow simultaneous access.
+ */
+
+ shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
+
+ /*
+ * Now we get to create the file.
+ */
+
+ handle = CreateFile(nativeName, accessMode, shareMode, NULL, createMode,
+ flags, (HANDLE) NULL);
+
+ if (handle == INVALID_HANDLE_VALUE) {
+ DWORD err;
+
+ openerr:
+ err = GetLastError();
+ if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
+ err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
+ }
+ TclWinConvertError(err);
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ Tcl_DStringFree(&buffer);
+ return NULL;
+ }
+
+ if (GetFileType(handle) == FILE_TYPE_CHAR) {
+ dcb.DCBlength = sizeof( DCB ) ;
+ if (GetCommState(handle, &dcb)) {
+ /*
+ * This is a com port. Reopen it with the correct modes.
+ */
+
+ COMMTIMEOUTS cto;
+
+ CloseHandle(handle);
+ handle = CreateFile(nativeName, accessMode, 0, NULL, OPEN_EXISTING,
+ flags, NULL);
+ if (handle == INVALID_HANDLE_VALUE) {
+ goto openerr;
+ }
+
+ /*
+ * FileInit the com port.
+ */
+
+ SetCommMask(handle, EV_RXCHAR);
+ SetupComm(handle, 4096, 4096);
+ PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
+ | PURGE_RXCLEAR);
+ cto.ReadIntervalTimeout = MAXDWORD;
+ cto.ReadTotalTimeoutMultiplier = 0;
+ cto.ReadTotalTimeoutConstant = 0;
+ cto.WriteTotalTimeoutMultiplier = 0;
+ cto.WriteTotalTimeoutConstant = 0;
+ SetCommTimeouts(handle, &cto);
+
+ GetCommState(handle, &dcb);
+ SetCommState(handle, &dcb);
+ channelTypePtr = &comChannelType;
+ } else {
+ channelTypePtr = &fileChannelType;
+ }
+ } else {
+ channelTypePtr = &fileChannelType;
+ }
+ Tcl_DStringFree(&buffer);
+
+ infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+ infoPtr->nextPtr = firstFilePtr;
+ firstFilePtr = infoPtr;
+ infoPtr->validMask = channelPermissions;
+ infoPtr->watchMask = 0;
+ infoPtr->flags = (mode & O_APPEND) ? FILE_APPEND : 0;
+ infoPtr->handle = handle;
+
+ sprintf(channelName, "file%d", (int) handle);
+
+ infoPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+ (ClientData) infoPtr, channelPermissions);
+
+ if (seekFlag) {
+ if (Tcl_Seek(infoPtr->channel, 0, SEEK_END) < 0) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "could not seek to end of file on \"",
+ channelName, "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
+ }
+ Tcl_Close(NULL, infoPtr->channel);
+ return NULL;
+ }
+ }
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be appended to them at close.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+ return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeFileChannel --
+ *
+ * Creates a Tcl_Channel from an existing platform specific file
+ * handle.
+ *
+ * Results:
+ * The Tcl_Channel created around the preexisting file.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeFileChannel(handle, mode)
+ ClientData handle; /* OS level handle */
+ int mode; /* ORed combination of TCL_READABLE and
+ * TCL_WRITABLE to indicate file mode. */
+{
+ char channelName[20];
+ FileInfo *infoPtr;
+
+ if (!initialized) {
+ FileInit();
+ }
+
+ if (mode == 0) {
+ return NULL;
+ }
+
+ sprintf(channelName, "file%d", (int) handle);
+
+ /*
+ * See if a channel with this handle already exists.
+ */
+
+ for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->handle == (HANDLE) handle) {
+ return (mode == infoPtr->validMask) ? infoPtr->channel : NULL;
+ }
+ }
+
+ infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+ infoPtr->nextPtr = firstFilePtr;
+ firstFilePtr = infoPtr;
+ infoPtr->validMask = mode;
+ infoPtr->watchMask = 0;
+ infoPtr->flags = 0;
+ infoPtr->handle = (HANDLE) handle;
+ infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
+ (ClientData) infoPtr, mode);
+
+ /*
+ * Windows files have AUTO translation mode and ^Z eof char on input.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+ return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetDefaultStdChannel --
+ *
+ * Constructs a channel for the specified standard OS handle.
+ *
+ * Results:
+ * Returns the specified default standard channel, or NULL.
+ *
+ * Side effects:
+ * May cause the creation of a standard channel and the underlying
+ * file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclGetDefaultStdChannel(type)
+ int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+ Tcl_Channel channel;
+ HANDLE handle;
+ int mode;
+ char *bufMode;
+ DWORD handleId; /* Standard handle to retrieve. */
+
+ switch (type) {
+ case TCL_STDIN:
+ handleId = STD_INPUT_HANDLE;
+ mode = TCL_READABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDOUT:
+ handleId = STD_OUTPUT_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDERR:
+ handleId = STD_ERROR_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "none";
+ break;
+ default:
+ panic("TclGetDefaultStdChannel: Unexpected channel type");
+ break;
+ }
+ handle = GetStdHandle(handleId);
+
+ /*
+ * Note that we need to check for 0 because Windows will return 0 if this
+ * is not a console mode application, even though this is not a valid
+ * handle.
+ */
+
+ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
+ return NULL;
+ }
+
+ channel = Tcl_MakeFileChannel(handle, mode);
+
+ /*
+ * Set up the normal channel options for stdio handles.
+ */
+
+ if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
+ "auto") == TCL_ERROR)
+ || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
+ "\032 {}") == TCL_ERROR)
+ || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
+ "-buffering", bufMode) == TCL_ERROR)) {
+ Tcl_Close((Tcl_Interp *) NULL, channel);
+ return (Tcl_Channel) NULL;
+ }
+ return channel;
+}