summaryrefslogtreecommitdiffstats
path: root/Python/pythonmain.c
blob: 1c6469231d01e5fa85a3df547af5f7dfef902b75 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
/***********************************************************
Copyright 1991, 1992 by Stichting Mathematisch Centrum, Amsterdam, The
Netherlands.

                        All Rights Reserved

Permission to use, copy, modify, and distribute this software and its 
documentation for any purpose and without fee is hereby granted, 
provided that the above copyright notice appear in all copies and that
both that copyright notice and this permission notice appear in 
supporting documentation, and that the names of Stichting Mathematisch
Centrum or CWI not be used in advertising or publicity pertaining to
distribution of the software without specific, written prior permission.

STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

******************************************************************/

/* Python interpreter main program */

#include "allobjects.h"

extern int debugging; /* Needed by parser.c */
extern int verbose; /* Needed by import.c */

/* Interface to getopt(): */
extern int optind;
extern char *optarg;
extern int getopt PROTO((int, char **, char *));

main(argc, argv)
	int argc;
	char **argv;
{
	int c;
	int sts;
	char *command = NULL;
	char *filename = NULL;
	FILE *fp = stdin;
	
	initargs(&argc, &argv); /* Defined in config*.c */

	while ((c = getopt(argc, argv, "c:dv")) != EOF) {
		if (c == 'c') {
			/* -c is the last option; following arguments
			   that look like options are left for the
			   the command to interpret. */
			command = malloc(strlen(optarg) + 2);
			/* Ignore malloc errors this early... */
			strcpy(command, optarg);
			strcat(command, "\n");
			break;
		}
		
		switch (c) {

		case 'd':
			debugging++;
			break;

		case 'v':
			verbose++;
			break;

		/* This space reserved for other options */

		default:
			fprintf(stderr,
				"usage: %s [-c cmd | file | -] [arg] ...\n",
				argv[0]);
			exit(2);
			/*NOTREACHED*/

		}
	}
	
	if (command == NULL && optind < argc && strcmp(argv[optind], "-") != 0)
		filename = argv[optind];
	
	if (filename != NULL) {
		if ((fp = fopen(filename, "r")) == NULL) {
			fprintf(stderr, "%s: can't open file '%s'\n",
				argv[0], filename);
			exit(2);
		}
	}
	
	initall();
	
	if (command != NULL) {
		/* Backup optind and force sys.argv[0] = '-c' */
		optind--;
		argv[optind] = "-c";
	}

	setpythonargv(argc-optind, argv+optind);

	if (command) {
		sts = run_command(command) != 0;
	}
	else {
		if (filename == NULL && isatty((int)fileno(fp))) {
			char *startup = getenv("PYTHONSTARTUP");
			if (startup != NULL && startup[0] != '\0') {
				FILE *fp = fopen(startup, "r");
				if (fp != NULL) {
					(void) run_script(fp, startup);
					err_clear();
				}
			}
		}
		sts = run(fp, filename == NULL ? "<stdin>" : filename) != 0;
	}

	goaway(sts);
	/*NOTREACHED*/
}
>dgp_stack_depth_tester Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog37
-rw-r--r--generic/tcl.h5
-rw-r--r--generic/tclFileName.c12
-rw-r--r--generic/tclIOUtil.c177
-rw-r--r--generic/tclPathObj.c16
-rw-r--r--generic/tclTest.c20
-rw-r--r--mac/tclMacFile.c7
-rw-r--r--tests/fileName.test19
-rw-r--r--unix/tclUnixFCmd.c24
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--win/tclWin32Dll.c37
-rw-r--r--win/tclWinFCmd.c31
-rw-r--r--win/tclWinFile.c158
-rw-r--r--win/tclWinInt.h27
14 files changed, 526 insertions, 57 deletions
diff --git a/ChangeLog b/ChangeLog
index 376835e..25c702e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,40 @@
+2003-10-13 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tcl.h:
+ * generic/tclFileName.c:
+ * generic/tclIOUtil.c:
+ * generic/tclPathObj.c:
+ * generic/tclTest.c:
+ * mac/tclMacFile.c:
+ * tests/fileName.test: better tests for [Bug 813273]
+ * unix/tclUnixFCmd.c:
+ * unix/tclUnixFile.c:
+ * win/tclWin32Dll.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c:
+ * win/tclFileInt.h:
+
+ Fixed [Bug 800106] in which 'glob' was incapable of merging the
+ results of a directory listing (real or virtual) and any virtual
+ filesystem mountpoints in that directory (the latter were
+ ignored). This meant boundaries between different filesystems
+ were not seamless (e.g. 'glob */*' across a filesystem boundary
+ was wrong). Added new entry to Tcl_GlobTypeData in a totally
+ backwards compatible way. To allow listing of mounts, registered
+ filesystems must support the 'TCL_GLOB_TYPE_MOUNT' flag. If this
+ is not supported (e.g. in tclvfs 1.2) then mounts will simply not
+ be listed for that filesystem.
+
+ Fixed [Bug 749876] 'file writable/readable/etc' (NativeAccess)
+ using correct permission checking code for Windows NT/2000/XP
+ where more complex user-based security/access priveleges are
+ available, particularly on shared volumes. The performance
+ impact of this extra checking will need further investigation.
+ Note: Win 95,98,ME have no support for this.
+
+ Also made better use of normalized rather than translated paths
+ in the platform specific code.
+
2003-10-12 Jeff Hobbs <jeffh@ActiveState.com>
* unix/tclUnixTest.c (TestalarmCmd): don't bother checking return
diff --git a/generic/tcl.h b/generic/tcl.h
index 692cbf3..e89690d 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tcl.h,v 1.165 2003/09/04 16:44:12 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.166 2003/10/13 16:48:06 vincentdarley Exp $
*/
#ifndef _TCL
@@ -1615,6 +1615,7 @@ typedef struct Tcl_GlobTypeData {
#define TCL_GLOB_TYPE_FILE (1<<4)
#define TCL_GLOB_TYPE_LINK (1<<5)
#define TCL_GLOB_TYPE_SOCK (1<<6)
+#define TCL_GLOB_TYPE_MOUNT (1<<7)
#define TCL_GLOB_PERM_RONLY (1<<0)
#define TCL_GLOB_PERM_HIDDEN (1<<1)
@@ -1790,7 +1791,7 @@ typedef struct Tcl_Filesystem {
* 'Tcl_FSLink()' call. Should be
* implemented only if the filesystem supports
* links (reading or creating). */
- Tcl_FSListVolumesProc *listVolumesProc;
+ Tcl_FSListVolumesProc *listVolumesProc;
/* Function to list any filesystem volumes
* added by this filesystem. Should be
* implemented only if the filesystem adds
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index f607def..c9995f6 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.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: tclFileName.c,v 1.43 2003/07/17 00:20:41 hobbs Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.44 2003/10/13 16:48:06 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -1380,17 +1380,19 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
* with name after tilde substitution. */
{
Tcl_Obj *path = Tcl_NewStringObj(name, -1);
- CONST char *result;
+ Tcl_Obj *transPtr;
Tcl_IncrRefCount(path);
- result = Tcl_FSGetTranslatedStringPath(interp, path);
- if (result == NULL) {
+ transPtr = Tcl_FSGetTranslatedPath(interp, path);
+ if (transPtr == NULL) {
Tcl_DecrRefCount(path);
return NULL;
}
+
Tcl_DStringInit(bufferPtr);
- Tcl_DStringAppend(bufferPtr, result, -1);
+ Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
Tcl_DecrRefCount(path);
+ Tcl_DecrRefCount(transPtr);
/*
* Convert forward slashes to backslashes in Windows paths because
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 43f68e0..8586eb3 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.85 2003/10/10 15:50:35 dkf Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.86 2003/10/13 16:48:06 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -35,9 +35,13 @@
* Prototypes for procedures defined later in this file.
*/
-static FilesystemRecord* FsGetFirstFilesystem(void);
-static void FsThrExitProc(ClientData cd);
-
+static FilesystemRecord* FsGetFirstFilesystem _ANSI_ARGS_((void));
+static void FsThrExitProc _ANSI_ARGS_((ClientData cd));
+static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ CONST char *pattern));
+static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_((Tcl_Obj *result,
+ Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types));
+
#ifdef TCL_THREADS
static void FsRecacheFilesystemList(void);
#endif
@@ -922,7 +926,12 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
if (fsPtr != NULL) {
Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
if (proc != NULL) {
- return (*proc)(interp, result, pathPtr, pattern, types);
+ int ret = (*proc)(interp, result, pathPtr, pattern, types);
+ if (ret == TCL_OK && pattern != NULL) {
+ result = FsAddMountsToGlobResult(result, pathPtr,
+ pattern, types);
+ }
+ return ret;
}
} else {
Tcl_Obj* cwd;
@@ -967,6 +976,9 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
if (ret == TCL_OK) {
int resLength;
+ tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd,
+ pattern, types);
+
ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
if (ret == TCL_OK) {
int i;
@@ -993,6 +1005,92 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
/*
*----------------------------------------------------------------------
*
+ * FsAddMountsToGlobResult --
+ *
+ * This routine is used by the globbing code to take the results
+ * of a directory listing and add any mounted paths to that
+ * listing. This is required so that simple things like
+ * 'glob *' merge mounts and listings correctly.
+ *
+ * Results:
+ *
+ * The passed in 'result' may be modified (in place, if
+ * necessary), and the correct list is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static Tcl_Obj*
+FsAddMountsToGlobResult(result, pathPtr, pattern, types)
+ Tcl_Obj *result; /* The current list of matching paths */
+ Tcl_Obj *pathPtr; /* The directory in question */
+ CONST char *pattern;
+ Tcl_GlobTypeData *types;
+{
+ int mLength, gLength, i;
+ int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
+ Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
+
+ if (mounts == NULL) return result;
+
+ if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
+ goto endOfMounts;
+ }
+ if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {
+ goto endOfMounts;
+ }
+ for (i = 0; i < mLength; i++) {
+ Tcl_Obj *mElt;
+ int j;
+ int found = 0;
+
+ Tcl_ListObjIndex(NULL, mounts, i, &mElt);
+
+ for (j = 0; j < gLength; j++) {
+ Tcl_Obj *gElt;
+ Tcl_ListObjIndex(NULL, result, j, &gElt);
+ if (Tcl_FSEqualPaths(mElt, gElt)) {
+ found = 1;
+ if (!dir) {
+ /* We don't want to list this */
+ if (Tcl_IsShared(result)) {
+ Tcl_Obj *newList;
+ newList = Tcl_DuplicateObj(result);
+ Tcl_DecrRefCount(result);
+ result = newList;
+ }
+ Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL);
+ gLength--;
+ }
+ /* Break out of for loop */
+ break;
+ }
+ }
+ if (!found && dir) {
+ if (Tcl_IsShared(result)) {
+ Tcl_Obj *newList;
+ newList = Tcl_DuplicateObj(result);
+ Tcl_DecrRefCount(result);
+ result = newList;
+ }
+ Tcl_ListObjAppendElement(NULL, result, mElt);
+ /*
+ * No need to increment gLength, since we
+ * don't want to compare mounts against
+ * mounts.
+ */
+ }
+ }
+ endOfMounts:
+ Tcl_DecrRefCount(mounts);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_FSMountsChanged --
*
* Notify the filesystem that the available mounted filesystems
@@ -1627,6 +1725,9 @@ Tcl_FSStat(pathPtr, buf)
retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
statProcPtr = statProcPtr->nextPtr;
}
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
}
Tcl_MutexUnlock(&obsoleteFsHookMutex);
@@ -1754,6 +1855,9 @@ Tcl_FSAccess(pathPtr, mode)
retVal = (*accessProcPtr->proc)(path, mode);
accessProcPtr = accessProcPtr->nextPtr;
}
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
}
Tcl_MutexUnlock(&obsoleteFsHookMutex);
@@ -1831,6 +1935,9 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
modeString, permissions);
openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
}
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
}
Tcl_MutexUnlock(&obsoleteFsHookMutex);
if (retVal != NULL) {
@@ -2816,7 +2923,7 @@ Tcl_FSListVolumes(void)
* a list of all drives from all filesystems.
*/
- fsRecPtr = FsGetFirstFilesystem();
+ fsRecPtr = FsGetFirstFilesystem();
while (fsRecPtr != NULL) {
Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
if (proc != NULL) {
@@ -2835,6 +2942,59 @@ Tcl_FSListVolumes(void)
/*
*---------------------------------------------------------------------------
*
+ * FsListMounts --
+ *
+ * List all mounts within the given directory, which match the
+ * given pattern.
+ *
+ * Results:
+ * The list of mounts, in a list object which has refCount 0, or
+ * NULL if we didn't even find any filesystems to try to list
+ * mounts.
+ *
+ * Side effects:
+ * None
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+FsListMounts(pathPtr, pattern)
+ Tcl_Obj *pathPtr; /* Contains path to directory to search. */
+ CONST char *pattern; /* Pattern to match against. */
+{
+ FilesystemRecord *fsRecPtr;
+ Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
+ Tcl_Obj *resultPtr = NULL;
+
+ /*
+ * Call each of the "listMounts" functions in succession.
+ * A non-NULL return value indicates the particular function has
+ * succeeded. We call all the functions registered, since we want
+ * a list from each filesystems.
+ */
+
+ fsRecPtr = FsGetFirstFilesystem();
+ while (fsRecPtr != NULL) {
+ if (fsRecPtr != &nativeFilesystemRecord) {
+ Tcl_FSMatchInDirectoryProc *proc =
+ fsRecPtr->fsPtr->matchInDirectoryProc;
+ if (proc != NULL) {
+ if (resultPtr == NULL) {
+ resultPtr = Tcl_NewObj();
+ }
+ (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
+ }
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+
+ return resultPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* Tcl_FSSplitPath --
*
* This function takes the given Tcl_Obj, which should be a valid
@@ -3431,6 +3591,11 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
FilesystemRecord *fsRecPtr;
Tcl_Filesystem* retVal = NULL;
+ if (pathObjPtr == NULL) {
+ panic("Tcl_FSGetFileSystemForPath called with NULL object");
+ return NULL;
+ }
+
/*
* If the object has a refCount of zero, we reject it. This
* is to avoid possible segfaults or nondeterministic memory
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 18d3dd4..8fa73d5 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.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: tclPathObj.c,v 1.11 2003/10/10 15:50:35 dkf Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.12 2003/10/13 16:48:06 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -377,6 +377,7 @@ Tcl_FSJoinPath(listObj, elements)
* '/'. There's no need to return a special path
* object, when the base itself is just fine!
*/
+ Tcl_DecrRefCount(res);
return elt;
}
/*
@@ -390,6 +391,7 @@ Tcl_FSJoinPath(listObj, elements)
*/
if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS)
|| (strchr(str, '\\') == NULL))) {
+ Tcl_DecrRefCount(res);
return TclNewFSPathObj(elt, str, len);
}
/*
@@ -399,6 +401,7 @@ Tcl_FSJoinPath(listObj, elements)
*/
} else {
if (tclPlatform == TCL_PLATFORM_UNIX) {
+ Tcl_DecrRefCount(res);
return tail;
} else {
CONST char *str;
@@ -406,10 +409,12 @@ Tcl_FSJoinPath(listObj, elements)
str = Tcl_GetStringFromObj(tail,&len);
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
if (strchr(str, '\\') == NULL) {
+ Tcl_DecrRefCount(res);
return tail;
}
} else if (tclPlatform == TCL_PLATFORM_MAC) {
if (strchr(str, '/') == NULL) {
+ Tcl_DecrRefCount(res);
return tail;
}
}
@@ -965,6 +970,7 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
retObj = srcFsPathPtr->translatedPathPtr;
}
+ Tcl_IncrRefCount(retObj);
return retObj;
}
@@ -995,7 +1001,13 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr)
Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
if (transPtr != NULL) {
- return Tcl_GetString(transPtr);
+ int len;
+ CONST char *result, *orig;
+ orig = Tcl_GetStringFromObj(transPtr, &len);
+ result = (char*) ckalloc((unsigned)(len+1));
+ memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1));
+ Tcl_DecrRefCount(transPtr);
+ return result;
}
return NULL;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 8f322fc..effa8a3 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.68 2003/10/08 14:24:41 dkf Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.69 2003/10/13 16:48:06 vincentdarley Exp $
*/
#define TCL_TEST
@@ -6080,17 +6080,23 @@ TestReportOpenFileChannel(interp, fileName, mode, permissions)
static int
TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
- Tcl_Interp *interp; /* Interpreter to receive results. */
- Tcl_Obj *resultPtr; /* Directory separators to pass to TclDoGlob. */
+ Tcl_Interp *interp; /* Interpreter for error
+ * messages. */
+ Tcl_Obj *resultPtr; /* Object to lappend results. */
Tcl_Obj *dirPtr; /* 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. */
{
- TestReport("matchindirectory",dirPtr, NULL);
- return Tcl_FSMatchInDirectory(interp, resultPtr,
- TestReportGetNativePath(dirPtr), pattern,
- types);
+ if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+ TestReport("matchmounts",dirPtr, NULL);
+ return TCL_OK;
+ } else {
+ TestReport("matchindirectory",dirPtr, NULL);
+ return Tcl_FSMatchInDirectory(interp, resultPtr,
+ TestReportGetNativePath(dirPtr), pattern,
+ types);
+ }
}
static int
TestReportChdir(dirName)
diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c
index 0311ecd..be89237 100644
--- a/mac/tclMacFile.c
+++ b/mac/tclMacFile.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: tclMacFile.c,v 1.27 2003/03/03 20:22:43 das Exp $
+ * RCS: @(#) $Id: tclMacFile.c,v 1.28 2003/10/13 16:48:07 vincentdarley Exp $
*/
/*
@@ -178,6 +178,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
if (TclpObjLstat(fileNamePtr, &buf) != 0) {
/* File doesn't exist */
+ Tcl_DecrRefCount(fileNamePtr);
return TCL_OK;
}
@@ -202,6 +203,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
}
+ Tcl_DecrRefCount(fileNamePtr);
return TCL_OK;
} else {
char *fname;
@@ -258,6 +260,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
if ((err != noErr) || !isDirectory) {
Tcl_DStringFree(&dsOrig);
+ Tcl_DecrRefCount(fileNamePtr);
return TCL_OK;
}
}
@@ -326,6 +329,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
}
Tcl_DStringFree(&dsOrig);
+ Tcl_DecrRefCount(fileNamePtr);
return result;
}
}
@@ -1211,6 +1215,7 @@ TclpObjLink(pathPtr, toPtr, linkAction)
Tcl_IncrRefCount(link);
Tcl_DStringFree(&ds);
}
+ Tcl_DecrRefCount(transPtr);
}
return link;
}
diff --git a/tests/fileName.test b/tests/fileName.test
index de5c655..e75a1b7 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -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: fileName.test,v 1.32 2003/09/30 14:05:45 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.33 2003/10/13 16:48:07 vincentdarley Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -911,6 +911,23 @@ test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} {
[file join C:/blah {C:\foo\bar}] \
[file join C:/blah C:/blah {C:\foo\bar}]
} {C:/foo/bar C:/foo/bar C:/foo/bar}
+test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} {
+ testsetplatform win
+ set res {}
+ lappend res \
+ [file join {foo\bar}] \
+ [file join C:/blah {foo\bar}] \
+ [file join C:/blah C:/blah {foo\bar}]
+} {foo/bar C:/blah/foo/bar C:/blah/foo/bar}
+test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform winOnly} {
+ testsetplatform win
+ set res {}
+ lappend res \
+ [file join {foo\bar}] \
+ [file join [pwd] {foo\bar}] \
+ [file join [pwd] [pwd] {foo\bar}]
+ string map [list [pwd] pwd] $res
+} {foo/bar pwd/foo/bar pwd/foo/bar}
test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
set res {}
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 1754e2d..7301017 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.31 2003/07/18 02:02:02 das Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.32 2003/10/13 16:48:07 vincentdarley Exp $
*
* Portions of this code were derived from NetBSD source code which has
* the following copyright notice:
@@ -658,13 +658,22 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
Tcl_DString ds;
Tcl_DString srcString, dstString;
int ret;
-
+ Tcl_Obj *transPtr;
+
+ transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
Tcl_UtfToExternalDString(NULL,
- Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
+ (transPtr != NULL ? Tcl_GetString(transPtr) : NULL),
-1, &srcString);
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
+ transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
Tcl_UtfToExternalDString(NULL,
- Tcl_FSGetTranslatedStringPath(NULL,destPathPtr),
+ (transPtr != NULL ? Tcl_GetString(transPtr) : NULL),
-1, &dstString);
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds);
@@ -715,9 +724,14 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
Tcl_DString ds;
Tcl_DString pathString;
int ret;
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr),
+ Tcl_UtfToExternalDString(NULL,
+ (transPtr != NULL ? Tcl_GetString(transPtr) : NULL),
-1, &pathString);
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
ret = DoRemoveDirectory(&pathString, recursive, &ds);
Tcl_DStringFree(&pathString);
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 3e74d16..d68bebd 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,7 +9,7 @@
* 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 2003/02/12 18:57:52 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.33 2003/10/13 16:48:07 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -221,6 +221,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
if (NativeMatchType(native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
+ Tcl_DecrRefCount(fileNamePtr);
return TCL_OK;
} else {
DIR *d;
@@ -277,6 +278,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_DStringValue(&dsOrig), "\": ",
Tcl_PosixError(interp), (char *) NULL);
Tcl_DStringFree(&dsOrig);
+ Tcl_DecrRefCount(fileNamePtr);
return TCL_ERROR;
}
@@ -330,6 +332,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
closedir(d);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dsOrig);
+ Tcl_DecrRefCount(fileNamePtr);
return TCL_OK;
}
}
@@ -745,10 +748,14 @@ TclpObjLink(pathPtr, toPtr, linkAction)
char link[MAXPATHLEN];
int length;
Tcl_DString ds;
-
- if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) {
+ 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;
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 09b9046..dc497f4 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWin32Dll.c,v 1.27 2003/09/29 22:38:21 dkf Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.28 2003/10/13 16:48:07 vincentdarley Exp $
*/
#include "tclWinInt.h"
@@ -99,6 +99,8 @@ static TclWinProcs asciiProcs = {
(int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime,
NULL,
NULL,
+ /* Security SDK - not available on 95,98,ME */
+ NULL, NULL, NULL, NULL, NULL, NULL
};
static TclWinProcs unicodeProcs = {
@@ -148,6 +150,8 @@ static TclWinProcs unicodeProcs = {
(int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime,
NULL,
NULL,
+ /* Security SDK - will be filled in on NT,XP,2000,2003 */
+ NULL, NULL, NULL, NULL, NULL, NULL
};
TclWinProcs *tclWinProcs;
@@ -567,6 +571,37 @@ TclWinSetInterfaces(
"GetVolumeNameForVolumeMountPointW");
FreeLibrary(hInstance);
}
+ hInstance = LoadLibraryA("advapi32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
+ LPCTSTR lpFileName,
+ SECURITY_INFORMATION RequestedInformation,
+ PSECURITY_DESCRIPTOR pSecurityDescriptor, DWORD nLength,
+ LPDWORD lpnLengthNeeded)) GetProcAddress(hInstance,
+ "GetFileSecurityW");
+ tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) (
+ SECURITY_IMPERSONATION_LEVEL ImpersonationLevel))
+ GetProcAddress(hInstance, "ImpersonateSelf");
+ tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) (
+ HANDLE ThreadHandle, DWORD DesiredAccess, BOOL OpenAsSelf,
+ PHANDLE TokenHandle)) GetProcAddress(hInstance,
+ "OpenThreadToken");
+ tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void))
+ GetProcAddress(hInstance, "RevertToSelf");
+ tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) (
+ PDWORD AccessMask, PGENERIC_MAPPING GenericMapping))
+ GetProcAddress(hInstance, "MapGenericMask");
+ tclWinProcs->accessCheckProc = (BOOL (WINAPI *)(
+ PSECURITY_DESCRIPTOR pSecurityDescriptor,
+ HANDLE ClientToken, DWORD DesiredAccess,
+ PGENERIC_MAPPING GenericMapping,
+ PPRIVILEGE_SET PrivilegeSet,
+ LPDWORD PrivilegeSetLength,
+ LPDWORD GrantedAccess,
+ LPBOOL AccessStatus)) GetProcAddress(hInstance,
+ "AccessCheck");
+ FreeLibrary(hInstance);
+ }
}
} else {
tclWinProcs = &asciiProcs;
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c