/* 

 * tclPipe.c --

 *

 *	This file contains the generic portion of the command channel

 *	driver as well as various utility routines used in managing

 *	subprocesses.

 *

 * Copyright (c) 1997 by Sun Microsystems, Inc.

 * Portions Copyright (c) 2007-2009 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: tclPipe.c,v 1.7.2.5 2006/03/16 00:35:58 andreas_kupries Exp $

 */

#include "tclInt.h"

#include "tclPort.h"

#if defined(__SYMBIAN32__)    

#include "tclSymbianGlobals.h"

#include <sys/select.h>

/*

 * The following macros convert between TclFile's and fd's.  The conversion

 * simple involves shifting fd's up by one to ensure that no valid fd is ever

 * the same as NULL.  Note that this code is duplicated from tclUnixPipe.c

 */

#define MakeFile(fd) ((TclFile)((fd)+1))

#define GetFd(file) (((int)file)-1)

#endif

/*

 * A linked list of the following structures is used to keep track

 * of child processes that have been detached but haven't exited

 * yet, so we can make sure that they're properly "reaped" (officially

 * waited for) and don't lie around as zombies cluttering the

 * system.

 */

typedef struct Detached {

    Tcl_Pid pid;			/* Id of process that's been detached

					 * but isn't known to have exited. */

    struct Detached *nextPtr;		/* Next in list of all detached

					 * processes. */

} Detached;

static Detached *detList = NULL;	/* List of all detached proceses. */

TCL_DECLARE_MUTEX(pipeMutex)		/* Guard access to detList. */

/*

 * Declarations for local procedures defined in this file:

 */

static TclFile	FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,

	            CONST char *spec, int atOk, CONST char *arg, 

		    CONST char *nextArg, int flags, int *skipPtr,

		    int *closePtr, int *releasePtr));

/*

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

 *

 * FileForRedirect --

 *

 *	This procedure does much of the work of parsing redirection

 *	operators.  It handles "@" if specified and allowed, and a file

 *	name, and opens the file if necessary.

 *

 * Results:

 *	The return value is the descriptor number for the file.  If an

 *	error occurs then NULL is returned and an error message is left

 *	in the interp's result.  Several arguments are side-effected; see

 *	the argument list below for details.

 *

 * Side effects:

 *	None.

 *

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

 */

static TclFile

FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,

	releasePtr)

    Tcl_Interp *interp;		/* Intepreter to use for error reporting. */

    CONST char *spec;		/* Points to character just after

				 * redirection character. */

    int atOK;			/* Non-zero means that '@' notation can be 

				 * used to specify a channel, zero means that

				 * it isn't. */

    CONST char *arg;		/* Pointer to entire argument containing 

				 * spec:  used for error reporting. */

    CONST char *nextArg;	/* Next argument in argc/argv array, if needed 

				 * for file name or channel name.  May be 

				 * NULL. */

    int flags;			/* Flags to use for opening file or to 

				 * specify mode for channel. */

    int *skipPtr;		/* Filled with 1 if redirection target was

				 * in spec, 2 if it was in nextArg. */

    int *closePtr;		/* Filled with one if the caller should 

				 * close the file when done with it, zero

				 * otherwise. */

    int *releasePtr;

{

    int writing = (flags & O_WRONLY);

    Tcl_Channel chan;

    TclFile file;

    *skipPtr = 1;

    if ((atOK != 0)  && (*spec == '@')) {

	spec++;

	if (*spec == '\0') {

	    spec = nextArg;

	    if (spec == NULL) {

		goto badLastArg;

	    }

	    *skipPtr = 2;

	}

        chan = Tcl_GetChannel(interp, spec, NULL);

        if (chan == (Tcl_Channel) NULL) {

            return NULL;

        }

	file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);

        if (file == NULL) {

	    Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),

		    "\" wasn't opened for ",

		    ((writing) ? "writing" : "reading"), (char *) NULL);

            return NULL;

        }

	*releasePtr = 1;

	if (writing) {

	    /*

	     * Be sure to flush output to the file, so that anything

	     * written by the child appears after stuff we've already

	     * written.

	     */

            Tcl_Flush(chan);

	}

    } else {

	CONST char *name;

	Tcl_DString nameString;

	if (*spec == '\0') {

	    spec = nextArg;

	    if (spec == NULL) {

		goto badLastArg;

	    }

	    *skipPtr = 2;

	}

	name = Tcl_TranslateFileName(interp, spec, &nameString);

	if (name == NULL) {

	    return NULL;

	}

	file = TclpOpenFile(name, flags);

	Tcl_DStringFree(&nameString);

	if (file == NULL) {

	    Tcl_AppendResult(interp, "couldn't ",

		    ((writing) ? "write" : "read"), " file \"", spec, "\": ",

		    Tcl_PosixError(interp), (char *) NULL);

	    return NULL;

	}

        *closePtr = 1;

    }

    return file;

    badLastArg:

    Tcl_AppendResult(interp, "can't specify \"", arg,

	    "\" as last word in command", (char *) NULL);

    return NULL;

}

/*

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

 *

 * Tcl_DetachPids --

 *

 *	This procedure is called to indicate that one or more child

 *	processes have been placed in background and will never be

 *	waited for;  they should eventually be reaped by

 *	Tcl_ReapDetachedProcs.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	None.

 *

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

 */

EXPORT_C void

Tcl_DetachPids(numPids, pidPtr)

    int numPids;		/* Number of pids to detach:  gives size

				 * of array pointed to by pidPtr. */

    Tcl_Pid *pidPtr;		/* Array of pids to detach. */

{

    register Detached *detPtr;

    int i;

    Tcl_MutexLock(&pipeMutex);

    for (i = 0; i < numPids; i++) {

	detPtr = (Detached *) ckalloc(sizeof(Detached));

	detPtr->pid = pidPtr[i];

	detPtr->nextPtr = detList;

	detList = detPtr;

    }

    Tcl_MutexUnlock(&pipeMutex);

}

/*

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

 *

 * Tcl_ReapDetachedProcs --

 *

 *	This procedure checks to see if any detached processes have

 *	exited and, if so, it "reaps" them by officially waiting on

 *	them.  It should be called "occasionally" to make sure that

 *	all detached processes are eventually reaped.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	Processes are waited on, so that they can be reaped by the

 *	system.

 *

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

 */

EXPORT_C void

Tcl_ReapDetachedProcs()

{

    register Detached *detPtr;

    Detached *nextPtr, *prevPtr;

    int status;

    Tcl_Pid pid;

    Tcl_MutexLock(&pipeMutex);

    for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {

	pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);

	if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {

	    prevPtr = detPtr;

	    detPtr = detPtr->nextPtr;

	    continue;

	}

	nextPtr = detPtr->nextPtr;

	if (prevPtr == NULL) {

	    detList = detPtr->nextPtr;

	} else {

	    prevPtr->nextPtr = detPtr->nextPtr;

	}

	ckfree((char *) detPtr);

	detPtr = nextPtr;

    }

    Tcl_MutexUnlock(&pipeMutex);

}

/*

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

 *

 * TclCleanupChildren --

 *

 *	This is a utility procedure used to wait for child processes

 *	to exit, record information about abnormal exits, and then

 *	collect any stderr output generated by them.

 *

 * Results:

 *	The return value is a standard Tcl result.  If anything at

 *	weird happened with the child processes, TCL_ERROR is returned

 *	and a message is left in the interp's result.

 *

 * Side effects:

 *	If the last character of the interp's result is a newline, then it

 *	is removed unless keepNewline is non-zero.  File errorId gets

 *	closed, and pidPtr is freed back to the storage allocator.

 *

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

 */

int

TclCleanupChildren(interp, numPids, pidPtr, errorChan)

    Tcl_Interp *interp;		/* Used for error messages. */

    int numPids;		/* Number of entries in pidPtr array. */

    Tcl_Pid *pidPtr;		/* Array of process ids of children. */

    Tcl_Channel errorChan;	/* Channel for file containing stderr output

				 * from pipeline.  NULL means there isn't any

				 * stderr output. */

{

    int result = TCL_OK;

    int i, abnormalExit, anyErrorInfo;

    Tcl_Pid pid;

    WAIT_STATUS_TYPE waitStatus;

    CONST char *msg;

    unsigned long resolvedPid;

    abnormalExit = 0;

    for (i = 0; i < numPids; i++) {

	/*

	 * We need to get the resolved pid before we wait on it as

	 * the windows implimentation of Tcl_WaitPid deletes the

	 * information such that any following calls to TclpGetPid

	 * fail.

	 */

	resolvedPid = TclpGetPid(pidPtr[i]);

        pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);

	if (pid == (Tcl_Pid) -1) {

	    result = TCL_ERROR;

            if (interp != (Tcl_Interp *) NULL) {

                msg = Tcl_PosixError(interp);

                if (errno == ECHILD) {

		    /*

                     * This changeup in message suggested by Mark Diekhans

                     * to remind people that ECHILD errors can occur on

                     * some systems if SIGCHLD isn't in its default state.

                     */

#ifdef __SYMBIAN32__  

					// change message to remove all references to signals.				

                    msg =

                        "child process lost.";

#else

                    msg =

                        "child process lost (is SIGCHLD ignored or trapped?)";

#endif                                             

                }

                Tcl_AppendResult(interp, "error waiting for process to exit: ",

                        msg, (char *) NULL);

            }

	    continue;

	}

	/*

	 * Create error messages for unusual process exits.  An

	 * extra newline gets appended to each error message, but

	 * it gets removed below (in the same fashion that an

	 * extra newline in the command's output is removed).

	 */	 

#ifdef __SYMBIAN32__  

	// process the return status of the child.

	if (waitStatus != 0) {

	    char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];

	    result = TCL_ERROR;

	    TclFormatInt(msg1, (long) resolvedPid);

	    	if (waitStatus < 0) {

                if (interp != (Tcl_Interp *) NULL) {

	    			TclFormatInt(msg2, (long) waitStatus);

                    Tcl_AppendResult(interp,

                            "child wait status is error (pid ", msg1, ") status: ", msg2,

                            (char *) NULL);

                }

	    	} else { 

                if (interp != (Tcl_Interp *) NULL) {

	    			TclFormatInt(msg2, (long) waitStatus);

                    Tcl_SetErrorCode(interp, "CHILDSTATUS (pid: ", msg1, ") status: ", msg2,

                            (char *) NULL);

                }

			abnormalExit = 1;

	    	}

#else

	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {

	    char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];

	    result = TCL_ERROR;

	    TclFormatInt(msg1, (long) resolvedPid);

	    if (WIFEXITED(waitStatus)) {

                if (interp != (Tcl_Interp *) NULL) {

		    TclFormatInt(msg2, WEXITSTATUS(waitStatus));

                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,

                            (char *) NULL);

                }

		abnormalExit = 1;

	    } else if (WIFSIGNALED(waitStatus)) {

                if (interp != (Tcl_Interp *) NULL) {

                    CONST char *p;

                    p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));

                    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,

                            Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,

                            (char *) NULL);

                    Tcl_AppendResult(interp, "child killed: ", p, "\n",

                            (char *) NULL);

                }

	    } else if (WIFSTOPPED(waitStatus)) {

                if (interp != (Tcl_Interp *) NULL) {

                    CONST char *p;

                    p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));

                    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,

                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))),

                            p, (char *) NULL);

                    Tcl_AppendResult(interp, "child suspended: ", p, "\n",

                            (char *) NULL);

                }

	    } else {

                if (interp != (Tcl_Interp *) NULL) {

                    Tcl_AppendResult(interp,

                            "child wait status didn't make sense\n",

                            (char *) NULL);

                }

	    }

#endif	    

	}

    }

    /*

     * Read the standard error file.  If there's anything there,

     * then return an error and add the file's contents to the result

     * string.

     */

    anyErrorInfo = 0;

    if (errorChan != NULL) {

	/*

	 * Make sure we start at the beginning of the file.

	 */

        if (interp != NULL) {

	    int count;

	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);

	    objPtr = Tcl_NewObj();

	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);

	    if (count < 0) {

		result = TCL_ERROR;

		Tcl_DecrRefCount(objPtr);

		Tcl_ResetResult(interp);

		Tcl_AppendResult(interp, "error reading stderr output file: ",

			Tcl_PosixError(interp), NULL);

	    } else if (count > 0) {

		anyErrorInfo = 1;

		Tcl_SetObjResult(interp, objPtr);

		result = TCL_ERROR;

	    } else {

		Tcl_DecrRefCount(objPtr);

	    }

	}

	Tcl_Close(NULL, errorChan);

    }

    /*

     * If a child exited abnormally but didn't output any error information

     * at all, generate an error message here.

     */

    if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {

	Tcl_AppendResult(interp, "child process exited abnormally",

		(char *) NULL);

    }

    return result;

}

/*

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

 *

 * TclCreatePipeline --

 *

 *	Given an argc/argv array, instantiate a pipeline of processes

 *	as described by the argv.

 *

 *	This procedure is unofficially exported for use by BLT.

 *

 * Results:

 *	The return value is a count of the number of new processes

 *	created, or -1 if an error occurred while creating the pipeline.

 *	*pidArrayPtr is filled in with the address of a dynamically

 *	allocated array giving the ids of all of the processes.  It

 *	is up to the caller to free this array when it isn't needed

 *	anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in

 *	with the file id for the input pipe for the pipeline (if any):

 *	the caller must eventually close this file.  If outPipePtr

 *	isn't NULL, then *outPipePtr is filled in with the file id

 *	for the output pipe from the pipeline:  the caller must close

 *	this file.  If errFilePtr isn't NULL, then *errFilePtr is filled

 *	with a file id that may be used to read error output after the

 *	pipeline completes.

 *

 * Side effects:

 *	Processes and pipes are created.

 *

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

 */

int

TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,

	outPipePtr, errFilePtr)

    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */

    int argc;			/* Number of entries in argv. */

    CONST char **argv;		/* Array of strings describing commands in

				 * pipeline plus I/O redirection with <,

				 * <<,  >, etc.  Argv[argc] must be NULL. */

    Tcl_Pid **pidArrayPtr;	/* Word at *pidArrayPtr gets filled in with

				 * address of array of pids for processes

				 * in pipeline (first pid is first process

				 * in pipeline). */

    TclFile *inPipePtr;		/* If non-NULL, input to the pipeline comes

				 * from a pipe (unless overridden by

				 * redirection in the command).  The file

				 * id with which to write to this pipe is

				 * stored at *inPipePtr.  NULL means command

				 * specified its own input source. */

    TclFile *outPipePtr;	/* If non-NULL, output to the pipeline goes

				 * to a pipe, unless overriden by redirection

				 * in the command.  The file id with which to

				 * read frome this pipe is stored at

				 * *outPipePtr.  NULL means command specified

				 * its own output sink. */

    TclFile *errFilePtr;	/* If non-NULL, all stderr output from the

				 * pipeline will go to a temporary file

				 * created here, and a descriptor to read

				 * the file will be left at *errFilePtr.

				 * The file will be removed already, so

				 * closing this descriptor will be the end

				 * of the file.  If this is NULL, then

				 * all stderr output goes to our stderr.

				 * If the pipeline specifies redirection

				 * then the file will still be created

				 * but it will never get any data. */

{

    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all

				 * the pids of child processes. */

    int numPids;		/* Actual number of processes that exist

				 * at *pidPtr right now. */