/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinfile.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinfile.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (show annotations) (download)
Sat Nov 5 11:07:06 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 27825 byte(s)
Set EOL properties appropriately to facilitate simultaneous Linux and Windows development.
1 /* $Header$ */
2 /*
3 * tclWinFile.c --
4 *
5 * This file contains temporary wrappers around UNIX file handling
6 * functions. These wrappers map the UNIX functions to Win32 HANDLE-style
7 * files, which can be manipulated through the Win32 console redirection
8 * interfaces.
9 *
10 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
11 *
12 * See the file "license.terms" for information on usage and redistribution
13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tclwinfile.c,v 1.1.1.1 2001/06/13 04:49:10 dtashley Exp $
16 */
17
18 #include "tclWinInt.h"
19 #include <sys/stat.h>
20 #include <shlobj.h>
21 #include <lmaccess.h> /* For TclpGetUserHome(). */
22
23 static time_t ToCTime(FILETIME fileTime);
24
25 typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
26 (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
27
28 typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC
29 (LPVOID Buffer);
30
31 typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
32 (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
33
34
35 /*
36 *---------------------------------------------------------------------------
37 *
38 * TclpFindExecutable --
39 *
40 * This procedure computes the absolute path name of the current
41 * application, given its argv[0] value.
42 *
43 * Results:
44 * A dirty UTF string that is the path to the executable. At this
45 * point we may not know the system encoding. Convert the native
46 * string value to UTF using the default encoding. The assumption
47 * is that we will still be able to parse the path given the path
48 * name contains ASCII string and '/' chars do not conflict with
49 * other UTF chars.
50 *
51 * Side effects:
52 * The variable tclNativeExecutableName gets filled in with the file
53 * name for the application, if we figured it out. If we couldn't
54 * figure it out, tclNativeExecutableName is set to NULL.
55 *
56 *---------------------------------------------------------------------------
57 */
58
59 char *
60 TclpFindExecutable(argv0)
61 CONST char *argv0; /* The value of the application's argv[0]
62 * (native). */
63 {
64 Tcl_DString ds;
65 WCHAR wName[MAX_PATH];
66
67 if (argv0 == NULL) {
68 return NULL;
69 }
70 if (tclNativeExecutableName != NULL) {
71 return tclNativeExecutableName;
72 }
73
74 /*
75 * Under Windows we ignore argv0, and return the path for the file used to
76 * create this process.
77 */
78
79 (*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH);
80 Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds);
81
82 tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1));
83 strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds));
84 Tcl_DStringFree(&ds);
85
86 TclWinNoBackslash(tclNativeExecutableName);
87 return tclNativeExecutableName;
88 }
89
90 /*
91 *----------------------------------------------------------------------
92 *
93 * TclpMatchFilesTypes --
94 *
95 * This routine is used by the globbing code to search a
96 * directory for all files which match a given pattern.
97 *
98 * Results:
99 * If the tail argument is NULL, then the matching files are
100 * added to the the interp's result. Otherwise, TclDoGlob is called
101 * recursively for each matching subdirectory. The return value
102 * is a standard Tcl result indicating whether an error occurred
103 * in globbing.
104 *
105 * Side effects:
106 * None.
107 *
108 *---------------------------------------------------------------------- */
109
110 int
111 TclpMatchFilesTypes(
112 Tcl_Interp *interp, /* Interpreter to receive results. */
113 char *separators, /* Directory separators to pass to TclDoGlob. */
114 Tcl_DString *dirPtr, /* Contains path to directory to search. */
115 char *pattern, /* Pattern to match against. */
116 char *tail, /* Pointer to end of pattern. Tail must
117 * point to a location in pattern and must
118 * not be static.*/
119 GlobTypeData *types) /* Object containing list of acceptable types.
120 * May be NULL. */
121 {
122 char drivePat[] = "?:\\";
123 const char *message;
124 char *dir, *newPattern, *root;
125 int matchDotFiles;
126 int dirLength, result = TCL_OK;
127 Tcl_DString dirString, patternString;
128 DWORD attr, volFlags;
129 HANDLE handle;
130 WIN32_FIND_DATAT data;
131 BOOL found;
132 Tcl_DString ds;
133 TCHAR *nativeName;
134 Tcl_Obj *resultPtr;
135
136 /*
137 * Convert the path to normalized form since some interfaces only
138 * accept backslashes. Also, ensure that the directory ends with a
139 * separator character.
140 */
141
142 dirLength = Tcl_DStringLength(dirPtr);
143 Tcl_DStringInit(&dirString);
144 if (dirLength == 0) {
145 Tcl_DStringAppend(&dirString, ".\\", 2);
146 } else {
147 char *p;
148
149 Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr),
150 Tcl_DStringLength(dirPtr));
151 for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
152 if (*p == '/') {
153 *p = '\\';
154 }
155 }
156 p--;
157 if ((*p != '\\') && (*p != ':')) {
158 Tcl_DStringAppend(&dirString, "\\", 1);
159 }
160 }
161 dir = Tcl_DStringValue(&dirString);
162
163 /*
164 * First verify that the specified path is actually a directory.
165 */
166
167 nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
168 attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
169 Tcl_DStringFree(&ds);
170
171 if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
172 Tcl_DStringFree(&dirString);
173 return TCL_OK;
174 }
175
176 /*
177 * Next check the volume information for the directory to see whether
178 * comparisons should be case sensitive or not. If the root is null, then
179 * we use the root of the current directory. If the root is just a drive
180 * specifier, we use the root directory of the given drive.
181 */
182
183 switch (Tcl_GetPathType(dir)) {
184 case TCL_PATH_RELATIVE:
185 found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
186 &volFlags, NULL, 0);
187 break;
188 case TCL_PATH_VOLUME_RELATIVE:
189 if (dir[0] == '\\') {
190 root = NULL;
191 } else {
192 root = drivePat;
193 *root = dir[0];
194 }
195 found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
196 &volFlags, NULL, 0);
197 break;
198 case TCL_PATH_ABSOLUTE:
199 if (dir[1] == ':') {
200 root = drivePat;
201 *root = dir[0];
202 found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
203 &volFlags, NULL, 0);
204 } else if (dir[1] == '\\') {
205 char *p;
206
207 p = strchr(dir + 2, '\\');
208 p = strchr(p + 1, '\\');
209 p++;
210 nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
211 found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
212 NULL, 0, NULL, NULL, &volFlags, NULL, 0);
213 Tcl_DStringFree(&ds);
214 }
215 break;
216 }
217
218 if (found == 0) {
219 message = "couldn't read volume information for \"";
220 goto error;
221 }
222
223 /*
224 * In Windows, although some volumes may support case sensitivity, Windows
225 * doesn't honor case. So in globbing we need to ignore the case
226 * of file names.
227 */
228
229 Tcl_DStringInit(&patternString);
230 newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern);
231 Tcl_UtfToLower(newPattern);
232
233 /*
234 * We need to check all files in the directory, so append a *.*
235 * to the path.
236 */
237
238 dir = Tcl_DStringAppend(&dirString, "*.*", 3);
239 nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
240 handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
241 Tcl_DStringFree(&ds);
242
243 if (handle == INVALID_HANDLE_VALUE) {
244 message = "couldn't read directory \"";
245 goto error;
246 }
247
248 /*
249 * Clean up the tail pointer. Leave the tail pointing to the
250 * first character after the path separator or NULL.
251 */
252
253 if (*tail == '\\') {
254 tail++;
255 }
256 if (*tail == '\0') {
257 tail = NULL;
258 } else {
259 tail++;
260 }
261
262 /*
263 * Check to see if the pattern needs to compare with dot files.
264 */
265
266 if ((newPattern[0] == '.')
267 || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
268 matchDotFiles = 1;
269 } else {
270 matchDotFiles = 0;
271 }
272
273 /*
274 * Now iterate over all of the files in the directory.
275 */
276
277 resultPtr = Tcl_GetObjResult(interp);
278 for (found = 1; found != 0;
279 found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
280 TCHAR *nativeMatchResult;
281 char *name, *fname;
282
283 if (tclWinProcs->useWide) {
284 nativeName = (TCHAR *) data.w.cFileName;
285 } else {
286 nativeName = (TCHAR *) data.a.cFileName;
287 }
288 name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
289
290 /*
291 * Check to see if the file matches the pattern. We need to convert
292 * the file name to lower case for comparison purposes. Note that we
293 * are ignoring the case sensitivity flag because Windows doesn't honor
294 * case even if the volume is case sensitive. If the volume also
295 * doesn't preserve case, then we previously returned the lower case
296 * form of the name. This didn't seem quite right since there are
297 * non-case-preserving volumes that actually return mixed case. So now
298 * we are returning exactly what we get from the system.
299 */
300
301 Tcl_UtfToLower(name);
302 nativeMatchResult = NULL;
303
304 if ((matchDotFiles == 0) && (name[0] == '.')) {
305 /*
306 * Ignore hidden files.
307 */
308 } else if (Tcl_StringMatch(name, newPattern) != 0) {
309 nativeMatchResult = nativeName;
310 }
311 Tcl_DStringFree(&ds);
312
313 if (nativeMatchResult == NULL) {
314 continue;
315 }
316
317 /*
318 * If the file matches, then we need to process the remainder of the
319 * path. If there are more characters to process, then ensure matching
320 * files are directories and call TclDoGlob. Otherwise, just add the
321 * file to the result.
322 */
323
324 name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
325 Tcl_DStringAppend(dirPtr, name, -1);
326 Tcl_DStringFree(&ds);
327
328 fname = Tcl_DStringValue(dirPtr);
329 nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds);
330 attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
331 Tcl_DStringFree(&ds);
332
333 if (tail == NULL) {
334 int typeOk = 1;
335 if (types != NULL) {
336 if (types->perm != 0) {
337 if (
338 ((types->perm & TCL_GLOB_PERM_RONLY) &&
339 !(attr & FILE_ATTRIBUTE_READONLY)) ||
340 ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
341 !(attr & FILE_ATTRIBUTE_HIDDEN)) ||
342 ((types->perm & TCL_GLOB_PERM_R) &&
343 (TclpAccess(fname, R_OK) != 0)) ||
344 ((types->perm & TCL_GLOB_PERM_W) &&
345 (TclpAccess(fname, W_OK) != 0)) ||
346 ((types->perm & TCL_GLOB_PERM_X) &&
347 (TclpAccess(fname, X_OK) != 0))
348 ) {
349 typeOk = 0;
350 }
351 }
352 if (typeOk && types->type != 0) {
353 struct stat buf;
354 /*
355 * We must match at least one flag to be listed
356 */
357 typeOk = 0;
358 if (TclpLstat(fname, &buf) >= 0) {
359 /*
360 * In order bcdpfls as in 'find -t'
361 */
362 if (
363 ((types->type & TCL_GLOB_TYPE_BLOCK) &&
364 S_ISBLK(buf.st_mode)) ||
365 ((types->type & TCL_GLOB_TYPE_CHAR) &&
366 S_ISCHR(buf.st_mode)) ||
367 ((types->type & TCL_GLOB_TYPE_DIR) &&
368 S_ISDIR(buf.st_mode)) ||
369 ((types->type & TCL_GLOB_TYPE_PIPE) &&
370 S_ISFIFO(buf.st_mode)) ||
371 ((types->type & TCL_GLOB_TYPE_FILE) &&
372 S_ISREG(buf.st_mode))
373 #ifdef S_ISLNK
374 || ((types->type & TCL_GLOB_TYPE_LINK) &&
375 S_ISLNK(buf.st_mode))
376 #endif
377 #ifdef S_ISSOCK
378 || ((types->type & TCL_GLOB_TYPE_SOCK) &&
379 S_ISSOCK(buf.st_mode))
380 #endif
381 ) {
382 typeOk = 1;
383 }
384 } else {
385 /* Posix error occurred */
386 }
387 }
388 }
389 if (typeOk) {
390 Tcl_ListObjAppendElement(interp, resultPtr,
391 Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr)));
392 }
393 } else if (attr & FILE_ATTRIBUTE_DIRECTORY) {
394 Tcl_DStringAppend(dirPtr, "/", 1);
395 result = TclDoGlob(interp, separators, dirPtr, tail, types);
396 if (result != TCL_OK) {
397 break;
398 }
399 }
400 Tcl_DStringSetLength(dirPtr, dirLength);
401 }
402
403 FindClose(handle);
404 Tcl_DStringFree(&dirString);
405 Tcl_DStringFree(&patternString);
406
407 return result;
408
409 error:
410 Tcl_DStringFree(&dirString);
411 TclWinConvertError(GetLastError());
412 Tcl_ResetResult(interp);
413 Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ",
414 Tcl_PosixError(interp), (char *) NULL);
415 return TCL_ERROR;
416 }
417
418 /*
419 * TclpMatchFiles --
420 *
421 * This function is now obsolete. Call the above function
422 * 'TclpMatchFilesTypes' instead.
423 */
424 int
425 TclpMatchFiles(
426 Tcl_Interp *interp, /* Interpreter to receive results. */
427 char *separators, /* Directory separators to pass to TclDoGlob. */
428 Tcl_DString *dirPtr, /* Contains path to directory to search. */
429 char *pattern, /* Pattern to match against. */
430 char *tail) /* Pointer to end of pattern. Tail must
431 * point to a location in pattern and must
432 * not be static.*/
433 {
434 return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
435 }
436
437 /*
438 *----------------------------------------------------------------------
439 *
440 * TclpGetUserHome --
441 *
442 * This function takes the passed in user name and finds the
443 * corresponding home directory specified in the password file.
444 *
445 * Results:
446 * The result is a pointer to a string specifying the user's home
447 * directory, or NULL if the user's home directory could not be
448 * determined. Storage for the result string is allocated in
449 * bufferPtr; the caller must call Tcl_DStringFree() when the result
450 * is no longer needed.
451 *
452 * Side effects:
453 * None.
454 *
455 *----------------------------------------------------------------------
456 */
457
458 char *
459 TclpGetUserHome(name, bufferPtr)
460 CONST char *name; /* User name for desired home directory. */
461 Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
462 * with name of user's home directory. */
463 {
464 char *result;
465 HINSTANCE netapiInst;
466
467 result = NULL;
468
469 Tcl_DStringInit(bufferPtr);
470
471 netapiInst = LoadLibraryA("netapi32.dll");
472 if (netapiInst != NULL) {
473 NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
474 NETGETDCNAMEPROC *netGetDCNameProc;
475 NETUSERGETINFOPROC *netUserGetInfoProc;
476
477 netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
478 GetProcAddress(netapiInst, "NetApiBufferFree");
479 netGetDCNameProc = (NETGETDCNAMEPROC *)
480 GetProcAddress(netapiInst, "NetGetDCName");
481 netUserGetInfoProc = (NETUSERGETINFOPROC *)
482 GetProcAddress(netapiInst, "NetUserGetInfo");
483 if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
484 && (netApiBufferFreeProc != NULL)) {
485 USER_INFO_1 *uiPtr;
486 Tcl_DString ds;
487 int nameLen, badDomain;
488 char *domain;
489 WCHAR *wName, *wHomeDir, *wDomain;
490 WCHAR buf[MAX_PATH];
491
492 badDomain = 0;
493 nameLen = -1;
494 wDomain = NULL;
495 domain = strchr(name, '@');
496 if (domain != NULL) {
497 Tcl_DStringInit(&ds);
498 wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
499 badDomain = (*netGetDCNameProc)(NULL, wName,
500 (LPBYTE *) &wDomain);
501 Tcl_DStringFree(&ds);
502 nameLen = domain - name;
503 }
504 if (badDomain == 0) {
505 Tcl_DStringInit(&ds);
506 wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
507 if ((*netUserGetInfoProc)(wDomain, wName, 1,
508 (LPBYTE *) &uiPtr) == 0) {
509 wHomeDir = uiPtr->usri1_home_dir;
510 if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
511 Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
512 bufferPtr);
513 } else {
514 /*
515 * User exists but has no home dir. Return
516 * "{Windows Drive}:/users/default".
517 */
518
519 GetWindowsDirectoryW(buf, MAX_PATH);
520 Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
521 Tcl_DStringAppend(bufferPtr, "/users/default", -1);
522 }
523 result = Tcl_DStringValue(bufferPtr);
524 (*netApiBufferFreeProc)((void *) uiPtr);
525 }
526 Tcl_DStringFree(&ds);
527 }
528 if (wDomain != NULL) {
529 (*netApiBufferFreeProc)((void *) wDomain);
530 }
531 }
532 FreeLibrary(netapiInst);
533 }
534 if (result == NULL) {
535 /*
536 * Look in the "Password Lists" section of system.ini for the
537 * local user. There are also entries in that section that begin
538 * with a "*" character that are used by Windows for other
539 * purposes; ignore user names beginning with a "*".
540 */
541
542 char buf[MAX_PATH];
543
544 if (name[0] != '*') {
545 if (GetPrivateProfileStringA("Password Lists", name, "", buf,
546 MAX_PATH, "system.ini") > 0) {
547 /*
548 * User exists, but there is no such thing as a home
549 * directory in system.ini. Return "{Windows drive}:/".
550 */
551
552 GetWindowsDirectoryA(buf, MAX_PATH);
553 Tcl_DStringAppend(bufferPtr, buf, 3);
554 result = Tcl_DStringValue(bufferPtr);
555 }
556 }
557 }
558
559 return result;
560 }
561
562 /*
563 *---------------------------------------------------------------------------
564 *
565 * TclpAccess --
566 *
567 * This function replaces the library version of access(), fixing the
568 * following bugs:
569 *
570 * 1. access() returns that all files have execute permission.
571 *
572 * Results:
573 * See access documentation.
574 *
575 * Side effects:
576 * See access documentation.
577 *
578 *---------------------------------------------------------------------------
579 */
580
581 int
582 TclpAccess(
583 CONST char *path, /* Path of file to access (UTF-8). */
584 int mode) /* Permission setting. */
585 {
586 Tcl_DString ds;
587 TCHAR *nativePath;
588 DWORD attr;
589
590 nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
591 attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
592 Tcl_DStringFree(&ds);
593
594 if (attr == 0xffffffff) {
595 /*
596 * File doesn't exist.
597 */
598
599 TclWinConvertError(GetLastError());
600 return -1;
601 }
602
603 if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
604 /*
605 * File is not writable.
606 */
607
608 Tcl_SetErrno(EACCES);
609 return -1;
610 }
611
612 if (mode & X_OK) {
613 CONST char *p;
614
615 if (attr & FILE_ATTRIBUTE_DIRECTORY) {
616 /*
617 * Directories are always executable.
618 */
619
620 return 0;
621 }
622 p = strrchr(path, '.');
623 if (p != NULL) {
624 p++;
625 if ((stricmp(p, "exe") == 0)
626 || (stricmp(p, "com") == 0)
627 || (stricmp(p, "bat") == 0)) {
628 /*
629 * File that ends with .exe, .com, or .bat is executable.
630 */
631
632 return 0;
633 }
634 }
635 Tcl_SetErrno(EACCES);
636 return -1;
637 }
638
639 return 0;
640 }
641
642 /*
643 *----------------------------------------------------------------------
644 *
645 * TclpChdir --
646 *
647 * This function replaces the library version of chdir().
648 *
649 * Results:
650 * See chdir() documentation.
651 *
652 * Side effects:
653 * See chdir() documentation.
654 *
655 *----------------------------------------------------------------------
656 */
657
658 int
659 TclpChdir(path)
660 CONST char *path; /* Path to new working directory (UTF-8). */
661 {
662 int result;
663 Tcl_DString ds;
664 TCHAR *nativePath;
665
666 nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
667 result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
668 Tcl_DStringFree(&ds);
669
670 if (result == 0) {
671 TclWinConvertError(GetLastError());
672 return -1;
673 }
674 return 0;
675 }
676
677 /*
678 *----------------------------------------------------------------------
679 *
680 * TclpGetCwd --
681 *
682 * This function replaces the library version of getcwd().
683 *
684 * Results:
685 * The result is a pointer to a string specifying the current
686 * directory, or NULL if the current directory could not be
687 * determined. If NULL is returned, an error message is left in the
688 * interp's result. Storage for the result string is allocated in
689 * bufferPtr; the caller must call Tcl_DStringFree() when the result
690 * is no longer needed.
691 *
692 * Side effects:
693 * None.
694 *
695 *----------------------------------------------------------------------
696 */
697
698 char *
699 TclpGetCwd(interp, bufferPtr)
700 Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
701 Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
702 * with name of current directory. */
703 {
704 WCHAR buffer[MAX_PATH];
705 char *p;
706
707 if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
708 TclWinConvertError(GetLastError());
709 if (interp != NULL) {
710 Tcl_AppendResult(interp,
711 "error getting working directory name: ",
712 Tcl_PosixError(interp), (char *) NULL);
713 }
714 return NULL;
715 }
716
717 /*
718 * Watch for the wierd Windows c:\\UNC syntax.
719 */
720
721 if (tclWinProcs->useWide) {
722 WCHAR *native;
723
724 native = (WCHAR *) buffer;
725 if ((native[0] != '\0') && (native[1] == ':')
726 && (native[2] == '\\') && (native[3] == '\\')) {
727 native += 2;
728 }
729 Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
730 } else {
731 char *native;
732
733 native = (char *) buffer;
734 if ((native[0] != '\0') && (native[1] == ':')
735 && (native[2] == '\\') && (native[3] == '\\')) {
736 native += 2;
737 }
738 Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
739 }
740
741 /*
742 * Convert to forward slashes for easier use in scripts.
743 */
744
745 for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
746 if (*p == '\\') {
747 *p = '/';
748 }
749 }
750 return Tcl_DStringValue(bufferPtr);
751 }
752
753 /*
754 *----------------------------------------------------------------------
755 *
756 * TclpStat --
757 *
758 * This function replaces the library version of stat(), fixing
759 * the following bugs:
760 *
761 * 1. stat("c:") returns an error.
762 * 2. Borland stat() return time in GMT instead of localtime.
763 * 3. stat("\\server\mount") would return error.
764 * 4. Accepts slashes or backslashes.
765 * 5. st_dev and st_rdev were wrong for UNC paths.
766 *
767 * Results:
768 * See stat documentation.
769 *
770 * Side effects:
771 * See stat documentation.
772 *
773 *----------------------------------------------------------------------
774 */
775
776 int
777 TclpStat(path, statPtr)
778 CONST char *path; /* Path of file to stat (UTF-8). */
779 struct stat *statPtr; /* Filled with results of stat call. */
780 {
781 Tcl_DString ds;
782 TCHAR *nativePath;
783 WIN32_FIND_DATAT data;
784 HANDLE handle;
785 DWORD attr;
786 WCHAR nativeFullPath[MAX_PATH];
787 TCHAR *nativePart;
788 char *p, *fullPath;
789 int dev, mode;
790
791 /*
792 * Eliminate file names containing wildcard characters, or subsequent
793 * call to FindFirstFile() will expand them, matching some other file.
794 */
795
796 if (strpbrk(path, "?*") != NULL) {
797 Tcl_SetErrno(ENOENT);
798 return -1;
799 }
800
801 nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
802 handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
803 if (handle == INVALID_HANDLE_VALUE) {
804 /*
805 * FindFirstFile() doesn't work on root directories, so call
806 * GetFileAttributes() to see if the specified file exists.
807 */
808
809 attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
810 if (attr == 0xffffffff) {
811 Tcl_DStringFree(&ds);
812 Tcl_SetErrno(ENOENT);
813 return -1;
814 }
815
816 /*
817 * Make up some fake information for this file. It has the
818 * correct file attributes and a time of 0.
819 */
820
821 memset(&data, 0, sizeof(data));
822 data.a.dwFileAttributes = attr;
823 } else {
824 FindClose(handle);
825 }
826
827 (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
828 &nativePart);
829
830 Tcl_DStringFree(&ds);
831 fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
832
833 dev = -1;
834 if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
835 char *p;
836 DWORD dw;
837 TCHAR *nativeVol;
838 Tcl_DString volString;
839
840 p = strchr(fullPath + 2, '\\');
841 p = strchr(p + 1, '\\');
842 if (p == NULL) {
843 /*
844 * Add terminating backslash to fullpath or
845 * GetVolumeInformation() won't work.
846 */
847
848 fullPath = Tcl_DStringAppend(&ds, "\\", 1);
849 p = fullPath + Tcl_DStringLength(&ds);
850 } else {
851 p++;
852 }
853 nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
854 dw = (DWORD) -1;
855 (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
856 NULL, NULL, NULL, 0);
857 /*
858 * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
859 * but GetVolumeInformation() returns failure for "\\.\NUL". This
860 * will cause "NUL" to get a drive number of -1, which makes about
861 * as much sense as anything since the special devices don't live on
862 * any drive.
863 */
864
865 dev = dw;
866 Tcl_DStringFree(&volString);
867 } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
868 dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
869 }
870 Tcl_DStringFree(&ds);
871
872 attr = data.a.dwFileAttributes;
873 mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
874 mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
875 p = strrchr(path, '.');
876 if (p != NULL) {
877 if ((lstrcmpiA(p, ".exe") == 0)
878 || (lstrcmpiA(p, ".com") == 0)
879 || (lstrcmpiA(p, ".bat") == 0)
880 || (lstrcmpiA(p, ".pif") == 0)) {
881 mode |= S_IEXEC;
882 }
883 }
884
885 /*
886 * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
887 * other positions.
888 */
889
890 mode |= (mode & 0x0700) >> 3;
891 mode |= (mode & 0x0700) >> 6;
892
893 statPtr->st_dev = (dev_t) dev;
894 statPtr->st_ino = 0;
895 statPtr->st_mode = (unsigned short) mode;
896 statPtr->st_nlink = 1;
897 statPtr->st_uid = 0;
898 statPtr->st_gid = 0;
899 statPtr->st_rdev = (dev_t) dev;
900 statPtr->st_size = data.a.nFileSizeLow;
901 statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
902 statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
903 statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
904 return 0;
905 }
906
907 static time_t
908 ToCTime(
909 FILETIME fileTime) /* UTC Time to convert to local time_t. */
910 {
911 FILETIME localFileTime;
912 SYSTEMTIME systemTime;
913 struct tm tm;
914
915 if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) {
916 return 0;
917 }
918 if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) {
919 return 0;
920 }
921 tm.tm_sec = systemTime.wSecond;
922 tm.tm_min = systemTime.wMinute;
923 tm.tm_hour = systemTime.wHour;
924 tm.tm_mday = systemTime.wDay;
925 tm.tm_mon = systemTime.wMonth - 1;
926 tm.tm_year = systemTime.wYear - 1900;
927 tm.tm_wday = 0;
928 tm.tm_yday = 0;
929 tm.tm_isdst = -1;
930
931 return mktime(&tm);
932 }
933
934 #if 0
935
936 /*
937 * Borland's stat doesn't take into account localtime.
938 */
939
940 if ((result == 0) && (buf->st_mtime != 0)) {
941 TIME_ZONE_INFORMATION tz;
942 int time, bias;
943
944 time = GetTimeZoneInformation(&tz);
945 bias = tz.Bias;
946 if (time == TIME_ZONE_ID_DAYLIGHT) {
947 bias += tz.DaylightBias;
948 }
949 bias *= 60;
950 buf->st_atime -= bias;
951 buf->st_ctime -= bias;
952 buf->st_mtime -= bias;
953 }
954
955 #endif
956
957
958 #if 0
959 /*
960 *-------------------------------------------------------------------------
961 *
962 * TclWinResolveShortcut --
963 *
964 * Resolve a potential Windows shortcut to get the actual file or
965 * directory in question.
966 *
967 * Results:
968 * Returns 1 if the shortcut could be resolved, or 0 if there was
969 * an error or if the filename was not a shortcut.
970 * If bufferPtr did hold the name of a shortcut, it is modified to
971 * hold the resolved target of the shortcut instead.
972 *
973 * Side effects:
974 * Loads and unloads OLE package to determine if filename refers to
975 * a shortcut.
976 *
977 *-------------------------------------------------------------------------
978 */
979
980 int
981 TclWinResolveShortcut(bufferPtr)
982 Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
983 * return, holds resolved file name. */
984 {
985 HRESULT hres;
986 IShellLink *psl;
987 IPersistFile *ppf;
988 WIN32_FIND_DATA wfd;
989 WCHAR wpath[MAX_PATH];
990 char *path, *ext;
991 char realFileName[MAX_PATH];
992
993 /*
994 * Windows system calls do not automatically resolve
995 * shortcuts like UNIX automatically will with symbolic links.
996 */
997
998 path = Tcl_DStringValue(bufferPtr);
999 ext = strrchr(path, '.');
1000 if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
1001 return 0;
1002 }
1003
1004 CoInitialize(NULL);
1005 path = Tcl_DStringValue(bufferPtr);
1006 realFileName[0] = '\0';
1007 hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
1008 &IID_IShellLink, &psl);
1009 if (SUCCEEDED(hres)) {
1010 hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
1011 if (SUCCEEDED(hres)) {
1012 MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
1013 hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
1014 if (SUCCEEDED(hres)) {
1015 hres = psl->lpVtbl->Resolve(psl, NULL,
1016 SLR_ANY_MATCH | SLR_NO_UI);
1017 if (SUCCEEDED(hres)) {
1018 hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
1019 &wfd, 0);
1020 }
1021 }
1022 ppf->lpVtbl->Release(ppf);
1023 }
1024 psl->lpVtbl->Release(psl);
1025 }
1026 CoUninitialize();
1027
1028 if (realFileName[0] != '\0') {
1029 Tcl_DStringSetLength(bufferPtr, 0);
1030 Tcl_DStringAppend(bufferPtr, realFileName, -1);
1031 return 1;
1032 }
1033 return 0;
1034 }
1035 #endif
1036
1037 /* End of tclwinfile.c */

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25