diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclUnixFile.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclUnixFile.c Fri Jun 15 03:10:57 2012 +0200 @@ -0,0 +1,862 @@ +/* + * tclUnixFile.c -- + * + * This file contains wrappers around UNIX file handling functions. + * These wrappers mask differences between Windows and UNIX. + * + * Copyright (c) 1995-1998 Sun Microsystems, Inc. + * Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved. + * + * 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.32.2.2 2003/10/31 08:46:41 vincentdarley Exp $ + */ + +#include "tclInt.h" +#include "tclPort.h" +#if defined(__SYMBIAN32__) +#include "convertPathSlashes.h" +#include "tclSymbianGlobals.h" +#endif + +static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types); + + +/* + *--------------------------------------------------------------------------- + * + * TclpFindExecutable -- + * + * This procedure computes the absolute path name of the current + * application, given its argv[0] value. + * + * Results: + * A dirty UTF string that is the path to the executable. At this + * point we may not know the system encoding. Convert the native + * string value to UTF using the default encoding. The assumption + * is that we will still be able to parse the path given the path + * name contains ASCII string and '/' chars do not conflict with + * other UTF chars. + * + * Side effects: + * The variable tclNativeExecutableName gets filled in with the file + * name for the application, if we figured it out. If we couldn't + * figure it out, tclNativeExecutableName is set to NULL. + * + *--------------------------------------------------------------------------- + */ + +char * +TclpFindExecutable(argv0) + CONST char *argv0; /* The value of the application's argv[0] + * (native). */ +{ + CONST char *name, *p; + Tcl_StatBuf statBuf; + int length; + Tcl_DString buffer, nameString; +#ifdef __SYMBIAN32__ + char bufferUsed; +#endif + + if (argv0 == NULL) { + return NULL; + } + if (tclNativeExecutableName != NULL) { + return tclNativeExecutableName; + } + +#ifdef __SYMBIAN32__ + // assuming if we're not using eshell that we have to specify the path. + bufferUsed = 0; + if (!strstr(argv0, "Z:\\sys\\bin")) { + Tcl_DStringInit(&buffer); + Tcl_DStringSetLength(&buffer, 0); + Tcl_DStringAppend(&buffer, "Z:\\sys\\bin\\", 11); + name = Tcl_DStringAppend(&buffer, argv0, -1); + bufferUsed = 1; + } + else + name = argv0; //use if we don't have to specify the path. + + tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1)); + strcpy(tclNativeExecutableName, name); + + tclCopySymbianPathSlashConversion(TO_TCL, tclNativeExecutableName, tclNativeExecutableName); + + if (bufferUsed) { + Tcl_DStringFree(&buffer); + } + + return tclNativeExecutableName; +#else + + + 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 (isspace(UCHAR(*p))) { /* INTL: BUG */ + p++; + } + name = p; + while ((*p != ':') && (*p != 0)) { + p++; + } + Tcl_DStringSetLength(&buffer, 0); + if (p != name) { + Tcl_DStringAppend(&buffer, name, p - name); + if (p[-1] != '/') { + Tcl_DStringAppend(&buffer, "/", 1); + } + } + name = Tcl_DStringAppend(&buffer, argv0, -1); + + /* + * 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++; + } + } + goto done; + + /* + * If the name starts with "/" then just copy it to tclExecutableName. + */ + +gotName: +#ifdef DJGPP + if (name[1] == ':') { +#else + if (name[0] == '/') { +#endif + Tcl_ExternalToUtfDString(NULL, name, -1, &nameString); + tclNativeExecutableName = (char *) + ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1)); + strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString)); + Tcl_DStringFree(&nameString); + goto done; + } + + /* + * The name is relative to the current working directory. First + * strip off a leading "./", if any, then add the full path name of + * the current working directory. + */ + + if ((name[0] == '.') && (name[1] == '/')) { + name += 2; + } + + Tcl_ExternalToUtfDString(NULL, name, -1, &nameString); + + Tcl_DStringFree(&buffer); + TclpGetCwd(NULL, &buffer); + + length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2; + tclNativeExecutableName = (char *) ckalloc((unsigned) length); + strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer)); + tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/'; + strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1, + Tcl_DStringValue(&nameString)); + Tcl_DStringFree(&nameString); + +#endif + +done: + Tcl_DStringFree(&buffer); + return tclNativeExecutableName; +} + +/* + *---------------------------------------------------------------------- + * + * 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 lappended 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. */ + 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; + + fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); + if (fileNamePtr == NULL) { + return TCL_ERROR; + } + + if (pattern == NULL || (*pattern == '\0')) { + /* Match a file directly */ + native = (CONST char*) Tcl_FSGetNativePath(pathPtr); + if (NativeMatchType(native, types)) { + Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); + } + Tcl_DecrRefCount(fileNamePtr); + return TCL_OK; + } else { + DIR *d; + Tcl_DirEntry *entryPtr; + CONST char *dirName; + int dirLength; + int matchHidden; + int nativeDirLen; + Tcl_StatBuf statBuf; + Tcl_DString ds; /* native encoding of dir */ + Tcl_DString dsOrig; /* utf-8 encoding of dir */ + + Tcl_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". + */ + + if (dirLength == 0) { + dirName = "."; + } else { + dirName = Tcl_DStringValue(&dsOrig); + /* Make sure we have a trailing directory delimiter */ + if (dirName[dirLength-1] != '/') { + dirName = Tcl_DStringAppend(&dsOrig, "/", 1); + dirLength++; + } + } + Tcl_DecrRefCount(fileNamePtr); + + /* + * Now open the directory for reading and iterate over the contents. + */ + + native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); + + if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */ + || !S_ISDIR(statBuf.st_mode)) { + Tcl_DStringFree(&dsOrig); + Tcl_DStringFree(&ds); + return TCL_OK; + } + + d = opendir(native); /* INTL: Native. */ + if (d == NULL) { + Tcl_DStringFree(&ds); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't read directory \"", + Tcl_DStringValue(&dsOrig), "\": ", + Tcl_PosixError(interp), (char *) NULL); + Tcl_DStringFree(&dsOrig); + return TCL_ERROR; + } + + nativeDirLen = Tcl_DStringLength(&ds); + + /* + * 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. */ + 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 { + if (matchHidden) continue; + } + + /* + * Now check to see if the file matches, according to both type + * and pattern. If so, add the file to the result. + */ + + utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, + -1, &utfDs); + if (Tcl_StringCaseMatch(utfname, pattern, 0)) { + int typeOk = 1; + + if (types != NULL) { + Tcl_DStringSetLength(&ds, nativeDirLen); + native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1); + typeOk = NativeMatchType(native, types); + } + if (typeOk) { + Tcl_ListObjAppendElement(interp, resultPtr, + TclNewFSPathObj(pathPtr, utfname, + Tcl_DStringLength(&utfDs))); + } + } + Tcl_DStringFree(&utfDs); + } + + closedir(d); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsOrig); + return TCL_OK; + } +} +static int +NativeMatchType( + 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') + */ + 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. + */ + return 0; + } + + /* + * 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) && + (access(nativeEntry, R_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_W) && + (access(nativeEntry, W_OK) != 0)) || + ((types->perm & TCL_GLOB_PERM_X) && + (access(nativeEntry, X_OK) != 0)) + ) { + return 0; + } + } + if (types->type != 0) { + if (types->perm == 0) { + /* We haven't yet done a stat on the file */ + if (TclOSstat(nativeEntry, &buf) != 0) { + /* + * Posix error occurred. The only ok + * case is if this is a link to a nonexistent + * file, and the user did 'glob -l'. So + * we check that here: + */ + if (types->type & TCL_GLOB_TYPE_LINK) { + if (TclOSlstat(nativeEntry, &buf) == 0) { + if (S_ISLNK(buf.st_mode)) { + return 1; + } + } + } + return 0; + } + } + /* + * 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)) +#ifdef S_ISSOCK + || ((types->type & TCL_GLOB_TYPE_SOCK) && + S_ISSOCK(buf.st_mode)) +#endif /* S_ISSOCK */ + ) { + /* Do nothing -- this file is ok */ + } else { +#ifdef S_ISLNK + if (types->type & TCL_GLOB_TYPE_LINK) { + if (TclOSlstat(nativeEntry, &buf) == 0) { + if (S_ISLNK(buf.st_mode)) { + return 1; + } + } + } +#endif /* S_ISLNK */ + return 0; + } + } + } + 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. + * + *---------------------------------------------------------------------- + */ + +char * +TclpGetUserHome(name, bufferPtr) + CONST char *name; /* User name for desired home directory. */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled + * with name of user's home directory. */ +{ + struct passwd *pwPtr; + Tcl_DString ds; + CONST char *native; + + native = Tcl_UtfToExternalDString(NULL, name, -1, &ds); + pwPtr = getpwnam(native); /* INTL: Native. */ + Tcl_DStringFree(&ds); + + if (pwPtr == NULL) { + endpwent(); + return NULL; + } + Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr); + endpwent(); + return Tcl_DStringValue(bufferPtr); +} + +/* + *--------------------------------------------------------------------------- + * + * TclpObjAccess -- + * + * This function replaces the library version of access(). + * + * Results: + * See access() documentation. + * + * Side effects: + * See access() documentation. + * + *--------------------------------------------------------------------------- + */ + +int +TclpObjAccess(pathPtr, mode) + Tcl_Obj *pathPtr; /* Path of file to access */ + int mode; /* Permission setting. */ +{ + CONST char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return access(path, mode); + } +} + +/* + *--------------------------------------------------------------------------- + * + * TclpObjChdir -- + * + * This function replaces the library version of chdir(). + * + * Results: + * See chdir() documentation. + * + * Side effects: + * See chdir() documentation. + * + *--------------------------------------------------------------------------- + */ + +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; /* Path to new working directory */ +{ + CONST char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return chdir(path); + } +} + +/* + *---------------------------------------------------------------------- + * + * TclpObjLstat -- + * + * This function replaces the library version of lstat(). + * + * Results: + * See lstat() documentation. + * + * Side effects: + * See lstat() documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclpObjLstat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ +{ + return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr); +} + +/* + *--------------------------------------------------------------------------- + * + * TclpObjGetCwd -- + * + * This function replaces the library version of getcwd(). + * + * 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. + * + *---------------------------------------------------------------------- + */ + +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; + } +} + +/* Older string based version */ +CONST char * +TclpGetCwd(interp, bufferPtr) + Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled + * with name of current directory. */ +{ + char buffer[MAXPATHLEN+1]; + +#ifdef USEGETWD + if (getwd(buffer) == NULL) { /* INTL: Native. */ +#else + if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */ +#endif + if (interp != NULL) { + Tcl_AppendResult(interp, + "error getting working directory name: ", + Tcl_PosixError(interp), (char *) NULL); + } + return NULL; + } + /* TODO - the line bellow is a temporary patch. The defect number is: DEF116621. */ + buffer[0] = 'c'; + return Tcl_ExternalToUtfDString(NULL, buffer, -1, 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(path, linkPtr) + CONST char *path; /* Path of file to readlink (UTF-8). */ + Tcl_DString *linkPtr; /* Uninitialized or free DString filled + * with contents of link (UTF-8). */ +{ +#ifndef DJGPP + char link[MAXPATHLEN]; + int length; + CONST char *native; + Tcl_DString ds; + + native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); + length = readlink(native, link, sizeof(link)); /* INTL: Native. */ + Tcl_DStringFree(&ds); + + if (length < 0) { + return NULL; + } + + Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); + return Tcl_DStringValue(linkPtr); +#else + return NULL; +#endif +} + +/* + *---------------------------------------------------------------------- + * + * TclpObjStat -- + * + * This function replaces the library version of stat(). + * + * Results: + * See stat() documentation. + * + * Side effects: + * See stat() documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclpObjStat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ +{ + CONST char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return TclOSstat(path, bufPtr); + } +} + + +#ifdef S_IFLNK + +Tcl_Obj* +TclpObjLink(pathPtr, toPtr, linkAction) + Tcl_Obj *pathPtr; + Tcl_Obj *toPtr; + int linkAction; +{ + if (toPtr != NULL) { + CONST char *src = Tcl_FSGetNativePath(pathPtr); + CONST char *target = Tcl_FSGetNativePath(toPtr); + + if (src == NULL || target == NULL) { + return NULL; + } + if (access(src, F_OK) != -1) { + /* src exists */ + errno = EEXIST; + return NULL; + } + if (access(target, F_OK) == -1) { + /* target doesn't exist */ + errno = ENOENT; + return NULL; + } + /* + * Check symbolic link flag first, since we prefer to + * create these. + */ + if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { + if (symlink(target, src) != 0) return NULL; + } 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(Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); + if (length < 0) { + return NULL; + } + + Tcl_ExternalToUtfDString(NULL, link, length, &ds); + linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + if (linkPtr != NULL) { + Tcl_IncrRefCount(linkPtr); + } + return linkPtr; + } +} + +#endif + + +/* + *--------------------------------------------------------------------------- + * + * 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(pathObjPtr) + Tcl_Obj* pathObjPtr; +{ + /* All native paths are of the same type */ + return NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * TclpUtime -- + * + * Set the modification date for a file. + * + * Results: + * 0 on success, -1 on error. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ +int +TclpUtime(pathPtr, tval) + Tcl_Obj *pathPtr; /* File to modify */ + struct utimbuf *tval; /* New modification date structure */ +{ + return utime(Tcl_FSGetNativePath(pathPtr),tval); +}