tcl/mac/tclMacChan.c

   1 /*
   2  * tclMacChan.c
   3  *
   4  *      Channel drivers for Macintosh channels for the
   5  *      console fds.
   6  *
   7  * Copyright (c) 1996-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 "tclInt.h"
  16 #include "tclPort.h"
  17 #include "tclMacInt.h"
  18 #include <Aliases.h>
  19 #include <Errors.h>
  20 #include <Files.h>
  21 #include <Gestalt.h>
  22 #include <Processes.h>
  23 #include <Strings.h>
  24 #include <FSpCompat.h>
  25 #include <MoreFiles.h>
  26 #include <MoreFilesExtras.h>
  27
  28 #ifdef __MSL__
  29 #include <unix.mac.h>
  30 #define TCL_FILE_CREATOR (__getcreator(0))
  31 #else
  32 #define TCL_FILE_CREATOR 'MPW '
  33 #endif
  34
  35 /*
  36  * This structure describes per-instance state of a
  37  * macintosh file based channel.
  38  */
  39
  40 typedef struct FileState {
  41     short fileRef;              /* Macintosh file reference number. */
  42     Tcl_Channel fileChan;       /* Pointer to the channel for this file. */
  43     int watchMask;              /* OR'ed set of flags indicating which events
  44                                  * are being watched. */
  45     int appendMode;             /* Flag to tell if in O_APPEND mode or not. */
  46     int volumeRef;              /* Flag to tell if in O_APPEND mode or not. */
  47     int pending;                /* 1 if message is pending on queue. */
  48     struct FileState *nextPtr;  /* Pointer to next registered file. */
  49 } FileState;
  50
  51 typedef struct ThreadSpecificData {
  52     int initialized;            /* True after the thread initializes */
  53     FileState *firstFilePtr;    /* the head of the list of files managed
  54                                  * that are being watched for file events. */
  55     Tcl_Channel stdinChannel;
  56     Tcl_Channel stdoutChannel;  /* Note - these seem unused */
  57     Tcl_Channel stderrChannel;
  58 } ThreadSpecificData;
  59
  60 static Tcl_ThreadDataKey dataKey;
  61
  62 /*
  63  * The following structure is what is added to the Tcl event queue when
  64  * file events are generated.
  65  */
  66
  67 typedef struct FileEvent {
  68     Tcl_Event header;           /* Information that is standard for
  69                                  * all events. */
  70     FileState *infoPtr;         /* Pointer to file info structure.  Note
  71                                  * that we still have to verify that the
  72                                  * file exists before dereferencing this
  73                                  * pointer. */
  74 } FileEvent;
  75
  76
  77 /*
  78  * Static routines for this file:
  79  */
  80
  81 static int              CommonGetHandle _ANSI_ARGS_((ClientData instanceData,
  82                             int direction, ClientData *handlePtr));
  83 static void             CommonWatch _ANSI_ARGS_((ClientData instanceData,
  84                             int mask));
  85 static int              FileBlockMode _ANSI_ARGS_((ClientData instanceData,
  86                             int mode));
  87 static void             FileChannelExitHandler _ANSI_ARGS_((
  88                             ClientData clientData));
  89 static void             FileCheckProc _ANSI_ARGS_((ClientData clientData,
  90                             int flags));
  91 static int              FileClose _ANSI_ARGS_((ClientData instanceData,
  92                             Tcl_Interp *interp));
  93 static int              FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
  94                             int flags));
  95 static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
  96 static int              FileInput _ANSI_ARGS_((ClientData instanceData,
  97                             char *buf, int toRead, int *errorCode));
  98 static int              FileOutput _ANSI_ARGS_((ClientData instanceData,
  99                             CONST char *buf, int toWrite, int *errorCode));
 100 static int              FileSeek _ANSI_ARGS_((ClientData instanceData,
 101                             long offset, int mode, int *errorCode));
 102 static void             FileSetupProc _ANSI_ARGS_((ClientData clientData,
 103                             int flags));
 104 static Tcl_Channel      OpenFileChannel _ANSI_ARGS_((CONST char *fileName,
 105                             int mode, int permissions, int *errorCodePtr));
 106 static int              StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
 107                             int mode));
 108 static int              StdIOClose _ANSI_ARGS_((ClientData instanceData,
 109                             Tcl_Interp *interp));
 110 static int              StdIOInput _ANSI_ARGS_((ClientData instanceData,
 111                             char *buf, int toRead, int *errorCode));
 112 static int              StdIOOutput _ANSI_ARGS_((ClientData instanceData,
 113                             CONST char *buf, int toWrite, int *errorCode));
 114 static int              StdIOSeek _ANSI_ARGS_((ClientData instanceData,
 115                             long offset, int mode, int *errorCode));
 116 static int              StdReady _ANSI_ARGS_((ClientData instanceData,
 117                             int mask));
 118
 119 /*
 120  * This structure describes the channel type structure for file based IO:
 121  */
 122
 123 static Tcl_ChannelType consoleChannelType = {
 124     "file",                     /* Type name. */
 125     (Tcl_ChannelTypeVersion)StdIOBlockMode,             /* Set blocking/nonblocking mode.*/
 126     StdIOClose,                 /* Close proc. */
 127     StdIOInput,                 /* Input proc. */
 128     StdIOOutput,                /* Output proc. */
 129     StdIOSeek,                  /* Seek proc. */
 130     NULL,                       /* Set option proc. */
 131     NULL,                       /* Get option proc. */
 132     CommonWatch,                /* Initialize notifier. */
 133     CommonGetHandle             /* Get OS handles out of channel. */
 134 };
 135
 136 /*
 137  * This variable describes the channel type structure for file based IO.
 138  */
 139
 140 static Tcl_ChannelType fileChannelType = {
 141     "file",                     /* Type name. */
 142     (Tcl_ChannelTypeVersion)FileBlockMode,              /* Set blocking or
 143                                  * non-blocking mode.*/
 144     FileClose,                  /* Close proc. */
 145     FileInput,                  /* Input proc. */
 146     FileOutput,                 /* Output proc. */
 147     FileSeek,                   /* Seek proc. */
 148     NULL,                       /* Set option proc. */
 149     NULL,                       /* Get option proc. */
 150     CommonWatch,                /* Initialize notifier. */
 151     CommonGetHandle             /* Get OS handles out of channel. */
 152 };
 153
 154
 155 /*
 156  * Hack to allow Mac Tk to override the TclGetStdChannels function.
 157  */
 158
 159 typedef void (*TclGetStdChannelsProc) _ANSI_ARGS_((Tcl_Channel *stdinPtr,
 160         Tcl_Channel *stdoutPtr, Tcl_Channel *stderrPtr));
 161
 162 TclGetStdChannelsProc getStdChannelsProc = NULL;
 163
 164 \f
 165 /*
 166  *----------------------------------------------------------------------
 167  *
 168  * FileInit --
 169  *
 170  *      This function initializes the file channel event source.
 171  *
 172  * Results:
 173  *      None.
 174  *
 175  * Side effects:
 176  *      Creates a new event source.
 177  *
 178  *----------------------------------------------------------------------
 179  */
 180
 181 static ThreadSpecificData *
 182 FileInit()
 183 {
 184     ThreadSpecificData *tsdPtr =
 185         (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
 186     if (tsdPtr == NULL) {
 187         tsdPtr = TCL_TSD_INIT(&dataKey);
 188         tsdPtr->firstFilePtr = NULL;
 189         Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
 190         Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
 191     }
 192     return tsdPtr;
 193 }
 194 \f
 195 /*
 196  *----------------------------------------------------------------------
 197  *
 198  * FileChannelExitHandler --
 199  *
 200  *      This function is called to cleanup the channel driver before
 201  *      Tcl is unloaded.
 202  *
 203  * Results:
 204  *      None.
 205  *
 206  * Side effects:
 207  *      Destroys the communication window.
 208  *
 209  *----------------------------------------------------------------------
 210  */
 211
 212 static void
 213 FileChannelExitHandler(
 214     ClientData clientData)      /* Old window proc */
 215 {
 216     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
 217 }
 218 \f
 219 /*
 220  *----------------------------------------------------------------------
 221  *
 222  * FileSetupProc --
 223  *
 224  *      This procedure is invoked before Tcl_DoOneEvent blocks waiting
 225  *      for an event.
 226  *
 227  * Results:
 228  *      None.
 229  *
 230  * Side effects:
 231  *      Adjusts the block time if needed.
 232  *
 233  *----------------------------------------------------------------------
 234  */
 235
 236 void
 237 FileSetupProc(
 238     ClientData data,            /* Not used. */
 239     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
 240 {
 241     FileState *infoPtr;
 242     Tcl_Time blockTime = { 0, 0 };
 243     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 244
 245     if (!(flags & TCL_FILE_EVENTS)) {
 246         return;
 247     }
 248
 249     /*
 250      * Check to see if there is a ready file.  If so, poll.
 251      */
 252
 253     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 254             infoPtr = infoPtr->nextPtr) {
 255         if (infoPtr->watchMask) {
 256             Tcl_SetMaxBlockTime(&blockTime);
 257             break;
 258         }
 259     }
 260 }
 261 \f
 262 /*
 263  *----------------------------------------------------------------------
 264  *
 265  * FileCheckProc --
 266  *
 267  *      This procedure is called by Tcl_DoOneEvent to check the file
 268  *      event source for events.
 269  *
 270  * Results:
 271  *      None.
 272  *
 273  * Side effects:
 274  *      May queue an event.
 275  *
 276  *----------------------------------------------------------------------
 277  */
 278
 279 static void
 280 FileCheckProc(
 281     ClientData data,            /* Not used. */
 282     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
 283 {
 284     FileEvent *evPtr;
 285     FileState *infoPtr;
 286     int sentMsg = 0;
 287     Tcl_Time blockTime = { 0, 0 };
 288     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 289
 290     if (!(flags & TCL_FILE_EVENTS)) {
 291         return;
 292     }
 293
 294     /*
 295      * Queue events for any ready files that don't already have events
 296      * queued (caused by persistent states that won't generate WinSock
 297      * events).
 298      */
 299
 300     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 301             infoPtr = infoPtr->nextPtr) {
 302         if (infoPtr->watchMask && !infoPtr->pending) {
 303             infoPtr->pending = 1;
 304             evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
 305             evPtr->header.proc = FileEventProc;
 306             evPtr->infoPtr = infoPtr;
 307             Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 308         }
 309     }
 310 }
 311 \f
 312 /*----------------------------------------------------------------------
 313  *
 314  * FileEventProc --
 315  *
 316  *      This function is invoked by Tcl_ServiceEvent when a file event
 317  *      reaches the front of the event queue.  This procedure invokes
 318  *      Tcl_NotifyChannel on the file.
 319  *
 320  * Results:
 321  *      Returns 1 if the event was handled, meaning it should be removed
 322  *      from the queue.  Returns 0 if the event was not handled, meaning
 323  *      it should stay on the queue.  The only time the event isn't
 324  *      handled is if the TCL_FILE_EVENTS flag bit isn't set.
 325  *
 326  * Side effects:
 327  *      Whatever the notifier callback does.
 328  *
 329  *----------------------------------------------------------------------
 330  */
 331
 332 static int
 333 FileEventProc(
 334     Tcl_Event *evPtr,           /* Event to service. */
 335     int flags)                  /* Flags that indicate what events to
 336                                  * handle, such as TCL_FILE_EVENTS. */
 337 {
 338     FileEvent *fileEvPtr = (FileEvent *)evPtr;
 339     FileState *infoPtr;
 340     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 341
 342     if (!(flags & TCL_FILE_EVENTS)) {
 343         return 0;
 344     }
 345
 346     /*
 347      * Search through the list of watched files for the one whose handle
 348      * matches the event.  We do this rather than simply dereferencing
 349      * the handle in the event so that files can be deleted while the
 350      * event is in the queue.
 351      */
 352
 353     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 354             infoPtr = infoPtr->nextPtr) {
 355         if (fileEvPtr->infoPtr == infoPtr) {
 356             infoPtr->pending = 0;
 357             Tcl_NotifyChannel(infoPtr->fileChan, infoPtr->watchMask);
 358             break;
 359         }
 360     }
 361     return 1;
 362 }
 363 \f
 364 /*
 365  *----------------------------------------------------------------------
 366  *
 367  * StdIOBlockMode --
 368  *
 369  *      Set blocking or non-blocking mode on channel.
 370  *
 371  * Results:
 372  *      0 if successful, errno when failed.
 373  *
 374  * Side effects:
 375  *      Sets the device into blocking or non-blocking mode.
 376  *
 377  *----------------------------------------------------------------------
 378  */
 379
 380 static int
 381 StdIOBlockMode(
 382     ClientData instanceData,            /* Unused. */
 383     int mode)                           /* The mode to set. */
 384 {
 385     /*
 386      * Do not allow putting stdin, stdout or stderr into nonblocking mode.
 387      */
 388
 389     if (mode == TCL_MODE_NONBLOCKING) {
 390         return EFAULT;
 391     }
 392
 393     return 0;
 394 }
 395 \f
 396 /*
 397  *----------------------------------------------------------------------
 398  *
 399  * StdIOClose --
 400  *
 401  *      Closes the IO channel.
 402  *
 403  * Results:
 404  *      0 if successful, the value of errno if failed.
 405  *
 406  * Side effects:
 407  *      Closes the physical channel
 408  *
 409  *----------------------------------------------------------------------
 410  */
 411
 412 static int
 413 StdIOClose(
 414     ClientData instanceData,    /* Unused. */
 415     Tcl_Interp *interp)         /* Unused. */
 416 {
 417     int fd, errorCode = 0;
 418     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 419
 420     /*
 421      * Invalidate the stdio cache if necessary.  Note that we assume that
 422      * the stdio file and channel pointers will become invalid at the same
 423      * time.
 424      * Do not close standard channels while in thread-exit.
 425      */
 426
 427     fd = (int) ((FileState*)instanceData)->fileRef;
 428     if (!TclInExit()) {
 429         if (fd == 0) {
 430             tsdPtr->stdinChannel = NULL;
 431         } else if (fd == 1) {
 432             tsdPtr->stdoutChannel = NULL;
 433         } else if (fd == 2) {
 434             tsdPtr->stderrChannel = NULL;
 435         } else {
 436             panic("recieved invalid std file");
 437         }
 438
 439         if (close(fd) < 0) {
 440             errorCode = errno;
 441         }
 442     }
 443     return errorCode;
 444 }
 445 \f
 446 /*
 447  *----------------------------------------------------------------------
 448  *
 449  * CommonGetHandle --
 450  *
 451  *      Called from Tcl_GetChannelHandle to retrieve OS handles from inside
 452  *      a file based channel.
 453  *
 454  * Results:
 455  *      The appropriate handle or NULL if not present.
 456  *
 457  * Side effects:
 458  *      None.
 459  *
 460  *----------------------------------------------------------------------
 461  */
 462
 463 static int
 464 CommonGetHandle(
 465     ClientData instanceData,            /* The file state. */
 466     int direction,                      /* Which handle to retrieve? */
 467     ClientData *handlePtr)
 468 {
 469     if ((direction == TCL_READABLE) || (direction == TCL_WRITABLE)) {
 470         *handlePtr = (ClientData) ((FileState*)instanceData)->fileRef;
 471         return TCL_OK;
 472     }
 473     return TCL_ERROR;
 474 }
 475 \f
 476 /*
 477  *----------------------------------------------------------------------
 478  *
 479  * StdIOInput --
 480  *
 481  *      Reads input from the IO channel into the buffer given. Returns
 482  *      count of how many bytes were actually read, and an error indication.
 483  *
 484  * Results:
 485  *      A count of how many bytes were read is returned and an error
 486  *      indication is returned in an output argument.
 487  *
 488  * Side effects:
 489  *      Reads input from the actual channel.
 490  *
 491  *----------------------------------------------------------------------
 492  */
 493
 494 int
 495 StdIOInput(
 496     ClientData instanceData,            /* Unused. */
 497     char *buf,                          /* Where to store data read. */
 498     int bufSize,                        /* How much space is available
 499                                          * in the buffer? */
 500     int *errorCode)                     /* Where to store error code. */
 501 {
 502     int fd;
 503     int bytesRead;                      /* How many bytes were read? */
 504
 505     *errorCode = 0;
 506     errno = 0;
 507     fd = (int) ((FileState*)instanceData)->fileRef;
 508     bytesRead = read(fd, buf, (size_t) bufSize);
 509     if (bytesRead > -1) {
 510         return bytesRead;
 511     }
 512     *errorCode = errno;
 513     return -1;
 514 }
 515 \f
 516 /*
 517  *----------------------------------------------------------------------
 518  *
 519  * StdIOOutput--
 520  *
 521  *      Writes the given output on the IO channel. Returns count of how
 522  *      many characters were actually written, and an error indication.
 523  *
 524  * Results:
 525  *      A count of how many characters were written is returned and an
 526  *      error indication is returned in an output argument.
 527  *
 528  * Side effects:
 529  *      Writes output on the actual channel.
 530  *
 531  *----------------------------------------------------------------------
 532  */
 533
 534 static int
 535 StdIOOutput(
 536     ClientData instanceData,            /* Unused. */
 537     CONST char *buf,                    /* The data buffer. */
 538     int toWrite,                        /* How many bytes to write? */
 539     int *errorCode)                     /* Where to store error code. */
 540 {
 541     int written;
 542     int fd;
 543
 544     *errorCode = 0;
 545     errno = 0;
 546     fd = (int) ((FileState*)instanceData)->fileRef;
 547     written = write(fd, (void*)buf, (size_t) toWrite);
 548     if (written > -1) {
 549         return written;
 550     }
 551     *errorCode = errno;
 552     return -1;
 553 }
 554 \f
 555 /*
 556  *----------------------------------------------------------------------
 557  *
 558  * StdIOSeek --
 559  *
 560  *      Seeks on an IO channel. Returns the new position.
 561  *
 562  * Results:
 563  *      -1 if failed, the new position if successful. If failed, it
 564  *      also sets *errorCodePtr to the error code.
 565  *
 566  * Side effects:
 567  *      Moves the location at which the channel will be accessed in
 568  *      future operations.
 569  *
 570  *----------------------------------------------------------------------
 571  */
 572
 573 static int
 574 StdIOSeek(
 575     ClientData instanceData,    /* Unused. */
 576     long offset,                /* Offset to seek to. */
 577     int mode,                   /* Relative to where should we seek? */
 578     int *errorCodePtr)          /* To store error code. */
 579 {
 580     int newLoc;
 581     int fd;
 582
 583     *errorCodePtr = 0;
 584     fd = (int) ((FileState*)instanceData)->fileRef;
 585     newLoc = lseek(fd, offset, mode);
 586     if (newLoc > -1) {
 587         return newLoc;
 588     }
 589     *errorCodePtr = errno;
 590     return -1;
 591 }
 592 \f
 593 /*
 594  *----------------------------------------------------------------------
 595  *
 596  * Tcl_PidObjCmd --
 597  *
 598  *      This procedure is invoked to process the "pid" Tcl command.
 599  *      See the user documentation for details on what it does.
 600  *
 601  * Results:
 602  *      A standard Tcl result.
 603  *
 604  * Side effects:
 605  *      See the user documentation.
 606  *
 607  *----------------------------------------------------------------------
 608  */
 609
 610         /* ARGSUSED */
 611 int
 612 Tcl_PidObjCmd(dummy, interp, objc, objv)
 613     ClientData dummy;           /* Not used. */
 614     Tcl_Interp *interp;         /* Current interpreter. */
 615     int objc;                   /* Number of arguments. */
 616     Tcl_Obj *CONST *objv;       /* Argument strings. */
 617 {
 618     ProcessSerialNumber psn;
 619     char buf[20];
 620     Tcl_Channel chan;
 621     Tcl_Obj *resultPtr;
 622
 623     if (objc > 2) {
 624         Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
 625         return TCL_ERROR;
 626     }
 627     if (objc == 1) {
 628         resultPtr = Tcl_GetObjResult(interp);
 629         GetCurrentProcess(&psn);
 630         sprintf(buf, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
 631         Tcl_SetStringObj(resultPtr, buf, -1);
 632     } else {
 633         chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
 634                 NULL);
 635         if (chan == (Tcl_Channel) NULL) {
 636             return TCL_ERROR;
 637         }
 638         /*
 639          * We can't create pipelines on the Mac so
 640          * this will always return an empty list.
 641          */
 642     }
 643
 644     return TCL_OK;
 645 }
 646 \f
 647 /*
 648  *----------------------------------------------------------------------
 649  *
 650  * TclpGetDefaultStdChannel --
 651  *
 652  *      Constructs a channel for the specified standard OS handle.
 653  *
 654  * Results:
 655  *      Returns the specified default standard channel, or NULL.
 656  *
 657  * Side effects:
 658  *      May cause the creation of a standard channel and the underlying
 659  *      file.
 660  *
 661  *----------------------------------------------------------------------
 662  */
 663
 664 Tcl_Channel
 665 TclpGetDefaultStdChannel(
 666     int type)                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
 667 {
 668     Tcl_Channel channel = NULL;
 669     int fd = 0;                 /* Initializations needed to prevent */
 670     int mode = 0;               /* compiler warning (used before set). */
 671     char *bufMode = NULL;
 672     char channelName[16 + TCL_INTEGER_SPACE];
 673     int channelPermissions;
 674     FileState *fileState;
 675
 676     /*
 677      * If the channels were not created yet, create them now and
 678      * store them in the static variables.
 679      */
 680
 681     switch (type) {
 682         case TCL_STDIN:
 683             fd = 0;
 684             channelPermissions = TCL_READABLE;
 685             bufMode = "line";
 686             break;
 687         case TCL_STDOUT:
 688             fd = 1;
 689             channelPermissions = TCL_WRITABLE;
 690             bufMode = "line";
 691             break;
 692         case TCL_STDERR:
 693             fd = 2;
 694             channelPermissions = TCL_WRITABLE;
 695             bufMode = "none";
 696             break;
 697         default:
 698             panic("TclGetDefaultStdChannel: Unexpected channel type");
 699             break;
 700     }
 701
 702     sprintf(channelName, "console%d", (int) fd);
 703     fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
 704     channel = Tcl_CreateChannel(&consoleChannelType, channelName,
 705             (ClientData) fileState, channelPermissions);
 706     fileState->fileChan = channel;
 707     fileState->fileRef = fd;
 708
 709     /*
 710      * Set up the normal channel options for stdio handles.
 711      */
 712
 713     Tcl_SetChannelOption(NULL, channel, "-translation", "cr");
 714     Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
 715
 716     return channel;
 717 }
 718 \f
 719 /*
 720  *----------------------------------------------------------------------
 721  *
 722  * TclpOpenFileChannel --
 723  *
 724  *      Open a File based channel on MacOS systems.
 725  *
 726  * Results:
 727  *      The new channel or NULL. If NULL, the output argument
 728  *      errorCodePtr is set to a POSIX error.
 729  *
 730  * Side effects:
 731  *      May open the channel and may cause creation of a file on the
 732  *      file system.
 733  *
 734  *----------------------------------------------------------------------
 735  */
 736
 737 Tcl_Channel
 738 TclpOpenFileChannel(
 739     Tcl_Interp *interp,                 /* Interpreter for error reporting;
 740                                          * can be NULL. */
 741     Tcl_Obj *pathPtr,                   /* Name of file to open. */
 742     int mode,                           /* POSIX open mode. */
 743     int permissions)                    /* If the open involves creating a
 744                                          * file, with what modes to create
 745                                          * it? */
 746 {
 747     Tcl_Channel chan;
 748     CONST char *native;
 749     int errorCode;
 750
 751     native = Tcl_FSGetNativePath(pathPtr);
 752     if (native == NULL) {
 753         return NULL;
 754     }
 755     chan = OpenFileChannel(native, mode, permissions, &errorCode);
 756
 757     if (chan == NULL) {
 758         Tcl_SetErrno(errorCode);
 759         if (interp != (Tcl_Interp *) NULL) {
 760             Tcl_AppendResult(interp, "couldn't open \"",
 761                              Tcl_GetString(pathPtr), "\": ",
 762                              Tcl_PosixError(interp), (char *) NULL);
 763         }
 764         return NULL;
 765     }
 766
 767     return chan;
 768 }
 769 \f
 770 /*
 771  *----------------------------------------------------------------------
 772  *
 773  * OpenFileChannel--
 774  *
 775  *      Opens a Macintosh file and creates a Tcl channel to control it.
 776  *
 777  * Results:
 778  *      A Tcl channel.
 779  *
 780  * Side effects:
 781  *      Will open a Macintosh file.
 782  *
 783  *----------------------------------------------------------------------
 784  */
 785
 786 static Tcl_Channel
 787 OpenFileChannel(
 788     CONST char *fileName,               /* Name of file to open (native). */
 789     int mode,                           /* Mode for opening file. */
 790     int permissions,                    /* If the open involves creating a
 791                                          * file, with what modes to create
 792                                          * it? */
 793     int *errorCodePtr)                  /* Where to store error code. */
 794 {
 795     int channelPermissions;
 796     Tcl_Channel chan;
 797     char macPermision;
 798     FSSpec fileSpec;
 799     OSErr err;
 800     short fileRef;
 801     FileState *fileState;
 802     char channelName[16 + TCL_INTEGER_SPACE];
 803
 804     /*
 805      * Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
 806      * writes on a file.  This isn't common on a mac but is common with
 807      * Windows and UNIX and the feature is used by Tcl.
 808      */
 809
 810     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
 811         case O_RDWR:
 812             channelPermissions = (TCL_READABLE | TCL_WRITABLE);
 813             macPermision = fsRdWrShPerm;
 814             break;
 815         case O_WRONLY:
 816             /*
 817              * Mac's fsRdPerm permission actually defaults to fsRdWrPerm because
 818              * the Mac OS doesn't realy support write only access.  We explicitly
 819              * set the permission fsRdWrShPerm so that we can have shared write
 820              * access.
 821              */
 822             channelPermissions = TCL_WRITABLE;
 823             macPermision = fsRdWrShPerm;
 824             break;
 825         case O_RDONLY:
 826         default:
 827             channelPermissions = TCL_READABLE;
 828             macPermision = fsRdPerm;
 829             break;
 830     }
 831
 832     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
 833     if ((err != noErr) && (err != fnfErr)) {
 834         *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
 835         Tcl_SetErrno(errno);
 836         return NULL;
 837     }
 838
 839     if ((err == fnfErr) && (mode & O_CREAT)) {
 840         err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, TCL_FILE_CREATOR, 'TEXT');
 841         if (err != noErr) {
 842             *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
 843             Tcl_SetErrno(errno);
 844             return NULL;
 845         }
 846     } else if ((mode & O_CREAT) && (mode & O_EXCL)) {
 847         *errorCodePtr = errno = EEXIST;
 848         Tcl_SetErrno(errno);
 849         return NULL;
 850     }
 851
 852     err = HOpenDF(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, macPermision, &fileRef);
 853     if (err != noErr) {
 854         *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
 855         Tcl_SetErrno(errno);
 856         return NULL;
 857     }
 858
 859     if (mode & O_TRUNC) {
 860         SetEOF(fileRef, 0);
 861     }
 862
 863     sprintf(channelName, "file%d", (int) fileRef);
 864     fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
 865     chan = Tcl_CreateChannel(&fileChannelType, channelName,
 866         (ClientData) fileState, channelPermissions);
 867     if (chan == (Tcl_Channel) NULL) {
 868         *errorCodePtr = errno = EFAULT;
 869         Tcl_SetErrno(errno);
 870         FSClose(fileRef);
 871         ckfree((char *) fileState);
 872         return NULL;
 873     }
 874
 875     fileState->fileChan = chan;
 876     fileState->volumeRef = fileSpec.vRefNum;
 877     fileState->fileRef = fileRef;
 878     fileState->pending = 0;
 879     fileState->watchMask = 0;
 880     if (mode & O_APPEND) {
 881         fileState->appendMode = true;
 882     } else {
 883         fileState->appendMode = false;
 884     }
 885
 886     if ((mode & O_APPEND) || (mode & O_APPEND)) {
 887         if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
 888             *errorCodePtr = errno = EFAULT;
 889             Tcl_SetErrno(errno);
 890             Tcl_Close(NULL, chan);
 891             FSClose(fileRef);
 892             ckfree((char *) fileState);
 893             return NULL;
 894         }
 895     }
 896
 897     return chan;
 898 }
 899 \f
 900 /*
 901  *----------------------------------------------------------------------
 902  *
 903  * Tcl_MakeFileChannel --
 904  *
 905  *      Makes a Tcl_Channel from an existing OS level file handle.
 906  *
 907  * Results:
 908  *      The Tcl_Channel created around the preexisting OS level file handle.
 909  *
 910  * Side effects:
 911  *      None.
 912  *
 913  *----------------------------------------------------------------------
 914  */
 915
 916 Tcl_Channel
 917 Tcl_MakeFileChannel(handle, mode)
 918     ClientData handle;          /* OS level handle. */
 919     int mode;                   /* ORed combination of TCL_READABLE and
 920                                  * TCL_WRITABLE to indicate file mode. */
 921 {
 922     /*
 923      * Not implemented yet.
 924      */
 925
 926     return NULL;
 927 }
 928 \f
 929 /*
 930  *----------------------------------------------------------------------
 931  *
 932  * FileBlockMode --
 933  *
 934  *      Set blocking or non-blocking mode on channel.  Macintosh files
 935  *      can never really be set to blocking or non-blocking modes.
 936  *      However, we don't generate an error - we just return success.
 937  *
 938  * Results:
 939  *      0 if successful, errno when failed.
 940  *
 941  * Side effects:
 942  *      Sets the device into blocking or non-blocking mode.
 943  *
 944  *----------------------------------------------------------------------
 945  */
 946
 947 static int
 948 FileBlockMode(
 949     ClientData instanceData,            /* Unused. */
 950     int mode)                           /* The mode to set. */
 951 {
 952     return 0;
 953 }
 954 \f
 955 /*
 956  *----------------------------------------------------------------------
 957  *
 958  * FileClose --
 959  *
 960  *      Closes the IO channel.
 961  *
 962  * Results:
 963  *      0 if successful, the value of errno if failed.
 964  *
 965  * Side effects:
 966  *      Closes the physical channel
 967  *
 968  *----------------------------------------------------------------------
 969  */
 970
 971 static int
 972 FileClose(
 973     ClientData instanceData,    /* Unused. */
 974     Tcl_Interp *interp)         /* Unused. */
 975 {
 976     FileState *fileState = (FileState *) instanceData;
 977     int errorCode = 0;
 978     OSErr err;
 979
 980     err = FSClose(fileState->fileRef);
 981     FlushVol(NULL, fileState->volumeRef);
 982     if (err != noErr) {
 983         errorCode = errno = TclMacOSErrorToPosixError(err);
 984         panic("error during file close");
 985     }
 986
 987     ckfree((char *) fileState);
 988     Tcl_SetErrno(errorCode);
 989     return errorCode;
 990 }
 991 \f
 992 /*
 993  *----------------------------------------------------------------------
 994  *
 995  * FileInput --
 996  *
 997  *      Reads input from the IO channel into the buffer given. Returns
 998  *      count of how many bytes were actually read, and an error indication.
 999  *
1000  * Results:
1001  *      A count of how many bytes were read is returned and an error
1002  *      indication is returned in an output argument.
1003  *
1004  * Side effects:
1005  *      Reads input from the actual channel.
1006  *
1007  *----------------------------------------------------------------------
1008  */
1009
1010 int
1011 FileInput(
1012     ClientData instanceData,    /* Unused. */
1013     char *buffer,                               /* Where to store data read. */
1014     int bufSize,                                /* How much space is available
1015                                  * in the buffer? */
1016     int *errorCodePtr)                  /* Where to store error code. */
1017 {
1018     FileState *fileState = (FileState *) instanceData;
1019     OSErr err;
1020     long length = bufSize;
1021
1022     *errorCodePtr = 0;
1023     errno = 0;
1024     err = FSRead(fileState->fileRef, &length, buffer);
1025     if ((err == noErr) || (err == eofErr)) {
1026         return length;
1027     } else {
1028         switch (err) {
1029             case ioErr:
1030                 *errorCodePtr = errno = EIO;
1031             case afpAccessDenied:
1032                 *errorCodePtr = errno = EACCES;
1033             default:
1034                 *errorCodePtr = errno = EINVAL;
1035         }
1036         return -1;
1037     }
1038     *errorCodePtr = errno;
1039     return -1;
1040 }
1041 \f
1042 /*
1043  *----------------------------------------------------------------------
1044  *
1045  * FileOutput--
1046  *
1047  *      Writes the given output on the IO channel. Returns count of how
1048  *      many characters were actually written, and an error indication.
1049  *
1050  * Results:
1051  *      A count of how many characters were written is returned and an
1052  *      error indication is returned in an output argument.
1053  *
1054  * Side effects:
1055  *      Writes output on the actual channel.
1056  *
1057  *----------------------------------------------------------------------
1058  */
1059
1060 static int
1061 FileOutput(
1062     ClientData instanceData,            /* Unused. */
1063     CONST char *buffer,                 /* The data buffer. */
1064     int toWrite,                        /* How many bytes to write? */
1065     int *errorCodePtr)                  /* Where to store error code. */
1066 {
1067     FileState *fileState = (FileState *) instanceData;
1068     long length = toWrite;
1069     OSErr err;
1070
1071     *errorCodePtr = 0;
1072     errno = 0;
1073
1074     if (fileState->appendMode == true) {
1075         FileSeek(instanceData, 0, SEEK_END, errorCodePtr);
1076         *errorCodePtr = 0;
1077     }
1078
1079     err = FSWrite(fileState->fileRef, &length, buffer);
1080     if (err == noErr) {
1081         err = FlushFile(fileState->fileRef);
1082     } else {
1083         *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
1084         return -1;
1085     }
1086     return length;
1087 }
1088 \f
1089 /*
1090  *----------------------------------------------------------------------
1091  *
1092  * FileSeek --
1093  *
1094  *      Seeks on an IO channel. Returns the new position.
1095  *
1096  * Results:
1097  *      -1 if failed, the new position if successful. If failed, it
1098  *      also sets *errorCodePtr to the error code.
1099  *
1100  * Side effects:
1101  *      Moves the location at which the channel will be accessed in
1102  *      future operations.
1103  *
1104  *----------------------------------------------------------------------
1105  */
1106
1107 static int
1108 FileSeek(
1109     ClientData instanceData,    /* Unused. */
1110     long offset,                /* Offset to seek to. */
1111     int mode,                   /* Relative to where should we seek? */
1112     int *errorCodePtr)          /* To store error code. */
1113 {
1114     FileState *fileState = (FileState *) instanceData;
1115     IOParam pb;
1116     OSErr err;
1117
1118     *errorCodePtr = 0;
1119     pb.ioCompletion = NULL;
1120     pb.ioRefNum = fileState->fileRef;
1121     if (mode == SEEK_SET) {
1122         pb.ioPosMode = fsFromStart;
1123     } else if (mode == SEEK_END) {
1124         pb.ioPosMode = fsFromLEOF;
1125     } else if (mode == SEEK_CUR) {
1126         err = PBGetFPosSync((ParmBlkPtr) &pb);
1127         if (pb.ioResult == noErr) {
1128             if (offset == 0) {
1129                 return pb.ioPosOffset;
1130             }
1131             offset += pb.ioPosOffset;
1132         }
1133         pb.ioPosMode = fsFromStart;
1134     }
1135     pb.ioPosOffset = offset;
1136     err = PBSetFPosSync((ParmBlkPtr) &pb);
1137     if (pb.ioResult == noErr){
1138         return pb.ioPosOffset;
1139     } else if (pb.ioResult == eofErr) {
1140         long currentEOF, newEOF;
1141         long buffer, i, length;
1142
1143         err = PBGetEOFSync((ParmBlkPtr) &pb);
1144         currentEOF = (long) pb.ioMisc;
1145         if (mode == SEEK_SET) {
1146             newEOF = offset;
1147         } else if (mode == SEEK_END) {
1148             newEOF = offset + currentEOF;
1149         } else if (mode == SEEK_CUR) {
1150             err = PBGetFPosSync((ParmBlkPtr) &pb);
1151             newEOF = offset + pb.ioPosOffset;
1152         }
1153
1154         /*
1155          * Write 0's to the new EOF.
1156          */
1157         pb.ioPosOffset = 0;
1158         pb.ioPosMode = fsFromLEOF;
1159         err = PBGetFPosSync((ParmBlkPtr) &pb);
1160         length = 1;
1161         buffer = 0;
1162         for (i = 0; i < (newEOF - currentEOF); i++) {
1163             err = FSWrite(fileState->fileRef, &length, &buffer);
1164         }
1165         err = PBGetFPosSync((ParmBlkPtr) &pb);
1166         if (pb.ioResult == noErr){
1167             return pb.ioPosOffset;
1168         }
1169     }
1170     *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
1171     return -1;
1172 }
1173 \f
1174 /*
1175  *----------------------------------------------------------------------
1176  *
1177  * CommonWatch --
1178  *
1179  *      Initialize the notifier to watch handles from this channel.
1180  *
1181  * Results:
1182  *      None.
1183  *
1184  * Side effects:
1185  *      None.
1186  *
1187  *----------------------------------------------------------------------
1188  */
1189
1190 static void
1191 CommonWatch(
1192     ClientData instanceData,            /* The file state. */
1193     int mask)                           /* Events of interest; an OR-ed
1194                                          * combination of TCL_READABLE,
1195                                          * TCL_WRITABLE and TCL_EXCEPTION. */
1196 {
1197     FileState **nextPtrPtr, *ptr;
1198     FileState *infoPtr = (FileState *) instanceData;
1199     int oldMask = infoPtr->watchMask;
1200     ThreadSpecificData *tsdPtr;
1201
1202     tsdPtr = FileInit();
1203
1204     infoPtr->watchMask = mask;
1205     if (infoPtr->watchMask) {
1206         if (!oldMask) {
1207             infoPtr->nextPtr = tsdPtr->firstFilePtr;
1208             tsdPtr->firstFilePtr = infoPtr;
1209         }
1210     } else {
1211         if (oldMask) {
1212             /*
1213              * Remove the file from the list of watched files.
1214              */
1215
1216             for (nextPtrPtr = &(tsdPtr->firstFilePtr), ptr = *nextPtrPtr;
1217                  ptr != NULL;
1218                  nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
1219                 if (infoPtr == ptr) {
1220                     *nextPtrPtr = ptr->nextPtr;
1221                     break;
1222                 }
1223             }
1224         }
1225     }
1226 }