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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25