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