]>
Commit | Line | Data |
---|---|---|
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.0 1992/10/16 04:50:38 markd Rel $ | |
16 | *----------------------------------------------------------------------------- | |
17 | */ | |
18 | ||
19 | #include "tclxint.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 | \f | |
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 | \f | |
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 | */ | |
202 | ||
203 | #ifndef IS_LINUX | |
204 | ||
205 | #ifdef _IONBF | |
206 | if (otherAttr & ATTR_NOBUF) { | |
207 | interp->result = (filePtr->f->_flag & _IONBF) ? "1" : "0"; | |
208 | return TCL_OK; | |
209 | } | |
210 | if (otherAttr & ATTR_LINEBUF) { | |
211 | interp->result = (filePtr->f->_flag & _IOLBF) ? "1" : "0"; | |
212 | return TCL_OK; | |
213 | } | |
214 | #else | |
215 | if (otherAttr & ATTR_NOBUF) { | |
216 | interp->result = (filePtr->f->_flags & _SNBF) ? "1" : "0"; | |
217 | return TCL_OK; | |
218 | } | |
219 | if (otherAttr & ATTR_LINEBUF) { | |
220 | interp->result = (filePtr->f->_flags & _SLBF) ? "1" : "0"; | |
221 | return TCL_OK; | |
222 | } | |
223 | #endif | |
224 | ||
225 | #endif | |
226 | ||
227 | unixError: | |
228 | interp->result = Tcl_UnixError (interp); | |
229 | return TCL_ERROR; | |
230 | } | |
231 | \f | |
232 | /* | |
233 | *----------------------------------------------------------------------------- | |
234 | * | |
235 | * SetFcntlAttr -- | |
236 | * Set the specified fcntl attr to the given value. | |
237 | * | |
238 | * Parameters: | |
239 | * o interp (I) - Tcl interpreter, value is returned in the result | |
240 | * o filePtr (I) - Pointer to the file descriptor. | |
241 | * o attrName (I) - The attrbute name to translate, maybe upper or lower | |
242 | * case. | |
243 | * o valueStr (I) - The string value to set the attribiute to. | |
244 | * | |
245 | * Result: | |
246 | * Returns TCL_OK if all is well, TCL_ERROR if there is an error. | |
247 | *----------------------------------------------------------------------------- | |
248 | */ | |
249 | static int | |
250 | SetFcntlAttr (interp, filePtr, attrName, valueStr) | |
251 | Tcl_Interp *interp; | |
252 | OpenFile *filePtr; | |
253 | char *attrName; | |
254 | char *valueStr; | |
255 | { | |
256 | ||
257 | int fcntlAttr, otherAttr, current, setValue; | |
258 | ||
259 | if (Tcl_GetBoolean (interp, valueStr, &setValue) != TCL_OK) | |
260 | return TCL_ERROR; | |
261 | ||
262 | if (XlateFcntlAttr (interp, attrName, &fcntlAttr, &otherAttr) != TCL_OK) | |
263 | return TCL_ERROR; | |
264 | ||
265 | /* | |
266 | * Validate that this the attribute may be set (or cleared). | |
267 | */ | |
268 | ||
269 | if (fcntlAttr & (O_RDONLY | O_WRONLY | O_RDWR)) { | |
270 | Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ", | |
271 | "altered after open", (char *) NULL); | |
272 | return TCL_ERROR; | |
273 | } | |
274 | ||
275 | if ((otherAttr & (ATTR_NOBUF | ATTR_LINEBUF)) && !setValue) { | |
276 | Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ", | |
277 | "cleared once set", (char *) NULL); | |
278 | return TCL_ERROR; | |
279 | } | |
280 | ||
281 | if (otherAttr == ATTR_CLOEXEC) { | |
282 | if (fcntl (fileno (filePtr->f), F_SETFD, setValue) == -1) | |
283 | goto unixError; | |
284 | return TCL_OK; | |
285 | } | |
286 | ||
287 | if (otherAttr == ATTR_NOBUF) { | |
288 | setbuf (filePtr->f, NULL); | |
289 | return TCL_OK; | |
290 | } | |
291 | ||
292 | if (otherAttr == ATTR_LINEBUF) { | |
293 | if (SET_LINE_BUF (filePtr->f) != 0) | |
294 | goto unixError; | |
295 | return TCL_OK; | |
296 | } | |
297 | ||
298 | /* | |
299 | * Handle standard fcntl attrs. | |
300 | */ | |
301 | ||
302 | current = fcntl (fileno (filePtr->f), F_GETFL, 0); | |
303 | if (current == -1) | |
304 | goto unixError; | |
305 | current &= ~fcntlAttr; | |
306 | if (setValue) | |
307 | current |= fcntlAttr; | |
308 | if (fcntl (fileno (filePtr->f), F_SETFL, current) == -1) | |
309 | goto unixError; | |
310 | ||
311 | return TCL_OK; | |
312 | ||
313 | unixError: | |
314 | interp->result = Tcl_UnixError (interp); | |
315 | return TCL_ERROR; | |
316 | ||
317 | } | |
318 | \f | |
319 | /* | |
320 | *----------------------------------------------------------------------------- | |
321 | * | |
322 | * Tcl_FcntlCmd -- | |
323 | * Implements the fcntl TCL command: | |
324 | * fcntl handle [attribute value] | |
325 | *----------------------------------------------------------------------------- | |
326 | */ | |
327 | int | |
328 | Tcl_FcntlCmd (clientData, interp, argc, argv) | |
329 | ClientData clientData; | |
330 | Tcl_Interp *interp; | |
331 | int argc; | |
332 | char **argv; | |
333 | { | |
334 | OpenFile *filePtr; | |
335 | ||
336 | if ((argc < 3) || (argc > 4)) { | |
337 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
338 | " handle attribute [value]", (char *) NULL); | |
339 | return TCL_ERROR; | |
340 | } | |
341 | ||
342 | if (TclGetOpenFile (interp, argv[1], &filePtr) != TCL_OK) | |
343 | return TCL_ERROR; | |
344 | if (argc == 3) { | |
345 | if (GetFcntlAttr (interp, filePtr, argv [2]) != TCL_OK) | |
346 | return TCL_ERROR; | |
347 | } else { | |
348 | if (SetFcntlAttr (interp, filePtr, argv [2], argv [3]) != TCL_OK) | |
349 | return TCL_ERROR; | |
350 | } | |
351 | return TCL_OK; | |
352 | } |