|
sl@0
|
1 |
/*
|
|
sl@0
|
2 |
* tclFCmd.c
|
|
sl@0
|
3 |
*
|
|
sl@0
|
4 |
* This file implements the generic portion of file manipulation
|
|
sl@0
|
5 |
* subcommands of the "file" command.
|
|
sl@0
|
6 |
*
|
|
sl@0
|
7 |
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
|
|
sl@0
|
8 |
*
|
|
sl@0
|
9 |
* See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
10 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
11 |
*
|
|
sl@0
|
12 |
* RCS: @(#) $Id: tclFCmd.c,v 1.20.2.2 2005/08/17 17:46:36 hobbs Exp $
|
|
sl@0
|
13 |
*/
|
|
sl@0
|
14 |
|
|
sl@0
|
15 |
#include "tclInt.h"
|
|
sl@0
|
16 |
#include "tclPort.h"
|
|
sl@0
|
17 |
|
|
sl@0
|
18 |
/*
|
|
sl@0
|
19 |
* Declarations for local procedures defined in this file:
|
|
sl@0
|
20 |
*/
|
|
sl@0
|
21 |
|
|
sl@0
|
22 |
static int CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
|
|
sl@0
|
23 |
Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
|
|
sl@0
|
24 |
int copyFlag, int force));
|
|
sl@0
|
25 |
static Tcl_Obj * FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
|
|
sl@0
|
26 |
Tcl_Obj *pathPtr));
|
|
sl@0
|
27 |
static int FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
|
|
sl@0
|
28 |
int objc, Tcl_Obj *CONST objv[], int copyFlag));
|
|
sl@0
|
29 |
static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
|
|
sl@0
|
30 |
int objc, Tcl_Obj *CONST objv[], int *forcePtr));
|
|
sl@0
|
31 |
|
|
sl@0
|
32 |
/*
|
|
sl@0
|
33 |
*---------------------------------------------------------------------------
|
|
sl@0
|
34 |
*
|
|
sl@0
|
35 |
* TclFileRenameCmd
|
|
sl@0
|
36 |
*
|
|
sl@0
|
37 |
* This procedure implements the "rename" subcommand of the "file"
|
|
sl@0
|
38 |
* command. Filename arguments need to be translated to native
|
|
sl@0
|
39 |
* format before being passed to platform-specific code that
|
|
sl@0
|
40 |
* implements rename functionality.
|
|
sl@0
|
41 |
*
|
|
sl@0
|
42 |
* Results:
|
|
sl@0
|
43 |
* A standard Tcl result.
|
|
sl@0
|
44 |
*
|
|
sl@0
|
45 |
* Side effects:
|
|
sl@0
|
46 |
* See the user documentation.
|
|
sl@0
|
47 |
*
|
|
sl@0
|
48 |
*---------------------------------------------------------------------------
|
|
sl@0
|
49 |
*/
|
|
sl@0
|
50 |
|
|
sl@0
|
51 |
int
|
|
sl@0
|
52 |
TclFileRenameCmd(interp, objc, objv)
|
|
sl@0
|
53 |
Tcl_Interp *interp; /* Interp for error reporting. */
|
|
sl@0
|
54 |
int objc; /* Number of arguments. */
|
|
sl@0
|
55 |
Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
|
|
sl@0
|
56 |
{
|
|
sl@0
|
57 |
return FileCopyRename(interp, objc, objv, 0);
|
|
sl@0
|
58 |
}
|
|
sl@0
|
59 |
|
|
sl@0
|
60 |
/*
|
|
sl@0
|
61 |
*---------------------------------------------------------------------------
|
|
sl@0
|
62 |
*
|
|
sl@0
|
63 |
* TclFileCopyCmd
|
|
sl@0
|
64 |
*
|
|
sl@0
|
65 |
* This procedure implements the "copy" subcommand of the "file"
|
|
sl@0
|
66 |
* command. Filename arguments need to be translated to native
|
|
sl@0
|
67 |
* format before being passed to platform-specific code that
|
|
sl@0
|
68 |
* implements copy functionality.
|
|
sl@0
|
69 |
*
|
|
sl@0
|
70 |
* Results:
|
|
sl@0
|
71 |
* A standard Tcl result.
|
|
sl@0
|
72 |
*
|
|
sl@0
|
73 |
* Side effects:
|
|
sl@0
|
74 |
* See the user documentation.
|
|
sl@0
|
75 |
*
|
|
sl@0
|
76 |
*---------------------------------------------------------------------------
|
|
sl@0
|
77 |
*/
|
|
sl@0
|
78 |
|
|
sl@0
|
79 |
int
|
|
sl@0
|
80 |
TclFileCopyCmd(interp, objc, objv)
|
|
sl@0
|
81 |
Tcl_Interp *interp; /* Used for error reporting */
|
|
sl@0
|
82 |
int objc; /* Number of arguments. */
|
|
sl@0
|
83 |
Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
|
|
sl@0
|
84 |
{
|
|
sl@0
|
85 |
return FileCopyRename(interp, objc, objv, 1);
|
|
sl@0
|
86 |
}
|
|
sl@0
|
87 |
|
|
sl@0
|
88 |
/*
|
|
sl@0
|
89 |
*---------------------------------------------------------------------------
|
|
sl@0
|
90 |
*
|
|
sl@0
|
91 |
* FileCopyRename --
|
|
sl@0
|
92 |
*
|
|
sl@0
|
93 |
* Performs the work of TclFileRenameCmd and TclFileCopyCmd.
|
|
sl@0
|
94 |
* See comments for those procedures.
|
|
sl@0
|
95 |
*
|
|
sl@0
|
96 |
* Results:
|
|
sl@0
|
97 |
* See above.
|
|
sl@0
|
98 |
*
|
|
sl@0
|
99 |
* Side effects:
|
|
sl@0
|
100 |
* See above.
|
|
sl@0
|
101 |
*
|
|
sl@0
|
102 |
*---------------------------------------------------------------------------
|
|
sl@0
|
103 |
*/
|
|
sl@0
|
104 |
|
|
sl@0
|
105 |
static int
|
|
sl@0
|
106 |
FileCopyRename(interp, objc, objv, copyFlag)
|
|
sl@0
|
107 |
Tcl_Interp *interp; /* Used for error reporting. */
|
|
sl@0
|
108 |
int objc; /* Number of arguments. */
|
|
sl@0
|
109 |
Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
|
|
sl@0
|
110 |
int copyFlag; /* If non-zero, copy source(s). Otherwise,
|
|
sl@0
|
111 |
* rename them. */
|
|
sl@0
|
112 |
{
|
|
sl@0
|
113 |
int i, result, force;
|
|
sl@0
|
114 |
Tcl_StatBuf statBuf;
|
|
sl@0
|
115 |
Tcl_Obj *target;
|
|
sl@0
|
116 |
|
|
sl@0
|
117 |
i = FileForceOption(interp, objc - 2, objv + 2, &force);
|
|
sl@0
|
118 |
if (i < 0) {
|
|
sl@0
|
119 |
return TCL_ERROR;
|
|
sl@0
|
120 |
}
|
|
sl@0
|
121 |
i += 2;
|
|
sl@0
|
122 |
if ((objc - i) < 2) {
|
|
sl@0
|
123 |
Tcl_AppendResult(interp, "wrong # args: should be \"",
|
|
sl@0
|
124 |
Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]),
|
|
sl@0
|
125 |
" ?options? source ?source ...? target\"",
|
|
sl@0
|
126 |
(char *) NULL);
|
|
sl@0
|
127 |
return TCL_ERROR;
|
|
sl@0
|
128 |
}
|
|
sl@0
|
129 |
|
|
sl@0
|
130 |
/*
|
|
sl@0
|
131 |
* If target doesn't exist or isn't a directory, try the copy/rename.
|
|
sl@0
|
132 |
* More than 2 arguments is only valid if the target is an existing
|
|
sl@0
|
133 |
* directory.
|
|
sl@0
|
134 |
*/
|
|
sl@0
|
135 |
|
|
sl@0
|
136 |
target = objv[objc - 1];
|
|
sl@0
|
137 |
if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
|
|
sl@0
|
138 |
return TCL_ERROR;
|
|
sl@0
|
139 |
}
|
|
sl@0
|
140 |
|
|
sl@0
|
141 |
result = TCL_OK;
|
|
sl@0
|
142 |
|
|
sl@0
|
143 |
/*
|
|
sl@0
|
144 |
* Call Tcl_FSStat() so that if target is a symlink that points to a
|
|
sl@0
|
145 |
* directory we will put the sources in that directory instead of
|
|
sl@0
|
146 |
* overwriting the symlink.
|
|
sl@0
|
147 |
*/
|
|
sl@0
|
148 |
|
|
sl@0
|
149 |
if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
|
|
sl@0
|
150 |
if ((objc - i) > 2) {
|
|
sl@0
|
151 |
errno = ENOTDIR;
|
|
sl@0
|
152 |
Tcl_PosixError(interp);
|
|
sl@0
|
153 |
Tcl_AppendResult(interp, "error ",
|
|
sl@0
|
154 |
((copyFlag) ? "copying" : "renaming"), ": target \"",
|
|
sl@0
|
155 |
Tcl_GetString(target), "\" is not a directory",
|
|
sl@0
|
156 |
(char *) NULL);
|
|
sl@0
|
157 |
result = TCL_ERROR;
|
|
sl@0
|
158 |
} else {
|
|
sl@0
|
159 |
/*
|
|
sl@0
|
160 |
* Even though already have target == translated(objv[i+1]),
|
|
sl@0
|
161 |
* pass the original argument down, so if there's an error, the
|
|
sl@0
|
162 |
* error message will reflect the original arguments.
|
|
sl@0
|
163 |
*/
|
|
sl@0
|
164 |
|
|
sl@0
|
165 |
result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag,
|
|
sl@0
|
166 |
force);
|
|
sl@0
|
167 |
}
|
|
sl@0
|
168 |
return result;
|
|
sl@0
|
169 |
}
|
|
sl@0
|
170 |
|
|
sl@0
|
171 |
/*
|
|
sl@0
|
172 |
* Move each source file into target directory. Extract the basename
|
|
sl@0
|
173 |
* from each source, and append it to the end of the target path.
|
|
sl@0
|
174 |
*/
|
|
sl@0
|
175 |
|
|
sl@0
|
176 |
for ( ; i < objc - 1; i++) {
|
|
sl@0
|
177 |
Tcl_Obj *jargv[2];
|
|
sl@0
|
178 |
Tcl_Obj *source, *newFileName;
|
|
sl@0
|
179 |
Tcl_Obj *temp;
|
|
sl@0
|
180 |
|
|
sl@0
|
181 |
source = FileBasename(interp, objv[i]);
|
|
sl@0
|
182 |
if (source == NULL) {
|
|
sl@0
|
183 |
result = TCL_ERROR;
|
|
sl@0
|
184 |
break;
|
|
sl@0
|
185 |
}
|
|
sl@0
|
186 |
jargv[0] = objv[objc - 1];
|
|
sl@0
|
187 |
jargv[1] = source;
|
|
sl@0
|
188 |
temp = Tcl_NewListObj(2, jargv);
|
|
sl@0
|
189 |
newFileName = Tcl_FSJoinPath(temp, -1);
|
|
sl@0
|
190 |
Tcl_IncrRefCount(newFileName);
|
|
sl@0
|
191 |
result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
|
|
sl@0
|
192 |
force);
|
|
sl@0
|
193 |
Tcl_DecrRefCount(newFileName);
|
|
sl@0
|
194 |
Tcl_DecrRefCount(temp);
|
|
sl@0
|
195 |
Tcl_DecrRefCount(source);
|
|
sl@0
|
196 |
|
|
sl@0
|
197 |
if (result == TCL_ERROR) {
|
|
sl@0
|
198 |
break;
|
|
sl@0
|
199 |
}
|
|
sl@0
|
200 |
}
|
|
sl@0
|
201 |
return result;
|
|
sl@0
|
202 |
}
|
|
sl@0
|
203 |
|
|
sl@0
|
204 |
/*
|
|
sl@0
|
205 |
*---------------------------------------------------------------------------
|
|
sl@0
|
206 |
*
|
|
sl@0
|
207 |
* TclFileMakeDirsCmd
|
|
sl@0
|
208 |
*
|
|
sl@0
|
209 |
* This procedure implements the "mkdir" subcommand of the "file"
|
|
sl@0
|
210 |
* command. Filename arguments need to be translated to native
|
|
sl@0
|
211 |
* format before being passed to platform-specific code that
|
|
sl@0
|
212 |
* implements mkdir functionality.
|
|
sl@0
|
213 |
*
|
|
sl@0
|
214 |
* Results:
|
|
sl@0
|
215 |
* A standard Tcl result.
|
|
sl@0
|
216 |
*
|
|
sl@0
|
217 |
* Side effects:
|
|
sl@0
|
218 |
* See the user documentation.
|
|
sl@0
|
219 |
*
|
|
sl@0
|
220 |
*----------------------------------------------------------------------
|
|
sl@0
|
221 |
*/
|
|
sl@0
|
222 |
int
|
|
sl@0
|
223 |
TclFileMakeDirsCmd(interp, objc, objv)
|
|
sl@0
|
224 |
Tcl_Interp *interp; /* Used for error reporting. */
|
|
sl@0
|
225 |
int objc; /* Number of arguments */
|
|
sl@0
|
226 |
Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
|
|
sl@0
|
227 |
{
|
|
sl@0
|
228 |
Tcl_Obj *errfile;
|
|
sl@0
|
229 |
int result, i, j, pobjc;
|
|
sl@0
|
230 |
Tcl_Obj *split = NULL;
|
|
sl@0
|
231 |
Tcl_Obj *target = NULL;
|
|
sl@0
|
232 |
Tcl_StatBuf statBuf;
|
|
sl@0
|
233 |
|
|
sl@0
|
234 |
errfile = NULL;
|
|
sl@0
|
235 |
|
|
sl@0
|
236 |
result = TCL_OK;
|
|
sl@0
|
237 |
for (i = 2; i < objc; i++) {
|
|
sl@0
|
238 |
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
|
|
sl@0
|
239 |
result = TCL_ERROR;
|
|
sl@0
|
240 |
break;
|
|
sl@0
|
241 |
}
|
|
sl@0
|
242 |
|
|
sl@0
|
243 |
split = Tcl_FSSplitPath(objv[i],&pobjc);
|
|
sl@0
|
244 |
if (pobjc == 0) {
|
|
sl@0
|
245 |
errno = ENOENT;
|
|
sl@0
|
246 |
errfile = objv[i];
|
|
sl@0
|
247 |
break;
|
|
sl@0
|
248 |
}
|
|
sl@0
|
249 |
for (j = 0; j < pobjc; j++) {
|
|
sl@0
|
250 |
target = Tcl_FSJoinPath(split, j + 1);
|
|
sl@0
|
251 |
Tcl_IncrRefCount(target);
|
|
sl@0
|
252 |
/*
|
|
sl@0
|
253 |
* Call Tcl_FSStat() so that if target is a symlink that
|
|
sl@0
|
254 |
* points to a directory we will create subdirectories in
|
|
sl@0
|
255 |
* that directory.
|
|
sl@0
|
256 |
*/
|
|
sl@0
|
257 |
|
|
sl@0
|
258 |
if (Tcl_FSStat(target, &statBuf) == 0) {
|
|
sl@0
|
259 |
if (!S_ISDIR(statBuf.st_mode)) {
|
|
sl@0
|
260 |
errno = EEXIST;
|
|
sl@0
|
261 |
errfile = target;
|
|
sl@0
|
262 |
goto done;
|
|
sl@0
|
263 |
}
|
|
sl@0
|
264 |
} else if (errno != ENOENT) {
|
|
sl@0
|
265 |
/*
|
|
sl@0
|
266 |
* If Tcl_FSStat() failed and the error is anything
|
|
sl@0
|
267 |
* other than non-existence of the target, throw the
|
|
sl@0
|
268 |
* error.
|
|
sl@0
|
269 |
*/
|
|
sl@0
|
270 |
errfile = target;
|
|
sl@0
|
271 |
goto done;
|
|
sl@0
|
272 |
} else if (Tcl_FSCreateDirectory(target) != TCL_OK) {
|
|
sl@0
|
273 |
/*
|
|
sl@0
|
274 |
* Create might have failed because of being in a race
|
|
sl@0
|
275 |
* condition with another process trying to create the
|
|
sl@0
|
276 |
* same subdirectory.
|
|
sl@0
|
277 |
*/
|
|
sl@0
|
278 |
if (errno == EEXIST) {
|
|
sl@0
|
279 |
if ((Tcl_FSStat(target, &statBuf) == 0)
|
|
sl@0
|
280 |
&& S_ISDIR(statBuf.st_mode)) {
|
|
sl@0
|
281 |
/*
|
|
sl@0
|
282 |
* It is a directory that wasn't there before,
|
|
sl@0
|
283 |
* so keep going without error.
|
|
sl@0
|
284 |
*/
|
|
sl@0
|
285 |
Tcl_ResetResult(interp);
|
|
sl@0
|
286 |
} else {
|
|
sl@0
|
287 |
errfile = target;
|
|
sl@0
|
288 |
goto done;
|
|
sl@0
|
289 |
}
|
|
sl@0
|
290 |
} else {
|
|
sl@0
|
291 |
errfile = target;
|
|
sl@0
|
292 |
goto done;
|
|
sl@0
|
293 |
}
|
|
sl@0
|
294 |
}
|
|
sl@0
|
295 |
/* Forget about this sub-path */
|
|
sl@0
|
296 |
Tcl_DecrRefCount(target);
|
|
sl@0
|
297 |
target = NULL;
|
|
sl@0
|
298 |
}
|
|
sl@0
|
299 |
Tcl_DecrRefCount(split);
|
|
sl@0
|
300 |
split = NULL;
|
|
sl@0
|
301 |
}
|
|
sl@0
|
302 |
|
|
sl@0
|
303 |
done:
|
|
sl@0
|
304 |
if (errfile != NULL) {
|
|
sl@0
|
305 |
Tcl_AppendResult(interp, "can't create directory \"",
|
|
sl@0
|
306 |
Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp),
|
|
sl@0
|
307 |
(char *) NULL);
|
|
sl@0
|
308 |
result = TCL_ERROR;
|
|
sl@0
|
309 |
}
|
|
sl@0
|
310 |
if (split != NULL) {
|
|
sl@0
|
311 |
Tcl_DecrRefCount(split);
|
|
sl@0
|
312 |
}
|
|
sl@0
|
313 |
if (target != NULL) {
|
|
sl@0
|
314 |
Tcl_DecrRefCount(target);
|
|
sl@0
|
315 |
}
|
|
sl@0
|
316 |
return result;
|
|
sl@0
|
317 |
}
|
|
sl@0
|
318 |
|
|
sl@0
|
319 |
/*
|
|
sl@0
|
320 |
*----------------------------------------------------------------------
|
|
sl@0
|
321 |
*
|
|
sl@0
|
322 |
* TclFileDeleteCmd
|
|
sl@0
|
323 |
*
|
|
sl@0
|
324 |
* This procedure implements the "delete" subcommand of the "file"
|
|
sl@0
|
325 |
* command.
|
|
sl@0
|
326 |
*
|
|
sl@0
|
327 |
* Results:
|
|
sl@0
|
328 |
* A standard Tcl result.
|
|
sl@0
|
329 |
*
|
|
sl@0
|
330 |
* Side effects:
|
|
sl@0
|
331 |
* See the user documentation.
|
|
sl@0
|
332 |
*
|
|
sl@0
|
333 |
*----------------------------------------------------------------------
|
|
sl@0
|
334 |
*/
|
|
sl@0
|
335 |
|
|
sl@0
|
336 |
int
|
|
sl@0
|
337 |
TclFileDeleteCmd(interp, objc, objv)
|
|
sl@0
|
338 |
Tcl_Interp *interp; /* Used for error reporting */
|
|
sl@0
|
339 |
int objc; /* Number of arguments */
|
|
sl@0
|
340 |
Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
|
|
sl@0
|
341 |
{
|
|
sl@0
|
342 |
int i, force, result;
|
|
sl@0
|
343 |
Tcl_Obj *errfile;
|
|
sl@0
|
344 |
Tcl_Obj *errorBuffer = NULL;
|
|
sl@0
|
345 |
|
|
sl@0
|
346 |
i = FileForceOption(interp, objc - 2, objv + 2, &force);
|
|
sl@0
|
347 |
if (i < 0) {
|
|
sl@0
|
348 |
return TCL_ERROR;
|
|
sl@0
|
349 |
}
|
|
sl@0
|
350 |
i += 2;
|
|
sl@0
|
351 |
if ((objc - i) < 1) {
|
|
sl@0
|
352 |
Tcl_AppendResult(interp, "wrong # args: should be \"",
|
|
sl@0
|
353 |
Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]),
|
|
sl@0
|
354 |
" ?options? file ?file ...?\"", (char *) NULL);
|
|
sl@0
|
355 |
return TCL_ERROR;
|
|
sl@0
|
356 |
}
|
|
sl@0
|
357 |
|
|
sl@0
|
358 |
errfile = NULL;
|
|
sl@0
|
359 |
result = TCL_OK;
|
|
sl@0
|
360 |
|
|
sl@0
|
361 |
for ( ; i < objc; i++) {
|
|
sl@0
|
362 |
Tcl_StatBuf statBuf;
|
|
sl@0
|
363 |
|
|
sl@0
|
364 |
errfile = objv[i];
|
|
sl@0
|
365 |
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
|
|
sl@0
|
366 |
result = TCL_ERROR;
|
|
sl@0
|
367 |
goto done;
|
|
sl@0
|
368 |
}
|
|
sl@0
|
369 |
|
|
sl@0
|
370 |
/*
|
|
sl@0
|
371 |
* Call lstat() to get info so can delete symbolic link itself.
|
|
sl@0
|
372 |
*/
|
|
sl@0
|
373 |
|
|
sl@0
|
374 |
if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
|
|
sl@0
|
375 |
/*
|
|
sl@0
|
376 |
* Trying to delete a file that does not exist is not
|
|
sl@0
|
377 |
* considered an error, just a no-op
|
|
sl@0
|
378 |
*/
|
|
sl@0
|
379 |
|
|
sl@0
|
380 |
if (errno != ENOENT) {
|
|
sl@0
|
381 |
result = TCL_ERROR;
|
|
sl@0
|
382 |
}
|
|
sl@0
|
383 |
} else if (S_ISDIR(statBuf.st_mode)) {
|
|
sl@0
|
384 |
/*
|
|
sl@0
|
385 |
* We own a reference count on errorBuffer, if it was set
|
|
sl@0
|
386 |
* as a result of this call.
|
|
sl@0
|
387 |
*/
|
|
sl@0
|
388 |
result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
|
|
sl@0
|
389 |
if (result != TCL_OK) {
|
|
sl@0
|
390 |
if ((force == 0) && (errno == EEXIST)) {
|
|
sl@0
|
391 |
Tcl_AppendResult(interp, "error deleting \"",
|
|
sl@0
|
392 |
Tcl_GetString(objv[i]),
|
|
sl@0
|
393 |
"\": directory not empty", (char *) NULL);
|
|
sl@0
|
394 |
Tcl_PosixError(interp);
|
|
sl@0
|
395 |
goto done;
|
|
sl@0
|
396 |
}
|
|
sl@0
|
397 |
|
|
sl@0
|
398 |
/*
|
|
sl@0
|
399 |
* If possible, use the untranslated name for the file.
|
|
sl@0
|
400 |
*/
|
|
sl@0
|
401 |
|
|
sl@0
|
402 |
errfile = errorBuffer;
|
|
sl@0
|
403 |
/* FS supposed to check between translated objv and errfile */
|
|
sl@0
|
404 |
if (Tcl_FSEqualPaths(objv[i], errfile)) {
|
|
sl@0
|
405 |
errfile = objv[i];
|
|
sl@0
|
406 |
}
|
|
sl@0
|
407 |
}
|
|
sl@0
|
408 |
} else {
|
|
sl@0
|
409 |
result = Tcl_FSDeleteFile(objv[i]);
|
|
sl@0
|
410 |
}
|
|
sl@0
|
411 |
|
|
sl@0
|
412 |
if (result != TCL_OK) {
|
|
sl@0
|
413 |
result = TCL_ERROR;
|
|
sl@0
|
414 |
/*
|
|
sl@0
|
415 |
* It is important that we break on error, otherwise we
|
|
sl@0
|
416 |
* might end up owning reference counts on numerous
|
|
sl@0
|
417 |
* errorBuffers.
|
|
sl@0
|
418 |
*/
|
|
sl@0
|
419 |
break;
|
|
sl@0
|
420 |
}
|
|
sl@0
|
421 |
}
|
|
sl@0
|
422 |
if (result != TCL_OK) {
|
|
sl@0
|
423 |
if (errfile == NULL) {
|
|
sl@0
|
424 |
/*
|
|
sl@0
|
425 |
* We try to accomodate poor error results from our
|
|
sl@0
|
426 |
* Tcl_FS calls
|
|
sl@0
|
427 |
*/
|
|
sl@0
|
428 |
Tcl_AppendResult(interp, "error deleting unknown file: ",
|
|
sl@0
|
429 |
Tcl_PosixError(interp), (char *) NULL);
|
|
sl@0
|
430 |
} else {
|
|
sl@0
|
431 |
Tcl_AppendResult(interp, "error deleting \"",
|
|
sl@0
|
432 |
Tcl_GetString(errfile), "\": ",
|
|
sl@0
|
433 |
Tcl_PosixError(interp), (char *) NULL);
|
|
sl@0
|
434 |
}
|
|
sl@0
|
435 |
}
|
|
sl@0
|
436 |
done:
|
|
sl@0
|
437 |
if (errorBuffer != NULL) {
|
|
sl@0
|
438 |
Tcl_DecrRefCount(errorBuffer);
|
|
sl@0
|
439 |
}
|
|
sl@0
|
440 |
return result;
|
|
sl@0
|
441 |
}
|
|
sl@0
|
442 |
|
|
sl@0
|
443 |
/*
|
|
sl@0
|
444 |
*---------------------------------------------------------------------------
|
|
sl@0
|
445 |
*
|
|
sl@0
|
446 |
* CopyRenameOneFile
|
|
sl@0
|
447 |
*
|
|
sl@0
|
448 |
* Copies or renames specified source file or directory hierarchy
|
|
sl@0
|
449 |
* to the specified target.
|
|
sl@0
|
450 |
*
|
|
sl@0
|
451 |
* Results:
|
|
sl@0
|
452 |
* A standard Tcl result.
|
|
sl@0
|
453 |
*
|
|
sl@0
|
454 |
* Side effects:
|
|
sl@0
|
455 |
* Target is overwritten if the force flag is set. Attempting to
|
|
sl@0
|
456 |
* copy/rename a file onto a directory or a directory onto a file
|
|
sl@0
|
457 |
* will always result in an error.
|
|
sl@0
|
458 |
*
|
|
sl@0
|
459 |
*----------------------------------------------------------------------
|
|
sl@0
|
460 |
*/
|
|
sl@0
|
461 |
|
|
sl@0
|
462 |
static int
|
|
sl@0
|
463 |
CopyRenameOneFile(interp, source, target, copyFlag, force)
|
|
sl@0
|
464 |
Tcl_Interp *interp; /* Used for error reporting. */
|
|
sl@0
|
465 |
Tcl_Obj *source; /* Pathname of file to copy. May need to
|
|
sl@0
|
466 |
* be translated. */
|
|
sl@0
|
467 |
Tcl_Obj *target; /* Pathname of file to create/overwrite.
|
|
sl@0
|
468 |
* May need to be translated. */
|
|
sl@0
|
469 |
int copyFlag; /* If non-zero, copy files. Otherwise,
|
|
sl@0
|
470 |
* rename them. */
|
|
sl@0
|
471 |
int force; /* If non-zero, overwrite target file if it
|
|
sl@0
|
472 |
* exists. Otherwise, error if target already
|
|
sl@0
|
473 |
* exists. */
|
|
sl@0
|
474 |
{
|
|
sl@0
|
475 |
int result;
|
|
sl@0
|
476 |
Tcl_Obj *errfile, *errorBuffer;
|
|
sl@0
|
477 |
/* If source is a link, then this is the real file/directory */
|
|
sl@0
|
478 |
Tcl_Obj *actualSource = NULL;
|
|
sl@0
|
479 |
Tcl_StatBuf sourceStatBuf, targetStatBuf;
|
|
sl@0
|
480 |
|
|
sl@0
|
481 |
if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
|
|
sl@0
|
482 |
return TCL_ERROR;
|
|
sl@0
|
483 |
}
|
|
sl@0
|
484 |
if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
|
|
sl@0
|
485 |
return TCL_ERROR;
|
|
sl@0
|
486 |
}
|
|
sl@0
|
487 |
|
|
sl@0
|
488 |
errfile = NULL;
|
|
sl@0
|
489 |
errorBuffer = NULL;
|
|
sl@0
|
490 |
result = TCL_ERROR;
|
|
sl@0
|
491 |
|
|
sl@0
|
492 |
/*
|
|
sl@0
|
493 |
* We want to copy/rename links and not the files they point to, so we
|
|
sl@0
|
494 |
* use lstat(). If target is a link, we also want to replace the
|
|
sl@0
|
495 |
* link and not the file it points to, so we also use lstat() on the
|
|
sl@0
|
496 |
* target.
|
|
sl@0
|
497 |
*/
|
|
sl@0
|
498 |
|
|
sl@0
|
499 |
if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
|
|
sl@0
|
500 |
errfile = source;
|
|
sl@0
|
501 |
goto done;
|
|
sl@0
|
502 |
}
|
|
sl@0
|
503 |
if (Tcl_FSLstat(target, &targetStatBuf) != 0) {
|
|
sl@0
|
504 |
if (errno != ENOENT) {
|
|
sl@0
|
505 |
errfile = target;
|
|
sl@0
|
506 |
goto done;
|
|
sl@0
|
507 |
}
|
|
sl@0
|
508 |
} else {
|
|
sl@0
|
509 |
if (force == 0) {
|
|
sl@0
|
510 |
errno = EEXIST;
|
|
sl@0
|
511 |
errfile = target;
|
|
sl@0
|
512 |
goto done;
|
|
sl@0
|
513 |
}
|
|
sl@0
|
514 |
|
|
sl@0
|
515 |
/*
|
|
sl@0
|
516 |
* Prevent copying or renaming a file onto itself. Under Windows,
|
|
sl@0
|
517 |
* stat always returns 0 for st_ino. However, the Windows-specific
|
|
sl@0
|
518 |
* code knows how to deal with copying or renaming a file on top of
|
|
sl@0
|
519 |
* itself. It might be a good idea to write a stat that worked.
|
|
sl@0
|
520 |
*/
|
|
sl@0
|
521 |
|
|
sl@0
|
522 |
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
|
|
sl@0
|
523 |
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
|
|
sl@0
|
524 |
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
|
|
sl@0
|
525 |
result = TCL_OK;
|
|
sl@0
|
526 |
goto done;
|
|
sl@0
|
527 |
}
|
|
sl@0
|
528 |
}
|
|
sl@0
|
529 |
|
|
sl@0
|
530 |
/*
|
|
sl@0
|
531 |
* Prevent copying/renaming a file onto a directory and
|
|
sl@0
|
532 |
* vice-versa. This is a policy decision based on the fact that
|
|
sl@0
|
533 |
* existing implementations of copy and rename on all platforms
|
|
sl@0
|
534 |
* also prevent this.
|
|
sl@0
|
535 |
*/
|
|
sl@0
|
536 |
|
|
sl@0
|
537 |
if (S_ISDIR(sourceStatBuf.st_mode)
|
|
sl@0
|
538 |
&& !S_ISDIR(targetStatBuf.st_mode)) {
|
|
sl@0
|
539 |
errno = EISDIR;
|
|
sl@0
|
540 |
Tcl_AppendResult(interp, "can't overwrite file \"",
|
|
sl@0
|
541 |
Tcl_GetString(target), "\" with directory \"",
|
|
sl@0
|
542 |
Tcl_GetString(source), "\"", (char *) NULL);
|
|
sl@0
|
543 |
goto done;
|
|
sl@0
|
544 |
}
|
|
sl@0
|
545 |
if (!S_ISDIR(sourceStatBuf.st_mode)
|
|
sl@0
|
546 |
&& S_ISDIR(targetStatBuf.st_mode)) {
|
|
sl@0
|
547 |
errno = EISDIR;
|
|
sl@0
|
548 |
Tcl_AppendResult(interp, "can't overwrite directory \"",
|
|
sl@0
|
549 |
Tcl_GetString(target), "\" with file \"",
|
|
sl@0
|
550 |
Tcl_GetString(source), "\"", (char *) NULL);
|
|
sl@0
|
551 |
goto done;
|
|
sl@0
|
552 |
}
|
|
sl@0
|
553 |
}
|
|
sl@0
|
554 |
|
|
sl@0
|
555 |
if (copyFlag == 0) {
|
|
sl@0
|
556 |
result = Tcl_FSRenameFile(source, target);
|
|
sl@0
|
557 |
if (result == TCL_OK) {
|
|
sl@0
|
558 |
goto done;
|
|
sl@0
|
559 |
}
|
|
sl@0
|
560 |
|
|
sl@0
|
561 |
if (errno == EINVAL) {
|
|
sl@0
|
562 |
Tcl_AppendResult(interp, "error renaming \"",
|
|
sl@0
|
563 |
Tcl_GetString(source), "\" to \"",
|
|
sl@0
|
564 |
Tcl_GetString(target), "\": trying to rename a volume or ",
|
|
sl@0
|
565 |
"move a directory into itself", (char *) NULL);
|
|
sl@0
|
566 |
goto done;
|
|
sl@0
|
567 |
} else if (errno != EXDEV) {
|
|
sl@0
|
568 |
errfile = target;
|
|
sl@0
|
569 |
goto done;
|
|
sl@0
|
570 |
}
|
|
sl@0
|
571 |
|
|
sl@0
|
572 |
/*
|
|
sl@0
|
573 |
* The rename failed because the move was across file systems.
|
|
sl@0
|
574 |
* Fall through to copy file and then remove original. Note that
|
|
sl@0
|
575 |
* the low-level Tcl_FSRenameFileProc in the filesystem is allowed
|
|
sl@0
|
576 |
* to implement cross-filesystem moves itself, if it desires.
|
|
sl@0
|
577 |
*/
|
|
sl@0
|
578 |
}
|
|
sl@0
|
579 |
|
|
sl@0
|
580 |
actualSource = source;
|
|
sl@0
|
581 |
Tcl_IncrRefCount(actualSource);
|
|
sl@0
|
582 |
#if 0
|
|
sl@0
|
583 |
#ifdef S_ISLNK
|
|
sl@0
|
584 |
/*
|
|
sl@0
|
585 |
* To add a flag to make 'copy' copy links instead of files, we could
|
|
sl@0
|
586 |
* add a condition to ignore this 'if' here.
|
|
sl@0
|
587 |
*/
|
|
sl@0
|
588 |
if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) {
|
|
sl@0
|
589 |
/*
|
|
sl@0
|
590 |
* We want to copy files not links. Therefore we must follow the
|
|
sl@0
|
591 |
* link. There are two purposes to this 'stat' call here. First
|
|
sl@0
|
592 |
* we want to know if the linked-file/dir actually exists, and
|
|
sl@0
|
593 |
* second, in the block of code which follows, some 20 lines
|
|
sl@0
|
594 |
* down, we want to check if the thing is a file or directory.
|
|
sl@0
|
595 |
*/
|
|
sl@0
|
596 |
if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
|
|
sl@0
|
597 |
/* Actual file doesn't exist */
|
|
sl@0
|
598 |
Tcl_AppendResult(interp,
|
|
sl@0
|
599 |
"error copying \"", Tcl_GetString(source),
|
|
sl@0
|
600 |
"\": the target of this link doesn't exist",
|
|
sl@0
|
601 |
(char *) NULL);
|
|
sl@0
|
602 |
goto done;
|
|
sl@0
|
603 |
} else {
|
|
sl@0
|
604 |
int counter = 0;
|
|
sl@0
|
605 |
while (1) {
|
|
sl@0
|
606 |
Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
|
|
sl@0
|
607 |
if (path == NULL) {
|
|
sl@0
|
608 |
break;
|
|
sl@0
|
609 |
}
|
|
sl@0
|
610 |
Tcl_DecrRefCount(actualSource);
|
|
sl@0
|
611 |
actualSource = path;
|
|
sl@0
|
612 |
counter++;
|
|
sl@0
|
613 |
/* Arbitrary limit of 20 links to follow */
|
|
sl@0
|
614 |
if (counter > 20) {
|
|
sl@0
|
615 |
/* Too many links */
|
|
sl@0
|
616 |
Tcl_SetErrno(EMLINK);
|
|
sl@0
|
617 |
errfile = source;
|
|
sl@0
|
618 |
goto done;
|
|
sl@0
|
619 |
}
|
|
sl@0
|
620 |
}
|
|
sl@0
|
621 |
/* Now 'actualSource' is the correct file */
|
|
sl@0
|
622 |
}
|
|
sl@0
|
623 |
}
|
|
sl@0
|
624 |
#endif
|
|
sl@0
|
625 |
#endif
|
|
sl@0
|
626 |
|
|
sl@0
|
627 |
if (S_ISDIR(sourceStatBuf.st_mode)) {
|
|
sl@0
|
628 |
result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer);
|
|
sl@0
|
629 |
if (result != TCL_OK) {
|
|
sl@0
|
630 |
if (errno == EXDEV) {
|
|
sl@0
|
631 |
/*
|
|
sl@0
|
632 |
* The copy failed because we're trying to do a
|
|
sl@0
|
633 |
* cross-filesystem copy. We do this through our Tcl
|
|
sl@0
|
634 |
* library.
|
|
sl@0
|
635 |
*/
|
|
sl@0
|
636 |
Tcl_SavedResult savedResult;
|
|
sl@0
|
637 |
Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
|
|
sl@0
|
638 |
Tcl_IncrRefCount(copyCommand);
|
|
sl@0
|
639 |
Tcl_ListObjAppendElement(interp, copyCommand,
|
|
sl@0
|
640 |
Tcl_NewStringObj("::tcl::CopyDirectory",-1));
|
|
sl@0
|
641 |
if (copyFlag) {
|
|
sl@0
|
642 |
Tcl_ListObjAppendElement(interp, copyCommand,
|
|
sl@0
|
643 |
Tcl_NewStringObj("copying",-1));
|
|
sl@0
|
644 |
} else {
|
|
sl@0
|
645 |
Tcl_ListObjAppendElement(interp, copyCommand,
|
|
sl@0
|
646 |
Tcl_NewStringObj("renaming",-1));
|
|
sl@0
|
647 |
}
|
|
sl@0
|
648 |
Tcl_ListObjAppendElement(interp, copyCommand, source);
|
|
sl@0
|
649 |
Tcl_ListObjAppendElement(interp, copyCommand, target);
|
|
sl@0
|
650 |
Tcl_SaveResult(interp, &savedResult);
|
|
sl@0
|
651 |
result = Tcl_EvalObjEx(interp, copyCommand,
|
|
sl@0
|
652 |
TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
|
|
sl@0
|
653 |
Tcl_DecrRefCount(copyCommand);
|
|
sl@0
|
654 |
if (result != TCL_OK) {
|
|
sl@0
|
655 |
/*
|
|
sl@0
|
656 |
* There was an error in the Tcl-level copy.
|
|
sl@0
|
657 |
* We will pass on the Tcl error message and
|
|
sl@0
|
658 |
* can ensure this by setting errfile to NULL
|
|
sl@0
|
659 |
*/
|
|
sl@0
|
660 |
Tcl_DiscardResult(&savedResult);
|
|
sl@0
|
661 |
errfile = NULL;
|
|
sl@0
|
662 |
} else {
|
|
sl@0
|
663 |
/* The copy was successful */
|
|
sl@0
|
664 |
Tcl_RestoreResult(interp, &savedResult);
|
|
sl@0
|
665 |
}
|
|
sl@0
|
666 |
} else {
|
|
sl@0
|
667 |
errfile = errorBuffer;
|
|
sl@0
|
668 |
if (Tcl_FSEqualPaths(errfile, source)) {
|
|
sl@0
|
669 |
errfile = source;
|
|
sl@0
|
670 |
} else if (Tcl_FSEqualPaths(errfile, target)) {
|
|
sl@0
|
671 |
errfile = target;
|
|
sl@0
|
672 |
}
|
|
sl@0
|
673 |
}
|
|
sl@0
|
674 |
}
|
|
sl@0
|
675 |
} else {
|
|
sl@0
|
676 |
result = Tcl_FSCopyFile(actualSource, target);
|
|
sl@0
|
677 |
if ((result != TCL_OK) && (errno == EXDEV)) {
|
|
sl@0
|
678 |
result = TclCrossFilesystemCopy(interp, source, target);
|
|
sl@0
|
679 |
}
|
|
sl@0
|
680 |
if (result != TCL_OK) {
|
|
sl@0
|
681 |
/*
|
|
sl@0
|
682 |
* We could examine 'errno' to double-check if the problem
|
|
sl@0
|
683 |
* was with the target, but we checked the source above,
|
|
sl@0
|
684 |
* so it should be quite clear
|
|
sl@0
|
685 |
*/
|
|
sl@0
|
686 |
errfile = target;
|
|
sl@0
|
687 |
/*
|
|
sl@0
|
688 |
* We now need to reset the result, because the above call,
|
|
sl@0
|
689 |
* if it failed, may have put an error message in place.
|
|
sl@0
|
690 |
* (Ideally we would prefer not to pass an interpreter in
|
|
sl@0
|
691 |
* above, but the channel IO code used by
|
|
sl@0
|
692 |
* TclCrossFilesystemCopy currently requires one)
|
|
sl@0
|
693 |
*/
|
|
sl@0
|
694 |
Tcl_ResetResult(interp);
|
|
sl@0
|
695 |
}
|
|
sl@0
|
696 |
}
|
|
sl@0
|
697 |
if ((copyFlag == 0) && (result == TCL_OK)) {
|
|
sl@0
|
698 |
if (S_ISDIR(sourceStatBuf.st_mode)) {
|
|
sl@0
|
699 |
result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
|
|
sl@0
|
700 |
if (result != TCL_OK) {
|
|
sl@0
|
701 |
if (Tcl_FSEqualPaths(errfile, source) == 0) {
|
|
sl@0
|
702 |
errfile = source;
|
|
sl@0
|
703 |
}
|
|
sl@0
|
704 |
}
|
|
sl@0
|
705 |
} else {
|
|
sl@0
|
706 |
result = Tcl_FSDeleteFile(source);
|
|
sl@0
|
707 |
if (result != TCL_OK) {
|
|
sl@0
|
708 |
errfile = source;
|
|
sl@0
|
709 |
}
|
|
sl@0
|
710 |
}
|
|
sl@0
|
711 |
if (result != TCL_OK) {
|
|
sl@0
|
712 |
Tcl_AppendResult(interp, "can't unlink \"",
|
|
sl@0
|
713 |
Tcl_GetString(errfile), "\": ",
|
|
sl@0
|
714 |
Tcl_PosixError(interp), (char *) NULL);
|
|
sl@0
|
715 |
errfile = NULL;
|
|
sl@0
|
716 |
}
|
|
sl@0
|
717 |
}
|
|
sl@0
|
718 |
|
|
sl@0
|
719 |
done:
|
|
sl@0
|
720 |
if (errfile != NULL) {
|
|
sl@0
|
721 |
Tcl_AppendResult(interp,
|
|
sl@0
|
722 |
((copyFlag) ? "error copying \"" : "error renaming \""),
|
|
sl@0
|
723 |
Tcl_GetString(source), (char *) NULL);
|
|
sl@0
|
724 |
if (errfile != source) {
|
|
sl@0
|
725 |
Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target),
|
|
sl@0
|
726 |
(char *) NULL);
|
|
sl@0
|
727 |
if (errfile != target) {
|
|
sl@0
|
728 |
Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile),
|
|
sl@0
|
729 |
(char *) NULL);
|
|
sl@0
|
730 |
}
|
|
sl@0
|
731 |
}
|
|
sl@0
|
732 |
Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
|
|
sl@0
|
733 |
(char *) NULL);
|
|
sl@0
|
734 |
}
|
|
sl@0
|
735 |
if (errorBuffer != NULL) {
|
|
sl@0
|
736 |
Tcl_DecrRefCount(errorBuffer);
|
|
sl@0
|
737 |
}
|
|
sl@0
|
738 |
if (actualSource != NULL) {
|
|
sl@0
|
739 |
Tcl_DecrRefCount(actualSource);
|
|
sl@0
|
740 |
}
|
|
sl@0
|
741 |
return result;
|
|
sl@0
|
742 |
}
|
|
sl@0
|
743 |
|
|
sl@0
|
744 |
/*
|
|
sl@0
|
745 |
*---------------------------------------------------------------------------
|
|
sl@0
|
746 |
*
|
|
sl@0
|
747 |
* FileForceOption --
|
|
sl@0
|
748 |
*
|
|
sl@0
|
749 |
* Helps parse command line options for file commands that take
|
|
sl@0
|
750 |
* the "-force" and "--" options.
|
|
sl@0
|
751 |
*
|
|
sl@0
|
752 |
* Results:
|
|
sl@0
|
753 |
* The return value is how many arguments from argv were consumed
|
|
sl@0
|
754 |
* by this function, or -1 if there was an error parsing the
|
|
sl@0
|
755 |
* options. If an error occurred, an error message is left in the
|
|
sl@0
|
756 |
* interp's result.
|
|
sl@0
|
757 |
*
|
|
sl@0
|
758 |
* Side effects:
|
|
sl@0
|
759 |
* None.
|
|
sl@0
|
760 |
*
|
|
sl@0
|
761 |
*---------------------------------------------------------------------------
|
|
sl@0
|
762 |
*/
|
|
sl@0
|
763 |
|
|
sl@0
|
764 |
static int
|
|
sl@0
|
765 |
FileForceOption(interp, objc, objv, forcePtr)
|
|
sl@0
|
766 |
Tcl_Interp *interp; /* Interp, for error return. */
|
|
sl@0
|
767 |
int objc; /* Number of arguments. */
|
|
sl@0
|
768 |
Tcl_Obj *CONST objv[]; /* Argument strings. First command line
|
|
sl@0
|
769 |
* option, if it exists, begins at 0. */
|
|
sl@0
|
770 |
int *forcePtr; /* If the "-force" was specified, *forcePtr
|
|
sl@0
|
771 |
* is filled with 1, otherwise with 0. */
|
|
sl@0
|
772 |
{
|
|
sl@0
|
773 |
int force, i;
|
|
sl@0
|
774 |
|
|
sl@0
|
775 |
force = 0;
|
|
sl@0
|
776 |
for (i = 0; i < objc; i++) {
|
|
sl@0
|
777 |
if (Tcl_GetString(objv[i])[0] != '-') {
|
|
sl@0
|
778 |
break;
|
|
sl@0
|
779 |
}
|
|
sl@0
|
780 |
if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) {
|
|
sl@0
|
781 |
force = 1;
|
|
sl@0
|
782 |
} else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) {
|
|
sl@0
|
783 |
i++;
|
|
sl@0
|
784 |
break;
|
|
sl@0
|
785 |
} else {
|
|
sl@0
|
786 |
Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]),
|
|
sl@0
|
787 |
"\": should be -force or --", (char *)NULL);
|
|
sl@0
|
788 |
return -1;
|
|
sl@0
|
789 |
}
|
|
sl@0
|
790 |
}
|
|
sl@0
|
791 |
*forcePtr = force;
|
|
sl@0
|
792 |
return i;
|
|
sl@0
|
793 |
}
|
|
sl@0
|
794 |
/*
|
|
sl@0
|
795 |
*---------------------------------------------------------------------------
|
|
sl@0
|
796 |
*
|
|
sl@0
|
797 |
* FileBasename --
|
|
sl@0
|
798 |
*
|
|
sl@0
|
799 |
* Given a path in either tcl format (with / separators), or in the
|
|
sl@0
|
800 |
* platform-specific format for the current platform, return all the
|
|
sl@0
|
801 |
* characters in the path after the last directory separator. But,
|
|
sl@0
|
802 |
* if path is the root directory, returns no characters.
|
|
sl@0
|
803 |
*
|
|
sl@0
|
804 |
* Results:
|
|
sl@0
|
805 |
* Returns the string object that represents the basename. If there
|
|
sl@0
|
806 |
* is an error, an error message is left in interp, and NULL is
|
|
sl@0
|
807 |
* returned.
|
|
sl@0
|
808 |
*
|
|
sl@0
|
809 |
* Side effects:
|
|
sl@0
|
810 |
* None.
|
|
sl@0
|
811 |
*
|
|
sl@0
|
812 |
*---------------------------------------------------------------------------
|
|
sl@0
|
813 |
*/
|
|
sl@0
|
814 |
|
|
sl@0
|
815 |
static Tcl_Obj *
|
|
sl@0
|
816 |
FileBasename(interp, pathPtr)
|
|
sl@0
|
817 |
Tcl_Interp *interp; /* Interp, for error return. */
|
|
sl@0
|
818 |
Tcl_Obj *pathPtr; /* Path whose basename to extract. */
|
|
sl@0
|
819 |
{
|
|
sl@0
|
820 |
int objc;
|
|
sl@0
|
821 |
Tcl_Obj *splitPtr;
|
|
sl@0
|
822 |
Tcl_Obj *resultPtr = NULL;
|
|
sl@0
|
823 |
|
|
sl@0
|
824 |
splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
|
|
sl@0
|
825 |
|
|
sl@0
|
826 |
if (objc != 0) {
|
|
sl@0
|
827 |
if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {
|
|
sl@0
|
828 |
Tcl_DecrRefCount(splitPtr);
|
|
sl@0
|
829 |
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
|
|
sl@0
|
830 |
return NULL;
|
|
sl@0
|
831 |
}
|
|
sl@0
|
832 |
splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
|
|
sl@0
|
833 |
}
|
|
sl@0
|
834 |
|
|
sl@0
|
835 |
/*
|
|
sl@0
|
836 |
* Return the last component, unless it is the only component, and it
|
|
sl@0
|
837 |
* is the root of an absolute path.
|
|
sl@0
|
838 |
*/
|
|
sl@0
|
839 |
|
|
sl@0
|
840 |
if (objc > 0) {
|
|
sl@0
|
841 |
Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
|
|
sl@0
|
842 |
if ((objc == 1) &&
|
|
sl@0
|
843 |
(Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
|
|
sl@0
|
844 |
resultPtr = NULL;
|
|
sl@0
|
845 |
}
|
|
sl@0
|
846 |
}
|
|
sl@0
|
847 |
}
|
|
sl@0
|
848 |
if (resultPtr == NULL) {
|
|
sl@0
|
849 |
resultPtr = Tcl_NewObj();
|
|
sl@0
|
850 |
}
|
|
sl@0
|
851 |
Tcl_IncrRefCount(resultPtr);
|
|
sl@0
|
852 |
Tcl_DecrRefCount(splitPtr);
|
|
sl@0
|
853 |
return resultPtr;
|
|
sl@0
|
854 |
}
|
|
sl@0
|
855 |
|
|
sl@0
|
856 |
/*
|
|
sl@0
|
857 |
*----------------------------------------------------------------------
|
|
sl@0
|
858 |
*
|
|
sl@0
|
859 |
* TclFileAttrsCmd --
|
|
sl@0
|
860 |
*
|
|
sl@0
|
861 |
* Sets or gets the platform-specific attributes of a file. The
|
|
sl@0
|
862 |
* objc-objv points to the file name with the rest of the command
|
|
sl@0
|
863 |
* line following. This routine uses platform-specific tables of
|
|
sl@0
|
864 |
* option strings and callbacks. The callback to get the
|
|
sl@0
|
865 |
* attributes take three parameters:
|
|
sl@0
|
866 |
* Tcl_Interp *interp; The interp to report errors with.
|
|
sl@0
|
867 |
* Since this is an object-based API,
|
|
sl@0
|
868 |
* the object form of the result should
|
|
sl@0
|
869 |
* be used.
|
|
sl@0
|
870 |
* CONST char *fileName; This is extracted using
|
|
sl@0
|
871 |
* Tcl_TranslateFileName.
|
|
sl@0
|
872 |
* TclObj **attrObjPtrPtr; A new object to hold the attribute
|
|
sl@0
|
873 |
* is allocated and put here.
|
|
sl@0
|
874 |
* The first two parameters of the callback used to write out the
|
|
sl@0
|
875 |
* attributes are the same. The third parameter is:
|
|
sl@0
|
876 |
* CONST *attrObjPtr; A pointer to the object that has
|
|
sl@0
|
877 |
* the new attribute.
|
|
sl@0
|
878 |
* They both return standard TCL errors; if the routine to get
|
|
sl@0
|
879 |
* an attribute fails, no object is allocated and *attrObjPtrPtr
|
|
sl@0
|
880 |
* is unchanged.
|
|
sl@0
|
881 |
*
|
|
sl@0
|
882 |
* Results:
|
|
sl@0
|
883 |
* Standard TCL error.
|
|
sl@0
|
884 |
*
|
|
sl@0
|
885 |
* Side effects:
|
|
sl@0
|
886 |
* May set file attributes for the file name.
|
|
sl@0
|
887 |
*
|
|
sl@0
|
888 |
*----------------------------------------------------------------------
|
|
sl@0
|
889 |
*/
|
|
sl@0
|
890 |
|
|
sl@0
|
891 |
int
|
|
sl@0
|
892 |
TclFileAttrsCmd(interp, objc, objv)
|
|
sl@0
|
893 |
Tcl_Interp *interp; /* The interpreter for error reporting. */
|
|
sl@0
|
894 |
int objc; /* Number of command line arguments. */
|
|
sl@0
|
895 |
Tcl_Obj *CONST objv[]; /* The command line objects. */
|
|
sl@0
|
896 |
{
|
|
sl@0
|
897 |
int result;
|
|
sl@0
|
898 |
CONST char ** attributeStrings;
|
|
sl@0
|
899 |
Tcl_Obj* objStrings = NULL;
|
|
sl@0
|
900 |
int numObjStrings = -1;
|
|
sl@0
|
901 |
Tcl_Obj *filePtr;
|
|
sl@0
|
902 |
|
|
sl@0
|
903 |
if (objc < 3) {
|
|
sl@0
|
904 |
Tcl_WrongNumArgs(interp, 2, objv,
|
|
sl@0
|
905 |
"name ?option? ?value? ?option value ...?");
|
|
sl@0
|
906 |
return TCL_ERROR;
|
|
sl@0
|
907 |
}
|
|
sl@0
|
908 |
|
|
sl@0
|
909 |
filePtr = objv[2];
|
|
sl@0
|
910 |
if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
|
|
sl@0
|
911 |
return TCL_ERROR;
|
|
sl@0
|
912 |
}
|
|
sl@0
|
913 |
|
|
sl@0
|
914 |
objc -= 3;
|
|
sl@0
|
915 |
objv += 3;
|
|
sl@0
|
916 |
result = TCL_ERROR;
|
|
sl@0
|
917 |
Tcl_SetErrno(0);
|
|
sl@0
|
918 |
attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
|
|
sl@0
|
919 |
if (attributeStrings == NULL) {
|
|
sl@0
|
920 |
int index;
|
|
sl@0
|
921 |
Tcl_Obj *objPtr;
|
|
sl@0
|
922 |
if (objStrings == NULL) {
|
|
sl@0
|
923 |
if (Tcl_GetErrno() != 0) {
|
|
sl@0
|
924 |
/*
|
|
sl@0
|
925 |
* There was an error, probably that the filePtr is
|
|
sl@0
|
926 |
* not accepted by any filesystem
|
|
sl@0
|
927 |
*/
|
|
sl@0
|
928 |
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
|
sl@0
|
929 |
"could not read \"", Tcl_GetString(filePtr),
|
|
sl@0
|
930 |
"\": ", Tcl_PosixError(interp),
|
|
sl@0
|
931 |
(char *) NULL);
|
|
sl@0
|
932 |
return TCL_ERROR;
|
|
sl@0
|
933 |
}
|
|
sl@0
|
934 |
goto end;
|
|
sl@0
|
935 |
}
|
|
sl@0
|
936 |
/* We own the object now */
|
|
sl@0
|
937 |
Tcl_IncrRefCount(objStrings);
|
|
sl@0
|
938 |
/* Use objStrings as a list object */
|
|
sl@0
|
939 |
if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
|
|
sl@0
|
940 |
goto end;
|
|
sl@0
|
941 |
}
|
|
sl@0
|
942 |
attributeStrings = (CONST char **)
|
|
sl@0
|
943 |
ckalloc ((1+numObjStrings) * sizeof(char*));
|
|
sl@0
|
944 |
for (index = 0; index < numObjStrings; index++) {
|
|
sl@0
|
945 |
Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
|
|
sl@0
|
946 |
attributeStrings[index] = Tcl_GetString(objPtr);
|
|
sl@0
|
947 |
}
|
|
sl@0
|
948 |
attributeStrings[index] = NULL;
|
|
sl@0
|
949 |
}
|
|
sl@0
|
950 |
if (objc == 0) {
|
|
sl@0
|
951 |
/*
|
|
sl@0
|
952 |
* Get all attributes.
|
|
sl@0
|
953 |
*/
|
|
sl@0
|
954 |
|
|
sl@0
|
955 |
int index;
|
|
sl@0
|
956 |
Tcl_Obj *listPtr;
|
|
sl@0
|
957 |
|
|
sl@0
|
958 |
listPtr = Tcl_NewListObj(0, NULL);
|
|
sl@0
|
959 |
for (index = 0; attributeStrings[index] != NULL; index++) {
|
|
sl@0
|
960 |
Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
|
|
sl@0
|
961 |
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
|
|
sl@0
|
962 |
/* We now forget about objPtr, it is in the list */
|
|
sl@0
|
963 |
objPtr = NULL;
|
|
sl@0
|
964 |
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
|
|
sl@0
|
965 |
&objPtr) != TCL_OK) {
|
|
sl@0
|
966 |
Tcl_DecrRefCount(listPtr);
|
|
sl@0
|
967 |
goto end;
|
|
sl@0
|
968 |
}
|
|
sl@0
|
969 |
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
|
|
sl@0
|
970 |
}
|
|
sl@0
|
971 |
Tcl_SetObjResult(interp, listPtr);
|
|
sl@0
|
972 |
} else if (objc == 1) {
|
|
sl@0
|
973 |
/*
|
|
sl@0
|
974 |
* Get one attribute.
|
|
sl@0
|
975 |
*/
|
|
sl@0
|
976 |
|
|
sl@0
|
977 |
int index;
|
|
sl@0
|
978 |
Tcl_Obj *objPtr = NULL;
|
|
sl@0
|
979 |
|
|
sl@0
|
980 |
if (numObjStrings == 0) {
|
|
sl@0
|
981 |
Tcl_AppendResult(interp, "bad option \"",
|
|
sl@0
|
982 |
Tcl_GetString(objv[0]), "\", there are no file attributes"
|
|
sl@0
|
983 |
" in this filesystem.", (char *) NULL);
|
|
sl@0
|
984 |
goto end;
|
|
sl@0
|
985 |
}
|
|
sl@0
|
986 |
|
|
sl@0
|
987 |
if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
|
|
sl@0
|
988 |
"option", 0, &index) != TCL_OK) {
|
|
sl@0
|
989 |
goto end;
|
|
sl@0
|
990 |
}
|
|
sl@0
|
991 |
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
|
|
sl@0
|
992 |
&objPtr) != TCL_OK) {
|
|
sl@0
|
993 |
goto end;
|
|
sl@0
|
994 |
}
|
|
sl@0
|
995 |
Tcl_SetObjResult(interp, objPtr);
|
|
sl@0
|
996 |
} else {
|
|
sl@0
|
997 |
/*
|
|
sl@0
|
998 |
* Set option/value pairs.
|
|
sl@0
|
999 |
*/
|
|
sl@0
|
1000 |
|
|
sl@0
|
1001 |
int i, index;
|
|
sl@0
|
1002 |
|
|
sl@0
|
1003 |
if (numObjStrings == 0) {
|
|
sl@0
|
1004 |
Tcl_AppendResult(interp, "bad option \"",
|
|
sl@0
|
1005 |
Tcl_GetString(objv[0]), "\", there are no file attributes"
|
|
sl@0
|
1006 |
" in this filesystem.", (char *) NULL);
|
|
sl@0
|
1007 |
goto end;
|
|
sl@0
|
1008 |
}
|
|
sl@0
|
1009 |
|
|
sl@0
|
1010 |
for (i = 0; i < objc ; i += 2) {
|
|
sl@0
|
1011 |
if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
|
|
sl@0
|
1012 |
"option", 0, &index) != TCL_OK) {
|
|
sl@0
|
1013 |
goto end;
|
|
sl@0
|
1014 |
}
|
|
sl@0
|
1015 |
if (i + 1 == objc) {
|
|
sl@0
|
1016 |
Tcl_AppendResult(interp, "value for \"",
|
|
sl@0
|
1017 |
Tcl_GetString(objv[i]), "\" missing",
|
|
sl@0
|
1018 |
(char *) NULL);
|
|
sl@0
|
1019 |
goto end;
|
|
sl@0
|
1020 |
}
|
|
sl@0
|
1021 |
if (Tcl_FSFileAttrsSet(interp, index, filePtr,
|
|
sl@0
|
1022 |
objv[i + 1]) != TCL_OK) {
|
|
sl@0
|
1023 |
goto end;
|
|
sl@0
|
1024 |
}
|
|
sl@0
|
1025 |
}
|
|
sl@0
|
1026 |
}
|
|
sl@0
|
1027 |
result = TCL_OK;
|
|
sl@0
|
1028 |
|
|
sl@0
|
1029 |
end:
|
|
sl@0
|
1030 |
if (numObjStrings != -1) {
|
|
sl@0
|
1031 |
/* Free up the array we allocated */
|
|
sl@0
|
1032 |
ckfree((char*)attributeStrings);
|
|
sl@0
|
1033 |
/*
|
|
sl@0
|
1034 |
* We don't need this object that was passed to us
|
|
sl@0
|
1035 |
* any more.
|
|
sl@0
|
1036 |
*/
|
|
sl@0
|
1037 |
if (objStrings != NULL) {
|
|
sl@0
|
1038 |
Tcl_DecrRefCount(objStrings);
|
|
sl@0
|
1039 |
}
|
|
sl@0
|
1040 |
}
|
|
sl@0
|
1041 |
return result;
|
|
sl@0
|
1042 |
}
|