/* 

 * tclEnv.c --

 *

 *	Tcl support for environment variables, including a setenv

 *	procedure.  This file contains the generic portion of the

 *	environment module.  It is primarily responsible for keeping

 *	the "env" arrays in sync with the system environment variables.

 *

 * Copyright (c) 1991-1994 The Regents of the University of California.

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 *

 * See the file "license.terms" for information on usage and redistribution

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

 *

 * RCS: @(#) $Id: tclEnv.c,v 1.20.2.3 2006/10/31 22:25:08 das Exp $

 */

#include "tclInt.h"

#include "tclPort.h"

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ */

static int cacheSize = 0;	/* Number of env strings in environCache. */

static char **environCache = NULL;

				/* Array containing all of the environment

				 * strings that Tcl has allocated. */

#ifndef USE_PUTENV

static char **ourEnviron = NULL;/* Cache of the array that we allocate.

				 * We need to track this in case another

				 * subsystem swaps around the environ array

				 * like we do.

				 */

static int environSize = 0;	/* Non-zero means that the environ array was

				 * malloced and has this many total entries

				 * allocated to it (not all may be in use at

				 * once).  Zero means that the environment

				 * array is in its original static state. */

#endif

/*

 * For MacOS X

 */

#if defined(__APPLE__) && defined(__DYNAMIC__)

#include <crt_externs.h>

__private_extern__ char **environ;

char **environ = NULL;

#endif

/*

 * Declarations for local procedures defined in this file:

 */

static char *		EnvTraceProc _ANSI_ARGS_((ClientData clientData,

			    Tcl_Interp *interp, CONST char *name1, 

			    CONST char *name2, int flags));

static void		ReplaceString _ANSI_ARGS_((CONST char *oldStr,

			    char *newStr));

void			TclSetEnv _ANSI_ARGS_((CONST char *name,

			    CONST char *value));

void			TclUnsetEnv _ANSI_ARGS_((CONST char *name));

#if defined (__CYGWIN__) && defined(__WIN32__)

static void		TclCygwinPutenv _ANSI_ARGS_((CONST char *string));

#endif

/*

 *----------------------------------------------------------------------

 *

 * TclSetupEnv --

 *

 *	This procedure is invoked for an interpreter to make environment

 *	variables accessible from that interpreter via the "env"

 *	associative array.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	The interpreter is added to a list of interpreters managed

 *	by us, so that its view of envariables can be kept consistent

 *	with the view in other interpreters.  If this is the first

 *	call to TclSetupEnv, then additional initialization happens,

 *	such as copying the environment to dynamically-allocated space

 *	for ease of management.

 *

 *----------------------------------------------------------------------

 */

void

TclSetupEnv(interp)

    Tcl_Interp *interp;		/* Interpreter whose "env" array is to be

				 * managed. */

{

    Tcl_DString envString;

    char *p1, *p2;

    int i;

    /*

     * For MacOS X

     */

#if defined(__APPLE__) && defined(__DYNAMIC__)

    environ = *_NSGetEnviron();

#endif

    /*

     * Synchronize the values in the environ array with the contents

     * of the Tcl "env" variable.  To do this:

     *    1) Remove the trace that fires when the "env" var is unset.

     *    2) Unset the "env" variable.

     *    3) If there are no environ variables, create an empty "env"

     *       array.  Otherwise populate the array with current values.

     *    4) Add a trace that synchronizes the "env" array.

     */

    Tcl_UntraceVar2(interp, "env", (char *) NULL,

	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |

	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,

	    (ClientData) NULL);

    Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 

    if (environ[0] == NULL) {

	Tcl_Obj *varNamePtr;

	varNamePtr = Tcl_NewStringObj("env", -1);

	Tcl_IncrRefCount(varNamePtr);

	TclArraySet(interp, varNamePtr, NULL);	

	Tcl_DecrRefCount(varNamePtr);

    } else {

	Tcl_MutexLock(&envMutex);

	for (i = 0; environ[i] != NULL; i++) {

	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);

	    p2 = strchr(p1, '=');

	    if (p2 == NULL) {

		/*

		 * This condition seem to happen occasionally under some

		 * versions of Solaris; ignore the entry.

		 */

		continue;

	    }

	    p2++;

	    p2[-1] = '\0';

	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);	

	    Tcl_DStringFree(&envString);

	}

	Tcl_MutexUnlock(&envMutex);

    }

    Tcl_TraceVar2(interp, "env", (char *) NULL,

	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |

	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,

	    (ClientData) NULL);

}

/*

 *----------------------------------------------------------------------

 *

 * TclSetEnv --

 *

 *	Set an environment variable, replacing an existing value

 *	or creating a new variable if there doesn't exist a variable

 *	by the given name.  This procedure is intended to be a

 *	stand-in for the  UNIX "setenv" procedure so that applications

 *	using that procedure will interface properly to Tcl.  To make

 *	it a stand-in, the Makefile must define "TclSetEnv" to "setenv".

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	The environ array gets updated.

 *

 *----------------------------------------------------------------------

 */

void

TclSetEnv(name, value)

    CONST char *name;		/* Name of variable whose value is to be

				 * set (UTF-8). */

    CONST char *value;		/* New value for variable (UTF-8). */

{

    Tcl_DString envString;

    int index, length, nameLength;

    char *p, *oldValue;

    CONST char *p2;

    /*

     * Figure out where the entry is going to go.  If the name doesn't

     * already exist, enlarge the array if necessary to make room.  If the

     * name exists, free its old entry.

     */

    Tcl_MutexLock(&envMutex);

    index = TclpFindVariable(name, &length);

    if (index == -1) {

#ifndef USE_PUTENV

	/*

	 * We need to handle the case where the environment may be changed

	 * outside our control.  environSize is only valid if the current

	 * environment is the one we allocated. [Bug 979640]

	 */

	if ((ourEnviron != environ) || ((length + 2) > environSize)) {

	    char **newEnviron;

	    newEnviron = (char **) ckalloc((unsigned)

		    ((length + 5) * sizeof(char *)));

	    memcpy((VOID *) newEnviron, (VOID *) environ,

		    length*sizeof(char *));

	    if ((environSize != 0) && (ourEnviron != NULL)) {

		ckfree((char *) ourEnviron);

	    }

	    environ = ourEnviron = newEnviron;

	    environSize = length + 5;

#if defined(__APPLE__) && defined(__DYNAMIC__)

	    {

	    char ***e = _NSGetEnviron();

	    *e = environ;

	    }

#endif

	}

	index = length;

	environ[index + 1] = NULL;

#endif

	oldValue = NULL;

	nameLength = strlen(name);

    } else {

	CONST char *env;

	/*

	 * Compare the new value to the existing value.  If they're

	 * the same then quit immediately (e.g. don't rewrite the

	 * value or propagate it to other interpreters).  Otherwise,

	 * when there are N interpreters there will be N! propagations

	 * of the same value among the interpreters.

	 */

	env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);

	if (strcmp(value, (env + length + 1)) == 0) {

	    Tcl_DStringFree(&envString);

	    Tcl_MutexUnlock(&envMutex);

	    return;

	}

	Tcl_DStringFree(&envString);

	oldValue = environ[index];

	nameLength = length;

    }

    /*

     * Create a new entry.  Build a complete UTF string that contains

     * a "name=value" pattern.  Then convert the string to the native

     * encoding, and set the environ array value.

     */

    p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));

    strcpy(p, name);

    p[nameLength] = '=';

    strcpy(p+nameLength+1, value);

    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*

     * Copy the native string to heap memory.

     */

    p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));

    strcpy(p, p2);

    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV

    /*

     * Update the system environment.

     */

    putenv(p);

    index = TclpFindVariable(name, &length);

#else

    environ[index] = p;

#endif

    /*

     * Watch out for versions of putenv that copy the string (e.g. VC++).

     * In this case we need to free the string immediately.  Otherwise

     * update the string in the cache.

     */

    if ((index != -1) && (environ[index] == p)) {

	ReplaceString(oldValue, p);

#ifdef HAVE_PUTENV_THAT_COPIES

    } else {

	/* This putenv() copies instead of taking ownership */

	ckfree(p);

#endif

    }

    Tcl_MutexUnlock(&envMutex);

    if (!strcmp(name, "HOME")) {

	/* 

	 * If the user's home directory has changed, we must invalidate

	 * the filesystem cache, because '~' expansions will now be

	 * incorrect.

	 */

        Tcl_FSMountsChanged(NULL);

    }

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_PutEnv --

 *

 *	Set an environment variable.  Similar to setenv except that

 *	the information is passed in a single string of the form

 *	NAME=value, rather than as separate name strings.  This procedure

 *	is intended to be a stand-in for the  UNIX "putenv" procedure

 *	so that applications using that procedure will interface

 *	properly to Tcl.  To make it a stand-in, the Makefile will

 *	define "Tcl_PutEnv" to "putenv".

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	The environ array gets updated, as do all of the interpreters

 *	that we manage.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C int

Tcl_PutEnv(string)

    CONST char *string;		/* Info about environment variable in the

				 * form NAME=value. (native) */

{

    Tcl_DString nameString;   

    CONST char *name;

    char *value;

    if (string == NULL) {

	return 0;

    }

    /*

     * First convert the native string to UTF.  Then separate the

     * string into name and value parts, and call TclSetEnv to do

     * all of the real work.

     */

    name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);

    value = strchr(name, '=');

    if ((value != NULL) && (value != name)) {

	value[0] = '\0';

	TclSetEnv(name, value+1);

    }

    Tcl_DStringFree(&nameString);

    return 0;

}

/*

 *----------------------------------------------------------------------

 *

 * TclUnsetEnv --

 *

 *	Remove an environment variable, updating the "env" arrays

 *	in all interpreters managed by us.  This function is intended

 *	to replace the UNIX "unsetenv" function (but to do this the

 *	Makefile must be modified to redefine "TclUnsetEnv" to

 *	"unsetenv".

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	Interpreters are updated, as is environ.

 *

 *----------------------------------------------------------------------

 */

void

TclUnsetEnv(name)

    CONST char *name;		/* Name of variable to remove (UTF-8). */

{

    char *oldValue;

    int length;

    int index;

#ifdef USE_PUTENV_FOR_UNSET

    Tcl_DString envString;

    char *string;

#else

    char **envPtr;

#endif

    Tcl_MutexLock(&envMutex);

    index = TclpFindVariable(name, &length);

    /*

     * First make sure that the environment variable exists to avoid

     * doing needless work and to avoid recursion on the unset.

     */

    if (index == -1) {

	Tcl_MutexUnlock(&envMutex);

	return;

    }

    /*

     * Remember the old value so we can free it if Tcl created the string.

     */

    oldValue = environ[index];

    /*

     * Update the system environment.  This must be done before we 

     * update the interpreters or we will recurse.

     */

#ifdef USE_PUTENV_FOR_UNSET

    /*

     * For those platforms that support putenv to unset, Linux indicates

     * that no = should be included, and Windows requires it.

     */

#ifdef WIN32

    string = ckalloc((unsigned int) length+2);

    memcpy((VOID *) string, (VOID *) name, (size_t) length);

    string[length] = '=';

    string[length+1] = '\0';

#else

    string = ckalloc((unsigned int) length+1);

    memcpy((VOID *) string, (VOID *) name, (size_t) length);

    string[length] = '\0';

#endif

    Tcl_UtfToExternalDString(NULL, string, -1, &envString);

    string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));

    strcpy(string, Tcl_DStringValue(&envString));

    Tcl_DStringFree(&envString);

    putenv(string);

    /*

     * Watch out for versions of putenv that copy the string (e.g. VC++).

     * In this case we need to free the string immediately.  Otherwise

     * update the string in the cache.

     */

    if (environ[index] == string) {

	ReplaceString(oldValue, string);

#ifdef HAVE_PUTENV_THAT_COPIES

    } else {

	/* This putenv() copies instead of taking ownership */

	ckfree(string);

#endif

    }

#else

    for (envPtr = environ+index+1; ; envPtr++) {

	envPtr[-1] = *envPtr;

	if (*envPtr == NULL) {

	    break;

	}

    }

    ReplaceString(oldValue, NULL);

#endif

    Tcl_MutexUnlock(&envMutex);

}

/*

 *---------------------------------------------------------------------------

 *

 * TclGetEnv --

 *

 *	Retrieve the value of an environment variable.

 *

 * Results:

 *	The result is a pointer to a string specifying the value of the

 *	environment variable, or NULL if that environment variable does

 *	not exist.  Storage for the result string is allocated in valuePtr;

 *	the caller must call Tcl_DStringFree() when the result is no

 *	longer needed.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

CONST char *

TclGetEnv(name, valuePtr)

    CONST char *name;		/* Name of environment variable to find

				 * (UTF-8). */

    Tcl_DString *valuePtr;	/* Uninitialized or free DString in which

				 * the value of the environment variable is

				 * stored. */

{

    int length, index;

    CONST char *result;

    Tcl_MutexLock(&envMutex);

    index = TclpFindVariable(name, &length);

    result = NULL;

    if (index != -1) {

	Tcl_DString envStr;

	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);

	result += length;

	if (*result == '=') {

	    result++;

	    Tcl_DStringInit(valuePtr);

	    Tcl_DStringAppend(valuePtr, result, -1);

	    result = Tcl_DStringValue(valuePtr);

	} else {

	    result = NULL;

	}

	Tcl_DStringFree(&envStr);

    }

    Tcl_MutexUnlock(&envMutex);

    return result;

}

/*

 *----------------------------------------------------------------------

 *

 * EnvTraceProc --