Tcl Source Code

converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last
block in a (potentially multi-block) input stream, telling the conversion
routine to perform any finalization that needs to occur after the last
byte is converted and then to reset to an initial state. The
\fBTCL_PROFILE_*\fR bits defined in the \fBPROFILES\fR section below
control the encoding profile to be used for dealing with invalid data or
other errors in the encoding transform.
The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect,
it only has meaning in Tcl 8.x.
.PP
Some flags bits may not be usable with some functions as noted in the
function descriptions below.
.AP Tcl_EncodingState *statePtr in/out
Used when converting a (generally long or indefinite length) byte stream
in a piece-by-piece fashion.  The conversion routine stores its current
state in \fI*statePtr\fR after \fIsrc\fR (the buffer containing the
current piece) has been converted; that state information must be passed

Encoding profiles define the manner in which errors in the encoding transforms
are handled by the encoding functions. An application can specify the profile
to be used by OR-ing the \fBflags\fR parameter passed to the function
with at most one of \fBTCL_ENCODING_PROFILE_TCL8\fR,
\fBTCL_ENCODING_PROFILE_STRICT\fR or \fBTCL_ENCODING_PROFILE_REPLACE\fR.
These correspond to the \fBtcl8\fR, \fBstrict\fR and \fBreplace\fR profiles
respectively. If none are specified, a version-dependent default profile is used.
For Tcl 9.0, the default profile is \fBstrict\fR.
.PP
For details about profiles, see the \fBPROFILES\fR section in
the documentation of the \fBencoding\fR command.
.SH "SEE ALSO"
encoding(n)
.SH KEYWORDS
utf, encoding, convert

platform-specific representation:  For all Unix variants it is \fBlf\fR, and
for all Windows variants it is \fBcrlf\fR, except that for sockets on all
platforms it is \fBcrlf\fR for both input and output.
.TP
\fBbinary\fR
.
Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets
\fB\-eofchar\fR to the empty string to disable it, and sets \fB\-encoding\fR
to \fBiso8859-1\fR.  With this one setting, a channel is fully configured
for binary input and output:  Each byte read from the channel
becomes the Unicode character having the same value as that byte, and each
character written to the channel becomes a single byte in the output.  This
makes it possible to work seamlessly with binary data as long as each character
in the data remains in the range of 0 to 255 so that there is no distinction
between binary data and text.  For example, A JPEG image can be read from a
such a channel, manipulated, and then written back to such a channel.

.TP
\fBcr\fR
.
The end of a line is represented in the external data by a single carriage
return character.  For input, each carriage return is translated to a line
feed, and for output each line feed character is translated to a carriage
return.

.VS "TCL8.7 TIP656"
Each \fIprofile\fR is a distinct strategy for dealing with invalid data for an
encoding.
.PP
The following profiles are currently implemented.
.VS "TCL8.7 TIP656"
.TP
\fBstrict\fR
.
The default profile.  The operation fails when invalid data for the encoding
are encountered.
.TP
\fBtcl8\fR
.
Provides for behaviour identical to that of Tcl 8.6: When
decoding, for encodings \fBother than utf-8\fR, each invalid byte is interpreted
as the Unicode value given by that one byte. For example, the byte 0x80, which
is invalid in the ASCII encoding would be mapped to the Unicode value U+0080.
For \fButf-8\fR, each invalid byte that is a valid CP1252 character is
interpreted as the Unicode value for that character, while each byte that is
not is treated as the Unicode value given by that one byte. For example, byte
0x80 is defined by CP1252 and is therefore mapped to its Unicode equivalent
U+20AC while byte 0x81 which is not defined by CP1252 is mapped to U+0081. As
an additional special case, the sequence 0xC0 0x80 is mapped to U+0000.

When encoding, each character that cannot be represented in the encoding is
replaced by an encoding-dependent character, usually the question mark \fB?\fR.
.TP




\fBreplace\fR
.
When decoding, invalid bytes are replaced by U+FFFD, the Unicode REPLACEMENT
CHARACTER.

When encoding, Unicode values that cannot be represented in the target encoding
are transformed to an encoding-specific fallback character, U+FFFD REPLACEMENT

% codepoints [encoding convertfrom -profile strict ascii A\ex80]
unexpected byte sequence starting at index 1: '\ex80'
.CE
.PP
Example 3: Get partial data and the error location:
.PP
.CS
% codepoints [encoding convertfrom -failindex idx ascii AB\ex80]
U+000041 U+000042
% set idx
2
.CE
.PP
Example 4: Encode a character that is not representable in ISO8859-1:
.PP
.CS
% encoding convertto iso8859-1 A\eu0141
A?
% encoding convertto -profile strict iso8859-1 A\eu0141
unexpected character at index 1: 'U+000141'
% encoding convertto -failindex idx iso8859-1 A\eu0141
A
% set idx
1
.CE
.VE "TCL8.7 TIP607, TIP656"
.PP
.SH "SEE ALSO"
Tcl_GetEncoding(3), fconfigure(n)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
.\" mode: nroff
.\" End:

/* Internal use bits, do not define bits in this space. See above comment */
#define TCL_ENCODING_INTERNAL_USE_MASK  0xFF00
/*
 * Reserve top byte for profile values (disjoint, not a mask). In case of
 * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
 * necessary.
 */
#define TCL_ENCODING_PROFILE_STRICT   TCL_ENCODING_STOPONERROR
#define TCL_ENCODING_PROFILE_TCL8     0x01000000
#define TCL_ENCODING_PROFILE_REPLACE  0x02000000






/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large

	    return TCL_ERROR;
	}
	Tcl_IncrRefCount(dir);
    }
    if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
	result = TCL_ERROR;
    } else {
	Tcl_DString ds;
	result = Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(dir), -1, 0, &ds, NULL);
	Tcl_DStringFree(&ds);
	if (result == TCL_OK) {
	    result = Tcl_FSChdir(dir);
	}
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't change working directory to \"%s\": %s",
		    TclGetString(dir), Tcl_PosixError(interp)));
	    result = TCL_ERROR;
	}
    }

)
{
    static const char *const options[] = {"-profile", "-failindex", NULL};
    enum convertfromOptions { PROFILE, FAILINDEX } optIndex;
    Tcl_Encoding encoding;
    Tcl_Obj *dataObj;
    Tcl_Obj *failVarObj;
    int profile = TCL_ENCODING_PROFILE_STRICT;

    /*
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) ?options? encoding data			-> objc >= 3
     * It is intentional that specifying option forces encoding to be
     * specified. Less prone to user error. This should have always been

    Tcl_Interp *interp,		/* Interp for status return. Must not be
				 * NULL. */
    Tcl_Obj *pathPtr,		/* Name of file to check. */
    int mode)			/* Attribute to check; passed as argument to
				 * access(). */
{
    int value;
    Tcl_DString ds;

    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	value = 0;
    } else if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(pathPtr),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	value = 0;
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringFree(&ds);
	value = (Tcl_FSAccess(pathPtr, mode) == 0);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));

    return TCL_OK;
}


    Tcl_Obj *pathPtr,		/* Path name to examine. */
    Tcl_FSStatProc *statProc,	/* Either stat() or lstat() depending on
				 * desired behavior. */
    Tcl_StatBuf *statPtr)	/* Filled with info about file obtained by
				 * calling (*statProc)(). */
{
    int status;
    Tcl_DString ds;

    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(pathPtr),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	status = -1;
    } else {
	status = statProc(pathPtr, statPtr);
    }
    Tcl_DStringFree(&ds);

    if (status < 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	}

    int value;
} encodingProfiles[] = {
    {"replace", TCL_ENCODING_PROFILE_REPLACE},
    {"strict", TCL_ENCODING_PROFILE_STRICT},
    {"tcl8", TCL_ENCODING_PROFILE_TCL8},
};
#define PROFILE_TCL8(flags_)                                           \
    (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8)


#define PROFILE_REPLACE(flags_)                                        \
    (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE)


#define PROFILE_STRICT(flags_)                                         \
    (!PROFILE_TCL8(flags_) && !PROFILE_REPLACE(flags_))



#define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD)
#define SURROGATE(c_)      (((c_) & ~0x7FF) == 0xD800)
#define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800)
#define LOW_SURROGATE(c_)  (((c_) & ~0x3FF) == 0xDC00)

/*

 *
 *	Convert a source buffer from the specified encoding into UTF-8.
 *	"flags" controls the behavior if any of the bytes in
 *	the source buffer are invalid or cannot be represented in utf-8.
 *	Possible flags values:
 *	target encoding. It should be composed by OR-ing the following:
 *	- *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}




 *
 * Results:
 *      The return value is one of
 *        TCL_OK: success. Converted string in *dstPtr
 *        TCL_ERROR: error in passed parameters. Error message in interp
 *        TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence
 *        TCL_CONVERT_SYNTAX: source is not conformant to encoding definition

 * Tcl_UtfToExternalDStringEx --
 *
 *	Convert a source buffer from UTF-8 to the specified encoding.
 *	The parameter flags controls the behavior, if any of the bytes in
 *	the source buffer are invalid or cannot be represented in the
 *	target encoding. It should be composed by OR-ing the following:
 *	- *At most one* of TCL_ENCODING_PROFILE_*


 *
 * Results:
 *      The return value is one of
 *        TCL_OK: success. Converted string in *dstPtr
 *        TCL_ERROR: error in passed parameters. Error message in interp
 *        TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence
 *        TCL_CONVERT_SYNTAX: source is not conformant to encoding definition

    int result;

    result = TCL_OK;
    dstLen -= TCL_UTF_MAX - 1;
    if (dstLen < 0) {
	dstLen = 0;
    }

    if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
	srcLen = *dstCharsPtr;
    }
    if (srcLen > dstLen) {
	srcLen = dstLen;
	result = TCL_CONVERT_NOSPACE;
    }

    int profile;

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= 6;
    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }

				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    int ch = 0, bytesLeft = srcLen % 4;


    flags |= PTR2INT(clientData);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

    /*

    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
    flags |= PTR2INT(clientData);

				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    unsigned short ch = 0;


    flags |= PTR2INT(clientData);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

    /*

    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd   = dst + dstLen - 2; /* 2 -> sizeof a UTF-16 code unit */
    flags |= PTR2INT(clientData);

				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars, len;
    Tcl_UniChar ch = 0;


    flags |= PTR2INT(clientData);
    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    const char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars, charLimit = INT_MAX;
    Tcl_UniChar ch = 0;
    const unsigned short *const *toUnicode;
    const unsigned short *pageZero;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;


    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;

    prefixBytes = dataPtr->prefixBytes;
    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

	}
	len = TclUtfToUniChar(src, &ch);

	/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
	if (ch & 0xFFFF0000) {
	    word = 0;
	} else {
	word = fromUnicode[(ch >> 8)][ch & 0xFF];
	}

	if ((word == 0) && (ch != 0)) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }

				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;


    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;

    const char *dstStart, *dstEnd;
    int result = TCL_OK, numChars;
    Tcl_UniChar ch = 0;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
    const unsigned short *const *tableToUnicode;
    const Encoding *encodingPtr;
    int state, result, numChars, charLimit = INT_MAX;
    const char *dstStart, *dstEnd;


    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;
    tablePrefixBytes = NULL;
    tableToUnicode = NULL;
    prefixBytes = dataPtr->prefixBytes;

    Tcl_UniChar ch = 0;

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

		"Internal error. Bad profile id \"%d\".",
		profileValue));
	Tcl_SetErrorCode(
	    interp, "TCL", "ENCODING", "PROFILEID", (void *)NULL);
    }
    return NULL;
}











































/*
 *------------------------------------------------------------------------
 *
 * TclGetEncodingProfiles --
 *
 *	Get the list of supported encoding profiles.

    /*
     * If a value is being set, call TclSetEnv to do all of the work.
     */

    if (flags & TCL_TRACE_WRITES) {
	const char *value;
	Tcl_DString ds;

	value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
	Tcl_DStringInit(&ds);
	if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, name2, -1, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return (char *) "encoding error";
	}
	if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, value, -1, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return (char *) "encoding error";
	}
	Tcl_DStringFree(&ds);
	TclSetEnv(name2, value);
	TclEnvEpoch++;
    }

    /*
     * If a value is being read, call TclGetEnv to do all of the work.
     */

    Tcl_Obj *const objv[],	/* Argument strings passed to Tcl_FileCmd. */
    int copyFlag)		/* If non-zero, copy source(s). Otherwise,
				 * rename them. */
{
    int i, result, force;
    Tcl_StatBuf statBuf;
    Tcl_Obj *target;
    Tcl_DString ds;

    i = FileForceOption(interp, objc - 1, objv + 1, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i++;
    if ((objc - i) < 2) {

     * than 2 arguments is only valid if the target is an existing directory.
     */

    target = objv[objc - 1];
    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(target),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);

    result = TCL_OK;

    /*
     * Call Tcl_FSStat() so that if target is a symlink that points to a
     * directory we will put the sources in that directory instead of
     * overwriting the symlink.

{
    Tcl_Obj *errfile = NULL;
    int result, i;
    Tcl_Size j, pobjc;
    Tcl_Obj *split = NULL;
    Tcl_Obj *target = NULL;
    Tcl_StatBuf statBuf;
    Tcl_DString ds;

    result = TCL_OK;
    for (i = 1; i < objc; i++) {
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    break;
	}
	if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[i]),
		TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    result = TCL_ERROR;
	    break;
	}
	Tcl_DStringFree(&ds);

	split = Tcl_FSSplitPath(objv[i], &pobjc);
	Tcl_IncrRefCount(split);
	if (pobjc == 0) {
	    errno = ENOENT;
	    errfile = objv[i];
	    break;

    Tcl_Interp *interp,		/* Used for error reporting */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    int i, force, result;
    Tcl_Obj *errfile;
    Tcl_Obj *errorBuffer = NULL;
    Tcl_DString ds;

    i = FileForceOption(interp, objc - 1, objv + 1, &force);
    if (i < 0) {
	return TCL_ERROR;
    }

    errfile = NULL;
    result = TCL_OK;

    for (i++ ; i < objc; i++) {
	Tcl_StatBuf statBuf;

	errfile = objv[i];
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[i]),
		TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    result = TCL_ERROR;
	    goto done;
	}
	Tcl_DStringFree(&ds);

	/*
	 * Call lstat() to get info so can delete symbolic link itself.
	 */

	if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
	    result = TCL_ERROR;

				 * exists. */
{
    int result;
    Tcl_Obj *errfile, *errorBuffer;
    Tcl_Obj *actualSource=NULL;	/* If source is a link, then this is the real
				 * file/directory. */
    Tcl_StatBuf sourceStatBuf, targetStatBuf;
    Tcl_DString ds;

    if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(source),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);
    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(target),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);

    errfile = NULL;
    errorBuffer = NULL;
    result = TCL_ERROR;

    /*
     * We want to copy/rename links and not the files they point to, so we use

{
    int result;
    const char *const *attributeStrings;
    const char **attributeStringsAllocated = NULL;
    Tcl_Obj *objStrings = NULL;
    Tcl_Size numObjStrings = TCL_INDEX_NONE;
    Tcl_Obj *filePtr;
    Tcl_DString ds;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
	return TCL_ERROR;
    }

    filePtr = objv[1];
    if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(filePtr),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);

    objc -= 2;
    objv += 2;
    result = TCL_ERROR;
    Tcl_SetErrno(0);

    /*

    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *contents;
    int index;
    Tcl_DString ds;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
	return TCL_ERROR;
    }

    /*

	    }
	} else {
	    linkAction = TCL_CREATE_SYMBOLIC_LINK | TCL_CREATE_HARD_LINK;
	}
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);

	/*
	 * Create link from source to target.
	 */

	contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
	if (contents == NULL) {

	    }
	    return TCL_ERROR;
	}
    } else {
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);

	/*
	 * Read link
	 */

	contents = Tcl_FSLink(objv[index], NULL, 0);
	if (contents == NULL) {

TclFileReadLinkCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *contents;
    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }

    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[1]),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&ds);

    contents = Tcl_FSLink(objv[1], NULL, 0);

    if (contents == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read link \"%s\": %s",
		TclGetString(objv[1]), Tcl_PosixError(interp)));

    case TCL_STDOUT:
	tsdPtr->stdoutInitialized = init;
	tsdPtr->stdoutChannel = channel;
	break;
    case TCL_STDERR:
	tsdPtr->stderrInitialized = init;
	tsdPtr->stderrChannel = channel;
	if (channel) {
	    ENCODING_PROFILE_SET(((Channel *)channel)->state->inputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
	    ENCODING_PROFILE_SET(((Channel *)channel)->state->outputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
	}
	break;
    }
}

/*
 *----------------------------------------------------------------------
 *

	channel = tsdPtr->stdoutChannel;
	break;
    case TCL_STDERR:
	if (!tsdPtr->stderrInitialized) {
	    tsdPtr->stderrInitialized = -1;
	    tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
	    if (tsdPtr->stderrChannel != NULL) {
		ENCODING_PROFILE_SET(((Channel *)tsdPtr->stderrChannel)->state->inputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
		ENCODING_PROFILE_SET(((Channel *)tsdPtr->stderrChannel)->state->outputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
		tsdPtr->stderrInitialized = 1;
		Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
	    }
	}
	channel = tsdPtr->stderrChannel;
	break;
    }

     * interpretation that Tcl_Channels give to the "-encoding binary" option.
     */

    name = Tcl_GetEncodingName(NULL);
    statePtr->encoding = Tcl_GetEncoding(NULL, name);
    statePtr->inputEncodingState  = NULL;
    statePtr->inputEncodingFlags  = TCL_ENCODING_START;


    statePtr->outputEncodingState = NULL;
    statePtr->outputEncodingFlags = TCL_ENCODING_START;



    /*
     * Set the channel up initially in AUTO input translation mode to accept
     * "\n", "\r" and "\r\n". Output translation mode is set to a platform
     * specific default value. The eofChar is set to 0 for both input and
     * output, so that Tcl does not look for an in-file EOF indicator (e.g.,
     * ^Z) and does not append an EOF indicator to files.

	return TCL_OK;
    } else if (HaveOpt(2, "-encoding")) {
	Tcl_Encoding encoding;
	int profile;

	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
	    encoding = Tcl_GetEncoding(NULL, "iso8859-1");






	} else {
	    encoding = Tcl_GetEncoding(interp, newValue);
	    if (encoding == NULL) {
		return TCL_ERROR;
	    }
	}

	    } else if (strcmp(readMode, "auto") == 0) {
		translation = TCL_TRANSLATE_AUTO;
	    } else if (strcmp(readMode, "binary") == 0) {
		translation = TCL_TRANSLATE_LF;
		statePtr->inEofChar = 0;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");






	    } else if (strcmp(readMode, "lf") == 0) {
		translation = TCL_TRANSLATE_LF;
	    } else if (strcmp(readMode, "cr") == 0) {
		translation = TCL_TRANSLATE_CR;
	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {

		} else {
		    statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
		}
	    } else if (strcmp(writeMode, "binary") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_LF;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");






	    } else if (strcmp(writeMode, "lf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_LF;
	    } else if (strcmp(writeMode, "cr") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CR;
	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {

    const char *native;

    if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
	/*
	 * Don't bother translating 'proto' to native.
	 */

	if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	sp = getservbyname(native, proto);		/* INTL: Native. */
	Tcl_DStringFree(&ds);
	if (sp != NULL) {
	    *portPtr = ntohs((unsigned short) sp->s_port);
	    return TCL_OK;
	}
    }

    struct addrinfo *v6head = NULL, *v6ptr = NULL;
    char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring;
    const char *family = NULL;
    Tcl_DString ds;
    int result;

    if (host != NULL) {
	if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) {
		Tcl_DStringFree(&ds);
	    return 0;
	}
	native = Tcl_DStringValue(&ds);
    }

    /*
     * Workaround for OSX's apparent inability to resolve "localhost", "0"
     * when the loopback device is the only available network interface.
     */

 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr,
	Tcl_Encoding *encodingPtr);

#ifdef _WIN32
#   define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */
#else
#   define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */
#endif

/*
 * A ProcessGlobalValue struct exists for each internal value in Tcl that is
 * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
 * the value, and the gobal value is kept as a counted string, with epoch and
 * mutex control. Each ProcessGlobalValue struct should be a static variable in
 * some file.
 */

 * Internal convenience macros for manipulating encoding flags. See
 * TCL_ENCODING_PROFILE_* in tcl.h
 *----------------------------------------------------------------------
 */

#define ENCODING_PROFILE_MASK     0xFF000000
#define ENCODING_PROFILE_GET(flags_)  ((flags_) & ENCODING_PROFILE_MASK)
#define ENCODING_PROFILE_SET(flags_, profile_)       \
    do {                                             \
	(flags_) &= ~ENCODING_PROFILE_MASK;              \
	(flags_) |= ((profile_) & ENCODING_PROFILE_MASK);\
    } while (0)

/*
 *----------------------------------------------------------------------
 * Common functions for calculating overallocation. Trivial but allows for
 * experimenting with growth factors without having to change code in
 * multiple places. See TclAttemptAllocElemsEx and similar for usage

MODULE_SCOPE Tcl_Encoding tclUtf8Encoding;
MODULE_SCOPE int
TclEncodingProfileNameToId(Tcl_Interp *interp,
			   const char *profileName,
			   int *profilePtr);
MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp,
						    int profileId);

MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp);

/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

    }

    /*
     * Convert to encoded form. Note that we use strlen() here; if someone's
     * crazy enough to embed NULs in filenames, they deserve what they get!
     */

    if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl, TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) {
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }
    zpathExt = Tcl_DStringValue(&zpathDs);
    zpathlen = strlen(zpathExt);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path too long for \"%s\"", TclGetString(pathObj)));
	ZIPFS_ERROR_CODE(interp, "PATH_LEN");
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;

	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    ret = TCL_ERROR;
	    goto done;
	}
	name = Tcl_DStringValue(&ds);
	len = Tcl_DStringLength(&ds);
	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
		z, len);
	if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
		!= ZIP_CENTRAL_HEADER_LEN)
		|| (Tcl_Write(out, name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(

	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)
	    if {[package vsatisfies [package provide Tcl] 9.0-]} {
		fconfigure $sock -profile replace
	    }
	    ##Log socket opened, DONE fconfigure - token $token
        }

        Log "Using $sock for $state(socketinfo) - token $token" \
	    [expr {$state(-keepalive)?"keepalive":""}]

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	fconfigure $sock -profile replace
    }

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET

    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	fconfigure $sock -profile replace
    }
    Log ^D$tk begin receiving response - token $token

    coroutine ${token}--EventCoroutine http::Event $sock $token
    if {[info exists state(-handler)] || [info exists state(-progress)]} {
        fileevent $sock readable [list http::EventGateway $sock $token]
    } else {

	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		if {[package vsatisfies [package provide Tcl] 9.0-]} {
		    set state(body) [encoding convertfrom -profile replace $enc $state(body)]
		} else {
		    set state(body) [encoding convertfrom $enc $state(body)]
		}
	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]

        }
    }
    set enc [CharsetToEncoding $res]
    if {$enc eq "binary"} {
        return 0
    }
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	set state(body) [encoding convertfrom -profile replace $enc $state(body)]
    } else {
	set state(body) [encoding convertfrom $enc $state(body)]
    }
    set state(body) [string map {\r\n \n \r \n} $state(body)]
    set state(type) application/xml
    set state(binary) 0
    set state(charset) $res

    variable formMap

    # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
    # a pre-computed map and [string map] to do the conversion (much faster
    # than [regsub]/[subst]). [Bug 1020491]

    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	set string [encoding convertto -profile replace $http(-urlencoding) $string]
    } else {
	set string [encoding convertto $http(-urlencoding) $string]
    }
    return [string map $formMap $string]
}

# http::ProxyRequired --

# This file contains test vectors for verifying various encodings. They are
# stored in a common file so that they can be sourced into the various test
# modules that are dependent on encodings. This file contains statically defined
# test vectors. In addition, it sources the ICU-generated test vectors from
# icuUcmTests.tcl.
#
# Note that sourcing the file will reinitialize any existing encoding test
# vectors.
#

# List of defined encoding profiles
set encProfiles {tcl8 strict replace}
set encDefaultProfile strict; # Should reflect the default from implementation

# encValidStrings - Table of valid strings.
#
# Each row is <ENCODING STR BYTES CTRL COMMENT>
# The pair <ENCODING,STR> should be unique for generated test ids to be unique.
# STR is a string that can be encoded in the encoding ENCODING resulting
# in the byte sequence BYTES. The CTRL field is a list that controls test

test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding utf-16
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile strict -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-eofchar {} -encoding utf-16 -profile tcl8
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
		-eofchar {} -encoding binary
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
test iocmd-8.11 {fconfigure command} -body {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -froboz blarfo

	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;
	const char *fileName = TclGetString(pathPtr);

	if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	/*
	 * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
	 */
	handle = dlopen(native, dlopenflags);
	Tcl_DStringFree(&ds);
    }

    /*
     * Some platforms still add an underscore to the beginning of symbol
     * names. If we can't find a name without an underscore, try again with
     * the underscore.
     */

    if (Tcl_UtfToExternalDStringEx(interp, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);
    proc = dlsym(handle, native);	/* INTL: Native. */
    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	native = Tcl_DStringAppend(&newName, native, TCL_INDEX_NONE);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);

    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativePath = (const char *)Tcl_FSGetNativePath(pathPtr);
    if (Tcl_UtfToExternalDStringEx(interp, NULL, TclGetString(pathPtr),
	    TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return TCL_ERROR;
    }
    nativeFileName = Tcl_DStringValue(&ds);

#if TCL_DYLD_USE_DLFCN
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     */

    if (flags & TCL_LOAD_GLOBAL) {

{
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;
    Tcl_LibraryInitProc *proc = NULL;
    const char *errMsg = NULL;
    Tcl_DString ds;
    const char *native;

    if (Tcl_UtfToExternalDStringEx(interp, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);
    if (dyldLoadHandle->dlHandle) {
#if TCL_DYLD_USE_DLFCN
	proc = (Tcl_LibraryInitProc *)dlsym(dyldLoadHandle->dlHandle, native);
	if (!proc) {
	    errMsg = dlerror();
	}
#endif /* TCL_DYLD_USE_DLFCN */

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <mach-o/rld.h>
#include <streams/streams.h>


/*
 * Static procedures defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		UnloadFile(Tcl_LoadHandle loadHandle);

/*
 *---------------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
 *	to the new code.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	New code suddenly appears in memory.
 *
 *---------------------------------------------------------------------------
 */

int
TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */

    result = rld_load(errorStream, &header, files, NULL);

    if (!result) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;

	if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	files = {native,NULL};
	result = rld_load(errorStream, &header, files, NULL);
	Tcl_DStringFree(&ds);
    }

    if (!result) {
	char *data;
	int len, maxlen;

	NXGetMemoryBuffer(errorStream, &data, &len, &maxlen);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	NXCloseMemory(errorStream, NX_FREEBUFFER);
	return TCL_ERROR;
    }
    NXCloseMemory(errorStream, NX_FREEBUFFER);

    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = INT2PTR(1);
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;

    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

 *
 * Side effects:
 *	Does nothing.  Can anything be done?
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_Free(loadHandle);
}

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <sys/types.h>
#include <loader.h>


/*
 * Static procedures defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		UnloadFile(Tcl_LoadHandle loadHandle);

/*
 *---------------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
 *	to the new code.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	New code suddenly appears in memory.
 *
 *---------------------------------------------------------------------------
 */

int
TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */

    Tcl_LoadHandle newHandle;
    ldr_module_t lm;
    char *pkg;
    char *fileName = TclGetString(pathPtr);
    const char *native;

    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    native = Tcl_FSGetNativePath(pathPtr);
    lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS);

    if (lm == LDR_NULL_MODULE) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path
	 */

	Tcl_DString ds;

	if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS);
	Tcl_DStringFree(&ds);
    }

    if (lm == LDR_NULL_MODULE) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",

    } else {
	pkg++;
    }
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = pkg;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    void *proc = ldr_lookup_package((char *) loadHandle, symbol);

    if (proc == NULL && interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\"", symbol));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL);
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 *

 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
 *	to the new code.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	New code suddenly appears in memory.
 *
 *---------------------------------------------------------------------------
 */

int
TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */

	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;

	if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L);
	Tcl_DStringFree(&ds);
    }

    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",

{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    int ret;
    Tcl_Obj *transPtr;

    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
    ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, 0, &srcString, NULL);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    if (ret != TCL_OK) {
	*errorPtr = srcPathPtr;
    } else {
	transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
	ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL);
	if (transPtr != NULL) {
	    Tcl_DecrRefCount(transPtr);
	}
	if (ret != TCL_OK) {
	    *errorPtr = destPathPtr;
	} else {
	    ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);
	    /* Note above call only sets ds on error */
	    if (ret != TCL_OK) {
		*errorPtr = Tcl_DStringToObj(&ds);
	    }
	    Tcl_DStringFree(&dstString);
	}
	Tcl_DStringFree(&srcString);
    }
    if (ret != TCL_OK) {


	Tcl_IncrRefCount(*errorPtr);
    }
    return ret;
}

/*
 *---------------------------------------------------------------------------

    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString pathString;
    int ret;
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

    ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_PROFILE_TCL8, &pathString, NULL);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    if (ret != TCL_OK) {
	*errorPtr = pathPtr;
    } else {
	ret = DoRemoveDirectory(&pathString, recursive, &ds);
	Tcl_DStringFree(&pathString);
	/* Note above call only sets ds on error */
	if (ret != TCL_OK) {
	    *errorPtr = Tcl_DStringToObj(&ds);
	}
    }

    if (ret != TCL_OK) {


	Tcl_IncrRefCount(*errorPtr);
    }
    return ret;
}

static int
DoRemoveDirectory(

    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    result = TCL_OK;
    if ((errno != EEXIST) || (recursive == 0)) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, errorPtr, NULL);
	}
	result = TCL_ERROR;
    }

    /*
     * The directory is nonempty, but the recursive flag has been specified,
     * so we recursively remove all the files in the directory.

	}
    }
#endif /* !HAVE_FTS */

  end:
    if (errfile != NULL) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, 0, errorPtr, NULL);
	}
	result = TCL_ERROR;
    }
#ifdef HAVE_FTS
    if (fts != NULL) {
	fts_close(fts);
    }

    /*
     * There shouldn't be a problem with src, because we already checked it to
     * get here.
     */

    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(dstPtr),
		Tcl_DStringLength(dstPtr), 0, errorPtr, NULL);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *

	if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) {
	    return TCL_OK;
	}
	break;
    }
    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(srcPtr),
		Tcl_DStringLength(srcPtr), 0, errorPtr, NULL);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
    } else {
	Tcl_DString ds;

	(void)Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds);
	*attributePtrPtr = Tcl_DStringToObj(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	Tcl_Size length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (groupPtr == NULL) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not set group for file \"%s\":"

	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	Tcl_Size length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (pwPtr == NULL) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not set owner for file \"%s\":"

 * Side effects:
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr,		/* An unshared object containing the path to
				 * normalize. */
    int nextCheckpoint)		/* offset to start at in pathPtr.  Must either
				 * be 0 or the offset of a directory separator
				 * at the end of a path part that is already
				 * normalized.  I.e. this is not the index of
				 * the byte just after the separator.  */

	/*
	 * Try to get the entire path in one go
	 */

	const char *lastDir = strrchr(currentPathEndPosition, '/');

	if (lastDir != NULL) {
	    if (Tcl_UtfToExternalDStringEx(interp, NULL, path,
		    lastDir-path, 0, &ds, NULL) != TCL_OK) {
		Tcl_DStringFree(&ds);
		return -1;
	    }
	    nativePath = Tcl_DStringValue(&ds);
	    if (Realpath(nativePath, normPath) != NULL) {
		if (*nativePath != '/' && *normPath == '/') {
		    /*
		     * realpath transformed a relative path into an
		     * absolute path.  Fall back to the long way.
		     */

	if ((cur == '/') && (path != currentPathEndPosition)) {
	    /*
	     * Reached directory separator.
	     */

	    int accessOk;

	    if (Tcl_UtfToExternalDStringEx(interp, NULL, path,
		    currentPathEndPosition - path, 0, &ds, NULL) != TCL_OK) {
		Tcl_DStringFree(&ds);
		return -1;
	    }
	    nativePath = Tcl_DStringValue(&ds);
	    accessOk = access(nativePath, F_OK);
	    Tcl_DStringFree(&ds);

	    if (accessOk != 0) {
		/*
		 * File doesn't exist.
		 */

	     * 'Realpath' transforms an empty string into the normalized pwd,
	     * which is the wrong answer.
	     */

	    return 0;
	}

	if (Tcl_UtfToExternalDStringEx(interp, NULL, path,nextCheckpoint, 0, &ds, NULL)) {
	    Tcl_DStringFree(&ds);
	    return -1;
	}
	nativePath = Tcl_DStringValue(&ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    Tcl_Size newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {

	    }

	    /*
	     * Free the original path and replace it with the normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, 0, &ds, NULL);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Append the remaining path components.
		 */

		int normLen = Tcl_DStringLength(&ds);

{
    Tcl_DString templ, tmp;
    const char *string;
    int fd;
    Tcl_Size length;

    /*
     * We should also check against making more than TMP_MAX of these.
     */

    if (dirObj) {
	string = Tcl_GetStringFromObj(dirObj, &length);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &templ, NULL) != TCL_OK) {
	    return -1;
	}
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = Tcl_GetStringFromObj(basenameObj, &length);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) {
	    Tcl_DStringFree(&tmp);
	    return -1;
	}
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = Tcl_GetStringFromObj(extensionObj, &length);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) {
	    Tcl_DStringFree(&templ);
	    return -1;
	}
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&templ));
    }

    if (fd == -1) {
	Tcl_DStringFree(&templ);
	return -1;
    }

    if (resultingNameObj) {
	if (Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
		Tcl_DStringLength(&templ), 0, &tmp, NULL) != TCL_OK) {
	    Tcl_DStringFree(&templ);
	    return -1;
	}
	Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else {
	/*
	 * Try to delete the file immediately since we're not reporting the
	 * name to anyone. Note that we're *not* handling any errors from

    /*
     * Build the template in writable memory from the user-supplied pieces and
     * some defaults.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, 0, &templ, NULL) != TCL_OK) {
	    return NULL;
	}
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') {
	TclDStringAppendLiteral(&templ, "/");
    }

    if (basenameObj) {
	string = TclGetString(basenameObj);
	if (basenameObj->length) {
	    if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, 0, &tmp, NULL) != TCL_OK) {
		Tcl_DStringFree(&templ);
		return NULL;
	    }
	    TclDStringAppendDString(&templ, &tmp);
	    Tcl_DStringFree(&tmp);
	} else {
	    TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
	}
    } else {
	TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);

	return NULL;
    }

    /*
     * The template has been updated. Tell the caller what it was.
     */

    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
	    Tcl_DStringLength(&templ), 0, &tmp, NULL) != TCL_OK) {
	Tcl_DStringFree(&templ);
	return NULL;
    }
    Tcl_DStringFree(&templ);
    return Tcl_DStringToObj(&tmp);
}

#if defined(__CYGWIN__)

static void

	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */

	if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);

	if ((TclOSstat(native, &statBuf) != 0)		/* INTL: Native. */
		|| !S_ISDIR(statBuf.st_mode)) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_OK;

	    }

	    /*
	     * Now check to see if the file matches, according to both type
	     * and pattern. If so, add the file to the result.
	     */

	    if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, TCL_INDEX_NONE,
		    0, &utfDs, NULL) != TCL_OK) {
		matchResult = -1;
		break;
	    }
	    utfname = Tcl_DStringValue(&utfDs);
	    if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
		int typeOk = 1;

		if (types != NULL) {
		    Tcl_DStringSetLength(&ds, nativeDirLen);
		    native = Tcl_DStringAppend(&ds, entryPtr->d_name, TCL_INDEX_NONE);
		    matchResult = NativeMatchType(interp, native,

TclpGetUserHome(
    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;

    if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);

    pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (pwPtr == NULL) {
	return NULL;
    }
    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) {
	return NULL;
    } else {
	return Tcl_DStringValue(bufferPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjAccess --
 *

	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error getting working directory name: %s",
		    Tcl_PosixError(interp)));
	}
	return NULL;
    }
    if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) {
	return NULL;
    }
    return Tcl_DStringValue(bufferPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpReadlink --
 *

TclpReadlink(
    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];
    Tcl_Size length;
    const char *native;
    Tcl_DString ds;

    if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);
    length = readlink(native, link, sizeof(link));	/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (length < 0) {
	return NULL;
    }

    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, NULL) == TCL_OK) {
	return Tcl_DStringValue(linkPtr);
    }
#endif /* !DJGPP */

    return NULL;

}

/*
 *----------------------------------------------------------------------
 *
 * TclpObjStat --
 *

	     */

	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
	    if (transPtr == NULL) {
		return NULL;
	    }
	    target = Tcl_GetStringFromObj(transPtr, &length);
	    if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, NULL) != TCL_OK) {
		Tcl_DStringFree(&ds);
		return NULL;
	    }
	    target = Tcl_DStringValue(&ds);
	    Tcl_DecrRefCount(transPtr);

	    if (symlink(target, src) != 0) {
		toPtr = NULL;
	    }
	    Tcl_DStringFree(&ds);
	} else if (linkAction & TCL_CREATE_HARD_LINK) {

	Tcl_DecrRefCount(transPtr);

	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, &ds, NULL) != TCL_OK) {
	    return NULL;
	}
	linkPtr = Tcl_DStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
	return linkPtr;
    }
}
#endif /* S_IFLNK */


	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetStringFromObj(validPathPtr, &len);
    if (Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, 0, &ds, NULL) != TCL_OK) {
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }
    len = Tcl_DStringLength(&ds) + sizeof(char);
    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
	/* See bug [3118489]: NUL in filenames */
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }

    const char *fname,		/* The name of the file to open. */
    int mode)			/* In what mode to open the file? */
{
    int fd;
    const char *native;
    Tcl_DString ds;

    if (Tcl_UtfToExternalDStringEx(NULL, NULL, fname, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);
    fd = TclOSopen(native, mode, 0666);			/* INTL: Native. */
    Tcl_DStringFree(&ds);
    if (fd != -1) {
	fcntl(fd, F_SETFD, FD_CLOEXEC);

	/*
	 * If the file is being opened for writing, seek to the end so we can

	return NULL;
    }
    fcntl(fd, F_SETFD, FD_CLOEXEC);
    if (contents != NULL) {
	Tcl_DString dstring;
	char *native;

	if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) {
	    close(fd);
	    Tcl_DStringFree(&dstring);
	    return NULL;
	}
	native = Tcl_DStringValue(&dstring);
	if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) {
	    close(fd);
	    Tcl_DStringFree(&dstring);
	    return NULL;
	}
	Tcl_DStringFree(&dstring);
	TclOSseek(fd, 0, SEEK_SET);

     * deallocated later
     */

    dsArray = (Tcl_DString *)TclStackAlloc(interp, argc * sizeof(Tcl_DString));
    newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *));
    newArgv[argc] = NULL;
    for (i = 0; i < argc; i++) {
	if (Tcl_UtfToExternalDStringEx(interp, NULL, argv[i], TCL_INDEX_NONE, 0, &dsArray[i], NULL) != TCL_OK) {
	    while (i-- > 0) {
		Tcl_DStringFree(&dsArray[i]);
	    }
	    TclStackFree(interp, newArgv);
	    TclStackFree(interp, dsArray);
	    goto error;
	}
	newArgv[i] = Tcl_DStringValue(&dsArray[i]);
    }

#if defined(HAVE_VFORK) || defined(HAVE_POSIX_SPAWNP)
    /*
     * After vfork(), do not call code in the child that changes global state,
     * because it is using the parent's memory space at that point and writes
     * might corrupt the parent: so ensure standard channels are initialized

 */

TclFile
TclpCreateTempFile(
    const char *contents)	/* String to write into temp file, or NULL. */
{
    WCHAR name[MAX_PATH];
    const char *native = NULL;
    Tcl_DString dstring;
    HANDLE handle;

    if (TempFileName(name) == 0) {
	return NULL;
    }

	const char *p;
	int toCopy;

	/*
	 * Convert the contents from UTF to native encoding
	 */

	if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) {
	   goto error;
	}
	native = Tcl_DStringValue(&dstring);

	toCopy = Tcl_DStringLength(&dstring);
	for (p = native; toCopy > 0; p++, toCopy--) {
	    if (*p == '\n') {
		length = p - native;
		if (length > 0) {
		    if (!WriteFile(handle, native, length, &result, NULL)) {

     * Free the native representation of the contents if necessary.
     */

    if (contents != NULL) {
	Tcl_DStringFree(&dstring);
    }

    if (native != NULL) {
	Tcl_WinConvertError(GetLastError());
    }
    CloseHandle(handle);
    DeleteFileW(name);
    return NULL;
}

/*
 *----------------------------------------------------------------------