1/* 2 * tclXfcntl.c 3 * 4 * Extended Tcl fcntl command. 5 *----------------------------------------------------------------------------- 6 * Copyright 1991-1999 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 1.2 2005/01/19 03:20:47 hobbs Exp $ 16 *----------------------------------------------------------------------------- 17 */ 18 19#include "tclExtdInt.h" 20 21/* 22 * Attributes sets used by fcntl command. 23 */ 24#define ATTR_ERROR -1 /* Error parsing attributes. */ 25 26#define ATTR_RDONLY 1 /* Access checks desired. */ 27#define ATTR_WRONLY 2 28#define ATTR_RDWR 3 29#define ATTR_READ 4 30#define ATTR_WRITE 5 31#define ATTR_APPEND 6 32#define ATTR_CLOEXEC 7 33#define ATTR_NOBUF 8 34#define ATTR_LINEBUF 9 35#define ATTR_NONBLOCK 10 36#define ATTR_KEEPALIVE 11 37 38/* 39 * The maximum length of any attribute name. 40 */ 41#define MAX_ATTR_NAME_LEN 20 42 43/* 44 * Table of attribute names and values. 45 */ 46static struct { 47 char *name; 48 int id; 49 int modifiable; 50} TclXfcntlAttrNames [] = { 51 {"RDONLY", ATTR_RDONLY, FALSE}, 52 {"WRONLY", ATTR_WRONLY, FALSE}, 53 {"RDWR", ATTR_RDWR, FALSE}, 54 {"READ", ATTR_READ, FALSE}, 55 {"WRITE", ATTR_WRITE, FALSE}, 56 {"APPEND", ATTR_APPEND, TRUE}, 57 {"CLOEXEC", ATTR_CLOEXEC, TRUE}, 58 {"NONBLOCK", ATTR_NONBLOCK, TRUE}, 59 {"LINEBUF", ATTR_LINEBUF, TRUE}, 60 {"NOBUF", ATTR_NOBUF, TRUE}, 61 {"KEEPALIVE", ATTR_KEEPALIVE, TRUE}, 62 {NULL, 0, FALSE}}; 63 64/* 65 * Prototypes of internal functions. 66 */ 67static int 68XlateFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp, 69 char *attrName, 70 int modify)); 71 72static int 73GetFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp, 74 Tcl_Channel channel, 75 int mode, 76 int attrib)); 77 78static int 79SetFcntlAttrObj _ANSI_ARGS_((Tcl_Interp *interp, 80 Tcl_Channel channel, 81 int attrib, 82 Tcl_Obj *valueObj)); 83 84static int 85TclX_FcntlObjCmd _ANSI_ARGS_((ClientData clientData, 86 Tcl_Interp *interp, 87 int objc, 88 Tcl_Obj *CONST objv[])); 89 90 91/*----------------------------------------------------------------------------- 92 * XlateFcntlAttr -- 93 * Translate an fcntl attribute to an numberic id. 94 * 95 * Parameters: 96 * o interp - Tcl interp, errors in result 97 * o attrName - The attrbute name to translate, maybe upper or lower case. 98 * o modify - Will the attribute be modified 99 * Result: 100 * The number associated with the attirbute, or ATTR_ERROR is an error 101 * occures. 102 *----------------------------------------------------------------------------- 103 */ 104static int 105XlateFcntlAttr (interp, attrName, modify) 106 Tcl_Interp *interp; 107 char *attrName; 108 int modify; 109{ 110 char attrNameUp [MAX_ATTR_NAME_LEN]; 111 int idx; 112 113 if (strlen (attrName) >= MAX_ATTR_NAME_LEN) 114 goto invalidAttrName; 115 116 TclX_UpShift (attrNameUp, attrName); 117 118 for (idx = 0; TclXfcntlAttrNames [idx].name != NULL; idx++) { 119 if (STREQU (attrNameUp, TclXfcntlAttrNames [idx].name)) { 120 if (modify && !TclXfcntlAttrNames [idx].modifiable) { 121 TclX_AppendObjResult (interp, "Attribute \"", attrName, 122 "\" may not be altered after open", 123 (char *) NULL); 124 return ATTR_ERROR; 125 } 126 return TclXfcntlAttrNames [idx].id; 127 } 128 } 129 130 /* 131 * Invalid attribute. 132 */ 133 invalidAttrName: 134 TclX_AppendObjResult (interp, "unknown attribute name \"", attrName, 135 "\", expected one of ", (char *) NULL); 136 137 for (idx = 0; TclXfcntlAttrNames [idx + 1].name != NULL; idx++) { 138 TclX_AppendObjResult (interp, TclXfcntlAttrNames [idx].name, ", ", 139 (char *) NULL); 140 } 141 TclX_AppendObjResult (interp, "or ", TclXfcntlAttrNames [idx].name, (char *) NULL); 142 return ATTR_ERROR; 143} 144 145/*----------------------------------------------------------------------------- 146 * GetFcntlAttr -- 147 * Return the value of a specified fcntl attribute. 148 * 149 * Parameters: 150 * o interp - Tcl interpreter, value is returned in the result 151 * o channel - The channel to check. 152 * o mode - Channel access mode. 153 * o attrib - Attribute to get. 154 * Result: 155 * TCL_OK or TCL_ERROR 156 *----------------------------------------------------------------------------- 157 */ 158static int 159GetFcntlAttr (interp, channel, mode, attrib) 160 Tcl_Interp *interp; 161 Tcl_Channel channel; 162 int mode; 163 int attrib; 164{ 165 int value, optValue; 166 167 switch (attrib) { 168 case ATTR_RDONLY: 169 value = (mode & TCL_READABLE) && !(mode & TCL_WRITABLE); 170 break; 171 case ATTR_WRONLY: 172 value = (mode & TCL_WRITABLE) && !(mode & TCL_READABLE); 173 break; 174 case ATTR_RDWR: 175 value = (mode & TCL_READABLE) && (mode & TCL_WRITABLE); 176 break; 177 case ATTR_READ: 178 value = (mode & TCL_READABLE); 179 break; 180 case ATTR_WRITE: 181 value = (mode & TCL_WRITABLE); 182 break; 183 case ATTR_APPEND: 184 if (TclXOSGetAppend (interp, channel, &value) != TCL_OK) 185 return TCL_ERROR; 186 break; 187 case ATTR_CLOEXEC: 188 if (TclXOSGetCloseOnExec (interp, channel, &value) != TCL_OK) 189 return TCL_ERROR; 190 break; 191 case ATTR_NONBLOCK: 192 if (TclX_GetChannelOption (interp, channel, TCLX_COPT_BLOCKING, 193 &optValue) != TCL_OK) 194 return TCL_ERROR; 195 value = (optValue == TCLX_MODE_NONBLOCKING); 196 break; 197 case ATTR_NOBUF: 198 if (TclX_GetChannelOption (interp, channel, TCLX_COPT_BUFFERING, 199 &optValue) != TCL_OK) 200 return TCL_ERROR; 201 value = (optValue == TCLX_BUFFERING_NONE); 202 break; 203 case ATTR_LINEBUF: 204 if (TclX_GetChannelOption (interp, channel, TCLX_COPT_BUFFERING, 205 &optValue) != TCL_OK) 206 return TCL_ERROR; 207 value = (optValue == TCLX_BUFFERING_LINE); 208 break; 209 case ATTR_KEEPALIVE: 210 if (TclXOSgetsockopt (interp, channel, SO_KEEPALIVE, &value) != TCL_OK) 211 return TCL_ERROR; 212 break; 213 default: 214 panic ("bug in fcntl get attrib"); 215 } 216 217 Tcl_SetIntObj (Tcl_GetObjResult (interp), value != 0); 218 return TCL_OK; 219} 220 221/*----------------------------------------------------------------------------- 222 * SetFcntlAttrObj -- 223 * Set the the attributes on a channel. 224 * 225 * Parameters: 226 * o interp - Tcl interpreter, value is returned in the result 227 * o channel - The channel to check. 228 * o attrib - Atrribute to set. 229 * o valueStr - Object value (all are boolean now). 230 * Result: 231 * TCL_OK or TCL_ERROR. 232 *----------------------------------------------------------------------------- 233 */ 234static int 235SetFcntlAttrObj (interp, channel, attrib, valueObj) 236 Tcl_Interp *interp; 237 Tcl_Channel channel; 238 int attrib; 239 Tcl_Obj *valueObj; 240{ 241 int value; 242 243 if (Tcl_GetBooleanFromObj (interp, valueObj, &value) != TCL_OK) 244 return TCL_ERROR; 245 246 switch (attrib) { 247 case ATTR_APPEND: 248 if (TclXOSSetAppend (interp, channel, value) != TCL_OK) 249 return TCL_ERROR; 250 return TCL_OK; 251 case ATTR_CLOEXEC: 252 if (TclXOSSetCloseOnExec (interp, channel, value) != TCL_OK) 253 return TCL_ERROR; 254 return TCL_OK; 255 case ATTR_NONBLOCK: 256 return TclX_SetChannelOption (interp, channel, TCLX_COPT_BLOCKING, 257 value ? TCLX_MODE_NONBLOCKING : 258 TCLX_MODE_BLOCKING); 259 case ATTR_NOBUF: 260 return TclX_SetChannelOption (interp, channel, TCLX_COPT_BUFFERING, 261 value ? TCLX_BUFFERING_NONE : 262 TCLX_BUFFERING_FULL); 263 case ATTR_LINEBUF: 264 return TclX_SetChannelOption (interp, channel, TCLX_COPT_BUFFERING, 265 value ? TCLX_BUFFERING_LINE : 266 TCLX_BUFFERING_FULL); 267 case ATTR_KEEPALIVE: 268 return TclXOSsetsockopt (interp, channel, SO_KEEPALIVE, value); 269 default: 270 panic ("buf in fcntl set attrib"); 271 } 272 return TCL_ERROR; /* Should never be reached */ 273} 274 275/*----------------------------------------------------------------------------- 276 * TclX_FcntlObjCmd -- 277 * Implements the fcntl TCL command: 278 * fcntl handle attribute ?value? 279 *----------------------------------------------------------------------------- 280 */ 281static int 282TclX_FcntlObjCmd (clientData, interp, objc, objv) 283 ClientData clientData; 284 Tcl_Interp *interp; 285 int objc; 286 Tcl_Obj *CONST objv[]; 287{ 288 Tcl_Channel channel; 289 int mode; 290 int attrib; 291 char *channelString; 292 char *fcntlAttributes; 293 294 if ((objc < 3) || (objc > 4)) 295 return TclX_WrongArgs (interp, objv [0], 296 "handle attribute ?value?"); 297 298 channelString = Tcl_GetStringFromObj (objv[1], NULL); 299 300 channel = Tcl_GetChannel (interp, channelString, &mode); 301 if (channel == NULL) { 302 return TCL_ERROR; 303 } 304 305 fcntlAttributes = Tcl_GetStringFromObj (objv[2], NULL); 306 attrib = XlateFcntlAttr (interp, fcntlAttributes, (objc == 4)); 307 if (attrib == ATTR_ERROR) 308 return TCL_ERROR; 309 310 if (objc == 3) { 311 if (GetFcntlAttr (interp, channel, mode, attrib) != TCL_OK) 312 return TCL_ERROR; 313 } else { 314 if (SetFcntlAttrObj (interp, channel, attrib, objv[3]) != TCL_OK) 315 return TCL_ERROR; 316 } 317 return TCL_OK; 318} 319 320 321/*----------------------------------------------------------------------------- 322 * TclX_FcntlInit -- 323 * Initialize the fcntl command. 324 *----------------------------------------------------------------------------- 325 */ 326void 327TclX_FcntlInit (interp) 328 Tcl_Interp *interp; 329{ 330 Tcl_CreateObjCommand (interp, 331 "fcntl", 332 TclX_FcntlObjCmd, 333 (ClientData) NULL, 334 (Tcl_CmdDeleteProc*) NULL); 335} 336 337