Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinPipe.c@bde4ae8d615e (annotated)

sl@0	1	/*
sl@0	2	* tclWinPipe.c --
sl@0	3	*
sl@0	4	* This file implements the Windows-specific exec pipeline functions,
sl@0	5	* the "pipe" channel driver, and the "pid" Tcl command.
sl@0	6	*
sl@0	7	* Copyright (c) 1996-1997 by Sun Microsystems, Inc.
sl@0	8	*
sl@0	9	* See the file "license.terms" for information on usage and redistribution
sl@0	10	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	11	*
sl@0	12	* RCS: @(#) $Id: tclWinPipe.c,v 1.33.2.17 2006/03/14 20:36:39 andreas_kupries Exp $
sl@0	13	*/
sl@0	14
sl@0	15	#include "tclWinInt.h"
sl@0	16
sl@0	17	#include <fcntl.h>
sl@0	18	#include <io.h>
sl@0	19	#include <sys/stat.h>
sl@0	20
sl@0	21	/*
sl@0	22	* The following variable is used to tell whether this module has been
sl@0	23	* initialized.
sl@0	24	*/
sl@0	25
sl@0	26	static int initialized = 0;
sl@0	27
sl@0	28	/*
sl@0	29	* The pipeMutex locks around access to the initialized and procList variables,
sl@0	30	* and it is used to protect background threads from being terminated while
sl@0	31	* they are using APIs that hold locks.
sl@0	32	*/
sl@0	33
sl@0	34	TCL_DECLARE_MUTEX(pipeMutex)
sl@0	35
sl@0	36	/*
sl@0	37	* The following defines identify the various types of applications that
sl@0	38	* run under windows. There is special case code for the various types.
sl@0	39	*/
sl@0	40
sl@0	41	#define APPL_NONE 0
sl@0	42	#define APPL_DOS 1
sl@0	43	#define APPL_WIN3X 2
sl@0	44	#define APPL_WIN32 3
sl@0	45
sl@0	46	/*
sl@0	47	* The following constants and structures are used to encapsulate the state
sl@0	48	* of various types of files used in a pipeline.
sl@0	49	* This used to have a 1 && 2 that supported Win32s.
sl@0	50	*/
sl@0	51
sl@0	52	#define WIN_FILE 3 /* Basic Win32 file. */
sl@0	53
sl@0	54	/*
sl@0	55	* This structure encapsulates the common state associated with all file
sl@0	56	* types used in a pipeline.
sl@0	57	*/
sl@0	58
sl@0	59	typedef struct WinFile {
sl@0	60	int type; /* One of the file types defined above. */
sl@0	61	HANDLE handle; /* Open file handle. */
sl@0	62	} WinFile;
sl@0	63
sl@0	64	/*
sl@0	65	* This list is used to map from pids to process handles.
sl@0	66	*/
sl@0	67
sl@0	68	typedef struct ProcInfo {
sl@0	69	HANDLE hProcess;
sl@0	70	DWORD dwProcessId;
sl@0	71	struct ProcInfo *nextPtr;
sl@0	72	} ProcInfo;
sl@0	73
sl@0	74	static ProcInfo *procList;
sl@0	75
sl@0	76	/*
sl@0	77	* Bit masks used in the flags field of the PipeInfo structure below.
sl@0	78	*/
sl@0	79
sl@0	80	#define PIPE_PENDING (1<<0) /* Message is pending in the queue. */
sl@0	81	#define PIPE_ASYNC (1<<1) /* Channel is non-blocking. */
sl@0	82
sl@0	83	/*
sl@0	84	* Bit masks used in the sharedFlags field of the PipeInfo structure below.
sl@0	85	*/
sl@0	86
sl@0	87	#define PIPE_EOF (1<<2) /* Pipe has reached EOF. */
sl@0	88	#define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */
sl@0	89
sl@0	90	/*
sl@0	91	* This structure describes per-instance data for a pipe based channel.
sl@0	92	*/
sl@0	93
sl@0	94	typedef struct PipeInfo {
sl@0	95	struct PipeInfo nextPtr; / Pointer to next registered pipe. */
sl@0	96	Tcl_Channel channel; /* Pointer to channel structure. */
sl@0	97	int validMask; /* OR'ed combination of TCL_READABLE,
sl@0	98	* TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0	99	* which operations are valid on the file. */
sl@0	100	int watchMask; /* OR'ed combination of TCL_READABLE,
sl@0	101	* TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0	102	* which events should be reported. */
sl@0	103	int flags; /* State flags, see above for a list. */
sl@0	104	TclFile readFile; /* Output from pipe. */
sl@0	105	TclFile writeFile; /* Input from pipe. */
sl@0	106	TclFile errorFile; /* Error output from pipe. */
sl@0	107	int numPids; /* Number of processes attached to pipe. */
sl@0	108	Tcl_Pid pidPtr; / Pids of attached processes. */
sl@0	109	Tcl_ThreadId threadId; /* Thread to which events should be reported.
sl@0	110	* This value is used by the reader/writer
sl@0	111	* threads. */
sl@0	112	HANDLE writeThread; /* Handle to writer thread. */
sl@0	113	HANDLE readThread; /* Handle to reader thread. */
sl@0	114	HANDLE writable; /* Manual-reset event to signal when the
sl@0	115	* writer thread has finished waiting for
sl@0	116	* the current buffer to be written. */
sl@0	117	HANDLE readable; /* Manual-reset event to signal when the
sl@0	118	* reader thread has finished waiting for
sl@0	119	* input. */
sl@0	120	HANDLE startWriter; /* Auto-reset event used by the main thread to
sl@0	121	* signal when the writer thread should attempt
sl@0	122	* to write to the pipe. */
sl@0	123	HANDLE stopWriter; /* Manual-reset event used to alert the reader
sl@0	124	* thread to fall-out and exit */
sl@0	125	HANDLE startReader; /* Auto-reset event used by the main thread to
sl@0	126	* signal when the reader thread should attempt
sl@0	127	* to read from the pipe. */
sl@0	128	HANDLE stopReader; /* Manual-reset event used to alert the reader
sl@0	129	* thread to fall-out and exit */
sl@0	130	DWORD writeError; /* An error caused by the last background
sl@0	131	* write. Set to 0 if no error has been
sl@0	132	* detected. This word is shared with the
sl@0	133	* writer thread so access must be
sl@0	134	* synchronized with the writable object.
sl@0	135	*/
sl@0	136	char writeBuf; / Current background output buffer.
sl@0	137	* Access is synchronized with the writable
sl@0	138	* object. */
sl@0	139	int writeBufLen; /* Size of write buffer. Access is
sl@0	140	* synchronized with the writable
sl@0	141	* object. */
sl@0	142	int toWrite; /* Current amount to be written. Access is
sl@0	143	* synchronized with the writable object. */
sl@0	144	int readFlags; /* Flags that are shared with the reader
sl@0	145	* thread. Access is synchronized with the
sl@0	146	* readable object. */
sl@0	147	char extraByte; /* Buffer for extra character consumed by
sl@0	148	* reader thread. This byte is shared with
sl@0	149	* the reader thread so access must be
sl@0	150	* synchronized with the readable object. */
sl@0	151	} PipeInfo;
sl@0	152
sl@0	153	typedef struct ThreadSpecificData {
sl@0	154	/*
sl@0	155	* The following pointer refers to the head of the list of pipes
sl@0	156	* that are being watched for file events.
sl@0	157	*/
sl@0	158
sl@0	159	PipeInfo *firstPipePtr;
sl@0	160	} ThreadSpecificData;
sl@0	161
sl@0	162	static Tcl_ThreadDataKey dataKey;
sl@0	163
sl@0	164	/*
sl@0	165	* The following structure is what is added to the Tcl event queue when
sl@0	166	* pipe events are generated.
sl@0	167	*/
sl@0	168
sl@0	169	typedef struct PipeEvent {
sl@0	170	Tcl_Event header; /* Information that is standard for
sl@0	171	* all events. */
sl@0	172	PipeInfo infoPtr; / Pointer to pipe info structure. Note
sl@0	173	* that we still have to verify that the
sl@0	174	* pipe exists before dereferencing this
sl@0	175	* pointer. */
sl@0	176	} PipeEvent;
sl@0	177
sl@0	178	/*
sl@0	179	* Declarations for functions used only in this file.
sl@0	180	*/
sl@0	181
sl@0	182	static int ApplicationType(Tcl_Interp *interp,
sl@0	183	const char fileName, char fullName);
sl@0	184	static void BuildCommandLine(const char *executable, int argc,
sl@0	185	CONST char *argv, Tcl_DString linePtr);
sl@0	186	static BOOL HasConsole(void);
sl@0	187	static int PipeBlockModeProc(ClientData instanceData, int mode);
sl@0	188	static void PipeCheckProc(ClientData clientData, int flags);
sl@0	189	static int PipeClose2Proc(ClientData instanceData,
sl@0	190	Tcl_Interp *interp, int flags);
sl@0	191	static int PipeEventProc(Tcl_Event *evPtr, int flags);
sl@0	192	static int PipeGetHandleProc(ClientData instanceData,
sl@0	193	int direction, ClientData *handlePtr);
sl@0	194	static void PipeInit(void);
sl@0	195	static int PipeInputProc(ClientData instanceData, char *buf,
sl@0	196	int toRead, int *errorCode);
sl@0	197	static int PipeOutputProc(ClientData instanceData,
sl@0	198	CONST char buf, int toWrite, int errorCode);
sl@0	199	static DWORD WINAPI PipeReaderThread(LPVOID arg);
sl@0	200	static void PipeSetupProc(ClientData clientData, int flags);
sl@0	201	static void PipeWatchProc(ClientData instanceData, int mask);
sl@0	202	static DWORD WINAPI PipeWriterThread(LPVOID arg);
sl@0	203	static int TempFileName(WCHAR name[MAX_PATH]);
sl@0	204	static int WaitForRead(PipeInfo *infoPtr, int blocking);
sl@0	205
sl@0	206	static void PipeThreadActionProc _ANSI_ARGS_ ((
sl@0	207	ClientData instanceData, int action));
sl@0	208
sl@0	209	/*
sl@0	210	* This structure describes the channel type structure for command pipe
sl@0	211	* based IO.
sl@0	212	*/
sl@0	213
sl@0	214	static Tcl_ChannelType pipeChannelType = {
sl@0	215	"pipe", /* Type name. */
sl@0	216	TCL_CHANNEL_VERSION_4, /* v4 channel */
sl@0	217	TCL_CLOSE2PROC, /* Close proc. */
sl@0	218	PipeInputProc, /* Input proc. */
sl@0	219	PipeOutputProc, /* Output proc. */
sl@0	220	NULL, /* Seek proc. */
sl@0	221	NULL, /* Set option proc. */
sl@0	222	NULL, /* Get option proc. */
sl@0	223	PipeWatchProc, /* Set up notifier to watch the channel. */
sl@0	224	PipeGetHandleProc, /* Get an OS handle from channel. */
sl@0	225	PipeClose2Proc, /* close2proc */
sl@0	226	PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
sl@0	227	NULL, /* flush proc. */
sl@0	228	NULL, /* handler proc. */
sl@0	229	NULL, /* wide seek proc */
sl@0	230	PipeThreadActionProc, /* thread action proc */
sl@0	231	};
sl@0	232
sl@0	233	/*
sl@0	234	*----------------------------------------------------------------------
sl@0	235	*
sl@0	236	* PipeInit --
sl@0	237	*
sl@0	238	* This function initializes the static variables for this file.
sl@0	239	*
sl@0	240	* Results:
sl@0	241	* None.
sl@0	242	*
sl@0	243	* Side effects:
sl@0	244	* Creates a new event source.
sl@0	245	*
sl@0	246	*----------------------------------------------------------------------
sl@0	247	*/
sl@0	248
sl@0	249	static void
sl@0	250	PipeInit()
sl@0	251	{
sl@0	252	ThreadSpecificData *tsdPtr;
sl@0	253
sl@0	254	/*
sl@0	255	* Check the initialized flag first, then check again in the mutex.
sl@0	256	* This is a speed enhancement.
sl@0	257	*/
sl@0	258
sl@0	259	if (!initialized) {
sl@0	260	Tcl_MutexLock(&pipeMutex);
sl@0	261	if (!initialized) {
sl@0	262	initialized = 1;
sl@0	263	procList = NULL;
sl@0	264	}
sl@0	265	Tcl_MutexUnlock(&pipeMutex);
sl@0	266	}
sl@0	267
sl@0	268	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
sl@0	269	if (tsdPtr == NULL) {
sl@0	270	tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	271	tsdPtr->firstPipePtr = NULL;
sl@0	272	Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
sl@0	273	}
sl@0	274	}
sl@0	275
sl@0	276	/*
sl@0	277	*----------------------------------------------------------------------
sl@0	278	*
sl@0	279	* TclpFinalizePipes --
sl@0	280	*
sl@0	281	* This function is called from Tcl_FinalizeThread to finalize the
sl@0	282	* platform specific pipe subsystem.
sl@0	283	*
sl@0	284	* Results:
sl@0	285	* None.
sl@0	286	*
sl@0	287	* Side effects:
sl@0	288	* Removes the pipe event source.
sl@0	289	*
sl@0	290	*----------------------------------------------------------------------
sl@0	291	*/
sl@0	292
sl@0	293	void
sl@0	294	TclpFinalizePipes()
sl@0	295	{
sl@0	296	ThreadSpecificData *tsdPtr;
sl@0	297
sl@0	298	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
sl@0	299	if (tsdPtr != NULL) {
sl@0	300	Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
sl@0	301	}
sl@0	302	}
sl@0	303
sl@0	304	/*
sl@0	305	*----------------------------------------------------------------------
sl@0	306	*
sl@0	307	* PipeSetupProc --
sl@0	308	*
sl@0	309	* This procedure is invoked before Tcl_DoOneEvent blocks waiting
sl@0	310	* for an event.
sl@0	311	*
sl@0	312	* Results:
sl@0	313	* None.
sl@0	314	*
sl@0	315	* Side effects:
sl@0	316	* Adjusts the block time if needed.
sl@0	317	*
sl@0	318	*----------------------------------------------------------------------
sl@0	319	*/
sl@0	320
sl@0	321	void
sl@0	322	PipeSetupProc(
sl@0	323	ClientData data, /* Not used. */
sl@0	324	int flags) /* Event flags as passed to Tcl_DoOneEvent. */
sl@0	325	{
sl@0	326	PipeInfo *infoPtr;
sl@0	327	Tcl_Time blockTime = { 0, 0 };
sl@0	328	int block = 1;
sl@0	329	WinFile *filePtr;
sl@0	330	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	331
sl@0	332	if (!(flags & TCL_FILE_EVENTS)) {
sl@0	333	return;
sl@0	334	}
sl@0	335
sl@0	336	/*
sl@0	337	* Look to see if any events are already pending. If they are, poll.
sl@0	338	*/
sl@0	339
sl@0	340	for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
sl@0	341	infoPtr = infoPtr->nextPtr) {
sl@0	342	if (infoPtr->watchMask & TCL_WRITABLE) {
sl@0	343	filePtr = (WinFile*) infoPtr->writeFile;
sl@0	344	if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
sl@0	345	block = 0;
sl@0	346	}
sl@0	347	}
sl@0	348	if (infoPtr->watchMask & TCL_READABLE) {
sl@0	349	filePtr = (WinFile*) infoPtr->readFile;
sl@0	350	if (WaitForRead(infoPtr, 0) >= 0) {
sl@0	351	block = 0;
sl@0	352	}
sl@0	353	}
sl@0	354	}
sl@0	355	if (!block) {
sl@0	356	Tcl_SetMaxBlockTime(&blockTime);
sl@0	357	}
sl@0	358	}
sl@0	359
sl@0	360	/*
sl@0	361	*----------------------------------------------------------------------
sl@0	362	*
sl@0	363	* PipeCheckProc --
sl@0	364	*
sl@0	365	* This procedure is called by Tcl_DoOneEvent to check the pipe
sl@0	366	* event source for events.
sl@0	367	*
sl@0	368	* Results:
sl@0	369	* None.
sl@0	370	*
sl@0	371	* Side effects:
sl@0	372	* May queue an event.
sl@0	373	*
sl@0	374	*----------------------------------------------------------------------
sl@0	375	*/
sl@0	376
sl@0	377	static void
sl@0	378	PipeCheckProc(
sl@0	379	ClientData data, /* Not used. */
sl@0	380	int flags) /* Event flags as passed to Tcl_DoOneEvent. */
sl@0	381	{
sl@0	382	PipeInfo *infoPtr;
sl@0	383	PipeEvent *evPtr;
sl@0	384	WinFile *filePtr;
sl@0	385	int needEvent;
sl@0	386	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	387
sl@0	388	if (!(flags & TCL_FILE_EVENTS)) {
sl@0	389	return;
sl@0	390	}
sl@0	391
sl@0	392	/*
sl@0	393	* Queue events for any ready pipes that don't already have events
sl@0	394	* queued.
sl@0	395	*/
sl@0	396
sl@0	397	for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
sl@0	398	infoPtr = infoPtr->nextPtr) {
sl@0	399	if (infoPtr->flags & PIPE_PENDING) {
sl@0	400	continue;
sl@0	401	}
sl@0	402
sl@0	403	/*
sl@0	404	* Queue an event if the pipe is signaled for reading or writing.
sl@0	405	*/
sl@0	406
sl@0	407	needEvent = 0;
sl@0	408	filePtr = (WinFile*) infoPtr->writeFile;
sl@0	409	if ((infoPtr->watchMask & TCL_WRITABLE) &&
sl@0	410	(WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
sl@0	411	needEvent = 1;
sl@0	412	}
sl@0	413
sl@0	414	filePtr = (WinFile*) infoPtr->readFile;
sl@0	415	if ((infoPtr->watchMask & TCL_READABLE) &&
sl@0	416	(WaitForRead(infoPtr, 0) >= 0)) {
sl@0	417	needEvent = 1;
sl@0	418	}
sl@0	419
sl@0	420	if (needEvent) {
sl@0	421	infoPtr->flags \|= PIPE_PENDING;
sl@0	422	evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
sl@0	423	evPtr->header.proc = PipeEventProc;
sl@0	424	evPtr->infoPtr = infoPtr;
sl@0	425	Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
sl@0	426	}
sl@0	427	}
sl@0	428	}
sl@0	429
sl@0	430	/*
sl@0	431	*----------------------------------------------------------------------
sl@0	432	*
sl@0	433	* TclWinMakeFile --
sl@0	434	*
sl@0	435	* This function constructs a new TclFile from a given data and
sl@0	436	* type value.
sl@0	437	*
sl@0	438	* Results:
sl@0	439	* Returns a newly allocated WinFile as a TclFile.
sl@0	440	*
sl@0	441	* Side effects:
sl@0	442	* None.
sl@0	443	*
sl@0	444	*----------------------------------------------------------------------
sl@0	445	*/
sl@0	446
sl@0	447	TclFile
sl@0	448	TclWinMakeFile(
sl@0	449	HANDLE handle) /* Type-specific data. */
sl@0	450	{
sl@0	451	WinFile *filePtr;
sl@0	452
sl@0	453	filePtr = (WinFile *) ckalloc(sizeof(WinFile));
sl@0	454	filePtr->type = WIN_FILE;
sl@0	455	filePtr->handle = handle;
sl@0	456
sl@0	457	return (TclFile)filePtr;
sl@0	458	}
sl@0	459
sl@0	460	/*
sl@0	461	*----------------------------------------------------------------------
sl@0	462	*
sl@0	463	* TempFileName --
sl@0	464	*
sl@0	465	* Gets a temporary file name and deals with the fact that the
sl@0	466	* temporary file path provided by Windows may not actually exist
sl@0	467	* if the TMP or TEMP environment variables refer to a
sl@0	468	* non-existent directory.
sl@0	469	*
sl@0	470	* Results:
sl@0	471	* 0 if error, non-zero otherwise. If non-zero is returned, the
sl@0	472	* name buffer will be filled with a name that can be used to
sl@0	473	* construct a temporary file.
sl@0	474	*
sl@0	475	* Side effects:
sl@0	476	* None.
sl@0	477	*
sl@0	478	*----------------------------------------------------------------------
sl@0	479	*/
sl@0	480
sl@0	481	static int
sl@0	482	TempFileName(name)
sl@0	483	WCHAR name[MAX_PATH]; /* Buffer in which name for temporary
sl@0	484	* file gets stored. */
sl@0	485	{
sl@0	486	TCHAR *prefix;
sl@0	487
sl@0	488	prefix = (tclWinProcs->useWide) ? (TCHAR ) L"TCL" : (TCHAR ) "TCL";
sl@0	489	if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
sl@0	490	if ((tclWinProcs->getTempFileNameProc)((TCHAR ) name, prefix, 0,
sl@0	491	name) != 0) {
sl@0	492	return 1;
sl@0	493	}
sl@0	494	}
sl@0	495	if (tclWinProcs->useWide) {
sl@0	496	((WCHAR *) name)[0] = '.';
sl@0	497	((WCHAR *) name)[1] = '\0';
sl@0	498	} else {
sl@0	499	((char *) name)[0] = '.';
sl@0	500	((char *) name)[1] = '\0';
sl@0	501	}
sl@0	502	return (tclWinProcs->getTempFileNameProc)((TCHAR ) name, prefix, 0,
sl@0	503	name);
sl@0	504	}
sl@0	505
sl@0	506	/*
sl@0	507	*----------------------------------------------------------------------
sl@0	508	*
sl@0	509	* TclpMakeFile --
sl@0	510	*
sl@0	511	* Make a TclFile from a channel.
sl@0	512	*
sl@0	513	* Results:
sl@0	514	* Returns a new TclFile or NULL on failure.
sl@0	515	*
sl@0	516	* Side effects:
sl@0	517	* None.
sl@0	518	*
sl@0	519	*----------------------------------------------------------------------
sl@0	520	*/
sl@0	521
sl@0	522	TclFile
sl@0	523	TclpMakeFile(channel, direction)
sl@0	524	Tcl_Channel channel; /* Channel to get file from. */
sl@0	525	int direction; /* Either TCL_READABLE or TCL_WRITABLE. */
sl@0	526	{
sl@0	527	HANDLE handle;
sl@0	528
sl@0	529	if (Tcl_GetChannelHandle(channel, direction,
sl@0	530	(ClientData *) &handle) == TCL_OK) {
sl@0	531	return TclWinMakeFile(handle);
sl@0	532	} else {
sl@0	533	return (TclFile) NULL;
sl@0	534	}
sl@0	535	}
sl@0	536
sl@0	537	/*
sl@0	538	*----------------------------------------------------------------------
sl@0	539	*
sl@0	540	* TclpOpenFile --
sl@0	541	*
sl@0	542	* This function opens files for use in a pipeline.
sl@0	543	*
sl@0	544	* Results:
sl@0	545	* Returns a newly allocated TclFile structure containing the
sl@0	546	* file handle.
sl@0	547	*
sl@0	548	* Side effects:
sl@0	549	* None.
sl@0	550	*
sl@0	551	*----------------------------------------------------------------------
sl@0	552	*/
sl@0	553
sl@0	554	TclFile
sl@0	555	TclpOpenFile(path, mode)
sl@0	556	CONST char path; / The name of the file to open. */
sl@0	557	int mode; /* In what mode to open the file? */
sl@0	558	{
sl@0	559	HANDLE handle;
sl@0	560	DWORD accessMode, createMode, shareMode, flags;
sl@0	561	Tcl_DString ds;
sl@0	562	CONST TCHAR *nativePath;
sl@0	563
sl@0	564	/*
sl@0	565	* Map the access bits to the NT access mode.
sl@0	566	*/
sl@0	567
sl@0	568	switch (mode & (O_RDONLY \| O_WRONLY \| O_RDWR)) {
sl@0	569	case O_RDONLY:
sl@0	570	accessMode = GENERIC_READ;
sl@0	571	break;
sl@0	572	case O_WRONLY:
sl@0	573	accessMode = GENERIC_WRITE;
sl@0	574	break;
sl@0	575	case O_RDWR:
sl@0	576	accessMode = (GENERIC_READ \| GENERIC_WRITE);
sl@0	577	break;
sl@0	578	default:
sl@0	579	TclWinConvertError(ERROR_INVALID_FUNCTION);
sl@0	580	return NULL;
sl@0	581	}
sl@0	582
sl@0	583	/*
sl@0	584	* Map the creation flags to the NT create mode.
sl@0	585	*/
sl@0	586
sl@0	587	switch (mode & (O_CREAT \| O_EXCL \| O_TRUNC)) {
sl@0	588	case (O_CREAT \| O_EXCL):
sl@0	589	case (O_CREAT \| O_EXCL \| O_TRUNC):
sl@0	590	createMode = CREATE_NEW;
sl@0	591	break;
sl@0	592	case (O_CREAT \| O_TRUNC):
sl@0	593	createMode = CREATE_ALWAYS;
sl@0	594	break;
sl@0	595	case O_CREAT:
sl@0	596	createMode = OPEN_ALWAYS;
sl@0	597	break;
sl@0	598	case O_TRUNC:
sl@0	599	case (O_TRUNC \| O_EXCL):
sl@0	600	createMode = TRUNCATE_EXISTING;
sl@0	601	break;
sl@0	602	default:
sl@0	603	createMode = OPEN_EXISTING;
sl@0	604	break;
sl@0	605	}
sl@0	606
sl@0	607	nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
sl@0	608
sl@0	609	/*
sl@0	610	* If the file is not being created, use the existing file attributes.
sl@0	611	*/
sl@0	612
sl@0	613	flags = 0;
sl@0	614	if (!(mode & O_CREAT)) {
sl@0	615	flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
sl@0	616	if (flags == 0xFFFFFFFF) {
sl@0	617	flags = 0;
sl@0	618	}
sl@0	619	}
sl@0	620
sl@0	621	/*
sl@0	622	* Set up the file sharing mode. We want to allow simultaneous access.
sl@0	623	*/
sl@0	624
sl@0	625	shareMode = FILE_SHARE_READ \| FILE_SHARE_WRITE;
sl@0	626
sl@0	627	/*
sl@0	628	* Now we get to create the file.
sl@0	629	*/
sl@0	630
sl@0	631	handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
sl@0	632	shareMode, NULL, createMode, flags, NULL);
sl@0	633	Tcl_DStringFree(&ds);
sl@0	634
sl@0	635	if (handle == INVALID_HANDLE_VALUE) {
sl@0	636	DWORD err;
sl@0	637
sl@0	638	err = GetLastError();
sl@0	639	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
sl@0	640	err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
sl@0	641	}
sl@0	642	TclWinConvertError(err);
sl@0	643	return NULL;
sl@0	644	}
sl@0	645
sl@0	646	/*
sl@0	647	* Seek to the end of file if we are writing.
sl@0	648	*/
sl@0	649
sl@0	650	if (mode & (O_WRONLY\|O_APPEND)) {
sl@0	651	SetFilePointer(handle, 0, NULL, FILE_END);
sl@0	652	}
sl@0	653
sl@0	654	return TclWinMakeFile(handle);
sl@0	655	}
sl@0	656
sl@0	657	/*
sl@0	658	*----------------------------------------------------------------------
sl@0	659	*
sl@0	660	* TclpCreateTempFile --
sl@0	661	*
sl@0	662	* This function opens a unique file with the property that it
sl@0	663	* will be deleted when its file handle is closed. The temporary
sl@0	664	* file is created in the system temporary directory.
sl@0	665	*
sl@0	666	* Results:
sl@0	667	* Returns a valid TclFile, or NULL on failure.
sl@0	668	*
sl@0	669	* Side effects:
sl@0	670	* Creates a new temporary file.
sl@0	671	*
sl@0	672	*----------------------------------------------------------------------
sl@0	673	*/
sl@0	674
sl@0	675	TclFile
sl@0	676	TclpCreateTempFile(contents)
sl@0	677	CONST char contents; / String to write into temp file, or NULL. */
sl@0	678	{
sl@0	679	WCHAR name[MAX_PATH];
sl@0	680	CONST char *native;
sl@0	681	Tcl_DString dstring;
sl@0	682	HANDLE handle;
sl@0	683
sl@0	684	if (TempFileName(name) == 0) {
sl@0	685	return NULL;
sl@0	686	}
sl@0	687
sl@0	688	handle = (tclWinProcs->createFileProc)((TCHAR ) name,
sl@0	689	GENERIC_READ \| GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
sl@0	690	FILE_ATTRIBUTE_TEMPORARY\|FILE_FLAG_DELETE_ON_CLOSE, NULL);
sl@0	691	if (handle == INVALID_HANDLE_VALUE) {
sl@0	692	goto error;
sl@0	693	}
sl@0	694
sl@0	695	/*
sl@0	696	* Write the file out, doing line translations on the way.
sl@0	697	*/
sl@0	698
sl@0	699	if (contents != NULL) {
sl@0	700	DWORD result, length;
sl@0	701	CONST char *p;
sl@0	702
sl@0	703	/*
sl@0	704	* Convert the contents from UTF to native encoding
sl@0	705	*/
sl@0	706	native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
sl@0	707
sl@0	708	for (p = native; *p != '\0'; p++) {
sl@0	709	if (*p == '\n') {
sl@0	710	length = p - native;
sl@0	711	if (length > 0) {
sl@0	712	if (!WriteFile(handle, native, length, &result, NULL)) {
sl@0	713	goto error;
sl@0	714	}
sl@0	715	}
sl@0	716	if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
sl@0	717	goto error;
sl@0	718	}
sl@0	719	native = p+1;
sl@0	720	}
sl@0	721	}
sl@0	722	length = p - native;
sl@0	723	if (length > 0) {
sl@0	724	if (!WriteFile(handle, native, length, &result, NULL)) {
sl@0	725	goto error;
sl@0	726	}
sl@0	727	}
sl@0	728	Tcl_DStringFree(&dstring);
sl@0	729	if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
sl@0	730	goto error;
sl@0	731	}
sl@0	732	}
sl@0	733
sl@0	734	return TclWinMakeFile(handle);
sl@0	735
sl@0	736	error:
sl@0	737	/* Free the native representation of the contents if necessary */
sl@0	738	if (contents != NULL) {
sl@0	739	Tcl_DStringFree(&dstring);
sl@0	740	}
sl@0	741
sl@0	742	TclWinConvertError(GetLastError());
sl@0	743	CloseHandle(handle);
sl@0	744	(tclWinProcs->deleteFileProc)((TCHAR ) name);
sl@0	745	return NULL;
sl@0	746	}
sl@0	747
sl@0	748	/*
sl@0	749	*----------------------------------------------------------------------
sl@0	750	*
sl@0	751	* TclpTempFileName --
sl@0	752	*
sl@0	753	* This function returns a unique filename.
sl@0	754	*
sl@0	755	* Results:
sl@0	756	* Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
sl@0	757	*
sl@0	758	* Side effects:
sl@0	759	* None.
sl@0	760	*
sl@0	761	*----------------------------------------------------------------------
sl@0	762	*/
sl@0	763
sl@0	764	Tcl_Obj*
sl@0	765	TclpTempFileName()
sl@0	766	{
sl@0	767	WCHAR fileName[MAX_PATH];
sl@0	768
sl@0	769	if (TempFileName(fileName) == 0) {
sl@0	770	return NULL;
sl@0	771	}
sl@0	772
sl@0	773	return TclpNativeToNormalized((ClientData) fileName);
sl@0	774	}
sl@0	775
sl@0	776	/*
sl@0	777	*----------------------------------------------------------------------
sl@0	778	*
sl@0	779	* TclpCreatePipe --
sl@0	780	*
sl@0	781	* Creates an anonymous pipe.
sl@0	782	*
sl@0	783	* Results:
sl@0	784	* Returns 1 on success, 0 on failure.
sl@0	785	*
sl@0	786	* Side effects:
sl@0	787	* Creates a pipe.
sl@0	788	*
sl@0	789	*----------------------------------------------------------------------
sl@0	790	*/
sl@0	791
sl@0	792	int
sl@0	793	TclpCreatePipe(
sl@0	794	TclFile readPipe, / Location to store file handle for
sl@0	795	* read side of pipe. */
sl@0	796	TclFile writePipe) / Location to store file handle for
sl@0	797	* write side of pipe. */
sl@0	798	{
sl@0	799	HANDLE readHandle, writeHandle;
sl@0	800
sl@0	801	if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
sl@0	802	*readPipe = TclWinMakeFile(readHandle);
sl@0	803	*writePipe = TclWinMakeFile(writeHandle);
sl@0	804	return 1;
sl@0	805	}
sl@0	806
sl@0	807	TclWinConvertError(GetLastError());
sl@0	808	return 0;
sl@0	809	}
sl@0	810
sl@0	811	/*
sl@0	812	*----------------------------------------------------------------------
sl@0	813	*
sl@0	814	* TclpCloseFile --
sl@0	815	*
sl@0	816	* Closes a pipeline file handle. These handles are created by
sl@0	817	* TclpOpenFile, TclpCreatePipe, or TclpMakeFile.
sl@0	818	*
sl@0	819	* Results:
sl@0	820	* 0 on success, -1 on failure.
sl@0	821	*
sl@0	822	* Side effects:
sl@0	823	* The file is closed and deallocated.
sl@0	824	*
sl@0	825	*----------------------------------------------------------------------
sl@0	826	*/
sl@0	827
sl@0	828	int
sl@0	829	TclpCloseFile(
sl@0	830	TclFile file) /* The file to close. */
sl@0	831	{
sl@0	832	WinFile filePtr = (WinFile ) file;
sl@0	833
sl@0	834	switch (filePtr->type) {
sl@0	835	case WIN_FILE:
sl@0	836	/*
sl@0	837	* Don't close the Win32 handle if the handle is a standard channel
sl@0	838	* during the thread exit process. Otherwise, one thread may kill
sl@0	839	* the stdio of another.
sl@0	840	*/
sl@0	841
sl@0	842	if (!TclInThreadExit()
sl@0	843	\|\| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
sl@0	844	&& (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
sl@0	845	&& (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
sl@0	846	if (filePtr->handle != NULL &&
sl@0	847	CloseHandle(filePtr->handle) == FALSE) {
sl@0	848	TclWinConvertError(GetLastError());
sl@0	849	ckfree((char *) filePtr);
sl@0	850	return -1;
sl@0	851	}
sl@0	852	}
sl@0	853	break;
sl@0	854
sl@0	855	default:
sl@0	856	panic("TclpCloseFile: unexpected file type");
sl@0	857	}
sl@0	858
sl@0	859	ckfree((char *) filePtr);
sl@0	860	return 0;
sl@0	861	}
sl@0	862
sl@0	863	/*
sl@0	864	*--------------------------------------------------------------------------
sl@0	865	*
sl@0	866	* TclpGetPid --
sl@0	867	*
sl@0	868	* Given a HANDLE to a child process, return the process id for that
sl@0	869	* child process.
sl@0	870	*
sl@0	871	* Results:
sl@0	872	* Returns the process id for the child process. If the pid was not
sl@0	873	* known by Tcl, either because the pid was not created by Tcl or the
sl@0	874	* child process has already been reaped, -1 is returned.
sl@0	875	*
sl@0	876	* Side effects:
sl@0	877	* None.
sl@0	878	*
sl@0	879	*--------------------------------------------------------------------------
sl@0	880	*/
sl@0	881
sl@0	882	unsigned long
sl@0	883	TclpGetPid(
sl@0	884	Tcl_Pid pid) /* The HANDLE of the child process. */
sl@0	885	{
sl@0	886	ProcInfo *infoPtr;
sl@0	887
sl@0	888	PipeInit();
sl@0	889
sl@0	890	Tcl_MutexLock(&pipeMutex);
sl@0	891	for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
sl@0	892	if (infoPtr->hProcess == (HANDLE) pid) {
sl@0	893	Tcl_MutexUnlock(&pipeMutex);
sl@0	894	return infoPtr->dwProcessId;
sl@0	895	}
sl@0	896	}
sl@0	897	Tcl_MutexUnlock(&pipeMutex);
sl@0	898	return (unsigned long) -1;
sl@0	899	}
sl@0	900
sl@0	901	/*
sl@0	902	*----------------------------------------------------------------------
sl@0	903	*
sl@0	904	* TclpCreateProcess --
sl@0	905	*
sl@0	906	* Create a child process that has the specified files as its
sl@0	907	* standard input, output, and error. The child process runs
sl@0	908	* asynchronously under Windows NT and Windows 9x, and runs
sl@0	909	* with the same environment variables as the creating process.
sl@0	910	*
sl@0	911	* The complete Windows search path is searched to find the specified
sl@0	912	* executable. If an executable by the given name is not found,
sl@0	913	* automatically tries appending ".com", ".exe", and ".bat" to the
sl@0	914	* executable name.
sl@0	915	*
sl@0	916	* Results:
sl@0	917	* The return value is TCL_ERROR and an error message is left in
sl@0	918	* the interp's result if there was a problem creating the child
sl@0	919	* process. Otherwise, the return value is TCL_OK and *pidPtr is
sl@0	920	* filled with the process id of the child process.
sl@0	921	*
sl@0	922	* Side effects:
sl@0	923	* A process is created.
sl@0	924	*
sl@0	925	*----------------------------------------------------------------------
sl@0	926	*/
sl@0	927
sl@0	928	int
sl@0	929	TclpCreateProcess(
sl@0	930	Tcl_Interp interp, / Interpreter in which to leave errors that
sl@0	931	* occurred when creating the child process.
sl@0	932	* Error messages from the child process
sl@0	933	* itself are sent to errorFile. */
sl@0	934	int argc, /* Number of arguments in following array. */
sl@0	935	CONST char *argv, / Array of argument strings. argv[0]
sl@0	936	* contains the name of the executable
sl@0	937	* converted to native format (using the
sl@0	938	* Tcl_TranslateFileName call). Additional
sl@0	939	* arguments have not been converted. */
sl@0	940	TclFile inputFile, /* If non-NULL, gives the file to use as
sl@0	941	* input for the child process. If inputFile
sl@0	942	* file is not readable or is NULL, the child
sl@0	943	* will receive no standard input. */
sl@0	944	TclFile outputFile, /* If non-NULL, gives the file that
sl@0	945	* receives output from the child process. If
sl@0	946	* outputFile file is not writeable or is
sl@0	947	* NULL, output from the child will be
sl@0	948	* discarded. */
sl@0	949	TclFile errorFile, /* If non-NULL, gives the file that
sl@0	950	* receives errors from the child process. If
sl@0	951	* errorFile file is not writeable or is NULL,
sl@0	952	* errors from the child will be discarded.
sl@0	953	* errorFile may be the same as outputFile. */
sl@0	954	Tcl_Pid pidPtr) / If this procedure is successful, pidPtr
sl@0	955	* is filled with the process id of the child
sl@0	956	* process. */
sl@0	957	{
sl@0	958	int result, applType, createFlags;
sl@0	959	Tcl_DString cmdLine; /* Complete command line (TCHAR). */
sl@0	960	STARTUPINFOA startInfo;
sl@0	961	PROCESS_INFORMATION procInfo;
sl@0	962	SECURITY_ATTRIBUTES secAtts;
sl@0	963	HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
sl@0	964	char execPath[MAX_PATH * TCL_UTF_MAX];
sl@0	965	WinFile *filePtr;
sl@0	966
sl@0	967	PipeInit();
sl@0	968
sl@0	969	applType = ApplicationType(interp, argv[0], execPath);
sl@0	970	if (applType == APPL_NONE) {
sl@0	971	return TCL_ERROR;
sl@0	972	}
sl@0	973
sl@0	974	result = TCL_ERROR;
sl@0	975	Tcl_DStringInit(&cmdLine);
sl@0	976	hProcess = GetCurrentProcess();
sl@0	977
sl@0	978	/*
sl@0	979	* STARTF_USESTDHANDLES must be used to pass handles to child process.
sl@0	980	* Using SetStdHandle() and/or dup2() only works when a console mode
sl@0	981	* parent process is spawning an attached console mode child process.
sl@0	982	*/
sl@0	983
sl@0	984	ZeroMemory(&startInfo, sizeof(startInfo));
sl@0	985	startInfo.cb = sizeof(startInfo);
sl@0	986	startInfo.dwFlags = STARTF_USESTDHANDLES;
sl@0	987	startInfo.hStdInput = INVALID_HANDLE_VALUE;
sl@0	988	startInfo.hStdOutput= INVALID_HANDLE_VALUE;
sl@0	989	startInfo.hStdError = INVALID_HANDLE_VALUE;
sl@0	990
sl@0	991	secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
sl@0	992	secAtts.lpSecurityDescriptor = NULL;
sl@0	993	secAtts.bInheritHandle = TRUE;
sl@0	994
sl@0	995	/*
sl@0	996	* We have to check the type of each file, since we cannot duplicate
sl@0	997	* some file types.
sl@0	998	*/
sl@0	999
sl@0	1000	inputHandle = INVALID_HANDLE_VALUE;
sl@0	1001	if (inputFile != NULL) {
sl@0	1002	filePtr = (WinFile *)inputFile;
sl@0	1003	if (filePtr->type == WIN_FILE) {
sl@0	1004	inputHandle = filePtr->handle;
sl@0	1005	}
sl@0	1006	}
sl@0	1007	outputHandle = INVALID_HANDLE_VALUE;
sl@0	1008	if (outputFile != NULL) {
sl@0	1009	filePtr = (WinFile *)outputFile;
sl@0	1010	if (filePtr->type == WIN_FILE) {
sl@0	1011	outputHandle = filePtr->handle;
sl@0	1012	}
sl@0	1013	}
sl@0	1014	errorHandle = INVALID_HANDLE_VALUE;
sl@0	1015	if (errorFile != NULL) {
sl@0	1016	filePtr = (WinFile *)errorFile;
sl@0	1017	if (filePtr->type == WIN_FILE) {
sl@0	1018	errorHandle = filePtr->handle;
sl@0	1019	}
sl@0	1020	}
sl@0	1021
sl@0	1022	/*
sl@0	1023	* Duplicate all the handles which will be passed off as stdin, stdout
sl@0	1024	* and stderr of the child process. The duplicate handles are set to
sl@0	1025	* be inheritable, so the child process can use them.
sl@0	1026	*/
sl@0	1027
sl@0	1028	if (inputHandle == INVALID_HANDLE_VALUE) {
sl@0	1029	/*
sl@0	1030	* If handle was not set, stdin should return immediate EOF.
sl@0	1031	* Under Windows95, some applications (both 16 and 32 bit!)
sl@0	1032	* cannot read from the NUL device; they read from console
sl@0	1033	* instead. When running tk, this is fatal because the child
sl@0	1034	* process would hang forever waiting for EOF from the unmapped
sl@0	1035	* console window used by the helper application.
sl@0	1036	*
sl@0	1037	* Fortunately, the helper application detects a closed pipe
sl@0	1038	* as an immediate EOF and can pass that information to the
sl@0	1039	* child process.
sl@0	1040	*/
sl@0	1041
sl@0	1042	if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
sl@0	1043	CloseHandle(h);
sl@0	1044	}
sl@0	1045	} else {
sl@0	1046	DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
sl@0	1047	0, TRUE, DUPLICATE_SAME_ACCESS);
sl@0	1048	}
sl@0	1049	if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
sl@0	1050	TclWinConvertError(GetLastError());
sl@0	1051	Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
sl@0	1052	Tcl_PosixError(interp), (char *) NULL);
sl@0	1053	goto end;
sl@0	1054	}
sl@0	1055
sl@0	1056	if (outputHandle == INVALID_HANDLE_VALUE) {
sl@0	1057	/*
sl@0	1058	* If handle was not set, output should be sent to an infinitely
sl@0	1059	* deep sink. Under Windows 95, some 16 bit applications cannot
sl@0	1060	* have stdout redirected to NUL; they send their output to
sl@0	1061	* the console instead. Some applications, like "more" or "dir /p",
sl@0	1062	* when outputting multiple pages to the console, also then try and
sl@0	1063	* read from the console to go the next page. When running tk, this
sl@0	1064	* is fatal because the child process would hang forever waiting
sl@0	1065	* for input from the unmapped console window used by the helper
sl@0	1066	* application.
sl@0	1067	*
sl@0	1068	* Fortunately, the helper application will detect a closed pipe
sl@0	1069	* as a sink.
sl@0	1070	*/
sl@0	1071
sl@0	1072	if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
sl@0	1073	&& (applType == APPL_DOS)) {
sl@0	1074	if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
sl@0	1075	CloseHandle(h);
sl@0	1076	}
sl@0	1077	} else {
sl@0	1078	startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
sl@0	1079	&secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
sl@0	1080	}
sl@0	1081	} else {
sl@0	1082	DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput,
sl@0	1083	0, TRUE, DUPLICATE_SAME_ACCESS);
sl@0	1084	}
sl@0	1085	if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
sl@0	1086	TclWinConvertError(GetLastError());
sl@0	1087	Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
sl@0	1088	Tcl_PosixError(interp), (char *) NULL);
sl@0	1089	goto end;
sl@0	1090	}
sl@0	1091
sl@0	1092	if (errorHandle == INVALID_HANDLE_VALUE) {
sl@0	1093	/*
sl@0	1094	* If handle was not set, errors should be sent to an infinitely
sl@0	1095	* deep sink.
sl@0	1096	*/
sl@0	1097
sl@0	1098	startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
sl@0	1099	&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
sl@0	1100	} else {
sl@0	1101	DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
sl@0	1102	0, TRUE, DUPLICATE_SAME_ACCESS);
sl@0	1103	}
sl@0	1104	if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
sl@0	1105	TclWinConvertError(GetLastError());
sl@0	1106	Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
sl@0	1107	Tcl_PosixError(interp), (char *) NULL);
sl@0	1108	goto end;
sl@0	1109	}
sl@0	1110	/*
sl@0	1111	* If we do not have a console window, then we must run DOS and
sl@0	1112	* WIN32 console mode applications as detached processes. This tells
sl@0	1113	* the loader that the child application should not inherit the
sl@0	1114	* console, and that it should not create a new console window for
sl@0	1115	* the child application. The child application should get its stdio
sl@0	1116	* from the redirection handles provided by this application, and run
sl@0	1117	* in the background.
sl@0	1118	*
sl@0	1119	* If we are starting a GUI process, they don't automatically get a
sl@0	1120	* console, so it doesn't matter if they are started as foreground or
sl@0	1121	* detached processes. The GUI window will still pop up to the
sl@0	1122	* foreground.
sl@0	1123	*/
sl@0	1124
sl@0	1125	if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
sl@0	1126	if (HasConsole()) {
sl@0	1127	createFlags = 0;
sl@0	1128	} else if (applType == APPL_DOS) {
sl@0	1129	/*
sl@0	1130	* Under NT, 16-bit DOS applications will not run unless they
sl@0	1131	* can be attached to a console. If we are running without a
sl@0	1132	* console, run the 16-bit program as an normal process inside
sl@0	1133	* of a hidden console application, and then run that hidden
sl@0	1134	* console as a detached process.
sl@0	1135	*/
sl@0	1136
sl@0	1137	startInfo.wShowWindow = SW_HIDE;
sl@0	1138	startInfo.dwFlags \|= STARTF_USESHOWWINDOW;
sl@0	1139	createFlags = CREATE_NEW_CONSOLE;
sl@0	1140	Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
sl@0	1141	} else {
sl@0	1142	createFlags = DETACHED_PROCESS;
sl@0	1143	}
sl@0	1144	} else {
sl@0	1145	if (HasConsole()) {
sl@0	1146	createFlags = 0;
sl@0	1147	} else {
sl@0	1148	createFlags = DETACHED_PROCESS;
sl@0	1149	}
sl@0	1150
sl@0	1151	if (applType == APPL_DOS) {
sl@0	1152	/*
sl@0	1153	* Under Windows 95, 16-bit DOS applications do not work well
sl@0	1154	* with pipes:
sl@0	1155	*
sl@0	1156	* 1. EOF on a pipe between a detached 16-bit DOS application
sl@0	1157	* and another application is not seen at the other
sl@0	1158	* end of the pipe, so the listening process blocks forever on
sl@0	1159	* reads. This inablity to detect EOF happens when either a
sl@0	1160	* 16-bit app or the 32-bit app is the listener.
sl@0	1161	*
sl@0	1162	* 2. If a 16-bit DOS application (detached or not) blocks when
sl@0	1163	* writing to a pipe, it will never wake up again, and it
sl@0	1164	* eventually brings the whole system down around it.
sl@0	1165	*
sl@0	1166	* The 16-bit application is run as a normal process inside
sl@0	1167	* of a hidden helper console app, and this helper may be run
sl@0	1168	* as a detached process. If any of the stdio handles is
sl@0	1169	* a pipe, the helper application accumulates information
sl@0	1170	* into temp files and forwards it to or from the DOS
sl@0	1171	* application as appropriate. This means that DOS apps
sl@0	1172	* must receive EOF from a stdin pipe before they will actually
sl@0	1173	* begin, and must finish generating stdout or stderr before
sl@0	1174	* the data will be sent to the next stage of the pipe.
sl@0	1175	*
sl@0	1176	* The helper app should be located in the same directory as
sl@0	1177	* the tcl dll.
sl@0	1178	*/
sl@0	1179
sl@0	1180	if (createFlags != 0) {
sl@0	1181	startInfo.wShowWindow = SW_HIDE;
sl@0	1182	startInfo.dwFlags \|= STARTF_USESHOWWINDOW;
sl@0	1183	createFlags = CREATE_NEW_CONSOLE;
sl@0	1184	}
sl@0	1185
sl@0	1186	{
sl@0	1187	Tcl_Obj tclExePtr, pipeDllPtr;
sl@0	1188	int i, fileExists;
sl@0	1189	char start,end;
sl@0	1190	Tcl_DString pipeDll;
sl@0	1191	Tcl_DStringInit(&pipeDll);
sl@0	1192	Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1);
sl@0	1193	tclExePtr = Tcl_NewStringObj(TclpFindExecutable(""), -1);
sl@0	1194	start = Tcl_GetStringFromObj(tclExePtr, &i);
sl@0	1195	for (end = start + (i-1); end > start; end--) {
sl@0	1196	if (*end == '/')
sl@0	1197	break;
sl@0	1198	}
sl@0	1199	if (*end != '/')
sl@0	1200	panic("no / in executable path name");
sl@0	1201	i = (end - start) + 1;
sl@0	1202	pipeDllPtr = Tcl_NewStringObj(start, i);
sl@0	1203	Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1);
sl@0	1204	Tcl_IncrRefCount(pipeDllPtr);
sl@0	1205	if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK)
sl@0	1206	panic("Tcl_FSConvertToPathType failed");
sl@0	1207	fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0);
sl@0	1208	if (!fileExists) {
sl@0	1209	panic("Tcl pipe dll \"%s\" not found",
sl@0	1210	Tcl_DStringValue(&pipeDll));
sl@0	1211	}
sl@0	1212	Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1);
sl@0	1213	Tcl_DecrRefCount(tclExePtr);
sl@0	1214	Tcl_DecrRefCount(pipeDllPtr);
sl@0	1215	Tcl_DStringFree(&pipeDll);
sl@0	1216	}
sl@0	1217	}
sl@0	1218	}
sl@0	1219
sl@0	1220	/*
sl@0	1221	* cmdLine gets the full command line used to invoke the executable,
sl@0	1222	* including the name of the executable itself. The command line
sl@0	1223	* arguments in argv[] are stored in cmdLine separated by spaces.
sl@0	1224	* Special characters in individual arguments from argv[] must be
sl@0	1225	* quoted when being stored in cmdLine.
sl@0	1226	*
sl@0	1227	* When calling any application, bear in mind that arguments that
sl@0	1228	* specify a path name are not converted. If an argument contains
sl@0	1229	* forward slashes as path separators, it may or may not be
sl@0	1230	* recognized as a path name, depending on the program. In general,
sl@0	1231	* most applications accept forward slashes only as option
sl@0	1232	* delimiters and backslashes only as paths.
sl@0	1233	*
sl@0	1234	* Additionally, when calling a 16-bit dos or windows application,
sl@0	1235	* all path names must use the short, cryptic, path format (e.g.,
sl@0	1236	* using ab~1.def instead of "a b.default").
sl@0	1237	*/
sl@0	1238
sl@0	1239	BuildCommandLine(execPath, argc, argv, &cmdLine);
sl@0	1240
sl@0	1241	if ((*tclWinProcs->createProcessProc)(NULL,
sl@0	1242	(TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
sl@0	1243	(DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
sl@0	1244	TclWinConvertError(GetLastError());
sl@0	1245	Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
sl@0	1246	"\": ", Tcl_PosixError(interp), (char *) NULL);
sl@0	1247	goto end;
sl@0	1248	}
sl@0	1249
sl@0	1250	/*
sl@0	1251	* This wait is used to force the OS to give some time to the DOS
sl@0	1252	* process.
sl@0	1253	*/
sl@0	1254
sl@0	1255	if (applType == APPL_DOS) {
sl@0	1256	WaitForSingleObject(procInfo.hProcess, 50);
sl@0	1257	}
sl@0	1258
sl@0	1259	/*
sl@0	1260	* "When an application spawns a process repeatedly, a new thread
sl@0	1261	* instance will be created for each process but the previous
sl@0	1262	* instances may not be cleaned up. This results in a significant
sl@0	1263	* virtual memory loss each time the process is spawned. If there
sl@0	1264	* is a WaitForInputIdle() call between CreateProcess() and
sl@0	1265	* CloseHandle(), the problem does not occur." PSS ID Number: Q124121
sl@0	1266	*/
sl@0	1267
sl@0	1268	WaitForInputIdle(procInfo.hProcess, 5000);
sl@0	1269	CloseHandle(procInfo.hThread);
sl@0	1270
sl@0	1271	*pidPtr = (Tcl_Pid) procInfo.hProcess;
sl@0	1272	if (*pidPtr != 0) {
sl@0	1273	TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
sl@0	1274	}
sl@0	1275	result = TCL_OK;
sl@0	1276
sl@0	1277	end:
sl@0	1278	Tcl_DStringFree(&cmdLine);
sl@0	1279	if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
sl@0	1280	CloseHandle(startInfo.hStdInput);
sl@0	1281	}
sl@0	1282	if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
sl@0	1283	CloseHandle(startInfo.hStdOutput);
sl@0	1284	}
sl@0	1285	if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
sl@0	1286	CloseHandle(startInfo.hStdError);
sl@0	1287	}
sl@0	1288	return result;
sl@0	1289	}
sl@0	1290
sl@0	1291
sl@0	1292	/*
sl@0	1293	*----------------------------------------------------------------------
sl@0	1294	*
sl@0	1295	* HasConsole --
sl@0	1296	*
sl@0	1297	* Determines whether the current application is attached to a
sl@0	1298	* console.
sl@0	1299	*
sl@0	1300	* Results:
sl@0	1301	* Returns TRUE if this application has a console, else FALSE.
sl@0	1302	*
sl@0	1303	* Side effects:
sl@0	1304	* None.
sl@0	1305	*
sl@0	1306	*----------------------------------------------------------------------
sl@0	1307	*/
sl@0	1308
sl@0	1309	static BOOL
sl@0	1310	HasConsole()
sl@0	1311	{
sl@0	1312	HANDLE handle;
sl@0	1313
sl@0	1314	handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
sl@0	1315	NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
sl@0	1316
sl@0	1317	if (handle != INVALID_HANDLE_VALUE) {
sl@0	1318	CloseHandle(handle);
sl@0	1319	return TRUE;
sl@0	1320	} else {
sl@0	1321	return FALSE;
sl@0	1322	}
sl@0	1323	}
sl@0	1324
sl@0	1325	/*
sl@0	1326	*--------------------------------------------------------------------
sl@0	1327	*
sl@0	1328	* ApplicationType --
sl@0	1329	*
sl@0	1330	* Search for the specified program and identify if it refers to a DOS,
sl@0	1331	* Windows 3.X, or Win32 program. Used to determine how to invoke
sl@0	1332	* a program, or if it can even be invoked.
sl@0	1333	*
sl@0	1334	* It is possible to almost positively identify DOS and Windows
sl@0	1335	* applications that contain the appropriate magic numbers. However,
sl@0	1336	* DOS .com files do not seem to contain a magic number; if the program
sl@0	1337	* name ends with .com and could not be identified as a Windows .com
sl@0	1338	* file, it will be assumed to be a DOS application, even if it was
sl@0	1339	* just random data. If the program name does not end with .com, no
sl@0	1340	* such assumption is made.
sl@0	1341	*
sl@0	1342	* The Win32 procedure GetBinaryType incorrectly identifies any
sl@0	1343	* junk file that ends with .exe as a dos executable and some
sl@0	1344	* executables that don't end with .exe as not executable. Plus it
sl@0	1345	* doesn't exist under win95, so I won't feel bad about reimplementing
sl@0	1346	* functionality.
sl@0	1347	*
sl@0	1348	* Results:
sl@0	1349	* The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32
sl@0	1350	* if the filename referred to the corresponding application type.
sl@0	1351	* If the file name could not be found or did not refer to any known
sl@0	1352	* application type, APPL_NONE is returned and an error message is
sl@0	1353	* left in interp. .bat files are identified as APPL_DOS.
sl@0	1354	*
sl@0	1355	* Side effects:
sl@0	1356	* None.
sl@0	1357	*
sl@0	1358	*----------------------------------------------------------------------
sl@0	1359	*/
sl@0	1360
sl@0	1361	static int
sl@0	1362	ApplicationType(interp, originalName, fullName)
sl@0	1363	Tcl_Interp interp; / Interp, for error message. */
sl@0	1364	const char originalName; / Name of the application to find. */
sl@0	1365	char fullName[]; /* Filled with complete path to
sl@0	1366	* application. */
sl@0	1367	{
sl@0	1368	int applType, i, nameLen, found;
sl@0	1369	HANDLE hFile;
sl@0	1370	TCHAR *rest;
sl@0	1371	char *ext;
sl@0	1372	char buf[2];
sl@0	1373	DWORD attr, read;
sl@0	1374	IMAGE_DOS_HEADER header;
sl@0	1375	Tcl_DString nameBuf, ds;
sl@0	1376	CONST TCHAR *nativeName;
sl@0	1377	WCHAR nativeFullPath[MAX_PATH];
sl@0	1378	static char extensions[][5] = {"", ".com", ".exe", ".bat"};
sl@0	1379
sl@0	1380	/* Look for the program as an external program. First try the name
sl@0	1381	* as it is, then try adding .com, .exe, and .bat, in that order, to
sl@0	1382	* the name, looking for an executable.
sl@0	1383	*
sl@0	1384	* Using the raw SearchPath() procedure doesn't do quite what is
sl@0	1385	* necessary. If the name of the executable already contains a '.'
sl@0	1386	* character, it will not try appending the specified extension when
sl@0	1387	* searching (in other words, SearchPath will not find the program
sl@0	1388	* "a.b.exe" if the arguments specified "a.b" and ".exe").
sl@0	1389	* So, first look for the file as it is named. Then manually append
sl@0	1390	* the extensions, looking for a match.
sl@0	1391	*/
sl@0	1392
sl@0	1393	applType = APPL_NONE;
sl@0	1394	Tcl_DStringInit(&nameBuf);
sl@0	1395	Tcl_DStringAppend(&nameBuf, originalName, -1);
sl@0	1396	nameLen = Tcl_DStringLength(&nameBuf);
sl@0	1397
sl@0	1398	for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
sl@0	1399	Tcl_DStringSetLength(&nameBuf, nameLen);
sl@0	1400	Tcl_DStringAppend(&nameBuf, extensions[i], -1);
sl@0	1401	nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
sl@0	1402	Tcl_DStringLength(&nameBuf), &ds);
sl@0	1403	found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
sl@0	1404	MAX_PATH, nativeFullPath, &rest);
sl@0	1405	Tcl_DStringFree(&ds);
sl@0	1406	if (found == 0) {
sl@0	1407	continue;
sl@0	1408	}
sl@0	1409
sl@0	1410	/*
sl@0	1411	* Ignore matches on directories or data files, return if identified
sl@0	1412	* a known type.
sl@0	1413	*/
sl@0	1414
sl@0	1415	attr = (tclWinProcs->getFileAttributesProc)((TCHAR ) nativeFullPath);
sl@0	1416	if ((attr == 0xffffffff) \|\| (attr & FILE_ATTRIBUTE_DIRECTORY)) {
sl@0	1417	continue;
sl@0	1418	}
sl@0	1419	strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
sl@0	1420	Tcl_DStringFree(&ds);
sl@0	1421
sl@0	1422	ext = strrchr(fullName, '.');
sl@0	1423	if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) {
sl@0	1424	applType = APPL_DOS;
sl@0	1425	break;
sl@0	1426	}
sl@0	1427
sl@0	1428	hFile = (tclWinProcs->createFileProc)((TCHAR ) nativeFullPath,
sl@0	1429	GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
sl@0	1430	FILE_ATTRIBUTE_NORMAL, NULL);
sl@0	1431	if (hFile == INVALID_HANDLE_VALUE) {
sl@0	1432	continue;
sl@0	1433	}
sl@0	1434
sl@0	1435	header.e_magic = 0;
sl@0	1436	ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
sl@0	1437	if (header.e_magic != IMAGE_DOS_SIGNATURE) {
sl@0	1438	/*
sl@0	1439	* Doesn't have the magic number for relocatable executables. If
sl@0	1440	* filename ends with .com, assume it's a DOS application anyhow.
sl@0	1441	* Note that we didn't make this assumption at first, because some
sl@0	1442	* supposed .com files are really 32-bit executables with all the
sl@0	1443	* magic numbers and everything.
sl@0	1444	*/
sl@0	1445
sl@0	1446	CloseHandle(hFile);
sl@0	1447	if ((ext != NULL) && (stricmp(ext, ".com") == 0)) {
sl@0	1448	applType = APPL_DOS;
sl@0	1449	break;
sl@0	1450	}
sl@0	1451	continue;
sl@0	1452	}
sl@0	1453	if (header.e_lfarlc != sizeof(header)) {
sl@0	1454	/*
sl@0	1455	* All Windows 3.X and Win32 and some DOS programs have this value
sl@0	1456	* set here. If it doesn't, assume that since it already had the
sl@0	1457	* other magic number it was a DOS application.
sl@0	1458	*/
sl@0	1459
sl@0	1460	CloseHandle(hFile);
sl@0	1461	applType = APPL_DOS;
sl@0	1462	break;
sl@0	1463	}
sl@0	1464
sl@0	1465	/*
sl@0	1466	* The DWORD at header.e_lfanew points to yet another magic number.
sl@0	1467	*/
sl@0	1468
sl@0	1469	buf[0] = '\0';
sl@0	1470	SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
sl@0	1471	ReadFile(hFile, (void *) buf, 2, &read, NULL);
sl@0	1472	CloseHandle(hFile);
sl@0	1473
sl@0	1474	if ((buf[0] == 'N') && (buf[1] == 'E')) {
sl@0	1475	applType = APPL_WIN3X;
sl@0	1476	} else if ((buf[0] == 'P') && (buf[1] == 'E')) {
sl@0	1477	applType = APPL_WIN32;
sl@0	1478	} else {
sl@0	1479	/*
sl@0	1480	* Strictly speaking, there should be a test that there
sl@0	1481	* is an 'L' and 'E' at buf[0..1], to identify the type as
sl@0	1482	* DOS, but of course we ran into a DOS executable that
sl@0	1483	* _doesn't_ have the magic number -- specifically, one
sl@0	1484	* compiled using the Lahey Fortran90 compiler.
sl@0	1485	*/
sl@0	1486
sl@0	1487	applType = APPL_DOS;
sl@0	1488	}
sl@0	1489	break;
sl@0	1490	}
sl@0	1491	Tcl_DStringFree(&nameBuf);
sl@0	1492
sl@0	1493	if (applType == APPL_NONE) {
sl@0	1494	TclWinConvertError(GetLastError());
sl@0	1495	Tcl_AppendResult(interp, "couldn't execute \"", originalName,
sl@0	1496	"\": ", Tcl_PosixError(interp), (char *) NULL);
sl@0	1497	return APPL_NONE;
sl@0	1498	}
sl@0	1499
sl@0	1500	if ((applType == APPL_DOS) \|\| (applType == APPL_WIN3X)) {
sl@0	1501	/*
sl@0	1502	* Replace long path name of executable with short path name for
sl@0	1503	* 16-bit applications. Otherwise the application may not be able
sl@0	1504	* to correctly parse its own command line to separate off the
sl@0	1505	* application name from the arguments.
sl@0	1506	*/
sl@0	1507
sl@0	1508	(tclWinProcs->getShortPathNameProc)((TCHAR ) nativeFullPath,
sl@0	1509	nativeFullPath, MAX_PATH);
sl@0	1510	strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
sl@0	1511	Tcl_DStringFree(&ds);
sl@0	1512	}
sl@0	1513	return applType;
sl@0	1514	}
sl@0	1515
sl@0	1516	/*
sl@0	1517	*----------------------------------------------------------------------
sl@0	1518	*
sl@0	1519	* BuildCommandLine --
sl@0	1520	*
sl@0	1521	* The command line arguments are stored in linePtr separated
sl@0	1522	* by spaces, in a form that CreateProcess() understands. Special
sl@0	1523	* characters in individual arguments from argv[] must be quoted
sl@0	1524	* when being stored in cmdLine.
sl@0	1525	*
sl@0	1526	* Results:
sl@0	1527	* None.
sl@0	1528	*
sl@0	1529	* Side effects:
sl@0	1530	* None.
sl@0	1531	*
sl@0	1532	*----------------------------------------------------------------------
sl@0	1533	*/
sl@0	1534
sl@0	1535	static void
sl@0	1536	BuildCommandLine(
sl@0	1537	CONST char executable, / Full path of executable (including
sl@0	1538	* extension). Replacement for argv[0]. */
sl@0	1539	int argc, /* Number of arguments. */
sl@0	1540	CONST char *argv, / Argument strings in UTF. */
sl@0	1541	Tcl_DString linePtr) / Initialized Tcl_DString that receives the
sl@0	1542	* command line (TCHAR). */
sl@0	1543	{
sl@0	1544	CONST char arg, start, *special;
sl@0	1545	int quote, i;
sl@0	1546	Tcl_DString ds;
sl@0	1547
sl@0	1548	Tcl_DStringInit(&ds);
sl@0	1549
sl@0	1550	/*
sl@0	1551	* Prime the path. Add a space separator if we were primed with
sl@0	1552	* something.
sl@0	1553	*/
sl@0	1554
sl@0	1555	Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
sl@0	1556	if (Tcl_DStringLength(&ds) > 0) Tcl_DStringAppend(&ds, " ", 1);
sl@0	1557
sl@0	1558	for (i = 0; i < argc; i++) {
sl@0	1559	if (i == 0) {
sl@0	1560	arg = executable;
sl@0	1561	} else {
sl@0	1562	arg = argv[i];
sl@0	1563	Tcl_DStringAppend(&ds, " ", 1);
sl@0	1564	}
sl@0	1565
sl@0	1566	quote = 0;
sl@0	1567	if (arg[0] == '\0') {
sl@0	1568	quote = 1;
sl@0	1569	} else {
sl@0	1570	int count;
sl@0	1571	Tcl_UniChar ch;
sl@0	1572	for (start = arg; *start != '\0'; start += count) {
sl@0	1573	count = Tcl_UtfToUniChar(start, &ch);
sl@0	1574	if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */
sl@0	1575	quote = 1;
sl@0	1576	break;
sl@0	1577	}
sl@0	1578	}
sl@0	1579	}
sl@0	1580	if (quote) {
sl@0	1581	Tcl_DStringAppend(&ds, "\"", 1);
sl@0	1582	}
sl@0	1583	start = arg;
sl@0	1584	for (special = arg; ; ) {
sl@0	1585	if ((*special == '\\') &&
sl@0	1586	(special[1] == '\\' \|\| special[1] == '"' \|\| (quote && special[1] == '\0'))) {
sl@0	1587	Tcl_DStringAppend(&ds, start, (int) (special - start));
sl@0	1588	start = special;
sl@0	1589	while (1) {
sl@0	1590	special++;
sl@0	1591	if (special == '"' \|\| (quote && special == '\0')) {
sl@0	1592	/*
sl@0	1593	* N backslashes followed a quote -> insert
sl@0	1594	* N * 2 + 1 backslashes then a quote.
sl@0	1595	*/
sl@0	1596
sl@0	1597	Tcl_DStringAppend(&ds, start,
sl@0	1598	(int) (special - start));
sl@0	1599	break;
sl@0	1600	}
sl@0	1601	if (*special != '\\') {
sl@0	1602	break;
sl@0	1603	}
sl@0	1604	}
sl@0	1605	Tcl_DStringAppend(&ds, start, (int) (special - start));
sl@0	1606	start = special;
sl@0	1607	}
sl@0	1608	if (*special == '"') {
sl@0	1609	Tcl_DStringAppend(&ds, start, (int) (special - start));
sl@0	1610	Tcl_DStringAppend(&ds, "\\\"", 2);
sl@0	1611	start = special + 1;
sl@0	1612	}
sl@0	1613	if (*special == '\0') {
sl@0	1614	break;
sl@0	1615	}
sl@0	1616	special++;
sl@0	1617	}
sl@0	1618	Tcl_DStringAppend(&ds, start, (int) (special - start));
sl@0	1619	if (quote) {
sl@0	1620	Tcl_DStringAppend(&ds, "\"", 1);
sl@0	1621	}
sl@0	1622	}
sl@0	1623	Tcl_DStringFree(linePtr);
sl@0	1624	Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
sl@0	1625	Tcl_DStringFree(&ds);
sl@0	1626	}
sl@0	1627
sl@0	1628	/*
sl@0	1629	*----------------------------------------------------------------------
sl@0	1630	*
sl@0	1631	* TclpCreateCommandChannel --
sl@0	1632	*
sl@0	1633	* This function is called by Tcl_OpenCommandChannel to perform
sl@0	1634	* the platform specific channel initialization for a command
sl@0	1635	* channel.
sl@0	1636	*
sl@0	1637	* Results:
sl@0	1638	* Returns a new channel or NULL on failure.
sl@0	1639	*
sl@0	1640	* Side effects:
sl@0	1641	* Allocates a new channel.
sl@0	1642	*
sl@0	1643	*----------------------------------------------------------------------
sl@0	1644	*/
sl@0	1645
sl@0	1646	Tcl_Channel
sl@0	1647	TclpCreateCommandChannel(
sl@0	1648	TclFile readFile, /* If non-null, gives the file for reading. */
sl@0	1649	TclFile writeFile, /* If non-null, gives the file for writing. */
sl@0	1650	TclFile errorFile, /* If non-null, gives the file where errors
sl@0	1651	* can be read. */
sl@0	1652	int numPids, /* The number of pids in the pid array. */
sl@0	1653	Tcl_Pid pidPtr) / An array of process identifiers. */
sl@0	1654	{
sl@0	1655	char channelName[16 + TCL_INTEGER_SPACE];
sl@0	1656	int channelId;
sl@0	1657	DWORD id;
sl@0	1658	PipeInfo infoPtr = (PipeInfo ) ckalloc((unsigned) sizeof(PipeInfo));
sl@0	1659
sl@0	1660	PipeInit();
sl@0	1661
sl@0	1662	infoPtr->watchMask = 0;
sl@0	1663	infoPtr->flags = 0;
sl@0	1664	infoPtr->readFlags = 0;
sl@0	1665	infoPtr->readFile = readFile;
sl@0	1666	infoPtr->writeFile = writeFile;
sl@0	1667	infoPtr->errorFile = errorFile;
sl@0	1668	infoPtr->numPids = numPids;
sl@0	1669	infoPtr->pidPtr = pidPtr;
sl@0	1670	infoPtr->writeBuf = 0;
sl@0	1671	infoPtr->writeBufLen = 0;
sl@0	1672	infoPtr->writeError = 0;
sl@0	1673	infoPtr->channel = (Tcl_Channel) NULL;
sl@0	1674
sl@0	1675	/*
sl@0	1676	* Use one of the fds associated with the channel as the
sl@0	1677	* channel id.
sl@0	1678	*/
sl@0	1679
sl@0	1680	if (readFile) {
sl@0	1681	channelId = (int) ((WinFile*)readFile)->handle;
sl@0	1682	} else if (writeFile) {
sl@0	1683	channelId = (int) ((WinFile*)writeFile)->handle;
sl@0	1684	} else if (errorFile) {
sl@0	1685	channelId = (int) ((WinFile*)errorFile)->handle;
sl@0	1686	} else {
sl@0	1687	channelId = 0;
sl@0	1688	}
sl@0	1689
sl@0	1690	infoPtr->validMask = 0;
sl@0	1691
sl@0	1692	infoPtr->threadId = Tcl_GetCurrentThread();
sl@0	1693
sl@0	1694	if (readFile != NULL) {
sl@0	1695	/*
sl@0	1696	* Start the background reader thread.
sl@0	1697	*/
sl@0	1698
sl@0	1699	infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
sl@0	1700	infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
sl@0	1701	infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
sl@0	1702	infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
sl@0	1703	infoPtr, 0, &id);
sl@0	1704	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
sl@0	1705	infoPtr->validMask \|= TCL_READABLE;
sl@0	1706	} else {
sl@0	1707	infoPtr->readThread = 0;
sl@0	1708	}
sl@0	1709	if (writeFile != NULL) {
sl@0	1710	/*
sl@0	1711	* Start the background writer thread.
sl@0	1712	*/
sl@0	1713
sl@0	1714	infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
sl@0	1715	infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
sl@0	1716	infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL);
sl@0	1717	infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
sl@0	1718	infoPtr, 0, &id);
sl@0	1719	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
sl@0	1720	infoPtr->validMask \|= TCL_WRITABLE;
sl@0	1721	}
sl@0	1722
sl@0	1723	/*
sl@0	1724	* For backward compatibility with previous versions of Tcl, we
sl@0	1725	* use "file%d" as the base name for pipes even though it would
sl@0	1726	* be more natural to use "pipe%d".
sl@0	1727	* Use the pointer to keep the channel names unique, in case
sl@0	1728	* channels share handles (stdin/stdout).
sl@0	1729	*/
sl@0	1730
sl@0	1731	wsprintfA(channelName, "file%lx", infoPtr);
sl@0	1732	infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
sl@0	1733	(ClientData) infoPtr, infoPtr->validMask);
sl@0	1734
sl@0	1735	/*
sl@0	1736	* Pipes have AUTO translation mode on Windows and ^Z eof char, which
sl@0	1737	* means that a ^Z will be appended to them at close. This is needed
sl@0	1738	* for Windows programs that expect a ^Z at EOF.
sl@0	1739	*/
sl@0	1740
sl@0	1741	Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
sl@0	1742	"-translation", "auto");
sl@0	1743	Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
sl@0	1744	"-eofchar", "\032 {}");
sl@0	1745	return infoPtr->channel;
sl@0	1746	}
sl@0	1747
sl@0	1748	/*
sl@0	1749	*----------------------------------------------------------------------
sl@0	1750	*
sl@0	1751	* TclGetAndDetachPids --
sl@0	1752	*
sl@0	1753	* Stores a list of the command PIDs for a command channel in
sl@0	1754	* the interp's result.
sl@0	1755	*
sl@0	1756	* Results:
sl@0	1757	* None.
sl@0	1758	*
sl@0	1759	* Side effects:
sl@0	1760	* Modifies the interp's result.
sl@0	1761	*
sl@0	1762	*----------------------------------------------------------------------
sl@0	1763	*/
sl@0	1764
sl@0	1765	void
sl@0	1766	TclGetAndDetachPids(
sl@0	1767	Tcl_Interp *interp,
sl@0	1768	Tcl_Channel chan)
sl@0	1769	{
sl@0	1770	PipeInfo *pipePtr;
sl@0	1771	Tcl_ChannelType *chanTypePtr;
sl@0	1772	int i;
sl@0	1773	char buf[TCL_INTEGER_SPACE];
sl@0	1774
sl@0	1775	/*
sl@0	1776	* Punt if the channel is not a command channel.
sl@0	1777	*/
sl@0	1778
sl@0	1779	chanTypePtr = Tcl_GetChannelType(chan);
sl@0	1780	if (chanTypePtr != &pipeChannelType) {
sl@0	1781	return;
sl@0	1782	}
sl@0	1783
sl@0	1784	pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
sl@0	1785	for (i = 0; i < pipePtr->numPids; i++) {
sl@0	1786	wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
sl@0	1787	Tcl_AppendElement(interp, buf);
sl@0	1788	Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
sl@0	1789	}
sl@0	1790	if (pipePtr->numPids > 0) {
sl@0	1791	ckfree((char *) pipePtr->pidPtr);
sl@0	1792	pipePtr->numPids = 0;
sl@0	1793	}
sl@0	1794	}
sl@0	1795
sl@0	1796	/*
sl@0	1797	*----------------------------------------------------------------------
sl@0	1798	*
sl@0	1799	* PipeBlockModeProc --
sl@0	1800	*
sl@0	1801	* Set blocking or non-blocking mode on channel.
sl@0	1802	*
sl@0	1803	* Results:
sl@0	1804	* 0 if successful, errno when failed.
sl@0	1805	*
sl@0	1806	* Side effects:
sl@0	1807	* Sets the device into blocking or non-blocking mode.
sl@0	1808	*
sl@0	1809	*----------------------------------------------------------------------
sl@0	1810	*/
sl@0	1811
sl@0	1812	static int
sl@0	1813	PipeBlockModeProc(
sl@0	1814	ClientData instanceData, /* Instance data for channel. */
sl@0	1815	int mode) /* TCL_MODE_BLOCKING or
sl@0	1816	* TCL_MODE_NONBLOCKING. */
sl@0	1817	{
sl@0	1818	PipeInfo infoPtr = (PipeInfo ) instanceData;
sl@0	1819
sl@0	1820	/*
sl@0	1821	* Pipes on Windows can not be switched between blocking and nonblocking,
sl@0	1822	* hence we have to emulate the behavior. This is done in the input
sl@0	1823	* function by checking against a bit in the state. We set or unset the
sl@0	1824	* bit here to cause the input function to emulate the correct behavior.
sl@0	1825	*/
sl@0	1826
sl@0	1827	if (mode == TCL_MODE_NONBLOCKING) {
sl@0	1828	infoPtr->flags \|= PIPE_ASYNC;
sl@0	1829	} else {
sl@0	1830	infoPtr->flags &= ~(PIPE_ASYNC);
sl@0	1831	}
sl@0	1832	return 0;
sl@0	1833	}
sl@0	1834
sl@0	1835	/*
sl@0	1836	*----------------------------------------------------------------------
sl@0	1837	*
sl@0	1838	* PipeClose2Proc --
sl@0	1839	*
sl@0	1840	* Closes a pipe based IO channel.
sl@0	1841	*
sl@0	1842	* Results:
sl@0	1843	* 0 on success, errno otherwise.
sl@0	1844	*
sl@0	1845	* Side effects:
sl@0	1846	* Closes the physical channel.
sl@0	1847	*
sl@0	1848	*----------------------------------------------------------------------
sl@0	1849	*/
sl@0	1850
sl@0	1851	static int
sl@0	1852	PipeClose2Proc(
sl@0	1853	ClientData instanceData, /* Pointer to PipeInfo structure. */
sl@0	1854	Tcl_Interp interp, / For error reporting. */
sl@0	1855	int flags) /* Flags that indicate which side to close. */
sl@0	1856	{
sl@0	1857	PipeInfo pipePtr = (PipeInfo ) instanceData;
sl@0	1858	Tcl_Channel errChan;
sl@0	1859	int errorCode, result;
sl@0	1860	PipeInfo infoPtr, *nextPtrPtr;
sl@0	1861	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	1862	DWORD exitCode;
sl@0	1863
sl@0	1864	errorCode = 0;
sl@0	1865	if ((!flags \|\| (flags == TCL_CLOSE_READ))
sl@0	1866	&& (pipePtr->readFile != NULL)) {
sl@0	1867	/*
sl@0	1868	* Clean up the background thread if necessary. Note that this
sl@0	1869	* must be done before we can close the file, since the
sl@0	1870	* thread may be blocking trying to read from the pipe.
sl@0	1871	*/
sl@0	1872
sl@0	1873	if (pipePtr->readThread) {
sl@0	1874	/*
sl@0	1875	* The thread may already have closed on it's own. Check it's
sl@0	1876	* exit code.
sl@0	1877	*/
sl@0	1878
sl@0	1879	GetExitCodeThread(pipePtr->readThread, &exitCode);
sl@0	1880
sl@0	1881	if (exitCode == STILL_ACTIVE) {
sl@0	1882	/*
sl@0	1883	* Set the stop event so that if the reader thread is blocked
sl@0	1884	* in PipeReaderThread on WaitForMultipleEvents, it will exit
sl@0	1885	* cleanly.
sl@0	1886	*/
sl@0	1887
sl@0	1888	SetEvent(pipePtr->stopReader);
sl@0	1889
sl@0	1890	/*
sl@0	1891	* Wait at most 20 milliseconds for the reader thread to close.
sl@0	1892	*/
sl@0	1893
sl@0	1894	if (WaitForSingleObject(pipePtr->readThread, 20)
sl@0	1895	== WAIT_TIMEOUT) {
sl@0	1896	/*
sl@0	1897	* The thread must be blocked waiting for the pipe to
sl@0	1898	* become readable in ReadFile(). There isn't a clean way
sl@0	1899	* to exit the thread from this condition. We should
sl@0	1900	* terminate the child process instead to get the reader
sl@0	1901	* thread to fall out of ReadFile with a FALSE. (below) is
sl@0	1902	* not the correct way to do this, but will stay here until
sl@0	1903	* a better solution is found.
sl@0	1904	*
sl@0	1905	* Note that we need to guard against terminating the
sl@0	1906	* thread while it is in the middle of Tcl_ThreadAlert
sl@0	1907	* because it won't be able to release the notifier lock.
sl@0	1908	*/
sl@0	1909
sl@0	1910	Tcl_MutexLock(&pipeMutex);
sl@0	1911
sl@0	1912	/* BUG: this leaks memory */
sl@0	1913	TerminateThread(pipePtr->readThread, 0);
sl@0	1914	Tcl_MutexUnlock(&pipeMutex);
sl@0	1915	}
sl@0	1916	}
sl@0	1917
sl@0	1918	CloseHandle(pipePtr->readThread);
sl@0	1919	CloseHandle(pipePtr->readable);
sl@0	1920	CloseHandle(pipePtr->startReader);
sl@0	1921	CloseHandle(pipePtr->stopReader);
sl@0	1922	pipePtr->readThread = NULL;
sl@0	1923	}
sl@0	1924	if (TclpCloseFile(pipePtr->readFile) != 0) {
sl@0	1925	errorCode = errno;
sl@0	1926	}
sl@0	1927	pipePtr->validMask &= ~TCL_READABLE;
sl@0	1928	pipePtr->readFile = NULL;
sl@0	1929	}
sl@0	1930	if ((!flags \|\| (flags & TCL_CLOSE_WRITE))
sl@0	1931	&& (pipePtr->writeFile != NULL)) {
sl@0	1932
sl@0	1933	if (pipePtr->writeThread) {
sl@0	1934	/*
sl@0	1935	* Wait for the writer thread to finish the current buffer,
sl@0	1936	* then terminate the thread and close the handles. If the
sl@0	1937	* channel is nonblocking, there should be no pending write
sl@0	1938	* operations.
sl@0	1939	*/
sl@0	1940
sl@0	1941	WaitForSingleObject(pipePtr->writable, INFINITE);
sl@0	1942
sl@0	1943	/*
sl@0	1944	* The thread may already have closed on it's own. Check it's
sl@0	1945	* exit code.
sl@0	1946	*/
sl@0	1947
sl@0	1948	GetExitCodeThread(pipePtr->writeThread, &exitCode);
sl@0	1949
sl@0	1950	if (exitCode == STILL_ACTIVE) {
sl@0	1951	/*
sl@0	1952	* Set the stop event so that if the reader thread is blocked
sl@0	1953	* in PipeReaderThread on WaitForMultipleEvents, it will exit
sl@0	1954	* cleanly.
sl@0	1955	*/
sl@0	1956
sl@0	1957	SetEvent(pipePtr->stopWriter);
sl@0	1958
sl@0	1959	/*
sl@0	1960	* Wait at most 20 milliseconds for the reader thread to close.
sl@0	1961	*/
sl@0	1962
sl@0	1963	if (WaitForSingleObject(pipePtr->writeThread, 20)
sl@0	1964	== WAIT_TIMEOUT) {
sl@0	1965	/*
sl@0	1966	* The thread must be blocked waiting for the pipe to
sl@0	1967	* consume input in WriteFile(). There isn't a clean way
sl@0	1968	* to exit the thread from this condition. We should
sl@0	1969	* terminate the child process instead to get the writer
sl@0	1970	* thread to fall out of WriteFile with a FALSE. (below) is
sl@0	1971	* not the correct way to do this, but will stay here until
sl@0	1972	* a better solution is found.
sl@0	1973	*
sl@0	1974	* Note that we need to guard against terminating the
sl@0	1975	* thread while it is in the middle of Tcl_ThreadAlert
sl@0	1976	* because it won't be able to release the notifier lock.
sl@0	1977	*/
sl@0	1978
sl@0	1979	Tcl_MutexLock(&pipeMutex);
sl@0	1980
sl@0	1981	/* BUG: this leaks memory */
sl@0	1982	TerminateThread(pipePtr->writeThread, 0);
sl@0	1983	Tcl_MutexUnlock(&pipeMutex);
sl@0	1984	}
sl@0	1985	}
sl@0	1986
sl@0	1987	CloseHandle(pipePtr->writeThread);
sl@0	1988	CloseHandle(pipePtr->writable);
sl@0	1989	CloseHandle(pipePtr->startWriter);
sl@0	1990	CloseHandle(pipePtr->stopWriter);
sl@0	1991	pipePtr->writeThread = NULL;
sl@0	1992	}
sl@0	1993	if (TclpCloseFile(pipePtr->writeFile) != 0) {
sl@0	1994	if (errorCode == 0) {
sl@0	1995	errorCode = errno;
sl@0	1996	}
sl@0	1997	}
sl@0	1998	pipePtr->validMask &= ~TCL_WRITABLE;
sl@0	1999	pipePtr->writeFile = NULL;
sl@0	2000	}
sl@0	2001
sl@0	2002	pipePtr->watchMask &= pipePtr->validMask;
sl@0	2003
sl@0	2004	/*
sl@0	2005	* Don't free the channel if any of the flags were set.
sl@0	2006	*/
sl@0	2007
sl@0	2008	if (flags) {
sl@0	2009	return errorCode;
sl@0	2010	}
sl@0	2011
sl@0	2012	/*
sl@0	2013	* Remove the file from the list of watched files.
sl@0	2014	*/
sl@0	2015
sl@0	2016	for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr;
sl@0	2017	infoPtr != NULL;
sl@0	2018	nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
sl@0	2019	if (infoPtr == (PipeInfo *)pipePtr) {
sl@0	2020	*nextPtrPtr = infoPtr->nextPtr;
sl@0	2021	break;
sl@0	2022	}
sl@0	2023	}
sl@0	2024
sl@0	2025	if ((pipePtr->flags & PIPE_ASYNC) \|\| TclInExit()) {
sl@0	2026	/*
sl@0	2027	* If the channel is non-blocking or Tcl is being cleaned up,
sl@0	2028	* just detach the children PIDs, reap them (important if we are
sl@0	2029	* in a dynamic load module), and discard the errorFile.
sl@0	2030	*/
sl@0	2031
sl@0	2032	Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
sl@0	2033	Tcl_ReapDetachedProcs();
sl@0	2034
sl@0	2035	if (pipePtr->errorFile) {
sl@0	2036	if (TclpCloseFile(pipePtr->errorFile) != 0) {
sl@0	2037	if ( errorCode == 0 ) {
sl@0	2038	errorCode = errno;
sl@0	2039	}
sl@0	2040	}
sl@0	2041	}
sl@0	2042	result = 0;
sl@0	2043	} else {
sl@0	2044	/*
sl@0	2045	* Wrap the error file into a channel and give it to the cleanup
sl@0	2046	* routine.
sl@0	2047	*/
sl@0	2048
sl@0	2049	if (pipePtr->errorFile) {
sl@0	2050	WinFile *filePtr;
sl@0	2051
sl@0	2052	filePtr = (WinFile*)pipePtr->errorFile;
sl@0	2053	errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
sl@0	2054	TCL_READABLE);
sl@0	2055	ckfree((char *) filePtr);
sl@0	2056	} else {
sl@0	2057	errChan = NULL;
sl@0	2058	}
sl@0	2059
sl@0	2060	result = TclCleanupChildren(interp, pipePtr->numPids,
sl@0	2061	pipePtr->pidPtr, errChan);
sl@0	2062	}
sl@0	2063
sl@0	2064	if (pipePtr->numPids > 0) {
sl@0	2065	ckfree((char *) pipePtr->pidPtr);
sl@0	2066	}
sl@0	2067
sl@0	2068	if (pipePtr->writeBuf != NULL) {
sl@0	2069	ckfree(pipePtr->writeBuf);
sl@0	2070	}
sl@0	2071
sl@0	2072	ckfree((char*) pipePtr);
sl@0	2073
sl@0	2074	if (errorCode == 0) {
sl@0	2075	return result;
sl@0	2076	}
sl@0	2077	return errorCode;
sl@0	2078	}
sl@0	2079
sl@0	2080	/*
sl@0	2081	*----------------------------------------------------------------------
sl@0	2082	*
sl@0	2083	* PipeInputProc --
sl@0	2084	*
sl@0	2085	* Reads input from the IO channel into the buffer given. Returns
sl@0	2086	* count of how many bytes were actually read, and an error indication.
sl@0	2087	*
sl@0	2088	* Results:
sl@0	2089	* A count of how many bytes were read is returned and an error
sl@0	2090	* indication is returned in an output argument.
sl@0	2091	*
sl@0	2092	* Side effects:
sl@0	2093	* Reads input from the actual channel.
sl@0	2094	*
sl@0	2095	*----------------------------------------------------------------------
sl@0	2096	*/
sl@0	2097
sl@0	2098	static int
sl@0	2099	PipeInputProc(
sl@0	2100	ClientData instanceData, /* Pipe state. */
sl@0	2101	char buf, / Where to store data read. */
sl@0	2102	int bufSize, /* How much space is available
sl@0	2103	* in the buffer? */
sl@0	2104	int errorCode) / Where to store error code. */
sl@0	2105	{
sl@0	2106	PipeInfo infoPtr = (PipeInfo ) instanceData;
sl@0	2107	WinFile filePtr = (WinFile) infoPtr->readFile;
sl@0	2108	DWORD count, bytesRead = 0;
sl@0	2109	int result;
sl@0	2110
sl@0	2111	*errorCode = 0;
sl@0	2112	/*
sl@0	2113	* Synchronize with the reader thread.
sl@0	2114	*/
sl@0	2115
sl@0	2116	result = WaitForRead(infoPtr, (infoPtr->flags & PIPE_ASYNC) ? 0 : 1);
sl@0	2117
sl@0	2118	/*
sl@0	2119	* If an error occurred, return immediately.
sl@0	2120	*/
sl@0	2121
sl@0	2122	if (result == -1) {
sl@0	2123	*errorCode = errno;
sl@0	2124	return -1;
sl@0	2125	}
sl@0	2126
sl@0	2127	if (infoPtr->readFlags & PIPE_EXTRABYTE) {
sl@0	2128	/*
sl@0	2129	* The reader thread consumed 1 byte as a side effect of
sl@0	2130	* waiting so we need to move it into the buffer.
sl@0	2131	*/
sl@0	2132
sl@0	2133	*buf = infoPtr->extraByte;
sl@0	2134	infoPtr->readFlags &= ~PIPE_EXTRABYTE;
sl@0	2135	buf++;
sl@0	2136	bufSize--;
sl@0	2137	bytesRead = 1;
sl@0	2138
sl@0	2139	/*
sl@0	2140	* If further read attempts would block, return what we have.
sl@0	2141	*/
sl@0	2142
sl@0	2143	if (result == 0) {
sl@0	2144	return bytesRead;
sl@0	2145	}
sl@0	2146	}
sl@0	2147
sl@0	2148	/*
sl@0	2149	* Attempt to read bufSize bytes. The read will return immediately
sl@0	2150	* if there is any data available. Otherwise it will block until
sl@0	2151	* at least one byte is available or an EOF occurs.
sl@0	2152	*/
sl@0	2153
sl@0	2154	if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
sl@0	2155	(LPOVERLAPPED) NULL) == TRUE) {
sl@0	2156	return bytesRead + count;
sl@0	2157	} else if (bytesRead) {
sl@0	2158	/*
sl@0	2159	* Ignore errors if we have data to return.
sl@0	2160	*/
sl@0	2161
sl@0	2162	return bytesRead;
sl@0	2163	}
sl@0	2164
sl@0	2165	TclWinConvertError(GetLastError());
sl@0	2166	if (errno == EPIPE) {
sl@0	2167	infoPtr->readFlags \|= PIPE_EOF;
sl@0	2168	return 0;
sl@0	2169	}
sl@0	2170	*errorCode = errno;
sl@0	2171	return -1;
sl@0	2172	}
sl@0	2173
sl@0	2174	/*
sl@0	2175	*----------------------------------------------------------------------
sl@0	2176	*
sl@0	2177	* PipeOutputProc --
sl@0	2178	*
sl@0	2179	* Writes the given output on the IO channel. Returns count of how
sl@0	2180	* many characters were actually written, and an error indication.
sl@0	2181	*
sl@0	2182	* Results:
sl@0	2183	* A count of how many characters were written is returned and an
sl@0	2184	* error indication is returned in an output argument.
sl@0	2185	*
sl@0	2186	* Side effects:
sl@0	2187	* Writes output on the actual channel.
sl@0	2188	*
sl@0	2189	*----------------------------------------------------------------------
sl@0	2190	*/
sl@0	2191
sl@0	2192	static int
sl@0	2193	PipeOutputProc(
sl@0	2194	ClientData instanceData, /* Pipe state. */
sl@0	2195	CONST char buf, / The data buffer. */
sl@0	2196	int toWrite, /* How many bytes to write? */
sl@0	2197	int errorCode) / Where to store error code. */
sl@0	2198	{
sl@0	2199	PipeInfo infoPtr = (PipeInfo ) instanceData;
sl@0	2200	WinFile filePtr = (WinFile) infoPtr->writeFile;
sl@0	2201	DWORD bytesWritten, timeout;
sl@0	2202
sl@0	2203	*errorCode = 0;
sl@0	2204	timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
sl@0	2205	if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
sl@0	2206	/*
sl@0	2207	* The writer thread is blocked waiting for a write to complete
sl@0	2208	* and the channel is in non-blocking mode.
sl@0	2209	*/
sl@0	2210
sl@0	2211	errno = EAGAIN;
sl@0	2212	goto error;
sl@0	2213	}
sl@0	2214
sl@0	2215	/*
sl@0	2216	* Check for a background error on the last write.
sl@0	2217	*/
sl@0	2218
sl@0	2219	if (infoPtr->writeError) {
sl@0	2220	TclWinConvertError(infoPtr->writeError);
sl@0	2221	infoPtr->writeError = 0;
sl@0	2222	goto error;
sl@0	2223	}
sl@0	2224
sl@0	2225	if (infoPtr->flags & PIPE_ASYNC) {
sl@0	2226	/*
sl@0	2227	* The pipe is non-blocking, so copy the data into the output
sl@0	2228	* buffer and restart the writer thread.
sl@0	2229	*/
sl@0	2230
sl@0	2231	if (toWrite > infoPtr->writeBufLen) {
sl@0	2232	/*
sl@0	2233	* Reallocate the buffer to be large enough to hold the data.
sl@0	2234	*/
sl@0	2235
sl@0	2236	if (infoPtr->writeBuf) {
sl@0	2237	ckfree(infoPtr->writeBuf);
sl@0	2238	}
sl@0	2239	infoPtr->writeBufLen = toWrite;
sl@0	2240	infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
sl@0	2241	}
sl@0	2242	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
sl@0	2243	infoPtr->toWrite = toWrite;
sl@0	2244	ResetEvent(infoPtr->writable);
sl@0	2245	SetEvent(infoPtr->startWriter);
sl@0	2246	bytesWritten = toWrite;
sl@0	2247	} else {
sl@0	2248	/*
sl@0	2249	* In the blocking case, just try to write the buffer directly.
sl@0	2250	* This avoids an unnecessary copy.
sl@0	2251	*/
sl@0	2252
sl@0	2253	if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
sl@0	2254	&bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
sl@0	2255	TclWinConvertError(GetLastError());
sl@0	2256	goto error;
sl@0	2257	}
sl@0	2258	}
sl@0	2259	return bytesWritten;
sl@0	2260
sl@0	2261	error:
sl@0	2262	*errorCode = errno;
sl@0	2263	return -1;
sl@0	2264
sl@0	2265	}
sl@0	2266
sl@0	2267	/*
sl@0	2268	*----------------------------------------------------------------------
sl@0	2269	*
sl@0	2270	* PipeEventProc --
sl@0	2271	*
sl@0	2272	* This function is invoked by Tcl_ServiceEvent when a file event
sl@0	2273	* reaches the front of the event queue. This procedure invokes
sl@0	2274	* Tcl_NotifyChannel on the pipe.
sl@0	2275	*
sl@0	2276	* Results:
sl@0	2277	* Returns 1 if the event was handled, meaning it should be removed
sl@0	2278	* from the queue. Returns 0 if the event was not handled, meaning
sl@0	2279	* it should stay on the queue. The only time the event isn't
sl@0	2280	* handled is if the TCL_FILE_EVENTS flag bit isn't set.
sl@0	2281	*
sl@0	2282	* Side effects:
sl@0	2283	* Whatever the notifier callback does.
sl@0	2284	*
sl@0	2285	*----------------------------------------------------------------------
sl@0	2286	*/
sl@0	2287
sl@0	2288	static int
sl@0	2289	PipeEventProc(
sl@0	2290	Tcl_Event evPtr, / Event to service. */
sl@0	2291	int flags) /* Flags that indicate what events to
sl@0	2292	* handle, such as TCL_FILE_EVENTS. */
sl@0	2293	{
sl@0	2294	PipeEvent pipeEvPtr = (PipeEvent )evPtr;
sl@0	2295	PipeInfo *infoPtr;
sl@0	2296	WinFile *filePtr;
sl@0	2297	int mask;
sl@0	2298	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2299
sl@0	2300	if (!(flags & TCL_FILE_EVENTS)) {
sl@0	2301	return 0;
sl@0	2302	}
sl@0	2303
sl@0	2304	/*
sl@0	2305	* Search through the list of watched pipes for the one whose handle
sl@0	2306	* matches the event. We do this rather than simply dereferencing
sl@0	2307	* the handle in the event so that pipes can be deleted while the
sl@0	2308	* event is in the queue.
sl@0	2309	*/
sl@0	2310
sl@0	2311	for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
sl@0	2312	infoPtr = infoPtr->nextPtr) {
sl@0	2313	if (pipeEvPtr->infoPtr == infoPtr) {
sl@0	2314	infoPtr->flags &= ~(PIPE_PENDING);
sl@0	2315	break;
sl@0	2316	}
sl@0	2317	}
sl@0	2318
sl@0	2319	/*
sl@0	2320	* Remove stale events.
sl@0	2321	*/
sl@0	2322
sl@0	2323	if (!infoPtr) {
sl@0	2324	return 1;
sl@0	2325	}
sl@0	2326
sl@0	2327	/*
sl@0	2328	* Check to see if the pipe is readable. Note
sl@0	2329	* that we can't tell if a pipe is writable, so we always report it
sl@0	2330	* as being writable unless we have detected EOF.
sl@0	2331	*/
sl@0	2332
sl@0	2333	filePtr = (WinFile) ((PipeInfo)infoPtr)->writeFile;
sl@0	2334	mask = 0;
sl@0	2335	if ((infoPtr->watchMask & TCL_WRITABLE) &&
sl@0	2336	(WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
sl@0	2337	mask = TCL_WRITABLE;
sl@0	2338	}
sl@0	2339
sl@0	2340	filePtr = (WinFile) ((PipeInfo)infoPtr)->readFile;
sl@0	2341	if ((infoPtr->watchMask & TCL_READABLE) &&
sl@0	2342	(WaitForRead(infoPtr, 0) >= 0)) {
sl@0	2343	if (infoPtr->readFlags & PIPE_EOF) {
sl@0	2344	mask = TCL_READABLE;
sl@0	2345	} else {
sl@0	2346	mask \|= TCL_READABLE;
sl@0	2347	}
sl@0	2348	}
sl@0	2349
sl@0	2350	/*
sl@0	2351	* Inform the channel of the events.
sl@0	2352	*/
sl@0	2353
sl@0	2354	Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
sl@0	2355	return 1;
sl@0	2356	}
sl@0	2357
sl@0	2358	/*
sl@0	2359	*----------------------------------------------------------------------
sl@0	2360	*
sl@0	2361	* PipeWatchProc --
sl@0	2362	*
sl@0	2363	* Called by the notifier to set up to watch for events on this
sl@0	2364	* channel.
sl@0	2365	*
sl@0	2366	* Results:
sl@0	2367	* None.
sl@0	2368	*
sl@0	2369	* Side effects:
sl@0	2370	* None.
sl@0	2371	*
sl@0	2372	*----------------------------------------------------------------------
sl@0	2373	*/
sl@0	2374
sl@0	2375	static void
sl@0	2376	PipeWatchProc(
sl@0	2377	ClientData instanceData, /* Pipe state. */
sl@0	2378	int mask) /* What events to watch for, OR-ed
sl@0	2379	* combination of TCL_READABLE,
sl@0	2380	* TCL_WRITABLE and TCL_EXCEPTION. */
sl@0	2381	{
sl@0	2382	PipeInfo *nextPtrPtr, ptr;
sl@0	2383	PipeInfo infoPtr = (PipeInfo ) instanceData;
sl@0	2384	int oldMask = infoPtr->watchMask;
sl@0	2385	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2386
sl@0	2387	/*
sl@0	2388	* Since most of the work is handled by the background threads,
sl@0	2389	* we just need to update the watchMask and then force the notifier
sl@0	2390	* to poll once.
sl@0	2391	*/
sl@0	2392
sl@0	2393	infoPtr->watchMask = mask & infoPtr->validMask;
sl@0	2394	if (infoPtr->watchMask) {
sl@0	2395	Tcl_Time blockTime = { 0, 0 };
sl@0	2396	if (!oldMask) {
sl@0	2397	infoPtr->nextPtr = tsdPtr->firstPipePtr;
sl@0	2398	tsdPtr->firstPipePtr = infoPtr;
sl@0	2399	}
sl@0	2400	Tcl_SetMaxBlockTime(&blockTime);
sl@0	2401	} else {
sl@0	2402	if (oldMask) {
sl@0	2403	/*
sl@0	2404	* Remove the pipe from the list of watched pipes.
sl@0	2405	*/
sl@0	2406
sl@0	2407	for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr;
sl@0	2408	ptr != NULL;
sl@0	2409	nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
sl@0	2410	if (infoPtr == ptr) {
sl@0	2411	*nextPtrPtr = ptr->nextPtr;
sl@0	2412	break;
sl@0	2413	}
sl@0	2414	}
sl@0	2415	}
sl@0	2416	}
sl@0	2417	}
sl@0	2418
sl@0	2419	/*
sl@0	2420	*----------------------------------------------------------------------
sl@0	2421	*
sl@0	2422	* PipeGetHandleProc --
sl@0	2423	*
sl@0	2424	* Called from Tcl_GetChannelHandle to retrieve OS handles from
sl@0	2425	* inside a command pipeline based channel.
sl@0	2426	*
sl@0	2427	* Results:
sl@0	2428	* Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
sl@0	2429	* there is no handle for the specified direction.
sl@0	2430	*
sl@0	2431	* Side effects:
sl@0	2432	* None.
sl@0	2433	*
sl@0	2434	*----------------------------------------------------------------------
sl@0	2435	*/
sl@0	2436
sl@0	2437	static int
sl@0	2438	PipeGetHandleProc(
sl@0	2439	ClientData instanceData, /* The pipe state. */
sl@0	2440	int direction, /* TCL_READABLE or TCL_WRITABLE */
sl@0	2441	ClientData handlePtr) / Where to store the handle. */
sl@0	2442	{
sl@0	2443	PipeInfo infoPtr = (PipeInfo ) instanceData;
sl@0	2444	WinFile *filePtr;
sl@0	2445
sl@0	2446	if (direction == TCL_READABLE && infoPtr->readFile) {
sl@0	2447	filePtr = (WinFile*) infoPtr->readFile;
sl@0	2448	*handlePtr = (ClientData) filePtr->handle;
sl@0	2449	return TCL_OK;
sl@0	2450	}
sl@0	2451	if (direction == TCL_WRITABLE && infoPtr->writeFile) {
sl@0	2452	filePtr = (WinFile*) infoPtr->writeFile;
sl@0	2453	*handlePtr = (ClientData) filePtr->handle;
sl@0	2454	return TCL_OK;
sl@0	2455	}
sl@0	2456	return TCL_ERROR;
sl@0	2457	}
sl@0	2458
sl@0	2459	/*
sl@0	2460	*----------------------------------------------------------------------
sl@0	2461	*
sl@0	2462	* Tcl_WaitPid --
sl@0	2463	*
sl@0	2464	* Emulates the waitpid system call.
sl@0	2465	*
sl@0	2466	* Results:
sl@0	2467	* Returns 0 if the process is still alive, -1 on an error, or
sl@0	2468	* the pid on a clean close.
sl@0	2469	*
sl@0	2470	* Side effects:
sl@0	2471	* Unless WNOHANG is set and the wait times out, the process
sl@0	2472	* information record will be deleted and the process handle
sl@0	2473	* will be closed.
sl@0	2474	*
sl@0	2475	*----------------------------------------------------------------------
sl@0	2476	*/
sl@0	2477
sl@0	2478	Tcl_Pid
sl@0	2479	Tcl_WaitPid(
sl@0	2480	Tcl_Pid pid,
sl@0	2481	int *statPtr,
sl@0	2482	int options)
sl@0	2483	{
sl@0	2484	ProcInfo infoPtr = NULL, *prevPtrPtr;
sl@0	2485	DWORD flags;
sl@0	2486	Tcl_Pid result;
sl@0	2487	DWORD ret, exitCode;
sl@0	2488
sl@0	2489	PipeInit();
sl@0	2490
sl@0	2491	/*
sl@0	2492	* If no pid is specified, do nothing.
sl@0	2493	*/
sl@0	2494
sl@0	2495	if (pid == 0) {
sl@0	2496	*statPtr = 0;
sl@0	2497	return 0;
sl@0	2498	}
sl@0	2499
sl@0	2500	/*
sl@0	2501	* Find the process and cut it from the process list.
sl@0	2502	* SF Tcl Bug 859820, Backport of its fix.
sl@0	2503	* SF Tcl Bug 1381436, asking for the backport.
sl@0	2504	*
sl@0	2505	* [x] Cutting the infoPtr after the closehandle allows the
sl@0	2506	* pointer to become stale. We do it here, and compensate if the
sl@0	2507	* process was not done yet.
sl@0	2508	*/
sl@0	2509
sl@0	2510	Tcl_MutexLock(&pipeMutex);
sl@0	2511	prevPtrPtr = &procList;
sl@0	2512	for (infoPtr = procList; infoPtr != NULL;
sl@0	2513	prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
sl@0	2514	if (infoPtr->hProcess == (HANDLE) pid) {
sl@0	2515	*prevPtrPtr = infoPtr->nextPtr;
sl@0	2516	break;
sl@0	2517	}
sl@0	2518	}
sl@0	2519	Tcl_MutexUnlock(&pipeMutex);
sl@0	2520
sl@0	2521	/*
sl@0	2522	* If the pid is not one of the processes we know about (we started it)
sl@0	2523	* then do nothing.
sl@0	2524	*/
sl@0	2525
sl@0	2526	if (infoPtr == NULL) {
sl@0	2527	*statPtr = 0;
sl@0	2528	return 0;
sl@0	2529	}
sl@0	2530
sl@0	2531	/*
sl@0	2532	* Officially "wait" for it to finish. We either poll (WNOHANG) or
sl@0	2533	* wait for an infinite amount of time.
sl@0	2534	*/
sl@0	2535
sl@0	2536	if (options & WNOHANG) {
sl@0	2537	flags = 0;
sl@0	2538	} else {
sl@0	2539	flags = INFINITE;
sl@0	2540	}
sl@0	2541	ret = WaitForSingleObject(infoPtr->hProcess, flags);
sl@0	2542	if (ret == WAIT_TIMEOUT) {
sl@0	2543	*statPtr = 0;
sl@0	2544	if (options & WNOHANG) {
sl@0	2545	/*
sl@0	2546	* Re-insert the cut infoPtr back on the list.
sl@0	2547	* See [x] for explanation.
sl@0	2548	*/
sl@0	2549	Tcl_MutexLock(&pipeMutex);
sl@0	2550	infoPtr->nextPtr = procList;
sl@0	2551	procList = infoPtr;
sl@0	2552	Tcl_MutexUnlock(&pipeMutex);
sl@0	2553	return 0;
sl@0	2554	} else {
sl@0	2555	result = 0;
sl@0	2556	}
sl@0	2557	} else if (ret == WAIT_OBJECT_0) {
sl@0	2558	GetExitCodeProcess(infoPtr->hProcess, &exitCode);
sl@0	2559	if (exitCode & 0xC0000000) {
sl@0	2560	/*
sl@0	2561	* A fatal exception occured.
sl@0	2562	*/
sl@0	2563	switch (exitCode) {
sl@0	2564	case EXCEPTION_FLT_DENORMAL_OPERAND:
sl@0	2565	case EXCEPTION_FLT_DIVIDE_BY_ZERO:
sl@0	2566	case EXCEPTION_FLT_INEXACT_RESULT:
sl@0	2567	case EXCEPTION_FLT_INVALID_OPERATION:
sl@0	2568	case EXCEPTION_FLT_OVERFLOW:
sl@0	2569	case EXCEPTION_FLT_STACK_CHECK:
sl@0	2570	case EXCEPTION_FLT_UNDERFLOW:
sl@0	2571	case EXCEPTION_INT_DIVIDE_BY_ZERO:
sl@0	2572	case EXCEPTION_INT_OVERFLOW:
sl@0	2573	*statPtr = 0xC0000000 \| SIGFPE;
sl@0	2574	break;
sl@0	2575
sl@0	2576	case EXCEPTION_PRIV_INSTRUCTION:
sl@0	2577	case EXCEPTION_ILLEGAL_INSTRUCTION:
sl@0	2578	*statPtr = 0xC0000000 \| SIGILL;
sl@0	2579	break;
sl@0	2580
sl@0	2581	case EXCEPTION_ACCESS_VIOLATION:
sl@0	2582	case EXCEPTION_DATATYPE_MISALIGNMENT:
sl@0	2583	case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
sl@0	2584	case EXCEPTION_STACK_OVERFLOW:
sl@0	2585	case EXCEPTION_NONCONTINUABLE_EXCEPTION:
sl@0	2586	case EXCEPTION_INVALID_DISPOSITION:
sl@0	2587	case EXCEPTION_GUARD_PAGE:
sl@0	2588	case EXCEPTION_INVALID_HANDLE:
sl@0	2589	*statPtr = 0xC0000000 \| SIGSEGV;
sl@0	2590	break;
sl@0	2591
sl@0	2592	case CONTROL_C_EXIT:
sl@0	2593	*statPtr = 0xC0000000 \| SIGINT;
sl@0	2594	break;
sl@0	2595
sl@0	2596	default:
sl@0	2597	*statPtr = 0xC0000000 \| SIGABRT;
sl@0	2598	break;
sl@0	2599	}
sl@0	2600	} else {
sl@0	2601	*statPtr = exitCode;
sl@0	2602	}
sl@0	2603	result = pid;
sl@0	2604	} else {
sl@0	2605	errno = ECHILD;
sl@0	2606	*statPtr = 0xC0000000 \| ECHILD;
sl@0	2607	result = (Tcl_Pid) -1;
sl@0	2608	}
sl@0	2609
sl@0	2610	/*
sl@0	2611	* Officially close the process handle.
sl@0	2612	*/
sl@0	2613
sl@0	2614	CloseHandle(infoPtr->hProcess);
sl@0	2615	ckfree((char*)infoPtr);
sl@0	2616
sl@0	2617	return result;
sl@0	2618	}
sl@0	2619
sl@0	2620	/*
sl@0	2621	*----------------------------------------------------------------------
sl@0	2622	*
sl@0	2623	* TclWinAddProcess --
sl@0	2624	*
sl@0	2625	* Add a process to the process list so that we can use
sl@0	2626	* Tcl_WaitPid on the process.
sl@0	2627	*
sl@0	2628	* Results:
sl@0	2629	* None
sl@0	2630	*
sl@0	2631	* Side effects:
sl@0	2632	* Adds the specified process handle to the process list so
sl@0	2633	* Tcl_WaitPid knows about it.
sl@0	2634	*
sl@0	2635	*----------------------------------------------------------------------
sl@0	2636	*/
sl@0	2637
sl@0	2638	void
sl@0	2639	TclWinAddProcess(hProcess, id)
sl@0	2640	HANDLE hProcess; /* Handle to process */
sl@0	2641	DWORD id; /* Global process identifier */
sl@0	2642	{
sl@0	2643	ProcInfo procPtr = (ProcInfo ) ckalloc(sizeof(ProcInfo));
sl@0	2644
sl@0	2645	PipeInit();
sl@0	2646
sl@0	2647	procPtr->hProcess = hProcess;
sl@0	2648	procPtr->dwProcessId = id;
sl@0	2649	Tcl_MutexLock(&pipeMutex);
sl@0	2650	procPtr->nextPtr = procList;
sl@0	2651	procList = procPtr;
sl@0	2652	Tcl_MutexUnlock(&pipeMutex);
sl@0	2653	}
sl@0	2654
sl@0	2655	/*
sl@0	2656	*----------------------------------------------------------------------
sl@0	2657	*
sl@0	2658	* Tcl_PidObjCmd --
sl@0	2659	*
sl@0	2660	* This procedure is invoked to process the "pid" Tcl command.
sl@0	2661	* See the user documentation for details on what it does.
sl@0	2662	*
sl@0	2663	* Results:
sl@0	2664	* A standard Tcl result.
sl@0	2665	*
sl@0	2666	* Side effects:
sl@0	2667	* See the user documentation.
sl@0	2668	*
sl@0	2669	*----------------------------------------------------------------------
sl@0	2670	*/
sl@0	2671
sl@0	2672	/* ARGSUSED */
sl@0	2673	int
sl@0	2674	Tcl_PidObjCmd(
sl@0	2675	ClientData dummy, /* Not used. */
sl@0	2676	Tcl_Interp interp, / Current interpreter. */
sl@0	2677	int objc, /* Number of arguments. */
sl@0	2678	Tcl_Obj CONST objv) /* Argument strings. */
sl@0	2679	{
sl@0	2680	Tcl_Channel chan;
sl@0	2681	Tcl_ChannelType *chanTypePtr;
sl@0	2682	PipeInfo *pipePtr;
sl@0	2683	int i;
sl@0	2684	Tcl_Obj *resultPtr;
sl@0	2685	char buf[TCL_INTEGER_SPACE];
sl@0	2686
sl@0	2687	if (objc > 2) {
sl@0	2688	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
sl@0	2689	return TCL_ERROR;
sl@0	2690	}
sl@0	2691	if (objc == 1) {
sl@0	2692	resultPtr = Tcl_GetObjResult(interp);
sl@0	2693	wsprintfA(buf, "%lu", (unsigned long) getpid());
sl@0	2694	Tcl_SetStringObj(resultPtr, buf, -1);
sl@0	2695	} else {
sl@0	2696	chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
sl@0	2697	NULL);
sl@0	2698	if (chan == (Tcl_Channel) NULL) {
sl@0	2699	return TCL_ERROR;
sl@0	2700	}
sl@0	2701	chanTypePtr = Tcl_GetChannelType(chan);
sl@0	2702	if (chanTypePtr != &pipeChannelType) {
sl@0	2703	return TCL_OK;
sl@0	2704	}
sl@0	2705
sl@0	2706	pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
sl@0	2707	resultPtr = Tcl_GetObjResult(interp);
sl@0	2708	for (i = 0; i < pipePtr->numPids; i++) {
sl@0	2709	wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
sl@0	2710	Tcl_ListObjAppendElement(/interp/ NULL, resultPtr,
sl@0	2711	Tcl_NewStringObj(buf, -1));
sl@0	2712	}
sl@0	2713	}
sl@0	2714	return TCL_OK;
sl@0	2715	}
sl@0	2716
sl@0	2717	/*
sl@0	2718	*----------------------------------------------------------------------
sl@0	2719	*
sl@0	2720	* WaitForRead --
sl@0	2721	*
sl@0	2722	* Wait until some data is available, the pipe is at
sl@0	2723	* EOF or the reader thread is blocked waiting for data (if the
sl@0	2724	* channel is in non-blocking mode).
sl@0	2725	*
sl@0	2726	* Results:
sl@0	2727	* Returns 1 if pipe is readable. Returns 0 if there is no data
sl@0	2728	* on the pipe, but there is buffered data. Returns -1 if an
sl@0	2729	* error occurred. If an error occurred, the threads may not
sl@0	2730	* be synchronized.
sl@0	2731	*
sl@0	2732	* Side effects:
sl@0	2733	* Updates the shared state flags and may consume 1 byte of data
sl@0	2734	* from the pipe. If no error occurred, the reader thread is
sl@0	2735	* blocked waiting for a signal from the main thread.
sl@0	2736	*
sl@0	2737	*----------------------------------------------------------------------
sl@0	2738	*/
sl@0	2739
sl@0	2740	static int
sl@0	2741	WaitForRead(
sl@0	2742	PipeInfo infoPtr, / Pipe state. */
sl@0	2743	int blocking) /* Indicates whether call should be
sl@0	2744	* blocking or not. */
sl@0	2745	{
sl@0	2746	DWORD timeout, count;
sl@0	2747	HANDLE handle = ((WinFile ) infoPtr->readFile)->handle;
sl@0	2748
sl@0	2749	while (1) {
sl@0	2750	/*
sl@0	2751	* Synchronize with the reader thread.
sl@0	2752	*/
sl@0	2753
sl@0	2754	timeout = blocking ? INFINITE : 0;
sl@0	2755	if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
sl@0	2756	/*
sl@0	2757	* The reader thread is blocked waiting for data and the channel
sl@0	2758	* is in non-blocking mode.
sl@0	2759	*/
sl@0	2760
sl@0	2761	errno = EAGAIN;
sl@0	2762	return -1;
sl@0	2763	}
sl@0	2764
sl@0	2765	/*
sl@0	2766	* At this point, the two threads are synchronized, so it is safe
sl@0	2767	* to access shared state.
sl@0	2768	*/
sl@0	2769
sl@0	2770
sl@0	2771	/*
sl@0	2772	* If the pipe has hit EOF, it is always readable.
sl@0	2773	*/
sl@0	2774
sl@0	2775	if (infoPtr->readFlags & PIPE_EOF) {
sl@0	2776	return 1;
sl@0	2777	}
sl@0	2778
sl@0	2779	/*
sl@0	2780	* Check to see if there is any data sitting in the pipe.
sl@0	2781	*/
sl@0	2782
sl@0	2783	if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,
sl@0	2784	(LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {
sl@0	2785	TclWinConvertError(GetLastError());
sl@0	2786	/*
sl@0	2787	* Check to see if the peek failed because of EOF.
sl@0	2788	*/
sl@0	2789
sl@0	2790	if (errno == EPIPE) {
sl@0	2791	infoPtr->readFlags \|= PIPE_EOF;
sl@0	2792	return 1;
sl@0	2793	}
sl@0	2794
sl@0	2795	/*
sl@0	2796	* Ignore errors if there is data in the buffer.
sl@0	2797	*/
sl@0	2798
sl@0	2799	if (infoPtr->readFlags & PIPE_EXTRABYTE) {
sl@0	2800	return 0;
sl@0	2801	} else {
sl@0	2802	return -1;
sl@0	2803	}
sl@0	2804	}
sl@0	2805
sl@0	2806	/*
sl@0	2807	* We found some data in the pipe, so it must be readable.
sl@0	2808	*/
sl@0	2809
sl@0	2810	if (count > 0) {
sl@0	2811	return 1;
sl@0	2812	}
sl@0	2813
sl@0	2814	/*
sl@0	2815	* The pipe isn't readable, but there is some data sitting
sl@0	2816	* in the buffer, so return immediately.
sl@0	2817	*/
sl@0	2818
sl@0	2819	if (infoPtr->readFlags & PIPE_EXTRABYTE) {
sl@0	2820	return 0;
sl@0	2821	}
sl@0	2822
sl@0	2823	/*
sl@0	2824	* There wasn't any data available, so reset the thread and
sl@0	2825	* try again.
sl@0	2826	*/
sl@0	2827
sl@0	2828	ResetEvent(infoPtr->readable);
sl@0	2829	SetEvent(infoPtr->startReader);
sl@0	2830	}
sl@0	2831	}
sl@0	2832
sl@0	2833	/*
sl@0	2834	*----------------------------------------------------------------------
sl@0	2835	*
sl@0	2836	* PipeReaderThread --
sl@0	2837	*
sl@0	2838	* This function runs in a separate thread and waits for input
sl@0	2839	* to become available on a pipe.
sl@0	2840	*
sl@0	2841	* Results:
sl@0	2842	* None.
sl@0	2843	*
sl@0	2844	* Side effects:
sl@0	2845	* Signals the main thread when input become available. May
sl@0	2846	* cause the main thread to wake up by posting a message. May
sl@0	2847	* consume one byte from the pipe for each wait operation. Will
sl@0	2848	* cause a memory leak of ~4k, if forcefully terminated with
sl@0	2849	* TerminateThread().
sl@0	2850	*
sl@0	2851	*----------------------------------------------------------------------
sl@0	2852	*/
sl@0	2853
sl@0	2854	static DWORD WINAPI
sl@0	2855	PipeReaderThread(LPVOID arg)
sl@0	2856	{
sl@0	2857	PipeInfo infoPtr = (PipeInfo )arg;
sl@0	2858	HANDLE handle = ((WinFile ) infoPtr->readFile)->handle;
sl@0	2859	DWORD count, err;
sl@0	2860	int done = 0;
sl@0	2861	HANDLE wEvents[2];
sl@0	2862	DWORD waitResult;
sl@0	2863
sl@0	2864	wEvents[0] = infoPtr->stopReader;
sl@0	2865	wEvents[1] = infoPtr->startReader;
sl@0	2866
sl@0	2867	while (!done) {
sl@0	2868	/*
sl@0	2869	* Wait for the main thread to signal before attempting to wait
sl@0	2870	* on the pipe becoming readable.
sl@0	2871	*/
sl@0	2872
sl@0	2873	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
sl@0	2874
sl@0	2875	if (waitResult != (WAIT_OBJECT_0 + 1)) {
sl@0	2876	/*
sl@0	2877	* The start event was not signaled. It might be the stop event
sl@0	2878	* or an error, so exit.
sl@0	2879	*/
sl@0	2880
sl@0	2881	break;
sl@0	2882	}
sl@0	2883
sl@0	2884	/*
sl@0	2885	* Try waiting for 0 bytes. This will block until some data is
sl@0	2886	* available on NT, but will return immediately on Win 95. So,
sl@0	2887	* if no data is available after the first read, we block until
sl@0	2888	* we can read a single byte off of the pipe.
sl@0	2889	*/
sl@0	2890
sl@0	2891	if ((ReadFile(handle, NULL, 0, &count, NULL) == FALSE)
sl@0	2892	\|\| (PeekNamedPipe(handle, NULL, 0, NULL, &count,
sl@0	2893	NULL) == FALSE)) {
sl@0	2894	/*
sl@0	2895	* The error is a result of an EOF condition, so set the
sl@0	2896	* EOF bit before signalling the main thread.
sl@0	2897	*/
sl@0	2898
sl@0	2899	err = GetLastError();
sl@0	2900	if (err == ERROR_BROKEN_PIPE) {
sl@0	2901	infoPtr->readFlags \|= PIPE_EOF;
sl@0	2902	done = 1;
sl@0	2903	} else if (err == ERROR_INVALID_HANDLE) {
sl@0	2904	break;
sl@0	2905	}
sl@0	2906	} else if (count == 0) {
sl@0	2907	if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
sl@0	2908	!= FALSE) {
sl@0	2909	/*
sl@0	2910	* One byte was consumed as a side effect of waiting
sl@0	2911	* for the pipe to become readable.
sl@0	2912	*/
sl@0	2913
sl@0	2914	infoPtr->readFlags \|= PIPE_EXTRABYTE;
sl@0	2915	} else {
sl@0	2916	err = GetLastError();
sl@0	2917	if (err == ERROR_BROKEN_PIPE) {
sl@0	2918	/*
sl@0	2919	* The error is a result of an EOF condition, so set the
sl@0	2920	* EOF bit before signalling the main thread.
sl@0	2921	*/
sl@0	2922
sl@0	2923	infoPtr->readFlags \|= PIPE_EOF;
sl@0	2924	done = 1;
sl@0	2925	} else if (err == ERROR_INVALID_HANDLE) {
sl@0	2926	break;
sl@0	2927	}
sl@0	2928	}
sl@0	2929	}
sl@0	2930
sl@0	2931
sl@0	2932	/*
sl@0	2933	* Signal the main thread by signalling the readable event and
sl@0	2934	* then waking up the notifier thread.
sl@0	2935	*/
sl@0	2936
sl@0	2937	SetEvent(infoPtr->readable);
sl@0	2938
sl@0	2939	/*
sl@0	2940	* Alert the foreground thread. Note that we need to treat this like
sl@0	2941	* a critical section so the foreground thread does not terminate
sl@0	2942	* this thread while we are holding a mutex in the notifier code.
sl@0	2943	*/
sl@0	2944
sl@0	2945	Tcl_MutexLock(&pipeMutex);
sl@0	2946	if (infoPtr->threadId != NULL) {
sl@0	2947	/* TIP #218. When in flight ignore the event, no one will receive it anyway */
sl@0	2948	Tcl_ThreadAlert(infoPtr->threadId);
sl@0	2949	}
sl@0	2950	Tcl_MutexUnlock(&pipeMutex);
sl@0	2951	}
sl@0	2952
sl@0	2953	return 0;
sl@0	2954	}
sl@0	2955
sl@0	2956	/*
sl@0	2957	*----------------------------------------------------------------------
sl@0	2958	*
sl@0	2959	* PipeWriterThread --
sl@0	2960	*
sl@0	2961	* This function runs in a separate thread and writes data
sl@0	2962	* onto a pipe.
sl@0	2963	*
sl@0	2964	* Results:
sl@0	2965	* Always returns 0.
sl@0	2966	*
sl@0	2967	* Side effects:
sl@0	2968	* Signals the main thread when an output operation is completed.
sl@0	2969	* May cause the main thread to wake up by posting a message.
sl@0	2970	*
sl@0	2971	*----------------------------------------------------------------------
sl@0	2972	*/
sl@0	2973
sl@0	2974	static DWORD WINAPI
sl@0	2975	PipeWriterThread(LPVOID arg)
sl@0	2976	{
sl@0	2977
sl@0	2978	PipeInfo infoPtr = (PipeInfo )arg;
sl@0	2979	HANDLE handle = ((WinFile ) infoPtr->writeFile)->handle;
sl@0	2980	DWORD count, toWrite;
sl@0	2981	char *buf;
sl@0	2982	int done = 0;
sl@0	2983	HANDLE wEvents[2];
sl@0	2984	DWORD waitResult;
sl@0	2985
sl@0	2986	wEvents[0] = infoPtr->stopWriter;
sl@0	2987	wEvents[1] = infoPtr->startWriter;
sl@0	2988
sl@0	2989	while (!done) {
sl@0	2990	/*
sl@0	2991	* Wait for the main thread to signal before attempting to write.
sl@0	2992	*/
sl@0	2993
sl@0	2994	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
sl@0	2995
sl@0	2996	if (waitResult != (WAIT_OBJECT_0 + 1)) {
sl@0	2997	/*
sl@0	2998	* The start event was not signaled. It might be the stop event
sl@0	2999	* or an error, so exit.
sl@0	3000	*/
sl@0	3001
sl@0	3002	break;
sl@0	3003	}
sl@0	3004
sl@0	3005	buf = infoPtr->writeBuf;
sl@0	3006	toWrite = infoPtr->toWrite;
sl@0	3007
sl@0	3008	/*
sl@0	3009	* Loop until all of the bytes are written or an error occurs.
sl@0	3010	*/
sl@0	3011
sl@0	3012	while (toWrite > 0) {
sl@0	3013	if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
sl@0	3014	infoPtr->writeError = GetLastError();
sl@0	3015	done = 1;
sl@0	3016	break;
sl@0	3017	} else {
sl@0	3018	toWrite -= count;
sl@0	3019	buf += count;
sl@0	3020	}
sl@0	3021	}
sl@0	3022
sl@0	3023	/*
sl@0	3024	* Signal the main thread by signalling the writable event and
sl@0	3025	* then waking up the notifier thread.
sl@0	3026	*/
sl@0	3027
sl@0	3028	SetEvent(infoPtr->writable);
sl@0	3029
sl@0	3030	/*
sl@0	3031	* Alert the foreground thread. Note that we need to treat this like
sl@0	3032	* a critical section so the foreground thread does not terminate
sl@0	3033	* this thread while we are holding a mutex in the notifier code.
sl@0	3034	*/
sl@0	3035
sl@0	3036	Tcl_MutexLock(&pipeMutex);
sl@0	3037	if (infoPtr->threadId != NULL) {
sl@0	3038	/* TIP #218. When in flight ignore the event, no one will receive it anyway */
sl@0	3039	Tcl_ThreadAlert(infoPtr->threadId);
sl@0	3040	}
sl@0	3041	Tcl_MutexUnlock(&pipeMutex);
sl@0	3042	}
sl@0	3043
sl@0	3044	return 0;
sl@0	3045	}
sl@0	3046
sl@0	3047	/*
sl@0	3048	*----------------------------------------------------------------------
sl@0	3049	*
sl@0	3050	* PipeThreadActionProc --
sl@0	3051	*
sl@0	3052	* Insert or remove any thread local refs to this channel.
sl@0	3053	*
sl@0	3054	* Results:
sl@0	3055	* None.
sl@0	3056	*
sl@0	3057	* Side effects:
sl@0	3058	* Changes thread local list of valid channels.
sl@0	3059	*
sl@0	3060	*----------------------------------------------------------------------
sl@0	3061	*/
sl@0	3062
sl@0	3063	static void
sl@0	3064	PipeThreadActionProc (instanceData, action)
sl@0	3065	ClientData instanceData;
sl@0	3066	int action;
sl@0	3067	{
sl@0	3068	PipeInfo infoPtr = (PipeInfo ) instanceData;
sl@0	3069
sl@0	3070	/* We do not access firstPipePtr in the thread structures. This is
sl@0	3071	* not for all pipes managed by the thread, but only those we are
sl@0	3072	* watching. Removal of the filevent handlers before transfer thus
sl@0	3073	* takes care of this structure.
sl@0	3074	*/
sl@0	3075
sl@0	3076	Tcl_MutexLock(&pipeMutex);
sl@0	3077	if (action == TCL_CHANNEL_THREAD_INSERT) {
sl@0	3078	/* We can't copy the thread information from the channel when
sl@0	3079	* the channel is created. At this time the channel back
sl@0	3080	* pointer has not been set yet. However in that case the
sl@0	3081	* threadId has already been set by TclpCreateCommandChannel
sl@0	3082	* itself, so the structure is still good.
sl@0	3083	*/
sl@0	3084
sl@0	3085	PipeInit ();
sl@0	3086	if (infoPtr->channel != NULL) {
sl@0	3087	infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
sl@0	3088	}
sl@0	3089	} else {
sl@0	3090	infoPtr->threadId = NULL;
sl@0	3091	}
sl@0	3092	Tcl_MutexUnlock(&pipeMutex);
sl@0	3093	}

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--