diff options
Diffstat (limited to 'unix/tclUnixFile.c')
| -rw-r--r-- | unix/tclUnixFile.c | 994 |
1 files changed, 326 insertions, 668 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index a4426b7..4ba2e47 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -1,8 +1,8 @@ /* * tclUnixFile.c -- * - * This file contains wrappers around UNIX file handling functions. - * These wrappers mask differences between Windows and UNIX. + * This file contains wrappers around UNIX file handling functions. + * These wrappers mask differences between Windows and UNIX. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * @@ -11,45 +11,62 @@ */ #include "tclInt.h" -#include "tclFileSystem.h" +#include "tclPort.h" + +static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types); -static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry, - const char* nativeName, Tcl_GlobTypeData *types); /* *--------------------------------------------------------------------------- * * TclpFindExecutable -- * - * This function computes the absolute path name of the current + * This procedure computes the absolute path name of the current * application, given its argv[0] value. For Cygwin, argv[0] is * ignored and the path is determined the same as under win32. * * Results: - * None. + * A dirty UTF string that is the path to the executable. At this + * point we may not know the system encoding. Convert the native + * string value to UTF using the default encoding. The assumption + * is that we will still be able to parse the path given the path + * name contains ASCII string and '/' chars do not conflict with + * other UTF chars. * * Side effects: - * The computed path name is stored as a ProcessGlobalValue. + * The variable tclNativeExecutableName gets filled in with the file + * name for the application, if we figured it out. If we couldn't + * figure it out, tclNativeExecutableName is set to NULL. * *--------------------------------------------------------------------------- */ -void -TclpFindExecutable( - const char *argv0) /* The value of the application's argv[0] +char * +TclpFindExecutable(argv0) + CONST char *argv0; /* The value of the application's argv[0] * (native). */ { - Tcl_Encoding encoding; -#ifdef __CYGWIN__ int length; +#ifdef __CYGWIN__ char buf[PATH_MAX * TCL_UTF_MAX + 1]; char name[PATH_MAX * TCL_UTF_MAX + 1]; +#else + CONST char *name, *p; + Tcl_StatBuf statBuf; + Tcl_DString buffer, nameString; +#endif + + if (tclNativeExecutableName != NULL) { + return tclNativeExecutableName; + } + +#ifdef __CYGWIN__ /* Make some symbols available without including <windows.h> */ # define CP_UTF8 65001 - DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *); - DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int); - DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int, + extern int cygwin_conv_to_full_posix_path(const char *, char *); + extern __stdcall int GetModuleFileNameW(void *, const char *, int); + extern __stdcall int WideCharToMultiByte(int, int, const char *, int, const char *, int, const char *, const char *); GetModuleFileNameW(NULL, name, PATH_MAX); @@ -60,16 +77,12 @@ TclpFindExecutable( /* Strip '.exe' part. */ length -= 4; } - encoding = Tcl_GetEncoding(NULL, NULL); - TclSetObjNameOfExecutable( - Tcl_NewStringObj(name, length), encoding); + tclNativeExecutableName = (char *) ckalloc(length + 1); + memcpy(tclNativeExecutableName, name, length); + buf[length] = '\0'; #else - const char *name, *p; - Tcl_StatBuf statBuf; - Tcl_DString buffer, nameString, cwd, utfName; - if (argv0 == NULL) { - return; + return NULL; } Tcl_DStringInit(&buffer); @@ -77,8 +90,8 @@ TclpFindExecutable( for (p = name; *p != '\0'; p++) { if (*p == '/') { /* - * The name contains a slash, so use the name directly without - * doing a path search. + * The name contains a slash, so use the name directly + * without doing a path search. */ goto gotName; @@ -88,8 +101,8 @@ TclpFindExecutable( p = getenv("PATH"); /* INTL: Native. */ if (p == NULL) { /* - * There's no PATH environment variable; use the default that is used - * by sh. + * There's no PATH environment variable; use the default that + * is used by sh. */ p = ":/bin:/usr/bin"; @@ -102,12 +115,13 @@ TclpFindExecutable( } /* - * Search through all the directories named in the PATH variable to see if - * argv[0] is in one of them. If so, use that file name. + * Search through all the directories named in the PATH variable + * to see if argv[0] is in one of them. If so, use that file + * name. */ while (1) { - while (TclIsSpaceProc(*p)) { + while (isspace(UCHAR(*p))) { /* INTL: BUG */ p++; } name = p; @@ -142,64 +156,53 @@ TclpFindExecutable( p++; } } - TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); goto done; /* - * If the name starts with "/" then just store it + * If the name starts with "/" then just copy it to tclExecutableName. */ - gotName: +gotName: #ifdef DJGPP - if (name[1] == ':') + if (name[1] == ':') { #else - if (name[0] == '/') + if (name[0] == '/') { #endif - { - encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, name, -1, &utfName); - TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); - Tcl_DStringFree(&utfName); + Tcl_ExternalToUtfDString(NULL, name, -1, &nameString); + tclNativeExecutableName = (char *) + ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1)); + strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString)); + Tcl_DStringFree(&nameString); goto done; } /* - * The name is relative to the current working directory. First strip off - * a leading "./", if any, then add the full path name of the current - * working directory. + * The name is relative to the current working directory. First + * strip off a leading "./", if any, then add the full path name of + * the current working directory. */ if ((name[0] == '.') && (name[1] == '/')) { name += 2; } - Tcl_DStringInit(&nameString); - Tcl_DStringAppend(&nameString, name, -1); - - TclpGetCwd(NULL, &cwd); + Tcl_ExternalToUtfDString(NULL, name, -1, &nameString); Tcl_DStringFree(&buffer); - Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), - Tcl_DStringLength(&cwd), &buffer); - if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { - Tcl_DStringAppend(&buffer, "/", 1); - } - Tcl_DStringFree(&cwd); - Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString), - Tcl_DStringLength(&nameString)); + TclpGetCwd(NULL, &buffer); + + length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2; + tclNativeExecutableName = (char *) ckalloc((unsigned) length); + strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer)); + tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/'; + strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1, + Tcl_DStringValue(&nameString)); Tcl_DStringFree(&nameString); - - encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, - &utfName); - TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); - Tcl_DStringFree(&utfName); - - done: + +done: Tcl_DStringFree(&buffer); #endif + return tclNativeExecutableName; } /* @@ -207,101 +210,80 @@ TclpFindExecutable( * * TclpMatchInDirectory -- * - * This routine is used by the globbing code to search a directory for - * all files which match a given pattern. + * This routine is used by the globbing code to search a + * directory for all files which match a given pattern. * - * Results: - * The return value is a standard Tcl result indicating whether an error - * occurred in globbing. Errors are left in interp, good results are - * [lappend]ed to resultPtr (which must be a valid object). + * Results: + * The return value is a standard Tcl result indicating whether an + * error occurred in globbing. Errors are left in interp, good + * results are lappended to resultPtr (which must be a valid object) * * Side effects: * None. * - *---------------------------------------------------------------------- - */ + *---------------------------------------------------------------------- */ int -TclpMatchInDirectory( - Tcl_Interp *interp, /* Interpreter to receive errors. */ - Tcl_Obj *resultPtr, /* List object to lappend results. */ - Tcl_Obj *pathPtr, /* Contains path to directory to search. */ - const char *pattern, /* Pattern to match against. */ - Tcl_GlobTypeData *types) /* Object containing list of acceptable types. +TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) + Tcl_Interp *interp; /* Interpreter to receive errors. */ + Tcl_Obj *resultPtr; /* List object to lappend results. */ + Tcl_Obj *pathPtr; /* Contains path to directory to search. */ + CONST char *pattern; /* Pattern to match against. */ + Tcl_GlobTypeData *types; /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { - const char *native; + CONST char *native; Tcl_Obj *fileNamePtr; - int matchResult = 0; - - if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { - /* - * The native filesystem never adds mounts. - */ - - return TCL_OK; - } fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } - + if (pattern == NULL || (*pattern == '\0')) { - /* - * Match a file directly. - */ - - Tcl_Obj *tailPtr; - const char *nativeTail; - - native = Tcl_FSGetNativePath(pathPtr); - tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL); - nativeTail = Tcl_FSGetNativePath(tailPtr); - matchResult = NativeMatchType(interp, native, nativeTail, types); - if (matchResult == 1) { + /* Match a file directly */ + native = (CONST char*) Tcl_FSGetNativePath(pathPtr); + if (NativeMatchType(native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } - Tcl_DecrRefCount(tailPtr); Tcl_DecrRefCount(fileNamePtr); + return TCL_OK; } else { DIR *d; Tcl_DirEntry *entryPtr; - const char *dirName; - int dirLength, nativeDirLen; - int matchHidden, matchHiddenPat; + CONST char *dirName; + int dirLength; + int matchHidden; + int nativeDirLen; Tcl_StatBuf statBuf; - Tcl_DString ds; /* native encoding of dir */ - Tcl_DString dsOrig; /* utf-8 encoding of dir */ + Tcl_DString ds; /* native encoding of dir */ + Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); - + /* * Make sure that the directory part of the name really is a - * directory. If the directory name is "", use the name "." instead, - * because some UNIX systems don't treat "" like "." automatically. - * Keep the "" for use in generating file names, otherwise "glob - * foo.c" would return "./foo.c". + * directory. If the directory name is "", use the name "." + * instead, because some UNIX systems don't treat "" like "." + * automatically. Keep the "" for use in generating file names, + * otherwise "glob foo.c" would return "./foo.c". */ if (dirLength == 0) { dirName = "."; } else { dirName = Tcl_DStringValue(&dsOrig); - - /* - * Make sure we have a trailing directory delimiter. - */ - + /* Make sure we have a trailing directory delimiter */ if (dirName[dirLength-1] != '/') { dirName = Tcl_DStringAppend(&dsOrig, "/", 1); dirLength++; } } - + Tcl_DecrRefCount(fileNamePtr); + /* * Now open the directory for reading and iterate over the contents. */ @@ -312,21 +294,17 @@ TclpMatchInDirectory( || !S_ISDIR(statBuf.st_mode)) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); - Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } d = opendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); - if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read directory \"", - Tcl_DStringValue(&dsOrig), "\": ", - Tcl_PosixError(interp), NULL); - } + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't read directory \"", + Tcl_DStringValue(&dsOrig), "\": ", + Tcl_PosixError(interp), (char *) NULL); Tcl_DStringFree(&dsOrig); - Tcl_DecrRefCount(fileNamePtr); return TCL_ERROR; } @@ -335,239 +313,157 @@ TclpMatchInDirectory( /* * Check to see if -type or the pattern requests hidden files. */ + matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) || + ((pattern[0] == '.') + || ((pattern[0] == '\\') && (pattern[1] == '.')))); - matchHiddenPat = (pattern[0] == '.') - || ((pattern[0] == '\\') && (pattern[1] == '.')); - matchHidden = matchHiddenPat - || (types && (types->perm & TCL_GLOB_PERM_HIDDEN)); - while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ + while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ Tcl_DString utfDs; - const char *utfname; + CONST char *utfname; - /* - * Skip this file if it doesn't agree with the hidden parameters - * requested by the user (via -type or pattern). + /* + * Skip this file if it doesn't agree with the hidden + * parameters requested by the user (via -type or pattern). */ - if (*entryPtr->d_name == '.') { - if (!matchHidden) { - continue; - } + if (!matchHidden) continue; } else { -#ifdef MAC_OSX_TCL - if (matchHiddenPat) { - continue; - } - /* Also need to check HFS hidden flag in TclMacOSXMatchType. */ -#else - if (matchHidden) { - continue; - } -#endif + if (matchHidden) continue; } /* * Now check to see if the file matches, according to both type - * and pattern. If so, add the file to the result. + * and pattern. If so, add the file to the result. */ - utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, - &utfDs); + utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, + -1, &utfDs); if (Tcl_StringCaseMatch(utfname, pattern, 0)) { int typeOk = 1; if (types != NULL) { Tcl_DStringSetLength(&ds, nativeDirLen); native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1); - matchResult = NativeMatchType(interp, native, - entryPtr->d_name, types); - typeOk = (matchResult == 1); + typeOk = NativeMatchType(native, types); } if (typeOk) { - Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_ListObjAppendElement(interp, resultPtr, TclNewFSPathObj(pathPtr, utfname, - Tcl_DStringLength(&utfDs))); + Tcl_DStringLength(&utfDs))); } } Tcl_DStringFree(&utfDs); - if (matchResult < 0) { - break; - } } closedir(d); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); - Tcl_DecrRefCount(fileNamePtr); - } - if (matchResult < 0) { - return TCL_ERROR; + return TCL_OK; } - return TCL_OK; } - -/* - *---------------------------------------------------------------------- - * - * NativeMatchType -- - * - * This routine is used by the globbing code to check if a file matches a - * given type description. - * - * Results: - * The return value is 1, 0 or -1 indicating whether the file matches the - * given criteria, does not match them, or an error occurred (in which - * case an error is left in interp). - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int +static int NativeMatchType( - Tcl_Interp *interp, /* Interpreter to receive errors. */ - const char *nativeEntry, /* Native path to check. */ - const char *nativeName, /* Native filename to check. */ - Tcl_GlobTypeData *types) /* Type description to match against. */ + CONST char* nativeEntry, /* Native path to check */ + Tcl_GlobTypeData *types) /* Type description to match against */ { Tcl_StatBuf buf; - if (types == NULL) { - /* - * Simply check for the file's existence, but do it with lstat, in - * case it is a link to a file which doesn't exist (since that case - * would not show up if we used 'access' or 'stat') + /* + * Simply check for the file's existence, but do it + * with lstat, in case it is a link to a file which + * doesn't exist (since that case would not show up + * if we used 'access' or 'stat') */ - if (TclOSlstat(nativeEntry, &buf) != 0) { return 0; } - return 1; - } - - if (types->perm != 0) { - if (TclOSstat(nativeEntry, &buf) != 0) { - /* - * Either the file has disappeared between the 'readdir' call and - * the 'stat' call, or the file is a link to a file which doesn't - * exist (which we could ascertain with lstat), or there is some - * other strange problem. In all these cases, we define this to - * mean the file does not match any defined permission, and - * therefore it is not added to the list of files to return. + } else { + if (types->perm != 0) { + if (TclOSstat(nativeEntry, &buf) != 0) { + /* + * Either the file has disappeared between the + * 'readdir' call and the 'stat' call, or + * the file is a link to a file which doesn't + * exist (which we could ascertain with + * lstat), or there is some other strange + * problem. In all these cases, we define this + * to mean the file does not match any defined + * permission, and therefore it is not + * added to the list of files to return. + */ + return 0; + } + + /* + * readonly means that there are NO write permissions + * (even for user), but execute is OK for anybody */ - - return 0; - } - - /* - * readonly means that there are NO write permissions (even for user), - * but execute is OK for anybody OR that the user immutable flag is - * set (where supported). - */ - - if (((types->perm & TCL_GLOB_PERM_RONLY) && -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) - !(buf.st_flags & UF_IMMUTABLE) && -#endif - (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) || - ((types->perm & TCL_GLOB_PERM_R) && - (access(nativeEntry, R_OK) != 0)) || - ((types->perm & TCL_GLOB_PERM_W) && - (access(nativeEntry, W_OK) != 0)) || - ((types->perm & TCL_GLOB_PERM_X) && - (access(nativeEntry, X_OK) != 0)) -#ifndef MAC_OSX_TCL - || ((types->perm & TCL_GLOB_PERM_HIDDEN) && - (*nativeName != '.')) -#endif + if (((types->perm & TCL_GLOB_PERM_RONLY) && + (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) || + ((types->perm & TCL_GLOB_PERM_R) && + (access(nativeEntry, R_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_W) && + (access(nativeEntry, W_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_X) && + (access(nativeEntry, X_OK) != 0)) ) { - return 0; + return 0; + } } - } - if (types->type != 0) { - if (types->perm == 0) { - /* - * We haven't yet done a stat on the file. - */ - - if (TclOSstat(nativeEntry, &buf) != 0) { - /* - * Posix error occurred. The only ok case is if this is a link - * to a nonexistent file, and the user did 'glob -l'. So we - * check that here: - */ - - if (types->type & TCL_GLOB_TYPE_LINK) { - if (TclOSlstat(nativeEntry, &buf) == 0) { - if (S_ISLNK(buf.st_mode)) { - return 1; + if (types->type != 0) { + if (types->perm == 0) { + /* We haven't yet done a stat on the file */ + if (TclOSstat(nativeEntry, &buf) != 0) { + /* + * Posix error occurred. The only ok + * case is if this is a link to a nonexistent + * file, and the user did 'glob -l'. So + * we check that here: + */ + if (types->type & TCL_GLOB_TYPE_LINK) { + if (TclOSlstat(nativeEntry, &buf) == 0) { + if (S_ISLNK(buf.st_mode)) { + return 1; + } } } + return 0; } - return 0; } - } - - /* - * In order bcdpsfl as in 'find -t' - */ - - if ( ((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_CHAR) && S_ISCHR(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_DIR) && S_ISDIR(buf.st_mode)) || - ((types->type & TCL_GLOB_TYPE_PIPE) && S_ISFIFO(buf.st_mode))|| -#ifdef S_ISSOCK - ((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))|| -#endif /* S_ISSOCK */ - ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))) { /* - * Do nothing - this file is ok. + * In order bcdpfls as in 'find -t' */ - } else { + if ( + ((types->type & TCL_GLOB_TYPE_BLOCK) && + S_ISBLK(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_CHAR) && + S_ISCHR(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_DIR) && + S_ISDIR(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_PIPE) && + S_ISFIFO(buf.st_mode)) || + ((types->type & TCL_GLOB_TYPE_FILE) && + S_ISREG(buf.st_mode)) +#ifdef S_ISSOCK + || ((types->type & TCL_GLOB_TYPE_SOCK) && + S_ISSOCK(buf.st_mode)) +#endif /* S_ISSOCK */ + ) { + /* Do nothing -- this file is ok */ + } else { #ifdef S_ISLNK - if (types->type & TCL_GLOB_TYPE_LINK) { - if (TclOSlstat(nativeEntry, &buf) == 0) { - if (S_ISLNK(buf.st_mode)) { - goto filetypeOK; + if (types->type & TCL_GLOB_TYPE_LINK) { + if (TclOSlstat(nativeEntry, &buf) == 0) { + if (S_ISLNK(buf.st_mode)) { + return 1; + } } } - } #endif /* S_ISLNK */ - return 0; - } - } - filetypeOK: - - /* - * If we're on OSX, we also have to worry about matching the file creator - * code (if specified). Do that now. - */ - -#ifdef MAC_OSX_TCL - if (types->macType != NULL || types->macCreator != NULL || - (types->perm & TCL_GLOB_PERM_HIDDEN)) { - int matchResult; - - if (types->perm == 0 && types->type == 0) { - /* - * We haven't yet done a stat on the file. - */ - - if (TclOSstat(nativeEntry, &buf) != 0) { return 0; } } - - matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName, - &buf, types); - if (matchResult != 1) { - return matchResult; - } } -#endif /* MAC_OSX_TCL */ - return 1; } @@ -576,15 +472,15 @@ NativeMatchType( * * TclpGetUserHome -- * - * This function takes the specified user name and finds their home - * directory. + * This function takes the specified user name and finds their + * home directory. * * Results: * The result is a pointer to a string specifying the user's home * directory, or NULL if the user's home directory could not be - * determined. Storage for the result string is allocated in bufferPtr; - * the caller must call Tcl_DStringFree() when the result is no longer - * needed. + * determined. Storage for the result string is allocated in + * bufferPtr; the caller must call Tcl_DStringFree() when the result + * is no longer needed. * * Side effects: * None. @@ -592,23 +488,26 @@ NativeMatchType( *---------------------------------------------------------------------- */ -const char * -TclpGetUserHome( - const char *name, /* User name for desired home directory. */ - Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with - * name of user's home directory. */ +char * +TclpGetUserHome(name, bufferPtr) + CONST char *name; /* User name for desired home directory. */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled + * with name of user's home directory. */ { struct passwd *pwPtr; Tcl_DString ds; - const char *native = Tcl_UtfToExternalDString(NULL, name, -1, &ds); + CONST char *native; - pwPtr = TclpGetPwNam(native); /* INTL: Native. */ + native = Tcl_UtfToExternalDString(NULL, name, -1, &ds); + pwPtr = getpwnam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); - + if (pwPtr == NULL) { + endpwent(); return NULL; } Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr); + endpwent(); return Tcl_DStringValue(bufferPtr); } @@ -628,17 +527,17 @@ TclpGetUserHome( *--------------------------------------------------------------------------- */ -int -TclpObjAccess( - Tcl_Obj *pathPtr, /* Path of file to access */ - int mode) /* Permission setting. */ +int +TclpObjAccess(pathPtr, mode) + Tcl_Obj *pathPtr; /* Path of file to access */ + int mode; /* Permission setting. */ { - const char *path = Tcl_FSGetNativePath(pathPtr); - + CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; + } else { + return access(path, mode); } - return access(path, mode); } /* @@ -652,21 +551,21 @@ TclpObjAccess( * See chdir() documentation. * * Side effects: - * See chdir() documentation. + * See chdir() documentation. * *--------------------------------------------------------------------------- */ -int -TclpObjChdir( - Tcl_Obj *pathPtr) /* Path to new working directory */ +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; /* Path to new working directory */ { - const char *path = Tcl_FSGetNativePath(pathPtr); - + CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; + } else { + return chdir(path); } - return chdir(path); } /* @@ -685,10 +584,10 @@ TclpObjChdir( *---------------------------------------------------------------------- */ -int -TclpObjLstat( - Tcl_Obj *pathPtr, /* Path of file to stat */ - Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ +int +TclpObjLstat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ { return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr); } @@ -696,17 +595,17 @@ TclpObjLstat( /* *--------------------------------------------------------------------------- * - * TclpGetNativeCwd -- + * TclpObjGetCwd -- * * This function replaces the library version of getcwd(). * * Results: - * The input and output are filesystem paths in native form. The result - * is either the given clientData, if the working directory hasn't - * changed, or a new clientData (owned by our caller), giving the new - * native path, or NULL if the current directory could not be determined. - * If NULL is returned, the caller can examine the standard posix error - * codes to determine the cause of the problem. + * The result is a pointer to a string specifying the current + * directory, or NULL if the current directory could not be + * determined. If NULL is returned, an error message is left in the + * interp's result. Storage for the result string is allocated in + * bufferPtr; the caller must call Tcl_DStringFree() when the result + * is no longer needed. * * Side effects: * None. @@ -714,76 +613,39 @@ TclpObjLstat( *---------------------------------------------------------------------- */ -ClientData -TclpGetNativeCwd( - ClientData clientData) +Tcl_Obj* +TclpObjGetCwd(interp) + Tcl_Interp *interp; { - char buffer[MAXPATHLEN+1]; - -#ifdef USEGETWD - if (getwd(buffer) == NULL) { /* INTL: Native. */ - return NULL; - } -#else - if (getcwd(buffer, MAXPATHLEN+1) == NULL) { /* INTL: Native. */ + Tcl_DString ds; + if (TclpGetCwd(interp, &ds) != NULL) { + Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(cwdPtr); + Tcl_DStringFree(&ds); + return cwdPtr; + } else { return NULL; } -#endif - - if ((clientData == NULL) || strcmp(buffer, (const char*)clientData)) { - char *newCd = ckalloc(strlen(buffer) + 1); - - strcpy(newCd, buffer); - return newCd; - } - - /* - * No change to pwd. - */ - - return clientData; } - -/* - *--------------------------------------------------------------------------- - * - * TclpGetCwd -- - * - * This function replaces the library version of getcwd(). (Obsolete - * function, only retained for old extensions which may call it - * directly). - * - * Results: - * The result is a pointer to a string specifying the current directory, - * or NULL if the current directory could not be determined. If NULL is - * returned, an error message is left in the interp's result. Storage for - * the result string is allocated in bufferPtr; the caller must call - * Tcl_DStringFree() when the result is no longer needed. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -const char * -TclpGetCwd( - Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ - Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with - * name of current directory. */ +/* Older string based version */ +CONST char * +TclpGetCwd(interp, bufferPtr) + Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled + * with name of current directory. */ { char buffer[MAXPATHLEN+1]; #ifdef USEGETWD - if (getwd(buffer) == NULL) /* INTL: Native. */ + if (getwd(buffer) == NULL) { /* INTL: Native. */ #else - if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */ + if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */ #endif - { if (interp != NULL) { Tcl_AppendResult(interp, "error getting working directory name: ", - Tcl_PosixError(interp), NULL); + Tcl_PosixError(interp), (char *) NULL); } return NULL; } @@ -798,11 +660,11 @@ TclpGetCwd( * This function replaces the library version of readlink(). * * Results: - * The result is a pointer to a string specifying the contents of the - * symbolic link given by 'path', or NULL if the symbolic link could not - * be read. Storage for the result string is allocated in bufferPtr; the - * caller must call Tcl_DStringFree() when the result is no longer - * needed. + * The result is a pointer to a string specifying the contents + * of the symbolic link given by 'path', or NULL if the symbolic + * link could not be read. Storage for the result string is + * allocated in bufferPtr; the caller must call Tcl_DStringFree() + * when the result is no longer needed. * * Side effects: * See readlink() documentation. @@ -811,21 +673,21 @@ TclpGetCwd( */ char * -TclpReadlink( - const char *path, /* Path of file to readlink (UTF-8). */ - Tcl_DString *linkPtr) /* Uninitialized or free DString filled with - * contents of link (UTF-8). */ +TclpReadlink(path, linkPtr) + CONST char *path; /* Path of file to readlink (UTF-8). */ + Tcl_DString *linkPtr; /* Uninitialized or free DString filled + * with contents of link (UTF-8). */ { #ifndef DJGPP char link[MAXPATHLEN]; int length; - const char *native; + CONST char *native; Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); - + if (length < 0) { return NULL; } @@ -853,318 +715,115 @@ TclpReadlink( *---------------------------------------------------------------------- */ -int -TclpObjStat( - Tcl_Obj *pathPtr, /* Path of file to stat */ - Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ +int +TclpObjStat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ { - const char *path = Tcl_FSGetNativePath(pathPtr); - + CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; + } else { + return TclOSstat(path, bufPtr); } - return TclOSstat(path, bufPtr); } + #ifdef S_IFLNK -Tcl_Obj* -TclpObjLink( - Tcl_Obj *pathPtr, - Tcl_Obj *toPtr, - int linkAction) +Tcl_Obj* +TclpObjLink(pathPtr, toPtr, linkAction) + Tcl_Obj *pathPtr; + Tcl_Obj *toPtr; + int linkAction; { if (toPtr != NULL) { - const char *src = Tcl_FSGetNativePath(pathPtr); - const char *target = NULL; - - if (src == NULL) { + CONST char *src = Tcl_FSGetNativePath(pathPtr); + CONST char *target = Tcl_FSGetNativePath(toPtr); + + if (src == NULL || target == NULL) { return NULL; } - - /* - * If we're making a symbolic link and the path is relative, then we - * must check whether it exists _relative_ to the directory in which - * the src is found (not relative to the current cwd which is just not - * relevant in this case). - * - * If we're making a hard link, then a relative path is just converted - * to absolute relative to the cwd. - */ - - if ((linkAction & TCL_CREATE_SYMBOLIC_LINK) - && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) { - Tcl_Obj *dirPtr, *absPtr; - - dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME); - if (dirPtr == NULL) { - return NULL; - } - absPtr = Tcl_FSJoinToPath(dirPtr, 1, &toPtr); - Tcl_IncrRefCount(absPtr); - if (Tcl_FSAccess(absPtr, F_OK) == -1) { - Tcl_DecrRefCount(absPtr); - Tcl_DecrRefCount(dirPtr); - - /* - * Target doesn't exist. - */ - - errno = ENOENT; - return NULL; - } - - /* - * Target exists; we'll construct the relative path we want below. - */ - - Tcl_DecrRefCount(absPtr); - Tcl_DecrRefCount(dirPtr); - } else { - target = Tcl_FSGetNativePath(toPtr); - if (target == NULL) { - return NULL; - } - if (access(target, F_OK) == -1) { - /* - * Target doesn't exist. - */ - - errno = ENOENT; - return NULL; - } - } - if (access(src, F_OK) != -1) { - /* - * Src exists. - */ - + /* src exists */ errno = EEXIST; return NULL; } - - /* - * Check symbolic link flag first, since we prefer to create these. + if (access(target, F_OK) == -1) { + /* target doesn't exist */ + errno = ENOENT; + return NULL; + } + /* + * Check symbolic link flag first, since we prefer to + * create these. */ - if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - int targetLen; - Tcl_DString ds; - Tcl_Obj *transPtr; - - /* - * Now we don't want to link to the absolute, normalized path. - * Relative links are quite acceptable (but links to ~user are not - * -- these must be expanded first). - */ - - transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr); - if (transPtr == NULL) { - return NULL; - } - target = Tcl_GetStringFromObj(transPtr, &targetLen); - target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); - Tcl_DecrRefCount(transPtr); - - if (symlink(target, src) != 0) { - toPtr = NULL; - } - Tcl_DStringFree(&ds); + if (symlink(target, src) != 0) return NULL; } else if (linkAction & TCL_CREATE_HARD_LINK) { - if (link(target, src) != 0) { - return NULL; - } + if (link(target, src) != 0) return NULL; } else { errno = ENODEV; return NULL; } return toPtr; } else { - Tcl_Obj *linkPtr = NULL; + Tcl_Obj* linkPtr = NULL; char link[MAXPATHLEN]; int length; Tcl_DString ds; Tcl_Obj *transPtr; - + transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (transPtr == NULL) { return NULL; } Tcl_DecrRefCount(transPtr); - + length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; } Tcl_ExternalToUtfDString(NULL, link, length, &ds); - linkPtr = TclDStringToObj(&ds); - Tcl_IncrRefCount(linkPtr); + linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + if (linkPtr != NULL) { + Tcl_IncrRefCount(linkPtr); + } return linkPtr; } } -#endif /* S_IFLNK */ - -/* - *--------------------------------------------------------------------------- - * - * TclpFilesystemPathType -- - * - * This function is part of the native filesystem support, and returns - * the path type of the given path. Right now it simply returns NULL. In - * the future it could return specific path types, like 'nfs', 'samba', - * 'FAT32', etc. - * - * Results: - * NULL at present. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ -Tcl_Obj * -TclpFilesystemPathType( - Tcl_Obj *pathPtr) -{ - /* - * All native paths are of the same type. - */ +#endif - return NULL; -} /* *--------------------------------------------------------------------------- * - * TclpNativeToNormalized -- - * - * Convert native format to a normalized path object, with refCount of - * zero. + * TclpFilesystemPathType -- * - * Currently assumes all native paths are actually normalized already, so - * if the path given is not normalized this will actually just convert to - * a valid string path, but not necessarily a normalized one. + * This function is part of the native filesystem support, and + * returns the path type of the given path. Right now it simply + * returns NULL. In the future it could return specific path + * types, like 'nfs', 'samba', 'FAT32', etc. * * Results: - * A valid normalized path. + * NULL at present. * * Side effects: * None. * *--------------------------------------------------------------------------- */ - -Tcl_Obj * -TclpNativeToNormalized( - ClientData clientData) -{ - Tcl_DString ds; - - Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds); - return TclDStringToObj(&ds); -} - -/* - *--------------------------------------------------------------------------- - * - * TclNativeCreateNativeRep -- - * - * Create a native representation for the given path. - * - * Results: - * The nativePath representation. - * - * Side effects: - * Memory will be allocated. The path may need to be normalized. - * - *--------------------------------------------------------------------------- - */ - -ClientData -TclNativeCreateNativeRep( - Tcl_Obj *pathPtr) -{ - char *nativePathPtr; - const char *str; - Tcl_DString ds; - Tcl_Obj *validPathPtr; - int len; - - if (TclFSCwdIsNative()) { - /* - * The cwd is native, which means we can use the translated path - * without worrying about normalization (this will also usually be - * shorter so the utf-to-external conversion will be somewhat faster). - */ - - validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (validPathPtr == NULL) { - return NULL; - } - } else { - /* - * Make sure the normalized path is set. - */ - - validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - if (validPathPtr == NULL) { - return NULL; - } - Tcl_IncrRefCount(validPathPtr); - } - - str = Tcl_GetStringFromObj(validPathPtr, &len); - Tcl_UtfToExternalDString(NULL, str, len, &ds); - len = Tcl_DStringLength(&ds) + sizeof(char); - Tcl_DecrRefCount(validPathPtr); - nativePathPtr = ckalloc(len); - memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); - - Tcl_DStringFree(&ds); - return nativePathPtr; -} - -/* - *--------------------------------------------------------------------------- - * - * TclNativeDupInternalRep -- - * - * Duplicate the native representation. - * - * Results: - * The copied native representation, or NULL if it is not possible to - * copy the representation. - * - * Side effects: - * Memory will be allocated for the copy. - * - *--------------------------------------------------------------------------- - */ - -ClientData -TclNativeDupInternalRep( - ClientData clientData) +Tcl_Obj* +TclpFilesystemPathType(pathObjPtr) + Tcl_Obj* pathObjPtr; { - char *copy; - size_t len; - - if (clientData == NULL) { - return NULL; - } - - /* - * ASCII representation when running on Unix. - */ - - len = (strlen((const char*) clientData) + 1) * sizeof(char); - - copy = ckalloc(len); - memcpy(copy, clientData, len); - return copy; + /* All native paths are of the same type */ + return NULL; } /* @@ -1182,13 +841,12 @@ TclNativeDupInternalRep( * *--------------------------------------------------------------------------- */ - -int -TclpUtime( - Tcl_Obj *pathPtr, /* File to modify */ - struct utimbuf *tval) /* New modification date structure */ +int +TclpUtime(pathPtr, tval) + Tcl_Obj *pathPtr; /* File to modify */ + struct utimbuf *tval; /* New modification date structure */ { - return utime(Tcl_FSGetNativePath(pathPtr), tval); + return utime(Tcl_FSGetNativePath(pathPtr),tval); } #ifdef __CYGWIN__ int TclOSstat(const char *name, Tcl_StatBuf *statBuf) { |