home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXfcntl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  10.1 KB  |  357 lines
  1. /*
  2.  * tclXfcntl.c
  3.  *
  4.  * Extended Tcl fcntl 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: tclXfcntl.c,v 2.1 1992/11/25 15:45:23 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Macro to enable line buffering mode on a file.  Macros assure that the
  23.  * resulting expression returns zero if the function call does not return
  24.  * a value.
  25.  */
  26. #ifdef TCL_HAVE_SETLINEBUF
  27. #   define SET_LINE_BUF(fp)  (setlinebuf (fp),0)
  28. #else
  29. #   define SET_LINE_BUF(fp)  setvbuf (fp, NULL, _IOLBF, BUFSIZ)
  30. #endif
  31.  
  32. /*
  33.  * If we don't have O_NONBLOCK, use O_NDELAY.
  34.  */
  35. #ifndef O_NONBLOCK
  36. #   define O_NONBLOCK O_NDELAY
  37. #endif
  38.  
  39. /*
  40.  * Attributes used by fcntl command and the maximum length of any attribute
  41.  * name.
  42.  */
  43. #define   ATTR_CLOEXEC  1
  44. #define   ATTR_NOBUF    2
  45. #define   ATTR_LINEBUF  4
  46. #define   MAX_ATTR_NAME_LEN  20
  47.  
  48. /*
  49.  * Prototypes of internal functions.
  50.  */
  51. static int
  52. XlateFcntlAttr  _ANSI_ARGS_((Tcl_Interp *interp,
  53.                              char       *attrName,
  54.                              int        *fcntlAttrPtr,
  55.                              int        *otherAttrPtr));
  56.  
  57. static int
  58. GetFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp,
  59.                           OpenFile   *filePtr,
  60.                           char       *attrName));
  61.  
  62. static int
  63. SetFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp,
  64.                           OpenFile   *filePtr,
  65.                           char       *attrName,
  66.                           char       *valueStr));
  67.  
  68. /*
  69.  *-----------------------------------------------------------------------------
  70.  *
  71.  * XlateFcntlAttr --
  72.  *    Translate an fcntl attribute.
  73.  *
  74.  * Parameters:
  75.  *   o interp (I) - Tcl interpreter.
  76.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  77.  *     case.
  78.  *   o fcntlAttrPtr (O) - If the attr specified is one of the standard
  79.  *     fcntl attrs, it is returned here, otherwise zero is returned.
  80.  *   o otherAttrPtr (O) - If the attr specified is one of the additional
  81.  *     attrs supported by the Tcl command, it is returned here, otherwise
  82.  *     zero is returned.
  83.  * Result:
  84.  *   Returns TCL_OK if all is well, TCL_ERROR if there is an error.
  85.  *-----------------------------------------------------------------------------
  86.  */
  87. static int
  88. XlateFcntlAttr (interp, attrName, fcntlAttrPtr, otherAttrPtr)
  89.     Tcl_Interp *interp;
  90.     char       *attrName;
  91.     int        *fcntlAttrPtr;
  92.     int        *otherAttrPtr;
  93. {
  94.     char attrNameUp [MAX_ATTR_NAME_LEN];
  95.  
  96.     *fcntlAttrPtr = 0;
  97.     *otherAttrPtr = 0;
  98.  
  99.     if (strlen (attrName) >= MAX_ATTR_NAME_LEN)
  100.         goto invalidAttrName;
  101.  
  102.     Tcl_UpShift (attrNameUp, attrName);
  103.  
  104.     if (STREQU (attrNameUp, "RDONLY")) {
  105.         *fcntlAttrPtr = O_RDONLY;
  106.         return TCL_OK;
  107.     }
  108.     if (STREQU (attrNameUp, "WRONLY")) {
  109.         *fcntlAttrPtr = O_WRONLY;
  110.         return TCL_OK;
  111.     }
  112.     if (STREQU (attrNameUp, "RDWR")) {
  113.         *fcntlAttrPtr = O_RDWR;
  114.         return TCL_OK;
  115.     }
  116.     if (STREQU (attrNameUp, "READ")) {
  117.         *fcntlAttrPtr = O_RDONLY | O_RDWR;
  118.         return TCL_OK;
  119.     }
  120.     if (STREQU (attrNameUp, "WRITE")) {
  121.         *fcntlAttrPtr = O_WRONLY | O_RDWR;
  122.         return TCL_OK;
  123.     }
  124.     if (STREQU (attrNameUp, "NONBLOCK")) {
  125.         *fcntlAttrPtr = O_NONBLOCK;
  126.         return TCL_OK;
  127.     }
  128.     if (STREQU (attrNameUp, "APPEND")) {
  129.         *fcntlAttrPtr = O_APPEND;
  130.         return TCL_OK;
  131.     }
  132.     if (STREQU (attrNameUp, "CLOEXEC")) {
  133.         *otherAttrPtr = ATTR_CLOEXEC;
  134.         return TCL_OK;
  135.     }
  136.     if (STREQU (attrNameUp, "NOBUF")) {
  137.         *otherAttrPtr = ATTR_NOBUF;
  138.         return TCL_OK;
  139.     }
  140.     if (STREQU (attrNameUp, "LINEBUF")) {
  141.         *otherAttrPtr = ATTR_LINEBUF;
  142.         return TCL_OK;
  143.     }
  144.  
  145.     /*
  146.      * Error return code.
  147.      */
  148.   invalidAttrName:
  149.     Tcl_AppendResult (interp, "unknown attribute name \"", attrName,
  150.                       "\", expected one of APPEND, CLOEXEC, LINEBUF, ",
  151.                       "NONBLOCK, NOBUF, READ, RDONLY, RDWR, WRITE, WRONLY",
  152.                       (char *) NULL);
  153.     return TCL_ERROR;
  154.  
  155. }
  156.  
  157. /*
  158.  *-----------------------------------------------------------------------------
  159.  *
  160.  * GetFcntlAttr --
  161.  *    Return the value of a specified fcntl attribute.
  162.  *
  163.  * Parameters:
  164.  *   o interp (I) - Tcl interpreter, value is returned in the result
  165.  *   o filePtr (I) - Pointer to the file descriptor.
  166.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  167.  *     case.
  168.  * Result:
  169.  *   Returns TCL_OK if all is well, TCL_ERROR if fcntl returns an error.
  170.  *-----------------------------------------------------------------------------
  171.  */
  172. static int
  173. GetFcntlAttr (interp, filePtr, attrName)
  174.     Tcl_Interp *interp;
  175.     OpenFile   *filePtr;
  176.     char       *attrName;
  177. {
  178.     int fcntlAttr, otherAttr, current;
  179.  
  180.     if (XlateFcntlAttr (interp, attrName, &fcntlAttr, &otherAttr) != TCL_OK)
  181.         return TCL_ERROR;
  182.  
  183.     if (fcntlAttr != 0) {
  184.         current = fcntl (fileno (filePtr->f), F_GETFL, 0);
  185.         if (current == -1)
  186.             goto unixError;
  187.         interp->result = (current & fcntlAttr) ? "1" : "0";
  188.         return TCL_OK;
  189.     }
  190.     
  191.     if (otherAttr & ATTR_CLOEXEC) {
  192.         current = fcntl (fileno (filePtr->f), F_GETFD, 0);
  193.         if (current == -1)
  194.             goto unixError;
  195.         interp->result = (current & 1) ? "1" : "0";
  196.         return TCL_OK;
  197.     }
  198.  
  199.     /*
  200.      * Poke the stdio FILE structure to determine the buffering status.
  201.      * This is nasty, _IONBF is the System V flag and _SNBF is the BSD
  202.      * flag.  However some systems using BSD also define _IONBF (yuk).
  203.      * Also some BSDs use __SNBF.
  204.      */
  205. #if defined(__SNBF) && !defined (_SNBF)
  206. #    define _SNBF __SNBF
  207. #    define _SLBF __SLBF
  208. #endif
  209.  
  210. #if defined(_IONBF) && !defined(_SNBF)
  211.     if (otherAttr & ATTR_NOBUF) {
  212.         interp->result = (filePtr->f->_flag & _IONBF) ? "1" : "0";
  213.         return TCL_OK;
  214.     }
  215.     if (otherAttr & ATTR_LINEBUF) {
  216.         interp->result = (filePtr->f->_flag & _IOLBF) ? "1" : "0";
  217.         return TCL_OK;
  218.     }
  219. #else
  220.     if (otherAttr & ATTR_NOBUF) {
  221.         interp->result = (filePtr->f->_flags & _SNBF) ? "1" : "0";
  222.         return TCL_OK;
  223.     }
  224.     if (otherAttr & ATTR_LINEBUF) {
  225.         interp->result = (filePtr->f->_flags & _SLBF) ? "1" : "0";
  226.         return TCL_OK;
  227.     }
  228. #endif
  229.  
  230.  
  231. unixError:
  232.     interp->result = Tcl_UnixError (interp);
  233.     return TCL_ERROR;
  234. }
  235.  
  236. /*
  237.  *-----------------------------------------------------------------------------
  238.  *
  239.  * SetFcntlAttr --
  240.  *    Set the specified fcntl attr to the given value.
  241.  *
  242.  * Parameters:
  243.  *   o interp (I) - Tcl interpreter, value is returned in the result
  244.  *   o filePtr (I) - Pointer to the file descriptor.
  245.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  246.  *     case.
  247.  *   o valueStr (I) - The string value to set the attribiute to.
  248.  *
  249.  * Result:
  250.  *   Returns TCL_OK if all is well, TCL_ERROR if there is an error.
  251.  *-----------------------------------------------------------------------------
  252.  */
  253. static int
  254. SetFcntlAttr (interp, filePtr, attrName, valueStr)
  255.     Tcl_Interp *interp;
  256.     OpenFile   *filePtr;
  257.     char       *attrName;
  258.     char       *valueStr;
  259. {
  260.  
  261.     int fcntlAttr, otherAttr, current, setValue;
  262.  
  263.     if (Tcl_GetBoolean (interp, valueStr, &setValue) != TCL_OK)
  264.         return TCL_ERROR;
  265.  
  266.     if (XlateFcntlAttr (interp, attrName, &fcntlAttr, &otherAttr) != TCL_OK)
  267.         return TCL_ERROR;
  268.  
  269.     /*
  270.      * Validate that this the attribute may be set (or cleared).
  271.      */
  272.  
  273.     if (fcntlAttr & (O_RDONLY | O_WRONLY | O_RDWR)) {
  274.         Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ",
  275.                           "altered after open", (char *) NULL);
  276.         return TCL_ERROR;
  277.     }
  278.  
  279.     if ((otherAttr & (ATTR_NOBUF | ATTR_LINEBUF)) && !setValue) {
  280.         Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ",
  281.                           "cleared once set", (char *) NULL);
  282.         return TCL_ERROR;
  283.     }
  284.  
  285.     if (otherAttr == ATTR_CLOEXEC) {
  286.         if (fcntl (fileno (filePtr->f), F_SETFD, setValue) == -1)
  287.             goto unixError;
  288.         return TCL_OK;
  289.     }
  290.  
  291.     if (otherAttr == ATTR_NOBUF) {
  292.         setbuf (filePtr->f, NULL);
  293.         return TCL_OK;
  294.     }
  295.  
  296.     if (otherAttr == ATTR_LINEBUF) {
  297.         if (SET_LINE_BUF (filePtr->f) != 0)
  298.             goto unixError;
  299.         return TCL_OK;
  300.     }
  301.  
  302.     /*
  303.      * Handle standard fcntl attrs.
  304.      */
  305.        
  306.     current = fcntl (fileno (filePtr->f), F_GETFL, 0);
  307.     if (current == -1)
  308.         goto unixError;
  309.     current &= ~fcntlAttr;
  310.     if (setValue)
  311.         current |= fcntlAttr;
  312.     if (fcntl (fileno (filePtr->f), F_SETFL, current) == -1)
  313.         goto unixError;
  314.  
  315.     return TCL_OK;
  316.  
  317.   unixError:
  318.     interp->result = Tcl_UnixError (interp);
  319.     return TCL_ERROR;
  320.    
  321. }
  322.  
  323. /*
  324.  *-----------------------------------------------------------------------------
  325.  *
  326.  * Tcl_FcntlCmd --
  327.  *     Implements the fcntl TCL command:
  328.  *         fcntl handle [attribute value]
  329.  *-----------------------------------------------------------------------------
  330.  */
  331. int
  332. Tcl_FcntlCmd (clientData, interp, argc, argv)
  333.     ClientData  clientData;
  334.     Tcl_Interp *interp;
  335.     int         argc;
  336.     char      **argv;
  337. {
  338.     OpenFile    *filePtr;
  339.  
  340.     if ((argc < 3) || (argc > 4)) {
  341.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  342.                           " handle attribute [value]", (char *) NULL);
  343.         return TCL_ERROR;
  344.     }
  345.  
  346.     if (TclGetOpenFile (interp, argv[1], &filePtr) != TCL_OK)
  347.     return TCL_ERROR;
  348.     if (argc == 3) {    
  349.         if (GetFcntlAttr (interp, filePtr, argv [2]) != TCL_OK)
  350.             return TCL_ERROR;
  351.     } else {
  352.         if (SetFcntlAttr (interp, filePtr, argv [2], argv [3]) != TCL_OK)
  353.             return TCL_ERROR;
  354.     }
  355.     return TCL_OK;
  356. }
  357.