/* * tclUnixFile.c -- * * This file contains wrappers around UNIX file handling functions. * These wrappers mask differences between Windows and UNIX. * * Copyright © 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" 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 * application, given its argv[0] value. For Cygwin, argv[0] is * ignored and the path is determined the same as under win32. * * Results: * None. * * Side effects: * The computed path name is stored as a ProcessGlobalValue. * *--------------------------------------------------------------------------- */ #ifdef __CYGWIN__ void TclpFindExecutable( TCL_UNUSED(const char *) /*argv0*/) { size_t length; wchar_t buf[PATH_MAX] = L""; char name[PATH_MAX * 3 + 1]; GetModuleFileNameW(NULL, buf, PATH_MAX); cygwin_conv_path(3, buf, name, sizeof(name)); length = strlen(name); if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) { /* Strip '.exe' part. */ length -= 4; } TclSetObjNameOfExecutable( Tcl_NewStringObj(name, length), NULL); } #else void TclpFindExecutable( const char *argv0) /* The value of the application's argv[0] * (native). */ { Tcl_Encoding encoding; const char *name, *p; Tcl_StatBuf statBuf; Tcl_DString buffer, nameString, cwd, utfName; if (argv0 == NULL) { return; } Tcl_DStringInit(&buffer); name = argv0; for (p = name; *p != '\0'; p++) { if (*p == '/') { /* * The name contains a slash, so use the name directly without * doing a path search. */ goto gotName; } } p = getenv("PATH"); /* INTL: Native. */ if (p == NULL) { /* * There's no PATH environment variable; use the default that is used * by sh. */ p = ":/bin:/usr/bin"; } else if (*p == '\0') { /* * An empty path is equivalent to ".". */ p = "./"; } /* * 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 (TclIsSpaceProcM(*p)) { p++; } name = p; while ((*p != ':') && (*p != 0)) { p++; } TclDStringClear(&buffer); if (p != name) { Tcl_DStringAppend(&buffer, name, p - name); if (p[-1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } } name = Tcl_DStringAppend(&buffer, argv0, TCL_INDEX_NONE); /* * INTL: The following calls to access() and stat() should not be * converted to Tclp routines because they need to operate on native * strings directly. */ if ((access(name, X_OK) == 0) /* INTL: Native. */ && (TclOSstat(name, &statBuf) == 0) /* INTL: Native. */ && S_ISREG(statBuf.st_mode)) { goto gotName; } if (*p == '\0') { break; } else if (*(p+1) == 0) { p = "./"; } else { p++; } } TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); goto done; /* * If the name starts with "/" then just store it */ gotName: #ifdef DJGPP if (name[1] == ':') #else if (name[0] == '/') #endif { encoding = Tcl_GetEncoding(NULL, NULL); Tcl_ExternalToUtfDStringEx(encoding, name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); goto done; } if (TclpGetCwd(NULL, &cwd) == NULL) { TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); 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. */ if ((name[0] == '.') && (name[1] == '/')) { name += 2; } Tcl_DStringInit(&nameString); Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE); Tcl_DStringFree(&buffer); Tcl_UtfToExternalDStringEx(NULL, Tcl_DStringValue(&cwd), Tcl_DStringLength(&cwd), TCL_ENCODING_NOCOMPLAIN, &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } Tcl_DStringFree(&cwd); TclDStringAppendDString(&buffer, &nameString); Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); Tcl_ExternalToUtfDStringEx(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); done: Tcl_DStringFree(&buffer); } #endif /* *---------------------------------------------------------------------- * * TclpMatchInDirectory -- * * 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). * * 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. * May be NULL. In particular the directory * flag is very important. */ { 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 = (const char *)Tcl_FSGetNativePath(pathPtr); tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL); nativeTail = (const char *)Tcl_FSGetNativePath(tailPtr); matchResult = NativeMatchType(interp, native, nativeTail, types); if (matchResult == 1) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } Tcl_DecrRefCount(tailPtr); Tcl_DecrRefCount(fileNamePtr); } else { TclDIR *d; Tcl_DirEntry *entryPtr; const char *dirName; size_t dirLength, nativeDirLen; int matchHidden, matchHiddenPat; Tcl_StatBuf statBuf; Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); dirName = TclGetString(fileNamePtr); dirLength = fileNamePtr->length; 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". */ if (dirLength == 0) { dirName = "."; } else { dirName = Tcl_DStringValue(&dsOrig); /* * Make sure we have a trailing directory delimiter. */ if (dirName[dirLength-1] != '/') { dirName = TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } } /* * Now open the directory for reading and iterate over the contents. */ native = Tcl_UtfToExternalDString(NULL, dirName, TCL_INDEX_NONE, &ds); if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */ || !S_ISDIR(statBuf.st_mode)) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } d = TclOSopendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read directory \"%s\": %s", Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); } Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); return TCL_ERROR; } nativeDirLen = Tcl_DStringLength(&ds); /* * Check to see if -type or the pattern requests hidden files. */ matchHiddenPat = (pattern[0] == '.') || ((pattern[0] == '\\') && (pattern[1] == '.')); matchHidden = matchHiddenPat || (types && (types->perm & TCL_GLOB_PERM_HIDDEN)); while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ Tcl_DString utfDs; const char *utfname; /* * 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; } } else { #ifdef MAC_OSX_TCL if (matchHiddenPat) { continue; } /* Also need to check HFS hidden flag in TclMacOSXMatchType. */ #else if (matchHidden) { continue; } #endif } /* * Now check to see if the file matches, according to both type * and pattern. If so, add the file to the result. */ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, TCL_INDEX_NONE, &utfDs); if (Tcl_StringCaseMatch(utfname, pattern, 0)) { int typeOk = 1; if (types != NULL) { Tcl_DStringSetLength(&ds, nativeDirLen); native = Tcl_DStringAppend(&ds, entryPtr->d_name, TCL_INDEX_NONE); matchResult = NativeMatchType(interp, native, entryPtr->d_name, types); typeOk = (matchResult == 1); } if (typeOk) { Tcl_ListObjAppendElement(interp, resultPtr, TclNewFSPathObj(pathPtr, utfname, Tcl_DStringLength(&utfDs))); } } Tcl_DStringFree(&utfDs); if (matchResult < 0) { break; } } TclOSclosedir(d); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); } if (matchResult < 0) { return TCL_ERROR; } 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 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. */ { 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') */ 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. */ 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 /* MAC_OSX_TCL */ ) { 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) && (TclOSlstat(nativeEntry, &buf) == 0) && S_ISLNK(buf.st_mode)) { return 1; } 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. */ } else { #ifdef S_ISLNK if ((types->type & TCL_GLOB_TYPE_LINK) && (TclOSlstat(nativeEntry, &buf) == 0) && S_ISLNK(buf.st_mode)) { goto filetypeOK; } #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; } } #else (void)interp; #endif /* MAC_OSX_TCL */ return 1; } /* *--------------------------------------------------------------------------- * * TclpGetUserHome -- * * 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. * * Side effects: * None. * *---------------------------------------------------------------------- */ 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. */ { struct passwd *pwPtr; Tcl_DString ds; const char *native = Tcl_UtfToExternalDString(NULL, name, TCL_INDEX_NONE, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { return NULL; } return Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr); } /* *--------------------------------------------------------------------------- * * TclpObjAccess -- * * This function replaces the library version of access(). * * Results: * See access() documentation. * * Side effects: * See access() documentation. * *--------------------------------------------------------------------------- */ int TclpObjAccess( Tcl_Obj *pathPtr, /* Path of file to access */ int mode) /* Permission setting. */ { const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return access(path, mode); } /* *--------------------------------------------------------------------------- * * TclpObjChdir -- * * This function replaces the library version of chdir(). * * Results: * See chdir() documentation. * * Side effects: * See chdir() documentation. * *--------------------------------------------------------------------------- */ int TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory */ { const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return chdir(path); } /* *---------------------------------------------------------------------- * * TclpObjLstat -- * * This function replaces the library version of lstat(). * * Results: * See lstat() documentation. * * Side effects: * See lstat() documentation. * *---------------------------------------------------------------------- */ int TclpObjLstat( Tcl_Obj *pathPtr, /* Path of file to stat */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { return TclOSlstat((const char *)Tcl_FSGetNativePath(pathPtr), bufPtr); } /* *--------------------------------------------------------------------------- * * TclpGetNativeCwd -- * * 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. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData TclpGetNativeCwd( ClientData clientData) { char buffer[MAXPATHLEN+1]; #ifdef USEGETWD if (getwd(buffer) == NULL) { /* INTL: Native. */ return NULL; } #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) { /* INTL: Native. */ return NULL; } #endif /* USEGETWD */ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { char *newCd = (char *)Tcl_Alloc(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. */ { char buffer[MAXPATHLEN+1]; #ifdef USEGETWD if (getwd(buffer) == NULL) /* INTL: Native. */ #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */ #endif /* USEGETWD */ { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); } return NULL; } return Tcl_ExternalToUtfDString(NULL, buffer, TCL_INDEX_NONE, bufferPtr); } /* *--------------------------------------------------------------------------- * * TclpReadlink -- * * 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. * * Side effects: * See readlink() documentation. * *--------------------------------------------------------------------------- */ 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). */ { #ifndef DJGPP char link[MAXPATHLEN]; int length; const char *native; Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, path, TCL_INDEX_NONE, &ds); length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); if (length < 0) { return NULL; } Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, linkPtr); return Tcl_DStringValue(linkPtr); #else return NULL; #endif /* !DJGPP */ } /* *---------------------------------------------------------------------- * * TclpObjStat -- * * This function replaces the library version of stat(). * * Results: * See stat() documentation. * * Side effects: * See stat() documentation. * *---------------------------------------------------------------------- */ int TclpObjStat( Tcl_Obj *pathPtr, /* Path of file to stat */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return TclOSstat(path, bufPtr); } #ifdef S_IFLNK Tcl_Obj * TclpObjLink( Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction) { if (toPtr != NULL) { const char *src = (const char *)Tcl_FSGetNativePath(pathPtr); const char *target = NULL; if (src == 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 = (const char*)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. */ errno = EEXIST; return NULL; } /* * Check symbolic link flag first, since we prefer to create these. */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { Tcl_DString ds; Tcl_Obj *transPtr; size_t length; /* * 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, &length); target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { toPtr = NULL; } Tcl_DStringFree(&ds); } else if (linkAction & TCL_CREATE_HARD_LINK) { if (link(target, src) != 0) { return NULL; } } else { errno = ENODEV; return NULL; } return toPtr; } else { 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((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; } Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, &ds); linkPtr = Tcl_DStringToObj(&ds); 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_UNUSED(Tcl_Obj *)) { /* * All native paths are of the same type. */ return NULL; } /* *--------------------------------------------------------------------------- * * TclpNativeToNormalized -- * * Convert native format to a normalized path object, with refCount of * zero. * * 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. * * Results: * A valid normalized path. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpNativeToNormalized( ClientData clientData) { Tcl_DString ds; Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds); return Tcl_DStringToObj(&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; size_t 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_UtfToExternalDStringEx(NULL, str, len, TCL_ENCODING_NOCOMPLAIN, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ Tcl_DecrRefCount(validPathPtr); Tcl_DStringFree(&ds); return NULL; } Tcl_DecrRefCount(validPathPtr); nativePathPtr = (char *)Tcl_Alloc(len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), 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) { 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 = (char *)Tcl_Alloc(len); memcpy(copy, clientData, len); return copy; } /* *--------------------------------------------------------------------------- * * TclpUtime -- * * Set the modification date for a file. * * Results: * 0 on success, -1 on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclpUtime( Tcl_Obj *pathPtr, /* File to modify */ struct utimbuf *tval) /* New modification date structure */ { return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval); } #ifdef __CYGWIN__ int TclOSfstat( int fd, void *cygstat) { struct stat buf; Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = fstat(fd, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; statBuf->st_rdev = buf.st_rdev; statBuf->st_nlink = buf.st_nlink; statBuf->st_uid = buf.st_uid; statBuf->st_gid = buf.st_gid; statBuf->st_size = buf.st_size; statBuf->st_atime = buf.st_atime; statBuf->st_mtime = buf.st_mtime; statBuf->st_ctime = buf.st_ctime; return result; } int TclOSstat( const char *name, void *cygstat) { struct stat buf; Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = stat(name, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; statBuf->st_rdev = buf.st_rdev; statBuf->st_nlink = buf.st_nlink; statBuf->st_uid = buf.st_uid; statBuf->st_gid = buf.st_gid; statBuf->st_size = buf.st_size; statBuf->st_atime = buf.st_atime; statBuf->st_mtime = buf.st_mtime; statBuf->st_ctime = buf.st_ctime; return result; } int TclOSlstat( const char *name, void *cygstat) { struct stat buf; Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = lstat(name, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; statBuf->st_rdev = buf.st_rdev; statBuf->st_nlink = buf.st_nlink; statBuf->st_uid = buf.st_uid; statBuf->st_gid = buf.st_gid; statBuf->st_size = buf.st_size; statBuf->st_atime = buf.st_atime; statBuf->st_mtime = buf.st_mtime; statBuf->st_ctime = buf.st_ctime; return result; } #endif /* CYGWIN */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */