os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclUnixFile.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclUnixFile.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,862 @@
1.4 +/*
1.5 + * tclUnixFile.c --
1.6 + *
1.7 + * This file contains wrappers around UNIX file handling functions.
1.8 + * These wrappers mask differences between Windows and UNIX.
1.9 + *
1.10 + * Copyright (c) 1995-1998 Sun Microsystems, Inc.
1.11 + * Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.12 + *
1.13 + * See the file "license.terms" for information on usage and redistribution
1.14 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 + *
1.16 + * RCS: @(#) $Id: tclUnixFile.c,v 1.32.2.2 2003/10/31 08:46:41 vincentdarley Exp $
1.17 + */
1.18 +
1.19 +#include "tclInt.h"
1.20 +#include "tclPort.h"
1.21 +#if defined(__SYMBIAN32__)
1.22 +#include "convertPathSlashes.h"
1.23 +#include "tclSymbianGlobals.h"
1.24 +#endif
1.25 +
1.26 +static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
1.27 +
1.28 +
1.29 +/*
1.30 + *---------------------------------------------------------------------------
1.31 + *
1.32 + * TclpFindExecutable --
1.33 + *
1.34 + * This procedure computes the absolute path name of the current
1.35 + * application, given its argv[0] value.
1.36 + *
1.37 + * Results:
1.38 + * A dirty UTF string that is the path to the executable. At this
1.39 + * point we may not know the system encoding. Convert the native
1.40 + * string value to UTF using the default encoding. The assumption
1.41 + * is that we will still be able to parse the path given the path
1.42 + * name contains ASCII string and '/' chars do not conflict with
1.43 + * other UTF chars.
1.44 + *
1.45 + * Side effects:
1.46 + * The variable tclNativeExecutableName gets filled in with the file
1.47 + * name for the application, if we figured it out. If we couldn't
1.48 + * figure it out, tclNativeExecutableName is set to NULL.
1.49 + *
1.50 + *---------------------------------------------------------------------------
1.51 + */
1.52 +
1.53 +char *
1.54 +TclpFindExecutable(argv0)
1.55 + CONST char *argv0; /* The value of the application's argv[0]
1.56 + * (native). */
1.57 +{
1.58 + CONST char *name, *p;
1.59 + Tcl_StatBuf statBuf;
1.60 + int length;
1.61 + Tcl_DString buffer, nameString;
1.62 +#ifdef __SYMBIAN32__
1.63 + char bufferUsed;
1.64 +#endif
1.65 +
1.66 + if (argv0 == NULL) {
1.67 + return NULL;
1.68 + }
1.69 + if (tclNativeExecutableName != NULL) {
1.70 + return tclNativeExecutableName;
1.71 + }
1.72 +
1.73 +#ifdef __SYMBIAN32__
1.74 + // assuming if we're not using eshell that we have to specify the path.
1.75 + bufferUsed = 0;
1.76 + if (!strstr(argv0, "Z:\\sys\\bin")) {
1.77 + Tcl_DStringInit(&buffer);
1.78 + Tcl_DStringSetLength(&buffer, 0);
1.79 + Tcl_DStringAppend(&buffer, "Z:\\sys\\bin\\", 11);
1.80 + name = Tcl_DStringAppend(&buffer, argv0, -1);
1.81 + bufferUsed = 1;
1.82 + }
1.83 + else
1.84 + name = argv0; //use if we don't have to specify the path.
1.85 +
1.86 + tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));
1.87 + strcpy(tclNativeExecutableName, name);
1.88 +
1.89 + tclCopySymbianPathSlashConversion(TO_TCL, tclNativeExecutableName, tclNativeExecutableName);
1.90 +
1.91 + if (bufferUsed) {
1.92 + Tcl_DStringFree(&buffer);
1.93 + }
1.94 +
1.95 + return tclNativeExecutableName;
1.96 +#else
1.97 +
1.98 +
1.99 + Tcl_DStringInit(&buffer);
1.100 +
1.101 + name = argv0;
1.102 + for (p = name; *p != '\0'; p++) {
1.103 + if (*p == '/') {
1.104 + /*
1.105 + * The name contains a slash, so use the name directly
1.106 + * without doing a path search.
1.107 + */
1.108 +
1.109 + goto gotName;
1.110 + }
1.111 + }
1.112 +
1.113 + p = getenv("PATH"); /* INTL: Native. */
1.114 + if (p == NULL) {
1.115 + /*
1.116 + * There's no PATH environment variable; use the default that
1.117 + * is used by sh.
1.118 + */
1.119 +
1.120 + p = ":/bin:/usr/bin";
1.121 + } else if (*p == '\0') {
1.122 + /*
1.123 + * An empty path is equivalent to ".".
1.124 + */
1.125 +
1.126 + p = "./";
1.127 + }
1.128 +
1.129 + /*
1.130 + * Search through all the directories named in the PATH variable
1.131 + * to see if argv[0] is in one of them. If so, use that file
1.132 + * name.
1.133 + */
1.134 +
1.135 + while (1) {
1.136 + while (isspace(UCHAR(*p))) { /* INTL: BUG */
1.137 + p++;
1.138 + }
1.139 + name = p;
1.140 + while ((*p != ':') && (*p != 0)) {
1.141 + p++;
1.142 + }
1.143 + Tcl_DStringSetLength(&buffer, 0);
1.144 + if (p != name) {
1.145 + Tcl_DStringAppend(&buffer, name, p - name);
1.146 + if (p[-1] != '/') {
1.147 + Tcl_DStringAppend(&buffer, "/", 1);
1.148 + }
1.149 + }
1.150 + name = Tcl_DStringAppend(&buffer, argv0, -1);
1.151 +
1.152 + /*
1.153 + * INTL: The following calls to access() and stat() should not be
1.154 + * converted to Tclp routines because they need to operate on native
1.155 + * strings directly.
1.156 + */
1.157 +
1.158 + if ((access(name, X_OK) == 0) /* INTL: Native. */
1.159 + && (TclOSstat(name, &statBuf) == 0) /* INTL: Native. */
1.160 + && S_ISREG(statBuf.st_mode)) {
1.161 + goto gotName;
1.162 + }
1.163 + if (*p == '\0') {
1.164 + break;
1.165 + } else if (*(p+1) == 0) {
1.166 + p = "./";
1.167 + } else {
1.168 + p++;
1.169 + }
1.170 + }
1.171 + goto done;
1.172 +
1.173 + /*
1.174 + * If the name starts with "/" then just copy it to tclExecutableName.
1.175 + */
1.176 +
1.177 +gotName:
1.178 +#ifdef DJGPP
1.179 + if (name[1] == ':') {
1.180 +#else
1.181 + if (name[0] == '/') {
1.182 +#endif
1.183 + Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
1.184 + tclNativeExecutableName = (char *)
1.185 + ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
1.186 + strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString));
1.187 + Tcl_DStringFree(&nameString);
1.188 + goto done;
1.189 + }
1.190 +
1.191 + /*
1.192 + * The name is relative to the current working directory. First
1.193 + * strip off a leading "./", if any, then add the full path name of
1.194 + * the current working directory.
1.195 + */
1.196 +
1.197 + if ((name[0] == '.') && (name[1] == '/')) {
1.198 + name += 2;
1.199 + }
1.200 +
1.201 + Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
1.202 +
1.203 + Tcl_DStringFree(&buffer);
1.204 + TclpGetCwd(NULL, &buffer);
1.205 +
1.206 + length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2;
1.207 + tclNativeExecutableName = (char *) ckalloc((unsigned) length);
1.208 + strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer));
1.209 + tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/';
1.210 + strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1,
1.211 + Tcl_DStringValue(&nameString));
1.212 + Tcl_DStringFree(&nameString);
1.213 +
1.214 +#endif
1.215 +
1.216 +done:
1.217 + Tcl_DStringFree(&buffer);
1.218 + return tclNativeExecutableName;
1.219 +}
1.220 +
1.221 +/*
1.222 + *----------------------------------------------------------------------
1.223 + *
1.224 + * TclpMatchInDirectory --
1.225 + *
1.226 + * This routine is used by the globbing code to search a
1.227 + * directory for all files which match a given pattern.
1.228 + *
1.229 + * Results:
1.230 + * The return value is a standard Tcl result indicating whether an
1.231 + * error occurred in globbing. Errors are left in interp, good
1.232 + * results are lappended to resultPtr (which must be a valid object)
1.233 + *
1.234 + * Side effects:
1.235 + * None.
1.236 + *
1.237 + *---------------------------------------------------------------------- */
1.238 +
1.239 +int
1.240 +TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
1.241 + Tcl_Interp *interp; /* Interpreter to receive errors. */
1.242 + Tcl_Obj *resultPtr; /* List object to lappend results. */
1.243 + Tcl_Obj *pathPtr; /* Contains path to directory to search. */
1.244 + CONST char *pattern; /* Pattern to match against. */
1.245 + Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
1.246 + * May be NULL. In particular the directory
1.247 + * flag is very important. */
1.248 +{
1.249 + CONST char *native;
1.250 + Tcl_Obj *fileNamePtr;
1.251 +
1.252 + fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
1.253 + if (fileNamePtr == NULL) {
1.254 + return TCL_ERROR;
1.255 + }
1.256 +
1.257 + if (pattern == NULL || (*pattern == '\0')) {
1.258 + /* Match a file directly */
1.259 + native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
1.260 + if (NativeMatchType(native, types)) {
1.261 + Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
1.262 + }
1.263 + Tcl_DecrRefCount(fileNamePtr);
1.264 + return TCL_OK;
1.265 + } else {
1.266 + DIR *d;
1.267 + Tcl_DirEntry *entryPtr;
1.268 + CONST char *dirName;
1.269 + int dirLength;
1.270 + int matchHidden;
1.271 + int nativeDirLen;
1.272 + Tcl_StatBuf statBuf;
1.273 + Tcl_DString ds; /* native encoding of dir */
1.274 + Tcl_DString dsOrig; /* utf-8 encoding of dir */
1.275 +
1.276 + Tcl_DStringInit(&dsOrig);
1.277 + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
1.278 + Tcl_DStringAppend(&dsOrig, dirName, dirLength);
1.279 +
1.280 + /*
1.281 + * Make sure that the directory part of the name really is a
1.282 + * directory. If the directory name is "", use the name "."
1.283 + * instead, because some UNIX systems don't treat "" like "."
1.284 + * automatically. Keep the "" for use in generating file names,
1.285 + * otherwise "glob foo.c" would return "./foo.c".
1.286 + */
1.287 +
1.288 + if (dirLength == 0) {
1.289 + dirName = ".";
1.290 + } else {
1.291 + dirName = Tcl_DStringValue(&dsOrig);
1.292 + /* Make sure we have a trailing directory delimiter */
1.293 + if (dirName[dirLength-1] != '/') {
1.294 + dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
1.295 + dirLength++;
1.296 + }
1.297 + }
1.298 + Tcl_DecrRefCount(fileNamePtr);
1.299 +
1.300 + /*
1.301 + * Now open the directory for reading and iterate over the contents.
1.302 + */
1.303 +
1.304 + native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
1.305 +
1.306 + if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */
1.307 + || !S_ISDIR(statBuf.st_mode)) {
1.308 + Tcl_DStringFree(&dsOrig);
1.309 + Tcl_DStringFree(&ds);
1.310 + return TCL_OK;
1.311 + }
1.312 +
1.313 + d = opendir(native); /* INTL: Native. */
1.314 + if (d == NULL) {
1.315 + Tcl_DStringFree(&ds);
1.316 + Tcl_ResetResult(interp);
1.317 + Tcl_AppendResult(interp, "couldn't read directory \"",
1.318 + Tcl_DStringValue(&dsOrig), "\": ",
1.319 + Tcl_PosixError(interp), (char *) NULL);
1.320 + Tcl_DStringFree(&dsOrig);
1.321 + return TCL_ERROR;
1.322 + }
1.323 +
1.324 + nativeDirLen = Tcl_DStringLength(&ds);
1.325 +
1.326 + /*
1.327 + * Check to see if -type or the pattern requests hidden files.
1.328 + */
1.329 + matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) ||
1.330 + ((pattern[0] == '.')
1.331 + || ((pattern[0] == '\\') && (pattern[1] == '.'))));
1.332 +
1.333 + while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
1.334 + Tcl_DString utfDs;
1.335 + CONST char *utfname;
1.336 +
1.337 + /*
1.338 + * Skip this file if it doesn't agree with the hidden
1.339 + * parameters requested by the user (via -type or pattern).
1.340 + */
1.341 + if (*entryPtr->d_name == '.') {
1.342 + if (!matchHidden) continue;
1.343 + } else {
1.344 + if (matchHidden) continue;
1.345 + }
1.346 +
1.347 + /*
1.348 + * Now check to see if the file matches, according to both type
1.349 + * and pattern. If so, add the file to the result.
1.350 + */
1.351 +
1.352 + utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name,
1.353 + -1, &utfDs);
1.354 + if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
1.355 + int typeOk = 1;
1.356 +
1.357 + if (types != NULL) {
1.358 + Tcl_DStringSetLength(&ds, nativeDirLen);
1.359 + native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
1.360 + typeOk = NativeMatchType(native, types);
1.361 + }
1.362 + if (typeOk) {
1.363 + Tcl_ListObjAppendElement(interp, resultPtr,
1.364 + TclNewFSPathObj(pathPtr, utfname,
1.365 + Tcl_DStringLength(&utfDs)));
1.366 + }
1.367 + }
1.368 + Tcl_DStringFree(&utfDs);
1.369 + }
1.370 +
1.371 + closedir(d);
1.372 + Tcl_DStringFree(&ds);
1.373 + Tcl_DStringFree(&dsOrig);
1.374 + return TCL_OK;
1.375 + }
1.376 +}
1.377 +static int
1.378 +NativeMatchType(
1.379 + CONST char* nativeEntry, /* Native path to check */
1.380 + Tcl_GlobTypeData *types) /* Type description to match against */
1.381 +{
1.382 + Tcl_StatBuf buf;
1.383 + if (types == NULL) {
1.384 + /*
1.385 + * Simply check for the file's existence, but do it
1.386 + * with lstat, in case it is a link to a file which
1.387 + * doesn't exist (since that case would not show up
1.388 + * if we used 'access' or 'stat')
1.389 + */
1.390 + if (TclOSlstat(nativeEntry, &buf) != 0) {
1.391 + return 0;
1.392 + }
1.393 + } else {
1.394 + if (types->perm != 0) {
1.395 + if (TclOSstat(nativeEntry, &buf) != 0) {
1.396 + /*
1.397 + * Either the file has disappeared between the
1.398 + * 'readdir' call and the 'stat' call, or
1.399 + * the file is a link to a file which doesn't
1.400 + * exist (which we could ascertain with
1.401 + * lstat), or there is some other strange
1.402 + * problem. In all these cases, we define this
1.403 + * to mean the file does not match any defined
1.404 + * permission, and therefore it is not
1.405 + * added to the list of files to return.
1.406 + */
1.407 + return 0;
1.408 + }
1.409 +
1.410 + /*
1.411 + * readonly means that there are NO write permissions
1.412 + * (even for user), but execute is OK for anybody
1.413 + */
1.414 + if (((types->perm & TCL_GLOB_PERM_RONLY) &&
1.415 + (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
1.416 + ((types->perm & TCL_GLOB_PERM_R) &&
1.417 + (access(nativeEntry, R_OK) != 0)) ||
1.418 + ((types->perm & TCL_GLOB_PERM_W) &&
1.419 + (access(nativeEntry, W_OK) != 0)) ||
1.420 + ((types->perm & TCL_GLOB_PERM_X) &&
1.421 + (access(nativeEntry, X_OK) != 0))
1.422 + ) {
1.423 + return 0;
1.424 + }
1.425 + }
1.426 + if (types->type != 0) {
1.427 + if (types->perm == 0) {
1.428 + /* We haven't yet done a stat on the file */
1.429 + if (TclOSstat(nativeEntry, &buf) != 0) {
1.430 + /*
1.431 + * Posix error occurred. The only ok
1.432 + * case is if this is a link to a nonexistent
1.433 + * file, and the user did 'glob -l'. So
1.434 + * we check that here:
1.435 + */
1.436 + if (types->type & TCL_GLOB_TYPE_LINK) {
1.437 + if (TclOSlstat(nativeEntry, &buf) == 0) {
1.438 + if (S_ISLNK(buf.st_mode)) {
1.439 + return 1;
1.440 + }
1.441 + }
1.442 + }
1.443 + return 0;
1.444 + }
1.445 + }
1.446 + /*
1.447 + * In order bcdpfls as in 'find -t'
1.448 + */
1.449 + if (
1.450 + ((types->type & TCL_GLOB_TYPE_BLOCK) &&
1.451 + S_ISBLK(buf.st_mode)) ||
1.452 + ((types->type & TCL_GLOB_TYPE_CHAR) &&
1.453 + S_ISCHR(buf.st_mode)) ||
1.454 + ((types->type & TCL_GLOB_TYPE_DIR) &&
1.455 + S_ISDIR(buf.st_mode)) ||
1.456 + ((types->type & TCL_GLOB_TYPE_PIPE) &&
1.457 + S_ISFIFO(buf.st_mode)) ||
1.458 + ((types->type & TCL_GLOB_TYPE_FILE) &&
1.459 + S_ISREG(buf.st_mode))
1.460 +#ifdef S_ISSOCK
1.461 + || ((types->type & TCL_GLOB_TYPE_SOCK) &&
1.462 + S_ISSOCK(buf.st_mode))
1.463 +#endif /* S_ISSOCK */
1.464 + ) {
1.465 + /* Do nothing -- this file is ok */
1.466 + } else {
1.467 +#ifdef S_ISLNK
1.468 + if (types->type & TCL_GLOB_TYPE_LINK) {
1.469 + if (TclOSlstat(nativeEntry, &buf) == 0) {
1.470 + if (S_ISLNK(buf.st_mode)) {
1.471 + return 1;
1.472 + }
1.473 + }
1.474 + }
1.475 +#endif /* S_ISLNK */
1.476 + return 0;
1.477 + }
1.478 + }
1.479 + }
1.480 + return 1;
1.481 +}
1.482 +
1.483 +/*
1.484 + *---------------------------------------------------------------------------
1.485 + *
1.486 + * TclpGetUserHome --
1.487 + *
1.488 + * This function takes the specified user name and finds their
1.489 + * home directory.
1.490 + *
1.491 + * Results:
1.492 + * The result is a pointer to a string specifying the user's home
1.493 + * directory, or NULL if the user's home directory could not be
1.494 + * determined. Storage for the result string is allocated in
1.495 + * bufferPtr; the caller must call Tcl_DStringFree() when the result
1.496 + * is no longer needed.
1.497 + *
1.498 + * Side effects:
1.499 + * None.
1.500 + *
1.501 + *----------------------------------------------------------------------
1.502 + */
1.503 +
1.504 +char *
1.505 +TclpGetUserHome(name, bufferPtr)
1.506 + CONST char *name; /* User name for desired home directory. */
1.507 + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
1.508 + * with name of user's home directory. */
1.509 +{
1.510 + struct passwd *pwPtr;
1.511 + Tcl_DString ds;
1.512 + CONST char *native;
1.513 +
1.514 + native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
1.515 + pwPtr = getpwnam(native); /* INTL: Native. */
1.516 + Tcl_DStringFree(&ds);
1.517 +
1.518 + if (pwPtr == NULL) {
1.519 + endpwent();
1.520 + return NULL;
1.521 + }
1.522 + Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
1.523 + endpwent();
1.524 + return Tcl_DStringValue(bufferPtr);
1.525 +}
1.526 +
1.527 +/*
1.528 + *---------------------------------------------------------------------------
1.529 + *
1.530 + * TclpObjAccess --
1.531 + *
1.532 + * This function replaces the library version of access().
1.533 + *
1.534 + * Results:
1.535 + * See access() documentation.
1.536 + *
1.537 + * Side effects:
1.538 + * See access() documentation.
1.539 + *
1.540 + *---------------------------------------------------------------------------
1.541 + */
1.542 +
1.543 +int
1.544 +TclpObjAccess(pathPtr, mode)
1.545 + Tcl_Obj *pathPtr; /* Path of file to access */
1.546 + int mode; /* Permission setting. */
1.547 +{
1.548 + CONST char *path = Tcl_FSGetNativePath(pathPtr);
1.549 + if (path == NULL) {
1.550 + return -1;
1.551 + } else {
1.552 + return access(path, mode);
1.553 + }
1.554 +}
1.555 +
1.556 +/*
1.557 + *---------------------------------------------------------------------------
1.558 + *
1.559 + * TclpObjChdir --
1.560 + *
1.561 + * This function replaces the library version of chdir().
1.562 + *
1.563 + * Results:
1.564 + * See chdir() documentation.
1.565 + *
1.566 + * Side effects:
1.567 + * See chdir() documentation.
1.568 + *
1.569 + *---------------------------------------------------------------------------
1.570 + */
1.571 +
1.572 +int
1.573 +TclpObjChdir(pathPtr)
1.574 + Tcl_Obj *pathPtr; /* Path to new working directory */
1.575 +{
1.576 + CONST char *path = Tcl_FSGetNativePath(pathPtr);
1.577 + if (path == NULL) {
1.578 + return -1;
1.579 + } else {
1.580 + return chdir(path);
1.581 + }
1.582 +}
1.583 +
1.584 +/*
1.585 + *----------------------------------------------------------------------
1.586 + *
1.587 + * TclpObjLstat --
1.588 + *
1.589 + * This function replaces the library version of lstat().
1.590 + *
1.591 + * Results:
1.592 + * See lstat() documentation.
1.593 + *
1.594 + * Side effects:
1.595 + * See lstat() documentation.
1.596 + *
1.597 + *----------------------------------------------------------------------
1.598 + */
1.599 +
1.600 +int
1.601 +TclpObjLstat(pathPtr, bufPtr)
1.602 + Tcl_Obj *pathPtr; /* Path of file to stat */
1.603 + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
1.604 +{
1.605 + return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
1.606 +}
1.607 +
1.608 +/*
1.609 + *---------------------------------------------------------------------------
1.610 + *
1.611 + * TclpObjGetCwd --
1.612 + *
1.613 + * This function replaces the library version of getcwd().
1.614 + *
1.615 + * Results:
1.616 + * The result is a pointer to a string specifying the current
1.617 + * directory, or NULL if the current directory could not be
1.618 + * determined. If NULL is returned, an error message is left in the
1.619 + * interp's result. Storage for the result string is allocated in
1.620 + * bufferPtr; the caller must call Tcl_DStringFree() when the result
1.621 + * is no longer needed.
1.622 + *
1.623 + * Side effects:
1.624 + * None.
1.625 + *
1.626 + *----------------------------------------------------------------------
1.627 + */
1.628 +
1.629 +Tcl_Obj*
1.630 +TclpObjGetCwd(interp)
1.631 + Tcl_Interp *interp;
1.632 +{
1.633 + Tcl_DString ds;
1.634 + if (TclpGetCwd(interp, &ds) != NULL) {
1.635 + Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
1.636 + Tcl_IncrRefCount(cwdPtr);
1.637 + Tcl_DStringFree(&ds);
1.638 + return cwdPtr;
1.639 + } else {
1.640 + return NULL;
1.641 + }
1.642 +}
1.643 +
1.644 +/* Older string based version */
1.645 +CONST char *
1.646 +TclpGetCwd(interp, bufferPtr)
1.647 + Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
1.648 + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
1.649 + * with name of current directory. */
1.650 +{
1.651 + char buffer[MAXPATHLEN+1];
1.652 +
1.653 +#ifdef USEGETWD
1.654 + if (getwd(buffer) == NULL) { /* INTL: Native. */
1.655 +#else
1.656 + if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */
1.657 +#endif
1.658 + if (interp != NULL) {
1.659 + Tcl_AppendResult(interp,
1.660 + "error getting working directory name: ",
1.661 + Tcl_PosixError(interp), (char *) NULL);
1.662 + }
1.663 + return NULL;
1.664 + }
1.665 + /* TODO - the line bellow is a temporary patch. The defect number is: DEF116621. */
1.666 + buffer[0] = 'c';
1.667 + return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
1.668 +}
1.669 +
1.670 +/*
1.671 + *---------------------------------------------------------------------------
1.672 + *
1.673 + * TclpReadlink --
1.674 + *
1.675 + * This function replaces the library version of readlink().
1.676 + *
1.677 + * Results:
1.678 + * The result is a pointer to a string specifying the contents
1.679 + * of the symbolic link given by 'path', or NULL if the symbolic
1.680 + * link could not be read. Storage for the result string is
1.681 + * allocated in bufferPtr; the caller must call Tcl_DStringFree()
1.682 + * when the result is no longer needed.
1.683 + *
1.684 + * Side effects:
1.685 + * See readlink() documentation.
1.686 + *
1.687 + *---------------------------------------------------------------------------
1.688 + */
1.689 +
1.690 +char *
1.691 +TclpReadlink(path, linkPtr)
1.692 + CONST char *path; /* Path of file to readlink (UTF-8). */
1.693 + Tcl_DString *linkPtr; /* Uninitialized or free DString filled
1.694 + * with contents of link (UTF-8). */
1.695 +{
1.696 +#ifndef DJGPP
1.697 + char link[MAXPATHLEN];
1.698 + int length;
1.699 + CONST char *native;
1.700 + Tcl_DString ds;
1.701 +
1.702 + native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
1.703 + length = readlink(native, link, sizeof(link)); /* INTL: Native. */
1.704 + Tcl_DStringFree(&ds);
1.705 +
1.706 + if (length < 0) {
1.707 + return NULL;
1.708 + }
1.709 +
1.710 + Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
1.711 + return Tcl_DStringValue(linkPtr);
1.712 +#else
1.713 + return NULL;
1.714 +#endif
1.715 +}
1.716 +
1.717 +/*
1.718 + *----------------------------------------------------------------------
1.719 + *
1.720 + * TclpObjStat --
1.721 + *
1.722 + * This function replaces the library version of stat().
1.723 + *
1.724 + * Results:
1.725 + * See stat() documentation.
1.726 + *
1.727 + * Side effects:
1.728 + * See stat() documentation.
1.729 + *
1.730 + *----------------------------------------------------------------------
1.731 + */
1.732 +
1.733 +int
1.734 +TclpObjStat(pathPtr, bufPtr)
1.735 + Tcl_Obj *pathPtr; /* Path of file to stat */
1.736 + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
1.737 +{
1.738 + CONST char *path = Tcl_FSGetNativePath(pathPtr);
1.739 + if (path == NULL) {
1.740 + return -1;
1.741 + } else {
1.742 + return TclOSstat(path, bufPtr);
1.743 + }
1.744 +}
1.745 +
1.746 +
1.747 +#ifdef S_IFLNK
1.748 +
1.749 +Tcl_Obj*
1.750 +TclpObjLink(pathPtr, toPtr, linkAction)
1.751 + Tcl_Obj *pathPtr;
1.752 + Tcl_Obj *toPtr;
1.753 + int linkAction;
1.754 +{
1.755 + if (toPtr != NULL) {
1.756 + CONST char *src = Tcl_FSGetNativePath(pathPtr);
1.757 + CONST char *target = Tcl_FSGetNativePath(toPtr);
1.758 +
1.759 + if (src == NULL || target == NULL) {
1.760 + return NULL;
1.761 + }
1.762 + if (access(src, F_OK) != -1) {
1.763 + /* src exists */
1.764 + errno = EEXIST;
1.765 + return NULL;
1.766 + }
1.767 + if (access(target, F_OK) == -1) {
1.768 + /* target doesn't exist */
1.769 + errno = ENOENT;
1.770 + return NULL;
1.771 + }
1.772 + /*
1.773 + * Check symbolic link flag first, since we prefer to
1.774 + * create these.
1.775 + */
1.776 + if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
1.777 + if (symlink(target, src) != 0) return NULL;
1.778 + } else if (linkAction & TCL_CREATE_HARD_LINK) {
1.779 + if (link(target, src) != 0) return NULL;
1.780 + } else {
1.781 + errno = ENODEV;
1.782 + return NULL;
1.783 + }
1.784 + return toPtr;
1.785 + } else {
1.786 + Tcl_Obj* linkPtr = NULL;
1.787 +
1.788 + char link[MAXPATHLEN];
1.789 + int length;
1.790 + Tcl_DString ds;
1.791 + Tcl_Obj *transPtr;
1.792 +
1.793 + transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
1.794 + if (transPtr == NULL) {
1.795 + return NULL;
1.796 + }
1.797 + Tcl_DecrRefCount(transPtr);
1.798 +
1.799 + length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
1.800 + if (length < 0) {
1.801 + return NULL;
1.802 + }
1.803 +
1.804 + Tcl_ExternalToUtfDString(NULL, link, length, &ds);
1.805 + linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
1.806 + Tcl_DStringLength(&ds));
1.807 + Tcl_DStringFree(&ds);
1.808 + if (linkPtr != NULL) {
1.809 + Tcl_IncrRefCount(linkPtr);
1.810 + }
1.811 + return linkPtr;
1.812 + }
1.813 +}
1.814 +
1.815 +#endif
1.816 +
1.817 +
1.818 +/*
1.819 + *---------------------------------------------------------------------------
1.820 + *
1.821 + * TclpFilesystemPathType --
1.822 + *
1.823 + * This function is part of the native filesystem support, and
1.824 + * returns the path type of the given path. Right now it simply
1.825 + * returns NULL. In the future it could return specific path
1.826 + * types, like 'nfs', 'samba', 'FAT32', etc.
1.827 + *
1.828 + * Results:
1.829 + * NULL at present.
1.830 + *
1.831 + * Side effects:
1.832 + * None.
1.833 + *
1.834 + *---------------------------------------------------------------------------
1.835 + */
1.836 +Tcl_Obj*
1.837 +TclpFilesystemPathType(pathObjPtr)
1.838 + Tcl_Obj* pathObjPtr;
1.839 +{
1.840 + /* All native paths are of the same type */
1.841 + return NULL;
1.842 +}
1.843 +
1.844 +/*
1.845 + *---------------------------------------------------------------------------
1.846 + *
1.847 + * TclpUtime --
1.848 + *
1.849 + * Set the modification date for a file.
1.850 + *
1.851 + * Results:
1.852 + * 0 on success, -1 on error.
1.853 + *
1.854 + * Side effects:
1.855 + * None.
1.856 + *
1.857 + *---------------------------------------------------------------------------
1.858 + */
1.859 +int
1.860 +TclpUtime(pathPtr, tval)
1.861 + Tcl_Obj *pathPtr; /* File to modify */
1.862 + struct utimbuf *tval; /* New modification date structure */
1.863 +{
1.864 + return utime(Tcl_FSGetNativePath(pathPtr),tval);
1.865 +}