1 |
dashley |
71 |
/* $Header$ */ |
2 |
|
|
/* |
3 |
|
|
* tclWinFCmd.c |
4 |
|
|
* |
5 |
|
|
* This file implements the Windows specific portion of file manipulation |
6 |
|
|
* subcommands of the "file" command. |
7 |
|
|
* |
8 |
|
|
* Copyright (c) 1996-1998 Sun Microsystems, Inc. |
9 |
|
|
* |
10 |
|
|
* See the file "license.terms" for information on usage and redistribution |
11 |
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
12 |
|
|
* |
13 |
|
|
* RCS: @(#) $Id: tclwinfcmd.c,v 1.1.1.1 2001/06/13 04:49:02 dtashley Exp $ |
14 |
|
|
*/ |
15 |
|
|
|
16 |
|
|
#include "tclWinInt.h" |
17 |
|
|
|
18 |
|
|
/* |
19 |
|
|
* The following constants specify the type of callback when |
20 |
|
|
* TraverseWinTree() calls the traverseProc() |
21 |
|
|
*/ |
22 |
|
|
|
23 |
|
|
#define DOTREE_PRED 1 /* pre-order directory */ |
24 |
|
|
#define DOTREE_POSTD 2 /* post-order directory */ |
25 |
|
|
#define DOTREE_F 3 /* regular file */ |
26 |
|
|
|
27 |
|
|
/* |
28 |
|
|
* Callbacks for file attributes code. |
29 |
|
|
*/ |
30 |
|
|
|
31 |
|
|
static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, |
32 |
|
|
int objIndex, CONST char *fileName, |
33 |
|
|
Tcl_Obj **attributePtrPtr)); |
34 |
|
|
static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp, |
35 |
|
|
int objIndex, CONST char *fileName, |
36 |
|
|
Tcl_Obj **attributePtrPtr)); |
37 |
|
|
static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp, |
38 |
|
|
int objIndex, CONST char *fileName, |
39 |
|
|
Tcl_Obj **attributePtrPtr)); |
40 |
|
|
static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, |
41 |
|
|
int objIndex, CONST char *fileName, |
42 |
|
|
Tcl_Obj *attributePtr)); |
43 |
|
|
static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp, |
44 |
|
|
int objIndex, CONST char *fileName, |
45 |
|
|
Tcl_Obj *attributePtr)); |
46 |
|
|
|
47 |
|
|
/* |
48 |
|
|
* Constants and variables necessary for file attributes subcommand. |
49 |
|
|
*/ |
50 |
|
|
|
51 |
|
|
enum { |
52 |
|
|
WIN_ARCHIVE_ATTRIBUTE, |
53 |
|
|
WIN_HIDDEN_ATTRIBUTE, |
54 |
|
|
WIN_LONGNAME_ATTRIBUTE, |
55 |
|
|
WIN_READONLY_ATTRIBUTE, |
56 |
|
|
WIN_SHORTNAME_ATTRIBUTE, |
57 |
|
|
WIN_SYSTEM_ATTRIBUTE |
58 |
|
|
}; |
59 |
|
|
|
60 |
|
|
static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, |
61 |
|
|
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; |
62 |
|
|
|
63 |
|
|
|
64 |
|
|
char *tclpFileAttrStrings[] = { |
65 |
|
|
"-archive", "-hidden", "-longname", "-readonly", |
66 |
|
|
"-shortname", "-system", (char *) NULL |
67 |
|
|
}; |
68 |
|
|
|
69 |
|
|
const TclFileAttrProcs tclpFileAttrProcs[] = { |
70 |
|
|
{GetWinFileAttributes, SetWinFileAttributes}, |
71 |
|
|
{GetWinFileAttributes, SetWinFileAttributes}, |
72 |
|
|
{GetWinFileLongName, CannotSetAttribute}, |
73 |
|
|
{GetWinFileAttributes, SetWinFileAttributes}, |
74 |
|
|
{GetWinFileShortName, CannotSetAttribute}, |
75 |
|
|
{GetWinFileAttributes, SetWinFileAttributes}}; |
76 |
|
|
|
77 |
|
|
/* |
78 |
|
|
* Prototype for the TraverseWinTree callback function. |
79 |
|
|
*/ |
80 |
|
|
|
81 |
|
|
typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, |
82 |
|
|
int type, Tcl_DString *errorPtr); |
83 |
|
|
|
84 |
|
|
/* |
85 |
|
|
* Declarations for local procedures defined in this file: |
86 |
|
|
*/ |
87 |
|
|
|
88 |
|
|
static void StatError(Tcl_Interp *interp, CONST char *fileName); |
89 |
|
|
static int ConvertFileNameFormat(Tcl_Interp *interp, |
90 |
|
|
int objIndex, CONST char *fileName, int longShort, |
91 |
|
|
Tcl_Obj **attributePtrPtr); |
92 |
|
|
static int DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr); |
93 |
|
|
static int DoCreateDirectory(Tcl_DString *pathPtr); |
94 |
|
|
static int DoDeleteFile(Tcl_DString *pathPtr); |
95 |
|
|
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, |
96 |
|
|
Tcl_DString *errorPtr); |
97 |
|
|
static int DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr); |
98 |
|
|
static int TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr, |
99 |
|
|
int type, Tcl_DString *errorPtr); |
100 |
|
|
static int TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr, |
101 |
|
|
int type, Tcl_DString *errorPtr); |
102 |
|
|
static int TraverseWinTree(TraversalProc *traverseProc, |
103 |
|
|
Tcl_DString *sourcePtr, Tcl_DString *dstPtr, |
104 |
|
|
Tcl_DString *errorPtr); |
105 |
|
|
|
106 |
|
|
|
107 |
|
|
/* |
108 |
|
|
*--------------------------------------------------------------------------- |
109 |
|
|
* |
110 |
|
|
* TclpRenameFile, DoRenameFile -- |
111 |
|
|
* |
112 |
|
|
* Changes the name of an existing file or directory, from src to dst. |
113 |
|
|
* If src and dst refer to the same file or directory, does nothing |
114 |
|
|
* and returns success. Otherwise if dst already exists, it will be |
115 |
|
|
* deleted and replaced by src subject to the following conditions: |
116 |
|
|
* If src is a directory, dst may be an empty directory. |
117 |
|
|
* If src is a file, dst may be a file. |
118 |
|
|
* In any other situation where dst already exists, the rename will |
119 |
|
|
* fail. |
120 |
|
|
* |
121 |
|
|
* Results: |
122 |
|
|
* If the file or directory was successfully renamed, returns TCL_OK. |
123 |
|
|
* Otherwise the return value is TCL_ERROR and errno is set to |
124 |
|
|
* indicate the error. Some possible values for errno are: |
125 |
|
|
* |
126 |
|
|
* ENAMETOOLONG: src or dst names are too long. |
127 |
|
|
* EACCES: src or dst parent directory can't be read and/or written. |
128 |
|
|
* EEXIST: dst is a non-empty directory. |
129 |
|
|
* EINVAL: src is a root directory or dst is a subdirectory of src. |
130 |
|
|
* EISDIR: dst is a directory, but src is not. |
131 |
|
|
* ENOENT: src doesn't exist. src or dst is "". |
132 |
|
|
* ENOTDIR: src is a directory, but dst is not. |
133 |
|
|
* EXDEV: src and dst are on different filesystems. |
134 |
|
|
* |
135 |
|
|
* EACCES: exists an open file already referring to src or dst. |
136 |
|
|
* EACCES: src or dst specify the current working directory (NT). |
137 |
|
|
* EACCES: src specifies a char device (nul:, com1:, etc.) |
138 |
|
|
* EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT) |
139 |
|
|
* EACCES: dst specifies a char device (nul:, com1:, etc.) (95) |
140 |
|
|
* |
141 |
|
|
* Side effects: |
142 |
|
|
* The implementation supports cross-filesystem renames of files, |
143 |
|
|
* but the caller should be prepared to emulate cross-filesystem |
144 |
|
|
* renames of directories if errno is EXDEV. |
145 |
|
|
* |
146 |
|
|
*--------------------------------------------------------------------------- |
147 |
|
|
*/ |
148 |
|
|
|
149 |
|
|
int |
150 |
|
|
TclpRenameFile( |
151 |
|
|
CONST char *src, /* Pathname of file or dir to be renamed |
152 |
|
|
* (UTF-8). */ |
153 |
|
|
CONST char *dst) /* New pathname of file or directory |
154 |
|
|
* (UTF-8). */ |
155 |
|
|
{ |
156 |
|
|
int result; |
157 |
|
|
TCHAR *nativeSrc; |
158 |
|
|
Tcl_DString srcString, dstString; |
159 |
|
|
|
160 |
|
|
nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString); |
161 |
|
|
Tcl_WinUtfToTChar(dst, -1, &dstString); |
162 |
|
|
|
163 |
|
|
result = DoRenameFile(nativeSrc, &dstString); |
164 |
|
|
Tcl_DStringFree(&srcString); |
165 |
|
|
Tcl_DStringFree(&dstString); |
166 |
|
|
return result; |
167 |
|
|
} |
168 |
|
|
|
169 |
|
|
static int |
170 |
|
|
DoRenameFile( |
171 |
|
|
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed |
172 |
|
|
* (native). */ |
173 |
|
|
Tcl_DString *dstPtr) /* New pathname for file or directory |
174 |
|
|
* (native). */ |
175 |
|
|
{ |
176 |
|
|
const TCHAR *nativeDst; |
177 |
|
|
DWORD srcAttr, dstAttr; |
178 |
|
|
|
179 |
|
|
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); |
180 |
|
|
|
181 |
|
|
/* |
182 |
|
|
* Would throw an exception under NT if one of the arguments is a |
183 |
|
|
* char block device. |
184 |
|
|
*/ |
185 |
|
|
|
186 |
|
|
__try { |
187 |
|
|
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { |
188 |
|
|
return TCL_OK; |
189 |
|
|
} |
190 |
|
|
} __except (-1) {} |
191 |
|
|
|
192 |
|
|
TclWinConvertError(GetLastError()); |
193 |
|
|
|
194 |
|
|
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); |
195 |
|
|
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); |
196 |
|
|
if (srcAttr == 0xffffffff) { |
197 |
|
|
if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { |
198 |
|
|
errno = ENAMETOOLONG; |
199 |
|
|
return TCL_ERROR; |
200 |
|
|
} |
201 |
|
|
srcAttr = 0; |
202 |
|
|
} |
203 |
|
|
if (dstAttr == 0xffffffff) { |
204 |
|
|
if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { |
205 |
|
|
errno = ENAMETOOLONG; |
206 |
|
|
return TCL_ERROR; |
207 |
|
|
} |
208 |
|
|
dstAttr = 0; |
209 |
|
|
} |
210 |
|
|
|
211 |
|
|
if (errno == EBADF) { |
212 |
|
|
errno = EACCES; |
213 |
|
|
return TCL_ERROR; |
214 |
|
|
} |
215 |
|
|
if (errno == EACCES) { |
216 |
|
|
decode: |
217 |
|
|
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { |
218 |
|
|
TCHAR *nativeSrcRest, *nativeDstRest; |
219 |
|
|
char **srcArgv, **dstArgv; |
220 |
|
|
int size, srcArgc, dstArgc; |
221 |
|
|
WCHAR nativeSrcPath[MAX_PATH]; |
222 |
|
|
WCHAR nativeDstPath[MAX_PATH]; |
223 |
|
|
Tcl_DString srcString, dstString; |
224 |
|
|
CONST char *src, *dst; |
225 |
|
|
|
226 |
|
|
size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, |
227 |
|
|
nativeSrcPath, &nativeSrcRest); |
228 |
|
|
if ((size == 0) || (size > MAX_PATH)) { |
229 |
|
|
return TCL_ERROR; |
230 |
|
|
} |
231 |
|
|
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, |
232 |
|
|
nativeDstPath, &nativeDstRest); |
233 |
|
|
if ((size == 0) || (size > MAX_PATH)) { |
234 |
|
|
return TCL_ERROR; |
235 |
|
|
} |
236 |
|
|
(*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); |
237 |
|
|
(*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); |
238 |
|
|
|
239 |
|
|
src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); |
240 |
|
|
dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); |
241 |
|
|
if (strncmp(src, dst, Tcl_DStringLength(&srcString)) == 0) { |
242 |
|
|
/* |
243 |
|
|
* Trying to move a directory into itself. |
244 |
|
|
*/ |
245 |
|
|
|
246 |
|
|
errno = EINVAL; |
247 |
|
|
Tcl_DStringFree(&srcString); |
248 |
|
|
Tcl_DStringFree(&dstString); |
249 |
|
|
return TCL_ERROR; |
250 |
|
|
} |
251 |
|
|
Tcl_SplitPath(src, &srcArgc, &srcArgv); |
252 |
|
|
Tcl_SplitPath(dst, &dstArgc, &dstArgv); |
253 |
|
|
Tcl_DStringFree(&srcString); |
254 |
|
|
Tcl_DStringFree(&dstString); |
255 |
|
|
|
256 |
|
|
if (srcArgc == 1) { |
257 |
|
|
/* |
258 |
|
|
* They are trying to move a root directory. Whether |
259 |
|
|
* or not it is across filesystems, this cannot be |
260 |
|
|
* done. |
261 |
|
|
*/ |
262 |
|
|
|
263 |
|
|
Tcl_SetErrno(EINVAL); |
264 |
|
|
} else if ((srcArgc > 0) && (dstArgc > 0) && |
265 |
|
|
(strcmp(srcArgv[0], dstArgv[0]) != 0)) { |
266 |
|
|
/* |
267 |
|
|
* If src is a directory and dst filesystem != src |
268 |
|
|
* filesystem, errno should be EXDEV. It is very |
269 |
|
|
* important to get this behavior, so that the caller |
270 |
|
|
* can respond to a cross filesystem rename by |
271 |
|
|
* simulating it with copy and delete. The MoveFile |
272 |
|
|
* system call already handles the case of moving a |
273 |
|
|
* file between filesystems. |
274 |
|
|
*/ |
275 |
|
|
|
276 |
|
|
Tcl_SetErrno(EXDEV); |
277 |
|
|
} |
278 |
|
|
|
279 |
|
|
ckfree((char *) srcArgv); |
280 |
|
|
ckfree((char *) dstArgv); |
281 |
|
|
} |
282 |
|
|
|
283 |
|
|
/* |
284 |
|
|
* Other types of access failure is that dst is a read-only |
285 |
|
|
* filesystem, that an open file referred to src or dest, or that |
286 |
|
|
* src or dest specified the current working directory on the |
287 |
|
|
* current filesystem. EACCES is returned for those cases. |
288 |
|
|
*/ |
289 |
|
|
|
290 |
|
|
} else if (Tcl_GetErrno() == EEXIST) { |
291 |
|
|
/* |
292 |
|
|
* Reports EEXIST any time the target already exists. If it makes |
293 |
|
|
* sense, remove the old file and try renaming again. |
294 |
|
|
*/ |
295 |
|
|
|
296 |
|
|
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { |
297 |
|
|
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { |
298 |
|
|
/* |
299 |
|
|
* Overwrite empty dst directory with src directory. The |
300 |
|
|
* following call will remove an empty directory. If it |
301 |
|
|
* fails, it's because it wasn't empty. |
302 |
|
|
*/ |
303 |
|
|
|
304 |
|
|
if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) { |
305 |
|
|
/* |
306 |
|
|
* Now that that empty directory is gone, we can try |
307 |
|
|
* renaming again. If that fails, we'll put this empty |
308 |
|
|
* directory back, for completeness. |
309 |
|
|
*/ |
310 |
|
|
|
311 |
|
|
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { |
312 |
|
|
return TCL_OK; |
313 |
|
|
} |
314 |
|
|
|
315 |
|
|
/* |
316 |
|
|
* Some new error has occurred. Don't know what it |
317 |
|
|
* could be, but report this one. |
318 |
|
|
*/ |
319 |
|
|
|
320 |
|
|
TclWinConvertError(GetLastError()); |
321 |
|
|
(*tclWinProcs->createDirectoryProc)(nativeDst, NULL); |
322 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); |
323 |
|
|
if (Tcl_GetErrno() == EACCES) { |
324 |
|
|
/* |
325 |
|
|
* Decode the EACCES to a more meaningful error. |
326 |
|
|
*/ |
327 |
|
|
|
328 |
|
|
goto decode; |
329 |
|
|
} |
330 |
|
|
} |
331 |
|
|
} else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ |
332 |
|
|
Tcl_SetErrno(ENOTDIR); |
333 |
|
|
} |
334 |
|
|
} else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ |
335 |
|
|
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { |
336 |
|
|
Tcl_SetErrno(EISDIR); |
337 |
|
|
} else { |
338 |
|
|
/* |
339 |
|
|
* Overwrite existing file by: |
340 |
|
|
* |
341 |
|
|
* 1. Rename existing file to temp name. |
342 |
|
|
* 2. Rename old file to new name. |
343 |
|
|
* 3. If success, delete temp file. If failure, |
344 |
|
|
* put temp file back to old name. |
345 |
|
|
*/ |
346 |
|
|
|
347 |
|
|
TCHAR *nativeRest, *nativeTmp, *nativePrefix; |
348 |
|
|
int result, size; |
349 |
|
|
WCHAR tempBuf[MAX_PATH]; |
350 |
|
|
|
351 |
|
|
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, |
352 |
|
|
tempBuf, &nativeRest); |
353 |
|
|
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { |
354 |
|
|
return TCL_ERROR; |
355 |
|
|
} |
356 |
|
|
nativeTmp = (TCHAR *) tempBuf; |
357 |
|
|
((char *) nativeRest)[0] = '\0'; |
358 |
|
|
((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ |
359 |
|
|
|
360 |
|
|
result = TCL_ERROR; |
361 |
|
|
nativePrefix = (tclWinProcs->useWide) |
362 |
|
|
? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; |
363 |
|
|
if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, |
364 |
|
|
nativePrefix, 0, tempBuf) != 0) { |
365 |
|
|
/* |
366 |
|
|
* Strictly speaking, need the following DeleteFile and |
367 |
|
|
* MoveFile to be joined as an atomic operation so no |
368 |
|
|
* other app comes along in the meantime and creates the |
369 |
|
|
* same temp file. |
370 |
|
|
*/ |
371 |
|
|
|
372 |
|
|
nativeTmp = (TCHAR *) tempBuf; |
373 |
|
|
(*tclWinProcs->deleteFileProc)(nativeTmp); |
374 |
|
|
if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) { |
375 |
|
|
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { |
376 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativeTmp, |
377 |
|
|
FILE_ATTRIBUTE_NORMAL); |
378 |
|
|
(*tclWinProcs->deleteFileProc)(nativeTmp); |
379 |
|
|
return TCL_OK; |
380 |
|
|
} else { |
381 |
|
|
(*tclWinProcs->deleteFileProc)(nativeDst); |
382 |
|
|
(*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); |
383 |
|
|
} |
384 |
|
|
} |
385 |
|
|
|
386 |
|
|
/* |
387 |
|
|
* Can't backup dst file or move src file. Return that |
388 |
|
|
* error. Could happen if an open file refers to dst. |
389 |
|
|
*/ |
390 |
|
|
|
391 |
|
|
TclWinConvertError(GetLastError()); |
392 |
|
|
if (Tcl_GetErrno() == EACCES) { |
393 |
|
|
/* |
394 |
|
|
* Decode the EACCES to a more meaningful error. |
395 |
|
|
*/ |
396 |
|
|
|
397 |
|
|
goto decode; |
398 |
|
|
} |
399 |
|
|
} |
400 |
|
|
return result; |
401 |
|
|
} |
402 |
|
|
} |
403 |
|
|
} |
404 |
|
|
return TCL_ERROR; |
405 |
|
|
} |
406 |
|
|
|
407 |
|
|
/* |
408 |
|
|
*--------------------------------------------------------------------------- |
409 |
|
|
* |
410 |
|
|
* TclpCopyFile, DoCopyFile -- |
411 |
|
|
* |
412 |
|
|
* Copy a single file (not a directory). If dst already exists and |
413 |
|
|
* is not a directory, it is removed. |
414 |
|
|
* |
415 |
|
|
* Results: |
416 |
|
|
* If the file was successfully copied, returns TCL_OK. Otherwise |
417 |
|
|
* the return value is TCL_ERROR and errno is set to indicate the |
418 |
|
|
* error. Some possible values for errno are: |
419 |
|
|
* |
420 |
|
|
* EACCES: src or dst parent directory can't be read and/or written. |
421 |
|
|
* EISDIR: src or dst is a directory. |
422 |
|
|
* ENOENT: src doesn't exist. src or dst is "". |
423 |
|
|
* |
424 |
|
|
* EACCES: exists an open file already referring to dst (95). |
425 |
|
|
* EACCES: src specifies a char device (nul:, com1:, etc.) (NT) |
426 |
|
|
* ENOENT: src specifies a char device (nul:, com1:, etc.) (95) |
427 |
|
|
* |
428 |
|
|
* Side effects: |
429 |
|
|
* It is not an error to copy to a char device. |
430 |
|
|
* |
431 |
|
|
*--------------------------------------------------------------------------- |
432 |
|
|
*/ |
433 |
|
|
|
434 |
|
|
int |
435 |
|
|
TclpCopyFile( |
436 |
|
|
CONST char *src, /* Pathname of file to be copied (UTF-8). */ |
437 |
|
|
CONST char *dst) /* Pathname of file to copy to (UTF-8). */ |
438 |
|
|
{ |
439 |
|
|
int result; |
440 |
|
|
Tcl_DString srcString, dstString; |
441 |
|
|
|
442 |
|
|
Tcl_WinUtfToTChar(src, -1, &srcString); |
443 |
|
|
Tcl_WinUtfToTChar(dst, -1, &dstString); |
444 |
|
|
result = DoCopyFile(&srcString, &dstString); |
445 |
|
|
Tcl_DStringFree(&srcString); |
446 |
|
|
Tcl_DStringFree(&dstString); |
447 |
|
|
return result; |
448 |
|
|
} |
449 |
|
|
|
450 |
|
|
static int |
451 |
|
|
DoCopyFile( |
452 |
|
|
Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */ |
453 |
|
|
Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */ |
454 |
|
|
{ |
455 |
|
|
CONST TCHAR *nativeSrc, *nativeDst; |
456 |
|
|
|
457 |
|
|
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr); |
458 |
|
|
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); |
459 |
|
|
|
460 |
|
|
/* |
461 |
|
|
* Would throw an exception under NT if one of the arguments is a char |
462 |
|
|
* block device. |
463 |
|
|
*/ |
464 |
|
|
|
465 |
|
|
__try { |
466 |
|
|
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { |
467 |
|
|
return TCL_OK; |
468 |
|
|
} |
469 |
|
|
} __except (-1) {} |
470 |
|
|
|
471 |
|
|
TclWinConvertError(GetLastError()); |
472 |
|
|
if (Tcl_GetErrno() == EBADF) { |
473 |
|
|
Tcl_SetErrno(EACCES); |
474 |
|
|
return TCL_ERROR; |
475 |
|
|
} |
476 |
|
|
if (Tcl_GetErrno() == EACCES) { |
477 |
|
|
DWORD srcAttr, dstAttr; |
478 |
|
|
|
479 |
|
|
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); |
480 |
|
|
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); |
481 |
|
|
if (srcAttr != 0xffffffff) { |
482 |
|
|
if (dstAttr == 0xffffffff) { |
483 |
|
|
dstAttr = 0; |
484 |
|
|
} |
485 |
|
|
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || |
486 |
|
|
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { |
487 |
|
|
Tcl_SetErrno(EISDIR); |
488 |
|
|
} |
489 |
|
|
if (dstAttr & FILE_ATTRIBUTE_READONLY) { |
490 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativeDst, |
491 |
|
|
dstAttr & ~FILE_ATTRIBUTE_READONLY); |
492 |
|
|
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { |
493 |
|
|
return TCL_OK; |
494 |
|
|
} |
495 |
|
|
/* |
496 |
|
|
* Still can't copy onto dst. Return that error, and |
497 |
|
|
* restore attributes of dst. |
498 |
|
|
*/ |
499 |
|
|
|
500 |
|
|
TclWinConvertError(GetLastError()); |
501 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); |
502 |
|
|
} |
503 |
|
|
} |
504 |
|
|
} |
505 |
|
|
return TCL_ERROR; |
506 |
|
|
} |
507 |
|
|
|
508 |
|
|
/* |
509 |
|
|
*--------------------------------------------------------------------------- |
510 |
|
|
* |
511 |
|
|
* TclpDeleteFile, DoDeleteFile -- |
512 |
|
|
* |
513 |
|
|
* Removes a single file (not a directory). |
514 |
|
|
* |
515 |
|
|
* Results: |
516 |
|
|
* If the file was successfully deleted, returns TCL_OK. Otherwise |
517 |
|
|
* the return value is TCL_ERROR and errno is set to indicate the |
518 |
|
|
* error. Some possible values for errno are: |
519 |
|
|
* |
520 |
|
|
* EACCES: a parent directory can't be read and/or written. |
521 |
|
|
* EISDIR: path is a directory. |
522 |
|
|
* ENOENT: path doesn't exist or is "". |
523 |
|
|
* |
524 |
|
|
* EACCES: exists an open file already referring to path. |
525 |
|
|
* EACCES: path is a char device (nul:, com1:, etc.) |
526 |
|
|
* |
527 |
|
|
* Side effects: |
528 |
|
|
* The file is deleted, even if it is read-only. |
529 |
|
|
* |
530 |
|
|
*--------------------------------------------------------------------------- |
531 |
|
|
*/ |
532 |
|
|
|
533 |
|
|
int |
534 |
|
|
TclpDeleteFile( |
535 |
|
|
CONST char *path) /* Pathname of file to be removed (UTF-8). */ |
536 |
|
|
{ |
537 |
|
|
int result; |
538 |
|
|
Tcl_DString pathString; |
539 |
|
|
|
540 |
|
|
Tcl_WinUtfToTChar(path, -1, &pathString); |
541 |
|
|
result = DoDeleteFile(&pathString); |
542 |
|
|
Tcl_DStringFree(&pathString); |
543 |
|
|
return result; |
544 |
|
|
} |
545 |
|
|
|
546 |
|
|
static int |
547 |
|
|
DoDeleteFile( |
548 |
|
|
Tcl_DString *pathPtr) /* Pathname of file to be removed (native). */ |
549 |
|
|
{ |
550 |
|
|
DWORD attr; |
551 |
|
|
CONST TCHAR *nativePath; |
552 |
|
|
|
553 |
|
|
nativePath = (TCHAR *) Tcl_DStringValue(pathPtr); |
554 |
|
|
|
555 |
|
|
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { |
556 |
|
|
return TCL_OK; |
557 |
|
|
} |
558 |
|
|
TclWinConvertError(GetLastError()); |
559 |
|
|
|
560 |
|
|
/* |
561 |
|
|
* Win32s thinks that "" is the same as "." and then reports EISDIR |
562 |
|
|
* instead of ENOENT. |
563 |
|
|
*/ |
564 |
|
|
|
565 |
|
|
if (tclWinProcs->useWide) { |
566 |
|
|
if (((WCHAR *) nativePath)[0] == '\0') { |
567 |
|
|
Tcl_SetErrno(ENOENT); |
568 |
|
|
return TCL_ERROR; |
569 |
|
|
} |
570 |
|
|
} else { |
571 |
|
|
if (((char *) nativePath)[0] == '\0') { |
572 |
|
|
Tcl_SetErrno(ENOENT); |
573 |
|
|
return TCL_ERROR; |
574 |
|
|
} |
575 |
|
|
} |
576 |
|
|
if (Tcl_GetErrno() == EACCES) { |
577 |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
578 |
|
|
if (attr != 0xffffffff) { |
579 |
|
|
if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
580 |
|
|
/* |
581 |
|
|
* Windows NT reports removing a directory as EACCES instead |
582 |
|
|
* of EISDIR. |
583 |
|
|
*/ |
584 |
|
|
|
585 |
|
|
Tcl_SetErrno(EISDIR); |
586 |
|
|
} else if (attr & FILE_ATTRIBUTE_READONLY) { |
587 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativePath, |
588 |
|
|
attr & ~FILE_ATTRIBUTE_READONLY); |
589 |
|
|
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { |
590 |
|
|
return TCL_OK; |
591 |
|
|
} |
592 |
|
|
TclWinConvertError(GetLastError()); |
593 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativePath, attr); |
594 |
|
|
} |
595 |
|
|
} |
596 |
|
|
} else if (Tcl_GetErrno() == ENOENT) { |
597 |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
598 |
|
|
if (attr != 0xffffffff) { |
599 |
|
|
if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
600 |
|
|
/* |
601 |
|
|
* Windows 95 reports removing a directory as ENOENT instead |
602 |
|
|
* of EISDIR. |
603 |
|
|
*/ |
604 |
|
|
|
605 |
|
|
Tcl_SetErrno(EISDIR); |
606 |
|
|
} |
607 |
|
|
} |
608 |
|
|
} else if (Tcl_GetErrno() == EINVAL) { |
609 |
|
|
/* |
610 |
|
|
* Windows NT reports removing a char device as EINVAL instead of |
611 |
|
|
* EACCES. |
612 |
|
|
*/ |
613 |
|
|
|
614 |
|
|
Tcl_SetErrno(EACCES); |
615 |
|
|
} |
616 |
|
|
|
617 |
|
|
return TCL_ERROR; |
618 |
|
|
} |
619 |
|
|
|
620 |
|
|
/* |
621 |
|
|
*--------------------------------------------------------------------------- |
622 |
|
|
* |
623 |
|
|
* TclpCreateDirectory -- |
624 |
|
|
* |
625 |
|
|
* Creates the specified directory. All parent directories of the |
626 |
|
|
* specified directory must already exist. The directory is |
627 |
|
|
* automatically created with permissions so that user can access |
628 |
|
|
* the new directory and create new files or subdirectories in it. |
629 |
|
|
* |
630 |
|
|
* Results: |
631 |
|
|
* If the directory was successfully created, returns TCL_OK. |
632 |
|
|
* Otherwise the return value is TCL_ERROR and errno is set to |
633 |
|
|
* indicate the error. Some possible values for errno are: |
634 |
|
|
* |
635 |
|
|
* EACCES: a parent directory can't be read and/or written. |
636 |
|
|
* EEXIST: path already exists. |
637 |
|
|
* ENOENT: a parent directory doesn't exist. |
638 |
|
|
* |
639 |
|
|
* Side effects: |
640 |
|
|
* A directory is created. |
641 |
|
|
* |
642 |
|
|
*--------------------------------------------------------------------------- |
643 |
|
|
*/ |
644 |
|
|
|
645 |
|
|
int |
646 |
|
|
TclpCreateDirectory( |
647 |
|
|
CONST char *path) /* Pathname of directory to create (UTF-8). */ |
648 |
|
|
{ |
649 |
|
|
int result; |
650 |
|
|
Tcl_DString pathString; |
651 |
|
|
|
652 |
|
|
Tcl_WinUtfToTChar(path, -1, &pathString); |
653 |
|
|
result = DoCreateDirectory(&pathString); |
654 |
|
|
Tcl_DStringFree(&pathString); |
655 |
|
|
return result; |
656 |
|
|
} |
657 |
|
|
|
658 |
|
|
static int |
659 |
|
|
DoCreateDirectory( |
660 |
|
|
Tcl_DString *pathPtr) /* Pathname of directory to create (native). */ |
661 |
|
|
{ |
662 |
|
|
int error; |
663 |
|
|
CONST TCHAR *nativePath; |
664 |
|
|
|
665 |
|
|
nativePath = (TCHAR *) Tcl_DStringValue(pathPtr); |
666 |
|
|
if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { |
667 |
|
|
error = GetLastError(); |
668 |
|
|
TclWinConvertError(error); |
669 |
|
|
return TCL_ERROR; |
670 |
|
|
} |
671 |
|
|
return TCL_OK; |
672 |
|
|
} |
673 |
|
|
|
674 |
|
|
/* |
675 |
|
|
*--------------------------------------------------------------------------- |
676 |
|
|
* |
677 |
|
|
* TclpCopyDirectory -- |
678 |
|
|
* |
679 |
|
|
* Recursively copies a directory. The target directory dst must |
680 |
|
|
* not already exist. Note that this function does not merge two |
681 |
|
|
* directory hierarchies, even if the target directory is an an |
682 |
|
|
* empty directory. |
683 |
|
|
* |
684 |
|
|
* Results: |
685 |
|
|
* If the directory was successfully copied, returns TCL_OK. |
686 |
|
|
* Otherwise the return value is TCL_ERROR, errno is set to indicate |
687 |
|
|
* the error, and the pathname of the file that caused the error |
688 |
|
|
* is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile |
689 |
|
|
* for a description of possible values for errno. |
690 |
|
|
* |
691 |
|
|
* Side effects: |
692 |
|
|
* An exact copy of the directory hierarchy src will be created |
693 |
|
|
* with the name dst. If an error occurs, the error will |
694 |
|
|
* be returned immediately, and remaining files will not be |
695 |
|
|
* processed. |
696 |
|
|
* |
697 |
|
|
*--------------------------------------------------------------------------- |
698 |
|
|
*/ |
699 |
|
|
|
700 |
|
|
int |
701 |
|
|
TclpCopyDirectory( |
702 |
|
|
CONST char *src, /* Pathname of directory to be copied |
703 |
|
|
* (UTF-8). */ |
704 |
|
|
CONST char *dst, /* Pathname of target directory (UTF-8). */ |
705 |
|
|
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free |
706 |
|
|
* DString filled with UTF-8 name of file |
707 |
|
|
* causing error. */ |
708 |
|
|
{ |
709 |
|
|
int result; |
710 |
|
|
Tcl_DString srcString, dstString; |
711 |
|
|
|
712 |
|
|
Tcl_WinUtfToTChar(src, -1, &srcString); |
713 |
|
|
Tcl_WinUtfToTChar(dst, -1, &dstString); |
714 |
|
|
|
715 |
|
|
result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr); |
716 |
|
|
|
717 |
|
|
Tcl_DStringFree(&srcString); |
718 |
|
|
Tcl_DStringFree(&dstString); |
719 |
|
|
return result; |
720 |
|
|
} |
721 |
|
|
|
722 |
|
|
/* |
723 |
|
|
*---------------------------------------------------------------------- |
724 |
|
|
* |
725 |
|
|
* TclpRemoveDirectory, DoRemoveDirectory -- |
726 |
|
|
* |
727 |
|
|
* Removes directory (and its contents, if the recursive flag is set). |
728 |
|
|
* |
729 |
|
|
* Results: |
730 |
|
|
* If the directory was successfully removed, returns TCL_OK. |
731 |
|
|
* Otherwise the return value is TCL_ERROR, errno is set to indicate |
732 |
|
|
* the error, and the pathname of the file that caused the error |
733 |
|
|
* is stored in errorPtr. Some possible values for errno are: |
734 |
|
|
* |
735 |
|
|
* EACCES: path directory can't be read and/or written. |
736 |
|
|
* EEXIST: path is a non-empty directory. |
737 |
|
|
* EINVAL: path is root directory or current directory. |
738 |
|
|
* ENOENT: path doesn't exist or is "". |
739 |
|
|
* ENOTDIR: path is not a directory. |
740 |
|
|
* |
741 |
|
|
* EACCES: path is a char device (nul:, com1:, etc.) (95) |
742 |
|
|
* EINVAL: path is a char device (nul:, com1:, etc.) (NT) |
743 |
|
|
* |
744 |
|
|
* Side effects: |
745 |
|
|
* Directory removed. If an error occurs, the error will be returned |
746 |
|
|
* immediately, and remaining files will not be deleted. |
747 |
|
|
* |
748 |
|
|
*---------------------------------------------------------------------- |
749 |
|
|
*/ |
750 |
|
|
|
751 |
|
|
int |
752 |
|
|
TclpRemoveDirectory( |
753 |
|
|
CONST char *path, /* Pathname of directory to be removed |
754 |
|
|
* (UTF-8). */ |
755 |
|
|
int recursive, /* If non-zero, removes directories that |
756 |
|
|
* are nonempty. Otherwise, will only remove |
757 |
|
|
* empty directories. */ |
758 |
|
|
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free |
759 |
|
|
* DString filled with UTF-8 name of file |
760 |
|
|
* causing error. */ |
761 |
|
|
{ |
762 |
|
|
int result; |
763 |
|
|
Tcl_DString pathString; |
764 |
|
|
|
765 |
|
|
Tcl_WinUtfToTChar(path, -1, &pathString); |
766 |
|
|
result = DoRemoveDirectory(&pathString, recursive, errorPtr); |
767 |
|
|
Tcl_DStringFree(&pathString); |
768 |
|
|
|
769 |
|
|
return result; |
770 |
|
|
} |
771 |
|
|
|
772 |
|
|
static int |
773 |
|
|
DoRemoveDirectory( |
774 |
|
|
Tcl_DString *pathPtr, /* Pathname of directory to be removed |
775 |
|
|
* (native). */ |
776 |
|
|
int recursive, /* If non-zero, removes directories that |
777 |
|
|
* are nonempty. Otherwise, will only remove |
778 |
|
|
* empty directories. */ |
779 |
|
|
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free |
780 |
|
|
* DString filled with UTF-8 name of file |
781 |
|
|
* causing error. */ |
782 |
|
|
{ |
783 |
|
|
CONST TCHAR *nativePath; |
784 |
|
|
DWORD attr; |
785 |
|
|
|
786 |
|
|
nativePath = (TCHAR *) Tcl_DStringValue(pathPtr); |
787 |
|
|
|
788 |
|
|
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { |
789 |
|
|
return TCL_OK; |
790 |
|
|
} |
791 |
|
|
TclWinConvertError(GetLastError()); |
792 |
|
|
|
793 |
|
|
/* |
794 |
|
|
* Win32s thinks that "" is the same as "." and then reports EACCES |
795 |
|
|
* instead of ENOENT. |
796 |
|
|
*/ |
797 |
|
|
|
798 |
|
|
|
799 |
|
|
if (tclWinProcs->useWide) { |
800 |
|
|
if (((WCHAR *) nativePath)[0] == '\0') { |
801 |
|
|
Tcl_SetErrno(ENOENT); |
802 |
|
|
return TCL_ERROR; |
803 |
|
|
} |
804 |
|
|
} else { |
805 |
|
|
if (((char *) nativePath)[0] == '\0') { |
806 |
|
|
Tcl_SetErrno(ENOENT); |
807 |
|
|
return TCL_ERROR; |
808 |
|
|
} |
809 |
|
|
} |
810 |
|
|
if (Tcl_GetErrno() == EACCES) { |
811 |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
812 |
|
|
if (attr != 0xffffffff) { |
813 |
|
|
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { |
814 |
|
|
/* |
815 |
|
|
* Windows 95 reports calling RemoveDirectory on a file as an |
816 |
|
|
* EACCES, not an ENOTDIR. |
817 |
|
|
*/ |
818 |
|
|
|
819 |
|
|
Tcl_SetErrno(ENOTDIR); |
820 |
|
|
goto end; |
821 |
|
|
} |
822 |
|
|
|
823 |
|
|
if (attr & FILE_ATTRIBUTE_READONLY) { |
824 |
|
|
attr &= ~FILE_ATTRIBUTE_READONLY; |
825 |
|
|
if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { |
826 |
|
|
goto end; |
827 |
|
|
} |
828 |
|
|
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { |
829 |
|
|
return TCL_OK; |
830 |
|
|
} |
831 |
|
|
TclWinConvertError(GetLastError()); |
832 |
|
|
(*tclWinProcs->setFileAttributesProc)(nativePath, |
833 |
|
|
attr | FILE_ATTRIBUTE_READONLY); |
834 |
|
|
} |
835 |
|
|
|
836 |
|
|
/* |
837 |
|
|
* Windows 95 and Win32s report removing a non-empty directory |
838 |
|
|
* as EACCES, not EEXIST. If the directory is not empty, |
839 |
|
|
* change errno so caller knows what's going on. |
840 |
|
|
*/ |
841 |
|
|
|
842 |
|
|
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { |
843 |
|
|
char *path, *find; |
844 |
|
|
HANDLE handle; |
845 |
|
|
WIN32_FIND_DATAA data; |
846 |
|
|
Tcl_DString buffer; |
847 |
|
|
int len; |
848 |
|
|
|
849 |
|
|
path = (char *) nativePath; |
850 |
|
|
|
851 |
|
|
Tcl_DStringInit(&buffer); |
852 |
|
|
len = strlen(path); |
853 |
|
|
find = Tcl_DStringAppend(&buffer, path, len); |
854 |
|
|
if ((len > 0) && (find[len - 1] != '\\')) { |
855 |
|
|
Tcl_DStringAppend(&buffer, "\\", 1); |
856 |
|
|
} |
857 |
|
|
find = Tcl_DStringAppend(&buffer, "*.*", 3); |
858 |
|
|
handle = FindFirstFileA(find, &data); |
859 |
|
|
if (handle != INVALID_HANDLE_VALUE) { |
860 |
|
|
while (1) { |
861 |
|
|
if ((strcmp(data.cFileName, ".") != 0) |
862 |
|
|
&& (strcmp(data.cFileName, "..") != 0)) { |
863 |
|
|
/* |
864 |
|
|
* Found something in this directory. |
865 |
|
|
*/ |
866 |
|
|
|
867 |
|
|
Tcl_SetErrno(EEXIST); |
868 |
|
|
break; |
869 |
|
|
} |
870 |
|
|
if (FindNextFileA(handle, &data) == FALSE) { |
871 |
|
|
break; |
872 |
|
|
} |
873 |
|
|
} |
874 |
|
|
FindClose(handle); |
875 |
|
|
} |
876 |
|
|
Tcl_DStringFree(&buffer); |
877 |
|
|
} |
878 |
|
|
} |
879 |
|
|
} |
880 |
|
|
if (Tcl_GetErrno() == ENOTEMPTY) { |
881 |
|
|
/* |
882 |
|
|
* The caller depends on EEXIST to signify that the directory is |
883 |
|
|
* not empty, not ENOTEMPTY. |
884 |
|
|
*/ |
885 |
|
|
|
886 |
|
|
Tcl_SetErrno(EEXIST); |
887 |
|
|
} |
888 |
|
|
if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) { |
889 |
|
|
/* |
890 |
|
|
* The directory is nonempty, but the recursive flag has been |
891 |
|
|
* specified, so we recursively remove all the files in the directory. |
892 |
|
|
*/ |
893 |
|
|
|
894 |
|
|
return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr); |
895 |
|
|
} |
896 |
|
|
|
897 |
|
|
end: |
898 |
|
|
if (errorPtr != NULL) { |
899 |
|
|
Tcl_WinTCharToUtf(nativePath, -1, errorPtr); |
900 |
|
|
} |
901 |
|
|
return TCL_ERROR; |
902 |
|
|
} |
903 |
|
|
|
904 |
|
|
/* |
905 |
|
|
*--------------------------------------------------------------------------- |
906 |
|
|
* |
907 |
|
|
* TraverseWinTree -- |
908 |
|
|
* |
909 |
|
|
* Traverse directory tree specified by sourcePtr, calling the function |
910 |
|
|
* traverseProc for each file and directory encountered. If destPtr |
911 |
|
|
* is non-null, each of name in the sourcePtr directory is appended to |
912 |
|
|
* the directory specified by destPtr and passed as the second argument |
913 |
|
|
* to traverseProc() . |
914 |
|
|
* |
915 |
|
|
* Results: |
916 |
|
|
* Standard Tcl result. |
917 |
|
|
* |
918 |
|
|
* Side effects: |
919 |
|
|
* None caused by TraverseWinTree, however the user specified |
920 |
|
|
* traverseProc() may change state. If an error occurs, the error will |
921 |
|
|
* be returned immediately, and remaining files will not be processed. |
922 |
|
|
* |
923 |
|
|
*--------------------------------------------------------------------------- |
924 |
|
|
*/ |
925 |
|
|
|
926 |
|
|
static int |
927 |
|
|
TraverseWinTree( |
928 |
|
|
TraversalProc *traverseProc,/* Function to call for every file and |
929 |
|
|
* directory in source hierarchy. */ |
930 |
|
|
Tcl_DString *sourcePtr, /* Pathname of source directory to be |
931 |
|
|
* traversed (native). */ |
932 |
|
|
Tcl_DString *targetPtr, /* Pathname of directory to traverse in |
933 |
|
|
* parallel with source directory (native). */ |
934 |
|
|
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free |
935 |
|
|
* DString filled with UTF-8 name of file |
936 |
|
|
* causing error. */ |
937 |
|
|
{ |
938 |
|
|
DWORD sourceAttr; |
939 |
|
|
TCHAR *nativeSource, *nativeErrfile; |
940 |
|
|
int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen; |
941 |
|
|
HANDLE handle; |
942 |
|
|
WIN32_FIND_DATAT data; |
943 |
|
|
|
944 |
|
|
nativeErrfile = NULL; |
945 |
|
|
result = TCL_OK; |
946 |
|
|
oldTargetLen = 0; /* lint. */ |
947 |
|
|
|
948 |
|
|
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); |
949 |
|
|
oldSourceLen = Tcl_DStringLength(sourcePtr); |
950 |
|
|
sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); |
951 |
|
|
if (sourceAttr == 0xffffffff) { |
952 |
|
|
nativeErrfile = nativeSource; |
953 |
|
|
goto end; |
954 |
|
|
} |
955 |
|
|
if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { |
956 |
|
|
/* |
957 |
|
|
* Process the regular file |
958 |
|
|
*/ |
959 |
|
|
|
960 |
|
|
return (*traverseProc)(sourcePtr, targetPtr, DOTREE_F, errorPtr); |
961 |
|
|
} |
962 |
|
|
|
963 |
|
|
if (tclWinProcs->useWide) { |
964 |
|
|
Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); |
965 |
|
|
Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); |
966 |
|
|
} else { |
967 |
|
|
Tcl_DStringAppend(sourcePtr, "\\*.*", 4); |
968 |
|
|
} |
969 |
|
|
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); |
970 |
|
|
handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); |
971 |
|
|
if (handle == INVALID_HANDLE_VALUE) { |
972 |
|
|
/* |
973 |
|
|
* Can't read directory |
974 |
|
|
*/ |
975 |
|
|
|
976 |
|
|
TclWinConvertError(GetLastError()); |
977 |
|
|
nativeErrfile = nativeSource; |
978 |
|
|
goto end; |
979 |
|
|
} |
980 |
|
|
|
981 |
|
|
nativeSource[oldSourceLen + 1] = '\0'; |
982 |
|
|
Tcl_DStringSetLength(sourcePtr, oldSourceLen); |
983 |
|
|
result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr); |
984 |
|
|
if (result != TCL_OK) { |
985 |
|
|
FindClose(handle); |
986 |
|
|
return result; |
987 |
|
|
} |
988 |
|
|
|
989 |
|
|
sourceLen = oldSourceLen; |
990 |
|
|
|
991 |
|
|
if (tclWinProcs->useWide) { |
992 |
|
|
sourceLen += sizeof(WCHAR); |
993 |
|
|
Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); |
994 |
|
|
Tcl_DStringSetLength(sourcePtr, sourceLen); |
995 |
|
|
} else { |
996 |
|
|
sourceLen += 1; |
997 |
|
|
Tcl_DStringAppend(sourcePtr, "\\", 1); |
998 |
|
|
} |
999 |
|
|
if (targetPtr != NULL) { |
1000 |
|
|
oldTargetLen = Tcl_DStringLength(targetPtr); |
1001 |
|
|
|
1002 |
|
|
targetLen = oldTargetLen; |
1003 |
|
|
if (tclWinProcs->useWide) { |
1004 |
|
|
targetLen += sizeof(WCHAR); |
1005 |
|
|
Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); |
1006 |
|
|
Tcl_DStringSetLength(targetPtr, targetLen); |
1007 |
|
|
} else { |
1008 |
|
|
targetLen += 1; |
1009 |
|
|
Tcl_DStringAppend(targetPtr, "\\", 1); |
1010 |
|
|
} |
1011 |
|
|
} |
1012 |
|
|
|
1013 |
|
|
found = 1; |
1014 |
|
|
for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { |
1015 |
|
|
TCHAR *nativeName; |
1016 |
|
|
int len; |
1017 |
|
|
|
1018 |
|
|
if (tclWinProcs->useWide) { |
1019 |
|
|
WCHAR *wp; |
1020 |
|
|
|
1021 |
|
|
wp = data.w.cFileName; |
1022 |
|
|
if (*wp == '.') { |
1023 |
|
|
wp++; |
1024 |
|
|
if (*wp == '.') { |
1025 |
|
|
wp++; |
1026 |
|
|
} |
1027 |
|
|
if (*wp == '\0') { |
1028 |
|
|
continue; |
1029 |
|
|
} |
1030 |
|
|
} |
1031 |
|
|
nativeName = (TCHAR *) data.w.cFileName; |
1032 |
|
|
len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR); |
1033 |
|
|
} else { |
1034 |
|
|
if ((strcmp(data.a.cFileName, ".") == 0) |
1035 |
|
|
|| (strcmp(data.a.cFileName, "..") == 0)) { |
1036 |
|
|
continue; |
1037 |
|
|
} |
1038 |
|
|
nativeName = (TCHAR *) data.a.cFileName; |
1039 |
|
|
len = strlen(data.a.cFileName); |
1040 |
|
|
} |
1041 |
|
|
|
1042 |
|
|
/* |
1043 |
|
|
* Append name after slash, and recurse on the file. |
1044 |
|
|
*/ |
1045 |
|
|
|
1046 |
|
|
Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1); |
1047 |
|
|
Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); |
1048 |
|
|
if (targetPtr != NULL) { |
1049 |
|
|
Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1); |
1050 |
|
|
Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1); |
1051 |
|
|
} |
1052 |
|
|
result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, |
1053 |
|
|
errorPtr); |
1054 |
|
|
if (result != TCL_OK) { |
1055 |
|
|
break; |
1056 |
|
|
} |
1057 |
|
|
|
1058 |
|
|
/* |
1059 |
|
|
* Remove name after slash. |
1060 |
|
|
*/ |
1061 |
|
|
|
1062 |
|
|
Tcl_DStringSetLength(sourcePtr, sourceLen); |
1063 |
|
|
if (targetPtr != NULL) { |
1064 |
|
|
Tcl_DStringSetLength(targetPtr, targetLen); |
1065 |
|
|
} |
1066 |
|
|
} |
1067 |
|
|
FindClose(handle); |
1068 |
|
|
|
1069 |
|
|
/* |
1070 |
|
|
* Strip off the trailing slash we added |
1071 |
|
|
*/ |
1072 |
|
|
|
1073 |
|
|
Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); |
1074 |
|
|
Tcl_DStringSetLength(sourcePtr, oldSourceLen); |
1075 |
|
|
if (targetPtr != NULL) { |
1076 |
|
|
Tcl_DStringSetLength(targetPtr, oldTargetLen + 1); |
1077 |
|
|
Tcl_DStringSetLength(targetPtr, oldTargetLen); |
1078 |
|
|
} |
1079 |
|
|
if (result == TCL_OK) { |
1080 |
|
|
/* |
1081 |
|
|
* Call traverseProc() on a directory after visiting all the |
1082 |
|
|
* files in that directory. |
1083 |
|
|
*/ |
1084 |
|
|
|
1085 |
|
|
result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD, |
1086 |
|
|
errorPtr); |
1087 |
|
|
} |
1088 |
|
|
end: |
1089 |
|
|
if (nativeErrfile != NULL) { |
1090 |
|
|
TclWinConvertError(GetLastError()); |
1091 |
|
|
if (errorPtr != NULL) { |
1092 |
|
|
Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); |
1093 |
|
|
} |
1094 |
|
|
result = TCL_ERROR; |
1095 |
|
|
} |
1096 |
|
|
|
1097 |
|
|
return result; |
1098 |
|
|
} |
1099 |
|
|
|
1100 |
|
|
/* |
1101 |
|
|
*---------------------------------------------------------------------- |
1102 |
|
|
* |
1103 |
|
|
* TraversalCopy |
1104 |
|
|
* |
1105 |
|
|
* Called from TraverseUnixTree in order to execute a recursive |
1106 |
|
|
* copy of a directory. |
1107 |
|
|
* |
1108 |
|
|
* Results: |
1109 |
|
|
* Standard Tcl result. |
1110 |
|
|
* |
1111 |
|
|
* Side effects: |
1112 |
|
|
* Depending on the value of type, src may be copied to dst. |
1113 |
|
|
* |
1114 |
|
|
*---------------------------------------------------------------------- |
1115 |
|
|
*/ |
1116 |
|
|
|
1117 |
|
|
static int |
1118 |
|
|
TraversalCopy( |
1119 |
|
|
Tcl_DString *srcPtr, /* Source pathname to copy. */ |
1120 |
|
|
Tcl_DString *dstPtr, /* Destination pathname of copy. */ |
1121 |
|
|
int type, /* Reason for call - see TraverseWinTree() */ |
1122 |
|
|
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled |
1123 |
|
|
* with UTF-8 name of file causing error. */ |
1124 |
|
|
{ |
1125 |
|
|
TCHAR *nativeDst, *nativeSrc; |
1126 |
|
|
DWORD attr; |
1127 |
|
|
|
1128 |
|
|
switch (type) { |
1129 |
|
|
case DOTREE_F: { |
1130 |
|
|
if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) { |
1131 |
|
|
return TCL_OK; |
1132 |
|
|
} |
1133 |
|
|
break; |
1134 |
|
|
} |
1135 |
|
|
case DOTREE_PRED: { |
1136 |
|
|
if (DoCreateDirectory(dstPtr) == TCL_OK) { |
1137 |
|
|
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr); |
1138 |
|
|
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); |
1139 |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); |
1140 |
|
|
if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) { |
1141 |
|
|
return TCL_OK; |
1142 |
|
|
} |
1143 |
|
|
TclWinConvertError(GetLastError()); |
1144 |
|
|
} |
1145 |
|
|
break; |
1146 |
|
|
} |
1147 |
|
|
case DOTREE_POSTD: { |
1148 |
|
|
return TCL_OK; |
1149 |
|
|
} |
1150 |
|
|
} |
1151 |
|
|
|
1152 |
|
|
/* |
1153 |
|
|
* There shouldn't be a problem with src, because we already |
1154 |
|
|
* checked it to get here. |
1155 |
|
|
*/ |
1156 |
|
|
|
1157 |
|
|
if (errorPtr != NULL) { |
1158 |
|
|
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); |
1159 |
|
|
Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); |
1160 |
|
|
} |
1161 |
|
|
return TCL_ERROR; |
1162 |
|
|
} |
1163 |
|
|
|
1164 |
|
|
/* |
1165 |
|
|
*---------------------------------------------------------------------- |
1166 |
|
|
* |
1167 |
|
|
* TraversalDelete -- |
1168 |
|
|
* |
1169 |
|
|
* Called by procedure TraverseWinTree for every file and |
1170 |
|
|
* directory that it encounters in a directory hierarchy. This |
1171 |
|
|
* procedure unlinks files, and removes directories after all the |
1172 |
|
|
* containing files have been processed. |
1173 |
|
|
* |
1174 |
|
|
* Results: |
1175 |
|
|
* Standard Tcl result. |
1176 |
|
|
* |
1177 |
|
|
* Side effects: |
1178 |
|
|
* Files or directory specified by src will be deleted. If an |
1179 |
|
|
* error occurs, the windows error is converted to a Posix error |
1180 |
|
|
* and errno is set accordingly. |
1181 |
|
|
* |
1182 |
|
|
*---------------------------------------------------------------------- |
1183 |
|
|
*/ |
1184 |
|
|
|
1185 |
|
|
static int |
1186 |
|
|
TraversalDelete( |
1187 |
|
|
Tcl_DString *srcPtr, /* Source pathname to delete. */ |
1188 |
|
|
Tcl_DString *dstPtr, /* Not used. */ |
1189 |
|
|
int type, /* Reason for call - see TraverseWinTree() */ |
1190 |
|
|
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled |
1191 |
|
|
* with UTF-8 name of file causing error. */ |
1192 |
|
|
{ |
1193 |
|
|
TCHAR *nativeSrc; |
1194 |
|
|
|
1195 |
|
|
switch (type) { |
1196 |
|
|
case DOTREE_F: { |
1197 |
|
|
if (DoDeleteFile(srcPtr) == TCL_OK) { |
1198 |
|
|
return TCL_OK; |
1199 |
|
|
} |
1200 |
|
|
break; |
1201 |
|
|
} |
1202 |
|
|
case DOTREE_PRED: { |
1203 |
|
|
return TCL_OK; |
1204 |
|
|
} |
1205 |
|
|
case DOTREE_POSTD: { |
1206 |
|
|
if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) { |
1207 |
|
|
return TCL_OK; |
1208 |
|
|
} |
1209 |
|
|
break; |
1210 |
|
|
} |
1211 |
|
|
} |
1212 |
|
|
|
1213 |
|
|
if (errorPtr != NULL) { |
1214 |
|
|
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr); |
1215 |
|
|
Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); |
1216 |
|
|
} |
1217 |
|
|
return TCL_ERROR; |
1218 |
|
|
} |
1219 |
|
|
|
1220 |
|
|
/* |
1221 |
|
|
*---------------------------------------------------------------------- |
1222 |
|
|
* |
1223 |
|
|
* StatError -- |
1224 |
|
|
* |
1225 |
|
|
* Sets the object result with the appropriate error. |
1226 |
|
|
* |
1227 |
|
|
* Results: |
1228 |
|
|
* None. |
1229 |
|
|
* |
1230 |
|
|
* Side effects: |
1231 |
|
|
* The interp's object result is set with an error message |
1232 |
|
|
* based on the objIndex, fileName and errno. |
1233 |
|
|
* |
1234 |
|
|
*---------------------------------------------------------------------- |
1235 |
|
|
*/ |
1236 |
|
|
|
1237 |
|
|
static void |
1238 |
|
|
StatError( |
1239 |
|
|
Tcl_Interp *interp, /* The interp that has the error */ |
1240 |
|
|
CONST char *fileName) /* The name of the file which caused the |
1241 |
|
|
* error. */ |
1242 |
|
|
{ |
1243 |
|
|
TclWinConvertError(GetLastError()); |
1244 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), |
1245 |
|
|
"could not read \"", fileName, "\": ", Tcl_PosixError(interp), |
1246 |
|
|
(char *) NULL); |
1247 |
|
|
} |
1248 |
|
|
|
1249 |
|
|
/* |
1250 |
|
|
*---------------------------------------------------------------------- |
1251 |
|
|
* |
1252 |
|
|
* GetWinFileAttributes -- |
1253 |
|
|
* |
1254 |
|
|
* Returns a Tcl_Obj containing the value of a file attribute. |
1255 |
|
|
* This routine gets the -hidden, -readonly or -system attribute. |
1256 |
|
|
* |
1257 |
|
|
* Results: |
1258 |
|
|
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object |
1259 |
|
|
* will have ref count 0. If the return value is not TCL_OK, |
1260 |
|
|
* attributePtrPtr is not touched. |
1261 |
|
|
* |
1262 |
|
|
* Side effects: |
1263 |
|
|
* A new object is allocated if the file is valid. |
1264 |
|
|
* |
1265 |
|
|
*---------------------------------------------------------------------- |
1266 |
|
|
*/ |
1267 |
|
|
|
1268 |
|
|
static int |
1269 |
|
|
GetWinFileAttributes( |
1270 |
|
|
Tcl_Interp *interp, /* The interp we are using for errors. */ |
1271 |
|
|
int objIndex, /* The index of the attribute. */ |
1272 |
|
|
CONST char *fileName, /* The name of the file. */ |
1273 |
|
|
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ |
1274 |
|
|
{ |
1275 |
|
|
DWORD result; |
1276 |
|
|
Tcl_DString ds; |
1277 |
|
|
TCHAR *nativeName; |
1278 |
|
|
|
1279 |
|
|
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); |
1280 |
|
|
result = (*tclWinProcs->getFileAttributesProc)(nativeName); |
1281 |
|
|
Tcl_DStringFree(&ds); |
1282 |
|
|
|
1283 |
|
|
if (result == 0xffffffff) { |
1284 |
|
|
StatError(interp, fileName); |
1285 |
|
|
return TCL_ERROR; |
1286 |
|
|
} |
1287 |
|
|
|
1288 |
|
|
*attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]); |
1289 |
|
|
return TCL_OK; |
1290 |
|
|
} |
1291 |
|
|
|
1292 |
|
|
/* |
1293 |
|
|
*---------------------------------------------------------------------- |
1294 |
|
|
* |
1295 |
|
|
* ConvertFileNameFormat -- |
1296 |
|
|
* |
1297 |
|
|
* Returns a Tcl_Obj containing either the long or short version of the |
1298 |
|
|
* file name. |
1299 |
|
|
* |
1300 |
|
|
* Results: |
1301 |
|
|
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object |
1302 |
|
|
* will have ref count 0. If the return value is not TCL_OK, |
1303 |
|
|
* attributePtrPtr is not touched. |
1304 |
|
|
* |
1305 |
|
|
* Side effects: |
1306 |
|
|
* A new object is allocated if the file is valid. |
1307 |
|
|
* |
1308 |
|
|
*---------------------------------------------------------------------- |
1309 |
|
|
*/ |
1310 |
|
|
|
1311 |
|
|
static int |
1312 |
|
|
ConvertFileNameFormat( |
1313 |
|
|
Tcl_Interp *interp, /* The interp we are using for errors. */ |
1314 |
|
|
int objIndex, /* The index of the attribute. */ |
1315 |
|
|
CONST char *fileName, /* The name of the file. */ |
1316 |
|
|
int longShort, /* 0 to short name, 1 to long name. */ |
1317 |
|
|
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ |
1318 |
|
|
{ |
1319 |
|
|
int pathc, i; |
1320 |
|
|
char **pathv, **newv; |
1321 |
|
|
char *resultStr; |
1322 |
|
|
Tcl_DString resultDString; |
1323 |
|
|
int result = TCL_OK; |
1324 |
|
|
|
1325 |
|
|
Tcl_SplitPath(fileName, &pathc, &pathv); |
1326 |
|
|
newv = (char **) ckalloc(pathc * sizeof(char *)); |
1327 |
|
|
|
1328 |
|
|
if (pathc == 0) { |
1329 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), |
1330 |
|
|
"could not read \"", fileName, |
1331 |
|
|
"\": no such file or directory", |
1332 |
|
|
(char *) NULL); |
1333 |
|
|
result = TCL_ERROR; |
1334 |
|
|
goto cleanup; |
1335 |
|
|
} |
1336 |
|
|
|
1337 |
|
|
for (i = 0; i < pathc; i++) { |
1338 |
|
|
if ((pathv[i][0] == '/') |
1339 |
|
|
|| ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':')) |
1340 |
|
|
|| (strcmp(pathv[i], ".") == 0) |
1341 |
|
|
|| (strcmp(pathv[i], "..") == 0)) { |
1342 |
|
|
/* |
1343 |
|
|
* Handle "/", "//machine/export", "c:/", "." or ".." by just |
1344 |
|
|
* copying the string literally. Uppercase the drive letter, |
1345 |
|
|
* just because it looks better under Windows to do so. |
1346 |
|
|
*/ |
1347 |
|
|
|
1348 |
|
|
simple: |
1349 |
|
|
pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0])); |
1350 |
|
|
newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1); |
1351 |
|
|
lstrcpyA(newv[i], pathv[i]); |
1352 |
|
|
} else { |
1353 |
|
|
char *str; |
1354 |
|
|
TCHAR *nativeName; |
1355 |
|
|
Tcl_DString ds; |
1356 |
|
|
WIN32_FIND_DATAT data; |
1357 |
|
|
HANDLE handle; |
1358 |
|
|
DWORD attr; |
1359 |
|
|
|
1360 |
|
|
Tcl_DStringInit(&resultDString); |
1361 |
|
|
str = Tcl_JoinPath(i + 1, pathv, &resultDString); |
1362 |
|
|
nativeName = Tcl_WinUtfToTChar(str, -1, &ds); |
1363 |
|
|
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); |
1364 |
|
|
if (handle == INVALID_HANDLE_VALUE) { |
1365 |
|
|
/* |
1366 |
|
|
* FindFirstFile() doesn't like root directories. We |
1367 |
|
|
* would only get a root directory here if the caller |
1368 |
|
|
* specified "c:" or "c:." and the current directory on the |
1369 |
|
|
* drive was the root directory |
1370 |
|
|
*/ |
1371 |
|
|
|
1372 |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeName); |
1373 |
|
|
if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { |
1374 |
|
|
Tcl_DStringFree(&ds); |
1375 |
|
|
Tcl_DStringFree(&resultDString); |
1376 |
|
|
|
1377 |
|
|
goto simple; |
1378 |
|
|
} |
1379 |
|
|
} |
1380 |
|
|
Tcl_DStringFree(&ds); |
1381 |
|
|
Tcl_DStringFree(&resultDString); |
1382 |
|
|
|
1383 |
|
|
if (handle == INVALID_HANDLE_VALUE) { |
1384 |
|
|
pathc = i - 1; |
1385 |
|
|
StatError(interp, fileName); |
1386 |
|
|
result = TCL_ERROR; |
1387 |
|
|
goto cleanup; |
1388 |
|
|
} |
1389 |
|
|
if (tclWinProcs->useWide) { |
1390 |
|
|
nativeName = (TCHAR *) data.w.cAlternateFileName; |
1391 |
|
|
if (longShort) { |
1392 |
|
|
if (data.w.cFileName[0] != '\0') { |
1393 |
|
|
nativeName = (TCHAR *) data.w.cFileName; |
1394 |
|
|
} |
1395 |
|
|
} else { |
1396 |
|
|
if (data.w.cAlternateFileName[0] == '\0') { |
1397 |
|
|
nativeName = (TCHAR *) data.w.cFileName; |
1398 |
|
|
} |
1399 |
|
|
} |
1400 |
|
|
} else { |
1401 |
|
|
nativeName = (TCHAR *) data.a.cAlternateFileName; |
1402 |
|
|
if (longShort) { |
1403 |
|
|
if (data.a.cFileName[0] != '\0') { |
1404 |
|
|
nativeName = (TCHAR *) data.a.cFileName; |
1405 |
|
|
} |
1406 |
|
|
} else { |
1407 |
|
|
if (data.a.cAlternateFileName[0] == '\0') { |
1408 |
|
|
nativeName = (TCHAR *) data.a.cFileName; |
1409 |
|
|
} |
1410 |
|
|
} |
1411 |
|
|
} |
1412 |
|
|
|
1413 |
|
|
/* |
1414 |
|
|
* Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying |
1415 |
|
|
* to dereference nativeName as a Unicode string. I have proven |
1416 |
|
|
* to myself that purify is wrong by running the following |
1417 |
|
|
* example when nativeName == data.w.cAlternateFileName and |
1418 |
|
|
* noting that purify doesn't complain about the first line, |
1419 |
|
|
* but does complain about the second. |
1420 |
|
|
* |
1421 |
|
|
* fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); |
1422 |
|
|
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); |
1423 |
|
|
*/ |
1424 |
|
|
|
1425 |
|
|
Tcl_WinTCharToUtf(nativeName, -1, &ds); |
1426 |
|
|
newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1); |
1427 |
|
|
lstrcpyA(newv[i], Tcl_DStringValue(&ds)); |
1428 |
|
|
Tcl_DStringFree(&ds); |
1429 |
|
|
FindClose(handle); |
1430 |
|
|
} |
1431 |
|
|
} |
1432 |
|
|
|
1433 |
|
|
Tcl_DStringInit(&resultDString); |
1434 |
|
|
resultStr = Tcl_JoinPath(pathc, newv, &resultDString); |
1435 |
|
|
*attributePtrPtr = Tcl_NewStringObj(resultStr, |
1436 |
|
|
Tcl_DStringLength(&resultDString)); |
1437 |
|
|
Tcl_DStringFree(&resultDString); |
1438 |
|
|
|
1439 |
|
|
cleanup: |
1440 |
|
|
for (i = 0; i < pathc; i++) { |
1441 |
|
|
ckfree(newv[i]); |
1442 |
|
|
} |
1443 |
|
|
ckfree((char *) newv); |
1444 |
|
|
ckfree((char *) pathv); |
1445 |
|
|
return result; |
1446 |
|
|
} |
1447 |
|
|
|
1448 |
|
|
/* |
1449 |
|
|
*---------------------------------------------------------------------- |
1450 |
|
|
* |
1451 |
|
|
* GetWinFileLongName -- |
1452 |
|
|
* |
1453 |
|
|
* Returns a Tcl_Obj containing the short version of the file |
1454 |
|
|
* name. |
1455 |
|
|
* |
1456 |
|
|
* Results: |
1457 |
|
|
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object |
1458 |
|
|
* will have ref count 0. If the return value is not TCL_OK, |
1459 |
|
|
* attributePtrPtr is not touched. |
1460 |
|
|
* |
1461 |
|
|
* Side effects: |
1462 |
|
|
* A new object is allocated if the file is valid. |
1463 |
|
|
* |
1464 |
|
|
*---------------------------------------------------------------------- |
1465 |
|
|
*/ |
1466 |
|
|
|
1467 |
|
|
static int |
1468 |
|
|
GetWinFileLongName( |
1469 |
|
|
Tcl_Interp *interp, /* The interp we are using for errors. */ |
1470 |
|
|
int objIndex, /* The index of the attribute. */ |
1471 |
|
|
CONST char *fileName, /* The name of the file. */ |
1472 |
|
|
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ |
1473 |
|
|
{ |
1474 |
|
|
return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr); |
1475 |
|
|
} |
1476 |
|
|
|
1477 |
|
|
/* |
1478 |
|
|
*---------------------------------------------------------------------- |
1479 |
|
|
* |
1480 |
|
|
* GetWinFileShortName -- |
1481 |
|
|
* |
1482 |
|
|
* Returns a Tcl_Obj containing the short version of the file |
1483 |
|
|
* name. |
1484 |
|
|
* |
1485 |
|
|
* Results: |
1486 |
|
|
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object |
1487 |
|
|
* will have ref count 0. If the return value is not TCL_OK, |
1488 |
|
|
* attributePtrPtr is not touched. |
1489 |
|
|
* |
1490 |
|
|
* Side effects: |
1491 |
|
|
* A new object is allocated if the file is valid. |
1492 |
|
|
* |
1493 |
|
|
*---------------------------------------------------------------------- |
1494 |
|
|
*/ |
1495 |
|
|
|
1496 |
|
|
static int |
1497 |
|
|
GetWinFileShortName( |
1498 |
|
|
Tcl_Interp *interp, /* The interp we are using for errors. */ |
1499 |
|
|
int objIndex, /* The index of the attribute. */ |
1500 |
|
|
CONST char *fileName, /* The name of the file. */ |
1501 |
|
|
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ |
1502 |
|
|
{ |
1503 |
|
|
return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr); |
1504 |
|
|
} |
1505 |
|
|
|
1506 |
|
|
/* |
1507 |
|
|
*---------------------------------------------------------------------- |
1508 |
|
|
* |
1509 |
|
|
* SetWinFileAttributes -- |
1510 |
|
|
* |
1511 |
|
|
* Set the file attributes to the value given by attributePtr. |
1512 |
|
|
* This routine sets the -hidden, -readonly, or -system attributes. |
1513 |
|
|
* |
1514 |
|
|
* Results: |
1515 |
|
|
* Standard TCL error. |
1516 |
|
|
* |
1517 |
|
|
* Side effects: |
1518 |
|
|
* The file's attribute is set. |
1519 |
|
|
* |
1520 |
|
|
*---------------------------------------------------------------------- |
1521 |
|
|
*/ |
1522 |
|
|
|
1523 |
|
|
static int |
1524 |
|
|
SetWinFileAttributes( |
1525 |
|
|
Tcl_Interp *interp, /* The interp we are using for errors. */ |
1526 |
|
|
int objIndex, /* The index of the attribute. */ |
1527 |
|
|
CONST char *fileName, /* The name of the file. */ |
1528 |
|
|
Tcl_Obj *attributePtr) /* The new value of the attribute. */ |
1529 |
|
|
{ |
1530 |
|
|
DWORD fileAttributes; |
1531 |
|
|
int yesNo; |
1532 |
|
|
int result; |
1533 |
|
|
Tcl_DString ds; |
1534 |
|
|
TCHAR *nativeName; |
1535 |
|
|
|
1536 |
|
|
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); |
1537 |
|
|
fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); |
1538 |
|
|
|
1539 |
|
|
if (fileAttributes == 0xffffffff) { |
1540 |
|
|
StatError(interp, fileName); |
1541 |
|
|
result = TCL_ERROR; |
1542 |
|
|
goto end; |
1543 |
|
|
} |
1544 |
|
|
|
1545 |
|
|
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo); |
1546 |
|
|
if (result != TCL_OK) { |
1547 |
|
|
goto end; |
1548 |
|
|
} |
1549 |
|
|
|
1550 |
|
|
if (yesNo) { |
1551 |
|
|
fileAttributes |= (attributeArray[objIndex]); |
1552 |
|
|
} else { |
1553 |
|
|
fileAttributes &= ~(attributeArray[objIndex]); |
1554 |
|
|
} |
1555 |
|
|
|
1556 |
|
|
if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { |
1557 |
|
|
StatError(interp, fileName); |
1558 |
|
|
result = TCL_ERROR; |
1559 |
|
|
goto end; |
1560 |
|
|
} |
1561 |
|
|
|
1562 |
|
|
end: |
1563 |
|
|
Tcl_DStringFree(&ds); |
1564 |
|
|
|
1565 |
|
|
return result; |
1566 |
|
|
} |
1567 |
|
|
|
1568 |
|
|
/* |
1569 |
|
|
*---------------------------------------------------------------------- |
1570 |
|
|
* |
1571 |
|
|
* SetWinFileLongName -- |
1572 |
|
|
* |
1573 |
|
|
* The attribute in question is a readonly attribute and cannot |
1574 |
|
|
* be set. |
1575 |
|
|
* |
1576 |
|
|
* Results: |
1577 |
|
|
* TCL_ERROR |
1578 |
|
|
* |
1579 |
|
|
* Side effects: |
1580 |
|
|
* The object result is set to a pertinant error message. |
1581 |
|
|
* |
1582 |
|
|
*---------------------------------------------------------------------- |
1583 |
|
|
*/ |
1584 |
|
|
|
1585 |
|
|
static int |
1586 |
|
|
CannotSetAttribute( |
1587 |
|
|
Tcl_Interp *interp, /* The interp we are using for errors. */ |
1588 |
|
|
int objIndex, /* The index of the attribute. */ |
1589 |
|
|
CONST char *fileName, /* The name of the file. */ |
1590 |
|
|
Tcl_Obj *attributePtr) /* The new value of the attribute. */ |
1591 |
|
|
{ |
1592 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), |
1593 |
|
|
"cannot set attribute \"", tclpFileAttrStrings[objIndex], |
1594 |
|
|
"\" for file \"", fileName, "\": attribute is readonly", |
1595 |
|
|
(char *) NULL); |
1596 |
|
|
return TCL_ERROR; |
1597 |
|
|
} |
1598 |
|
|
|
1599 |
|
|
|
1600 |
|
|
/* |
1601 |
|
|
*--------------------------------------------------------------------------- |
1602 |
|
|
* |
1603 |
|
|
* TclpListVolumes -- |
1604 |
|
|
* |
1605 |
|
|
* Lists the currently mounted volumes |
1606 |
|
|
* |
1607 |
|
|
* Results: |
1608 |
|
|
* A standard Tcl result. Will always be TCL_OK, since there is no way |
1609 |
|
|
* that this command can fail. Also, the interpreter's result is set to |
1610 |
|
|
* the list of volumes. |
1611 |
|
|
* |
1612 |
|
|
* Side effects: |
1613 |
|
|
* None |
1614 |
|
|
* |
1615 |
|
|
*--------------------------------------------------------------------------- |
1616 |
|
|
*/ |
1617 |
|
|
|
1618 |
|
|
int |
1619 |
|
|
TclpListVolumes( |
1620 |
|
|
Tcl_Interp *interp) /* Interpreter for returning volume list. */ |
1621 |
|
|
{ |
1622 |
|
|
Tcl_Obj *resultPtr, *elemPtr; |
1623 |
|
|
char buf[40 * 4]; /* There couldn't be more than 30 drives??? */ |
1624 |
|
|
int i; |
1625 |
|
|
char *p; |
1626 |
|
|
|
1627 |
|
|
resultPtr = Tcl_GetObjResult(interp); |
1628 |
|
|
|
1629 |
|
|
/* |
1630 |
|
|
* On Win32s: |
1631 |
|
|
* GetLogicalDriveStrings() isn't implemented. |
1632 |
|
|
* GetLogicalDrives() returns incorrect information. |
1633 |
|
|
*/ |
1634 |
|
|
|
1635 |
|
|
if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { |
1636 |
|
|
/* |
1637 |
|
|
* GetVolumeInformation() will detects all drives, but causes |
1638 |
|
|
* chattering on empty floppy drives. We only do this if |
1639 |
|
|
* GetLogicalDriveStrings() didn't work. It has also been reported |
1640 |
|
|
* that on some laptops it takes a while for GetVolumeInformation() |
1641 |
|
|
* to return when pinging an empty floppy drive, another reason to |
1642 |
|
|
* try to avoid calling it. |
1643 |
|
|
*/ |
1644 |
|
|
|
1645 |
|
|
buf[1] = ':'; |
1646 |
|
|
buf[2] = '/'; |
1647 |
|
|
buf[3] = '\0'; |
1648 |
|
|
|
1649 |
|
|
for (i = 0; i < 26; i++) { |
1650 |
|
|
buf[0] = (char) ('a' + i); |
1651 |
|
|
if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) |
1652 |
|
|
|| (GetLastError() == ERROR_NOT_READY)) { |
1653 |
|
|
elemPtr = Tcl_NewStringObj(buf, -1); |
1654 |
|
|
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); |
1655 |
|
|
} |
1656 |
|
|
} |
1657 |
|
|
} else { |
1658 |
|
|
for (p = buf; *p != '\0'; p += 4) { |
1659 |
|
|
p[2] = '/'; |
1660 |
|
|
elemPtr = Tcl_NewStringObj(p, -1); |
1661 |
|
|
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); |
1662 |
|
|
} |
1663 |
|
|
} |
1664 |
|
|
return TCL_OK; |
1665 |
|
|
} |
1666 |
|
|
|
1667 |
|
|
/* End of tclwinfcmd.c */ |