allow creation of relative links

1 files changed, 24 insertions, 3 deletions

diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index f268ad5..66c31b9 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.34 2003/11/03 12:48:30 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.35 2003/12/12 17:09:34 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -735,9 +735,30 @@ TclpObjLink(pathPtr, toPtr, linkAction)
 	 * create these.
 	 */
 	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
-	    if (symlink(target, src) != 0) return NULL;
+	    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, as are links to '~user',
+	     * for example.
+	     */
+	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
+	    if (transPtr == NULL) {
+		return NULL;
+	    }
+	    target = Tcl_GetStringFromObj(transPtr, &targetLen);
+	    target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
+	    Tcl_DecrRefCount(transPtr);
+	    
+	    if (symlink(target, src) != 0) {
+	        toPtr = NULL;
+	    }
+	    Tcl_DStringFree(&ds);
 	} else if (linkAction & TCL_CREATE_HARD_LINK) {
-	    if (link(target, src) != 0) return NULL;
+	    if (link(target, src) != 0) {
+		return NULL;
+	    }
 	} else {
 	    errno = ENODEV;
 	    return NULL;