home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclOS2Chan.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  33KB  |  1,155 lines
  1. /* 
  2.  * tclOS2Chan.c
  3.  *
  4.  *    Channel drivers for OS/2 channels based on files, command
  5.  *    pipes and TCP sockets.
  6.  *
  7.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  8.  * Copyright (c) 1996-1997 Illya Vaes
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  */
  14.  
  15. #include    "tclInt.h"    /* Internal definitions for Tcl. */
  16. #include    "tclPort.h"    /* Portability features for Tcl. */
  17.  
  18. /*
  19.  * Static routines for this file:
  20.  */
  21.  
  22. static int        FilePipeBlockMode _ANSI_ARGS_((
  23.                     ClientData instanceData, Tcl_File inFile,
  24.                 Tcl_File outFile, int mode));
  25. static int        FileClose _ANSI_ARGS_((ClientData instanceData,
  26.                         Tcl_Interp *interp, Tcl_File inFile,
  27.                             Tcl_File outFile));
  28. static int        FileSeek _ANSI_ARGS_((ClientData instanceData,
  29.                 Tcl_File inFile, Tcl_File outFile, long offset,
  30.                 int mode, int *errorCode));
  31. static int        FilePipeInput _ANSI_ARGS_((ClientData instanceData,
  32.                         Tcl_File inFile, char *buf, int toRead,
  33.                         int *errorCode));
  34. static int        FilePipeOutput _ANSI_ARGS_((ClientData instanceData,
  35.                 Tcl_File outFile, char *buf, int toWrite,
  36.                 int *errorCode));
  37. static int        FileType _ANSI_ARGS_((HFILE h));
  38. static int        PipeClose _ANSI_ARGS_((ClientData instanceData,
  39.                         Tcl_Interp *interp, Tcl_File inFile,
  40.                             Tcl_File outFile));
  41.  
  42. /*
  43.  * This structure describes the channel type structure for file based IO.
  44.  */
  45.  
  46. static Tcl_ChannelType fileChannelType = {
  47.     "file",            /* Type name. */
  48.     FilePipeBlockMode,        /* Set blocking or non-blocking mode.*/
  49.     FileClose,            /* Close proc. */
  50.     FilePipeInput,        /* Input proc. */
  51.     FilePipeOutput,        /* Output proc. */
  52.     FileSeek,            /* Seek proc. */
  53.     NULL,            /* Set option proc. */
  54.     NULL,            /* Get option proc. */
  55. };
  56.  
  57. /*
  58.  * This structure describes the channel type structure for command pipe
  59.  * based IO.
  60.  */
  61.  
  62. static Tcl_ChannelType pipeChannelType = {
  63.     "pipe",            /* Type name. */
  64.     FilePipeBlockMode,        /* Set blocking or non-blocking mode.*/
  65.     PipeClose,            /* Close proc. */
  66.     FilePipeInput,        /* Input proc. */
  67.     FilePipeOutput,        /* Output proc. */
  68.     NULL,            /* Seek proc. */
  69.     NULL,            /* Set option proc. */
  70.     NULL,            /* Get option proc. */
  71. };
  72.  
  73. /*
  74.  * This is the size of the channel name for File based channels
  75.  */
  76.  
  77. #define CHANNEL_NAME_SIZE    64
  78. static char channelName[CHANNEL_NAME_SIZE+1];
  79.  
  80. /*
  81.  * Structure describing per-instance state for file based channels.
  82.  *
  83.  * IMPORTANT NOTE: If you modify this structure, make sure that the
  84.  * "asynch" field remains the first field - FilePipeBlockMode depends
  85.  * on this.
  86.  */
  87.  
  88. typedef struct FileState {
  89.     int asynch;            /* 1 if channel is in asynch mode. */
  90.     int append;            /* 1 if channel is in append mode. */
  91. } FileState;
  92.  
  93. /*
  94.  * This structure describes per-instance state of a pipe based channel.
  95.  *
  96.  * IMPORTANT NOTE: If you modify this structure, make sure that the
  97.  * "asynch" field remains the first field - FilePipeBlockMode depends
  98.  * on this.
  99.  */
  100.  
  101. typedef struct PipeState {
  102.     int asynch;            /* 1 if channel is in asynch mode. */
  103.     Tcl_File readFile;        /* Output from pipe. */
  104.     Tcl_File writeFile;        /* Input from pipe. */
  105.     Tcl_File errorFile;        /* Error output from pipe. */
  106.     int numPids;        /* Number of processes attached to pipe. */
  107.     int *pidPtr;        /* Pids of attached processes. */
  108. } PipeState;
  109.  
  110. /*
  111.  *----------------------------------------------------------------------
  112.  *
  113.  * FilePipeOutput--
  114.  *
  115.  *    Writes the given output on the IO channel. Returns count of how
  116.  *    many characters were actually written, and an error indication.
  117.  *
  118.  * Results:
  119.  *    A count of how many characters were written is returned and an
  120.  *    error indication is returned in an output argument.
  121.  *
  122.  * Side effects:
  123.  *    Writes output on the actual channel.
  124.  *
  125.  *----------------------------------------------------------------------
  126.  */
  127.  
  128.     /* ARGSUSED */
  129. static int
  130. FilePipeOutput(instanceData, outFile, buf, toWrite, errorCode)
  131.     ClientData instanceData;        /* Unused. */
  132.     Tcl_File outFile;            /* Output device for channel. */
  133.     char *buf;                /* The data buffer. */
  134.     int toWrite;            /* How many bytes to write? */
  135.     int *errorCode;            /* Where to store error code. */
  136. {
  137.     int type;
  138.     ULONG bytesWritten;
  139.     HFILE handle;
  140.     ULONG newPos;
  141.     
  142.     *errorCode = 0;
  143.     handle = (HFILE) Tcl_GetFileInfo(outFile, &type);
  144.  
  145.     /*
  146.      * If we are writing to a file that was opened with O_APPEND, we need to
  147.      * seek to the end of the file before writing the current buffer.
  148.      */
  149.  
  150.     if (type == TCL_OS2_FILE) {
  151.     FileState *statePtr = (FileState *)instanceData;
  152.     if (statePtr->append) {
  153.         DosSetFilePtr(handle, 0, FILE_END, &newPos);
  154.     }
  155.     }
  156.  
  157.     if (DosWrite(handle, (PVOID) buf, (ULONG) toWrite, &bytesWritten)
  158.         != NO_ERROR) {
  159.         if (errno == EPIPE) {
  160.             return 0;
  161.         }
  162.         *errorCode = errno;
  163.         return -1;
  164.     }
  165.     if (type == TCL_OS2_FILE) {
  166.     DosResetBuffer(handle);
  167.     }
  168.     return bytesWritten;
  169. }
  170.  
  171. /*
  172.  *----------------------------------------------------------------------
  173.  *
  174.  * FilePipeInput --
  175.  *
  176.  *    Reads input from the IO channel into the buffer given. Returns
  177.  *    count of how many bytes were actually read, and an error indication.
  178.  *
  179.  * Results:
  180.  *    A count of how many bytes were read is returned and an error
  181.  *    indication is returned in an output argument.
  182.  *
  183.  * Side effects:
  184.  *    Reads input from the actual channel.
  185.  *
  186.  *----------------------------------------------------------------------
  187.  */
  188.  
  189. static int
  190. FilePipeInput(instanceData, inFile, buf, bufSize, errorCode)
  191.     ClientData instanceData;        /* File state. */
  192.     Tcl_File inFile;            /* Input device for channel. */
  193.     char *buf;                /* Where to store data read. */
  194.     int bufSize;            /* How much space is available
  195.                                          * in the buffer? */
  196.     int *errorCode;            /* Where to store error code. */
  197. {
  198.     FileState *statePtr;
  199.     HFILE handle;
  200.     ULONG bytesRead;
  201.     int type;
  202.     APIRET rc;
  203.  
  204.     *errorCode = 0;
  205.     statePtr = (FileState *) instanceData;
  206.     handle = (HFILE) Tcl_GetFileInfo(inFile, &type);
  207. #ifdef DEBUG
  208.     printf("FilePipeInput type %s inFile %x\n", (type == TCL_OS2_PIPE) ?
  209.        "TCL_OS2_PIPE" : "<> TCL_OS2_PIPE", handle);
  210. #endif
  211.  
  212.     /*
  213.      * Note that we will block on reads from a console buffer until a
  214.      * full line has been entered.  The only way I know of to get
  215.      * around this is to write a console driver.  We should probably
  216.      * do this at some point, but for now, we just block.
  217.      */
  218.  
  219.     rc = DosRead(handle, (PVOID) buf, (ULONG) bufSize, &bytesRead);
  220. #ifdef DEBUG
  221.     { int i;
  222.     printf("DosRead handle [%x] returns [%d], bytes read [%d]\n[", handle, rc,
  223.            bytesRead);
  224.     /*
  225.     for (i=0; i < bytesRead; i++) putchar(*(buf+i));
  226.     printf("]\n");
  227.     */
  228.     fflush(stdout);
  229.     }
  230. #endif
  231.     if (rc != NO_ERROR) {
  232.     TclOS2ConvertError(rc);
  233.     goto error;
  234.     }
  235.     
  236.     return bytesRead;
  237.  
  238.     error:
  239.     if (errno == EPIPE) {
  240.     return 0;
  241.     }
  242.     *errorCode = errno;
  243.     return -1;
  244. }
  245.  
  246. /*
  247.  *----------------------------------------------------------------------
  248.  *
  249.  * FilePipeBlockMode --
  250.  *
  251.  *    Set blocking or non-blocking mode on channel.
  252.  *
  253.  * Results:
  254.  *    0 if successful, errno when failed.
  255.  *
  256.  * Side effects:
  257.  *    Sets the device into blocking or non-blocking mode.
  258.  *
  259.  *----------------------------------------------------------------------
  260.  */
  261.  
  262. static int
  263. FilePipeBlockMode(instanceData, inFile, outFile, mode)
  264.     ClientData instanceData;        /* Instance state for channel. */
  265.     Tcl_File inFile, outFile;        /* Input, output for channel. */
  266.     int mode;                /* The mode to set. */
  267. {
  268.     /*
  269.      * Files on OS/2 can not be switched between blocking and nonblocking,
  270.      * hence we have to emulate the behavior. This is done in the input
  271.      * function by checking against a bit in the state. We set or unset the
  272.      * bit here to cause the input function to emulate the correct behavior.
  273.      *
  274.      * IMPORTANT NOTE:
  275.      *
  276.      * The use of the "asynch" field below relies on the assumption that it
  277.      * will be located at the same offset (0) in the instanceData associated
  278.      * with all types of channels using this routine.
  279.      */
  280.  
  281.     if (instanceData != (ClientData) NULL) {
  282.         FileState *sPtr = (FileState *) instanceData;
  283.     sPtr->asynch = (mode == TCL_MODE_BLOCKING) ? 0 : 1;
  284.     }
  285.  
  286.     return 0;
  287. }
  288.  
  289. /*
  290.  *----------------------------------------------------------------------
  291.  *
  292.  * FileClose --
  293.  *
  294.  *    Closes the IO channel.
  295.  *
  296.  * Results:
  297.  *    0 if successful, the value of errno if failed.
  298.  *
  299.  * Side effects:
  300.  *    Closes the physical channel
  301.  *
  302.  *----------------------------------------------------------------------
  303.  */
  304.  
  305.     /* ARGSUSED */
  306. static int
  307. FileClose(instanceData, interp, inFile, outFile)
  308.     ClientData instanceData;    /* Pointer to FileState structure. */
  309.     Tcl_Interp *interp;        /* Not used. */
  310.     Tcl_File inFile;        /* Input side. */
  311.     Tcl_File outFile;        /* Output side. */
  312. {
  313.     HFILE handle;
  314.     APIRET rc;
  315.     int type, errorCode = 0;
  316.  
  317.     if (instanceData != (ClientData) NULL) {
  318.         ckfree((char *) instanceData);
  319.     }
  320.  
  321.     if (inFile != NULL) {
  322.         handle = (HFILE) Tcl_GetFileInfo(inFile, &type);
  323.  
  324.     /*
  325.      * Check for read/write file so we only close it once.
  326.      */
  327.  
  328.     if (inFile == outFile) {
  329.         outFile = NULL;
  330.     }
  331.  
  332.     rc = DosClose(handle);
  333. #ifdef DEBUG
  334.         printf("DosClose [%x] returns [%x]\n", handle, rc);
  335. #endif
  336.     if (rc != NO_ERROR) {
  337.         TclOS2ConvertError(rc);
  338.         errorCode = errno;
  339.     }
  340.  
  341.         Tcl_FreeFile(inFile);
  342.     }
  343.     if (outFile != NULL) {
  344.         handle = (HFILE) Tcl_GetFileInfo(outFile, &type);
  345.  
  346.     rc = DosClose(handle);
  347. #ifdef DEBUG
  348.         printf("DosClose [%x] returns [%x]\n", handle, rc);
  349. #endif
  350.     if (rc != NO_ERROR && errorCode == 0 ) {
  351.         TclOS2ConvertError(rc);
  352.             errorCode = errno;
  353.     }
  354.     Tcl_FreeFile(outFile);
  355.     }
  356.     return errorCode;
  357. }
  358.  
  359. /*
  360.  *----------------------------------------------------------------------
  361.  *
  362.  * FileSeek --
  363.  *
  364.  *    Seeks on a file-based channel. Returns the new position.
  365.  *
  366.  * Results:
  367.  *    -1 if failed, the new position if successful. If failed, it
  368.  *    also sets *errorCodePtr to the error code.
  369.  *
  370.  * Side effects:
  371.  *    Moves the location at which the channel will be accessed in
  372.  *    future operations.
  373.  *
  374.  *----------------------------------------------------------------------
  375.  */
  376.  
  377.     /* ARGSUSED */
  378. static int
  379. FileSeek(instanceData, inFile, outFile, offset, mode, errorCodePtr)
  380.     ClientData instanceData;            /* Unused. */
  381.     Tcl_File inFile, outFile;            /* Input and output
  382.                                                  * devices for channel. */
  383.     long offset;                /* Offset to seek to. */
  384.     int mode;                    /* Relative to where
  385.                                                  * should we seek? */
  386.     int *errorCodePtr;                /* To store error code. */
  387. {
  388.     ULONG moveMethod;
  389.     ULONG newPos;
  390.     HFILE handle;
  391.     int type;
  392.  
  393.     *errorCodePtr = 0;
  394.     if (inFile != (Tcl_File) NULL) {
  395.         handle = (HFILE) Tcl_GetFileInfo(inFile, &type);
  396.     } else if (outFile != (Tcl_File) NULL) {
  397.         handle = (HFILE) Tcl_GetFileInfo(outFile, &type);
  398.     } else {
  399.         *errorCodePtr = EFAULT;
  400.         return -1;
  401.     }
  402.     
  403.     if (mode == SEEK_SET) {
  404.         moveMethod = FILE_BEGIN;
  405.     } else if (mode == SEEK_CUR) {
  406.         moveMethod = FILE_CURRENT;
  407.     } else {
  408.         moveMethod = FILE_END;
  409.     }
  410.  
  411.     if (DosSetFilePtr(handle, offset, moveMethod, &newPos) != NO_ERROR) {
  412. #ifdef DEBUG
  413.         printf("DosSetFilePtr handle [%x] returned ERROR\n", handle);
  414. #endif
  415.         return -1;
  416.     }
  417. #ifdef DEBUG
  418.     printf("DosSetFilePtr handle [%x]: [%d]\n", handle, newPos);
  419. #endif
  420.     return newPos;
  421. }
  422.  
  423. /*
  424.  *----------------------------------------------------------------------
  425.  *
  426.  * PipeClose --
  427.  *
  428.  *    Closes a pipe based IO channel.
  429.  *
  430.  * Results:
  431.  *    0 on success, errno otherwise.
  432.  *
  433.  * Side effects:
  434.  *    Closes the physical channel.
  435.  *
  436.  *----------------------------------------------------------------------
  437.  */
  438.  
  439.     /* ARGSUSED */
  440. static int
  441. PipeClose(instanceData, interp, inFile, outFile)
  442.     ClientData instanceData;    /* Pointer to PipeState structure. */
  443.     Tcl_Interp *interp;        /* For error reporting. */
  444.     Tcl_File inFile, outFile;    /* Unused. */
  445. {
  446.     PipeState *pipePtr = (PipeState *) instanceData;
  447.     HFILE handle;
  448.     APIRET rc;
  449.     Tcl_Channel errChan;
  450.     int errorCode, result;
  451.  
  452.     errorCode = 0;
  453.     if (pipePtr->readFile != NULL) {
  454.         handle = (HFILE) Tcl_GetFileInfo(pipePtr->readFile, NULL);
  455.  
  456.     rc = DosClose(handle);
  457. #ifdef DEBUG
  458.         printf("DosClose [%x] returns [%x]\n", handle, rc);
  459. #endif
  460.     if (rc != NO_ERROR) {
  461.         TclOS2ConvertError(rc);
  462.         errorCode = errno;
  463.     }
  464.         Tcl_FreeFile(pipePtr->readFile);
  465.     }
  466.     if (pipePtr->writeFile != NULL) {
  467.         handle = (HFILE) Tcl_GetFileInfo(pipePtr->writeFile, NULL);
  468.  
  469.     rc = DosClose(handle);
  470. #ifdef DEBUG
  471.         printf("DosClose [%x] returns [%x]\n", handle, rc);
  472. #endif
  473.     if (rc != NO_ERROR && errorCode == 0 ) {
  474.             TclOS2ConvertError(rc);
  475.             errorCode = errno;
  476.     }
  477.     Tcl_FreeFile(pipePtr->writeFile);
  478.     }
  479.     
  480.     /*
  481.      * Wrap the error file into a channel and give it to the cleanup
  482.      * routine.
  483.      */
  484.  
  485.     if (pipePtr->errorFile != NULL) {
  486.     errChan = Tcl_CreateChannel(&fileChannelType, "pipeError",
  487.                 pipePtr->errorFile, NULL, NULL);
  488.         if (Tcl_SetChannelOption(interp, errChan, "-translation", "auto") ==
  489.                 TCL_ERROR) {
  490.             Tcl_Close((Tcl_Interp *) NULL, errChan);
  491.             errChan = (Tcl_Channel) NULL;
  492.         }
  493.         if ((errChan != (Tcl_Channel) NULL) &&
  494.                 (Tcl_SetChannelOption(NULL, errChan, "-eofchar", "\032") ==
  495.                         TCL_ERROR)) {
  496.             Tcl_Close((Tcl_Interp *) NULL, errChan);
  497.             errChan = (Tcl_Channel) NULL;
  498.         }
  499.     } else {
  500.         errChan = NULL;
  501.     }
  502.     result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
  503.             errChan);
  504.     if (pipePtr->numPids > 0) {
  505.         ckfree((char *) pipePtr->pidPtr);
  506.     }
  507.     ckfree((char *) pipePtr);
  508.     if (errorCode == 0) {
  509.         return result;
  510.     }
  511.     return errorCode;
  512.     }
  513.     
  514.  
  515. /*
  516.  *----------------------------------------------------------------------
  517.  *
  518.  * Tcl_OpenFileChannel --
  519.  *
  520.  *    Open an File based channel.
  521.  *
  522.  * Results:
  523.  *    The new channel or NULL. If NULL, the output argument
  524.  *    errorCodePtr is set to a POSIX error.
  525.  *
  526.  * Side effects:
  527.  *    May open the channel and may cause creation of a file on the
  528.  *    file system.
  529.  *
  530.  *----------------------------------------------------------------------
  531.  */
  532.  
  533. Tcl_Channel
  534. Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
  535.     Tcl_Interp *interp;            /* Interpreter for error reporting;
  536.                                          * can be NULL. */
  537.     char *fileName;            /* Name of file to open. */
  538.     char *modeString;            /* A list of POSIX open modes or
  539.                                          * a string such as "rw". */
  540.     int permissions;            /* If the open involves creating a
  541.                                          * file, with what modes to create
  542.                                          * it? */
  543. {
  544.     Tcl_File file;
  545.     Tcl_Channel chan;
  546.     FileState *sPtr;
  547.     int seekFlag, mode;
  548.     HFILE handle;
  549.     ULONG accessMode = 0, createMode, flags, exist;
  550.     BOOL readonly = FALSE;
  551.     APIRET rc;
  552.     char *nativeName;
  553.     Tcl_DString buffer;
  554.  
  555.     mode = TclGetOpenMode(interp, modeString, &seekFlag);
  556.     if (mode == -1) {
  557.         return NULL;
  558.     }
  559.     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
  560.     case O_RDONLY:
  561.         accessMode = OPEN_ACCESS_READONLY;
  562.         readonly = TRUE; /* Needed because O_A_R is 0 */
  563.         break;
  564.     case O_WRONLY:
  565.         accessMode = OPEN_ACCESS_WRITEONLY;
  566.         break;
  567.     case O_RDWR:
  568.         accessMode = OPEN_ACCESS_READWRITE;
  569.         break;
  570.     default:
  571.         panic("Tcl_OpenFileChannel: invalid mode value");
  572.         break;
  573.     }
  574.  
  575.     /*
  576.      * Map the creation flags to the OS/2 open mode.
  577.      */
  578.  
  579.     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
  580.     case (O_CREAT | O_EXCL):
  581.     case (O_CREAT | O_EXCL | O_TRUNC):
  582.         createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_FAIL_IF_EXISTS;
  583.         break;
  584.     case (O_CREAT | O_TRUNC):
  585.         createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_REPLACE_IF_EXISTS;
  586.         break;
  587.     case O_CREAT:
  588.         createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_OPEN_IF_EXISTS;
  589.         break;
  590.     case O_TRUNC:
  591.     case (O_TRUNC | O_EXCL):
  592.         createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_REPLACE_IF_EXISTS;
  593.         break;
  594.     default:
  595.         createMode = OPEN_ACTION_FAIL_IF_NEW | OPEN_ACTION_OPEN_IF_EXISTS;
  596.         break;
  597.     }
  598.  
  599.     /*
  600.      * If the file is being created, get the file attributes from the
  601.      * permissions argument, else use the existing file attributes.
  602.      */
  603.  
  604.     if (mode & O_CREAT) {
  605.         if (permissions & S_IWRITE) {
  606.             flags = FILE_NORMAL;
  607.         } else {
  608.             flags = FILE_READONLY;
  609.         }
  610.     } else {
  611.         FILESTATUS3 infoBuf;
  612.  
  613.     if (DosQueryPathInfo(fileName, FIL_STANDARD, &infoBuf, sizeof(infoBuf))
  614.             == NO_ERROR) {
  615.         flags = infoBuf.attrFile;
  616.         } else {
  617.         flags = 0;
  618.     }
  619.     }
  620.  
  621.     /*
  622.      * Set up the attributes so this file is not inherited by child processes.
  623.      */
  624.  
  625.     accessMode |= OPEN_FLAGS_NOINHERIT;
  626.  
  627.     /*
  628.      * Set up the file sharing mode.  We want to allow simultaneous access.
  629.      */
  630.  
  631.     accessMode |= OPEN_SHARE_DENYNONE;
  632.  
  633.     /*
  634.      * Now we get to create the file.
  635.      */
  636.  
  637.     nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
  638.     if (nativeName == NULL) {
  639.     return NULL;
  640.     }
  641.     rc = DosOpen(nativeName, &handle, &exist, 0, flags, createMode,
  642.                   accessMode, (PEAOP2)NULL);
  643. #ifdef DEBUG
  644.     printf("DosOpen [%s]: handle [%x], rc [%d] (create [%x] access [%x])\n",
  645.            nativeName, handle, rc, createMode, accessMode);
  646. #endif
  647.     Tcl_DStringFree(&buffer);
  648.  
  649.     if (rc != NO_ERROR) {
  650.     ULONG err = ERROR_SIGNAL_REFUSED;
  651.  
  652.     switch (rc) {
  653.         case ERROR_FILE_NOT_FOUND:
  654.         case ERROR_PATH_NOT_FOUND:
  655.             err = ERROR_FILE_NOT_FOUND;
  656.             break;
  657.         case ERROR_ACCESS_DENIED:
  658.         case ERROR_INVALID_ACCESS:
  659.         case ERROR_SHARING_VIOLATION:
  660.         case ERROR_CANNOT_MAKE:
  661.             err = (mode & O_CREAT) ? ERROR_FILE_EXISTS
  662.                                    : ERROR_FILE_NOT_FOUND;
  663.             break;
  664.     }
  665.         TclOS2ConvertError(err);
  666.     if (interp != (Tcl_Interp *) NULL) {
  667.             Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
  668.                     Tcl_PosixError(interp), (char *) NULL);
  669.         }
  670.         return NULL;
  671.     }
  672.  
  673.     file = Tcl_GetFile((ClientData) handle, TCL_OS2_FILE);
  674.  
  675.     sPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
  676.     sPtr->asynch = 0;
  677.     sPtr->append = (mode & O_APPEND) ? 1 : 0;
  678.     sprintf(channelName, "file%d", (int) Tcl_GetFileInfo(file, NULL));
  679.  
  680.     /* WATCH IT!!!!
  681.      * The symbol OPEN_ACCESS_READONLY is 0, so the & operator ALWAYS gives
  682.      * 0, so the channel NEVER gets the file as argument => use Boolean
  683.      * variable "readonly" that is set when O_A_R is applicable.
  684.      */
  685.     chan = Tcl_CreateChannel(&fileChannelType, channelName,
  686.             (readonly) ? file : NULL,
  687.             (accessMode & OPEN_ACCESS_WRITEONLY) ? file : NULL,
  688.             (ClientData) sPtr);
  689.     if (chan == (Tcl_Channel) NULL) {
  690.         if (interp != (Tcl_Interp *) NULL) {
  691.             Tcl_AppendResult(interp, "could not open channel \"",
  692.                     channelName, "\": ", Tcl_PosixError(interp),
  693.                     (char *) NULL);
  694.         }
  695.         rc = DosClose(handle);
  696. #ifdef DEBUG
  697.         printf("DosClose [%x]\n", handle);
  698. #endif
  699.         Tcl_FreeFile(file);
  700.         ckfree((char *) sPtr);
  701.         return NULL;
  702.     }
  703.  
  704.     if (seekFlag) {
  705.         if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
  706.             if (interp != (Tcl_Interp *) NULL) {
  707.                 Tcl_AppendResult(interp, "could not seek to end of file on \"",
  708.                         channelName, "\": ", Tcl_PosixError(interp),
  709.                         (char *) NULL);
  710.             }
  711.             Tcl_Close((Tcl_Interp *) NULL, chan);
  712.             return NULL;
  713.         }
  714.     }
  715.  
  716.     /*
  717.      * Files have default translation of AUTO and ^Z eof char, which
  718.      * means that a ^Z will be appended to them at close.
  719.      */
  720.     
  721.     if (Tcl_SetChannelOption(interp, chan, "-translation", "auto") ==
  722.             TCL_ERROR) {
  723.         Tcl_Close((Tcl_Interp *) NULL, chan);
  724.         return (Tcl_Channel) NULL;
  725.     }
  726.     if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "\032 {}") ==
  727.             TCL_ERROR) {
  728.         Tcl_Close((Tcl_Interp *) NULL, chan);
  729.         return (Tcl_Channel) NULL;
  730.     }
  731.     return chan;
  732. }
  733.  
  734. /*
  735.  *----------------------------------------------------------------------
  736.  *
  737.  * FileType --
  738.  *
  739.  *    Converts an OS/2 handle type to a Tcl file type
  740.  *
  741.  * Results:
  742.  *    The Tcl file type corresponding to the given OS/2 handle type
  743.  *    or -1 on error.
  744.  *
  745.  * Side effects:
  746.  *    None.
  747.  *
  748.  *----------------------------------------------------------------------
  749.  */
  750.  
  751. static int
  752. FileType(h)
  753.     HFILE h;        /* Convert the type of this handle to
  754.                          * a Tcl file type. */
  755. {
  756.     ULONG type, attr;
  757.     APIRET rc;
  758.  
  759.     rc = DosQueryHType(h, &type, &attr);
  760. #ifdef DEBUG
  761.     printf("FileType: DosQueryHType handle %x, type %d, attr %x\n",
  762.            h, type, attr);
  763. #endif
  764.     if (rc != NO_ERROR) return -1;
  765.     switch (type & (HANDTYPE_FILE | HANDTYPE_DEVICE | HANDTYPE_PIPE)) {
  766.     case HANDTYPE_DEVICE:
  767.         return TCL_OS2_CONSOLE;
  768.     case HANDTYPE_FILE:
  769.         return TCL_OS2_FILE;
  770.     case HANDTYPE_PIPE:
  771.         return TCL_OS2_PIPE;
  772.     default:
  773.         return -1;
  774.     }
  775. }
  776.  
  777. /*
  778.  *----------------------------------------------------------------------
  779.  *
  780.  * Tcl_MakeFileChannel --
  781.  *
  782.  *    Creates a Tcl_Channel from an existing platform specific file
  783.  *    handle.
  784.  *
  785.  * Results:
  786.  *    The Tcl_Channel created around the preexisting file.
  787.  *
  788.  * Side effects:
  789.  *    None.
  790.  *
  791.  *----------------------------------------------------------------------
  792.  */
  793.  
  794. Tcl_Channel
  795. Tcl_MakeFileChannel(inFile, outFile, mode)
  796.     ClientData inFile;        /* OS level handle used for input. */
  797.     ClientData outFile;        /* OS level handle used for output. */
  798.     int mode;            /* ORed combination of TCL_READABLE and
  799.                                  * TCL_WRITABLE to indicate whether inFile
  800.                                  * and/or outFile are valid. */
  801. {
  802.     Tcl_File inFd, outFd;
  803.     char channelName[20];
  804.     FileState *sPtr;
  805.     Tcl_Channel chan;
  806.  
  807. #ifdef DEBUG
  808.     printf("Making file channel inFile [%x] outFile [%x]\n", inFile, outFile);
  809. #endif
  810.     if (mode & TCL_READABLE) {
  811.         sprintf(channelName, "file%d", (int) inFile);
  812.         inFd = Tcl_GetFile(inFile, FileType((HFILE) inFile));
  813.     } else {
  814.         inFd = (Tcl_File) NULL;
  815.     }
  816.     
  817.     if (mode & TCL_WRITABLE) {
  818.         sprintf(channelName, "file%d", (int) outFile);
  819.         outFd = Tcl_GetFile(outFile, FileType((HFILE) outFile));
  820.     } else {
  821.         outFd = (Tcl_File) NULL;
  822.     }
  823.  
  824.     sPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
  825.     sPtr->asynch = 0;
  826.     sPtr->append = 0;
  827.  
  828.     chan = Tcl_CreateChannel(&fileChannelType, channelName, inFd, outFd,
  829.             (ClientData) sPtr);
  830.     if (chan == (Tcl_Channel) NULL) {
  831.         ckfree((char *) sPtr);
  832.         return NULL;
  833.     }
  834.  
  835.     /*
  836.      * OS/2 files have AUTO translation mode and ^Z eof char, which
  837.      * means that ^Z will be appended on close and accepted as EOF.
  838.      */
  839.     
  840.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-translation",
  841.             "auto") == TCL_ERROR) {
  842.         Tcl_Close((Tcl_Interp *) NULL, chan);
  843.         return (Tcl_Channel) NULL;
  844.     }
  845.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-eofchar",
  846.             "\032 {}") == TCL_ERROR) {
  847.         Tcl_Close((Tcl_Interp *) NULL, chan);
  848.         return (Tcl_Channel) NULL;
  849.     }
  850.     return chan;
  851. }
  852.  
  853. /*
  854.  *----------------------------------------------------------------------
  855.  *
  856.  * TclCreateCommandChannel --
  857.  *
  858.  *    This function is called by Tcl_OpenCommandChannel to perform
  859.  *    the platform specific channel initialization for a command
  860.  *    channel.
  861.  *
  862.  * Results:
  863.  *    Returns a new channel or NULL on failure.
  864.  *
  865.  * Side effects:
  866.  *    Allocates a new channel.
  867.  *
  868.  *----------------------------------------------------------------------
  869.  */
  870.  
  871. Tcl_Channel
  872. TclCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
  873.     Tcl_File readFile;        /* If non-null, gives the file for reading. */
  874.     Tcl_File writeFile;        /* If non-null, gives the file for writing. */
  875.     Tcl_File errorFile;        /* If non-null, gives the file where errors
  876.                  * can be read. */
  877.     int numPids;        /* The number of pids in the pid array. */
  878.     int *pidPtr;        /* An array of process identifiers. */
  879. {
  880.     Tcl_Channel channel;
  881.     char channelName[20];
  882.     int channelId;
  883.     PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
  884.  
  885.     statePtr->asynch = 0;
  886.     statePtr->readFile = readFile;
  887.     statePtr->writeFile = writeFile;
  888.     statePtr->errorFile = errorFile;
  889.     statePtr->numPids = numPids;
  890.     statePtr->pidPtr = pidPtr;
  891.  
  892.     /*
  893.      * Use one of the fds associated with the channel as the
  894.      * channel id.
  895.      */
  896.  
  897.     if (readFile) {
  898.     channelId = (int) Tcl_GetFileInfo(readFile, NULL);
  899.     } else if (writeFile) {
  900.     channelId = (int) Tcl_GetFileInfo(writeFile, NULL);
  901.     } else if (errorFile) {
  902.     channelId = (int) Tcl_GetFileInfo(errorFile, NULL);
  903.     } else {
  904.     channelId = 0;
  905.     }
  906.  
  907.     /*
  908.      * For backward compatibility with previous versions of Tcl, we
  909.      * use "file%d" as the base name for pipes even though it would
  910.      * be more natural to use "pipe%d".
  911.      */
  912.  
  913.     sprintf(channelName, "file%d", channelId);
  914.     channel = Tcl_CreateChannel(&pipeChannelType, channelName, readFile,
  915.         writeFile, (ClientData) statePtr);
  916.  
  917.     if (channel == NULL) {
  918.     ckfree((char *)statePtr);
  919.         return NULL;
  920.     }
  921.  
  922.     /*
  923.      * Pipes have AUTO translation mode on OS/2 and ^Z eof char, which
  924.      * means that a ^Z will be appended to them at close. This is needed
  925.      * for OS/2 programs that expect a ^Z at EOF.
  926.      */
  927.  
  928.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
  929.             "auto") == TCL_ERROR) {
  930.         Tcl_Close((Tcl_Interp *) NULL, channel);
  931.         return (Tcl_Channel) NULL;
  932.     }
  933.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
  934.             "\032 {}") == TCL_ERROR) {
  935.         Tcl_Close((Tcl_Interp *) NULL, channel);
  936.         return (Tcl_Channel) NULL;
  937.     }
  938.     return channel;
  939. }
  940.  
  941. /*
  942.  *----------------------------------------------------------------------
  943.  *
  944.  * Tcl_PidCmd --
  945.  *
  946.  *    This procedure is invoked to process the "pid" Tcl command.
  947.  *    See the user documentation for details on what it does.
  948.  *
  949.  * Results:
  950.  *    A standard Tcl result.
  951.  *
  952.  * Side effects:
  953.  *    See the user documentation.
  954.  *
  955.  *----------------------------------------------------------------------
  956.  */
  957.  
  958.     /* ARGSUSED */
  959. int
  960. Tcl_PidCmd(dummy, interp, argc, argv)
  961.     ClientData dummy;            /* Not used. */
  962.     Tcl_Interp *interp;            /* Current interpreter. */
  963.     int argc;                /* Number of arguments. */
  964.     char **argv;            /* Argument strings. */
  965. {
  966.     Tcl_Channel chan;            /* The channel to get pids for. */
  967.     Tcl_ChannelType *typePtr;
  968.     PipeState *pipePtr;            /* The pipe state. */
  969.     int i;                /* Loops over PIDs attached to the
  970.                                          * pipe. */
  971.     char string[50];            /* Temp buffer for string rep. of
  972.                                          * PIDs attached to the pipe. */
  973.  
  974.     if (argc > 2) {
  975.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  976.         argv[0], " ?channelId?\"", (char *) NULL);
  977.     return TCL_ERROR;
  978.     }
  979.     if (argc == 1) {
  980.     sprintf(interp->result, "%ld", (long) getpid());
  981.     } else {
  982.         chan = Tcl_GetChannel(interp, argv[1], NULL);
  983.         if (chan == (Tcl_Channel) NULL) {
  984.         return TCL_ERROR;
  985.     }
  986.     typePtr = Tcl_GetChannelType(chan);
  987.     if (typePtr != &pipeChannelType) {
  988.             return TCL_OK;
  989.         }
  990.         pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
  991.         for (i = 0; i < pipePtr->numPids; i++) {
  992.         sprintf(string, "%d", pipePtr->pidPtr[i]);
  993.         Tcl_AppendElement(interp, string);
  994.     }
  995.     }
  996.     return TCL_OK;
  997. }
  998.  
  999. /*
  1000.  *----------------------------------------------------------------------
  1001.  *
  1002.  * TclGetDefaultStdChannel --
  1003.  *
  1004.  *    Constructs a channel for the specified standard OS handle.
  1005.  *
  1006.  * Results:
  1007.  *    Returns the specified default standard channel, or NULL.
  1008.  *
  1009.  * Side effects:
  1010.  *    May cause the creation of a standard channel and the underlying
  1011.  *    file.
  1012.  *
  1013.  *----------------------------------------------------------------------
  1014.  */
  1015.  
  1016. Tcl_Channel
  1017. TclGetDefaultStdChannel(type)
  1018.     int type;            /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  1019. {
  1020.     Tcl_Channel channel;
  1021.     HFILE handle = 0;
  1022.     int mode = TCL_READABLE;
  1023.     char *bufMode = "line";
  1024.  
  1025.     switch (type) {
  1026.     case TCL_STDIN:
  1027.         handle = (HFILE)0;
  1028.         mode = TCL_READABLE;
  1029.         bufMode = "line";
  1030.         break;
  1031.     case TCL_STDOUT:
  1032.         handle = (HFILE)1;
  1033.         mode = TCL_WRITABLE;
  1034.         bufMode = "line";
  1035.         break;
  1036.     case TCL_STDERR:
  1037.         handle = (HFILE)2;
  1038.         mode = TCL_WRITABLE;
  1039.         bufMode = "none";
  1040.         break;
  1041.     default:
  1042.         panic("TclGetDefaultStdChannel: Unexpected channel type");
  1043.         break;
  1044.     }
  1045.  
  1046.     channel = Tcl_MakeFileChannel((ClientData)handle, (ClientData)handle, mode);
  1047.  
  1048.     /*
  1049.      * Set up the normal channel options for stdio handles.
  1050.      */
  1051.  
  1052.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
  1053.             "auto") == TCL_ERROR) {
  1054.         Tcl_Close((Tcl_Interp *) NULL, channel);
  1055.         return (Tcl_Channel) NULL;
  1056.     }
  1057.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
  1058.             "\032 {}") == TCL_ERROR) {
  1059.         Tcl_Close((Tcl_Interp *) NULL, channel);
  1060.         return (Tcl_Channel) NULL;
  1061.     }
  1062.     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-buffering",
  1063.             bufMode) == TCL_ERROR) {
  1064.         Tcl_Close((Tcl_Interp *) NULL, channel);
  1065.         return (Tcl_Channel) NULL;
  1066.     }
  1067.     return channel;
  1068. }
  1069.  
  1070. /*
  1071.  *----------------------------------------------------------------------
  1072.  *
  1073.  * TclGetAndDetachPids --
  1074.  *
  1075.  *    Stores a list of the command PIDs for a command channel in
  1076.  *    interp->result.
  1077.  *
  1078.  * Results:
  1079.  *    None.
  1080.  *
  1081.  * Side effects:
  1082.  *    Modifies interp->result.
  1083.  *
  1084.  *----------------------------------------------------------------------
  1085.  */
  1086.  
  1087. void
  1088. TclGetAndDetachPids(interp, chan)
  1089.     Tcl_Interp *interp;
  1090.     Tcl_Channel chan;
  1091. {
  1092.     PipeState *pipePtr;
  1093.     Tcl_ChannelType *chanTypePtr;
  1094.     int i;
  1095.     char buf[20];
  1096.  
  1097.     /*
  1098.      * Punt if the channel is not a command channel.
  1099.      */
  1100.  
  1101.     chanTypePtr = Tcl_GetChannelType(chan);
  1102.     if (chanTypePtr != &pipeChannelType) {
  1103.         return;
  1104.     }
  1105.  
  1106.     pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
  1107.     for (i = 0; i < pipePtr->numPids; i++) {
  1108.         sprintf(buf, "%d", pipePtr->pidPtr[i]);
  1109.         Tcl_AppendElement(interp, buf);
  1110.         Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
  1111.     }
  1112.     if (pipePtr->numPids > 0) {
  1113.         ckfree((char *) pipePtr->pidPtr);
  1114.         pipePtr->numPids = 0;
  1115.     }
  1116. }
  1117.  
  1118. /*
  1119.  *----------------------------------------------------------------------
  1120.  *
  1121.  * TclClosePipeFile --
  1122.  *
  1123.  *    This function is a simple wrapper for close on a file or
  1124.  *    pipe handle.
  1125.  *
  1126.  * Results:
  1127.  *    None.
  1128.  *
  1129.  * Side effects:
  1130.  *    Closes the HFILE and frees the Tcl_File.
  1131.  *
  1132.  *----------------------------------------------------------------------
  1133.  */
  1134.  
  1135. void
  1136. TclClosePipeFile(file)
  1137.     Tcl_File file;
  1138. {
  1139.     int type;
  1140.     APIRET rc;
  1141.     HFILE handle = (HFILE) Tcl_GetFileInfo(file, &type);
  1142.     switch (type) {
  1143.     case TCL_OS2_FILE:
  1144.     case TCL_OS2_PIPE:
  1145.         rc = DosClose(handle);
  1146. #ifdef DEBUG
  1147.             printf("DosClose [%x]\n", handle);
  1148. #endif
  1149.         break;
  1150.     default:
  1151.         break;
  1152.     }
  1153.     Tcl_FreeFile(file);
  1154. }
  1155.