1 |
dashley |
71 |
/* $Header$ */ |
2 |
|
|
/* |
3 |
|
|
* tclIOUtil.c -- |
4 |
|
|
* |
5 |
|
|
* This file contains a collection of utility procedures that |
6 |
|
|
* are shared by the platform specific IO drivers. |
7 |
|
|
* |
8 |
|
|
* Parts of this file are based on code contributed by Karl |
9 |
|
|
* Lehenbauer, Mark Diekhans and Peter da Silva. |
10 |
|
|
* |
11 |
|
|
* Copyright (c) 1991-1994 The Regents of the University of California. |
12 |
|
|
* Copyright (c) 1994-1997 Sun Microsystems, Inc. |
13 |
|
|
* |
14 |
|
|
* See the file "license.terms" for information on usage and redistribution |
15 |
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
16 |
|
|
* |
17 |
|
|
* RCS: @(#) $Id: tclioutil.c,v 1.1.1.1 2001/06/13 04:42:24 dtashley Exp $ |
18 |
|
|
*/ |
19 |
|
|
|
20 |
|
|
#include "tclInt.h" |
21 |
|
|
#include "tclPort.h" |
22 |
|
|
|
23 |
|
|
/* |
24 |
|
|
* The following typedef declarations allow for hooking into the chain |
25 |
|
|
* of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' & |
26 |
|
|
* 'Tcl_OpenFileChannel(...)'. Basically for each hookable function |
27 |
|
|
* a linked list is defined. |
28 |
|
|
*/ |
29 |
|
|
|
30 |
|
|
typedef struct StatProc { |
31 |
|
|
TclStatProc_ *proc; /* Function to process a 'stat()' call */ |
32 |
|
|
struct StatProc *nextPtr; /* The next 'stat()' function to call */ |
33 |
|
|
} StatProc; |
34 |
|
|
|
35 |
|
|
typedef struct AccessProc { |
36 |
|
|
TclAccessProc_ *proc; /* Function to process a 'access()' call */ |
37 |
|
|
struct AccessProc *nextPtr; /* The next 'access()' function to call */ |
38 |
|
|
} AccessProc; |
39 |
|
|
|
40 |
|
|
typedef struct OpenFileChannelProc { |
41 |
|
|
TclOpenFileChannelProc_ *proc; /* Function to process a |
42 |
|
|
* 'Tcl_OpenFileChannel()' call */ |
43 |
|
|
struct OpenFileChannelProc *nextPtr; |
44 |
|
|
/* The next 'Tcl_OpenFileChannel()' |
45 |
|
|
* function to call */ |
46 |
|
|
} OpenFileChannelProc; |
47 |
|
|
|
48 |
|
|
/* |
49 |
|
|
* For each type of hookable function, a static node is declared to |
50 |
|
|
* hold the function pointer for the "built-in" routine (e.g. |
51 |
|
|
* 'TclpStat(...)') and the respective list is initialized as a pointer |
52 |
|
|
* to that node. |
53 |
|
|
* |
54 |
|
|
* The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that |
55 |
|
|
* these statically declared list entry cannot be inadvertently removed. |
56 |
|
|
* |
57 |
|
|
* This method avoids the need to call any sort of "initialization" |
58 |
|
|
* function. |
59 |
|
|
* |
60 |
|
|
* All three lists are protected by a global hookMutex. |
61 |
|
|
*/ |
62 |
|
|
|
63 |
|
|
static StatProc defaultStatProc = { |
64 |
|
|
&TclpStat, NULL |
65 |
|
|
}; |
66 |
|
|
static StatProc *statProcList = &defaultStatProc; |
67 |
|
|
|
68 |
|
|
static AccessProc defaultAccessProc = { |
69 |
|
|
&TclpAccess, NULL |
70 |
|
|
}; |
71 |
|
|
static AccessProc *accessProcList = &defaultAccessProc; |
72 |
|
|
|
73 |
|
|
static OpenFileChannelProc defaultOpenFileChannelProc = { |
74 |
|
|
&TclpOpenFileChannel, NULL |
75 |
|
|
}; |
76 |
|
|
static OpenFileChannelProc *openFileChannelProcList = |
77 |
|
|
&defaultOpenFileChannelProc; |
78 |
|
|
|
79 |
|
|
TCL_DECLARE_MUTEX(hookMutex) |
80 |
|
|
|
81 |
|
|
/* |
82 |
|
|
*--------------------------------------------------------------------------- |
83 |
|
|
* |
84 |
|
|
* TclGetOpenMode -- |
85 |
|
|
* |
86 |
|
|
* Description: |
87 |
|
|
* Computes a POSIX mode mask for opening a file, from a given string, |
88 |
|
|
* and also sets a flag to indicate whether the caller should seek to |
89 |
|
|
* EOF after opening the file. |
90 |
|
|
* |
91 |
|
|
* Results: |
92 |
|
|
* On success, returns mode to pass to "open". If an error occurs, the |
93 |
|
|
* return value is -1 and if interp is not NULL, sets interp's result |
94 |
|
|
* object to an error message. |
95 |
|
|
* |
96 |
|
|
* Side effects: |
97 |
|
|
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller |
98 |
|
|
* to seek to EOF after opening the file. |
99 |
|
|
* |
100 |
|
|
* Special note: |
101 |
|
|
* This code is based on a prototype implementation contributed |
102 |
|
|
* by Mark Diekhans. |
103 |
|
|
* |
104 |
|
|
*--------------------------------------------------------------------------- |
105 |
|
|
*/ |
106 |
|
|
|
107 |
|
|
int |
108 |
|
|
TclGetOpenMode(interp, string, seekFlagPtr) |
109 |
|
|
Tcl_Interp *interp; /* Interpreter to use for error |
110 |
|
|
* reporting - may be NULL. */ |
111 |
|
|
char *string; /* Mode string, e.g. "r+" or |
112 |
|
|
* "RDONLY CREAT". */ |
113 |
|
|
int *seekFlagPtr; /* Set this to 1 if the caller |
114 |
|
|
* should seek to EOF during the |
115 |
|
|
* opening of the file. */ |
116 |
|
|
{ |
117 |
|
|
int mode, modeArgc, c, i, gotRW; |
118 |
|
|
char **modeArgv, *flag; |
119 |
|
|
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) |
120 |
|
|
|
121 |
|
|
/* |
122 |
|
|
* Check for the simpler fopen-like access modes (e.g. "r"). They |
123 |
|
|
* are distinguished from the POSIX access modes by the presence |
124 |
|
|
* of a lower-case first letter. |
125 |
|
|
*/ |
126 |
|
|
|
127 |
|
|
*seekFlagPtr = 0; |
128 |
|
|
mode = 0; |
129 |
|
|
|
130 |
|
|
/* |
131 |
|
|
* Guard against international characters before using byte oriented |
132 |
|
|
* routines. |
133 |
|
|
*/ |
134 |
|
|
|
135 |
|
|
if (!(string[0] & 0x80) |
136 |
|
|
&& islower(UCHAR(string[0]))) { /* INTL: ISO only. */ |
137 |
|
|
switch (string[0]) { |
138 |
|
|
case 'r': |
139 |
|
|
mode = O_RDONLY; |
140 |
|
|
break; |
141 |
|
|
case 'w': |
142 |
|
|
mode = O_WRONLY|O_CREAT|O_TRUNC; |
143 |
|
|
break; |
144 |
|
|
case 'a': |
145 |
|
|
mode = O_WRONLY|O_CREAT; |
146 |
|
|
*seekFlagPtr = 1; |
147 |
|
|
break; |
148 |
|
|
default: |
149 |
|
|
error: |
150 |
|
|
if (interp != (Tcl_Interp *) NULL) { |
151 |
|
|
Tcl_AppendResult(interp, |
152 |
|
|
"illegal access mode \"", string, "\"", |
153 |
|
|
(char *) NULL); |
154 |
|
|
} |
155 |
|
|
return -1; |
156 |
|
|
} |
157 |
|
|
if (string[1] == '+') { |
158 |
|
|
mode &= ~(O_RDONLY|O_WRONLY); |
159 |
|
|
mode |= O_RDWR; |
160 |
|
|
if (string[2] != 0) { |
161 |
|
|
goto error; |
162 |
|
|
} |
163 |
|
|
} else if (string[1] != 0) { |
164 |
|
|
goto error; |
165 |
|
|
} |
166 |
|
|
return mode; |
167 |
|
|
} |
168 |
|
|
|
169 |
|
|
/* |
170 |
|
|
* The access modes are specified using a list of POSIX modes |
171 |
|
|
* such as O_CREAT. |
172 |
|
|
* |
173 |
|
|
* IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when |
174 |
|
|
* a NULL interpreter is passed in. |
175 |
|
|
*/ |
176 |
|
|
|
177 |
|
|
if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) { |
178 |
|
|
if (interp != (Tcl_Interp *) NULL) { |
179 |
|
|
Tcl_AddErrorInfo(interp, |
180 |
|
|
"\n while processing open access modes \""); |
181 |
|
|
Tcl_AddErrorInfo(interp, string); |
182 |
|
|
Tcl_AddErrorInfo(interp, "\""); |
183 |
|
|
} |
184 |
|
|
return -1; |
185 |
|
|
} |
186 |
|
|
|
187 |
|
|
gotRW = 0; |
188 |
|
|
for (i = 0; i < modeArgc; i++) { |
189 |
|
|
flag = modeArgv[i]; |
190 |
|
|
c = flag[0]; |
191 |
|
|
if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) { |
192 |
|
|
mode = (mode & ~RW_MODES) | O_RDONLY; |
193 |
|
|
gotRW = 1; |
194 |
|
|
} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) { |
195 |
|
|
mode = (mode & ~RW_MODES) | O_WRONLY; |
196 |
|
|
gotRW = 1; |
197 |
|
|
} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) { |
198 |
|
|
mode = (mode & ~RW_MODES) | O_RDWR; |
199 |
|
|
gotRW = 1; |
200 |
|
|
} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) { |
201 |
|
|
mode |= O_APPEND; |
202 |
|
|
*seekFlagPtr = 1; |
203 |
|
|
} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { |
204 |
|
|
mode |= O_CREAT; |
205 |
|
|
} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { |
206 |
|
|
mode |= O_EXCL; |
207 |
|
|
} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) { |
208 |
|
|
#ifdef O_NOCTTY |
209 |
|
|
mode |= O_NOCTTY; |
210 |
|
|
#else |
211 |
|
|
if (interp != (Tcl_Interp *) NULL) { |
212 |
|
|
Tcl_AppendResult(interp, "access mode \"", flag, |
213 |
|
|
"\" not supported by this system", (char *) NULL); |
214 |
|
|
} |
215 |
|
|
ckfree((char *) modeArgv); |
216 |
|
|
return -1; |
217 |
|
|
#endif |
218 |
|
|
} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { |
219 |
|
|
#if defined(O_NDELAY) || defined(O_NONBLOCK) |
220 |
|
|
# ifdef O_NONBLOCK |
221 |
|
|
mode |= O_NONBLOCK; |
222 |
|
|
# else |
223 |
|
|
mode |= O_NDELAY; |
224 |
|
|
# endif |
225 |
|
|
#else |
226 |
|
|
if (interp != (Tcl_Interp *) NULL) { |
227 |
|
|
Tcl_AppendResult(interp, "access mode \"", flag, |
228 |
|
|
"\" not supported by this system", (char *) NULL); |
229 |
|
|
} |
230 |
|
|
ckfree((char *) modeArgv); |
231 |
|
|
return -1; |
232 |
|
|
#endif |
233 |
|
|
} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { |
234 |
|
|
mode |= O_TRUNC; |
235 |
|
|
} else { |
236 |
|
|
if (interp != (Tcl_Interp *) NULL) { |
237 |
|
|
Tcl_AppendResult(interp, "invalid access mode \"", flag, |
238 |
|
|
"\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT", |
239 |
|
|
" EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL); |
240 |
|
|
} |
241 |
|
|
ckfree((char *) modeArgv); |
242 |
|
|
return -1; |
243 |
|
|
} |
244 |
|
|
} |
245 |
|
|
ckfree((char *) modeArgv); |
246 |
|
|
if (!gotRW) { |
247 |
|
|
if (interp != (Tcl_Interp *) NULL) { |
248 |
|
|
Tcl_AppendResult(interp, "access mode must include either", |
249 |
|
|
" RDONLY, WRONLY, or RDWR", (char *) NULL); |
250 |
|
|
} |
251 |
|
|
return -1; |
252 |
|
|
} |
253 |
|
|
return mode; |
254 |
|
|
} |
255 |
|
|
|
256 |
|
|
/* |
257 |
|
|
*---------------------------------------------------------------------- |
258 |
|
|
* |
259 |
|
|
* Tcl_EvalFile -- |
260 |
|
|
* |
261 |
|
|
* Read in a file and process the entire file as one gigantic |
262 |
|
|
* Tcl command. |
263 |
|
|
* |
264 |
|
|
* Results: |
265 |
|
|
* A standard Tcl result, which is either the result of executing |
266 |
|
|
* the file or an error indicating why the file couldn't be read. |
267 |
|
|
* |
268 |
|
|
* Side effects: |
269 |
|
|
* Depends on the commands in the file. |
270 |
|
|
* |
271 |
|
|
*---------------------------------------------------------------------- |
272 |
|
|
*/ |
273 |
|
|
|
274 |
|
|
int |
275 |
|
|
Tcl_EvalFile(interp, fileName) |
276 |
|
|
Tcl_Interp *interp; /* Interpreter in which to process file. */ |
277 |
|
|
char *fileName; /* Name of file to process. Tilde-substitution |
278 |
|
|
* will be performed on this name. */ |
279 |
|
|
{ |
280 |
|
|
int result, length; |
281 |
|
|
struct stat statBuf; |
282 |
|
|
char *oldScriptFile; |
283 |
|
|
Interp *iPtr; |
284 |
|
|
Tcl_DString nameString; |
285 |
|
|
char *name, *string; |
286 |
|
|
Tcl_Channel chan; |
287 |
|
|
Tcl_Obj *objPtr; |
288 |
|
|
|
289 |
|
|
name = Tcl_TranslateFileName(interp, fileName, &nameString); |
290 |
|
|
if (name == NULL) { |
291 |
|
|
return TCL_ERROR; |
292 |
|
|
} |
293 |
|
|
|
294 |
|
|
result = TCL_ERROR; |
295 |
|
|
objPtr = Tcl_NewObj(); |
296 |
|
|
|
297 |
|
|
if (TclStat(name, &statBuf) == -1) { |
298 |
|
|
Tcl_SetErrno(errno); |
299 |
|
|
Tcl_AppendResult(interp, "couldn't read file \"", fileName, |
300 |
|
|
"\": ", Tcl_PosixError(interp), (char *) NULL); |
301 |
|
|
goto end; |
302 |
|
|
} |
303 |
|
|
chan = Tcl_OpenFileChannel(interp, name, "r", 0644); |
304 |
|
|
if (chan == (Tcl_Channel) NULL) { |
305 |
|
|
Tcl_ResetResult(interp); |
306 |
|
|
Tcl_AppendResult(interp, "couldn't read file \"", fileName, |
307 |
|
|
"\": ", Tcl_PosixError(interp), (char *) NULL); |
308 |
|
|
goto end; |
309 |
|
|
} |
310 |
|
|
if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) { |
311 |
|
|
Tcl_Close(interp, chan); |
312 |
|
|
Tcl_AppendResult(interp, "couldn't read file \"", fileName, |
313 |
|
|
"\": ", Tcl_PosixError(interp), (char *) NULL); |
314 |
|
|
goto end; |
315 |
|
|
} |
316 |
|
|
if (Tcl_Close(interp, chan) != TCL_OK) { |
317 |
|
|
goto end; |
318 |
|
|
} |
319 |
|
|
|
320 |
|
|
iPtr = (Interp *) interp; |
321 |
|
|
oldScriptFile = iPtr->scriptFile; |
322 |
|
|
iPtr->scriptFile = fileName; |
323 |
|
|
string = Tcl_GetStringFromObj(objPtr, &length); |
324 |
|
|
result = Tcl_EvalEx(interp, string, length, 0); |
325 |
|
|
iPtr->scriptFile = oldScriptFile; |
326 |
|
|
|
327 |
|
|
if (result == TCL_RETURN) { |
328 |
|
|
result = TclUpdateReturnInfo(iPtr); |
329 |
|
|
} else if (result == TCL_ERROR) { |
330 |
|
|
char msg[200 + TCL_INTEGER_SPACE]; |
331 |
|
|
|
332 |
|
|
/* |
333 |
|
|
* Record information telling where the error occurred. |
334 |
|
|
*/ |
335 |
|
|
|
336 |
|
|
sprintf(msg, "\n (file \"%.150s\" line %d)", fileName, |
337 |
|
|
interp->errorLine); |
338 |
|
|
Tcl_AddErrorInfo(interp, msg); |
339 |
|
|
} |
340 |
|
|
|
341 |
|
|
end: |
342 |
|
|
Tcl_DecrRefCount(objPtr); |
343 |
|
|
Tcl_DStringFree(&nameString); |
344 |
|
|
return result; |
345 |
|
|
} |
346 |
|
|
|
347 |
|
|
/* |
348 |
|
|
*---------------------------------------------------------------------- |
349 |
|
|
* |
350 |
|
|
* Tcl_GetErrno -- |
351 |
|
|
* |
352 |
|
|
* Gets the current value of the Tcl error code variable. This is |
353 |
|
|
* currently the global variable "errno" but could in the future |
354 |
|
|
* change to something else. |
355 |
|
|
* |
356 |
|
|
* Results: |
357 |
|
|
* The value of the Tcl error code variable. |
358 |
|
|
* |
359 |
|
|
* Side effects: |
360 |
|
|
* None. Note that the value of the Tcl error code variable is |
361 |
|
|
* UNDEFINED if a call to Tcl_SetErrno did not precede this call. |
362 |
|
|
* |
363 |
|
|
*---------------------------------------------------------------------- |
364 |
|
|
*/ |
365 |
|
|
|
366 |
|
|
int |
367 |
|
|
Tcl_GetErrno() |
368 |
|
|
{ |
369 |
|
|
return errno; |
370 |
|
|
} |
371 |
|
|
|
372 |
|
|
/* |
373 |
|
|
*---------------------------------------------------------------------- |
374 |
|
|
* |
375 |
|
|
* Tcl_SetErrno -- |
376 |
|
|
* |
377 |
|
|
* Sets the Tcl error code variable to the supplied value. |
378 |
|
|
* |
379 |
|
|
* Results: |
380 |
|
|
* None. |
381 |
|
|
* |
382 |
|
|
* Side effects: |
383 |
|
|
* Modifies the value of the Tcl error code variable. |
384 |
|
|
* |
385 |
|
|
*---------------------------------------------------------------------- |
386 |
|
|
*/ |
387 |
|
|
|
388 |
|
|
void |
389 |
|
|
Tcl_SetErrno(err) |
390 |
|
|
int err; /* The new value. */ |
391 |
|
|
{ |
392 |
|
|
errno = err; |
393 |
|
|
} |
394 |
|
|
|
395 |
|
|
/* |
396 |
|
|
*---------------------------------------------------------------------- |
397 |
|
|
* |
398 |
|
|
* Tcl_PosixError -- |
399 |
|
|
* |
400 |
|
|
* This procedure is typically called after UNIX kernel calls |
401 |
|
|
* return errors. It stores machine-readable information about |
402 |
|
|
* the error in $errorCode returns an information string for |
403 |
|
|
* the caller's use. |
404 |
|
|
* |
405 |
|
|
* Results: |
406 |
|
|
* The return value is a human-readable string describing the |
407 |
|
|
* error. |
408 |
|
|
* |
409 |
|
|
* Side effects: |
410 |
|
|
* The global variable $errorCode is reset. |
411 |
|
|
* |
412 |
|
|
*---------------------------------------------------------------------- |
413 |
|
|
*/ |
414 |
|
|
|
415 |
|
|
char * |
416 |
|
|
Tcl_PosixError(interp) |
417 |
|
|
Tcl_Interp *interp; /* Interpreter whose $errorCode variable |
418 |
|
|
* is to be changed. */ |
419 |
|
|
{ |
420 |
|
|
char *id, *msg; |
421 |
|
|
|
422 |
|
|
msg = Tcl_ErrnoMsg(errno); |
423 |
|
|
id = Tcl_ErrnoId(); |
424 |
|
|
Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL); |
425 |
|
|
return msg; |
426 |
|
|
} |
427 |
|
|
|
428 |
|
|
/* |
429 |
|
|
*---------------------------------------------------------------------- |
430 |
|
|
* |
431 |
|
|
* TclStat -- |
432 |
|
|
* |
433 |
|
|
* This procedure replaces the library version of stat and lsat. |
434 |
|
|
* The chain of functions that have been "inserted" into the |
435 |
|
|
* 'statProcList' will be called in succession until either |
436 |
|
|
* a value of zero is returned, or the entire list is visited. |
437 |
|
|
* |
438 |
|
|
* Results: |
439 |
|
|
* See stat documentation. |
440 |
|
|
* |
441 |
|
|
* Side effects: |
442 |
|
|
* See stat documentation. |
443 |
|
|
* |
444 |
|
|
*---------------------------------------------------------------------- |
445 |
|
|
*/ |
446 |
|
|
|
447 |
|
|
int |
448 |
|
|
TclStat(path, buf) |
449 |
|
|
CONST char *path; /* Path of file to stat (in current CP). */ |
450 |
|
|
struct stat *buf; /* Filled with results of stat call. */ |
451 |
|
|
{ |
452 |
|
|
StatProc *statProcPtr; |
453 |
|
|
int retVal = -1; |
454 |
|
|
|
455 |
|
|
/* |
456 |
|
|
* Call each of the "stat" function in succession. A non-return |
457 |
|
|
* value of -1 indicates the particular function has succeeded. |
458 |
|
|
*/ |
459 |
|
|
|
460 |
|
|
Tcl_MutexLock(&hookMutex); |
461 |
|
|
statProcPtr = statProcList; |
462 |
|
|
while ((retVal == -1) && (statProcPtr != NULL)) { |
463 |
|
|
retVal = (*statProcPtr->proc)(path, buf); |
464 |
|
|
statProcPtr = statProcPtr->nextPtr; |
465 |
|
|
} |
466 |
|
|
Tcl_MutexUnlock(&hookMutex); |
467 |
|
|
|
468 |
|
|
return (retVal); |
469 |
|
|
} |
470 |
|
|
|
471 |
|
|
/* |
472 |
|
|
*---------------------------------------------------------------------- |
473 |
|
|
* |
474 |
|
|
* TclAccess -- |
475 |
|
|
* |
476 |
|
|
* This procedure replaces the library version of access. |
477 |
|
|
* The chain of functions that have been "inserted" into the |
478 |
|
|
* 'accessProcList' will be called in succession until either |
479 |
|
|
* a value of zero is returned, or the entire list is visited. |
480 |
|
|
* |
481 |
|
|
* Results: |
482 |
|
|
* See access documentation. |
483 |
|
|
* |
484 |
|
|
* Side effects: |
485 |
|
|
* See access documentation. |
486 |
|
|
* |
487 |
|
|
*---------------------------------------------------------------------- |
488 |
|
|
*/ |
489 |
|
|
|
490 |
|
|
int |
491 |
|
|
TclAccess(path, mode) |
492 |
|
|
CONST char *path; /* Path of file to access (in current CP). */ |
493 |
|
|
int mode; /* Permission setting. */ |
494 |
|
|
{ |
495 |
|
|
AccessProc *accessProcPtr; |
496 |
|
|
int retVal = -1; |
497 |
|
|
|
498 |
|
|
/* |
499 |
|
|
* Call each of the "access" function in succession. A non-return |
500 |
|
|
* value of -1 indicates the particular function has succeeded. |
501 |
|
|
*/ |
502 |
|
|
|
503 |
|
|
Tcl_MutexLock(&hookMutex); |
504 |
|
|
accessProcPtr = accessProcList; |
505 |
|
|
while ((retVal == -1) && (accessProcPtr != NULL)) { |
506 |
|
|
retVal = (*accessProcPtr->proc)(path, mode); |
507 |
|
|
accessProcPtr = accessProcPtr->nextPtr; |
508 |
|
|
} |
509 |
|
|
Tcl_MutexUnlock(&hookMutex); |
510 |
|
|
|
511 |
|
|
return (retVal); |
512 |
|
|
} |
513 |
|
|
|
514 |
|
|
/* |
515 |
|
|
*---------------------------------------------------------------------- |
516 |
|
|
* |
517 |
|
|
* Tcl_OpenFileChannel -- |
518 |
|
|
* |
519 |
|
|
* The chain of functions that have been "inserted" into the |
520 |
|
|
* 'openFileChannelProcList' will be called in succession until |
521 |
|
|
* either a valid file channel is returned, or the entire list is |
522 |
|
|
* visited. |
523 |
|
|
* |
524 |
|
|
* Results: |
525 |
|
|
* The new channel or NULL, if the named file could not be opened. |
526 |
|
|
* |
527 |
|
|
* Side effects: |
528 |
|
|
* May open the channel and may cause creation of a file on the |
529 |
|
|
* file system. |
530 |
|
|
* |
531 |
|
|
*---------------------------------------------------------------------- |
532 |
|
|
*/ |
533 |
|
|
|
534 |
|
|
Tcl_Channel |
535 |
|
|
Tcl_OpenFileChannel(interp, fileName, modeString, permissions) |
536 |
|
|
Tcl_Interp *interp; /* Interpreter for error reporting; |
537 |
|
|
* can be NULL. */ |
538 |
|
|
char *fileName; /* Name of file to open. */ |
539 |
|
|
char *modeString; /* A list of POSIX open modes or |
540 |
|
|
* a string such as "rw". */ |
541 |
|
|
int permissions; /* If the open involves creating a |
542 |
|
|
* file, with what modes to create |
543 |
|
|
* it? */ |
544 |
|
|
{ |
545 |
|
|
OpenFileChannelProc *openFileChannelProcPtr; |
546 |
|
|
Tcl_Channel retVal = NULL; |
547 |
|
|
|
548 |
|
|
/* |
549 |
|
|
* Call each of the "Tcl_OpenFileChannel" function in succession. |
550 |
|
|
* A non-NULL return value indicates the particular function has |
551 |
|
|
* succeeded. |
552 |
|
|
*/ |
553 |
|
|
|
554 |
|
|
Tcl_MutexLock(&hookMutex); |
555 |
|
|
openFileChannelProcPtr = openFileChannelProcList; |
556 |
|
|
while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) { |
557 |
|
|
retVal = (*openFileChannelProcPtr->proc)(interp, fileName, |
558 |
|
|
modeString, permissions); |
559 |
|
|
openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; |
560 |
|
|
} |
561 |
|
|
Tcl_MutexUnlock(&hookMutex); |
562 |
|
|
|
563 |
|
|
return (retVal); |
564 |
|
|
} |
565 |
|
|
|
566 |
|
|
/* |
567 |
|
|
*---------------------------------------------------------------------- |
568 |
|
|
* |
569 |
|
|
* TclStatInsertProc -- |
570 |
|
|
* |
571 |
|
|
* Insert the passed procedure pointer at the head of the list of |
572 |
|
|
* functions which are used during a call to 'TclStat(...)'. The |
573 |
|
|
* passed function should be have exactly like 'TclStat' when called |
574 |
|
|
* during that time (see 'TclStat(...)' for more informatin). |
575 |
|
|
* The function will be added even if it already in the list. |
576 |
|
|
* |
577 |
|
|
* Results: |
578 |
|
|
* Normally TCL_OK; TCL_ERROR if memory for a new node in the list |
579 |
|
|
* could not be allocated. |
580 |
|
|
* |
581 |
|
|
* Side effects: |
582 |
|
|
* Memory allocataed and modifies the link list for 'TclStat' |
583 |
|
|
* functions. |
584 |
|
|
* |
585 |
|
|
*---------------------------------------------------------------------- |
586 |
|
|
*/ |
587 |
|
|
|
588 |
|
|
int |
589 |
|
|
TclStatInsertProc (proc) |
590 |
|
|
TclStatProc_ *proc; |
591 |
|
|
{ |
592 |
|
|
int retVal = TCL_ERROR; |
593 |
|
|
|
594 |
|
|
if (proc != NULL) { |
595 |
|
|
StatProc *newStatProcPtr; |
596 |
|
|
|
597 |
|
|
newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc)); |
598 |
|
|
|
599 |
|
|
if (newStatProcPtr != NULL) { |
600 |
|
|
newStatProcPtr->proc = proc; |
601 |
|
|
Tcl_MutexLock(&hookMutex); |
602 |
|
|
newStatProcPtr->nextPtr = statProcList; |
603 |
|
|
statProcList = newStatProcPtr; |
604 |
|
|
Tcl_MutexUnlock(&hookMutex); |
605 |
|
|
|
606 |
|
|
retVal = TCL_OK; |
607 |
|
|
} |
608 |
|
|
} |
609 |
|
|
|
610 |
|
|
return (retVal); |
611 |
|
|
} |
612 |
|
|
|
613 |
|
|
/* |
614 |
|
|
*---------------------------------------------------------------------- |
615 |
|
|
* |
616 |
|
|
* TclStatDeleteProc -- |
617 |
|
|
* |
618 |
|
|
* Removed the passed function pointer from the list of 'TclStat' |
619 |
|
|
* functions. Ensures that the built-in stat function is not |
620 |
|
|
* removvable. |
621 |
|
|
* |
622 |
|
|
* Results: |
623 |
|
|
* TCL_OK if the procedure pointer was successfully removed, |
624 |
|
|
* TCL_ERROR otherwise. |
625 |
|
|
* |
626 |
|
|
* Side effects: |
627 |
|
|
* Memory is deallocated and the respective list updated. |
628 |
|
|
* |
629 |
|
|
*---------------------------------------------------------------------- |
630 |
|
|
*/ |
631 |
|
|
|
632 |
|
|
int |
633 |
|
|
TclStatDeleteProc (proc) |
634 |
|
|
TclStatProc_ *proc; |
635 |
|
|
{ |
636 |
|
|
int retVal = TCL_ERROR; |
637 |
|
|
StatProc *tmpStatProcPtr; |
638 |
|
|
StatProc *prevStatProcPtr = NULL; |
639 |
|
|
|
640 |
|
|
Tcl_MutexLock(&hookMutex); |
641 |
|
|
tmpStatProcPtr = statProcList; |
642 |
|
|
/* |
643 |
|
|
* Traverse the 'statProcList' looking for the particular node |
644 |
|
|
* whose 'proc' member matches 'proc' and remove that one from |
645 |
|
|
* the list. Ensure that the "default" node cannot be removed. |
646 |
|
|
*/ |
647 |
|
|
|
648 |
|
|
while ((retVal == TCL_ERROR) && (tmpStatProcPtr != &defaultStatProc)) { |
649 |
|
|
if (tmpStatProcPtr->proc == proc) { |
650 |
|
|
if (prevStatProcPtr == NULL) { |
651 |
|
|
statProcList = tmpStatProcPtr->nextPtr; |
652 |
|
|
} else { |
653 |
|
|
prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr; |
654 |
|
|
} |
655 |
|
|
|
656 |
|
|
Tcl_Free((char *)tmpStatProcPtr); |
657 |
|
|
|
658 |
|
|
retVal = TCL_OK; |
659 |
|
|
} else { |
660 |
|
|
prevStatProcPtr = tmpStatProcPtr; |
661 |
|
|
tmpStatProcPtr = tmpStatProcPtr->nextPtr; |
662 |
|
|
} |
663 |
|
|
} |
664 |
|
|
|
665 |
|
|
Tcl_MutexUnlock(&hookMutex); |
666 |
|
|
return (retVal); |
667 |
|
|
} |
668 |
|
|
|
669 |
|
|
/* |
670 |
|
|
*---------------------------------------------------------------------- |
671 |
|
|
* |
672 |
|
|
* TclAccessInsertProc -- |
673 |
|
|
* |
674 |
|
|
* Insert the passed procedure pointer at the head of the list of |
675 |
|
|
* functions which are used during a call to 'TclAccess(...)'. The |
676 |
|
|
* passed function should be have exactly like 'TclAccess' when |
677 |
|
|
* called during that time (see 'TclAccess(...)' for more informatin). |
678 |
|
|
* The function will be added even if it already in the list. |
679 |
|
|
* |
680 |
|
|
* Results: |
681 |
|
|
* Normally TCL_OK; TCL_ERROR if memory for a new node in the list |
682 |
|
|
* could not be allocated. |
683 |
|
|
* |
684 |
|
|
* Side effects: |
685 |
|
|
* Memory allocataed and modifies the link list for 'TclAccess' |
686 |
|
|
* functions. |
687 |
|
|
* |
688 |
|
|
*---------------------------------------------------------------------- |
689 |
|
|
*/ |
690 |
|
|
|
691 |
|
|
int |
692 |
|
|
TclAccessInsertProc(proc) |
693 |
|
|
TclAccessProc_ *proc; |
694 |
|
|
{ |
695 |
|
|
int retVal = TCL_ERROR; |
696 |
|
|
|
697 |
|
|
if (proc != NULL) { |
698 |
|
|
AccessProc *newAccessProcPtr; |
699 |
|
|
|
700 |
|
|
newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc)); |
701 |
|
|
|
702 |
|
|
if (newAccessProcPtr != NULL) { |
703 |
|
|
newAccessProcPtr->proc = proc; |
704 |
|
|
Tcl_MutexLock(&hookMutex); |
705 |
|
|
newAccessProcPtr->nextPtr = accessProcList; |
706 |
|
|
accessProcList = newAccessProcPtr; |
707 |
|
|
Tcl_MutexUnlock(&hookMutex); |
708 |
|
|
|
709 |
|
|
retVal = TCL_OK; |
710 |
|
|
} |
711 |
|
|
} |
712 |
|
|
|
713 |
|
|
return (retVal); |
714 |
|
|
} |
715 |
|
|
|
716 |
|
|
/* |
717 |
|
|
*---------------------------------------------------------------------- |
718 |
|
|
* |
719 |
|
|
* TclAccessDeleteProc -- |
720 |
|
|
* |
721 |
|
|
* Removed the passed function pointer from the list of 'TclAccess' |
722 |
|
|
* functions. Ensures that the built-in access function is not |
723 |
|
|
* removvable. |
724 |
|
|
* |
725 |
|
|
* Results: |
726 |
|
|
* TCL_OK if the procedure pointer was successfully removed, |
727 |
|
|
* TCL_ERROR otherwise. |
728 |
|
|
* |
729 |
|
|
* Side effects: |
730 |
|
|
* Memory is deallocated and the respective list updated. |
731 |
|
|
* |
732 |
|
|
*---------------------------------------------------------------------- |
733 |
|
|
*/ |
734 |
|
|
|
735 |
|
|
int |
736 |
|
|
TclAccessDeleteProc(proc) |
737 |
|
|
TclAccessProc_ *proc; |
738 |
|
|
{ |
739 |
|
|
int retVal = TCL_ERROR; |
740 |
|
|
AccessProc *tmpAccessProcPtr; |
741 |
|
|
AccessProc *prevAccessProcPtr = NULL; |
742 |
|
|
|
743 |
|
|
/* |
744 |
|
|
* Traverse the 'accessProcList' looking for the particular node |
745 |
|
|
* whose 'proc' member matches 'proc' and remove that one from |
746 |
|
|
* the list. Ensure that the "default" node cannot be removed. |
747 |
|
|
*/ |
748 |
|
|
|
749 |
|
|
Tcl_MutexLock(&hookMutex); |
750 |
|
|
tmpAccessProcPtr = accessProcList; |
751 |
|
|
while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != &defaultAccessProc)) { |
752 |
|
|
if (tmpAccessProcPtr->proc == proc) { |
753 |
|
|
if (prevAccessProcPtr == NULL) { |
754 |
|
|
accessProcList = tmpAccessProcPtr->nextPtr; |
755 |
|
|
} else { |
756 |
|
|
prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr; |
757 |
|
|
} |
758 |
|
|
|
759 |
|
|
Tcl_Free((char *)tmpAccessProcPtr); |
760 |
|
|
|
761 |
|
|
retVal = TCL_OK; |
762 |
|
|
} else { |
763 |
|
|
prevAccessProcPtr = tmpAccessProcPtr; |
764 |
|
|
tmpAccessProcPtr = tmpAccessProcPtr->nextPtr; |
765 |
|
|
} |
766 |
|
|
} |
767 |
|
|
Tcl_MutexUnlock(&hookMutex); |
768 |
|
|
|
769 |
|
|
return (retVal); |
770 |
|
|
} |
771 |
|
|
|
772 |
|
|
/* |
773 |
|
|
*---------------------------------------------------------------------- |
774 |
|
|
* |
775 |
|
|
* TclOpenFileChannelInsertProc -- |
776 |
|
|
* |
777 |
|
|
* Insert the passed procedure pointer at the head of the list of |
778 |
|
|
* functions which are used during a call to |
779 |
|
|
* 'Tcl_OpenFileChannel(...)'. The passed function should be have |
780 |
|
|
* exactly like 'Tcl_OpenFileChannel' when called during that time |
781 |
|
|
* (see 'Tcl_OpenFileChannel(...)' for more informatin). The |
782 |
|
|
* function will be added even if it already in the list. |
783 |
|
|
* |
784 |
|
|
* Results: |
785 |
|
|
* Normally TCL_OK; TCL_ERROR if memory for a new node in the list |
786 |
|
|
* could not be allocated. |
787 |
|
|
* |
788 |
|
|
* Side effects: |
789 |
|
|
* Memory allocataed and modifies the link list for |
790 |
|
|
* 'Tcl_OpenFileChannel' functions. |
791 |
|
|
* |
792 |
|
|
*---------------------------------------------------------------------- |
793 |
|
|
*/ |
794 |
|
|
|
795 |
|
|
int |
796 |
|
|
TclOpenFileChannelInsertProc(proc) |
797 |
|
|
TclOpenFileChannelProc_ *proc; |
798 |
|
|
{ |
799 |
|
|
int retVal = TCL_ERROR; |
800 |
|
|
|
801 |
|
|
if (proc != NULL) { |
802 |
|
|
OpenFileChannelProc *newOpenFileChannelProcPtr; |
803 |
|
|
|
804 |
|
|
newOpenFileChannelProcPtr = |
805 |
|
|
(OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc)); |
806 |
|
|
|
807 |
|
|
if (newOpenFileChannelProcPtr != NULL) { |
808 |
|
|
newOpenFileChannelProcPtr->proc = proc; |
809 |
|
|
Tcl_MutexLock(&hookMutex); |
810 |
|
|
newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList; |
811 |
|
|
openFileChannelProcList = newOpenFileChannelProcPtr; |
812 |
|
|
Tcl_MutexUnlock(&hookMutex); |
813 |
|
|
|
814 |
|
|
retVal = TCL_OK; |
815 |
|
|
} |
816 |
|
|
} |
817 |
|
|
|
818 |
|
|
return (retVal); |
819 |
|
|
} |
820 |
|
|
|
821 |
|
|
/* |
822 |
|
|
*---------------------------------------------------------------------- |
823 |
|
|
* |
824 |
|
|
* TclOpenFileChannelDeleteProc -- |
825 |
|
|
* |
826 |
|
|
* Removed the passed function pointer from the list of |
827 |
|
|
* 'Tcl_OpenFileChannel' functions. Ensures that the built-in |
828 |
|
|
* open file channel function is not removvable. |
829 |
|
|
* |
830 |
|
|
* Results: |
831 |
|
|
* TCL_OK if the procedure pointer was successfully removed, |
832 |
|
|
* TCL_ERROR otherwise. |
833 |
|
|
* |
834 |
|
|
* Side effects: |
835 |
|
|
* Memory is deallocated and the respective list updated. |
836 |
|
|
* |
837 |
|
|
*---------------------------------------------------------------------- |
838 |
|
|
*/ |
839 |
|
|
|
840 |
|
|
int |
841 |
|
|
TclOpenFileChannelDeleteProc(proc) |
842 |
|
|
TclOpenFileChannelProc_ *proc; |
843 |
|
|
{ |
844 |
|
|
int retVal = TCL_ERROR; |
845 |
|
|
OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList; |
846 |
|
|
OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL; |
847 |
|
|
|
848 |
|
|
/* |
849 |
|
|
* Traverse the 'openFileChannelProcList' looking for the particular |
850 |
|
|
* node whose 'proc' member matches 'proc' and remove that one from |
851 |
|
|
* the list. Ensure that the "default" node cannot be removed. |
852 |
|
|
*/ |
853 |
|
|
|
854 |
|
|
Tcl_MutexLock(&hookMutex); |
855 |
|
|
tmpOpenFileChannelProcPtr = openFileChannelProcList; |
856 |
|
|
while ((retVal == TCL_ERROR) && |
857 |
|
|
(tmpOpenFileChannelProcPtr != &defaultOpenFileChannelProc)) { |
858 |
|
|
if (tmpOpenFileChannelProcPtr->proc == proc) { |
859 |
|
|
if (prevOpenFileChannelProcPtr == NULL) { |
860 |
|
|
openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr; |
861 |
|
|
} else { |
862 |
|
|
prevOpenFileChannelProcPtr->nextPtr = |
863 |
|
|
tmpOpenFileChannelProcPtr->nextPtr; |
864 |
|
|
} |
865 |
|
|
|
866 |
|
|
Tcl_Free((char *)tmpOpenFileChannelProcPtr); |
867 |
|
|
|
868 |
|
|
retVal = TCL_OK; |
869 |
|
|
} else { |
870 |
|
|
prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr; |
871 |
|
|
tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr; |
872 |
|
|
} |
873 |
|
|
} |
874 |
|
|
Tcl_MutexUnlock(&hookMutex); |
875 |
|
|
|
876 |
|
|
return (retVal); |
877 |
|
|
} |
878 |
|
|
|
879 |
|
|
/* End of tclioutil.c */ |