/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinpipe.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinpipe.c

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25