util/src/TclTk/tcl8.6.12/win/tclWinPipe.c

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