summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r--unix/tclUnixFile.c498
1 files changed, 274 insertions, 224 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 9ae8129..b26691d 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1,29 +1,28 @@
-/*
+/*
* tclUnixFile.c --
*
- * This file contains wrappers around UNIX file handling functions.
- * These wrappers mask differences between Windows and UNIX.
+ * This file contains wrappers around UNIX file handling functions.
+ * These wrappers mask differences between Windows and UNIX.
*
* Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixFile.c,v 1.44 2004/12/01 23:18:55 dgp Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.45 2005/07/20 23:16:00 dkf Exp $
*/
#include "tclInt.h"
#include "tclFileSystem.h"
static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
-
/*
*---------------------------------------------------------------------------
*
* TclpFindExecutable --
*
- * This procedure computes the absolute path name of the current
+ * This function computes the absolute path name of the current
* application, given its argv[0] value.
*
* Results:
@@ -54,8 +53,8 @@ TclpFindExecutable(argv0)
for (p = name; *p != '\0'; p++) {
if (*p == '/') {
/*
- * The name contains a slash, so use the name directly
- * without doing a path search.
+ * The name contains a slash, so use the name directly without
+ * doing a path search.
*/
goto gotName;
@@ -65,8 +64,8 @@ TclpFindExecutable(argv0)
p = getenv("PATH"); /* INTL: Native. */
if (p == NULL) {
/*
- * There's no PATH environment variable; use the default that
- * is used by sh.
+ * There's no PATH environment variable; use the default that is used
+ * by sh.
*/
p = ":/bin:/usr/bin";
@@ -79,13 +78,12 @@ TclpFindExecutable(argv0)
}
/*
- * Search through all the directories named in the PATH variable
- * to see if argv[0] is in one of them. If so, use that file
- * name.
+ * Search through all the directories named in the PATH variable to see if
+ * argv[0] is in one of them. If so, use that file name.
*/
while (1) {
- while (isspace(UCHAR(*p))) { /* INTL: BUG */
+ while (isspace(UCHAR(*p))) { /* INTL: BUG */
p++;
}
name = p;
@@ -127,12 +125,13 @@ TclpFindExecutable(argv0)
* If the name starts with "/" then just store it
*/
-gotName:
+ gotName:
#ifdef DJGPP
- if (name[1] == ':') {
+ if (name[1] == ':')
#else
- if (name[0] == '/') {
+ if (name[0] == '/')
#endif
+ {
encoding = Tcl_GetEncoding(NULL, NULL);
Tcl_ExternalToUtfDString(encoding, name, -1, &utfName);
TclSetObjNameOfExecutable(
@@ -142,9 +141,9 @@ gotName:
}
/*
- * The name is relative to the current working directory. First
- * strip off a leading "./", if any, then add the full path name of
- * the current working directory.
+ * The name is relative to the current working directory. First strip off
+ * a leading "./", if any, then add the full path name of the current
+ * working directory.
*/
if ((name[0] == '.') && (name[1] == '/')) {
@@ -168,12 +167,13 @@ gotName:
Tcl_DStringFree(&nameString);
encoding = Tcl_GetEncoding(NULL, NULL);
- Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, &utfName);
+ Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
+ &utfName);
TclSetObjNameOfExecutable(
Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
Tcl_DStringFree(&utfName);
-
-done:
+
+ done:
Tcl_DStringFree(&buffer);
}
@@ -182,24 +182,25 @@ done:
*
* TclpMatchInDirectory --
*
- * This routine is used by the globbing code to search a
- * directory for all files which match a given pattern.
+ * This routine is used by the globbing code to search a directory for
+ * all files which match a given pattern.
*
- * Results:
- * The return value is a standard Tcl result indicating whether an
- * error occurred in globbing. Errors are left in interp, good
- * results are lappended to resultPtr (which must be a valid object)
+ * Results:
+ * The return value is a standard Tcl result indicating whether an error
+ * occurred in globbing. Errors are left in interp, good results are
+ * [lappend]ed to resultPtr (which must be a valid object).
*
* Side effects:
* None.
*
- *---------------------------------------------------------------------- */
+ *----------------------------------------------------------------------
+ */
int
TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_Interp *interp; /* Interpreter to receive errors. */
Tcl_Obj *resultPtr; /* List object to lappend results. */
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
+ Tcl_Obj *pathPtr; /* Contains path to directory to search. */
CONST char *pattern; /* Pattern to match against. */
Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
* May be NULL. In particular the directory
@@ -209,7 +210,10 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_Obj *fileNamePtr;
if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) {
- /* The native filesystem never adds mounts */
+ /*
+ * The native filesystem never adds mounts.
+ */
+
return TCL_OK;
}
@@ -217,9 +221,12 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
if (fileNamePtr == NULL) {
return TCL_ERROR;
}
-
+
if (pattern == NULL || (*pattern == '\0')) {
- /* Match a file directly */
+ /*
+ * Match a file directly.
+ */
+
native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
if (NativeMatchType(native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -234,26 +241,30 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
int matchHidden;
int nativeDirLen;
Tcl_StatBuf statBuf;
- Tcl_DString ds; /* native encoding of dir */
- Tcl_DString dsOrig; /* utf-8 encoding of dir */
+ Tcl_DString ds; /* native encoding of dir */
+ Tcl_DString dsOrig; /* utf-8 encoding of dir */
Tcl_DStringInit(&dsOrig);
dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
-
+
/*
* Make sure that the directory part of the name really is a
- * directory. If the directory name is "", use the name "."
- * instead, because some UNIX systems don't treat "" like "."
- * automatically. Keep the "" for use in generating file names,
- * otherwise "glob foo.c" would return "./foo.c".
+ * directory. If the directory name is "", use the name "." instead,
+ * because some UNIX systems don't treat "" like "." automatically.
+ * Keep the "" for use in generating file names, otherwise "glob
+ * foo.c" would return "./foo.c".
*/
if (dirLength == 0) {
dirName = ".";
} else {
dirName = Tcl_DStringValue(&dsOrig);
- /* Make sure we have a trailing directory delimiter */
+
+ /*
+ * Make sure we have a trailing directory delimiter.
+ */
+
if (dirName[dirLength-1] != '/') {
dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
dirLength++;
@@ -291,18 +302,20 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
/*
* Check to see if -type or the pattern requests hidden files.
*/
- matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) ||
- ((pattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))));
- while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
+ matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN))
+ || ((pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'))));
+
+ while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
Tcl_DString utfDs;
CONST char *utfname;
- /*
- * Skip this file if it doesn't agree with the hidden
- * parameters requested by the user (via -type or pattern).
+ /*
+ * Skip this file if it doesn't agree with the hidden parameters
+ * requested by the user (via -type or pattern).
*/
+
if (*entryPtr->d_name == '.') {
if (!matchHidden) continue;
} else {
@@ -311,11 +324,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
/*
* Now check to see if the file matches, according to both type
- * and pattern. If so, add the file to the result.
+ * and pattern. If so, add the file to the result.
*/
- utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name,
- -1, &utfDs);
+ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1,
+ &utfDs);
if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
int typeOk = 1;
@@ -325,9 +338,9 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
typeOk = NativeMatchType(native, types);
}
if (typeOk) {
- Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_ListObjAppendElement(interp, resultPtr,
TclNewFSPathObj(pathPtr, utfname,
- Tcl_DStringLength(&utfDs)));
+ Tcl_DStringLength(&utfDs)));
}
}
Tcl_DStringFree(&utfDs);
@@ -340,44 +353,45 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
return TCL_OK;
}
}
-static int
+
+static int
NativeMatchType(
- CONST char* nativeEntry, /* Native path to check */
- Tcl_GlobTypeData *types) /* Type description to match against */
+ CONST char* nativeEntry, /* Native path to check. */
+ Tcl_GlobTypeData *types) /* Type description to match against. */
{
Tcl_StatBuf buf;
if (types == NULL) {
- /*
- * Simply check for the file's existence, but do it
- * with lstat, in case it is a link to a file which
- * doesn't exist (since that case would not show up
- * if we used 'access' or 'stat')
+ /*
+ * Simply check for the file's existence, but do it with lstat, in
+ * case it is a link to a file which doesn't exist (since that case
+ * would not show up if we used 'access' or 'stat')
*/
+
if (TclOSlstat(nativeEntry, &buf) != 0) {
return 0;
}
} else {
if (types->perm != 0) {
if (TclOSstat(nativeEntry, &buf) != 0) {
- /*
- * Either the file has disappeared between the
- * 'readdir' call and the 'stat' call, or
- * the file is a link to a file which doesn't
- * exist (which we could ascertain with
- * lstat), or there is some other strange
- * problem. In all these cases, we define this
- * to mean the file does not match any defined
- * permission, and therefore it is not
- * added to the list of files to return.
+ /*
+ * Either the file has disappeared between the 'readdir' call
+ * and the 'stat' call, or the file is a link to a file which
+ * doesn't exist (which we could ascertain with lstat), or
+ * there is some other strange problem. In all these cases, we
+ * define this to mean the file does not match any defined
+ * permission, and therefore it is not added to the list of
+ * files to return.
*/
+
return 0;
}
-
- /*
- * readonly means that there are NO write permissions
- * (even for user), but execute is OK for anybody
- * OR that the user immutable flag is set (where supported).
+
+ /*
+ * readonly means that there are NO write permissions (even for
+ * user), but execute is OK for anybody OR that the user immutable
+ * flag is set (where supported).
*/
+
if (((types->perm & TCL_GLOB_PERM_RONLY) &&
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
!(buf.st_flags & UF_IMMUTABLE) &&
@@ -395,14 +409,17 @@ NativeMatchType(
}
if (types->type != 0) {
if (types->perm == 0) {
- /* We haven't yet done a stat on the file */
+ /*
+ * We haven't yet done a stat on the file.
+ */
+
if (TclOSstat(nativeEntry, &buf) != 0) {
- /*
- * Posix error occurred. The only ok
- * case is if this is a link to a nonexistent
- * file, and the user did 'glob -l'. So
- * we check that here:
+ /*
+ * Posix error occurred. The only ok case is if this is a
+ * link to a nonexistent file, and the user did 'glob -l'.
+ * So we check that here:
*/
+
if (types->type & TCL_GLOB_TYPE_LINK) {
if (TclOSlstat(nativeEntry, &buf) == 0) {
if (S_ISLNK(buf.st_mode)) {
@@ -413,26 +430,23 @@ NativeMatchType(
return 0;
}
}
+
/*
* In order bcdpfls as in 'find -t'
*/
- if (
- ((types->type & TCL_GLOB_TYPE_BLOCK) &&
- S_ISBLK(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_CHAR) &&
- S_ISCHR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_DIR) &&
- S_ISDIR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_PIPE) &&
- S_ISFIFO(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_FILE) &&
- S_ISREG(buf.st_mode))
+
+ if (((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) && S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) && S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) && S_ISFIFO(buf.st_mode))||
+ ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))
#ifdef S_ISSOCK
- || ((types->type & TCL_GLOB_TYPE_SOCK) &&
- S_ISSOCK(buf.st_mode))
+ ||((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))
#endif /* S_ISSOCK */
) {
- /* Do nothing -- this file is ok */
+ /*
+ * Do nothing - this file is ok.
+ */
} else {
#ifdef S_ISLNK
if (types->type & TCL_GLOB_TYPE_LINK) {
@@ -455,15 +469,15 @@ NativeMatchType(
*
* TclpGetUserHome --
*
- * This function takes the specified user name and finds their
- * home directory.
+ * This function takes the specified user name and finds their home
+ * directory.
*
* Results:
* The result is a pointer to a string specifying the user's home
* directory, or NULL if the user's home directory could not be
- * determined. Storage for the result string is allocated in
- * bufferPtr; the caller must call Tcl_DStringFree() when the result
- * is no longer needed.
+ * determined. Storage for the result string is allocated in bufferPtr;
+ * the caller must call Tcl_DStringFree() when the result is no longer
+ * needed.
*
* Side effects:
* None.
@@ -474,8 +488,8 @@ NativeMatchType(
char *
TclpGetUserHome(name, bufferPtr)
CONST char *name; /* User name for desired home directory. */
- Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
- * with name of user's home directory. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled with
+ * name of user's home directory. */
{
struct passwd *pwPtr;
Tcl_DString ds;
@@ -484,7 +498,7 @@ TclpGetUserHome(name, bufferPtr)
native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
pwPtr = getpwnam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
-
+
if (pwPtr == NULL) {
endpwent();
return NULL;
@@ -510,10 +524,10 @@ TclpGetUserHome(name, bufferPtr)
*---------------------------------------------------------------------------
*/
-int
+int
TclpObjAccess(pathPtr, mode)
- Tcl_Obj *pathPtr; /* Path of file to access */
- int mode; /* Permission setting. */
+ Tcl_Obj *pathPtr; /* Path of file to access */
+ int mode; /* Permission setting. */
{
CONST char *path = Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
@@ -534,14 +548,14 @@ TclpObjAccess(pathPtr, mode)
* See chdir() documentation.
*
* Side effects:
- * See chdir() documentation.
+ * See chdir() documentation.
*
*---------------------------------------------------------------------------
*/
-int
+int
TclpObjChdir(pathPtr)
- Tcl_Obj *pathPtr; /* Path to new working directory */
+ Tcl_Obj *pathPtr; /* Path to new working directory */
{
CONST char *path = Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
@@ -567,7 +581,7 @@ TclpObjChdir(pathPtr)
*----------------------------------------------------------------------
*/
-int
+int
TclpObjLstat(pathPtr, bufPtr)
Tcl_Obj *pathPtr; /* Path of file to stat */
Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
@@ -583,13 +597,12 @@ TclpObjLstat(pathPtr, bufPtr)
* This function replaces the library version of getcwd().
*
* Results:
- * The input and output are filesystem paths in native form. The
- * result is either the given clientData, if the working directory
- * hasn't changed, or a new clientData (owned by our caller),
- * giving the new native path, or NULL if the current directory
- * could not be determined. If NULL is returned, the caller can
- * examine the standard posix error codes to determine the cause of
- * the problem.
+ * The input and output are filesystem paths in native form. The result
+ * is either the given clientData, if the working directory hasn't
+ * changed, or a new clientData (owned by our caller), giving the new
+ * native path, or NULL if the current directory could not be determined.
+ * If NULL is returned, the caller can examine the standard posix error
+ * codes to determine the cause of the problem.
*
* Side effects:
* None.
@@ -604,18 +617,21 @@ TclpGetNativeCwd(clientData)
char buffer[MAXPATHLEN+1];
#ifdef USEGETWD
- if (getwd(buffer) == NULL) { /* INTL: Native. */
+ if (getwd(buffer) == NULL) /* INTL: Native. */
#else
- if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */
+ if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
#endif
+ {
return NULL;
}
if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) {
- /* No change to pwd */
+ /*
+ * No change to pwd.
+ */
+
return clientData;
} else {
- char *newCd = (char *) ckalloc((unsigned)
- (strlen(buffer) + 1));
+ char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
strcpy(newCd, buffer);
return (ClientData) newCd;
}
@@ -626,17 +642,16 @@ TclpGetNativeCwd(clientData)
*
* TclpGetCwd --
*
- * This function replaces the library version of getcwd().
- * (Obsolete function, only retained for old extensions which
- * may call it directly).
- *
+ * This function replaces the library version of getcwd(). (Obsolete
+ * function, only retained for old extensions which may call it
+ * directly).
+ *
* Results:
- * The result is a pointer to a string specifying the current
- * directory, or NULL if the current directory could not be
- * determined. If NULL is returned, an error message is left in the
- * interp's result. Storage for the result string is allocated in
- * bufferPtr; the caller must call Tcl_DStringFree() when the result
- * is no longer needed.
+ * The result is a pointer to a string specifying the current directory,
+ * or NULL if the current directory could not be determined. If NULL is
+ * returned, an error message is left in the interp's result. Storage for
+ * the result string is allocated in bufferPtr; the caller must call
+ * Tcl_DStringFree() when the result is no longer needed.
*
* Side effects:
* None.
@@ -647,16 +662,17 @@ TclpGetNativeCwd(clientData)
CONST char *
TclpGetCwd(interp, bufferPtr)
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
- Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
- * with name of current directory. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled with
+ * name of current directory. */
{
char buffer[MAXPATHLEN+1];
#ifdef USEGETWD
- if (getwd(buffer) == NULL) { /* INTL: Native. */
+ if (getwd(buffer) == NULL) /* INTL: Native. */
#else
- if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */
+ if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
#endif
+ {
if (interp != NULL) {
Tcl_AppendResult(interp,
"error getting working directory name: ",
@@ -675,11 +691,11 @@ TclpGetCwd(interp, bufferPtr)
* This function replaces the library version of readlink().
*
* Results:
- * The result is a pointer to a string specifying the contents
- * of the symbolic link given by 'path', or NULL if the symbolic
- * link could not be read. Storage for the result string is
- * allocated in bufferPtr; the caller must call Tcl_DStringFree()
- * when the result is no longer needed.
+ * The result is a pointer to a string specifying the contents of the
+ * symbolic link given by 'path', or NULL if the symbolic link could not
+ * be read. Storage for the result string is allocated in bufferPtr; the
+ * caller must call Tcl_DStringFree() when the result is no longer
+ * needed.
*
* Side effects:
* See readlink() documentation.
@@ -690,8 +706,8 @@ TclpGetCwd(interp, bufferPtr)
char *
TclpReadlink(path, linkPtr)
CONST char *path; /* Path of file to readlink (UTF-8). */
- Tcl_DString *linkPtr; /* Uninitialized or free DString filled
- * with contents of link (UTF-8). */
+ Tcl_DString *linkPtr; /* Uninitialized or free DString filled with
+ * contents of link (UTF-8). */
{
#ifndef DJGPP
char link[MAXPATHLEN];
@@ -702,7 +718,7 @@ TclpReadlink(path, linkPtr)
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
length = readlink(native, link, sizeof(link)); /* INTL: Native. */
Tcl_DStringFree(&ds);
-
+
if (length < 0) {
return NULL;
}
@@ -730,7 +746,7 @@ TclpReadlink(path, linkPtr)
*----------------------------------------------------------------------
*/
-int
+int
TclpObjStat(pathPtr, bufPtr)
Tcl_Obj *pathPtr; /* Path of file to stat */
Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
@@ -743,10 +759,9 @@ TclpObjStat(pathPtr, bufPtr)
}
}
-
#ifdef S_IFLNK
-Tcl_Obj*
+Tcl_Obj*
TclpObjLink(pathPtr, toPtr, linkAction)
Tcl_Obj *pathPtr;
Tcl_Obj *toPtr;
@@ -756,42 +771,52 @@ TclpObjLink(pathPtr, toPtr, linkAction)
CONST char *src = Tcl_FSGetNativePath(pathPtr);
CONST char *target = NULL;
if (src == NULL) return NULL;
-
- /*
- * If we're making a symbolic link and the path is relative,
- * then we must check whether it exists _relative_ to the
- * directory in which the src is found (not relative to the
- * current cwd which is just not relevant in this case).
- *
- * If we're making a hard link, then a relative path is
- * just converted to absolute relative to the cwd.
+
+ /*
+ * If we're making a symbolic link and the path is relative, then we
+ * must check whether it exists _relative_ to the directory in which
+ * the src is found (not relative to the current cwd which is just not
+ * relevant in this case).
+ *
+ * If we're making a hard link, then a relative path is just converted
+ * to absolute relative to the cwd.
*/
+
if ((linkAction & TCL_CREATE_SYMBOLIC_LINK)
- && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) {
+ && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) {
Tcl_Obj *dirPtr, *absPtr;
+
dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME);
if (dirPtr == NULL) {
- return NULL;
+ return NULL;
}
absPtr = Tcl_FSJoinToPath(dirPtr, 1, &toPtr);
Tcl_IncrRefCount(absPtr);
if (Tcl_FSAccess(absPtr, F_OK) == -1) {
Tcl_DecrRefCount(absPtr);
Tcl_DecrRefCount(dirPtr);
- /* target doesn't exist */
+
+ /*
+ * Target doesn't exist.
+ */
+
errno = ENOENT;
- return NULL;
+ return NULL;
}
- /*
- * Target exists; we'll construct the relative
- * path we want below.
+
+ /*
+ * Target exists; we'll construct the relative path we want below.
*/
+
Tcl_DecrRefCount(absPtr);
Tcl_DecrRefCount(dirPtr);
} else {
target = Tcl_FSGetNativePath(toPtr);
if (access(target, F_OK) == -1) {
- /* target doesn't exist */
+ /*
+ * Target doesn't exist.
+ */
+
errno = ENOENT;
return NULL;
}
@@ -799,25 +824,31 @@ TclpObjLink(pathPtr, toPtr, linkAction)
return NULL;
}
}
-
+
if (access(src, F_OK) != -1) {
- /* src exists */
+ /*
+ * Src exists.
+ */
+
errno = EEXIST;
return NULL;
}
- /*
- * Check symbolic link flag first, since we prefer to
- * create these.
+
+ /*
+ * Check symbolic link flag first, since we prefer to create these.
*/
+
if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
int targetLen;
Tcl_DString ds;
Tcl_Obj *transPtr;
- /*
+
+ /*
* Now we don't want to link to the absolute, normalized path.
- * Relative links are quite acceptable (but links to ~user
- * are not -- these must be expanded first).
+ * Relative links are quite acceptable (but links to ~user are not
+ * -- these must be expanded first).
*/
+
transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
if (transPtr == NULL) {
return NULL;
@@ -825,9 +856,9 @@ TclpObjLink(pathPtr, toPtr, linkAction)
target = Tcl_GetStringFromObj(transPtr, &targetLen);
target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
Tcl_DecrRefCount(transPtr);
-
+
if (symlink(target, src) != 0) {
- toPtr = NULL;
+ toPtr = NULL;
}
Tcl_DStringFree(&ds);
} else if (linkAction & TCL_CREATE_HARD_LINK) {
@@ -846,7 +877,7 @@ TclpObjLink(pathPtr, toPtr, linkAction)
int length;
Tcl_DString ds;
Tcl_Obj *transPtr;
-
+
transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
if (transPtr == NULL) {
return NULL;
@@ -859,8 +890,8 @@ TclpObjLink(pathPtr, toPtr, linkAction)
}
Tcl_ExternalToUtfDString(NULL, link, length, &ds);
- linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
+ linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
if (linkPtr != NULL) {
Tcl_IncrRefCount(linkPtr);
@@ -868,33 +899,35 @@ TclpObjLink(pathPtr, toPtr, linkAction)
return linkPtr;
}
}
-
-#endif
-
+#endif /* S_IFLNK */
/*
*---------------------------------------------------------------------------
*
* TclpFilesystemPathType --
*
- * This function is part of the native filesystem support, and
- * returns the path type of the given path. Right now it simply
- * returns NULL. In the future it could return specific path
- * types, like 'nfs', 'samba', 'FAT32', etc.
+ * This function is part of the native filesystem support, and returns
+ * the path type of the given path. Right now it simply returns NULL. In
+ * the future it could return specific path types, like 'nfs', 'samba',
+ * 'FAT32', etc.
*
* Results:
- * NULL at present.
+ * NULL at present.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
+
Tcl_Obj*
TclpFilesystemPathType(pathPtr)
Tcl_Obj* pathPtr;
{
- /* All native paths are of the same type */
+ /*
+ * All native paths are of the same type.
+ */
+
return NULL;
}
@@ -903,39 +936,39 @@ TclpFilesystemPathType(pathPtr)
*
* TclpNativeToNormalized --
*
- * Convert native format to a normalized path object, with refCount
- * of zero.
- *
- * Currently assumes all native paths are actually normalized
- * already, so if the path given is not normalized this will
- * actually just convert to a valid string path, but not
- * necessarily a normalized one.
+ * Convert native format to a normalized path object, with refCount of
+ * zero.
+ *
+ * Currently assumes all native paths are actually normalized already, so
+ * if the path given is not normalized this will actually just convert to
+ * a valid string path, but not necessarily a normalized one.
*
* Results:
- * A valid normalized path.
+ * A valid normalized path.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
+
+Tcl_Obj*
TclpNativeToNormalized(clientData)
ClientData clientData;
{
Tcl_DString ds;
Tcl_Obj *objPtr;
int len;
-
+
CONST char *copy;
Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
-
+
copy = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
objPtr = Tcl_NewStringObj(copy,len);
Tcl_DStringFree(&ds);
-
+
return objPtr;
}
@@ -944,17 +977,18 @@ TclpNativeToNormalized(clientData)
*
* TclNativeCreateNativeRep --
*
- * Create a native representation for the given path.
+ * Create a native representation for the given path.
*
* Results:
- * The nativePath representation.
+ * The nativePath representation.
*
* Side effects:
* Memory will be allocated. The path may need to be normalized.
*
*---------------------------------------------------------------------------
*/
-ClientData
+
+ClientData
TclNativeCreateNativeRep(pathPtr)
Tcl_Obj* pathPtr;
{
@@ -965,15 +999,18 @@ TclNativeCreateNativeRep(pathPtr)
char *str;
if (TclFSCwdIsNative()) {
- /*
- * The cwd is native, which means we can use the translated
- * path without worrying about normalization (this will also
- * usually be shorter so the utf-to-external conversion will
- * be somewhat faster).
+ /*
+ * The cwd is native, which means we can use the translated path
+ * without worrying about normalization (this will also usually be
+ * shorter so the utf-to-external conversion will be somewhat faster).
*/
+
validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
} else {
- /* Make sure the normalized path is set */
+ /*
+ * Make sure the normalized path is set.
+ */
+
validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
Tcl_IncrRefCount(validPathPtr);
}
@@ -984,7 +1021,7 @@ TclNativeCreateNativeRep(pathPtr)
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc((unsigned) len);
memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
-
+
Tcl_DStringFree(&ds);
return (ClientData)nativePathPtr;
}
@@ -994,18 +1031,19 @@ TclNativeCreateNativeRep(pathPtr)
*
* TclNativeDupInternalRep --
*
- * Duplicate the native representation.
+ * Duplicate the native representation.
*
* Results:
- * The copied native representation, or NULL if it is not possible
- * to copy the representation.
+ * The copied native representation, or NULL if it is not possible to
+ * copy the representation.
*
* Side effects:
* Memory will be allocated for the copy.
*
*---------------------------------------------------------------------------
*/
-ClientData
+
+ClientData
TclNativeDupInternalRep(clientData)
ClientData clientData;
{
@@ -1016,11 +1054,14 @@ TclNativeDupInternalRep(clientData)
return NULL;
}
- /* ascii representation when running on Unix */
- len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
-
+ /*
+ * ASCII representation when running on Unix.
+ */
+
+ len = sizeof(char) + (strlen((CONST char*) clientData) * sizeof(char));
+
copy = (char *) ckalloc(len);
- memcpy((VOID*)copy, (VOID*)clientData, len);
+ memcpy((VOID *) copy, (VOID *) clientData, len);
return (ClientData)copy;
}
@@ -1039,10 +1080,19 @@ TclNativeDupInternalRep(clientData)
*
*---------------------------------------------------------------------------
*/
-int
+
+int
TclpUtime(pathPtr, tval)
- Tcl_Obj *pathPtr; /* File to modify */
- struct utimbuf *tval; /* New modification date structure */
+ Tcl_Obj *pathPtr; /* File to modify */
+ struct utimbuf *tval; /* New modification date structure */
{
- return utime(Tcl_FSGetNativePath(pathPtr),tval);
+ return utime(Tcl_FSGetNativePath(pathPtr), tval);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */