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

   1 /*
   2  * tclWinChan.c
   3  *
   4  *      Channel drivers for Windows channels based on files, command pipes and
   5  *      TCP sockets.
   6  *
   7  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
   8  *
   9  * See the file "license.terms" for information on usage and redistribution of
  10  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11  */
  12
  13 #include "tclWinInt.h"
  14 #include "tclIO.h"
  15
  16 /*
  17  * State flags used in the info structures below.
  18  */
  19
  20 #define FILE_PENDING    (1<<0)  /* Message is pending in the queue. */
  21 #define FILE_ASYNC      (1<<1)  /* Channel is non-blocking. */
  22 #define FILE_APPEND     (1<<2)  /* File is in append mode. */
  23
  24 #define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
  25 #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
  26
  27 /*
  28  * The following structure contains per-instance data for a file based channel.
  29  */
  30
  31 typedef struct FileInfo {
  32     Tcl_Channel channel;        /* Pointer to channel structure. */
  33     int validMask;              /* OR'ed combination of TCL_READABLE,
  34                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  35                                  * which operations are valid on the file. */
  36     int watchMask;              /* OR'ed combination of TCL_READABLE,
  37                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  38                                  * which events should be reported. */
  39     int flags;                  /* State flags, see above for a list. */
  40     HANDLE handle;              /* Input/output file. */
  41     struct FileInfo *nextPtr;   /* Pointer to next registered file. */
  42     int dirty;                  /* Boolean flag. Set if the OS may have data
  43                                  * pending on the channel. */
  44 } FileInfo;
  45
  46 typedef struct ThreadSpecificData {
  47     /*
  48      * List of all file channels currently open.
  49      */
  50
  51     FileInfo *firstFilePtr;
  52 } ThreadSpecificData;
  53
  54 static Tcl_ThreadDataKey dataKey;
  55
  56 /*
  57  * The following structure is what is added to the Tcl event queue when file
  58  * events are generated.
  59  */
  60
  61 typedef struct FileEvent {
  62     Tcl_Event header;           /* Information that is standard for all
  63                                  * events. */
  64     FileInfo *infoPtr;          /* Pointer to file info structure. Note that
  65                                  * we still have to verify that the file
  66                                  * exists before dereferencing this
  67                                  * pointer. */
  68 } FileEvent;
  69
  70 /*
  71  * Static routines for this file:
  72  */
  73
  74 static int              FileBlockProc(ClientData instanceData, int mode);
  75 static void             FileChannelExitHandler(ClientData clientData);
  76 static void             FileCheckProc(ClientData clientData, int flags);
  77 static int              FileCloseProc(ClientData instanceData,
  78                             Tcl_Interp *interp);
  79 static int              FileClose2Proc(ClientData instanceData,
  80                             Tcl_Interp *interp, int flags);
  81 static int              FileEventProc(Tcl_Event *evPtr, int flags);
  82 static int              FileGetHandleProc(ClientData instanceData,
  83                             int direction, ClientData *handlePtr);
  84 static ThreadSpecificData *FileInit(void);
  85 static int              FileInputProc(ClientData instanceData, char *buf,
  86                             int toRead, int *errorCode);
  87 static int              FileOutputProc(ClientData instanceData,
  88                             const char *buf, int toWrite, int *errorCode);
  89 static int              FileSeekProc(ClientData instanceData, long offset,
  90                             int mode, int *errorCode);
  91 static Tcl_WideInt      FileWideSeekProc(ClientData instanceData,
  92                             Tcl_WideInt offset, int mode, int *errorCode);
  93 static void             FileSetupProc(ClientData clientData, int flags);
  94 static void             FileWatchProc(ClientData instanceData, int mask);
  95 static void             FileThreadActionProc(ClientData instanceData,
  96                             int action);
  97 static int              FileTruncateProc(ClientData instanceData,
  98                             Tcl_WideInt length);
  99 static DWORD            FileGetType(HANDLE handle);
 100 static int              NativeIsComPort(const WCHAR *nativeName);
 101 /*
 102  * This structure describes the channel type structure for file based IO.
 103  */
 104
 105 static const Tcl_ChannelType fileChannelType = {
 106     "file",                     /* Type name. */
 107     TCL_CHANNEL_VERSION_5,      /* v5 channel */
 108     FileCloseProc,              /* Close proc. */
 109     FileInputProc,              /* Input proc. */
 110     FileOutputProc,             /* Output proc. */
 111     FileSeekProc,               /* Seek proc. */
 112     NULL,                       /* Set option proc. */
 113     NULL,                       /* Get option proc. */
 114     FileWatchProc,              /* Set up the notifier to watch the channel. */
 115     FileGetHandleProc,          /* Get an OS handle from channel. */
 116         FileClose2Proc,         /* close2proc. */
 117     FileBlockProc,              /* Set blocking or non-blocking mode.*/
 118     NULL,                       /* flush proc. */
 119     NULL,                       /* handler proc. */
 120     FileWideSeekProc,           /* Wide seek proc. */
 121     FileThreadActionProc,       /* Thread action proc. */
 122     FileTruncateProc            /* Truncate proc. */
 123 };
 124 \f
 125 /*
 126  *----------------------------------------------------------------------
 127  *
 128  * FileInit --
 129  *
 130  *      This function creates the window used to simulate file events.
 131  *
 132  * Results:
 133  *      None.
 134  *
 135  * Side effects:
 136  *      Creates a new window and creates an exit handler.
 137  *
 138  *----------------------------------------------------------------------
 139  */
 140
 141 static ThreadSpecificData *
 142 FileInit(void)
 143 {
 144     ThreadSpecificData *tsdPtr =
 145             (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
 146
 147     if (tsdPtr == NULL) {
 148         tsdPtr = TCL_TSD_INIT(&dataKey);
 149         tsdPtr->firstFilePtr = NULL;
 150         Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
 151         Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
 152     }
 153     return tsdPtr;
 154 }
 155 \f
 156 /*
 157  *----------------------------------------------------------------------
 158  *
 159  * FileChannelExitHandler --
 160  *
 161  *      This function is called to cleanup the channel driver before Tcl is
 162  *      unloaded.
 163  *
 164  * Results:
 165  *      None.
 166  *
 167  * Side effects:
 168  *      Destroys the communication window.
 169  *
 170  *----------------------------------------------------------------------
 171  */
 172
 173 static void
 174 FileChannelExitHandler(
 175     ClientData clientData)      /* Old window proc */
 176 {
 177     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
 178 }
 179 \f
 180 /*
 181  *----------------------------------------------------------------------
 182  *
 183  * FileSetupProc --
 184  *
 185  *      This function is invoked before Tcl_DoOneEvent blocks waiting for an
 186  *      event.
 187  *
 188  * Results:
 189  *      None.
 190  *
 191  * Side effects:
 192  *      Adjusts the block time if needed.
 193  *
 194  *----------------------------------------------------------------------
 195  */
 196
 197 void
 198 FileSetupProc(
 199     ClientData data,            /* Not used. */
 200     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
 201 {
 202     FileInfo *infoPtr;
 203     Tcl_Time blockTime = { 0, 0 };
 204     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 205
 206     if (!(flags & TCL_FILE_EVENTS)) {
 207         return;
 208     }
 209
 210     /*
 211      * Check to see if there is a ready file. If so, poll.
 212      */
 213
 214     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 215             infoPtr = infoPtr->nextPtr) {
 216         if (infoPtr->watchMask) {
 217             Tcl_SetMaxBlockTime(&blockTime);
 218             break;
 219         }
 220     }
 221 }
 222 \f
 223 /*
 224  *----------------------------------------------------------------------
 225  *
 226  * FileCheckProc --
 227  *
 228  *      This function is called by Tcl_DoOneEvent to check the file event
 229  *      source for events.
 230  *
 231  * Results:
 232  *      None.
 233  *
 234  * Side effects:
 235  *      May queue an event.
 236  *
 237  *----------------------------------------------------------------------
 238  */
 239
 240 static void
 241 FileCheckProc(
 242     ClientData data,            /* Not used. */
 243     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
 244 {
 245     FileEvent *evPtr;
 246     FileInfo *infoPtr;
 247     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 248
 249     if (!(flags & TCL_FILE_EVENTS)) {
 250         return;
 251     }
 252
 253     /*
 254      * Queue events for any ready files that don't already have events queued
 255      * (caused by persistent states that won't generate WinSock events).
 256      */
 257
 258     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 259             infoPtr = infoPtr->nextPtr) {
 260         if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
 261             infoPtr->flags |= FILE_PENDING;
 262             evPtr = ckalloc(sizeof(FileEvent));
 263             evPtr->header.proc = FileEventProc;
 264             evPtr->infoPtr = infoPtr;
 265             Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 266         }
 267     }
 268 }
 269 \f
 270 /*
 271  *----------------------------------------------------------------------
 272  *
 273  * FileEventProc --
 274  *
 275  *      This function is invoked by Tcl_ServiceEvent when a file event reaches
 276  *      the front of the event queue. This function invokes Tcl_NotifyChannel
 277  *      on the file.
 278  *
 279  * Results:
 280  *      Returns 1 if the event was handled, meaning it should be removed from
 281  *      the queue. Returns 0 if the event was not handled, meaning it should
 282  *      stay on the queue. The only time the event isn't handled is if the
 283  *      TCL_FILE_EVENTS flag bit isn't set.
 284  *
 285  * Side effects:
 286  *      Whatever the notifier callback does.
 287  *
 288  *----------------------------------------------------------------------
 289  */
 290
 291 static int
 292 FileEventProc(
 293     Tcl_Event *evPtr,           /* Event to service. */
 294     int flags)                  /* Flags that indicate what events to handle,
 295                                  * such as TCL_FILE_EVENTS. */
 296 {
 297     FileEvent *fileEvPtr = (FileEvent *)evPtr;
 298     FileInfo *infoPtr;
 299     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 300
 301     if (!(flags & TCL_FILE_EVENTS)) {
 302         return 0;
 303     }
 304
 305     /*
 306      * Search through the list of watched files for the one whose handle
 307      * matches the event. We do this rather than simply dereferencing the
 308      * handle in the event so that files can be deleted while the event is in
 309      * the queue.
 310      */
 311
 312     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 313             infoPtr = infoPtr->nextPtr) {
 314         if (fileEvPtr->infoPtr == infoPtr) {
 315             infoPtr->flags &= ~(FILE_PENDING);
 316             Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
 317             break;
 318         }
 319     }
 320     return 1;
 321 }
 322 \f
 323 /*
 324  *----------------------------------------------------------------------
 325  *
 326  * FileBlockProc --
 327  *
 328  *      Set blocking or non-blocking mode on channel.
 329  *
 330  * Results:
 331  *      0 if successful, errno when failed.
 332  *
 333  * Side effects:
 334  *      Sets the device into blocking or non-blocking mode.
 335  *
 336  *----------------------------------------------------------------------
 337  */
 338
 339 static int
 340 FileBlockProc(
 341     ClientData instanceData,    /* Instance data for channel. */
 342     int mode)                   /* TCL_MODE_BLOCKING or
 343                                  * TCL_MODE_NONBLOCKING. */
 344 {
 345     FileInfo *infoPtr = instanceData;
 346
 347     /*
 348      * Files on Windows can not be switched between blocking and nonblocking,
 349      * hence we have to emulate the behavior. This is done in the input
 350      * function by checking against a bit in the state. We set or unset the
 351      * bit here to cause the input function to emulate the correct behavior.
 352      */
 353
 354     if (mode == TCL_MODE_NONBLOCKING) {
 355         infoPtr->flags |= FILE_ASYNC;
 356     } else {
 357         infoPtr->flags &= ~(FILE_ASYNC);
 358     }
 359     return 0;
 360 }
 361 \f
 362 /*
 363  *----------------------------------------------------------------------
 364  *
 365  * FileCloseProc/FileClose2Proc --
 366  *
 367  *      Closes the IO channel.
 368  *
 369  * Results:
 370  *      0 if successful, the value of errno if failed.
 371  *
 372  * Side effects:
 373  *      Closes the physical channel
 374  *
 375  *----------------------------------------------------------------------
 376  */
 377
 378 static int
 379 FileCloseProc(
 380     ClientData instanceData,    /* Pointer to FileInfo structure. */
 381     Tcl_Interp *interp)         /* Not used. */
 382 {
 383     FileInfo *fileInfoPtr = instanceData;
 384     FileInfo *infoPtr;
 385     ThreadSpecificData *tsdPtr;
 386     int errorCode = 0;
 387
 388     /*
 389      * Remove the file from the watch list.
 390      */
 391
 392     FileWatchProc(instanceData, 0);
 393
 394     /*
 395      * Don't close the Win32 handle if the handle is a standard channel during
 396      * the thread exit process. Otherwise, one thread may kill the stdio of
 397      * another.
 398      */
 399
 400     if (!TclInThreadExit()
 401             || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
 402             &&  (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
 403             &&  (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
 404         if (CloseHandle(fileInfoPtr->handle) == FALSE) {
 405             TclWinConvertError(GetLastError());
 406             errorCode = errno;
 407         }
 408     }
 409
 410     /*
 411      * See if this FileInfo* is still on the thread local list.
 412      */
 413
 414     tsdPtr = TCL_TSD_INIT(&dataKey);
 415     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 416             infoPtr = infoPtr->nextPtr) {
 417         if (infoPtr == fileInfoPtr) {
 418             /*
 419              * This channel exists on the thread local list. It should have
 420              * been removed by an earlier Threadaction call, but do that now
 421              * since just deallocating fileInfoPtr would leave an deallocated
 422              * pointer on the thread local list.
 423              */
 424
 425             FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
 426             break;
 427         }
 428     }
 429     ckfree(fileInfoPtr);
 430     return errorCode;
 431 }
 432
 433 static int
 434 FileClose2Proc(
 435     ClientData instanceData,    /* Pointer to FileInfo structure. */
 436     Tcl_Interp *interp,         /* Not used. */
 437         int flags)
 438 {
 439     if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
 440         return FileCloseProc(instanceData, interp);
 441     }
 442     return EINVAL;
 443 }
 444 \f
 445 /*
 446  *----------------------------------------------------------------------
 447  *
 448  * FileSeekProc --
 449  *
 450  *      Seeks on a file-based channel. Returns the new position.
 451  *
 452  * Results:
 453  *      -1 if failed, the new position if successful. If failed, it also sets
 454  *      *errorCodePtr to the error code.
 455  *
 456  * Side effects:
 457  *      Moves the location at which the channel will be accessed in future
 458  *      operations.
 459  *
 460  *----------------------------------------------------------------------
 461  */
 462
 463 static int
 464 FileSeekProc(
 465     ClientData instanceData,    /* File state. */
 466     long offset,                /* Offset to seek to. */
 467     int mode,                   /* Relative to where should we seek? */
 468     int *errorCodePtr)          /* To store error code. */
 469 {
 470     FileInfo *infoPtr = instanceData;
 471     LONG newPos, newPosHigh, oldPos, oldPosHigh;
 472     DWORD moveMethod;
 473
 474     *errorCodePtr = 0;
 475     if (mode == SEEK_SET) {
 476         moveMethod = FILE_BEGIN;
 477     } else if (mode == SEEK_CUR) {
 478         moveMethod = FILE_CURRENT;
 479     } else {
 480         moveMethod = FILE_END;
 481     }
 482
 483     /*
 484      * Save our current place in case we need to roll-back the seek.
 485      */
 486
 487     oldPosHigh = 0;
 488     oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
 489     if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
 490         DWORD winError = GetLastError();
 491
 492         if (winError != NO_ERROR) {
 493             TclWinConvertError(winError);
 494             *errorCodePtr = errno;
 495             return -1;
 496         }
 497     }
 498
 499     newPosHigh = (offset < 0 ? -1 : 0);
 500     newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
 501     if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
 502         DWORD winError = GetLastError();
 503
 504         if (winError != NO_ERROR) {
 505             TclWinConvertError(winError);
 506             *errorCodePtr = errno;
 507             return -1;
 508         }
 509     }
 510
 511     /*
 512      * Check for expressability in our return type, and roll-back otherwise.
 513      */
 514
 515     if (newPosHigh != 0) {
 516         *errorCodePtr = EOVERFLOW;
 517         SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
 518         return -1;
 519     }
 520     return (int) newPos;
 521 }
 522 \f
 523 /*
 524  *----------------------------------------------------------------------
 525  *
 526  * FileWideSeekProc --
 527  *
 528  *      Seeks on a file-based channel. Returns the new position.
 529  *
 530  * Results:
 531  *      -1 if failed, the new position if successful. If failed, it also sets
 532  *      *errorCodePtr to the error code.
 533  *
 534  * Side effects:
 535  *      Moves the location at which the channel will be accessed in future
 536  *      operations.
 537  *
 538  *----------------------------------------------------------------------
 539  */
 540
 541 static Tcl_WideInt
 542 FileWideSeekProc(
 543     ClientData instanceData,    /* File state. */
 544     Tcl_WideInt offset,         /* Offset to seek to. */
 545     int mode,                   /* Relative to where should we seek? */
 546     int *errorCodePtr)          /* To store error code. */
 547 {
 548     FileInfo *infoPtr = instanceData;
 549     DWORD moveMethod;
 550     LONG newPos, newPosHigh;
 551
 552     *errorCodePtr = 0;
 553     if (mode == SEEK_SET) {
 554         moveMethod = FILE_BEGIN;
 555     } else if (mode == SEEK_CUR) {
 556         moveMethod = FILE_CURRENT;
 557     } else {
 558         moveMethod = FILE_END;
 559     }
 560
 561     newPosHigh = Tcl_WideAsLong(offset >> 32);
 562     newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
 563             &newPosHigh, moveMethod);
 564     if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
 565         DWORD winError = GetLastError();
 566
 567         if (winError != NO_ERROR) {
 568             TclWinConvertError(winError);
 569             *errorCodePtr = errno;
 570             return -1;
 571         }
 572     }
 573     return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32));
 574 }
 575 \f
 576 /*
 577  *----------------------------------------------------------------------
 578  *
 579  * FileTruncateProc --
 580  *
 581  *      Truncates a file-based channel. Returns the error code.
 582  *
 583  * Results:
 584  *      0 if successful, POSIX-y error code if it failed.
 585  *
 586  * Side effects:
 587  *      Truncates the file, may move file pointers too.
 588  *
 589  *----------------------------------------------------------------------
 590  */
 591
 592 static int
 593 FileTruncateProc(
 594     ClientData instanceData,    /* File state. */
 595     Tcl_WideInt length)         /* Length to truncate at. */
 596 {
 597     FileInfo *infoPtr = instanceData;
 598     LONG newPos, newPosHigh, oldPos, oldPosHigh;
 599
 600     /*
 601      * Save where we were...
 602      */
 603
 604     oldPosHigh = 0;
 605     oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
 606     if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
 607         DWORD winError = GetLastError();
 608         if (winError != NO_ERROR) {
 609             TclWinConvertError(winError);
 610             return errno;
 611         }
 612     }
 613
 614     /*
 615      * Move to where we want to truncate
 616      */
 617
 618     newPosHigh = Tcl_WideAsLong(length >> 32);
 619     newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
 620             &newPosHigh, FILE_BEGIN);
 621     if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
 622         DWORD winError = GetLastError();
 623         if (winError != NO_ERROR) {
 624             TclWinConvertError(winError);
 625             return errno;
 626         }
 627     }
 628
 629     /*
 630      * Perform the truncation (unlike POSIX ftruncate(), we needed to move to
 631      * the location to truncate at first).
 632      */
 633
 634     if (!SetEndOfFile(infoPtr->handle)) {
 635         TclWinConvertError(GetLastError());
 636         return errno;
 637     }
 638
 639     /*
 640      * Move back. If this last step fails, we don't care; it's just a "best
 641      * effort" attempt to restore our file pointer to where it was.
 642      */
 643
 644     SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
 645     return 0;
 646 }
 647 \f
 648 /*
 649  *----------------------------------------------------------------------
 650  *
 651  * FileInputProc --
 652  *
 653  *      Reads input from the IO channel into the buffer given. Returns count
 654  *      of how many bytes were actually read, and an error indication.
 655  *
 656  * Results:
 657  *      A count of how many bytes were read is returned and an error
 658  *      indication is returned in an output argument.
 659  *
 660  * Side effects:
 661  *      Reads input from the actual channel.
 662  *
 663  *----------------------------------------------------------------------
 664  */
 665
 666 static int
 667 FileInputProc(
 668     ClientData instanceData,    /* File state. */
 669     char *buf,                  /* Where to store data read. */
 670     int bufSize,                /* Num bytes available in buffer. */
 671     int *errorCode)             /* Where to store error code. */
 672 {
 673     FileInfo *infoPtr = instanceData;
 674     DWORD bytesRead;
 675
 676     *errorCode = 0;
 677
 678     /*
 679      * TODO: This comment appears to be out of date.  We *do* have a
 680      * console driver, over in tclWinConsole.c.  After some Windows
 681      * developer confirms, this comment should be revised.
 682      *
 683      * Note that we will block on reads from a console buffer until a full
 684      * line has been entered. The only way I know of to get around this is to
 685      * write a console driver. We should probably do this at some point, but
 686      * for now, we just block. The same problem exists for files being read
 687      * over the network.
 688      */
 689
 690     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
 691             (LPOVERLAPPED) NULL) != FALSE) {
 692         return bytesRead;
 693     }
 694
 695     TclWinConvertError(GetLastError());
 696     *errorCode = errno;
 697     if (errno == EPIPE) {
 698         return 0;
 699     }
 700     return -1;
 701 }
 702 \f
 703 /*
 704  *----------------------------------------------------------------------
 705  *
 706  * FileOutputProc --
 707  *
 708  *      Writes the given output on the IO channel. Returns count of how many
 709  *      characters were actually written, and an error indication.
 710  *
 711  * Results:
 712  *      A count of how many characters were written is returned and an error
 713  *      indication is returned in an output argument.
 714  *
 715  * Side effects:
 716  *      Writes output on the actual channel.
 717  *
 718  *----------------------------------------------------------------------
 719  */
 720
 721 static int
 722 FileOutputProc(
 723     ClientData instanceData,    /* File state. */
 724     const char *buf,            /* The data buffer. */
 725     int toWrite,                /* How many bytes to write? */
 726     int *errorCode)             /* Where to store error code. */
 727 {
 728     FileInfo *infoPtr = instanceData;
 729     DWORD bytesWritten;
 730
 731     *errorCode = 0;
 732
 733     /*
 734      * If we are writing to a file that was opened with O_APPEND, we need to
 735      * seek to the end of the file before writing the current buffer.
 736      */
 737
 738     if (infoPtr->flags & FILE_APPEND) {
 739         SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
 740     }
 741
 742     if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
 743             &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
 744         TclWinConvertError(GetLastError());
 745         *errorCode = errno;
 746         return -1;
 747     }
 748     infoPtr->dirty = 1;
 749     return bytesWritten;
 750 }
 751 \f
 752 /*
 753  *----------------------------------------------------------------------
 754  *
 755  * FileWatchProc --
 756  *
 757  *      Called by the notifier to set up to watch for events on this channel.
 758  *
 759  * Results:
 760  *      None.
 761  *
 762  * Side effects:
 763  *      None.
 764  *
 765  *----------------------------------------------------------------------
 766  */
 767
 768 static void
 769 FileWatchProc(
 770     ClientData instanceData,    /* File state. */
 771     int mask)                   /* What events to watch for; OR-ed combination
 772                                  * of TCL_READABLE, TCL_WRITABLE and
 773                                  * TCL_EXCEPTION. */
 774 {
 775     FileInfo *infoPtr = instanceData;
 776     Tcl_Time blockTime = { 0, 0 };
 777
 778     /*
 779      * Since the file is always ready for events, we set the block time to
 780      * zero so we will poll.
 781      */
 782
 783     infoPtr->watchMask = mask & infoPtr->validMask;
 784     if (infoPtr->watchMask) {
 785         Tcl_SetMaxBlockTime(&blockTime);
 786     }
 787 }
 788 \f
 789 /*
 790  *----------------------------------------------------------------------
 791  *
 792  * FileGetHandleProc --
 793  *
 794  *      Called from Tcl_GetChannelHandle to retrieve OS handles from a file
 795  *      based channel.
 796  *
 797  * Results:
 798  *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
 799  *      handle for the specified direction.
 800  *
 801  * Side effects:
 802  *      None.
 803  *
 804  *----------------------------------------------------------------------
 805  */
 806
 807 static int
 808 FileGetHandleProc(
 809     ClientData instanceData,    /* The file state. */
 810     int direction,              /* TCL_READABLE or TCL_WRITABLE */
 811     ClientData *handlePtr)      /* Where to store the handle.  */
 812 {
 813     FileInfo *infoPtr = instanceData;
 814
 815     if (direction & infoPtr->validMask) {
 816         *handlePtr = (ClientData) infoPtr->handle;
 817         return TCL_OK;
 818     } else {
 819         return TCL_ERROR;
 820     }
 821 }
 822 \f
 823 /*
 824  *----------------------------------------------------------------------
 825  *
 826  * TclpOpenFileChannel --
 827  *
 828  *      Open an File based channel on Unix systems.
 829  *
 830  * Results:
 831  *      The new channel or NULL. If NULL, the output argument errorCodePtr is
 832  *      set to a POSIX error.
 833  *
 834  * Side effects:
 835  *      May open the channel and may cause creation of a file on the file
 836  *      system.
 837  *
 838  *----------------------------------------------------------------------
 839  */
 840
 841 Tcl_Channel
 842 TclpOpenFileChannel(
 843     Tcl_Interp *interp,         /* Interpreter for error reporting; can be
 844                                  * NULL. */
 845     Tcl_Obj *pathPtr,           /* Name of file to open. */
 846     int mode,                   /* POSIX mode. */
 847     int permissions)            /* If the open involves creating a file, with
 848                                  * what modes to create it? */
 849 {
 850     Tcl_Channel channel = 0;
 851     int channelPermissions = 0;
 852     DWORD accessMode = 0, createMode, shareMode, flags;
 853     const WCHAR *nativeName;
 854     HANDLE handle;
 855     char channelName[16 + TCL_INTEGER_SPACE];
 856     TclFile readFile = NULL, writeFile = NULL;
 857
 858     nativeName = Tcl_FSGetNativePath(pathPtr);
 859     if (nativeName == NULL) {
 860         if (interp != (Tcl_Interp *) NULL) {
 861             Tcl_AppendResult(interp, "couldn't open \"",
 862             TclGetString(pathPtr), "\": filename is invalid on this platform",
 863             NULL);
 864         }
 865         return NULL;
 866     }
 867
 868     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
 869     case O_RDONLY:
 870         accessMode = GENERIC_READ;
 871         channelPermissions = TCL_READABLE;
 872         break;
 873     case O_WRONLY:
 874         accessMode = GENERIC_WRITE;
 875         channelPermissions = TCL_WRITABLE;
 876         break;
 877     case O_RDWR:
 878         accessMode = (GENERIC_READ | GENERIC_WRITE);
 879         channelPermissions = (TCL_READABLE | TCL_WRITABLE);
 880         break;
 881     default:
 882         Tcl_Panic("TclpOpenFileChannel: invalid mode value");
 883         break;
 884     }
 885
 886     /*
 887      * Map the creation flags to the NT create mode.
 888      */
 889
 890     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
 891     case (O_CREAT | O_EXCL):
 892     case (O_CREAT | O_EXCL | O_TRUNC):
 893         createMode = CREATE_NEW;
 894         break;
 895     case (O_CREAT | O_TRUNC):
 896         createMode = CREATE_ALWAYS;
 897         break;
 898     case O_CREAT:
 899         createMode = OPEN_ALWAYS;
 900         break;
 901     case O_TRUNC:
 902     case (O_TRUNC | O_EXCL):
 903         createMode = TRUNCATE_EXISTING;
 904         break;
 905     default:
 906         createMode = OPEN_EXISTING;
 907         break;
 908     }
 909
 910     /*
 911      * [2413550] Avoid double-open of serial ports on Windows
 912      * Special handling for Windows serial ports by a "name-hint"
 913      * to directly open it with the OVERLAPPED flag set.
 914      */
 915
 916     if( NativeIsComPort(nativeName) ) {
 917
 918         handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
 919         if (handle == INVALID_HANDLE_VALUE) {
 920             TclWinConvertError(GetLastError());
 921             if (interp != (Tcl_Interp *) NULL) {
 922                 Tcl_AppendResult(interp, "couldn't open serial \"",
 923                         TclGetString(pathPtr), "\": ",
 924                         Tcl_PosixError(interp), NULL);
 925             }
 926             return NULL;
 927         }
 928
 929         /*
 930         * For natively named Windows serial ports we are done.
 931         */
 932         channel = TclWinOpenSerialChannel(handle, channelName,
 933                 channelPermissions);
 934
 935         return channel;
 936     }
 937     /*
 938      * If the file is being created, get the file attributes from the
 939      * permissions argument, else use the existing file attributes.
 940      */
 941
 942     if (mode & O_CREAT) {
 943         if (permissions & S_IWRITE) {
 944             flags = FILE_ATTRIBUTE_NORMAL;
 945         } else {
 946             flags = FILE_ATTRIBUTE_READONLY;
 947         }
 948     } else {
 949         flags = GetFileAttributesW(nativeName);
 950         if (flags == 0xFFFFFFFF) {
 951             flags = 0;
 952         }
 953     }
 954
 955     /*
 956      * Set up the file sharing mode.  We want to allow simultaneous access.
 957      */
 958
 959     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
 960
 961     /*
 962      * Now we get to create the file.
 963      */
 964
 965     handle = CreateFileW(nativeName, accessMode, shareMode,
 966             NULL, createMode, flags, (HANDLE) NULL);
 967
 968     if (handle == INVALID_HANDLE_VALUE) {
 969         DWORD err = GetLastError();
 970
 971         if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
 972             err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
 973         }
 974         TclWinConvertError(err);
 975         if (interp != (Tcl_Interp *) NULL) {
 976             Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 977                     "couldn't open \"%s\": %s",
 978                     TclGetString(pathPtr), Tcl_PosixError(interp)));
 979         }
 980         return NULL;
 981     }
 982
 983     channel = NULL;
 984
 985     switch (FileGetType(handle)) {
 986     case FILE_TYPE_SERIAL:
 987         /*
 988          * Natively named serial ports "com1-9", "\\\\.\\comXX" are
 989          * already done with the code above.
 990          * Here we handle all other serial port names.
 991          *
 992          * Reopen channel for OVERLAPPED operation. Normally this shouldn't
 993          * fail, because the channel exists.
 994          */
 995
 996         handle = TclWinSerialOpen(handle, nativeName, accessMode);
 997         if (handle == INVALID_HANDLE_VALUE) {
 998             TclWinConvertError(GetLastError());
 999             if (interp != (Tcl_Interp *) NULL) {
1000                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1001                         "couldn't reopen serial \"%s\": %s",
1002                         TclGetString(pathPtr), Tcl_PosixError(interp)));
1003             }
1004             return NULL;
1005         }
1006         channel = TclWinOpenSerialChannel(handle, channelName,
1007                 channelPermissions);
1008         break;
1009     case FILE_TYPE_CONSOLE:
1010         channel = TclWinOpenConsoleChannel(handle, channelName,
1011                 channelPermissions);
1012         break;
1013     case FILE_TYPE_PIPE:
1014         if (channelPermissions & TCL_READABLE) {
1015             readFile = TclWinMakeFile(handle);
1016         }
1017         if (channelPermissions & TCL_WRITABLE) {
1018             writeFile = TclWinMakeFile(handle);
1019         }
1020         channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
1021         break;
1022     case FILE_TYPE_CHAR:
1023     case FILE_TYPE_DISK:
1024     case FILE_TYPE_UNKNOWN:
1025         channel = TclWinOpenFileChannel(handle, channelName,
1026                 channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0);
1027         break;
1028
1029     default:
1030         /*
1031          * The handle is of an unknown type, probably /dev/nul equivalent or
1032          * possibly a closed handle.
1033          */
1034
1035         channel = NULL;
1036         Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1037                 "couldn't open \"%s\": bad file type",
1038                 TclGetString(pathPtr)));
1039         Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
1040                 NULL);
1041         break;
1042     }
1043
1044     return channel;
1045 }
1046 \f
1047 /*
1048  *----------------------------------------------------------------------
1049  *
1050  * Tcl_MakeFileChannel --
1051  *
1052  *      Creates a Tcl_Channel from an existing platform specific file handle.
1053  *
1054  * Results:
1055  *      The Tcl_Channel created around the preexisting file.
1056  *
1057  * Side effects:
1058  *      None.
1059  *
1060  *----------------------------------------------------------------------
1061  */
1062
1063 Tcl_Channel
1064 Tcl_MakeFileChannel(
1065     ClientData rawHandle,       /* OS level handle */
1066     int mode)                   /* ORed combination of TCL_READABLE and
1067                                  * TCL_WRITABLE to indicate file mode. */
1068 {
1069 #if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
1070     TCLEXCEPTION_REGISTRATION registration;
1071 #endif
1072     char channelName[16 + TCL_INTEGER_SPACE];
1073     Tcl_Channel channel = NULL;
1074     HANDLE handle = (HANDLE) rawHandle;
1075     HANDLE dupedHandle;
1076     TclFile readFile = NULL, writeFile = NULL;
1077     BOOL result;
1078
1079     if (mode == 0) {
1080         return NULL;
1081     }
1082
1083     switch (FileGetType(handle)) {
1084     case FILE_TYPE_SERIAL:
1085         channel = TclWinOpenSerialChannel(handle, channelName, mode);
1086         break;
1087     case FILE_TYPE_CONSOLE:
1088         channel = TclWinOpenConsoleChannel(handle, channelName, mode);
1089         break;
1090     case FILE_TYPE_PIPE:
1091         if (mode & TCL_READABLE) {
1092             readFile = TclWinMakeFile(handle);
1093         }
1094         if (mode & TCL_WRITABLE) {
1095             writeFile = TclWinMakeFile(handle);
1096         }
1097         channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
1098         break;
1099
1100     case FILE_TYPE_DISK:
1101     case FILE_TYPE_CHAR:
1102         channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
1103         break;
1104
1105     case FILE_TYPE_UNKNOWN:
1106     default:
1107         /*
1108          * The handle is of an unknown type. Test the validity of this OS
1109          * handle by duplicating it, then closing the dupe. The Win32 API
1110          * doesn't provide an IsValidHandle() function, so we have to emulate
1111          * it here. This test will not work on a console handle reliably,
1112          * which is why we can't test every handle that comes into this
1113          * function in this way.
1114          */
1115
1116         result = DuplicateHandle(GetCurrentProcess(), handle,
1117                 GetCurrentProcess(), &dupedHandle, 0, FALSE,
1118                 DUPLICATE_SAME_ACCESS);
1119
1120         if (result == 0) {
1121             /*
1122              * Unable to make a duplicate. It's definitely invalid at this
1123              * point.
1124              */
1125
1126             return NULL;
1127         }
1128
1129         /*
1130          * Use structured exception handling (Win32 SEH) to protect the close
1131          * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
1132          */
1133
1134         result = 0;
1135 #if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
1136         /*
1137          * Don't have SEH available, do things the hard way. Note that this
1138          * needs to be one block of asm, to avoid stack imbalance; also, it is
1139          * illegal for one asm block to contain a jump to another.
1140          */
1141
1142         __asm__ __volatile__ (
1143
1144             /*
1145              * Pick up parameters before messing with the stack
1146              */
1147
1148             "movl       %[dupedHandle], %%ebx"          "\n\t"
1149
1150             /*
1151              * Construct an TCLEXCEPTION_REGISTRATION to protect the call to
1152              * CloseHandle.
1153              */
1154
1155             "leal       %[registration], %%edx"         "\n\t"
1156             "movl       %%fs:0,         %%eax"          "\n\t"
1157             "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
1158             "leal       1f,             %%eax"          "\n\t"
1159             "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
1160             "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
1161             "movl       %%esp,          0xC(%%edx)"     "\n\t" /* esp */
1162             "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
1163
1164             /*
1165              * Link the TCLEXCEPTION_REGISTRATION on the chain.
1166              */
1167
1168             "movl       %%edx,          %%fs:0"         "\n\t"
1169
1170             /*
1171              * Call CloseHandle(dupedHandle).
1172              */
1173
1174             "pushl      %%ebx"                          "\n\t"
1175             "call       _CloseHandle@4"                 "\n\t"
1176
1177             /*
1178              * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION
1179              * and put a TRUE status return into it.
1180              */
1181
1182             "movl       %%fs:0,         %%edx"          "\n\t"
1183             "movl       $1,             %%eax"          "\n\t"
1184             "movl       %%eax,          0x10(%%edx)"    "\n\t"
1185             "jmp        2f"                             "\n"
1186
1187             /*
1188              * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION
1189              */
1190
1191             "1:"                                        "\t"
1192             "movl       %%fs:0,         %%edx"          "\n\t"
1193             "movl       0x8(%%edx),     %%edx"          "\n\t"
1194
1195             /*
1196              * Come here however we exited. Restore context from the
1197              * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
1198              */
1199
1200             "2:"                                        "\t"
1201             "movl       0xC(%%edx),     %%esp"          "\n\t"
1202             "movl       0x8(%%edx),     %%ebp"          "\n\t"
1203             "movl       0x0(%%edx),     %%eax"          "\n\t"
1204             "movl       %%eax,          %%fs:0"         "\n\t"
1205
1206             :
1207             /* No outputs */
1208             :
1209             [registration]  "m"     (registration),
1210             [dupedHandle]   "m"     (dupedHandle)
1211             :
1212             "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
1213             );
1214         result = registration.status;
1215 #else
1216 #ifndef HAVE_NO_SEH
1217         __try {
1218 #endif
1219             CloseHandle(dupedHandle);
1220             result = 1;
1221 #ifndef HAVE_NO_SEH
1222         } __except (EXCEPTION_EXECUTE_HANDLER) {}
1223 #endif
1224 #endif
1225         if (result == FALSE) {
1226             return NULL;
1227         }
1228
1229         /*
1230          * Fall through, the handle is valid.
1231          *
1232          * Create the undefined channel, anyways, because we know the handle
1233          * is valid to something.
1234          */
1235
1236         channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
1237     }
1238
1239     return channel;
1240 }
1241 \f
1242 /*
1243  *----------------------------------------------------------------------
1244  *
1245  * TclpGetDefaultStdChannel --
1246  *
1247  *      Constructs a channel for the specified standard OS handle.
1248  *
1249  * Results:
1250  *      Returns the specified default standard channel, or NULL.
1251  *
1252  * Side effects:
1253  *      May cause the creation of a standard channel and the underlying file.
1254  *
1255  *----------------------------------------------------------------------
1256  */
1257
1258 Tcl_Channel
1259 TclpGetDefaultStdChannel(
1260     int type)                   /* One of TCL_STDIN, TCL_STDOUT, or
1261                                  * TCL_STDERR. */
1262 {
1263     Tcl_Channel channel;
1264     HANDLE handle;
1265     int mode = -1;
1266     const char *bufMode = NULL;
1267     DWORD handleId = (DWORD) -1;
1268                                 /* Standard handle to retrieve. */
1269
1270     switch (type) {
1271     case TCL_STDIN:
1272         handleId = STD_INPUT_HANDLE;
1273         mode = TCL_READABLE;
1274         bufMode = "line";
1275         break;
1276     case TCL_STDOUT:
1277         handleId = STD_OUTPUT_HANDLE;
1278         mode = TCL_WRITABLE;
1279         bufMode = "line";
1280         break;
1281     case TCL_STDERR:
1282         handleId = STD_ERROR_HANDLE;
1283         mode = TCL_WRITABLE;
1284         bufMode = "none";
1285         break;
1286     default:
1287         Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
1288         break;
1289     }
1290
1291     handle = GetStdHandle(handleId);
1292
1293     /*
1294      * Note that we need to check for 0 because Windows may return 0 if this
1295      * is not a console mode application, even though this is not a valid
1296      * handle.
1297      */
1298
1299     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
1300         return (Tcl_Channel) NULL;
1301     }
1302
1303     channel = Tcl_MakeFileChannel(handle, mode);
1304
1305     if (channel == NULL) {
1306         return (Tcl_Channel) NULL;
1307     }
1308
1309     /*
1310      * Set up the normal channel options for stdio handles.
1311      */
1312
1313     if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
1314             Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK ||
1315             Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
1316         Tcl_Close(NULL, channel);
1317         return (Tcl_Channel) NULL;
1318     }
1319     return channel;
1320 }
1321 \f
1322 /*
1323  *----------------------------------------------------------------------
1324  *
1325  * TclWinOpenFileChannel --
1326  *
1327  *      Constructs a File channel for the specified standard OS handle. This
1328  *      is a helper function to break up the construction of channels into
1329  *      File, Console, or Serial.
1330  *
1331  * Results:
1332  *      Returns the new channel, or NULL.
1333  *
1334  * Side effects:
1335  *      May open the channel and may cause creation of a file on the file
1336  *      system.
1337  *
1338  *----------------------------------------------------------------------
1339  */
1340
1341 Tcl_Channel
1342 TclWinOpenFileChannel(
1343     HANDLE handle,              /* Win32 HANDLE to swallow */
1344     char *channelName,          /* Buffer to receive channel name */
1345     int permissions,            /* OR'ed combination of TCL_READABLE,
1346                                  * TCL_WRITABLE, or TCL_EXCEPTION, indicating
1347                                  * which operations are valid on the file. */
1348     int appendMode)             /* OR'ed combination of bits indicating what
1349                                  * additional configuration of the channel is
1350                                  * present. */
1351 {
1352     FileInfo *infoPtr;
1353     ThreadSpecificData *tsdPtr = FileInit();
1354
1355     /*
1356      * See if a channel with this handle already exists.
1357      */
1358
1359     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
1360             infoPtr = infoPtr->nextPtr) {
1361         if (infoPtr->handle == (HANDLE) handle) {
1362             return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
1363         }
1364     }
1365
1366     infoPtr = ckalloc(sizeof(FileInfo));
1367
1368     /*
1369      * TIP #218. Removed the code inserting the new structure into the global
1370      * list. This is now handled in the thread action callbacks, and only
1371      * there.
1372      */
1373
1374     infoPtr->nextPtr = NULL;
1375     infoPtr->validMask = permissions;
1376     infoPtr->watchMask = 0;
1377     infoPtr->flags = appendMode;
1378     infoPtr->handle = handle;
1379     infoPtr->dirty = 0;
1380     sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
1381
1382     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
1383             infoPtr, permissions);
1384
1385     /*
1386      * Files have default translation of AUTO and ^Z eof char, which means
1387      * that a ^Z will be accepted as EOF when reading.
1388      */
1389
1390     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1391     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1392
1393     return infoPtr->channel;
1394 }
1395 \f
1396 /*
1397  *----------------------------------------------------------------------
1398  *
1399  * TclWinFlushDirtyChannels --
1400  *
1401  *      Flush all dirty channels to disk, so that requesting the size of any
1402  *      file returns the correct value.
1403  *
1404  * Results:
1405  *      None.
1406  *
1407  * Side effects:
1408  *      Information is actually written to disk now, rather than later. Don't
1409  *      call this too often, or there will be a performance hit (i.e. only
1410  *      call when we need to ask for the size of a file).
1411  *
1412  *----------------------------------------------------------------------
1413  */
1414
1415 void
1416 TclWinFlushDirtyChannels(void)
1417 {
1418     FileInfo *infoPtr;
1419     ThreadSpecificData *tsdPtr = FileInit();
1420
1421     /*
1422      * Flush all channels which are dirty, i.e. may have data pending in the
1423      * OS.
1424      */
1425
1426     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
1427             infoPtr = infoPtr->nextPtr) {
1428         if (infoPtr->dirty) {
1429             FlushFileBuffers(infoPtr->handle);
1430             infoPtr->dirty = 0;
1431         }
1432     }
1433 }
1434 \f
1435 /*
1436  *----------------------------------------------------------------------
1437  *
1438  * FileThreadActionProc --
1439  *
1440  *      Insert or remove any thread local refs to this channel.
1441  *
1442  * Results:
1443  *      None.
1444  *
1445  * Side effects:
1446  *      Changes thread local list of valid channels.
1447  *
1448  *----------------------------------------------------------------------
1449  */
1450
1451 static void
1452 FileThreadActionProc(
1453     ClientData instanceData,
1454     int action)
1455 {
1456     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1457     FileInfo *infoPtr = instanceData;
1458
1459     if (action == TCL_CHANNEL_THREAD_INSERT) {
1460         infoPtr->nextPtr = tsdPtr->firstFilePtr;
1461         tsdPtr->firstFilePtr = infoPtr;
1462     } else {
1463         FileInfo **nextPtrPtr;
1464         int removed = 0;
1465
1466         for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
1467                 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
1468             if ((*nextPtrPtr) == infoPtr) {
1469                 (*nextPtrPtr) = infoPtr->nextPtr;
1470                 removed = 1;
1471                 break;
1472             }
1473         }
1474
1475         /*
1476          * This could happen if the channel was created in one thread and then
1477          * moved to another without updating the thread local data in each
1478          * thread.
1479          */
1480
1481         if (!removed) {
1482             Tcl_Panic("file info ptr not on thread channel list");
1483         }
1484     }
1485 }
1486 \f
1487 /*
1488  *----------------------------------------------------------------------
1489  *
1490  * FileGetType --
1491  *
1492  *      Given a file handle, return its type
1493  *
1494  * Results:
1495  *      None.
1496  *
1497  * Side effects:
1498  *      None.
1499  *
1500  *----------------------------------------------------------------------
1501  */
1502
1503 DWORD
1504 FileGetType(
1505     HANDLE handle)              /* Opened file handle */
1506 {
1507     DWORD type;
1508
1509     type = GetFileType(handle);
1510
1511     /*
1512      * If the file is a character device, we need to try to figure out whether
1513      * it is a serial port, a console, or something else. We test for the
1514      * console case first because this is more common.
1515      */
1516
1517     if ((type == FILE_TYPE_CHAR)
1518             || ((type == FILE_TYPE_UNKNOWN) && !GetLastError())) {
1519         DWORD consoleParams;
1520
1521         if (GetConsoleMode(handle, &consoleParams)) {
1522             type = FILE_TYPE_CONSOLE;
1523         } else {
1524             DCB dcb;
1525
1526             dcb.DCBlength = sizeof(DCB);
1527             if (GetCommState(handle, &dcb)) {
1528                 type = FILE_TYPE_SERIAL;
1529             }
1530         }
1531     }
1532
1533     return type;
1534 }
1535 \f
1536  /*
1537  *----------------------------------------------------------------------
1538  *
1539  * NativeIsComPort --
1540  *
1541  *      Determines if a path refers to a Windows serial port.
1542  *      A simple and efficient solution is to use a "name hint" to detect
1543  *      COM ports by their filename instead of resorting to a syscall
1544  *      to detect serialness after the fact.
1545  *      The following patterns cover common serial port names:
1546  *          COM[1-9]
1547  *          \\.\COM[0-9]+
1548  *
1549  * Results:
1550  *      1 = serial port, 0 = not.
1551  *
1552  *----------------------------------------------------------------------
1553  */
1554
1555 static int
1556 NativeIsComPort(
1557     const WCHAR *nativePath)    /* Path of file to access, native encoding. */
1558 {
1559     const WCHAR *p = (const WCHAR *) nativePath;
1560     int i, len = wcslen(p);
1561
1562     /*
1563      * 1. Look for com[1-9]:?
1564      */
1565
1566     if ( (len == 4) && (_wcsnicmp(p, L"com", 3) == 0) ) {
1567         /*
1568         * The 4th character must be a digit 1..9
1569         */
1570
1571         if ( (p[3] < L'1') || (p[3] > L'9') ) {
1572             return 0;
1573         }
1574         return 1;
1575     }
1576
1577     /*
1578      * 2. Look for \\.\com[0-9]+
1579      */
1580
1581     if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) {
1582         /*
1583         * Charaters 8..end must be a digits 0..9
1584         */
1585
1586         for ( i=7; i<len; i++ ) {
1587             if ( (p[i] < '0') || (p[i] > '9') ) {
1588                 return 0;
1589             }
1590         }
1591         return 1;
1592     }
1593     return 0;
1594 }
1595 \f
1596 /*
1597  * Local Variables:
1598  * mode: c
1599  * c-basic-offset: 4
1600  * fill-column: 78
1601  * End:
1602  */