git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxdup.c

   1 /*
   2  * tclXdup.c
   3  *
   4  * Extended Tcl dup command.
   5  *-----------------------------------------------------------------------------
   6  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
   7  *
   8  * Permission to use, copy, modify, and distribute this software and its
   9  * documentation for any purpose and without fee is hereby granted, provided
  10  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11  * Mark Diekhans make no representations about the suitability of this
  12  * software for any purpose.  It is provided "as is" without express or
  13  * implied warranty.
  14  *-----------------------------------------------------------------------------
  15  * $Id: tclXdup.c,v 2.0 1992/10/16 04:50:36 markd Rel $
  16  *-----------------------------------------------------------------------------
  17  */
  18
  19 #include "tclxint.h"
  20
  21 /*
  22  * Prototypes of internal functions.
  23  */
  24 static OpenFile *
  25 DoNormalDup _ANSI_ARGS_((Tcl_Interp *interp,
  26                          OpenFile   *oldFilePtr));
  27
  28 static OpenFile *
  29 DoSpecialDup _ANSI_ARGS_((Tcl_Interp *interp,
  30                           OpenFile   *oldFilePtr,
  31                           char       *newHandleName));
  32
  33 \f
  34 /*
  35  *-----------------------------------------------------------------------------
  36  *
  37  * DoNormalDup --
  38  *   Process a normal dup command (i.e. the new file is not specified).
  39  *
  40  * Parameters:
  41  *   o interp (I) - If an error occures, the error message is in result,
  42  *     otherwise the file handle is in result.
  43  *   o oldFilePtr (I) - Tcl file control block for the file to dup.
  44  * Returns:
  45  *   A pointer to the open file structure for the new file, or NULL if an
  46  * error occured.
  47  *-----------------------------------------------------------------------------
  48  */
  49 static OpenFile *
  50 DoNormalDup (interp, oldFilePtr)
  51     Tcl_Interp *interp;
  52     OpenFile   *oldFilePtr;
  53 {
  54     Interp   *iPtr = (Interp *) interp;
  55     int       newFileId;
  56     FILE     *newFileCbPtr;
  57     char     *mode;
  58
  59     newFileId = dup (fileno (oldFilePtr->f));
  60     if (newFileId < 0)
  61         goto unixError;
  62
  63     if (Tcl_SetupFileEntry (interp, newFileId,
  64                             oldFilePtr->readable,
  65                             oldFilePtr->writable) != TCL_OK)
  66         return NULL;
  67
  68     sprintf (interp->result, "file%d", newFileId);
  69     return iPtr->filePtrArray [newFileId];
  70
  71 unixError:
  72     interp->result = Tcl_UnixError (interp);
  73     return NULL;;
  74 }
  75 \f
  76 /*
  77  *-----------------------------------------------------------------------------
  78  *
  79  * DoSpecialDup --
  80  *   Process a special dup command.  This is the case were the file is
  81  *   dup-ed to stdin, stdout or stderr.  The new file may or be open or
  82  *   closed
  83  * Parameters:
  84  *   o interp (I) - If an error occures, the error message is in result,
  85  *     otherwise nothing is returned.
  86  *   o oldFilePtr (I) - Tcl file control block for the file to dup.
  87  *   o newFileHandle (I) - The handle name for the new file.
  88  * Returns:
  89  *   A pointer to the open file structure for the new file, or NULL if an
  90  * error occured.
  91  *-----------------------------------------------------------------------------
  92  */
  93 static OpenFile *
  94 DoSpecialDup (interp, oldFilePtr, newHandleName)
  95     Tcl_Interp *interp;
  96     OpenFile   *oldFilePtr;
  97     char       *newHandleName;
  98 {
  99     Interp   *iPtr = (Interp *) interp;
 100     int       newFileId;
 101     FILE     *newFileCbPtr;
 102     OpenFile *newFilePtr;
 103
 104     /*
 105      * Duplicate the old file to the specified file id.
 106      */
 107     newFileId = Tcl_ConvertFileHandle (interp, newHandleName);
 108     if (newFileId < 0)
 109         return NULL;
 110     if (newFileId > 2) {
 111         Tcl_AppendResult (interp, "target handle must be one of stdin, ",
 112                           "stdout, stderr, file0, file1, or file2: got \"",
 113                           newHandleName, "\"", (char *) NULL);
 114         return NULL;
 115     }
 116     switch (newFileId) {
 117         case 0:
 118             newFileCbPtr = stdin;
 119             break;
 120         case 1:
 121             newFileCbPtr = stdout;
 122             break;
 123         case 2:
 124             newFileCbPtr = stderr;
 125             break;
 126     }
 127
 128     /*
 129      * If the specified id is not open, set up a stdio file descriptor.
 130      */
 131     TclMakeFileTable (iPtr, newFileId);
 132     if (iPtr->filePtrArray [newFileId] == NULL) {
 133         char *mode;
 134
 135         /*
 136          * Set up a stdio FILE control block for the new file.
 137          */
 138         if (oldFilePtr->readable && oldFilePtr->writable) {
 139             mode = "r+";
 140         } else if (oldFilePtr->writable) {
 141             mode = "w";
 142         } else {
 143             mode = "r";
 144         }
 145         if (freopen ("/dev/null", mode, newFileCbPtr) == NULL)
 146             goto unixError;
 147     }
 148
 149     /*
 150      * This functionallity may be obtained with dup2 on most systems.  Being
 151      * open is optional.
 152      */
 153     close (newFileId);
 154 #ifndef MSDOS
 155     if (fcntl (fileno (oldFilePtr->f), F_DUPFD, newFileId) < 0)
 156         goto unixError;
 157 #endif
 158     /*
 159      * Set up a Tcl OpenFile structure for the new file handle.
 160      */
 161     newFilePtr = iPtr->filePtrArray [fileno (newFileCbPtr)];
 162     if (newFilePtr == NULL) {
 163         newFilePtr = (OpenFile*) ckalloc (sizeof (OpenFile));
 164         iPtr->filePtrArray [fileno (newFileCbPtr)] = newFilePtr;
 165     }
 166     newFilePtr->f        = newFileCbPtr;
 167     newFilePtr->f2       = NULL;
 168     newFilePtr->readable = oldFilePtr->readable;
 169     newFilePtr->writable = oldFilePtr->writable;
 170     newFilePtr->numPids  = 0;
 171     newFilePtr->pidPtr   = NULL;
 172     newFilePtr->errorId  = -1;
 173
 174     return newFilePtr;
 175
 176 unixError:
 177     iPtr->result = Tcl_UnixError (interp);
 178     return NULL;
 179 }
 180 \f
 181 /*
 182  *-----------------------------------------------------------------------------
 183  *
 184  * Tcl_DupCmd --
 185  *     Implements the dup TCL command:
 186  *         dup filehandle [stdhandle]
 187  *
 188  * Results:
 189  *      Returns TCL_OK and interp->result containing a filehandle
 190  *      if the requested file or pipe was successfully duplicated.
 191  *
 192  *      Return TCL_ERROR and interp->result containing an
 193  *      explanation of what went wrong if an error occured.
 194  *
 195  * Side effects:
 196  *      Locates and creates an entry in the handles table
 197  *
 198  *-----------------------------------------------------------------------------
 199  */
 200 int
 201 Tcl_DupCmd (clientData, interp, argc, argv)
 202     ClientData  clientData;
 203     Tcl_Interp *interp;
 204     int         argc;
 205     char      **argv;
 206 {
 207     OpenFile *oldFilePtr, *newFilePtr;
 208     long      seekOffset = -1;
 209
 210     if ((argc < 2) || (argc > 3)) {
 211         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
 212                           " filehandle [stdhandle]", (char *) NULL);
 213         return TCL_ERROR;
 214     }
 215
 216     if (TclGetOpenFile(interp, argv[1], &oldFilePtr) != TCL_OK)
 217         return TCL_ERROR;
 218     if (oldFilePtr->numPids > 0) { /*??????*/
 219         Tcl_AppendResult (interp, "can not `dup' a pipeline", (char *) NULL);
 220         return TCL_ERROR;
 221     }
 222
 223     /*
 224      * If writable, flush out the buffer.  If readable, remember were we are
 225      * so the we can set it up for the next stdio read to come from the same
 226      * place.  The location is only recorded if the file is a reqular file,
 227      * since you cann't seek on other types of files.
 228      */
 229     if (oldFilePtr->writable) {
 230         if (fflush (oldFilePtr->f) != 0)
 231             goto unixError;
 232     }
 233     if (oldFilePtr->readable) {
 234         struct stat statBuf;
 235
 236         if (fstat (fileno (oldFilePtr->f), &statBuf) < 0)
 237             goto unixError;
 238         if ((statBuf.st_mode & S_IFMT) == S_IFREG) {
 239             seekOffset = ftell (oldFilePtr->f);
 240             if (seekOffset < 0)
 241                 goto unixError;
 242         }
 243     }
 244
 245     /*
 246      * Process the dup depending on if dup-ing to a new file or a target
 247      * file handle.
 248      */
 249     if (argc == 2)
 250         newFilePtr = DoNormalDup (interp, oldFilePtr);
 251     else
 252         newFilePtr = DoSpecialDup (interp, oldFilePtr, argv [2]);
 253
 254     if (newFilePtr == NULL)
 255         return TCL_ERROR;
 256
 257     if (seekOffset >= 0) {
 258         if (fseek (newFilePtr->f, seekOffset, SEEK_SET) != 0)
 259             goto unixError;
 260     }
 261     return TCL_OK;
 262
 263 unixError:
 264     Tcl_ResetResult (interp);
 265     interp->result = Tcl_UnixError (interp);
 266     return TCL_ERROR;
 267 }