diff options
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r-- | unix/tclUnixFile.c | 400 |
1 files changed, 196 insertions, 204 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 5f5bfe0..0a2099c 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -6,15 +6,15 @@ * * 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. */ #include "tclInt.h" #include "tclFileSystem.h" -static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry, - const char* nativeName, Tcl_GlobTypeData *types); +static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry, + CONST char* nativeName, Tcl_GlobTypeData *types); /* *--------------------------------------------------------------------------- @@ -36,7 +36,7 @@ static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry, void TclpFindExecutable( - const char *argv0) /* The value of the application's argv[0] + CONST char *argv0) /* The value of the application's argv[0] * (native). */ { Tcl_Encoding encoding; @@ -105,11 +105,11 @@ TclpFindExecutable( while ((*p != ':') && (*p != 0)) { p++; } - TclDStringClear(&buffer); + Tcl_DStringSetLength(&buffer, 0); if (p != name) { Tcl_DStringAppend(&buffer, name, p - name); if (p[-1] != '/') { - TclDStringAppendLiteral(&buffer, "/"); + Tcl_DStringAppend(&buffer, "/", 1); } } name = Tcl_DStringAppend(&buffer, argv0, -1); @@ -177,10 +177,11 @@ TclpFindExecutable( Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), Tcl_DStringLength(&cwd), &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { - TclDStringAppendLiteral(&buffer, "/"); + Tcl_DStringAppend(&buffer, "/", 1); } Tcl_DStringFree(&cwd); - TclDStringAppendDString(&buffer, &nameString); + Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString), + Tcl_DStringLength(&nameString)); Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); @@ -219,12 +220,12 @@ 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. */ + 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; @@ -245,13 +246,12 @@ TclpMatchInDirectory( /* * Match a file directly. */ - Tcl_Obj *tailPtr; - const char *nativeTail; + CONST char *nativeTail; - native = Tcl_FSGetNativePath(pathPtr); + native = (CONST char*) Tcl_FSGetNativePath(pathPtr); tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL); - nativeTail = Tcl_FSGetNativePath(tailPtr); + nativeTail = (CONST char*) Tcl_FSGetNativePath(tailPtr); matchResult = NativeMatchType(interp, native, nativeTail, types); if (matchResult == 1) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); @@ -261,21 +261,21 @@ TclpMatchInDirectory( } else { DIR *d; Tcl_DirEntry *entryPtr; - const char *dirName; - size_t dirLength, nativeDirLen; + CONST char *dirName; + int dirLength; int matchHidden, matchHiddenPat; + int nativeDirLen; 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; + 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, + * 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". @@ -291,7 +291,7 @@ TclpMatchInDirectory( */ if (dirName[dirLength-1] != '/') { - dirName = TclDStringAppendLiteral(&dsOrig, "/"); + dirName = Tcl_DStringAppend(&dsOrig, "/", 1); dirLength++; } } @@ -314,9 +314,10 @@ TclpMatchInDirectory( 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_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't read directory \"", + Tcl_DStringValue(&dsOrig), "\": ", + Tcl_PosixError(interp), (char *) NULL); } Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); @@ -331,11 +332,11 @@ TclpMatchInDirectory( matchHiddenPat = (pattern[0] == '.') || ((pattern[0] == '\\') && (pattern[1] == '.')); - matchHidden = matchHiddenPat + matchHidden = matchHiddenPat || (types && (types->perm & TCL_GLOB_PERM_HIDDEN)); 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 @@ -343,19 +344,13 @@ TclpMatchInDirectory( */ if (*entryPtr->d_name == '.') { - if (!matchHidden) { - continue; - } + if (!matchHidden) continue; } else { #ifdef MAC_OSX_TCL - if (matchHiddenPat) { - continue; - } + if (matchHiddenPat) continue; /* Also need to check HFS hidden flag in TclMacOSXMatchType. */ #else - if (matchHidden) { - continue; - } + if (matchHidden) continue; #endif } @@ -395,8 +390,9 @@ TclpMatchInDirectory( } if (matchResult < 0) { return TCL_ERROR; + } else { + return TCL_OK; } - return TCL_OK; } /* @@ -404,13 +400,13 @@ TclpMatchInDirectory( * * NativeMatchType -- * - * This routine is used by the globbing code to check if a file matches a - * given type description. + * 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). + * 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 wich case an error is left in interp). * * Side effects: * None. @@ -421,12 +417,11 @@ TclpMatchInDirectory( static int NativeMatchType( Tcl_Interp *interp, /* Interpreter to receive errors. */ - const char *nativeEntry, /* Native path to check. */ - const char *nativeName, /* Native filename to check. */ + 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 @@ -437,126 +432,124 @@ NativeMatchType( if (TclOSlstat(nativeEntry, &buf) != 0) { return 0; } - return 1; - } + } 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; + } - 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. + * 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). */ - 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 (((types->perm & TCL_GLOB_PERM_RONLY) && #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) - !(buf.st_flags & 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)) + (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 */ + || ((types->perm & TCL_GLOB_PERM_HIDDEN) && + (*nativeName != '.')) +#endif ) { - 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) { + if (types->type != 0) { + if (types->perm == 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: + * We haven't yet done a stat on the file. */ - if ((types->type & TCL_GLOB_TYPE_LINK) - && (TclOSlstat(nativeEntry, &buf) == 0) - && S_ISLNK(buf.st_mode)) { - return 1; + 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' - */ + /* + * In order bcdpfls as in 'find -t' + */ - if ( ((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(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 */ - ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))) { - /* - * Do nothing - this file is ok. - */ - } else { + ) { + /* + * 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; - } + if (types->type & TCL_GLOB_TYPE_LINK) { + if (TclOSlstat(nativeEntry, &buf) == 0) { + if (S_ISLNK(buf.st_mode)) { + goto filetypeOK; + } + } + } #endif /* S_ISLNK */ - return 0; + return 0; + } } - } - filetypeOK: - - /* - * If we're on OSX, we also have to worry about matching the file creator - * code (if specified). Do that now. - */ - + filetypeOK: ; #ifdef MAC_OSX_TCL - if (types->macType != NULL || types->macCreator != NULL || - (types->perm & TCL_GLOB_PERM_HIDDEN)) { - int matchResult; + 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 (types->perm == 0 && types->type == 0) { + /* + * We haven't yet done a stat on the file. + */ - if (TclOSstat(nativeEntry, &buf) != 0) { - return 0; + if (TclOSstat(nativeEntry, &buf) != 0) { + return 0; + } } - } - matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName, - &buf, types); - if (matchResult != 1) { - return matchResult; + matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName, + &buf, types); + if (matchResult != 1) { + return matchResult; + } } +#endif } -#endif /* MAC_OSX_TCL */ - return 1; } @@ -581,16 +574,17 @@ NativeMatchType( *---------------------------------------------------------------------- */ -const char * +char * TclpGetUserHome( - const char *name, /* User name for desired home directory. */ + 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; + native = Tcl_UtfToExternalDString(NULL, name, -1, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -622,12 +616,12 @@ TclpObjAccess( 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); } /* @@ -650,12 +644,12 @@ int TclpObjChdir( 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); } /* @@ -710,27 +704,24 @@ TclpGetNativeCwd( char buffer[MAXPATHLEN+1]; #ifdef USEGETWD - if (getwd(buffer) == NULL) { /* INTL: Native. */ - return NULL; - } + 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; } -#endif /* USEGETWD */ - - if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { - char *newCd = ckalloc(strlen(buffer) + 1); + if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) { + /* + * No change to pwd. + */ + return clientData; + } else { + char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1)); strcpy(newCd, buffer); - return newCd; + return (ClientData) newCd; } - - /* - * No change to pwd. - */ - - return clientData; } /* @@ -755,7 +746,7 @@ TclpGetNativeCwd( *---------------------------------------------------------------------- */ -const char * +CONST char * TclpGetCwd( Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with @@ -767,12 +758,12 @@ TclpGetCwd( if (getwd(buffer) == NULL) /* INTL: Native. */ #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */ -#endif /* USEGETWD */ +#endif { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, + "error getting working directory name: ", + Tcl_PosixError(interp), NULL); } return NULL; } @@ -801,14 +792,14 @@ TclpGetCwd( char * TclpReadlink( - const char *path, /* Path of file to readlink (UTF-8). */ + 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); @@ -823,7 +814,7 @@ TclpReadlink( return Tcl_DStringValue(linkPtr); #else return NULL; -#endif /* !DJGPP */ +#endif } /* @@ -847,25 +838,25 @@ TclpObjStat( 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 * +Tcl_Obj* TclpObjLink( Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction) { if (toPtr != NULL) { - const char *src = Tcl_FSGetNativePath(pathPtr); - const char *target = NULL; + CONST char *src = Tcl_FSGetNativePath(pathPtr); + CONST char *target = NULL; if (src == NULL) { return NULL; @@ -938,6 +929,7 @@ TclpObjLink( */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { + int targetLen; Tcl_DString ds; Tcl_Obj *transPtr; @@ -951,8 +943,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = TclGetString(transPtr); - target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds); + target = Tcl_GetStringFromObj(transPtr, &targetLen); + target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { @@ -988,8 +980,12 @@ TclpObjLink( } 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; } } @@ -1051,9 +1047,19 @@ TclpNativeToNormalized( 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); - Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds); - return TclDStringToObj(&ds); + objPtr = Tcl_NewStringObj(copy,len); + Tcl_DStringFree(&ds); + + return objPtr; } /* @@ -1077,10 +1083,10 @@ TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { char *nativePathPtr; - const char *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - size_t len; + int len; + char *str; if (TclFSCwdIsNative()) { /* @@ -1105,8 +1111,7 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = TclGetString(validPathPtr); - len = validPathPtr->length; + str = Tcl_GetStringFromObj(validPathPtr, &len); Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { @@ -1116,11 +1121,11 @@ TclNativeCreateNativeRep( return NULL; } Tcl_DecrRefCount(validPathPtr); - nativePathPtr = ckalloc(len); - memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); + nativePathPtr = ckalloc((unsigned) len); + memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len); Tcl_DStringFree(&ds); - return nativePathPtr; + return (ClientData)nativePathPtr; } /* @@ -1155,11 +1160,11 @@ TclNativeDupInternalRep( * ASCII representation when running on Unix. */ - len = (strlen((const char*) clientData) + 1) * sizeof(char); + len = sizeof(char) + (strlen((CONST char*) clientData) * sizeof(char)); - copy = ckalloc(len); - memcpy(copy, clientData, len); - return copy; + copy = (char *) ckalloc(len); + memcpy((void *) copy, (void *) clientData, len); + return (ClientData)copy; } /* @@ -1185,18 +1190,11 @@ TclpUtime( { return utime(Tcl_FSGetNativePath(pathPtr), tval); } - #ifdef __CYGWIN__ - -int -TclOSstat( - const char *name, - void *cygstat) -{ +int TclOSstat(const char *name, void *cygstat) { struct stat buf; Tcl_StatBuf *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; @@ -1210,16 +1208,10 @@ TclOSstat( statBuf->st_ctime = buf.st_ctime; return result; } - -int -TclOSlstat( - const char *name, - void *cygstat) -{ +int TclOSlstat(const char *name, void *cygstat) { struct stat buf; Tcl_StatBuf *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; @@ -1233,7 +1225,7 @@ TclOSlstat( statBuf->st_ctime = buf.st_ctime; return result; } -#endif /* CYGWIN */ +#endif /* * Local Variables: |