tcl/win/tclWinPipe.c

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