diff options
Diffstat (limited to 'unix')
| -rw-r--r-- | unix/mkLinks | 72 | ||||
| -rw-r--r-- | unix/tclUnixFCmd.c | 118 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 340 | ||||
| -rw-r--r-- | unix/tclUnixInit.c | 247 | ||||
| -rw-r--r-- | unix/tclUnixPipe.c | 30 |
5 files changed, 553 insertions, 254 deletions
diff --git a/unix/mkLinks b/unix/mkLinks index 1b57e15..fa82057 100644 --- a/unix/mkLinks +++ b/unix/mkLinks @@ -442,6 +442,74 @@ if test -r ExprLongObj.3; then ln ExprLongObj.3 Tcl_ExprBooleanObj.3 ln ExprLongObj.3 Tcl_ExprObj.3 fi +if test -r FileSystem.3; then + rm -f Tcl_FSCopyFile.3 + rm -f Tcl_FSCopyDirectory.3 + rm -f Tcl_FSCreateDirectory.3 + rm -f Tcl_FSDeleteFile.3 + rm -f Tcl_FSRemoveDirectory.3 + rm -f Tcl_FSRenameFile.3 + rm -f Tcl_FSListVolumes.3 + rm -f Tcl_FSEvalFile.3 + rm -f Tcl_FSLoadFile.3 + rm -f Tcl_FSMatchInDirectory.3 + rm -f Tcl_FSReadlink.3 + rm -f Tcl_FSLstat.3 + rm -f Tcl_FSUtime.3 + rm -f Tcl_FSFileAttrsGet.3 + rm -f Tcl_FSFileAttrsSet.3 + rm -f Tcl_FSFileAttrStrings.3 + rm -f Tcl_FSStat.3 + rm -f Tcl_FSAccess.3 + rm -f Tcl_FSOpenFileChannel.3 + rm -f Tcl_FSGetCwd.3 + rm -f Tcl_FSChdir.3 + rm -f Tcl_FSPathSeparator.3 + rm -f Tcl_FSJoinPath.3 + rm -f Tcl_FSSplitPath.3 + rm -f Tcl_FSEqualPaths.3 + rm -f Tcl_FSGetNormalizedPath.3 + rm -f Tcl_FSJoinToPath.3 + rm -f Tcl_FSConvertToPathType.3 + rm -f Tcl_FSGetInternalRep.3 + rm -f Tcl_FSGetTranslatedPath.3 + rm -f Tcl_FSNewNativePath.3 + rm -f Tcl_FSGetNativePath.3 + rm -f Tcl_FSFileSystemInfo.3 + ln FileSystem.3 Tcl_FSCopyFile.3 + ln FileSystem.3 Tcl_FSCopyDirectory.3 + ln FileSystem.3 Tcl_FSCreateDirectory.3 + ln FileSystem.3 Tcl_FSDeleteFile.3 + ln FileSystem.3 Tcl_FSRemoveDirectory.3 + ln FileSystem.3 Tcl_FSRenameFile.3 + ln FileSystem.3 Tcl_FSListVolumes.3 + ln FileSystem.3 Tcl_FSEvalFile.3 + ln FileSystem.3 Tcl_FSLoadFile.3 + ln FileSystem.3 Tcl_FSMatchInDirectory.3 + ln FileSystem.3 Tcl_FSReadlink.3 + ln FileSystem.3 Tcl_FSLstat.3 + ln FileSystem.3 Tcl_FSUtime.3 + ln FileSystem.3 Tcl_FSFileAttrsGet.3 + ln FileSystem.3 Tcl_FSFileAttrsSet.3 + ln FileSystem.3 Tcl_FSFileAttrStrings.3 + ln FileSystem.3 Tcl_FSStat.3 + ln FileSystem.3 Tcl_FSAccess.3 + ln FileSystem.3 Tcl_FSOpenFileChannel.3 + ln FileSystem.3 Tcl_FSGetCwd.3 + ln FileSystem.3 Tcl_FSChdir.3 + ln FileSystem.3 Tcl_FSPathSeparator.3 + ln FileSystem.3 Tcl_FSJoinPath.3 + ln FileSystem.3 Tcl_FSSplitPath.3 + ln FileSystem.3 Tcl_FSEqualPaths.3 + ln FileSystem.3 Tcl_FSGetNormalizedPath.3 + ln FileSystem.3 Tcl_FSJoinToPath.3 + ln FileSystem.3 Tcl_FSConvertToPathType.3 + ln FileSystem.3 Tcl_FSGetInternalRep.3 + ln FileSystem.3 Tcl_FSGetTranslatedPath.3 + ln FileSystem.3 Tcl_FSNewNativePath.3 + ln FileSystem.3 Tcl_FSGetNativePath.3 + ln FileSystem.3 Tcl_FSFileSystemInfo.3 +fi if test -r FindExec.3; then rm -f Tcl_FindExecutable.3 rm -f Tcl_GetNameOfExecutable.3 @@ -651,6 +719,8 @@ if test -r OpenFileChnl.3; then rm -f Tcl_GetChannelNamesEx.3 rm -f Tcl_RegisterChannel.3 rm -f Tcl_UnregisterChannel.3 + rm -f Tcl_DetachChannel.3 + rm -f Tcl_IsStandardChannel.3 rm -f Tcl_Close.3 rm -f Tcl_ReadChars.3 rm -f Tcl_Read.3 @@ -676,6 +746,8 @@ if test -r OpenFileChnl.3; then ln OpenFileChnl.3 Tcl_GetChannelNamesEx.3 ln OpenFileChnl.3 Tcl_RegisterChannel.3 ln OpenFileChnl.3 Tcl_UnregisterChannel.3 + ln OpenFileChnl.3 Tcl_DetachChannel.3 + ln OpenFileChnl.3 Tcl_IsStandardChannel.3 ln OpenFileChnl.3 Tcl_Close.3 ln OpenFileChnl.3 Tcl_ReadChars.3 ln OpenFileChnl.3 Tcl_Read.3 diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 20998ca..e3d4d95 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.6 2000/04/04 08:05:57 hobbs Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.7 2001/07/31 19:12:07 vincentdarley Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -150,6 +150,73 @@ static int TraverseUnixTree _ANSI_ARGS_(( Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr)); +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; +{ + return TclpCreateDirectory(Tcl_FSGetTranslatedPath(NULL, pathPtr)); +} + +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; +{ + return TclpDeleteFile(Tcl_FSGetTranslatedPath(NULL, pathPtr)); +} + +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; +{ + Tcl_DString ds; + int ret; + ret = TclpCopyDirectory(Tcl_FSGetTranslatedPath(NULL,srcPathPtr), + Tcl_FSGetTranslatedPath(NULL,destPathPtr), &ds); + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; +} + +int +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; +{ + return TclpCopyFile(Tcl_FSGetTranslatedPath(NULL,srcPathPtr), + Tcl_FSGetTranslatedPath(NULL,destPathPtr)); +} + +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; +{ + Tcl_DString ds; + int ret; + ret = TclpRemoveDirectory(Tcl_FSGetTranslatedPath(NULL, pathPtr),recursive, &ds); + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; +} + +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; +{ + return TclpRenameFile(Tcl_FSGetTranslatedPath(NULL,srcPathPtr), + Tcl_FSGetTranslatedPath(NULL,destPathPtr)); +} + /* *--------------------------------------------------------------------------- * @@ -1609,3 +1676,52 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) } return TCL_OK; } + +/* + *--------------------------------------------------------------------------- + * + * TclpObjNormalizePath -- + * + * This function scans through a path specification and replaces + * it, in place, with a normalized version. On unix, this simply + * ascertains where the valid path ends, and makes no change in + * place. + * + * Results: + * The new 'nextCheckpoint' value, giving as far as we could + * understand in the path. + * + * Side effects: + * The pathPtr string, which must contain a valid path, is + * not modified (unlike Windows, MacOS versions). + * + *--------------------------------------------------------------------------- + */ + +int +TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) + Tcl_Interp *interp; + Tcl_Obj *pathPtr; + int nextCheckpoint; +{ + char *path = Tcl_GetString(pathPtr); + + while (1) { + char cur = path[nextCheckpoint]; + if (cur == 0) { + break; + } + if (cur == '/') { + int access; + path[nextCheckpoint] = 0; + access = TclpAccess(path, F_OK); + path[nextCheckpoint] = '/'; + if (access != 0) { + /* File doesn't exist */ + break; + } + } + nextCheckpoint++; + } + return nextCheckpoint; +} diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 2679fdb..308a320 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,12 +9,14 @@ * 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.9 2000/01/11 22:09:19 hobbs Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $ */ #include "tclInt.h" #include "tclPort.h" +char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr)); + /* *--------------------------------------------------------------------------- @@ -176,46 +178,49 @@ TclpFindExecutable(argv0) /* *---------------------------------------------------------------------- * - * TclpMatchFilesTypes -- + * TclpMatchInDirectory -- * * This routine is used by the globbing code to search a * directory for all files which match a given pattern. * * Results: - * If the tail argument is NULL, then the matching files are - * added to the the interp's result. Otherwise, TclDoGlob is called - * recursively for each matching subdirectory. The return value - * is a standard Tcl result indicating whether an error occurred - * in globbing. + * 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 -TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types) - Tcl_Interp *interp; /* Interpreter to receive results. */ - char *separators; /* Directory separators to pass to TclDoGlob */ - Tcl_DString *dirPtr; /* Contains path to directory to search. */ +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. */ char *pattern; /* Pattern to match against. */ - char *tail; /* Pointer to end of pattern. Tail must - * point to a location in pattern and must - * not be static. */ - GlobTypeData *types; /* Object containing list of acceptable types. - * May be NULL. */ + Tcl_GlobTypeData *types; /* Object containing list of acceptable types. + * May be NULL. In particular the directory + * flag is very important. */ { - char *native, *fname, *dirName, *patternEnd = tail; - char savedChar = 0; /* lint. */ + char *native, *fname, *dirName; DIR *d; Tcl_DString ds; struct stat statBuf; int matchHidden; int result = TCL_OK; - int baseLength = Tcl_DStringLength(dirPtr); - Tcl_Obj *resultPtr; + Tcl_DString dsOrig; + char *fileName; + int baseLength; + fileName = Tcl_FSGetTranslatedPath(interp, pathPtr); + if (fileName == NULL) { + return TCL_ERROR; + } + Tcl_DStringInit(&dsOrig); + Tcl_DStringAppend(&dsOrig, fileName, -1); + baseLength = Tcl_DStringLength(&dsOrig); + /* * Make sure that the directory part of the name really is a * directory. If the directory name is "", use the name "." @@ -224,14 +229,21 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types) * otherwise "glob foo.c" would return "./foo.c". */ - if (Tcl_DStringLength(dirPtr) == 0) { + if (baseLength == 0) { dirName = "."; } else { - dirName = Tcl_DStringValue(dirPtr); + dirName = Tcl_DStringValue(&dsOrig); + /* Make sure we have a trailing directory delimiter */ + if (dirName[baseLength-1] != '/') { + Tcl_DStringAppend(&dsOrig, "/", 1); + dirName = Tcl_DStringValue(&dsOrig); + baseLength++; + } } if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */ || !S_ISDIR(statBuf.st_mode)) { + Tcl_DStringFree(&dsOrig); return TCL_OK; } @@ -254,6 +266,7 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types) d = opendir(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (d == NULL) { + char savedChar = '\0'; Tcl_ResetResult(interp); /* @@ -261,39 +274,21 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types) */ if (baseLength > 0) { - savedChar = (Tcl_DStringValue(dirPtr))[baseLength-1]; + savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1]; if (savedChar == '/') { - (Tcl_DStringValue(dirPtr))[baseLength-1] = '\0'; + (Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0'; } } Tcl_AppendResult(interp, "couldn't read directory \"", - Tcl_DStringValue(dirPtr), "\": ", + Tcl_DStringValue(&dsOrig), "\": ", Tcl_PosixError(interp), (char *) NULL); if (baseLength > 0) { - (Tcl_DStringValue(dirPtr))[baseLength-1] = savedChar; + (Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar; } + Tcl_DStringFree(&dsOrig); return TCL_ERROR; } - /* - * Clean up the end of the pattern and the tail pointer. Leave - * the tail pointing to the first character after the path separator - * following the pattern, or NULL. Also, ensure that the pattern - * is null-terminated. - */ - - if (*tail == '\\') { - tail++; - } - if (*tail == '\0') { - tail = NULL; - } else { - tail++; - } - savedChar = *patternEnd; - *patternEnd = '\0'; - - resultPtr = Tcl_GetObjResult(interp); while (1) { char *utf; struct dirent *entryPtr; @@ -328,114 +323,85 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types) utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds); if (Tcl_StringMatch(utf, pattern) != 0) { - Tcl_DStringSetLength(dirPtr, baseLength); - Tcl_DStringAppend(dirPtr, utf, -1); - fname = Tcl_DStringValue(dirPtr); - if (tail == NULL) { - int typeOk = 1; - if (types != NULL) { - if (types->perm != 0) { - struct stat buf; - - if (TclpStat(fname, &buf) != 0) { - panic("stat failed on known file"); - } - /* - * readonly means that there are NO write permissions - * (even for user), but execute is OK for anybody - */ - if ( - ((types->perm & TCL_GLOB_PERM_RONLY) && - (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) || - ((types->perm & TCL_GLOB_PERM_R) && - (TclpAccess(fname, R_OK) != 0)) || - ((types->perm & TCL_GLOB_PERM_W) && - (TclpAccess(fname, W_OK) != 0)) || - ((types->perm & TCL_GLOB_PERM_X) && - (TclpAccess(fname, X_OK) != 0)) - ) { - typeOk = 0; - } + int typeOk = 1; + + Tcl_DStringSetLength(&dsOrig, baseLength); + Tcl_DStringAppend(&dsOrig, utf, -1); + fname = Tcl_DStringValue(&dsOrig); + if (types != NULL) { + if (types->perm != 0) { + struct stat buf; + + if (TclpStat(fname, &buf) != 0) { + panic("stat failed on known file"); } - if (typeOk && (types->type != 0)) { - struct stat buf; + /* + * readonly means that there are NO write permissions + * (even for user), but execute is OK for anybody + */ + if ( + ((types->perm & TCL_GLOB_PERM_RONLY) && + (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) || + ((types->perm & TCL_GLOB_PERM_R) && + (TclpAccess(fname, R_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_W) && + (TclpAccess(fname, W_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_X) && + (TclpAccess(fname, X_OK) != 0)) + ) { + typeOk = 0; + } + } + if (typeOk && (types->type != 0)) { + struct stat buf; + /* + * We must match at least one flag to be listed + */ + typeOk = 0; + if (TclpLstat(fname, &buf) >= 0) { /* - * We must match at least one flag to be listed + * In order bcdpfls as in 'find -t' */ - typeOk = 0; - if (TclpLstat(fname, &buf) >= 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_ISLNK - || ((types->type & TCL_GLOB_TYPE_LINK) && - S_ISLNK(buf.st_mode)) + || ((types->type & TCL_GLOB_TYPE_LINK) && + S_ISLNK(buf.st_mode)) #endif #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 - ) { - typeOk = 1; - } - } else { - /* Posix error occurred */ + ) { + typeOk = 1; } + } else { + /* Posix error occurred */ } } - if (typeOk) { - Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(fname, - Tcl_DStringLength(dirPtr))); - } - } else if ((TclpStat(fname, &statBuf) == 0) - && S_ISDIR(statBuf.st_mode)) { - Tcl_DStringAppend(dirPtr, "/", 1); - result = TclDoGlob(interp, separators, dirPtr, tail, types); - if (result != TCL_OK) { - Tcl_DStringFree(&ds); - break; - } + } + if (typeOk) { + Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig))); } } Tcl_DStringFree(&ds); } - *patternEnd = savedChar; closedir(d); + Tcl_DStringFree(&dsOrig); return result; } -/* - * TclpMatchFiles -- - * - * This function is now obsolete. Call the above function - * 'TclpMatchFilesTypes' instead. - */ -int -TclpMatchFiles(interp, separators, dirPtr, pattern, tail) - Tcl_Interp *interp; /* Interpreter to receive results. */ - char *separators; /* Directory separators to pass to TclDoGlob */ - Tcl_DString *dirPtr; /* Contains path to directory to search. */ - char *pattern; /* Pattern to match against. */ - char *tail; /* Pointer to end of pattern. Tail must - * point to a location in pattern and must - * not be static. */ -{ - return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL); -} - /* *--------------------------------------------------------------------------- * @@ -693,4 +659,106 @@ TclpStat(path, bufPtr) return result; } + +int +TclpObjLstat(pathPtr, buf) + Tcl_Obj *pathPtr; + struct stat *buf; +{ + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return lstat(path, buf); + } +} + +int +TclpObjStat(pathPtr, buf) + Tcl_Obj *pathPtr; + struct stat *buf; +{ + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return stat(path, buf); + } +} + +Tcl_Obj* +TclpObjGetCwd(interp) + Tcl_Interp *interp; +{ + 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; + } +} + +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; +{ + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return chdir(path); + } +} + +int +TclpObjAccess(pathPtr, mode) + Tcl_Obj *pathPtr; + int mode; +{ + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return access(path, mode); + } +} + +#ifdef S_IFLNK + +Tcl_Obj* +TclpObjReadlink(pathPtr) + Tcl_Obj *pathPtr; +{ + char link[MAXPATHLEN]; + int length; + char *native; + Tcl_Obj* linkPtr; + + if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) { + return NULL; + } + length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); + if (length < 0) { + return NULL; + } + + /* + * Allocate and copy the name, taking care since the + * name need not be null terminated. + */ + native = (char*)ckalloc((unsigned)(1+length)); + strncpy(native, link, (unsigned)length); + native[length] = '\0'; + + linkPtr = Tcl_FSNewNativePath(pathPtr, native); + Tcl_IncrRefCount(linkPtr); + return linkPtr; +} + +#endif + + diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 3fd7d1f..b75acd7 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclUnixInit.c,v 1.22 2001/07/02 20:57:02 dgp Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.23 2001/07/31 19:12:08 vincentdarley Exp $ */ #include "tclInt.h" @@ -29,6 +29,10 @@ */ #include "tclInitScript.h" +/* Used to store the encoding used for binary files */ +static Tcl_Encoding binaryEncoding = NULL; +/* Has the basic library path encoding issue been fixed */ +static int libraryPathEncodingFixed = 0; /* * Default directory in which to look for Tcl library scripts. The @@ -370,13 +374,18 @@ CONST char *path; /* Path to the executable in native * Based on the locale, determine the encoding of the operating * system and the default encoding for newly opened files. * - * Called at process initialization time. + * Called at process initialization time, and part way through + * startup, we verify that the initial encodings were correctly + * setup. Depending on Tcl's environment, there may not have been + * enough information first time through (above). * * Results: * None. * * Side effects: - * The Tcl library path is converted from native encoding to UTF-8. + * The Tcl library path is converted from native encoding to UTF-8, + * on the first call, and the encodings may be changed on first or + * second call. * *--------------------------------------------------------------------------- */ @@ -384,141 +393,147 @@ CONST char *path; /* Path to the executable in native void TclpSetInitialEncodings() { - CONST char *encoding; - int i; - Tcl_Obj *pathPtr; - char *langEnv; + if (libraryPathEncodingFixed == 0) { + CONST char *encoding; + int i; + Tcl_Obj *pathPtr; + char *langEnv; - /* - * Determine the current encoding from the LC_* or LANG environment - * variables. We previously used setlocale() to determine the locale, - * but this does not work on some systems (e.g. Linux/i386 RH 5.0). - */ + /* + * Determine the current encoding from the LC_* or LANG environment + * variables. We previously used setlocale() to determine the locale, + * but this does not work on some systems (e.g. Linux/i386 RH 5.0). + */ - langEnv = getenv("LC_ALL"); + langEnv = getenv("LC_ALL"); - if (langEnv == NULL || langEnv[0] == '\0') { - langEnv = getenv("LC_CTYPE"); - } - if (langEnv == NULL || langEnv[0] == '\0') { - langEnv = getenv("LANG"); - } - if (langEnv == NULL || langEnv[0] == '\0') { - langEnv = NULL; - } - - encoding = NULL; - if (langEnv != NULL) { - for (i = 0; localeTable[i].lang != NULL; i++) { - if (strcmp(localeTable[i].lang, langEnv) == 0) { - encoding = localeTable[i].encoding; - break; - } + if (langEnv == NULL || langEnv[0] == '\0') { + langEnv = getenv("LC_CTYPE"); + } + if (langEnv == NULL || langEnv[0] == '\0') { + langEnv = getenv("LANG"); + } + if (langEnv == NULL || langEnv[0] == '\0') { + langEnv = NULL; } - /* - * There was no mapping in the locale table. If there is an - * encoding subfield, we can try to guess from that. - */ - if (encoding == NULL) { - char *p; - for (p = langEnv; *p != '\0'; p++) { - if (*p == '.') { - p++; + encoding = NULL; + if (langEnv != NULL) { + for (i = 0; localeTable[i].lang != NULL; i++) { + if (strcmp(localeTable[i].lang, langEnv) == 0) { + encoding = localeTable[i].encoding; break; } } - if (*p != '\0') { - Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, p, -1); + /* + * There was no mapping in the locale table. If there is an + * encoding subfield, we can try to guess from that. + */ - encoding = Tcl_DStringValue(&ds); - Tcl_UtfToLower(Tcl_DStringValue(&ds)); - if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) { + if (encoding == NULL) { + char *p; + for (p = langEnv; *p != '\0'; p++) { + if (*p == '.') { + p++; + break; + } + } + if (*p != '\0') { + Tcl_DString ds; + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, p, -1); + + encoding = Tcl_DStringValue(&ds); + Tcl_UtfToLower(Tcl_DStringValue(&ds)); + if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) { + Tcl_DStringFree(&ds); + goto resetPath; + } Tcl_DStringFree(&ds); - goto resetPath; + encoding = NULL; } - Tcl_DStringFree(&ds); - encoding = NULL; } } - } - if (encoding == NULL) { - encoding = "iso8859-1"; - } + if (encoding == NULL) { + encoding = "iso8859-1"; + } - Tcl_SetSystemEncoding(NULL, encoding); + Tcl_SetSystemEncoding(NULL, encoding); - resetPath: - /* - * Initialize the C library's locale subsystem. This is required - * for input methods to work properly on X11. We only do this for - * LC_CTYPE because that's the necessary one, and we don't want to - * affect LC_TIME here. The side effect of setting the default locale - * should be to load any locale specific modules that are needed by X. - * [BUG: 5422 3345 4236 2522 2521]. - */ + resetPath: + /* + * Initialize the C library's locale subsystem. This is required + * for input methods to work properly on X11. We only do this for + * LC_CTYPE because that's the necessary one, and we don't want to + * affect LC_TIME here. The side effect of setting the default locale + * should be to load any locale specific modules that are needed by X. + * [BUG: 5422 3345 4236 2522 2521]. + */ - setlocale(LC_CTYPE, ""); + setlocale(LC_CTYPE, ""); - /* - * In case the initial locale is not "C", ensure that the numeric - * processing is done in "C" locale regardless. This is needed because - * Tcl relies on routines like strtod, but should not have locale - * dependent behavior. - */ + /* + * In case the initial locale is not "C", ensure that the numeric + * processing is done in "C" locale regardless. This is needed because + * Tcl relies on routines like strtod, but should not have locale + * dependent behavior. + */ - setlocale(LC_NUMERIC, "C"); + setlocale(LC_NUMERIC, "C"); - /* - * Until the system encoding was actually set, the library path was - * actually in the native multi-byte encoding, and not really UTF-8 - * as advertised. We cheated as follows: - * - * 1. It was safe to allow the Tcl_SetSystemEncoding() call to - * append the ASCII chars that make up the encoding's filename to - * the names (in the native encoding) of directories in the library - * path, since all Unix multi-byte encodings have ASCII in the - * beginning. - * - * 2. To open the encoding file, the native bytes in the file name - * were passed to the OS, without translating from UTF-8 to native, - * because the name was already in the native encoding. - * - * Now that the system encoding was actually successfully set, - * translate all the names in the library path to UTF-8. That way, - * next time we search the library path, we'll translate the names - * from UTF-8 to the system encoding which will be the native - * encoding. - */ + /* + * Until the system encoding was actually set, the library path was + * actually in the native multi-byte encoding, and not really UTF-8 + * as advertised. We cheated as follows: + * + * 1. It was safe to allow the Tcl_SetSystemEncoding() call to + * append the ASCII chars that make up the encoding's filename to + * the names (in the native encoding) of directories in the library + * path, since all Unix multi-byte encodings have ASCII in the + * beginning. + * + * 2. To open the encoding file, the native bytes in the file name + * were passed to the OS, without translating from UTF-8 to native, + * because the name was already in the native encoding. + * + * Now that the system encoding was actually successfully set, + * translate all the names in the library path to UTF-8. That way, + * next time we search the library path, we'll translate the names + * from UTF-8 to the system encoding which will be the native + * encoding. + */ - pathPtr = TclGetLibraryPath(); - if (pathPtr != NULL) { - int objc; - Tcl_Obj **objv; - - objc = 0; - Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); - for (i = 0; i < objc; i++) { - int length; - char *string; - Tcl_DString ds; - - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_ExternalToUtfDString(NULL, string, length, &ds); - Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - } - } + pathPtr = TclGetLibraryPath(); + if (pathPtr != NULL) { + int objc; + Tcl_Obj **objv; + + objc = 0; + Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); + for (i = 0; i < objc; i++) { + int length; + char *string; + Tcl_DString ds; - /* - * Keep the iso8859-1 encoding preloaded. The IO package uses it for - * gets on a binary channel. - */ + string = Tcl_GetStringFromObj(objv[i], &length); + Tcl_ExternalToUtfDString(NULL, string, length, &ds); + Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + } + } - Tcl_GetEncoding(NULL, "iso8859-1"); + libraryPathEncodingFixed = 1; + } + + /* This is only ever called from the startup thread */ + if (binaryEncoding == NULL) { + /* + * Keep the iso8859-1 encoding preloaded. The IO package uses + * it for gets on a binary channel. + */ + binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); + } } /* diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 318b9c6..9da1b11 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixPipe.c,v 1.12 2001/05/15 21:23:31 hobbs Exp $ + * RCS: @(#) $Id: tclUnixPipe.c,v 1.13 2001/07/31 19:12:08 vincentdarley Exp $ */ #include "tclInt.h" @@ -221,6 +221,34 @@ TclpCreateTempFile(contents) /* *---------------------------------------------------------------------- * + * TclpTempFileName -- + * + * This function returns unique filename. + * + * Results: + * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj* +TclpTempFileName() +{ + char fileName[L_tmpnam]; + + if (tmpnam(fileName) == NULL) { /* INTL: Native. */ + return NULL; + } + + return TclpNativeToNormalized((ClientData) fileName); +} + +/* + *---------------------------------------------------------------------- + * * TclpCreatePipe -- * * Creates a pipe - simply calls the pipe() function. |