source: nanoscale/trunk/tclparser.c @ 6632

/* -*- mode: c; c-basic-offset: 4; indent-tabs-mode: nil -*- */
/* ======================================================================
 *  Copyright (c) 2004-2016  HUBzero Foundation, LLC
 * ----------------------------------------------------------------------
 *  See the file "license.terms" for information on usage and
 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ======================================================================
 */
#include <stdlib.h>
#include <string.h>
#include <tcl.h>

#include "server.h"

static int *s_numServers;
static RenderServer **s_serverTable;

static int
ParseSwitches(Tcl_Interp *interp, RenderServer *serverPtr, int *objcPtr,
              Tcl_Obj ***objvPtr)
{
    int i, objc;
    Tcl_Obj **objv;

    objc = *objcPtr;
    objv = *objvPtr;
    for (i = 3; i < objc; i += 2) {
        const char *string;
        char c;

        string = Tcl_GetString(objv[i]);
        if (string[0] != '-') {
            break;
        }
        c = string[1];
        if ((c == 'i') && (strcmp(string, "-input") == 0)) {
            int f;

            if (Tcl_GetIntFromObj(interp, objv[i+1], &f) != TCL_OK) {
                return TCL_ERROR;
            }
            serverPtr->inputFd = f;
        } else if ((c == 'o') && (strcmp(string, "-output") == 0)) {
            int f;

            if (Tcl_GetIntFromObj(interp, objv[i+1], &f) != TCL_OK) {
                return TCL_ERROR;
            }
            serverPtr->outputFd = f;
        } else if ((c == 'l') && (strcmp(string, "-logstdout") == 0)) {
            int state;

            if (Tcl_GetBooleanFromObj(interp, objv[i+1], &state) != TCL_OK) {
                return TCL_ERROR;
            }
            serverPtr->logStdout = state;
        } else if ((c == 'l') && (strcmp(string, "-logstderr") == 0)) {
            int state;

            if (Tcl_GetBooleanFromObj(interp, objv[i+1], &state) != TCL_OK) {
                return TCL_ERROR;
            }
            serverPtr->logStderr = state;
        } else if ((c == 'c') && (strcmp(string, "-combinelogs") == 0)) {
            int state;

            if (Tcl_GetBooleanFromObj(interp, objv[i+1], &state) != TCL_OK) {
                return TCL_ERROR;
            }
            serverPtr->combineLogs = state;
        } else {
            Tcl_AppendResult(interp, "unknown switch \"", string, "\"",
                             (char *)NULL);
            return TCL_ERROR;
        }
    }
    *objcPtr = objc - (i - 3);
    *objvPtr = objv + (i - 3);
    return TCL_OK;
}

/* 
 * RegisterServerCmd --
 *
 *      Registers a render server to be run when a client connects
 *      on the designated port. The form of the commands is
 *
 *          register_server <name> <port> <cmd> <environ>
 *
 *      where
 *
 *          name        Token for the render server.
 *          port        Port to listen to accept connections.
 *          cmd         Command to be run to start the render server.
 *          environ     Name-value pairs of representing environment
 *                      variables.
 *
 *      Note that "cmd" and "environ" are variable and backslash
 *      substituted.  A listener socket automatically is established on
 *      the given port to accept client requests.
 *
 *      Example:
 *
 *          register_server myServer 12345 ?switches? {
 *               /path/to/myserver arg arg
 *          } {
 *               LD_LIBRARY_PATH $libdir/myServer
 *          }
 *
 */
static int
RegisterServerCmd(ClientData clientData, Tcl_Interp *interp, int objc,
                  Tcl_Obj *const *objv)
{
    Tcl_Obj *objPtr;
    const char *serverName;
    int numCmdArgs, numEnvArgs;
    char *const *cmdArgs;
    char *const *envArgs;
    RenderServer *serverPtr;

    if (objc < 4) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                         Tcl_GetString(objv[0]),
                         " serverName port ?flags? cmd ?environ?",
                         (char *)NULL);
        return TCL_ERROR;
    }
    serverName = Tcl_GetString(objv[1]);
    if (*s_numServers+1 >= MAX_SERVERS) {
        Tcl_AppendResult(interp, "Too many servers in configuration", (char *)NULL);
        return TCL_ERROR;
    }
    serverPtr = NewServer(serverName);
    if (serverPtr == NULL) {
        Tcl_AppendResult(interp, "Can't allocate a server entry", (char *)NULL);
        return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[2], &serverPtr->port) != TCL_OK) {
        Tcl_AppendResult(interp, "Can't parse port number", (char *)NULL);
        goto error;
    }

    INFO("Registering \"%s\" server on port %d", serverPtr->name, serverPtr->port);
    (*s_numServers)++;
    s_serverTable[*s_numServers-1] = serverPtr;

    if (ParseSwitches(interp, serverPtr, &objc, (Tcl_Obj ***)&objv) != TCL_OK) {
        goto error;
    }
    objPtr = Tcl_SubstObj(interp, objv[3],
                          TCL_SUBST_VARIABLES | TCL_SUBST_BACKSLASHES);
    if (Tcl_SplitList(interp, Tcl_GetString(objPtr), &numCmdArgs,
        (const char ***)&cmdArgs) != TCL_OK) {
        goto error;
    }
    serverPtr->cmdArgs = cmdArgs;
    serverPtr->numCmdArgs = numCmdArgs;

    numEnvArgs = 0;
    envArgs = NULL;
    if (objc == 5) {
        objPtr = Tcl_SubstObj(interp, objv[4],
                              TCL_SUBST_VARIABLES | TCL_SUBST_BACKSLASHES);
        if (Tcl_SplitList(interp, Tcl_GetString(objPtr), &numEnvArgs,
                (const char ***)&envArgs) != TCL_OK) {
            goto error;
        }
        if (numEnvArgs & 0x1) {
            Tcl_AppendResult(interp, "odd # elements in environment list",
                             (char *)NULL);
            goto error;
        }
    }
    serverPtr->envArgs = envArgs;
    serverPtr->numEnvArgs = numEnvArgs;

    return TCL_OK;
 error:
    free(serverPtr);
    return TCL_ERROR;
}

char *MergeArgs(int numCmdArgs, char *const *cmdArgs)
{
    return Tcl_Merge(numCmdArgs, (const char *const *)cmdArgs);
}

void FreeArgs(char *cmd)
{
    Tcl_Free(cmd);
}

int
ParseServersFile(const char *fileName, int *numServers, RenderServer **serverTable)
{
    Tcl_Interp *interp;

    s_numServers = numServers;
    s_serverTable = serverTable;

    interp = Tcl_CreateInterp();
    Tcl_MakeSafe(interp);
    Tcl_CreateObjCommand(interp, "register_server", RegisterServerCmd, NULL,
                         NULL);
    if (Tcl_EvalFile(interp, fileName) != TCL_OK) {
        ERROR("Can't add server: %s", Tcl_GetString(Tcl_GetObjResult(interp)));
        return FALSE;
    }

    Tcl_DeleteInterp(interp);
    return TRUE;
}