tcl/win/tclWinChan.c

   1 /*
   2  * tclWinChan.c
   3  *
   4  *      Channel drivers for Windows channels based on files, command
   5  *      pipes and TCP sockets.
   6  *
   7  * Copyright (c) 1995-1997 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 /*
  18  * State flags used in the info structures below.
  19  */
  20
  21 #define FILE_PENDING    (1<<0)  /* Message is pending in the queue. */
  22 #define FILE_ASYNC      (1<<1)  /* Channel is non-blocking. */
  23 #define FILE_APPEND     (1<<2)  /* File is in append mode. */
  24
  25 #define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
  26 #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
  27
  28 /*
  29  * The following structure contains per-instance data for a file based channel.
  30  */
  31
  32 typedef struct FileInfo {
  33     Tcl_Channel channel;        /* Pointer to channel structure. */
  34     int validMask;              /* OR'ed combination of TCL_READABLE,
  35                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  36                                  * which operations are valid on the file. */
  37     int watchMask;              /* OR'ed combination of TCL_READABLE,
  38                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  39                                  * which events should be reported. */
  40     int flags;                  /* State flags, see above for a list. */
  41     HANDLE handle;              /* Input/output file. */
  42     struct FileInfo *nextPtr;   /* Pointer to next registered file. */
  43 } FileInfo;
  44
  45 typedef struct ThreadSpecificData {
  46     /*
  47      * List of all file channels currently open.
  48      */
  49
  50     FileInfo *firstFilePtr;
  51 } ThreadSpecificData;
  52
  53 static Tcl_ThreadDataKey dataKey;
  54
  55 /*
  56  * The following structure is what is added to the Tcl event queue when
  57  * file events are generated.
  58  */
  59
  60 typedef struct FileEvent {
  61     Tcl_Event header;           /* Information that is standard for
  62                                  * all events. */
  63     FileInfo *infoPtr;          /* Pointer to file info structure.  Note
  64                                  * that we still have to verify that the
  65                                  * file exists before dereferencing this
  66                                  * pointer. */
  67 } FileEvent;
  68
  69 /*
  70  * Static routines for this file:
  71  */
  72
  73 static int              FileBlockProc _ANSI_ARGS_((ClientData instanceData,
  74                             int mode));
  75 static void             FileChannelExitHandler _ANSI_ARGS_((
  76                             ClientData clientData));
  77 static void             FileCheckProc _ANSI_ARGS_((ClientData clientData,
  78                             int flags));
  79 static int              FileCloseProc _ANSI_ARGS_((ClientData instanceData,
  80                             Tcl_Interp *interp));
  81 static int              FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
  82                             int flags));
  83 static int              FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
  84                             int direction, ClientData *handlePtr));
  85 static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
  86 static int              FileInputProc _ANSI_ARGS_((ClientData instanceData,
  87                             char *buf, int toRead, int *errorCode));
  88 static int              FileOutputProc _ANSI_ARGS_((ClientData instanceData,
  89                             char *buf, int toWrite, int *errorCode));
  90 static int              FileSeekProc _ANSI_ARGS_((ClientData instanceData,
  91                             long offset, int mode, int *errorCode));
  92 static void             FileSetupProc _ANSI_ARGS_((ClientData clientData,
  93                             int flags));
  94 static void             FileWatchProc _ANSI_ARGS_((ClientData instanceData,
  95                             int mask));
  96
  97
  98 /*
  99  * This structure describes the channel type structure for file based IO.
 100  */
 101
 102 static Tcl_ChannelType fileChannelType = {
 103     "file",                     /* Type name. */
 104     TCL_CHANNEL_VERSION_2,      /* v2 channel */
 105     FileCloseProc,              /* Close proc. */
 106     FileInputProc,              /* Input proc. */
 107     FileOutputProc,             /* Output proc. */
 108     FileSeekProc,               /* Seek proc. */
 109     NULL,                       /* Set option proc. */
 110     NULL,                       /* Get option proc. */
 111     FileWatchProc,              /* Set up the notifier to watch the channel. */
 112     FileGetHandleProc,          /* Get an OS handle from channel. */
 113     NULL,                       /* close2proc. */
 114     FileBlockProc,              /* Set blocking or non-blocking mode.*/
 115     NULL,                       /* flush proc. */
 116     NULL,                       /* handler proc. */
 117 };
 118
 119 \f
 120 /*
 121  *----------------------------------------------------------------------
 122  *
 123  * FileInit --
 124  *
 125  *      This function creates the window used to simulate file events.
 126  *
 127  * Results:
 128  *      None.
 129  *
 130  * Side effects:
 131  *      Creates a new window and creates an exit handler.
 132  *
 133  *----------------------------------------------------------------------
 134  */
 135
 136 static ThreadSpecificData *
 137 FileInit()
 138 {
 139     ThreadSpecificData *tsdPtr =
 140         (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
 141     if (tsdPtr == NULL) {
 142         tsdPtr = TCL_TSD_INIT(&dataKey);
 143         tsdPtr->firstFilePtr = NULL;
 144         Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
 145         Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
 146     }
 147     return tsdPtr;
 148 }
 149 \f
 150 /*
 151  *----------------------------------------------------------------------
 152  *
 153  * FileChannelExitHandler --
 154  *
 155  *      This function is called to cleanup the channel driver before
 156  *      Tcl is unloaded.
 157  *
 158  * Results:
 159  *      None.
 160  *
 161  * Side effects:
 162  *      Destroys the communication window.
 163  *
 164  *----------------------------------------------------------------------
 165  */
 166
 167 static void
 168 FileChannelExitHandler(clientData)
 169     ClientData clientData;      /* Old window proc */
 170 {
 171     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
 172 }
 173 \f
 174 /*
 175  *----------------------------------------------------------------------
 176  *
 177  * FileSetupProc --
 178  *
 179  *      This procedure is invoked before Tcl_DoOneEvent blocks waiting
 180  *      for an event.
 181  *
 182  * Results:
 183  *      None.
 184  *
 185  * Side effects:
 186  *      Adjusts the block time if needed.
 187  *
 188  *----------------------------------------------------------------------
 189  */
 190
 191 void
 192 FileSetupProc(data, flags)
 193     ClientData data;            /* Not used. */
 194     int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */
 195 {
 196     FileInfo *infoPtr;
 197     Tcl_Time blockTime = { 0, 0 };
 198     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 199
 200     if (!(flags & TCL_FILE_EVENTS)) {
 201         return;
 202     }
 203
 204     /*
 205      * Check to see if there is a ready file.  If so, poll.
 206      */
 207
 208     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 209             infoPtr = infoPtr->nextPtr) {
 210         if (infoPtr->watchMask) {
 211             Tcl_SetMaxBlockTime(&blockTime);
 212             break;
 213         }
 214     }
 215 }
 216 \f
 217 /*
 218  *----------------------------------------------------------------------
 219  *
 220  * FileCheckProc --
 221  *
 222  *      This procedure is called by Tcl_DoOneEvent to check the file
 223  *      event source for events.
 224  *
 225  * Results:
 226  *      None.
 227  *
 228  * Side effects:
 229  *      May queue an event.
 230  *
 231  *----------------------------------------------------------------------
 232  */
 233
 234 static void
 235 FileCheckProc(data, flags)
 236     ClientData data;            /* Not used. */
 237     int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */
 238 {
 239     FileEvent *evPtr;
 240     FileInfo *infoPtr;
 241     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 242
 243     if (!(flags & TCL_FILE_EVENTS)) {
 244         return;
 245     }
 246
 247     /*
 248      * Queue events for any ready files that don't already have events
 249      * queued (caused by persistent states that won't generate WinSock
 250      * events).
 251      */
 252
 253     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 254             infoPtr = infoPtr->nextPtr) {
 255         if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
 256             infoPtr->flags |= FILE_PENDING;
 257             evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
 258             evPtr->header.proc = FileEventProc;
 259             evPtr->infoPtr = infoPtr;
 260             Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 261         }
 262     }
 263 }
 264 \f
 265 /*----------------------------------------------------------------------
 266  *
 267  * FileEventProc --
 268  *
 269  *      This function is invoked by Tcl_ServiceEvent when a file event
 270  *      reaches the front of the event queue.  This procedure invokes
 271  *      Tcl_NotifyChannel on the file.
 272  *
 273  * Results:
 274  *      Returns 1 if the event was handled, meaning it should be removed
 275  *      from the queue.  Returns 0 if the event was not handled, meaning
 276  *      it should stay on the queue.  The only time the event isn't
 277  *      handled is if the TCL_FILE_EVENTS flag bit isn't set.
 278  *
 279  * Side effects:
 280  *      Whatever the notifier callback does.
 281  *
 282  *----------------------------------------------------------------------
 283  */
 284
 285 static int
 286 FileEventProc(evPtr, flags)
 287     Tcl_Event *evPtr;           /* Event to service. */
 288     int flags;                  /* Flags that indicate what events to
 289                                  * handle, such as TCL_FILE_EVENTS. */
 290 {
 291     FileEvent *fileEvPtr = (FileEvent *)evPtr;
 292     FileInfo *infoPtr;
 293     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 294
 295     if (!(flags & TCL_FILE_EVENTS)) {
 296         return 0;
 297     }
 298
 299     /*
 300      * Search through the list of watched files for the one whose handle
 301      * matches the event.  We do this rather than simply dereferencing
 302      * the handle in the event so that files can be deleted while the
 303      * event is in the queue.
 304      */
 305
 306     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 307             infoPtr = infoPtr->nextPtr) {
 308         if (fileEvPtr->infoPtr == infoPtr) {
 309             infoPtr->flags &= ~(FILE_PENDING);
 310             Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
 311             break;
 312         }
 313     }
 314     return 1;
 315 }
 316 \f
 317 /*
 318  *----------------------------------------------------------------------
 319  *
 320  * FileBlockProc --
 321  *
 322  *      Set blocking or non-blocking mode on channel.
 323  *
 324  * Results:
 325  *      0 if successful, errno when failed.
 326  *
 327  * Side effects:
 328  *      Sets the device into blocking or non-blocking mode.
 329  *
 330  *----------------------------------------------------------------------
 331  */
 332
 333 static int
 334 FileBlockProc(instanceData, mode)
 335     ClientData instanceData;    /* Instance data for channel. */
 336     int mode;                   /* TCL_MODE_BLOCKING or
 337                                  * TCL_MODE_NONBLOCKING. */
 338 {
 339     FileInfo *infoPtr = (FileInfo *) instanceData;
 340
 341     /*
 342      * Files on Windows can not be switched between blocking and nonblocking,
 343      * hence we have to emulate the behavior. This is done in the input
 344      * function by checking against a bit in the state. We set or unset the
 345      * bit here to cause the input function to emulate the correct behavior.
 346      */
 347
 348     if (mode == TCL_MODE_NONBLOCKING) {
 349         infoPtr->flags |= FILE_ASYNC;
 350     } else {
 351         infoPtr->flags &= ~(FILE_ASYNC);
 352     }
 353     return 0;
 354 }
 355 \f
 356 /*
 357  *----------------------------------------------------------------------
 358  *
 359  * FileCloseProc --
 360  *
 361  *      Closes the IO channel.
 362  *
 363  * Results:
 364  *      0 if successful, the value of errno if failed.
 365  *
 366  * Side effects:
 367  *      Closes the physical channel
 368  *
 369  *----------------------------------------------------------------------
 370  */
 371
 372 static int
 373 FileCloseProc(instanceData, interp)
 374     ClientData instanceData;    /* Pointer to FileInfo structure. */
 375     Tcl_Interp *interp;         /* Not used. */
 376 {
 377     FileInfo *fileInfoPtr = (FileInfo *) instanceData;
 378     FileInfo **nextPtrPtr;
 379     int errorCode = 0;
 380     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 381
 382     /*
 383      * Remove the file from the watch list.
 384      */
 385
 386     FileWatchProc(instanceData, 0);
 387
 388     /*
 389      * Don't close the Win32 handle if the handle is a standard channel
 390      * during the exit process.  Otherwise, one thread may kill the stdio
 391      * of another.
 392      */
 393
 394     if (!TclInExit()
 395             || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
 396                 && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
 397                 && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
 398         if (CloseHandle(fileInfoPtr->handle) == FALSE) {
 399             TclWinConvertError(GetLastError());
 400             errorCode = errno;
 401         }
 402     }
 403     for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
 404          nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 405         if ((*nextPtrPtr) == fileInfoPtr) {
 406             (*nextPtrPtr) = fileInfoPtr->nextPtr;
 407             break;
 408         }
 409     }
 410     ckfree((char *)fileInfoPtr);
 411     return errorCode;
 412 }
 413 \f
 414 /*
 415  *----------------------------------------------------------------------
 416  *
 417  * FileSeekProc --
 418  *
 419  *      Seeks on a file-based channel. Returns the new position.
 420  *
 421  * Results:
 422  *      -1 if failed, the new position if successful. If failed, it
 423  *      also sets *errorCodePtr to the error code.
 424  *
 425  * Side effects:
 426  *      Moves the location at which the channel will be accessed in
 427  *      future operations.
 428  *
 429  *----------------------------------------------------------------------
 430  */
 431
 432 static int
 433 FileSeekProc(instanceData, offset, mode, errorCodePtr)
 434     ClientData instanceData;                    /* File state. */
 435     long offset;                                /* Offset to seek to. */
 436     int mode;                                   /* Relative to where
 437                                                  * should we seek? */
 438     int *errorCodePtr;                          /* To store error code. */
 439 {
 440     FileInfo *infoPtr = (FileInfo *) instanceData;
 441     DWORD moveMethod;
 442     DWORD newPos;
 443
 444     *errorCodePtr = 0;
 445     if (mode == SEEK_SET) {
 446         moveMethod = FILE_BEGIN;
 447     } else if (mode == SEEK_CUR) {
 448         moveMethod = FILE_CURRENT;
 449     } else {
 450         moveMethod = FILE_END;
 451     }
 452
 453     newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
 454     if (newPos == 0xFFFFFFFF) {
 455         TclWinConvertError(GetLastError());
 456         *errorCodePtr = errno;
 457         return -1;
 458     }
 459     return newPos;
 460 }
 461 \f
 462 /*
 463  *----------------------------------------------------------------------
 464  *
 465  * FileInputProc --
 466  *
 467  *      Reads input from the IO channel into the buffer given. Returns
 468  *      count of how many bytes were actually read, and an error indication.
 469  *
 470  * Results:
 471  *      A count of how many bytes were read is returned and an error
 472  *      indication is returned in an output argument.
 473  *
 474  * Side effects:
 475  *      Reads input from the actual channel.
 476  *
 477  *----------------------------------------------------------------------
 478  */
 479
 480 static int
 481 FileInputProc(instanceData, buf, bufSize, errorCode)
 482     ClientData instanceData;            /* File state. */
 483     char *buf;                          /* Where to store data read. */
 484     int bufSize;                        /* How much space is available
 485                                          * in the buffer? */
 486     int *errorCode;                     /* Where to store error code. */
 487 {
 488     FileInfo *infoPtr;
 489     DWORD bytesRead;
 490
 491     *errorCode = 0;
 492     infoPtr = (FileInfo *) instanceData;
 493
 494     /*
 495      * Note that we will block on reads from a console buffer until a
 496      * full line has been entered.  The only way I know of to get
 497      * around this is to write a console driver.  We should probably
 498      * do this at some point, but for now, we just block.  The same
 499      * problem exists for files being read over the network.
 500      */
 501
 502     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
 503             (LPOVERLAPPED) NULL) != FALSE) {
 504         return bytesRead;
 505     }
 506
 507     TclWinConvertError(GetLastError());
 508     *errorCode = errno;
 509     if (errno == EPIPE) {
 510         return 0;
 511     }
 512     return -1;
 513 }
 514 \f
 515 /*
 516  *----------------------------------------------------------------------
 517  *
 518  * FileOutputProc --
 519  *
 520  *      Writes the given output on the IO channel. Returns count of how
 521  *      many characters were actually written, and an error indication.
 522  *
 523  * Results:
 524  *      A count of how many characters were written is returned and an
 525  *      error indication is returned in an output argument.
 526  *
 527  * Side effects:
 528  *      Writes output on the actual channel.
 529  *
 530  *----------------------------------------------------------------------
 531  */
 532
 533 static int
 534 FileOutputProc(instanceData, buf, toWrite, errorCode)
 535     ClientData instanceData;            /* File state. */
 536     char *buf;                          /* The data buffer. */
 537     int toWrite;                        /* How many bytes to write? */
 538     int *errorCode;                     /* Where to store error code. */
 539 {
 540     FileInfo *infoPtr = (FileInfo *) instanceData;
 541     DWORD bytesWritten;
 542
 543     *errorCode = 0;
 544
 545     /*
 546      * If we are writing to a file that was opened with O_APPEND, we need to
 547      * seek to the end of the file before writing the current buffer.
 548      */
 549
 550     if (infoPtr->flags & FILE_APPEND) {
 551         SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
 552     }
 553
 554     if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
 555             (LPOVERLAPPED) NULL) == FALSE) {
 556         TclWinConvertError(GetLastError());
 557         *errorCode = errno;
 558         return -1;
 559     }
 560     FlushFileBuffers(infoPtr->handle);
 561     return bytesWritten;
 562 }
 563 \f
 564 /*
 565  *----------------------------------------------------------------------
 566  *
 567  * FileWatchProc --
 568  *
 569  *      Called by the notifier to set up to watch for events on this
 570  *      channel.
 571  *
 572  * Results:
 573  *      None.
 574  *
 575  * Side effects:
 576  *      None.
 577  *
 578  *----------------------------------------------------------------------
 579  */
 580
 581 static void
 582 FileWatchProc(instanceData, mask)
 583     ClientData instanceData;            /* File state. */
 584     int mask;                           /* What events to watch for; OR-ed
 585                                          * combination of TCL_READABLE,
 586                                          * TCL_WRITABLE and TCL_EXCEPTION. */
 587 {
 588     FileInfo *infoPtr = (FileInfo *) instanceData;
 589     Tcl_Time blockTime = { 0, 0 };
 590
 591     /*
 592      * Since the file is always ready for events, we set the block time
 593      * to zero so we will poll.
 594      */
 595
 596     infoPtr->watchMask = mask & infoPtr->validMask;
 597     if (infoPtr->watchMask) {
 598         Tcl_SetMaxBlockTime(&blockTime);
 599     }
 600 }
 601 \f
 602 /*
 603  *----------------------------------------------------------------------
 604  *
 605  * FileGetHandleProc --
 606  *
 607  *      Called from Tcl_GetChannelHandle to retrieve OS handles from
 608  *      a file based channel.
 609  *
 610  * Results:
 611  *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
 612  *      there is no handle for the specified direction.
 613  *
 614  * Side effects:
 615  *      None.
 616  *
 617  *----------------------------------------------------------------------
 618  */
 619
 620 static int
 621 FileGetHandleProc(instanceData, direction, handlePtr)
 622     ClientData instanceData;    /* The file state. */
 623     int direction;              /* TCL_READABLE or TCL_WRITABLE */
 624     ClientData *handlePtr;      /* Where to store the handle.  */
 625 {
 626     FileInfo *infoPtr = (FileInfo *) instanceData;
 627
 628     if (direction & infoPtr->validMask) {
 629         *handlePtr = (ClientData) infoPtr->handle;
 630         return TCL_OK;
 631     } else {
 632         return TCL_ERROR;
 633     }
 634 }
 635
 636 \f
 637 /*
 638  *----------------------------------------------------------------------
 639  *
 640  * TclpOpenFileChannel --
 641  *
 642  *      Open an File based channel on Unix systems.
 643  *
 644  * Results:
 645  *      The new channel or NULL. If NULL, the output argument
 646  *      errorCodePtr is set to a POSIX error.
 647  *
 648  * Side effects:
 649  *      May open the channel and may cause creation of a file on the
 650  *      file system.
 651  *
 652  *----------------------------------------------------------------------
 653  */
 654
 655 Tcl_Channel
 656 TclpOpenFileChannel(interp, fileName, modeString, permissions)
 657     Tcl_Interp *interp;                 /* Interpreter for error reporting;
 658                                          * can be NULL. */
 659     char *fileName;                     /* Name of file to open. */
 660     char *modeString;                   /* A list of POSIX open modes or
 661                                          * a string such as "rw". */
 662     int permissions;                    /* If the open involves creating a
 663                                          * file, with what modes to create
 664                                          * it? */
 665 {
 666     Tcl_Channel channel = 0;
 667     int seekFlag, mode, channelPermissions;
 668     DWORD accessMode, createMode, shareMode, flags, consoleParams, type;
 669     TCHAR *nativeName;
 670     Tcl_DString ds, buffer;
 671     DCB dcb;
 672     HANDLE handle;
 673     char channelName[16 + TCL_INTEGER_SPACE];
 674     TclFile readFile = NULL;
 675     TclFile writeFile = NULL;
 676 #ifdef __CYGWIN__
 677     char winbuf[MAX_PATH];
 678 #endif
 679
 680     mode = TclGetOpenMode(interp, modeString, &seekFlag);
 681     if (mode == -1) {
 682         return NULL;
 683     }
 684
 685     if (Tcl_TranslateFileName(interp, fileName, &ds) == NULL) {
 686         return NULL;
 687     }
 688     nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&ds),
 689             Tcl_DStringLength(&ds), &buffer);
 690
 691 #ifdef __CYGWIN__
 692     /* In the Cygwin world, call conv_to_win32_path in order to use
 693        the mount table to translate the file name into something
 694        Windows will understand.  */
 695     cygwin_conv_to_win32_path(nativeName, winbuf);
 696     Tcl_DStringFree(&buffer);
 697     Tcl_DStringAppend(&buffer, winbuf, -1);
 698 #endif
 699
 700     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
 701         case O_RDONLY:
 702             accessMode = GENERIC_READ;
 703             channelPermissions = TCL_READABLE;
 704             break;
 705         case O_WRONLY:
 706             accessMode = GENERIC_WRITE;
 707             channelPermissions = TCL_WRITABLE;
 708             break;
 709         case O_RDWR:
 710             accessMode = (GENERIC_READ | GENERIC_WRITE);
 711             channelPermissions = (TCL_READABLE | TCL_WRITABLE);
 712             break;
 713         default:
 714             panic("TclpOpenFileChannel: invalid mode value");
 715             break;
 716     }
 717
 718     /*
 719      * Map the creation flags to the NT create mode.
 720      */
 721
 722     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
 723         case (O_CREAT | O_EXCL):
 724         case (O_CREAT | O_EXCL | O_TRUNC):
 725             createMode = CREATE_NEW;
 726             break;
 727         case (O_CREAT | O_TRUNC):
 728             createMode = CREATE_ALWAYS;
 729             break;
 730         case O_CREAT:
 731             createMode = OPEN_ALWAYS;
 732             break;
 733         case O_TRUNC:
 734         case (O_TRUNC | O_EXCL):
 735             createMode = TRUNCATE_EXISTING;
 736             break;
 737         default:
 738             createMode = OPEN_EXISTING;
 739             break;
 740     }
 741
 742     /*
 743      * If the file is being created, get the file attributes from the
 744      * permissions argument, else use the existing file attributes.
 745      */
 746
 747     if (mode & O_CREAT) {
 748         if (permissions & S_IWRITE) {
 749             flags = FILE_ATTRIBUTE_NORMAL;
 750         } else {
 751             flags = FILE_ATTRIBUTE_READONLY;
 752         }
 753     } else {
 754         flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
 755         if (flags == 0xFFFFFFFF) {
 756             flags = 0;
 757         }
 758     }
 759
 760     /*
 761      * Set up the file sharing mode.  We want to allow simultaneous access.
 762      */
 763
 764     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
 765
 766     /*
 767      * Now we get to create the file.
 768      */
 769
 770     handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
 771             shareMode, NULL, createMode, flags, (HANDLE) NULL);
 772
 773     if (handle == INVALID_HANDLE_VALUE) {
 774         DWORD err;
 775         err = GetLastError();
 776         if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
 777             err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
 778         }
 779         TclWinConvertError(err);
 780         if (interp != (Tcl_Interp *) NULL) {
 781             Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
 782                              Tcl_PosixError(interp), (char *) NULL);
 783         }
 784         Tcl_DStringFree(&buffer);
 785         return NULL;
 786     }
 787
 788     type = GetFileType(handle);
 789
 790     /*
 791      * If the file is a character device, we need to try to figure out
 792      * whether it is a serial port, a console, or something else.  We
 793      * test for the console case first because this is more common.
 794      */
 795
 796     if (type == FILE_TYPE_CHAR) {
 797         if (GetConsoleMode(handle, &consoleParams)) {
 798             type = FILE_TYPE_CONSOLE;
 799         } else {
 800             dcb.DCBlength = sizeof( DCB ) ;
 801             if (GetCommState(handle, &dcb)) {
 802                 type = FILE_TYPE_SERIAL;
 803             }
 804
 805         }
 806     }
 807
 808     channel = NULL;
 809
 810     switch (type) {
 811     case FILE_TYPE_SERIAL:
 812         channel = TclWinOpenSerialChannel(handle, channelName,
 813                 channelPermissions);
 814         break;
 815     case FILE_TYPE_CONSOLE:
 816         channel = TclWinOpenConsoleChannel(handle, channelName,
 817                 channelPermissions);
 818         break;
 819     case FILE_TYPE_PIPE:
 820         if (channelPermissions & TCL_READABLE) {
 821             readFile = TclWinMakeFile(handle);
 822         }
 823         if (channelPermissions & TCL_WRITABLE) {
 824             writeFile = TclWinMakeFile(handle);
 825         }
 826         channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
 827         break;
 828     case FILE_TYPE_CHAR:
 829     case FILE_TYPE_DISK:
 830     case FILE_TYPE_UNKNOWN:
 831         channel = TclWinOpenFileChannel(handle, channelName,
 832                                         channelPermissions,
 833                                         (mode & O_APPEND) ? FILE_APPEND : 0);
 834         break;
 835
 836     default:
 837         /*
 838          * The handle is of an unknown type, probably /dev/nul equivalent
 839          * or possibly a closed handle.
 840          */
 841
 842         channel = NULL;
 843         Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
 844                 "bad file type", (char *) NULL);
 845         break;
 846     }
 847
 848     Tcl_DStringFree(&buffer);
 849     Tcl_DStringFree(&ds);
 850
 851     if (channel != NULL) {
 852         if (seekFlag) {
 853             if (Tcl_Seek(channel, 0, SEEK_END) < 0) {
 854                 if (interp != (Tcl_Interp *) NULL) {
 855                     Tcl_AppendResult(interp,
 856                             "could not seek to end of file on \"",
 857                             channelName, "\": ", Tcl_PosixError(interp),
 858                             (char *) NULL);
 859                 }
 860                 Tcl_Close(NULL, channel);
 861                 return NULL;
 862             }
 863         }
 864     }
 865     return channel;
 866 }
 867 \f
 868 /*
 869  *----------------------------------------------------------------------
 870  *
 871  * Tcl_MakeFileChannel --
 872  *
 873  *      Creates a Tcl_Channel from an existing platform specific file
 874  *      handle.
 875  *
 876  * Results:
 877  *      The Tcl_Channel created around the preexisting file.
 878  *
 879  * Side effects:
 880  *      None.
 881  *
 882  *----------------------------------------------------------------------
 883  */
 884
 885 Tcl_Channel
 886 Tcl_MakeFileChannel(rawHandle, mode)
 887     ClientData rawHandle;       /* OS level handle */
 888     int mode;                   /* ORed combination of TCL_READABLE and
 889                                  * TCL_WRITABLE to indicate file mode. */
 890 {
 891     char channelName[16 + TCL_INTEGER_SPACE];
 892     Tcl_Channel channel = NULL;
 893     HANDLE handle = (HANDLE) rawHandle;
 894     DCB dcb;
 895     DWORD consoleParams;
 896     DWORD type;
 897     TclFile readFile = NULL;
 898     TclFile writeFile = NULL;
 899
 900     if (mode == 0) {
 901         return NULL;
 902     }
 903
 904     type = GetFileType(handle);
 905
 906     /*
 907      * If the file is a character device, we need to try to figure out
 908      * whether it is a serial port, a console, or something else.  We
 909      * test for the console case first because this is more common.
 910      */
 911
 912     if (type == FILE_TYPE_CHAR) {
 913         if (GetConsoleMode(handle, &consoleParams)) {
 914             type = FILE_TYPE_CONSOLE;
 915         } else {
 916             dcb.DCBlength = sizeof( DCB ) ;
 917             if (GetCommState(handle, &dcb)) {
 918                 type = FILE_TYPE_SERIAL;
 919             }
 920         }
 921     }
 922
 923     switch (type)
 924     {
 925     case FILE_TYPE_SERIAL:
 926         channel = TclWinOpenSerialChannel(handle, channelName, mode);
 927         break;
 928     case FILE_TYPE_CONSOLE:
 929         channel = TclWinOpenConsoleChannel(handle, channelName, mode);
 930         break;
 931     case FILE_TYPE_PIPE:
 932         if (mode & TCL_READABLE)
 933         {
 934             readFile = TclWinMakeFile(handle);
 935         }
 936         if (mode & TCL_WRITABLE)
 937         {
 938             writeFile = TclWinMakeFile(handle);
 939         }
 940         channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
 941         break;
 942
 943     case FILE_TYPE_DISK:
 944     case FILE_TYPE_CHAR:
 945     case FILE_TYPE_UNKNOWN:
 946         channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
 947         break;
 948
 949     default:
 950         /*
 951          * The handle is of an unknown type, probably /dev/nul equivalent
 952          * or possibly a closed handle.
 953          */
 954
 955         channel = NULL;
 956         break;
 957
 958     }
 959
 960     return channel;
 961 }
 962 \f
 963 /*
 964  *----------------------------------------------------------------------
 965  *
 966  * TclpGetDefaultStdChannel --
 967  *
 968  *      Constructs a channel for the specified standard OS handle.
 969  *
 970  * Results:
 971  *      Returns the specified default standard channel, or NULL.
 972  *
 973  * Side effects:
 974  *      May cause the creation of a standard channel and the underlying
 975  *      file.
 976  *
 977  *----------------------------------------------------------------------
 978  */
 979
 980 Tcl_Channel
 981 TclpGetDefaultStdChannel(type)
 982     int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
 983 {
 984     Tcl_Channel channel;
 985     HANDLE handle;
 986     int mode;
 987     char *bufMode;
 988     DWORD handleId;             /* Standard handle to retrieve. */
 989
 990     switch (type) {
 991         case TCL_STDIN:
 992             handleId = STD_INPUT_HANDLE;
 993             mode = TCL_READABLE;
 994             bufMode = "line";
 995             break;
 996         case TCL_STDOUT:
 997             handleId = STD_OUTPUT_HANDLE;
 998             mode = TCL_WRITABLE;
 999             bufMode = "line";
1000             break;
1001         case TCL_STDERR:
1002             handleId = STD_ERROR_HANDLE;
1003             mode = TCL_WRITABLE;
1004             bufMode = "none";
1005             break;
1006         default:
1007             panic("TclGetDefaultStdChannel: Unexpected channel type");
1008             break;
1009     }
1010
1011     handle = GetStdHandle(handleId);
1012
1013     /*
1014      * Note that we need to check for 0 because Windows may return 0 if this
1015      * is not a console mode application, even though this is not a valid
1016      * handle.
1017      */
1018
1019     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
1020         return NULL;
1021     }
1022
1023     channel = Tcl_MakeFileChannel(handle, mode);
1024
1025     if (channel == NULL) {
1026         return NULL;
1027     }
1028
1029     /*
1030      * Set up the normal channel options for stdio handles.
1031      */
1032
1033     if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
1034             "auto") == TCL_ERROR)
1035             || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
1036                     "\032 {}") == TCL_ERROR)
1037             || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
1038                     "-buffering", bufMode) == TCL_ERROR)) {
1039         Tcl_Close((Tcl_Interp *) NULL, channel);
1040         return (Tcl_Channel) NULL;
1041     }
1042     return channel;
1043 }
1044
1045
1046 \f
1047 /*
1048  *----------------------------------------------------------------------
1049  *
1050  * TclWinOpenFileChannel --
1051  *
1052  *      Constructs a File channel for the specified standard OS handle.
1053  *      This is a helper function to break up the construction of
1054  *      channels into File, Console, or Serial.
1055  *
1056  * Results:
1057  *      Returns the new channel, or NULL.
1058  *
1059  * Side effects:
1060  *      May open the channel and may cause creation of a file on the
1061  *      file system.
1062  *
1063  *----------------------------------------------------------------------
1064  */
1065
1066 Tcl_Channel
1067 TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
1068     HANDLE handle;
1069     char *channelName;
1070     int permissions;
1071     int appendMode;
1072 {
1073     FileInfo *infoPtr;
1074     ThreadSpecificData *tsdPtr;
1075
1076     tsdPtr = FileInit();
1077
1078     /*
1079      * See if a channel with this handle already exists.
1080      */
1081
1082     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
1083          infoPtr = infoPtr->nextPtr) {
1084         if (infoPtr->handle == (HANDLE) handle) {
1085             return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
1086         }
1087     }
1088
1089     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
1090     infoPtr->nextPtr = tsdPtr->firstFilePtr;
1091     tsdPtr->firstFilePtr = infoPtr;
1092     infoPtr->validMask = permissions;
1093     infoPtr->watchMask = 0;
1094     infoPtr->flags = appendMode;
1095     infoPtr->handle = handle;
1096
1097     wsprintfA(channelName, "file%lx", (int) infoPtr);
1098
1099     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
1100             (ClientData) infoPtr, permissions);
1101
1102     /*
1103      * Files have default translation of AUTO and ^Z eof char, which
1104      * means that a ^Z will be accepted as EOF when reading.
1105      */
1106
1107     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1108     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1109
1110     return infoPtr->channel;
1111 }
1112
1113