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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25