1/*
2 * tclUnixFile.c --
3 *
4 *      This file contains wrappers around UNIX file handling functions.
5 *      These wrappers mask differences between Windows and UNIX.
6 *
7 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
8 *
9 * See the file "license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: tclUnixFile.c,v 1.32.2.2 2003/10/31 08:46:41 vincentdarley Exp $
13 */
14
15#include "tclInt.h"
16#include "tclPort.h"
17
18static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
19
20
21/*
22 *---------------------------------------------------------------------------
23 *
24 * TclpFindExecutable --
25 *
26 *	This procedure computes the absolute path name of the current
27 *	application, given its argv[0] value.
28 *
29 * Results:
30 *	A dirty UTF string that is the path to the executable.  At this
31 *	point we may not know the system encoding.  Convert the native
32 *	string value to UTF using the default encoding.  The assumption
33 *	is that we will still be able to parse the path given the path
34 *	name contains ASCII string and '/' chars do not conflict with
35 *	other UTF chars.
36 *
37 * Side effects:
38 *	The variable tclNativeExecutableName gets filled in with the file
39 *	name for the application, if we figured it out.  If we couldn't
40 *	figure it out, tclNativeExecutableName is set to NULL.
41 *
42 *---------------------------------------------------------------------------
43 */
44
45char *
46TclpFindExecutable(argv0)
47    CONST char *argv0;		/* The value of the application's argv[0]
48				 * (native). */
49{
50    CONST char *name, *p;
51    Tcl_StatBuf statBuf;
52    int length;
53    Tcl_DString buffer, nameString;
54
55    if (argv0 == NULL) {
56	return NULL;
57    }
58    if (tclNativeExecutableName != NULL) {
59	return tclNativeExecutableName;
60    }
61
62    Tcl_DStringInit(&buffer);
63
64    name = argv0;
65    for (p = name; *p != '\0'; p++) {
66	if (*p == '/') {
67	    /*
68	     * The name contains a slash, so use the name directly
69	     * without doing a path search.
70	     */
71
72	    goto gotName;
73	}
74    }
75
76    p = getenv("PATH");					/* INTL: Native. */
77    if (p == NULL) {
78	/*
79	 * There's no PATH environment variable; use the default that
80	 * is used by sh.
81	 */
82
83	p = ":/bin:/usr/bin";
84    } else if (*p == '\0') {
85	/*
86	 * An empty path is equivalent to ".".
87	 */
88
89	p = "./";
90    }
91
92    /*
93     * Search through all the directories named in the PATH variable
94     * to see if argv[0] is in one of them.  If so, use that file
95     * name.
96     */
97
98    while (1) {
99	while (isspace(UCHAR(*p))) {		/* INTL: BUG */
100	    p++;
101	}
102	name = p;
103	while ((*p != ':') && (*p != 0)) {
104	    p++;
105	}
106	Tcl_DStringSetLength(&buffer, 0);
107	if (p != name) {
108	    Tcl_DStringAppend(&buffer, name, p - name);
109	    if (p[-1] != '/') {
110		Tcl_DStringAppend(&buffer, "/", 1);
111	    }
112	}
113	name = Tcl_DStringAppend(&buffer, argv0, -1);
114
115	/*
116	 * INTL: The following calls to access() and stat() should not be
117	 * converted to Tclp routines because they need to operate on native
118	 * strings directly.
119	 */
120
121	if ((access(name, X_OK) == 0)			/* INTL: Native. */
122		&& (TclOSstat(name, &statBuf) == 0)	/* INTL: Native. */
123		&& S_ISREG(statBuf.st_mode)) {
124	    goto gotName;
125	}
126	if (*p == '\0') {
127	    break;
128	} else if (*(p+1) == 0) {
129	    p = "./";
130	} else {
131	    p++;
132	}
133    }
134    goto done;
135
136    /*
137     * If the name starts with "/" then just copy it to tclExecutableName.
138     */
139
140gotName:
141#ifdef DJGPP
142    if (name[1] == ':')  {
143#else
144    if (name[0] == '/')  {
145#endif
146	Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
147	tclNativeExecutableName = (char *)
148		ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
149	strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString));
150	Tcl_DStringFree(&nameString);
151	goto done;
152    }
153
154    /*
155     * The name is relative to the current working directory.  First
156     * strip off a leading "./", if any, then add the full path name of
157     * the current working directory.
158     */
159
160    if ((name[0] == '.') && (name[1] == '/')) {
161	name += 2;
162    }
163
164    Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
165
166    Tcl_DStringFree(&buffer);
167    TclpGetCwd(NULL, &buffer);
168
169    length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2;
170    tclNativeExecutableName = (char *) ckalloc((unsigned) length);
171    strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer));
172    tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/';
173    strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1,
174	    Tcl_DStringValue(&nameString));
175    Tcl_DStringFree(&nameString);
176
177done:
178    Tcl_DStringFree(&buffer);
179    return tclNativeExecutableName;
180}
181
182/*
183 *----------------------------------------------------------------------
184 *
185 * TclpMatchInDirectory --
186 *
187 *	This routine is used by the globbing code to search a
188 *	directory for all files which match a given pattern.
189 *
190 * Results:
191 *	The return value is a standard Tcl result indicating whether an
192 *	error occurred in globbing.  Errors are left in interp, good
193 *	results are lappended to resultPtr (which must be a valid object)
194 *
195 * Side effects:
196 *	None.
197 *
198 *---------------------------------------------------------------------- */
199
200int
201TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
202    Tcl_Interp *interp;		/* Interpreter to receive errors. */
203    Tcl_Obj *resultPtr;		/* List object to lappend results. */
204    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
205    CONST char *pattern;	/* Pattern to match against. */
206    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
207				 * May be NULL. In particular the directory
208				 * flag is very important. */
209{
210    CONST char *native;
211    Tcl_Obj *fileNamePtr;
212
213    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
214    if (fileNamePtr == NULL) {
215	return TCL_ERROR;
216    }
217
218    if (pattern == NULL || (*pattern == '\0')) {
219	/* Match a file directly */
220	native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
221	if (NativeMatchType(native, types)) {
222	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
223	}
224	Tcl_DecrRefCount(fileNamePtr);
225	return TCL_OK;
226    } else {
227	DIR *d;
228	Tcl_DirEntry *entryPtr;
229	CONST char *dirName;
230	int dirLength;
231	int matchHidden;
232	int nativeDirLen;
233	Tcl_StatBuf statBuf;
234	Tcl_DString ds;      /* native encoding of dir */
235	Tcl_DString dsOrig;  /* utf-8 encoding of dir */
236
237	Tcl_DStringInit(&dsOrig);
238	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
239	Tcl_DStringAppend(&dsOrig, dirName, dirLength);
240
241	/*
242	 * Make sure that the directory part of the name really is a
243	 * directory.  If the directory name is "", use the name "."
244	 * instead, because some UNIX systems don't treat "" like "."
245	 * automatically.  Keep the "" for use in generating file names,
246	 * otherwise "glob foo.c" would return "./foo.c".
247	 */
248
249	if (dirLength == 0) {
250	    dirName = ".";
251	} else {
252	    dirName = Tcl_DStringValue(&dsOrig);
253	    /* Make sure we have a trailing directory delimiter */
254	    if (dirName[dirLength-1] != '/') {
255		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
256		dirLength++;
257	    }
258	}
259	Tcl_DecrRefCount(fileNamePtr);
260
261	/*
262	 * Now open the directory for reading and iterate over the contents.
263	 */
264
265	native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
266
267	if ((TclOSstat(native, &statBuf) != 0)		/* INTL: Native. */
268		|| !S_ISDIR(statBuf.st_mode)) {
269	    Tcl_DStringFree(&dsOrig);
270	    Tcl_DStringFree(&ds);
271	    return TCL_OK;
272	}
273
274	d = opendir(native);				/* INTL: Native. */
275	if (d == NULL) {
276	    Tcl_DStringFree(&ds);
277	    Tcl_ResetResult(interp);
278	    Tcl_AppendResult(interp, "couldn't read directory \"",
279		    Tcl_DStringValue(&dsOrig), "\": ",
280		    Tcl_PosixError(interp), (char *) NULL);
281	    Tcl_DStringFree(&dsOrig);
282	    return TCL_ERROR;
283	}
284
285	nativeDirLen = Tcl_DStringLength(&ds);
286
287	/*
288	 * Check to see if -type or the pattern requests hidden files.
289	 */
290	matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) ||
291		((pattern[0] == '.')
292			|| ((pattern[0] == '\\') && (pattern[1] == '.'))));
293
294	while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
295	    Tcl_DString utfDs;
296	    CONST char *utfname;
297
298	    /*
299	     * Skip this file if it doesn't agree with the hidden
300	     * parameters requested by the user (via -type or pattern).
301	     */
302	    if (*entryPtr->d_name == '.') {
303		if (!matchHidden) continue;
304	    } else {
305		if (matchHidden) continue;
306	    }
307
308	    /*
309	     * Now check to see if the file matches, according to both type
310	     * and pattern.  If so, add the file to the result.
311	     */
312
313	    utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name,
314		    -1, &utfDs);
315	    if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
316		int typeOk = 1;
317
318		if (types != NULL) {
319		    Tcl_DStringSetLength(&ds, nativeDirLen);
320		    native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
321		    typeOk = NativeMatchType(native, types);
322		}
323		if (typeOk) {
324		    Tcl_ListObjAppendElement(interp, resultPtr,
325			    TclNewFSPathObj(pathPtr, utfname,
326				    Tcl_DStringLength(&utfDs)));
327		}
328	    }
329	    Tcl_DStringFree(&utfDs);
330	}
331
332	closedir(d);
333	Tcl_DStringFree(&ds);
334	Tcl_DStringFree(&dsOrig);
335	return TCL_OK;
336    }
337}
338static int
339NativeMatchType(
340    CONST char* nativeEntry,  /* Native path to check */
341    Tcl_GlobTypeData *types)  /* Type description to match against */
342{
343    Tcl_StatBuf buf;
344    if (types == NULL) {
345	/*
346	 * Simply check for the file's existence, but do it
347	 * with lstat, in case it is a link to a file which
348	 * doesn't exist (since that case would not show up
349	 * if we used 'access' or 'stat')
350	 */
351	if (TclOSlstat(nativeEntry, &buf) != 0) {
352	    return 0;
353	}
354    } else {
355	if (types->perm != 0) {
356	    if (TclOSstat(nativeEntry, &buf) != 0) {
357		/*
358		 * Either the file has disappeared between the
359		 * 'readdir' call and the 'stat' call, or
360		 * the file is a link to a file which doesn't
361		 * exist (which we could ascertain with
362		 * lstat), or there is some other strange
363		 * problem.  In all these cases, we define this
364		 * to mean the file does not match any defined
365		 * permission, and therefore it is not
366		 * added to the list of files to return.
367		 */
368		return 0;
369	    }
370
371	    /*
372	     * readonly means that there are NO write permissions
373	     * (even for user), but execute is OK for anybody
374	     */
375	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
376			(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
377		((types->perm & TCL_GLOB_PERM_R) &&
378			(access(nativeEntry, R_OK) != 0)) ||
379		((types->perm & TCL_GLOB_PERM_W) &&
380			(access(nativeEntry, W_OK) != 0)) ||
381		((types->perm & TCL_GLOB_PERM_X) &&
382			(access(nativeEntry, X_OK) != 0))
383		) {
384		return 0;
385	    }
386	}
387	if (types->type != 0) {
388	    if (types->perm == 0) {
389		/* We haven't yet done a stat on the file */
390		if (TclOSstat(nativeEntry, &buf) != 0) {
391		    /*
392		     * Posix error occurred.  The only ok
393		     * case is if this is a link to a nonexistent
394		     * file, and the user did 'glob -l'. So
395		     * we check that here:
396		     */
397		    if (types->type & TCL_GLOB_TYPE_LINK) {
398			if (TclOSlstat(nativeEntry, &buf) == 0) {
399			    if (S_ISLNK(buf.st_mode)) {
400				return 1;
401			    }
402			}
403		    }
404		    return 0;
405		}
406	    }
407	    /*
408	     * In order bcdpfls as in 'find -t'
409	     */
410	    if (
411		((types->type & TCL_GLOB_TYPE_BLOCK) &&
412			S_ISBLK(buf.st_mode)) ||
413		((types->type & TCL_GLOB_TYPE_CHAR) &&
414			S_ISCHR(buf.st_mode)) ||
415		((types->type & TCL_GLOB_TYPE_DIR) &&
416			S_ISDIR(buf.st_mode)) ||
417		((types->type & TCL_GLOB_TYPE_PIPE) &&
418			S_ISFIFO(buf.st_mode)) ||
419		((types->type & TCL_GLOB_TYPE_FILE) &&
420			S_ISREG(buf.st_mode))
421#ifdef S_ISSOCK
422		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
423			S_ISSOCK(buf.st_mode))
424#endif /* S_ISSOCK */
425		) {
426		/* Do nothing -- this file is ok */
427	    } else {
428#ifdef S_ISLNK
429		if (types->type & TCL_GLOB_TYPE_LINK) {
430		    if (TclOSlstat(nativeEntry, &buf) == 0) {
431			if (S_ISLNK(buf.st_mode)) {
432			    return 1;
433			}
434		    }
435		}
436#endif /* S_ISLNK */
437		return 0;
438	    }
439	}
440    }
441    return 1;
442}
443
444/*
445 *---------------------------------------------------------------------------
446 *
447 * TclpGetUserHome --
448 *
449 *	This function takes the specified user name and finds their
450 *	home directory.
451 *
452 * Results:
453 *	The result is a pointer to a string specifying the user's home
454 *	directory, or NULL if the user's home directory could not be
455 *	determined.  Storage for the result string is allocated in
456 *	bufferPtr; the caller must call Tcl_DStringFree() when the result
457 *	is no longer needed.
458 *
459 * Side effects:
460 *	None.
461 *
462 *----------------------------------------------------------------------
463 */
464
465char *
466TclpGetUserHome(name, bufferPtr)
467    CONST char *name;		/* User name for desired home directory. */
468    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
469				 * with name of user's home directory. */
470{
471    struct passwd *pwPtr;
472    Tcl_DString ds;
473    CONST char *native;
474
475    native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
476    pwPtr = getpwnam(native);				/* INTL: Native. */
477    Tcl_DStringFree(&ds);
478
479    if (pwPtr == NULL) {
480	endpwent();
481	return NULL;
482    }
483    Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
484    endpwent();
485    return Tcl_DStringValue(bufferPtr);
486}
487
488/*
489 *---------------------------------------------------------------------------
490 *
491 * TclpObjAccess --
492 *
493 *	This function replaces the library version of access().
494 *
495 * Results:
496 *	See access() documentation.
497 *
498 * Side effects:
499 *	See access() documentation.
500 *
501 *---------------------------------------------------------------------------
502 */
503
504int
505TclpObjAccess(pathPtr, mode)
506    Tcl_Obj *pathPtr;        /* Path of file to access */
507    int mode;                /* Permission setting. */
508{
509    CONST char *path = Tcl_FSGetNativePath(pathPtr);
510    if (path == NULL) {
511	return -1;
512    } else {
513	return access(path, mode);
514    }
515}
516
517/*
518 *---------------------------------------------------------------------------
519 *
520 * TclpObjChdir --
521 *
522 *	This function replaces the library version of chdir().
523 *
524 * Results:
525 *	See chdir() documentation.
526 *
527 * Side effects:
528 *	See chdir() documentation.
529 *
530 *---------------------------------------------------------------------------
531 */
532
533int
534TclpObjChdir(pathPtr)
535    Tcl_Obj *pathPtr;          /* Path to new working directory */
536{
537    CONST char *path = Tcl_FSGetNativePath(pathPtr);
538    if (path == NULL) {
539	return -1;
540    } else {
541	return chdir(path);
542    }
543}
544
545/*
546 *----------------------------------------------------------------------
547 *
548 * TclpObjLstat --
549 *
550 *	This function replaces the library version of lstat().
551 *
552 * Results:
553 *	See lstat() documentation.
554 *
555 * Side effects:
556 *	See lstat() documentation.
557 *
558 *----------------------------------------------------------------------
559 */
560
561int
562TclpObjLstat(pathPtr, bufPtr)
563    Tcl_Obj *pathPtr;		/* Path of file to stat */
564    Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
565{
566    return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
567}
568
569/*
570 *---------------------------------------------------------------------------
571 *
572 * TclpObjGetCwd --
573 *
574 *	This function replaces the library version of getcwd().
575 *
576 * Results:
577 *	The result is a pointer to a string specifying the current
578 *	directory, or NULL if the current directory could not be
579 *	determined.  If NULL is returned, an error message is left in the
580 *	interp's result.  Storage for the result string is allocated in
581 *	bufferPtr; the caller must call Tcl_DStringFree() when the result
582 *	is no longer needed.
583 *
584 * Side effects:
585 *	None.
586 *
587 *----------------------------------------------------------------------
588 */
589
590Tcl_Obj*
591TclpObjGetCwd(interp)
592    Tcl_Interp *interp;
593{
594    Tcl_DString ds;
595    if (TclpGetCwd(interp, &ds) != NULL) {
596	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
597	Tcl_IncrRefCount(cwdPtr);
598	Tcl_DStringFree(&ds);
599	return cwdPtr;
600    } else {
601	return NULL;
602    }
603}
604
605/* Older string based version */
606CONST char *
607TclpGetCwd(interp, bufferPtr)
608    Tcl_Interp *interp;		/* If non-NULL, used for error reporting. */
609    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
610				 * with name of current directory. */
611{
612    char buffer[MAXPATHLEN+1];
613
614#ifdef USEGETWD
615    if (getwd(buffer) == NULL) {			/* INTL: Native. */
616#else
617    if (getcwd(buffer, MAXPATHLEN + 1) == NULL) {	/* INTL: Native. */
618#endif
619	if (interp != NULL) {
620	    Tcl_AppendResult(interp,
621		    "error getting working directory name: ",
622		    Tcl_PosixError(interp), (char *) NULL);
623	}
624	return NULL;
625    }
626    return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
627}
628
629/*
630 *---------------------------------------------------------------------------
631 *
632 * TclpReadlink --
633 *
634 *	This function replaces the library version of readlink().
635 *
636 * Results:
637 *	The result is a pointer to a string specifying the contents
638 *	of the symbolic link given by 'path', or NULL if the symbolic
639 *	link could not be read.  Storage for the result string is
640 *	allocated in bufferPtr; the caller must call Tcl_DStringFree()
641 *	when the result is no longer needed.
642 *
643 * Side effects:
644 *	See readlink() documentation.
645 *
646 *---------------------------------------------------------------------------
647 */
648
649char *
650TclpReadlink(path, linkPtr)
651    CONST char *path;		/* Path of file to readlink (UTF-8). */
652    Tcl_DString *linkPtr;	/* Uninitialized or free DString filled
653				 * with contents of link (UTF-8). */
654{
655#ifndef DJGPP
656    char link[MAXPATHLEN];
657    int length;
658    CONST char *native;
659    Tcl_DString ds;
660
661    native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
662    length = readlink(native, link, sizeof(link));	/* INTL: Native. */
663    Tcl_DStringFree(&ds);
664
665    if (length < 0) {
666	return NULL;
667    }
668
669    Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
670    return Tcl_DStringValue(linkPtr);
671#else
672    return NULL;
673#endif
674}
675
676/*
677 *----------------------------------------------------------------------
678 *
679 * TclpObjStat --
680 *
681 *	This function replaces the library version of stat().
682 *
683 * Results:
684 *	See stat() documentation.
685 *
686 * Side effects:
687 *	See stat() documentation.
688 *
689 *----------------------------------------------------------------------
690 */
691
692int
693TclpObjStat(pathPtr, bufPtr)
694    Tcl_Obj *pathPtr;		/* Path of file to stat */
695    Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
696{
697    CONST char *path = Tcl_FSGetNativePath(pathPtr);
698    if (path == NULL) {
699	return -1;
700    } else {
701	return TclOSstat(path, bufPtr);
702    }
703}
704
705
706#ifdef S_IFLNK
707
708Tcl_Obj*
709TclpObjLink(pathPtr, toPtr, linkAction)
710    Tcl_Obj *pathPtr;
711    Tcl_Obj *toPtr;
712    int linkAction;
713{
714    if (toPtr != NULL) {
715	CONST char *src = Tcl_FSGetNativePath(pathPtr);
716	CONST char *target = Tcl_FSGetNativePath(toPtr);
717
718	if (src == NULL || target == NULL) {
719	    return NULL;
720	}
721	if (access(src, F_OK) != -1) {
722	    /* src exists */
723	    errno = EEXIST;
724	    return NULL;
725	}
726	if (access(target, F_OK) == -1) {
727	    /* target doesn't exist */
728	    errno = ENOENT;
729	    return NULL;
730	}
731	/*
732	 * Check symbolic link flag first, since we prefer to
733	 * create these.
734	 */
735	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
736	    if (symlink(target, src) != 0) return NULL;
737	} else if (linkAction & TCL_CREATE_HARD_LINK) {
738	    if (link(target, src) != 0) return NULL;
739	} else {
740	    errno = ENODEV;
741	    return NULL;
742	}
743	return toPtr;
744    } else {
745	Tcl_Obj* linkPtr = NULL;
746
747	char link[MAXPATHLEN];
748	int length;
749	Tcl_DString ds;
750	Tcl_Obj *transPtr;
751
752	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
753	if (transPtr == NULL) {
754	    return NULL;
755	}
756	Tcl_DecrRefCount(transPtr);
757
758	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
759	if (length < 0) {
760	    return NULL;
761	}
762
763	Tcl_ExternalToUtfDString(NULL, link, length, &ds);
764	linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
765				   Tcl_DStringLength(&ds));
766	Tcl_DStringFree(&ds);
767	if (linkPtr != NULL) {
768	    Tcl_IncrRefCount(linkPtr);
769	}
770	return linkPtr;
771    }
772}
773
774#endif
775
776
777/*
778 *---------------------------------------------------------------------------
779 *
780 * TclpFilesystemPathType --
781 *
782 *      This function is part of the native filesystem support, and
783 *      returns the path type of the given path.  Right now it simply
784 *      returns NULL.  In the future it could return specific path
785 *      types, like 'nfs', 'samba', 'FAT32', etc.
786 *
787 * Results:
788 *      NULL at present.
789 *
790 * Side effects:
791 *	None.
792 *
793 *---------------------------------------------------------------------------
794 */
795Tcl_Obj*
796TclpFilesystemPathType(pathObjPtr)
797    Tcl_Obj* pathObjPtr;
798{
799    /* All native paths are of the same type */
800    return NULL;
801}
802
803/*
804 *---------------------------------------------------------------------------
805 *
806 * TclpUtime --
807 *
808 *	Set the modification date for a file.
809 *
810 * Results:
811 *	0 on success, -1 on error.
812 *
813 * Side effects:
814 *	None.
815 *
816 *---------------------------------------------------------------------------
817 */
818int
819TclpUtime(pathPtr, tval)
820    Tcl_Obj *pathPtr;      /* File to modify */
821    struct utimbuf *tval;  /* New modification date structure */
822{
823    return utime(Tcl_FSGetNativePath(pathPtr),tval);
824}
825