]>
Commit | Line | Data |
---|---|---|
6a5fa4e0 MG |
1 | /* |
2 | * tclXdup.c | |
3 | * | |
4 | * Extended Tcl dup 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: tclXdup.c,v 2.0 1992/10/16 04:50:36 markd Rel $ | |
16 | *----------------------------------------------------------------------------- | |
17 | */ | |
18 | ||
19 | #include "tclxint.h" | |
20 | ||
21 | /* | |
22 | * Prototypes of internal functions. | |
23 | */ | |
24 | static OpenFile * | |
25 | DoNormalDup _ANSI_ARGS_((Tcl_Interp *interp, | |
26 | OpenFile *oldFilePtr)); | |
27 | ||
28 | static OpenFile * | |
29 | DoSpecialDup _ANSI_ARGS_((Tcl_Interp *interp, | |
30 | OpenFile *oldFilePtr, | |
31 | char *newHandleName)); | |
32 | ||
33 | \f | |
34 | /* | |
35 | *----------------------------------------------------------------------------- | |
36 | * | |
37 | * DoNormalDup -- | |
38 | * Process a normal dup command (i.e. the new file is not specified). | |
39 | * | |
40 | * Parameters: | |
41 | * o interp (I) - If an error occures, the error message is in result, | |
42 | * otherwise the file handle is in result. | |
43 | * o oldFilePtr (I) - Tcl file control block for the file to dup. | |
44 | * Returns: | |
45 | * A pointer to the open file structure for the new file, or NULL if an | |
46 | * error occured. | |
47 | *----------------------------------------------------------------------------- | |
48 | */ | |
49 | static OpenFile * | |
50 | DoNormalDup (interp, oldFilePtr) | |
51 | Tcl_Interp *interp; | |
52 | OpenFile *oldFilePtr; | |
53 | { | |
54 | Interp *iPtr = (Interp *) interp; | |
55 | int newFileId; | |
56 | FILE *newFileCbPtr; | |
57 | char *mode; | |
58 | ||
59 | newFileId = dup (fileno (oldFilePtr->f)); | |
60 | if (newFileId < 0) | |
61 | goto unixError; | |
62 | ||
63 | if (Tcl_SetupFileEntry (interp, newFileId, | |
64 | oldFilePtr->readable, | |
65 | oldFilePtr->writable) != TCL_OK) | |
66 | return NULL; | |
67 | ||
68 | sprintf (interp->result, "file%d", newFileId); | |
69 | return iPtr->filePtrArray [newFileId]; | |
70 | ||
71 | unixError: | |
72 | interp->result = Tcl_UnixError (interp); | |
73 | return NULL;; | |
74 | } | |
75 | \f | |
76 | /* | |
77 | *----------------------------------------------------------------------------- | |
78 | * | |
79 | * DoSpecialDup -- | |
80 | * Process a special dup command. This is the case were the file is | |
81 | * dup-ed to stdin, stdout or stderr. The new file may or be open or | |
82 | * closed | |
83 | * Parameters: | |
84 | * o interp (I) - If an error occures, the error message is in result, | |
85 | * otherwise nothing is returned. | |
86 | * o oldFilePtr (I) - Tcl file control block for the file to dup. | |
87 | * o newFileHandle (I) - The handle name for the new file. | |
88 | * Returns: | |
89 | * A pointer to the open file structure for the new file, or NULL if an | |
90 | * error occured. | |
91 | *----------------------------------------------------------------------------- | |
92 | */ | |
93 | static OpenFile * | |
94 | DoSpecialDup (interp, oldFilePtr, newHandleName) | |
95 | Tcl_Interp *interp; | |
96 | OpenFile *oldFilePtr; | |
97 | char *newHandleName; | |
98 | { | |
99 | Interp *iPtr = (Interp *) interp; | |
100 | int newFileId; | |
101 | FILE *newFileCbPtr; | |
102 | OpenFile *newFilePtr; | |
103 | ||
104 | /* | |
105 | * Duplicate the old file to the specified file id. | |
106 | */ | |
107 | newFileId = Tcl_ConvertFileHandle (interp, newHandleName); | |
108 | if (newFileId < 0) | |
109 | return NULL; | |
110 | if (newFileId > 2) { | |
111 | Tcl_AppendResult (interp, "target handle must be one of stdin, ", | |
112 | "stdout, stderr, file0, file1, or file2: got \"", | |
113 | newHandleName, "\"", (char *) NULL); | |
114 | return NULL; | |
115 | } | |
116 | switch (newFileId) { | |
117 | case 0: | |
118 | newFileCbPtr = stdin; | |
119 | break; | |
120 | case 1: | |
121 | newFileCbPtr = stdout; | |
122 | break; | |
123 | case 2: | |
124 | newFileCbPtr = stderr; | |
125 | break; | |
126 | } | |
127 | ||
128 | /* | |
129 | * If the specified id is not open, set up a stdio file descriptor. | |
130 | */ | |
131 | TclMakeFileTable (iPtr, newFileId); | |
132 | if (iPtr->filePtrArray [newFileId] == NULL) { | |
133 | char *mode; | |
134 | ||
135 | /* | |
136 | * Set up a stdio FILE control block for the new file. | |
137 | */ | |
138 | if (oldFilePtr->readable && oldFilePtr->writable) { | |
139 | mode = "r+"; | |
140 | } else if (oldFilePtr->writable) { | |
141 | mode = "w"; | |
142 | } else { | |
143 | mode = "r"; | |
144 | } | |
145 | if (freopen ("/dev/null", mode, newFileCbPtr) == NULL) | |
146 | goto unixError; | |
147 | } | |
148 | ||
149 | /* | |
150 | * This functionallity may be obtained with dup2 on most systems. Being | |
151 | * open is optional. | |
152 | */ | |
153 | close (newFileId); | |
154 | #ifndef MSDOS | |
155 | if (fcntl (fileno (oldFilePtr->f), F_DUPFD, newFileId) < 0) | |
156 | goto unixError; | |
157 | #endif | |
158 | /* | |
159 | * Set up a Tcl OpenFile structure for the new file handle. | |
160 | */ | |
161 | newFilePtr = iPtr->filePtrArray [fileno (newFileCbPtr)]; | |
162 | if (newFilePtr == NULL) { | |
163 | newFilePtr = (OpenFile*) ckalloc (sizeof (OpenFile)); | |
164 | iPtr->filePtrArray [fileno (newFileCbPtr)] = newFilePtr; | |
165 | } | |
166 | newFilePtr->f = newFileCbPtr; | |
167 | newFilePtr->f2 = NULL; | |
168 | newFilePtr->readable = oldFilePtr->readable; | |
169 | newFilePtr->writable = oldFilePtr->writable; | |
170 | newFilePtr->numPids = 0; | |
171 | newFilePtr->pidPtr = NULL; | |
172 | newFilePtr->errorId = -1; | |
173 | ||
174 | return newFilePtr; | |
175 | ||
176 | unixError: | |
177 | iPtr->result = Tcl_UnixError (interp); | |
178 | return NULL; | |
179 | } | |
180 | \f | |
181 | /* | |
182 | *----------------------------------------------------------------------------- | |
183 | * | |
184 | * Tcl_DupCmd -- | |
185 | * Implements the dup TCL command: | |
186 | * dup filehandle [stdhandle] | |
187 | * | |
188 | * Results: | |
189 | * Returns TCL_OK and interp->result containing a filehandle | |
190 | * if the requested file or pipe was successfully duplicated. | |
191 | * | |
192 | * Return TCL_ERROR and interp->result containing an | |
193 | * explanation of what went wrong if an error occured. | |
194 | * | |
195 | * Side effects: | |
196 | * Locates and creates an entry in the handles table | |
197 | * | |
198 | *----------------------------------------------------------------------------- | |
199 | */ | |
200 | int | |
201 | Tcl_DupCmd (clientData, interp, argc, argv) | |
202 | ClientData clientData; | |
203 | Tcl_Interp *interp; | |
204 | int argc; | |
205 | char **argv; | |
206 | { | |
207 | OpenFile *oldFilePtr, *newFilePtr; | |
208 | long seekOffset = -1; | |
209 | ||
210 | if ((argc < 2) || (argc > 3)) { | |
211 | Tcl_AppendResult (interp, tclXWrongArgs, argv[0], | |
212 | " filehandle [stdhandle]", (char *) NULL); | |
213 | return TCL_ERROR; | |
214 | } | |
215 | ||
216 | if (TclGetOpenFile(interp, argv[1], &oldFilePtr) != TCL_OK) | |
217 | return TCL_ERROR; | |
218 | if (oldFilePtr->numPids > 0) { /*??????*/ | |
219 | Tcl_AppendResult (interp, "can not `dup' a pipeline", (char *) NULL); | |
220 | return TCL_ERROR; | |
221 | } | |
222 | ||
223 | /* | |
224 | * If writable, flush out the buffer. If readable, remember were we are | |
225 | * so the we can set it up for the next stdio read to come from the same | |
226 | * place. The location is only recorded if the file is a reqular file, | |
227 | * since you cann't seek on other types of files. | |
228 | */ | |
229 | if (oldFilePtr->writable) { | |
230 | if (fflush (oldFilePtr->f) != 0) | |
231 | goto unixError; | |
232 | } | |
233 | if (oldFilePtr->readable) { | |
234 | struct stat statBuf; | |
235 | ||
236 | if (fstat (fileno (oldFilePtr->f), &statBuf) < 0) | |
237 | goto unixError; | |
238 | if ((statBuf.st_mode & S_IFMT) == S_IFREG) { | |
239 | seekOffset = ftell (oldFilePtr->f); | |
240 | if (seekOffset < 0) | |
241 | goto unixError; | |
242 | } | |
243 | } | |
244 | ||
245 | /* | |
246 | * Process the dup depending on if dup-ing to a new file or a target | |
247 | * file handle. | |
248 | */ | |
249 | if (argc == 2) | |
250 | newFilePtr = DoNormalDup (interp, oldFilePtr); | |
251 | else | |
252 | newFilePtr = DoSpecialDup (interp, oldFilePtr, argv [2]); | |
253 | ||
254 | if (newFilePtr == NULL) | |
255 | return TCL_ERROR; | |
256 | ||
257 | if (seekOffset >= 0) { | |
258 | if (fseek (newFilePtr->f, seekOffset, SEEK_SET) != 0) | |
259 | goto unixError; | |
260 | } | |
261 | return TCL_OK; | |
262 | ||
263 | unixError: | |
264 | Tcl_ResetResult (interp); | |
265 | interp->result = Tcl_UnixError (interp); | |
266 | return TCL_ERROR; | |
267 | } |