home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / src / tclXfcntl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-19  |  10.6 KB  |  375 lines
  1. /*
  2.  * tclXfcntl.c
  3.  *
  4.  * Extended Tcl fcntl command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 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 3.0 1993/11/19 06:58:36 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Macro to enable line buffering mode on a file.  The macros assure that the
  23.  * resulting expression returns zero if the function call does not return
  24.  * a value.
  25.  */
  26. #ifdef 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.                           FILE       *filePtr,
  60.                           char       *attrName));
  61.  
  62. static int
  63. SetFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp,
  64.                           FILE       *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.     FILE       *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_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_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 (__linux__)
  211.     /*
  212.      * Linux libc does use _IOLBF
  213.      */
  214.     if (otherAttr & ATTR_NOBUF) {
  215.         interp->result = (filePtr->_flags & _IONBF) ? "1" : "0";
  216.         return TCL_OK;
  217.     }
  218.     if (otherAttr & ATTR_LINEBUF) {
  219.         interp->result = (filePtr->_flags & 0x200) ? "1" : "0";
  220.         return TCL_OK;
  221.     }
  222. #define TCL_STDIOBUF
  223. #endif
  224. #if (!defined(TCL_STDIOBUF)) && (defined(_IONBF) && !defined(_SNBF))
  225.     if (otherAttr & ATTR_NOBUF) {
  226.         interp->result = (filePtr->_flag & _IONBF) ? "1" : "0";
  227.         return TCL_OK;
  228.     }
  229.     if (otherAttr & ATTR_LINEBUF) {
  230.         interp->result = (filePtr->_flag & _IOLBF) ? "1" : "0";
  231.         return TCL_OK;
  232.     }
  233. #define TCL_STDIOBUF
  234. #endif
  235. #if !defined(TCL_STDIOBUF)
  236.     if (otherAttr & ATTR_NOBUF) {
  237.         interp->result = (filePtr->_flags & _SNBF) ? "1" : "0";
  238.         return TCL_OK;
  239.     }
  240.     if (otherAttr & ATTR_LINEBUF) {
  241.         interp->result = (filePtr->_flags & _SLBF) ? "1" : "0";
  242.         return TCL_OK;
  243.     }
  244. #define TCL_STDIOBUF
  245. #endif
  246.  
  247. unixError:
  248.     interp->result = Tcl_PosixError (interp);
  249.     return TCL_ERROR;
  250. }
  251.  
  252. /*
  253.  *-----------------------------------------------------------------------------
  254.  *
  255.  * SetFcntlAttr --
  256.  *    Set the specified fcntl attr to the given value.
  257.  *
  258.  * Parameters:
  259.  *   o interp (I) - Tcl interpreter, value is returned in the result
  260.  *   o filePtr (I) - Pointer to the file descriptor.
  261.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  262.  *     case.
  263.  *   o valueStr (I) - The string value to set the attribiute to.
  264.  *
  265.  * Result:
  266.  *   Returns TCL_OK if all is well, TCL_ERROR if there is an error.
  267.  *-----------------------------------------------------------------------------
  268.  */
  269. static int
  270. SetFcntlAttr (interp, filePtr, attrName, valueStr)
  271.     Tcl_Interp *interp;
  272.     FILE       *filePtr;
  273.     char       *attrName;
  274.     char       *valueStr;
  275. {
  276.  
  277.     int fcntlAttr, otherAttr, current, setValue;
  278.  
  279.     if (Tcl_GetBoolean (interp, valueStr, &setValue) != TCL_OK)
  280.         return TCL_ERROR;
  281.  
  282.     if (XlateFcntlAttr (interp, attrName, &fcntlAttr, &otherAttr) != TCL_OK)
  283.         return TCL_ERROR;
  284.  
  285.     /*
  286.      * Validate that this the attribute may be set (or cleared).
  287.      */
  288.  
  289.     if (fcntlAttr & (O_RDONLY | O_WRONLY | O_RDWR)) {
  290.         Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ",
  291.                           "altered after open", (char *) NULL);
  292.         return TCL_ERROR;
  293.     }
  294.  
  295.     if ((otherAttr & (ATTR_NOBUF | ATTR_LINEBUF)) && !setValue) {
  296.         Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ",
  297.                           "cleared once set", (char *) NULL);
  298.         return TCL_ERROR;
  299.     }
  300.  
  301.     if (otherAttr == ATTR_CLOEXEC) {
  302.         if (fcntl (fileno (filePtr), F_SETFD, setValue) == -1)
  303.             goto unixError;
  304.         return TCL_OK;
  305.     }
  306.  
  307.     if (otherAttr == ATTR_NOBUF) {
  308.         setbuf (filePtr, NULL);
  309.         return TCL_OK;
  310.     }
  311.  
  312.     if (otherAttr == ATTR_LINEBUF) {
  313.         if (SET_LINE_BUF (filePtr) != 0)
  314.             goto unixError;
  315.         return TCL_OK;
  316.     }
  317.  
  318.     /*
  319.      * Handle standard fcntl attrs.
  320.      */
  321.        
  322.     current = fcntl (fileno (filePtr), F_GETFL, 0);
  323.     if (current == -1)
  324.         goto unixError;
  325.     current &= ~fcntlAttr;
  326.     if (setValue)
  327.         current |= fcntlAttr;
  328.     if (fcntl (fileno (filePtr), F_SETFL, current) == -1)
  329.         goto unixError;
  330.  
  331.     return TCL_OK;
  332.  
  333.   unixError:
  334.     interp->result = Tcl_PosixError (interp);
  335.     return TCL_ERROR;
  336.    
  337. }
  338.  
  339. /*
  340.  *-----------------------------------------------------------------------------
  341.  *
  342.  * Tcl_FcntlCmd --
  343.  *     Implements the fcntl TCL command:
  344.  *         fcntl handle attribute ?value?
  345.  *-----------------------------------------------------------------------------
  346.  */
  347. int
  348. Tcl_FcntlCmd (clientData, interp, argc, argv)
  349.     ClientData  clientData;
  350.     Tcl_Interp *interp;
  351.     int         argc;
  352.     char      **argv;
  353. {
  354.     FILE  *filePtr;
  355.  
  356.     if ((argc < 3) || (argc > 4)) {
  357.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  358.                           " handle attribute ?value?", (char *) NULL);
  359.         return TCL_ERROR;
  360.     }
  361.  
  362.     if (Tcl_GetOpenFile (interp, argv [1], 
  363.                          FALSE, FALSE,   /* No access checking */
  364.                          &filePtr) != TCL_OK)
  365.     return TCL_ERROR;
  366.     if (argc == 3) {    
  367.         if (GetFcntlAttr (interp, filePtr, argv [2]) != TCL_OK)
  368.             return TCL_ERROR;
  369.     } else {
  370.         if (SetFcntlAttr (interp, filePtr, argv [2], argv [3]) != TCL_OK)
  371.             return TCL_ERROR;
  372.     }
  373.     return TCL_OK;
  374. }
  375.