diff options
Diffstat (limited to 'unix/tclUnixFile.c')
| -rw-r--r-- | unix/tclUnixFile.c | 498 |
1 files changed, 274 insertions, 224 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 9ae8129..b26691d 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -1,29 +1,28 @@ -/* +/* * 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. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.44 2004/12/01 23:18:55 dgp Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.45 2005/07/20 23:16:00 dkf Exp $ */ #include "tclInt.h" #include "tclFileSystem.h" static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types); - /* *--------------------------------------------------------------------------- * * TclpFindExecutable -- * - * This procedure computes the absolute path name of the current + * This function computes the absolute path name of the current * application, given its argv[0] value. * * Results: @@ -54,8 +53,8 @@ TclpFindExecutable(argv0) 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; @@ -65,8 +64,8 @@ TclpFindExecutable(argv0) 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"; @@ -79,13 +78,12 @@ TclpFindExecutable(argv0) } /* - * 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 (isspace(UCHAR(*p))) { /* INTL: BUG */ + while (isspace(UCHAR(*p))) { /* INTL: BUG */ p++; } name = p; @@ -127,12 +125,13 @@ TclpFindExecutable(argv0) * If the name starts with "/" then just store it */ -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( @@ -142,9 +141,9 @@ gotName: } /* - * 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] == '/')) { @@ -168,12 +167,13 @@ gotName: Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, &utfName); + Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, + &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); Tcl_DStringFree(&utfName); - -done: + + done: Tcl_DStringFree(&buffer); } @@ -182,24 +182,25 @@ done: * * 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 lappended 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 + * [lappend]ed to resultPtr (which must be a valid object). * * Side effects: * None. * - *---------------------------------------------------------------------- */ + *---------------------------------------------------------------------- + */ int 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. */ + 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 @@ -209,7 +210,10 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_Obj *fileNamePtr; if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { - /* The native filesystem never adds mounts */ + /* + * The native filesystem never adds mounts. + */ + return TCL_OK; } @@ -217,9 +221,12 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (fileNamePtr == NULL) { return TCL_ERROR; } - + if (pattern == NULL || (*pattern == '\0')) { - /* Match a file directly */ + /* + * Match a file directly. + */ + native = (CONST char*) Tcl_FSGetNativePath(pathPtr); if (NativeMatchType(native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); @@ -234,26 +241,30 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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++; @@ -291,18 +302,20 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) /* * 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] == '.')))); - while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ + matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) + || ((pattern[0] == '.') + || ((pattern[0] == '\\') && (pattern[1] == '.')))); + + 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). + /* + * 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 { @@ -311,11 +324,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) /* * 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; @@ -325,9 +338,9 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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); @@ -340,44 +353,45 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) return TCL_OK; } } -static int + +static int NativeMatchType( - CONST char* nativeEntry, /* Native path 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; } } 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. + /* + * 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). + + /* + * 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) && @@ -395,14 +409,17 @@ NativeMatchType( } if (types->type != 0) { if (types->perm == 0) { - /* We haven't yet done a stat on the file */ + /* + * 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: + /* + * 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)) { @@ -413,26 +430,23 @@ NativeMatchType( return 0; } } + /* * In order bcdpfls 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)) || - ((types->type & TCL_GLOB_TYPE_FILE) && - S_ISREG(buf.st_mode)) + + 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)) + ||((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode)) #endif /* S_ISSOCK */ ) { - /* Do nothing -- this file is ok */ + /* + * Do nothing - this file is ok. + */ } else { #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { @@ -455,15 +469,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. @@ -474,8 +488,8 @@ NativeMatchType( 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. */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled with + * name of user's home directory. */ { struct passwd *pwPtr; Tcl_DString ds; @@ -484,7 +498,7 @@ TclpGetUserHome(name, bufferPtr) native = Tcl_UtfToExternalDString(NULL, name, -1, &ds); pwPtr = getpwnam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); - + if (pwPtr == NULL) { endpwent(); return NULL; @@ -510,10 +524,10 @@ TclpGetUserHome(name, bufferPtr) *--------------------------------------------------------------------------- */ -int +int TclpObjAccess(pathPtr, mode) - Tcl_Obj *pathPtr; /* Path of file to access */ - int mode; /* Permission setting. */ + Tcl_Obj *pathPtr; /* Path of file to access */ + int mode; /* Permission setting. */ { CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { @@ -534,14 +548,14 @@ TclpObjAccess(pathPtr, mode) * See chdir() documentation. * * Side effects: - * See chdir() documentation. + * See chdir() documentation. * *--------------------------------------------------------------------------- */ -int +int TclpObjChdir(pathPtr) - Tcl_Obj *pathPtr; /* Path to new working directory */ + Tcl_Obj *pathPtr; /* Path to new working directory */ { CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { @@ -567,7 +581,7 @@ TclpObjChdir(pathPtr) *---------------------------------------------------------------------- */ -int +int TclpObjLstat(pathPtr, bufPtr) Tcl_Obj *pathPtr; /* Path of file to stat */ Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ @@ -583,13 +597,12 @@ TclpObjLstat(pathPtr, bufPtr) * 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 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. @@ -604,18 +617,21 @@ TclpGetNativeCwd(clientData) 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 + { return NULL; } if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) { - /* No change to pwd */ + /* + * No change to pwd. + */ + return clientData; } else { - char *newCd = (char *) ckalloc((unsigned) - (strlen(buffer) + 1)); + char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1)); strcpy(newCd, buffer); return (ClientData) newCd; } @@ -626,17 +642,16 @@ TclpGetNativeCwd(clientData) * * TclpGetCwd -- * - * This function replaces the library version of getcwd(). - * (Obsolete function, only retained for old extensions which - * may call it directly). - * + * 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. + * 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. @@ -647,16 +662,17 @@ TclpGetNativeCwd(clientData) 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. */ + 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: ", @@ -675,11 +691,11 @@ TclpGetCwd(interp, bufferPtr) * 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. @@ -690,8 +706,8 @@ TclpGetCwd(interp, bufferPtr) char * 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). */ + Tcl_DString *linkPtr; /* Uninitialized or free DString filled with + * contents of link (UTF-8). */ { #ifndef DJGPP char link[MAXPATHLEN]; @@ -702,7 +718,7 @@ TclpReadlink(path, linkPtr) native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); - + if (length < 0) { return NULL; } @@ -730,7 +746,7 @@ TclpReadlink(path, linkPtr) *---------------------------------------------------------------------- */ -int +int TclpObjStat(pathPtr, bufPtr) Tcl_Obj *pathPtr; /* Path of file to stat */ Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ @@ -743,10 +759,9 @@ TclpObjStat(pathPtr, bufPtr) } } - #ifdef S_IFLNK -Tcl_Obj* +Tcl_Obj* TclpObjLink(pathPtr, toPtr, linkAction) Tcl_Obj *pathPtr; Tcl_Obj *toPtr; @@ -756,42 +771,52 @@ TclpObjLink(pathPtr, toPtr, linkAction) CONST char *src = 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 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_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) { Tcl_Obj *dirPtr, *absPtr; + dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME); if (dirPtr == NULL) { - return 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 */ + + /* + * Target doesn't exist. + */ + errno = ENOENT; - return NULL; + return NULL; } - /* - * Target exists; we'll construct the relative - * path we want below. + + /* + * Target exists; we'll construct the relative path we want below. */ + Tcl_DecrRefCount(absPtr); Tcl_DecrRefCount(dirPtr); } else { target = Tcl_FSGetNativePath(toPtr); if (access(target, F_OK) == -1) { - /* target doesn't exist */ + /* + * Target doesn't exist. + */ + errno = ENOENT; return NULL; } @@ -799,25 +824,31 @@ TclpObjLink(pathPtr, toPtr, linkAction) 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. + + /* + * 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). + * 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; @@ -825,9 +856,9 @@ TclpObjLink(pathPtr, toPtr, linkAction) target = Tcl_GetStringFromObj(transPtr, &targetLen); target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); Tcl_DecrRefCount(transPtr); - + if (symlink(target, src) != 0) { - toPtr = NULL; + toPtr = NULL; } Tcl_DStringFree(&ds); } else if (linkAction & TCL_CREATE_HARD_LINK) { @@ -846,7 +877,7 @@ TclpObjLink(pathPtr, toPtr, linkAction) int length; Tcl_DString ds; Tcl_Obj *transPtr; - + transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (transPtr == NULL) { return NULL; @@ -859,8 +890,8 @@ TclpObjLink(pathPtr, toPtr, linkAction) } Tcl_ExternalToUtfDString(NULL, link, length, &ds); - linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); + linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); if (linkPtr != NULL) { Tcl_IncrRefCount(linkPtr); @@ -868,33 +899,35 @@ TclpObjLink(pathPtr, toPtr, linkAction) return linkPtr; } } - -#endif - +#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. + * 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. + * NULL at present. * * Side effects: * None. * *--------------------------------------------------------------------------- */ + Tcl_Obj* TclpFilesystemPathType(pathPtr) Tcl_Obj* pathPtr; { - /* All native paths are of the same type */ + /* + * All native paths are of the same type. + */ + return NULL; } @@ -903,39 +936,39 @@ TclpFilesystemPathType(pathPtr) * * 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. + * 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. + * A valid normalized path. * * Side effects: * None. * *--------------------------------------------------------------------------- */ -Tcl_Obj* + +Tcl_Obj* TclpNativeToNormalized(clientData) ClientData clientData; { Tcl_DString ds; Tcl_Obj *objPtr; int len; - + CONST char *copy; Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds); - + copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); objPtr = Tcl_NewStringObj(copy,len); Tcl_DStringFree(&ds); - + return objPtr; } @@ -944,17 +977,18 @@ TclpNativeToNormalized(clientData) * * TclNativeCreateNativeRep -- * - * Create a native representation for the given path. + * Create a native representation for the given path. * * Results: - * The nativePath representation. + * The nativePath representation. * * Side effects: * Memory will be allocated. The path may need to be normalized. * *--------------------------------------------------------------------------- */ -ClientData + +ClientData TclNativeCreateNativeRep(pathPtr) Tcl_Obj* pathPtr; { @@ -965,15 +999,18 @@ TclNativeCreateNativeRep(pathPtr) char *str; 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). + /* + * 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); } else { - /* Make sure the normalized path is set */ + /* + * Make sure the normalized path is set. + */ + validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); Tcl_IncrRefCount(validPathPtr); } @@ -984,7 +1021,7 @@ TclNativeCreateNativeRep(pathPtr) Tcl_DecrRefCount(validPathPtr); nativePathPtr = ckalloc((unsigned) len); memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len); - + Tcl_DStringFree(&ds); return (ClientData)nativePathPtr; } @@ -994,18 +1031,19 @@ TclNativeCreateNativeRep(pathPtr) * * TclNativeDupInternalRep -- * - * Duplicate the native representation. + * Duplicate the native representation. * * Results: - * The copied native representation, or NULL if it is not possible - * to copy the representation. + * 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 + +ClientData TclNativeDupInternalRep(clientData) ClientData clientData; { @@ -1016,11 +1054,14 @@ TclNativeDupInternalRep(clientData) return NULL; } - /* ascii representation when running on Unix */ - len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char)); - + /* + * ASCII representation when running on Unix. + */ + + len = sizeof(char) + (strlen((CONST char*) clientData) * sizeof(char)); + copy = (char *) ckalloc(len); - memcpy((VOID*)copy, (VOID*)clientData, len); + memcpy((VOID *) copy, (VOID *) clientData, len); return (ClientData)copy; } @@ -1039,10 +1080,19 @@ TclNativeDupInternalRep(clientData) * *--------------------------------------------------------------------------- */ -int + +int TclpUtime(pathPtr, tval) - Tcl_Obj *pathPtr; /* File to modify */ - struct utimbuf *tval; /* New modification date structure */ + 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); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |