sl@0: /* 
sl@0:  * tclWinChan.c
sl@0:  *
sl@0:  *	Channel drivers for Windows channels based on files, command
sl@0:  *	pipes and TCP sockets.
sl@0:  *
sl@0:  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclWinChan.c,v 1.30.2.5 2006/08/30 17:53:28 hobbs Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclWinInt.h"
sl@0: #include "tclIO.h"
sl@0: 
sl@0: /*
sl@0:  * State flags used in the info structures below.
sl@0:  */
sl@0: 
sl@0: #define FILE_PENDING	(1<<0)	/* Message is pending in the queue. */
sl@0: #define FILE_ASYNC	(1<<1)	/* Channel is non-blocking. */
sl@0: #define FILE_APPEND	(1<<2)	/* File is in append mode. */
sl@0: 
sl@0: #define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
sl@0: #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
sl@0: 
sl@0: /*
sl@0:  * The following structure contains per-instance data for a file based channel.
sl@0:  */
sl@0: 
sl@0: typedef struct FileInfo {
sl@0:     Tcl_Channel channel;	/* Pointer to channel structure. */
sl@0:     int validMask;		/* OR'ed combination of TCL_READABLE,
sl@0: 				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0: 				 * which operations are valid on the file. */
sl@0:     int watchMask;		/* OR'ed combination of TCL_READABLE,
sl@0: 				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0: 				 * which events should be reported. */
sl@0:     int flags;			/* State flags, see above for a list. */
sl@0:     HANDLE handle;		/* Input/output file. */
sl@0:     struct FileInfo *nextPtr;	/* Pointer to next registered file. */
sl@0:     int dirty;                  /* Boolean flag. Set if the OS may have data
sl@0: 				 * pending on the channel */
sl@0: } FileInfo;
sl@0: 
sl@0: typedef struct ThreadSpecificData {
sl@0:     /*
sl@0:      * List of all file channels currently open.
sl@0:      */
sl@0: 
sl@0:     FileInfo *firstFilePtr;
sl@0: } ThreadSpecificData;
sl@0: 
sl@0: static Tcl_ThreadDataKey dataKey;
sl@0: 
sl@0: /*
sl@0:  * The following structure is what is added to the Tcl event queue when
sl@0:  * file events are generated.
sl@0:  */
sl@0: 
sl@0: typedef struct FileEvent {
sl@0:     Tcl_Event header;		/* Information that is standard for
sl@0: 				 * all events. */
sl@0:     FileInfo *infoPtr;		/* Pointer to file info structure.  Note
sl@0: 				 * that we still have to verify that the
sl@0: 				 * file exists before dereferencing this
sl@0: 				 * pointer. */
sl@0: } FileEvent;
sl@0: 
sl@0: /*
sl@0:  * Static routines for this file:
sl@0:  */
sl@0: 
sl@0: static int		FileBlockProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 			    int mode));
sl@0: static void		FileChannelExitHandler _ANSI_ARGS_((
sl@0: 		            ClientData clientData));
sl@0: static void		FileCheckProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    int flags));
sl@0: static int		FileCloseProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 		            Tcl_Interp *interp));
sl@0: static int		FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr, 
sl@0: 			    int flags));
sl@0: static int		FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 		            int direction, ClientData *handlePtr));
sl@0: static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
sl@0: static int		FileInputProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 	            	    char *buf, int toRead, int *errorCode));
sl@0: static int		FileOutputProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 			    CONST char *buf, int toWrite, int *errorCode));
sl@0: static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 			    long offset, int mode, int *errorCode));
sl@0: static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 			    Tcl_WideInt offset, int mode, int *errorCode));
sl@0: static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    int flags));
sl@0: static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
sl@0: 		            int mask));
sl@0: static void             FileThreadActionProc _ANSI_ARGS_ ((
sl@0: 			   ClientData instanceData, int action));
sl@0: static DWORD		FileGetType _ANSI_ARGS_((HANDLE handle));
sl@0: 
sl@0: /*
sl@0:  * This structure describes the channel type structure for file based IO.
sl@0:  */
sl@0: 
sl@0: static Tcl_ChannelType fileChannelType = {
sl@0:     "file",			/* Type name. */
sl@0:     TCL_CHANNEL_VERSION_4,	/* v4 channel */
sl@0:     FileCloseProc,		/* Close proc. */
sl@0:     FileInputProc,		/* Input proc. */
sl@0:     FileOutputProc,		/* Output proc. */
sl@0:     FileSeekProc,		/* Seek proc. */
sl@0:     NULL,			/* Set option proc. */
sl@0:     NULL,			/* Get option proc. */
sl@0:     FileWatchProc,		/* Set up the notifier to watch the channel. */
sl@0:     FileGetHandleProc,		/* Get an OS handle from channel. */
sl@0:     NULL,			/* close2proc. */
sl@0:     FileBlockProc,		/* Set blocking or non-blocking mode.*/
sl@0:     NULL,			/* flush proc. */
sl@0:     NULL,			/* handler proc. */
sl@0:     FileWideSeekProc,		/* Wide seek proc. */
sl@0:     FileThreadActionProc,	/* Thread action proc. */
sl@0: };
sl@0: 
sl@0: #ifdef HAVE_NO_SEH
sl@0: 
sl@0: /*
sl@0:  * Unlike Borland and Microsoft, we don't register exception handlers
sl@0:  * by pushing registration records onto the runtime stack.  Instead, we
sl@0:  * register them by creating an EXCEPTION_REGISTRATION within the activation
sl@0:  * record.
sl@0:  */
sl@0: 
sl@0: typedef struct EXCEPTION_REGISTRATION {
sl@0:     struct EXCEPTION_REGISTRATION* link;
sl@0:     EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
sl@0: 				      struct _CONTEXT*, void* );
sl@0:     void* ebp;
sl@0:     void* esp;
sl@0:     int status;
sl@0: } EXCEPTION_REGISTRATION;
sl@0: 
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileInit --
sl@0:  *
sl@0:  *	This function creates the window used to simulate file events.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Creates a new window and creates an exit handler. 
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static ThreadSpecificData *
sl@0: FileInit()
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr =
sl@0: 	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
sl@0:     if (tsdPtr == NULL) {
sl@0: 	tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 	tsdPtr->firstFilePtr = NULL;
sl@0: 	Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
sl@0: 	Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
sl@0:     }
sl@0:     return tsdPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileChannelExitHandler --
sl@0:  *
sl@0:  *	This function is called to cleanup the channel driver before
sl@0:  *	Tcl is unloaded.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Destroys the communication window.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: FileChannelExitHandler(clientData)
sl@0:     ClientData clientData;	/* Old window proc */
sl@0: {
sl@0:     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileSetupProc --
sl@0:  *
sl@0:  *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
sl@0:  *	for an event.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Adjusts the block time if needed.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: FileSetupProc(data, flags)
sl@0:     ClientData data;		/* Not used. */
sl@0:     int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
sl@0: {
sl@0:     FileInfo *infoPtr;
sl@0:     Tcl_Time blockTime = { 0, 0 };
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     if (!(flags & TCL_FILE_EVENTS)) {
sl@0: 	return;
sl@0:     }
sl@0:     
sl@0:     /*
sl@0:      * Check to see if there is a ready file.  If so, poll.
sl@0:      */
sl@0: 
sl@0:     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0: 	    infoPtr = infoPtr->nextPtr) {
sl@0: 	if (infoPtr->watchMask) {
sl@0: 	    Tcl_SetMaxBlockTime(&blockTime);
sl@0: 	    break;
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileCheckProc --
sl@0:  *
sl@0:  *	This procedure is called by Tcl_DoOneEvent to check the file
sl@0:  *	event source for events. 
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May queue an event.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: FileCheckProc(data, flags)
sl@0:     ClientData data;		/* Not used. */
sl@0:     int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
sl@0: {
sl@0:     FileEvent *evPtr;
sl@0:     FileInfo *infoPtr;
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     if (!(flags & TCL_FILE_EVENTS)) {
sl@0: 	return;
sl@0:     }
sl@0:     
sl@0:     /*
sl@0:      * Queue events for any ready files that don't already have events
sl@0:      * queued (caused by persistent states that won't generate WinSock
sl@0:      * events).
sl@0:      */
sl@0: 
sl@0:     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0: 	    infoPtr = infoPtr->nextPtr) {
sl@0: 	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
sl@0: 	    infoPtr->flags |= FILE_PENDING;
sl@0: 	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
sl@0: 	    evPtr->header.proc = FileEventProc;
sl@0: 	    evPtr->infoPtr = infoPtr;
sl@0: 	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileEventProc --
sl@0:  *
sl@0:  *	This function is invoked by Tcl_ServiceEvent when a file event
sl@0:  *	reaches the front of the event queue.  This procedure invokes
sl@0:  *	Tcl_NotifyChannel on the file.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns 1 if the event was handled, meaning it should be removed
sl@0:  *	from the queue.  Returns 0 if the event was not handled, meaning
sl@0:  *	it should stay on the queue.  The only time the event isn't
sl@0:  *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Whatever the notifier callback does.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileEventProc(evPtr, flags)
sl@0:     Tcl_Event *evPtr;		/* Event to service. */
sl@0:     int flags;			/* Flags that indicate what events to
sl@0: 				 * handle, such as TCL_FILE_EVENTS. */
sl@0: {
sl@0:     FileEvent *fileEvPtr = (FileEvent *)evPtr;
sl@0:     FileInfo *infoPtr;
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     if (!(flags & TCL_FILE_EVENTS)) {
sl@0: 	return 0;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Search through the list of watched files for the one whose handle
sl@0:      * matches the event.  We do this rather than simply dereferencing
sl@0:      * the handle in the event so that files can be deleted while the
sl@0:      * event is in the queue.
sl@0:      */
sl@0: 
sl@0:     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
sl@0: 	    infoPtr = infoPtr->nextPtr) {
sl@0: 	if (fileEvPtr->infoPtr == infoPtr) {
sl@0: 	    infoPtr->flags &= ~(FILE_PENDING);
sl@0: 	    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
sl@0: 	    break;
sl@0: 	}
sl@0:     }
sl@0:     return 1;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileBlockProc --
sl@0:  *
sl@0:  *	Set blocking or non-blocking mode on channel.
sl@0:  *
sl@0:  * Results:
sl@0:  *	0 if successful, errno when failed.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Sets the device into blocking or non-blocking mode.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileBlockProc(instanceData, mode)
sl@0:     ClientData instanceData;	/* Instance data for channel. */
sl@0:     int mode;			/* TCL_MODE_BLOCKING or
sl@0:                                  * TCL_MODE_NONBLOCKING. */
sl@0: {
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0:     
sl@0:     /*
sl@0:      * Files on Windows can not be switched between blocking and nonblocking,
sl@0:      * hence we have to emulate the behavior. This is done in the input
sl@0:      * function by checking against a bit in the state. We set or unset the
sl@0:      * bit here to cause the input function to emulate the correct behavior.
sl@0:      */
sl@0: 
sl@0:     if (mode == TCL_MODE_NONBLOCKING) {
sl@0: 	infoPtr->flags |= FILE_ASYNC;
sl@0:     } else {
sl@0: 	infoPtr->flags &= ~(FILE_ASYNC);
sl@0:     }
sl@0:     return 0;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileCloseProc --
sl@0:  *
sl@0:  *	Closes the IO channel.
sl@0:  *
sl@0:  * Results:
sl@0:  *	0 if successful, the value of errno if failed.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Closes the physical channel
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileCloseProc(instanceData, interp)
sl@0:     ClientData instanceData;	/* Pointer to FileInfo structure. */
sl@0:     Tcl_Interp *interp;		/* Not used. */
sl@0: {
sl@0:     FileInfo *fileInfoPtr = (FileInfo *) instanceData;
sl@0:     FileInfo *infoPtr;
sl@0:     ThreadSpecificData *tsdPtr;
sl@0:     int errorCode = 0;
sl@0: 
sl@0:     /*
sl@0:      * Remove the file from the watch list.
sl@0:      */
sl@0: 
sl@0:     FileWatchProc(instanceData, 0);
sl@0: 
sl@0:     /*
sl@0:      * Don't close the Win32 handle if the handle is a standard channel
sl@0:      * during the thread exit process.  Otherwise, one thread may kill
sl@0:      * the stdio of another.
sl@0:      */
sl@0: 
sl@0:     if (!TclInThreadExit() 
sl@0: 	    || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
sl@0: 		&& (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
sl@0: 		&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
sl@0: 	if (CloseHandle(fileInfoPtr->handle) == FALSE) {
sl@0: 	    TclWinConvertError(GetLastError());
sl@0: 	    errorCode = errno;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * See if this FileInfo* is still on the thread local list.
sl@0:      */
sl@0:     tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0:     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0: 	    infoPtr = infoPtr->nextPtr) {
sl@0: 	if (infoPtr == fileInfoPtr) {
sl@0:             /*
sl@0:              * This channel exists on the thread local list. It should
sl@0:              * have been removed by an earlier Thread Action call,
sl@0:              * but do that now since just deallocating fileInfoPtr would
sl@0:              * leave an deallocated pointer on the thread local list.
sl@0:              */
sl@0: 	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
sl@0:             break;
sl@0:         }
sl@0:     }
sl@0:     ckfree((char *)fileInfoPtr);
sl@0:     return errorCode;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileSeekProc --
sl@0:  *
sl@0:  *	Seeks on a file-based channel. Returns the new position.
sl@0:  *
sl@0:  * Results:
sl@0:  *	-1 if failed, the new position if successful. If failed, it
sl@0:  *	also sets *errorCodePtr to the error code.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Moves the location at which the channel will be accessed in
sl@0:  *	future operations.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileSeekProc(instanceData, offset, mode, errorCodePtr)
sl@0:     ClientData instanceData;	/* File state. */
sl@0:     long offset;		/* Offset to seek to. */
sl@0:     int mode;			/* Relative to where should we seek? */
sl@0:     int *errorCodePtr;		/* To store error code. */
sl@0: {
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0:     DWORD moveMethod;
sl@0:     DWORD newPos, newPosHigh;
sl@0:     DWORD oldPos, oldPosHigh;
sl@0: 
sl@0:     *errorCodePtr = 0;
sl@0:     if (mode == SEEK_SET) {
sl@0:         moveMethod = FILE_BEGIN;
sl@0:     } else if (mode == SEEK_CUR) {
sl@0:         moveMethod = FILE_CURRENT;
sl@0:     } else {
sl@0:         moveMethod = FILE_END;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Save our current place in case we need to roll-back the seek.
sl@0:      */
sl@0:     oldPosHigh = (DWORD)0;
sl@0:     oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
sl@0: 	    FILE_CURRENT);
sl@0:     if (oldPos == INVALID_SET_FILE_POINTER) {
sl@0: 	DWORD winError = GetLastError();
sl@0: 	if (winError != NO_ERROR) {
sl@0: 	    TclWinConvertError(winError);
sl@0: 	    *errorCodePtr = errno;
sl@0: 	    return -1;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
sl@0:     newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
sl@0: 			    moveMethod);
sl@0:     if (newPos == INVALID_SET_FILE_POINTER) {
sl@0: 	DWORD winError = GetLastError();
sl@0: 	if (winError != NO_ERROR) {
sl@0: 	    TclWinConvertError(winError);
sl@0: 	    *errorCodePtr = errno;
sl@0: 	    return -1;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Check for expressability in our return type, and roll-back otherwise.
sl@0:      */
sl@0:     if (newPosHigh != 0) {
sl@0: 	*errorCodePtr = EOVERFLOW;
sl@0: 	SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
sl@0: 	return -1;
sl@0:     }
sl@0:     return (int) newPos;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileWideSeekProc --
sl@0:  *
sl@0:  *	Seeks on a file-based channel. Returns the new position.
sl@0:  *
sl@0:  * Results:
sl@0:  *	-1 if failed, the new position if successful. If failed, it
sl@0:  *	also sets *errorCodePtr to the error code.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Moves the location at which the channel will be accessed in
sl@0:  *	future operations.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static Tcl_WideInt
sl@0: FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
sl@0:     ClientData instanceData;	/* File state. */
sl@0:     Tcl_WideInt offset;		/* Offset to seek to. */
sl@0:     int mode;			/* Relative to where should we seek? */
sl@0:     int *errorCodePtr;		/* To store error code. */
sl@0: {
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0:     DWORD moveMethod;
sl@0:     DWORD newPos, newPosHigh;
sl@0: 
sl@0:     *errorCodePtr = 0;
sl@0:     if (mode == SEEK_SET) {
sl@0:         moveMethod = FILE_BEGIN;
sl@0:     } else if (mode == SEEK_CUR) {
sl@0:         moveMethod = FILE_CURRENT;
sl@0:     } else {
sl@0:         moveMethod = FILE_END;
sl@0:     }
sl@0: 
sl@0:     newPosHigh = (DWORD)(offset >> 32);
sl@0:     newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
sl@0: 			    moveMethod);
sl@0:     if (newPos == INVALID_SET_FILE_POINTER) {
sl@0: 	DWORD winError = GetLastError();
sl@0: 	if (winError != NO_ERROR) {
sl@0: 	    TclWinConvertError(winError);
sl@0: 	    *errorCodePtr = errno;
sl@0: 	    return -1;
sl@0: 	}
sl@0:     }
sl@0:     return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileInputProc --
sl@0:  *
sl@0:  *	Reads input from the IO channel into the buffer given. Returns
sl@0:  *	count of how many bytes were actually read, and an error indication.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A count of how many bytes were read is returned and an error
sl@0:  *	indication is returned in an output argument.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Reads input from the actual channel.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileInputProc(instanceData, buf, bufSize, errorCode)
sl@0:     ClientData instanceData;		/* File state. */
sl@0:     char *buf;				/* Where to store data read. */
sl@0:     int bufSize;			/* How much space is available
sl@0:                                          * in the buffer? */
sl@0:     int *errorCode;			/* Where to store error code. */
sl@0: {
sl@0:     FileInfo *infoPtr;
sl@0:     DWORD bytesRead;
sl@0: 
sl@0:     *errorCode = 0;
sl@0:     infoPtr = (FileInfo *) instanceData;
sl@0: 
sl@0:     /*
sl@0:      * Note that we will block on reads from a console buffer until a
sl@0:      * full line has been entered.  The only way I know of to get
sl@0:      * around this is to write a console driver.  We should probably
sl@0:      * do this at some point, but for now, we just block.  The same
sl@0:      * problem exists for files being read over the network.
sl@0:      */
sl@0: 
sl@0:     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
sl@0:             (LPOVERLAPPED) NULL) != FALSE) {
sl@0: 	return bytesRead;
sl@0:     }
sl@0:     
sl@0:     TclWinConvertError(GetLastError());
sl@0:     *errorCode = errno;
sl@0:     if (errno == EPIPE) {
sl@0: 	return 0;
sl@0:     }
sl@0:     return -1;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileOutputProc --
sl@0:  *
sl@0:  *	Writes the given output on the IO channel. Returns count of how
sl@0:  *	many characters were actually written, and an error indication.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A count of how many characters were written is returned and an
sl@0:  *	error indication is returned in an output argument.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Writes output on the actual channel.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileOutputProc(instanceData, buf, toWrite, errorCode)
sl@0:     ClientData instanceData;		/* File state. */
sl@0:     CONST char *buf;			/* The data buffer. */
sl@0:     int toWrite;			/* How many bytes to write? */
sl@0:     int *errorCode;			/* Where to store error code. */
sl@0: {
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0:     DWORD bytesWritten;
sl@0:     
sl@0:     *errorCode = 0;
sl@0: 
sl@0:     /*
sl@0:      * If we are writing to a file that was opened with O_APPEND, we need to
sl@0:      * seek to the end of the file before writing the current buffer.
sl@0:      */
sl@0: 
sl@0:     if (infoPtr->flags & FILE_APPEND) {
sl@0:         SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
sl@0:     }
sl@0: 
sl@0:     if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
sl@0:             (LPOVERLAPPED) NULL) == FALSE) {
sl@0:         TclWinConvertError(GetLastError());
sl@0:         *errorCode = errno;
sl@0:         return -1;
sl@0:     }
sl@0:     infoPtr->dirty = 1;
sl@0:     return bytesWritten;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileWatchProc --
sl@0:  *
sl@0:  *	Called by the notifier to set up to watch for events on this
sl@0:  *	channel.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: FileWatchProc(instanceData, mask)
sl@0:     ClientData instanceData;		/* File state. */
sl@0:     int mask;				/* What events to watch for; OR-ed
sl@0:                                          * combination of TCL_READABLE,
sl@0:                                          * TCL_WRITABLE and TCL_EXCEPTION. */
sl@0: {
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0:     Tcl_Time blockTime = { 0, 0 };
sl@0: 
sl@0:     /*
sl@0:      * Since the file is always ready for events, we set the block time
sl@0:      * to zero so we will poll.
sl@0:      */
sl@0: 
sl@0:     infoPtr->watchMask = mask & infoPtr->validMask;
sl@0:     if (infoPtr->watchMask) {
sl@0: 	Tcl_SetMaxBlockTime(&blockTime);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileGetHandleProc --
sl@0:  *
sl@0:  *	Called from Tcl_GetChannelHandle to retrieve OS handles from
sl@0:  *	a file based channel.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
sl@0:  *	there is no handle for the specified direction. 
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FileGetHandleProc(instanceData, direction, handlePtr)
sl@0:     ClientData instanceData;	/* The file state. */
sl@0:     int direction;		/* TCL_READABLE or TCL_WRITABLE */
sl@0:     ClientData *handlePtr;	/* Where to store the handle.  */
sl@0: {
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0: 
sl@0:     if (direction & infoPtr->validMask) {
sl@0: 	*handlePtr = (ClientData) infoPtr->handle;
sl@0: 	return TCL_OK;
sl@0:     } else {
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpOpenFileChannel --
sl@0:  *
sl@0:  *	Open an File based channel on Unix systems.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The new channel or NULL. If NULL, the output argument
sl@0:  *	errorCodePtr is set to a POSIX error.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May open the channel and may cause creation of a file on the
sl@0:  *	file system.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Channel
sl@0: TclpOpenFileChannel(interp, pathPtr, mode, permissions)
sl@0:     Tcl_Interp *interp;			/* Interpreter for error reporting;
sl@0:                                          * can be NULL. */
sl@0:     Tcl_Obj *pathPtr;			/* Name of file to open. */
sl@0:     int mode;				/* POSIX mode. */
sl@0:     int permissions;			/* If the open involves creating a
sl@0:                                          * file, with what modes to create
sl@0:                                          * it? */
sl@0: {
sl@0:     Tcl_Channel channel = 0;
sl@0:     int channelPermissions;
sl@0:     DWORD accessMode, createMode, shareMode, flags;
sl@0:     CONST TCHAR *nativeName;
sl@0:     HANDLE handle;
sl@0:     char channelName[16 + TCL_INTEGER_SPACE];
sl@0:     TclFile readFile = NULL;
sl@0:     TclFile writeFile = NULL;
sl@0: 
sl@0:     nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
sl@0:     if (nativeName == NULL) {
sl@0: 	return NULL;
sl@0:     }
sl@0:     
sl@0:     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
sl@0: 	case O_RDONLY:
sl@0: 	    accessMode = GENERIC_READ;
sl@0: 	    channelPermissions = TCL_READABLE;
sl@0: 	    break;
sl@0: 	case O_WRONLY:
sl@0: 	    accessMode = GENERIC_WRITE;
sl@0: 	    channelPermissions = TCL_WRITABLE;
sl@0: 	    break;
sl@0: 	case O_RDWR:
sl@0: 	    accessMode = (GENERIC_READ | GENERIC_WRITE);
sl@0: 	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
sl@0: 	    break;
sl@0: 	default:
sl@0: 	    panic("TclpOpenFileChannel: invalid mode value");
sl@0: 	    break;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Map the creation flags to the NT create mode.
sl@0:      */
sl@0: 
sl@0:     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
sl@0: 	case (O_CREAT | O_EXCL):
sl@0: 	case (O_CREAT | O_EXCL | O_TRUNC):
sl@0: 	    createMode = CREATE_NEW;
sl@0: 	    break;
sl@0: 	case (O_CREAT | O_TRUNC):
sl@0: 	    createMode = CREATE_ALWAYS;
sl@0: 	    break;
sl@0: 	case O_CREAT:
sl@0: 	    createMode = OPEN_ALWAYS;
sl@0: 	    break;
sl@0: 	case O_TRUNC:
sl@0: 	case (O_TRUNC | O_EXCL):
sl@0: 	    createMode = TRUNCATE_EXISTING;
sl@0: 	    break;
sl@0: 	default:
sl@0: 	    createMode = OPEN_EXISTING;
sl@0: 	    break;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If the file is being created, get the file attributes from the
sl@0:      * permissions argument, else use the existing file attributes.
sl@0:      */
sl@0: 
sl@0:     if (mode & O_CREAT) {
sl@0:         if (permissions & S_IWRITE) {
sl@0:             flags = FILE_ATTRIBUTE_NORMAL;
sl@0:         } else {
sl@0:             flags = FILE_ATTRIBUTE_READONLY;
sl@0:         }
sl@0:     } else {
sl@0: 	flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
sl@0:         if (flags == 0xFFFFFFFF) {
sl@0: 	    flags = 0;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Set up the file sharing mode.  We want to allow simultaneous access.
sl@0:      */
sl@0: 
sl@0:     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
sl@0: 
sl@0:     /*
sl@0:      * Now we get to create the file.
sl@0:      */
sl@0: 
sl@0:     handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, 
sl@0: 	    shareMode, NULL, createMode, flags, (HANDLE) NULL);
sl@0: 
sl@0:     if (handle == INVALID_HANDLE_VALUE) {
sl@0: 	DWORD err;
sl@0: 	err = GetLastError();
sl@0: 	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
sl@0: 	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
sl@0: 	}
sl@0:         TclWinConvertError(err);
sl@0: 	if (interp != (Tcl_Interp *) NULL) {
sl@0:             Tcl_AppendResult(interp, "couldn't open \"", 
sl@0: 			     Tcl_GetString(pathPtr), "\": ",
sl@0: 			     Tcl_PosixError(interp), (char *) NULL);
sl@0:         }
sl@0:         return NULL;
sl@0:     }
sl@0:     
sl@0:     channel = NULL;
sl@0: 
sl@0:     switch ( FileGetType(handle) ) {
sl@0:     case FILE_TYPE_SERIAL:
sl@0: 	/*
sl@0: 	 * Reopen channel for OVERLAPPED operation
sl@0: 	 * Normally this shouldn't fail, because the channel exists
sl@0: 	 */
sl@0: 	handle = TclWinSerialReopen(handle, nativeName, accessMode);
sl@0: 	if (handle == INVALID_HANDLE_VALUE) {
sl@0: 	    TclWinConvertError(GetLastError());
sl@0: 	    if (interp != (Tcl_Interp *) NULL) {
sl@0: 		Tcl_AppendResult(interp, "couldn't reopen serial \"",
sl@0: 			Tcl_GetString(pathPtr), "\": ",
sl@0: 			Tcl_PosixError(interp), (char *) NULL);
sl@0: 	    }
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	channel = TclWinOpenSerialChannel(handle, channelName,
sl@0: 	        channelPermissions);
sl@0: 	break;
sl@0:     case FILE_TYPE_CONSOLE:
sl@0: 	channel = TclWinOpenConsoleChannel(handle, channelName,
sl@0: 	        channelPermissions);
sl@0: 	break;
sl@0:     case FILE_TYPE_PIPE:
sl@0: 	if (channelPermissions & TCL_READABLE) {
sl@0: 	    readFile = TclWinMakeFile(handle);
sl@0: 	}
sl@0: 	if (channelPermissions & TCL_WRITABLE) {
sl@0: 	    writeFile = TclWinMakeFile(handle);
sl@0: 	}
sl@0: 	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
sl@0: 	break;
sl@0:     case FILE_TYPE_CHAR:
sl@0:     case FILE_TYPE_DISK:
sl@0:     case FILE_TYPE_UNKNOWN:
sl@0: 	channel = TclWinOpenFileChannel(handle, channelName,
sl@0: 					channelPermissions,
sl@0: 					(mode & O_APPEND) ? FILE_APPEND : 0);
sl@0: 	break;
sl@0: 
sl@0:     default:
sl@0: 	/*
sl@0: 	 * The handle is of an unknown type, probably /dev/nul equivalent
sl@0: 	 * or possibly a closed handle.  
sl@0: 	 */
sl@0: 	
sl@0: 	channel = NULL;
sl@0: 	Tcl_AppendResult(interp, "couldn't open \"", 
sl@0: 			 Tcl_GetString(pathPtr), "\": ",
sl@0: 			 "bad file type", (char *) NULL);
sl@0: 	break;
sl@0:     }
sl@0: 
sl@0:     return channel;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_MakeFileChannel --
sl@0:  *
sl@0:  *	Creates a Tcl_Channel from an existing platform specific file
sl@0:  *	handle.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The Tcl_Channel created around the preexisting file.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Channel
sl@0: Tcl_MakeFileChannel(rawHandle, mode)
sl@0:     ClientData rawHandle;	/* OS level handle */
sl@0:     int mode;			/* ORed combination of TCL_READABLE and
sl@0:                                  * TCL_WRITABLE to indicate file mode. */
sl@0: {
sl@0: #ifdef HAVE_NO_SEH
sl@0:     EXCEPTION_REGISTRATION registration;
sl@0: #endif
sl@0:     char channelName[16 + TCL_INTEGER_SPACE];
sl@0:     Tcl_Channel channel = NULL;
sl@0:     HANDLE handle = (HANDLE) rawHandle;
sl@0:     HANDLE dupedHandle;
sl@0:     TclFile readFile = NULL;
sl@0:     TclFile writeFile = NULL;
sl@0:     BOOL result;
sl@0: 
sl@0:     if (mode == 0) {
sl@0: 	return NULL;
sl@0:     }
sl@0: 
sl@0:     switch (FileGetType(handle))
sl@0:     {
sl@0:     case FILE_TYPE_SERIAL:
sl@0: 	channel = TclWinOpenSerialChannel(handle, channelName, mode);
sl@0: 	break;
sl@0:     case FILE_TYPE_CONSOLE:
sl@0: 	channel = TclWinOpenConsoleChannel(handle, channelName, mode);
sl@0: 	break;
sl@0:     case FILE_TYPE_PIPE:
sl@0: 	if (mode & TCL_READABLE)
sl@0: 	{
sl@0: 	    readFile = TclWinMakeFile(handle);
sl@0: 	}
sl@0: 	if (mode & TCL_WRITABLE)
sl@0: 	{
sl@0: 	    writeFile = TclWinMakeFile(handle);
sl@0: 	}
sl@0: 	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
sl@0: 	break;
sl@0: 
sl@0:     case FILE_TYPE_DISK:
sl@0:     case FILE_TYPE_CHAR:
sl@0: 	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
sl@0: 	break;
sl@0: 	
sl@0:     case FILE_TYPE_UNKNOWN:
sl@0:     default:
sl@0: 	/*
sl@0: 	 * The handle is of an unknown type.  Test the validity of this OS
sl@0: 	 * handle by duplicating it, then closing the dupe.  The Win32 API
sl@0: 	 * doesn't provide an IsValidHandle() function, so we have to emulate
sl@0: 	 * it here.  This test will not work on a console handle reliably,
sl@0: 	 * which is why we can't test every handle that comes into this
sl@0: 	 * function in this way.
sl@0: 	 */
sl@0: 
sl@0: 	result = DuplicateHandle(GetCurrentProcess(), handle,
sl@0: 		GetCurrentProcess(), &dupedHandle, 0, FALSE,
sl@0: 		DUPLICATE_SAME_ACCESS);
sl@0: 
sl@0: 	if (result == 0) {
sl@0: 	    /* 
sl@0: 	     * Unable to make a duplicate. It's definately invalid at this
sl@0: 	     * point.
sl@0: 	     */
sl@0: 
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 
sl@0: 	/*
sl@0: 	 * Use structured exception handling (Win32 SEH) to protect the close
sl@0: 	 * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
sl@0: 	 */
sl@0: 
sl@0: 	result = 0;
sl@0: #ifndef HAVE_NO_SEH
sl@0: 	__try {
sl@0: 	    CloseHandle(dupedHandle);
sl@0: 	    result = 1;
sl@0: 	} __except (EXCEPTION_EXECUTE_HANDLER) {}
sl@0: #else
sl@0: 	/*
sl@0: 	 * Don't have SEH available, do things the hard way.
sl@0: 	 * Note that this needs to be one block of asm, to avoid stack
sl@0: 	 * imbalance; also, it is illegal for one asm block to contain 
sl@0: 	 * a jump to another.
sl@0: 	 */
sl@0: 	
sl@0: 	__asm__ __volatile__ (
sl@0: 
sl@0: 	    /*
sl@0: 	     * Pick up parameters before messing with the stack
sl@0: 	     */
sl@0: 
sl@0: 	    "movl       %[dupedHandle], %%ebx"          "\n\t"
sl@0: 
sl@0: 	    /*
sl@0: 	     * Construct an EXCEPTION_REGISTRATION to protect the
sl@0: 	     * call to CloseHandle
sl@0: 	     */
sl@0: 	    "leal       %[registration], %%edx"         "\n\t"
sl@0: 	    "movl       %%fs:0,         %%eax"          "\n\t"
sl@0: 	    "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
sl@0: 	    "leal       1f,             %%eax"          "\n\t"
sl@0: 	    "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
sl@0: 	    "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
sl@0: 	    "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
sl@0: 	    "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
sl@0: 	
sl@0: 	    /* Link the EXCEPTION_REGISTRATION on the chain */
sl@0: 	    
sl@0: 	    "movl       %%edx,          %%fs:0"         "\n\t"
sl@0: 	    
sl@0: 	    /* Call CloseHandle( dupedHandle ) */
sl@0: 	    
sl@0: 	    "pushl      %%ebx"                          "\n\t"
sl@0: 	    "call       _CloseHandle@4"                 "\n\t"
sl@0: 	    
sl@0: 	    /* 
sl@0: 	     * Come here on normal exit.  Recover the EXCEPTION_REGISTRATION
sl@0: 	     * and put a TRUE status return into it.
sl@0: 	     */
sl@0: 	    
sl@0: 	    "movl       %%fs:0,         %%edx"          "\n\t"
sl@0: 	    "movl	$1,		%%eax"		"\n\t"
sl@0: 	    "movl       %%eax,          0x10(%%edx)"    "\n\t"
sl@0: 	    "jmp        2f"                             "\n"
sl@0: 	    
sl@0: 	    /*
sl@0: 	     * Come here on an exception.  Recover the EXCEPTION_REGISTRATION
sl@0: 	     */
sl@0: 	    
sl@0: 	    "1:"                                        "\t"
sl@0: 	    "movl       %%fs:0,         %%edx"          "\n\t"
sl@0: 	    "movl       0x8(%%edx),     %%edx"          "\n\t"
sl@0: 	    
sl@0: 	    /* 
sl@0: 	     * Come here however we exited.  Restore context from the
sl@0: 	     * EXCEPTION_REGISTRATION in case the stack is unbalanced.
sl@0: 	     */
sl@0: 	    
sl@0: 	    "2:"                                        "\t"
sl@0: 	    "movl       0xc(%%edx),     %%esp"          "\n\t"
sl@0: 	    "movl       0x8(%%edx),     %%ebp"          "\n\t"
sl@0: 	    "movl       0x0(%%edx),     %%eax"          "\n\t"
sl@0: 	    "movl       %%eax,          %%fs:0"         "\n\t"
sl@0: 	    
sl@0: 	    :
sl@0: 	    /* No outputs */
sl@0: 	    :
sl@0: 	    [registration]  "m"     (registration),
sl@0: 	    [dupedHandle]   "m"	    (dupedHandle)
sl@0: 	    :
sl@0: 	    "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
sl@0: 	    );
sl@0: 	result = registration.status;
sl@0: 
sl@0: #endif
sl@0: 	if (result == FALSE) {
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 
sl@0: 	/* Fall through, the handle is valid. */
sl@0: 
sl@0: 	/*
sl@0: 	 * Create the undefined channel, anyways, because we know the handle
sl@0: 	 * is valid to something.
sl@0: 	 */
sl@0: 
sl@0: 	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
sl@0:     }
sl@0: 
sl@0:     return channel;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpGetDefaultStdChannel --
sl@0:  *
sl@0:  *	Constructs a channel for the specified standard OS handle.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns the specified default standard channel, or NULL.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May cause the creation of a standard channel and the underlying
sl@0:  *	file.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Channel
sl@0: TclpGetDefaultStdChannel(type)
sl@0:     int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
sl@0: {
sl@0:     Tcl_Channel channel;
sl@0:     HANDLE handle;
sl@0:     int mode;
sl@0:     char *bufMode;
sl@0:     DWORD handleId;		/* Standard handle to retrieve. */
sl@0: 
sl@0: 
sl@0:     switch (type) {
sl@0: 	case TCL_STDIN:
sl@0: 	    handleId = STD_INPUT_HANDLE;
sl@0: 	    mode = TCL_READABLE;
sl@0: 	    bufMode = "line";
sl@0: 	    break;
sl@0: 	case TCL_STDOUT:
sl@0: 	    handleId = STD_OUTPUT_HANDLE;
sl@0: 	    mode = TCL_WRITABLE;
sl@0: 	    bufMode = "line";
sl@0: 	    break;
sl@0: 	case TCL_STDERR:
sl@0: 	    handleId = STD_ERROR_HANDLE;
sl@0: 	    mode = TCL_WRITABLE;
sl@0: 	    bufMode = "none";
sl@0: 	    break;
sl@0: 	default:
sl@0: 	    panic("TclGetDefaultStdChannel: Unexpected channel type");
sl@0: 	    break;
sl@0:     }
sl@0: 
sl@0:     handle = GetStdHandle(handleId);
sl@0: 
sl@0:     /*
sl@0:      * Note that we need to check for 0 because Windows may return 0 if this
sl@0:      * is not a console mode application, even though this is not a valid
sl@0:      * handle.
sl@0:      */
sl@0: 
sl@0:     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
sl@0: 	return (Tcl_Channel) NULL;
sl@0:     }
sl@0: 
sl@0:     channel = Tcl_MakeFileChannel(handle, mode);
sl@0: 
sl@0:     if (channel == NULL) {
sl@0: 	return (Tcl_Channel) NULL;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Set up the normal channel options for stdio handles.
sl@0:      */
sl@0: 
sl@0:     if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
sl@0:             "auto") == TCL_ERROR)
sl@0: 	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
sl@0: 		    "\032 {}") == TCL_ERROR)
sl@0: 	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
sl@0: 		    "-buffering", bufMode) == TCL_ERROR)) {
sl@0:         Tcl_Close((Tcl_Interp *) NULL, channel);
sl@0:         return (Tcl_Channel) NULL;
sl@0:     }
sl@0:     return channel;
sl@0: }
sl@0: 
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclWinOpenFileChannel --
sl@0:  *
sl@0:  *	Constructs a File channel for the specified standard OS handle.
sl@0:  *      This is a helper function to break up the construction of 
sl@0:  *      channels into File, Console, or Serial.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns the new channel, or NULL.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May open the channel and may cause creation of a file on the
sl@0:  *	file system.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Channel
sl@0: TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
sl@0:     HANDLE handle;
sl@0:     char *channelName;
sl@0:     int permissions;
sl@0:     int appendMode;
sl@0: {
sl@0:     FileInfo *infoPtr;
sl@0:     ThreadSpecificData *tsdPtr;
sl@0: 
sl@0:     tsdPtr = FileInit();
sl@0: 
sl@0:     /*
sl@0:      * See if a channel with this handle already exists.
sl@0:      */
sl@0:     
sl@0:     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0: 	 infoPtr = infoPtr->nextPtr) {
sl@0: 	if (infoPtr->handle == (HANDLE) handle) {
sl@0: 	    return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
sl@0:     /* TIP #218. Removed the code inserting the new structure
sl@0:      * into the global list. This is now handled in the thread
sl@0:      * action callbacks, and only there.
sl@0:      */
sl@0:     infoPtr->nextPtr = NULL;
sl@0:     infoPtr->validMask = permissions;
sl@0:     infoPtr->watchMask = 0;
sl@0:     infoPtr->flags = appendMode;
sl@0:     infoPtr->handle = handle;
sl@0:     infoPtr->dirty = 0;
sl@0:     wsprintfA(channelName, "file%lx", (int) infoPtr);
sl@0:     
sl@0:     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
sl@0: 	    (ClientData) infoPtr, permissions);
sl@0:     
sl@0:     /*
sl@0:      * Files have default translation of AUTO and ^Z eof char, which
sl@0:      * means that a ^Z will be accepted as EOF when reading.
sl@0:      */
sl@0:     
sl@0:     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
sl@0:     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
sl@0: 
sl@0:     return infoPtr->channel;
sl@0: }
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclWinFlushDirtyChannels --
sl@0:  *
sl@0:  *	Flush all dirty channels to disk, so that requesting the
sl@0:  *	size of any file returns the correct value.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Information is actually written to disk now, rather than
sl@0:  *	later.  Don't call this too often, or there will be a 
sl@0:  *	performance hit (i.e. only call when we need to ask for
sl@0:  *	the size of a file).
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclWinFlushDirtyChannels ()
sl@0: {
sl@0:     FileInfo *infoPtr;
sl@0:     ThreadSpecificData *tsdPtr;
sl@0: 
sl@0:     tsdPtr = FileInit();
sl@0: 
sl@0:     /*
sl@0:      * Flush all channels which are dirty, i.e. may have data pending
sl@0:      * in the OS
sl@0:      */
sl@0:     
sl@0:     for (infoPtr = tsdPtr->firstFilePtr;
sl@0: 	 infoPtr != NULL; 
sl@0: 	 infoPtr = infoPtr->nextPtr) {
sl@0: 	if (infoPtr->dirty) {
sl@0: 	    FlushFileBuffers(infoPtr->handle);
sl@0: 	    infoPtr->dirty = 0;
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileThreadActionProc --
sl@0:  *
sl@0:  *	Insert or remove any thread local refs to this channel.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Changes thread local list of valid channels.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: FileThreadActionProc (instanceData, action)
sl@0:      ClientData instanceData;
sl@0:      int action;
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0:     FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0: 
sl@0:     if (action == TCL_CHANNEL_THREAD_INSERT) {
sl@0:         infoPtr->nextPtr = tsdPtr->firstFilePtr;
sl@0: 	tsdPtr->firstFilePtr = infoPtr;
sl@0:     } else {
sl@0:         FileInfo **nextPtrPtr;
sl@0: 	int removed = 0;
sl@0: 
sl@0: 	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
sl@0: 	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
sl@0: 	    if ((*nextPtrPtr) == infoPtr) {
sl@0: 	        (*nextPtrPtr) = infoPtr->nextPtr;
sl@0: 		removed = 1;
sl@0: 		break;
sl@0: 	    }
sl@0: 	}
sl@0: 
sl@0: 	/*
sl@0: 	 * This could happen if the channel was created in one thread
sl@0: 	 * and then moved to another without updating the thread
sl@0: 	 * local data in each thread.
sl@0: 	 */
sl@0: 
sl@0: 	if (!removed) {
sl@0: 	    panic("file info ptr not on thread channel list");
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FileGetType --
sl@0:  *
sl@0:  *	Given a file handle, return its type
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: DWORD
sl@0: FileGetType(handle)
sl@0:     HANDLE handle; /* Opened file handle */
sl@0: { 
sl@0:     DWORD type;
sl@0:     DWORD consoleParams;
sl@0:     DCB dcb;
sl@0: 
sl@0:     type = GetFileType(handle);
sl@0: 
sl@0:     /*
sl@0:      * If the file is a character device, we need to try to figure out
sl@0:      * whether it is a serial port, a console, or something else.  We
sl@0:      * test for the console case first because this is more common.
sl@0:      */
sl@0:     
sl@0:     if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) {
sl@0: 	    if (GetConsoleMode(handle, &consoleParams)) {
sl@0: 	      type = FILE_TYPE_CONSOLE;
sl@0:       } else {
sl@0: 	      dcb.DCBlength = sizeof( DCB ) ;
sl@0: 	      if (GetCommState(handle, &dcb)) {
sl@0: 		      type = FILE_TYPE_SERIAL;
sl@0:         }
sl@0:       }
sl@0:     }
sl@0: 
sl@0:     return type;
sl@0: }