Esempio n. 1
0
/*-----------------------------------------------------------------------------
 * SetSignalActions --
 *     
 *    Set the signal state for the specified signals.  
 *
 * Parameters::
 *   o interp - The list is returned in the result.
 *   o signals - Boolean array indexed by signal number that indicates
 *     the requested signals.
 *   o actionFunc - The function to run when the signal is received.
 *   o restart - Restart systems calls on signal.
 *   o command - If the function is the "trap" function, this is the
 *     Tcl command to run when the trap occurs.  Otherwise, NULL.
 * Returns:
 *   TCL_OK or TCL_ERROR, with error message in interp.
 *-----------------------------------------------------------------------------
 */
static int
SetSignalActions (Tcl_Interp      *interp,
                  unsigned char    signals [MAXSIG],
                  signalProcPtr_t  actionFunc,
                  int              restart,
                  char            *command)
{
    int signalNum;

    for (signalNum = 0; signalNum < MAXSIG; signalNum++) {
        if (!signals [signalNum])
            continue;

        if (signalTrapCmds [signalNum] != NULL) {
            ckfree (signalTrapCmds [signalNum]);
            signalTrapCmds [signalNum] = NULL;
        }
        if (command != NULL)
            signalTrapCmds [signalNum] = ckstrdup (command);

        if (SetSignalState (signalNum, actionFunc, restart) == TCL_ERROR) {
            TclX_AppendObjResult (interp, Tcl_PosixError (interp),
                                  " while setting ", Tcl_SignalId (signalNum),
                                  (char *) NULL);
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}
Esempio n. 2
0
static int newpvInfo (Tcl_Interp *interp, const char *name, Tcl_Obj *prefix) {
	pvInfo *result=ckalloc(sizeof(pvInfo));
	
	result->interp=interp;
	result->name=ckstrdup(name);
	if (prefix) Tcl_IncrRefCount(prefix);
	result->connectprefix = prefix;
	result->id = 0;
	result->connected = 0;
	result->thrid = Tcl_GetCurrentThread();
	result->monitorid = 0;
	result->monitorprefix = NULL;
	result->nElem = 1;
	result->type = -1;

	/* connect PV */
	int code = ca_create_channel(name, stateHandler, result, 0, &(result->id));
	if (code != ECA_NORMAL) {
		/* raise error */
		freepvInfo(result);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(ca_message(code), -1));
		return TCL_ERROR;
	}	
	
	/* Create handle */
	static int pvcounter = 0;
	char objName[50 + TCL_INTEGER_SPACE];
	sprintf(objName, "::AsynCA::PV%d", ++pvcounter);
	result->cmd = Tcl_CreateObjCommand(interp, objName, InstanceCmd, (ClientData) result, DeleteCmd);
	
	Tcl_SetObjResult(interp, Tcl_NewStringObj(objName, -1));

	return TCL_OK;
}
Esempio n. 3
0
static void
SaveAuthKey(TnmSnmp *session)
{
    KeyCacheElem *keyPtr;
    
    keyPtr = (KeyCacheElem *) ckalloc(sizeof(KeyCacheElem));
    keyPtr->password = ckstrdup(session->password);
    memcpy(keyPtr->agentID, session->agentID, USEC_MAX_AGENTID);
    memcpy(keyPtr->authKey, session->authKey, TNM_MD5_SIZE);
    keyPtr->nextPtr = firstKeyCacheElem;
    firstKeyCacheElem = keyPtr;
}
Esempio n. 4
0
void
TkiFlash (Tcl_Interp *interp, Tki_Object *object)
{
    FlashItem *p;

    if (flashList == NULL) {
	
        flashList = (FlashItem *) ckalloc (sizeof(FlashItem));
	p = flashList;
	p->id = ckstrdup(object->id);
	p->nextPtr = NULL;
	Tk_CreateTimerHandler (500, FlashProc, (ClientData) interp);

    } else {

	/* 
	 * Move to the end of the list and check if it exists already.
	 */

	for (p = flashList; p->nextPtr != NULL; p = p->nextPtr) {
	    if (p->id && strcmp (p->id, object->id) == 0) return;
	}
	if (p->id && strcmp (p->id, object->id) == 0) {
	    return;
	}

	/* 
	 * Create a new entry for the flash list.
	 */

        p->nextPtr = (FlashItem *) ckalloc (sizeof(FlashItem));
	p = p->nextPtr;
	p->id = ckstrdup(object->id);
	p->nextPtr = NULL;
    }
}
Esempio n. 5
0
int
TnmAttrSet(Tcl_HashTable *tablePtr, Tcl_Interp *interp, char *name, char *value)
{
    Tcl_HashEntry *entryPtr;
    int isNew;
    char *p;

    entryPtr = Tcl_FindHashEntry(tablePtr, name);

    if (value) {

	/*
	 * Check the character set of the name to make sure that
	 * we do not run into quoting hell problems just because
	 * people put funny characters into the names.
	 */

	for (p = name; *p; p++) {
	    if (!isalnum(*p) && *p != ':') {
		Tcl_SetResult(interp, "illegal character in attribute name",
			      TCL_STATIC);
		return TCL_ERROR;
	    }
	}

	if (! entryPtr) {
	    entryPtr = Tcl_CreateHashEntry(tablePtr, name, &isNew);
	} else {
	    ckfree((char *) Tcl_GetHashValue(entryPtr));
	}
	if (*value) {
	    Tcl_SetHashValue(entryPtr, ckstrdup(value));
	} else {
	    Tcl_DeleteHashEntry(entryPtr);
	    entryPtr = NULL;
	}
    }

    if (entryPtr) {
	Tcl_SetResult(interp, (char *) Tcl_GetHashValue(entryPtr), TCL_STATIC);
    }

    return TCL_OK;
}
Esempio n. 6
0
char*
Tnm_SnmpMergeVBList(int varBindSize, SNMP_VarBind *varBindPtr)
{
    static Tcl_DString list;
    int i;

    Tcl_DStringInit(&list);

    for (i = 0; i < varBindSize; i++) {
        Tcl_DStringStartSublist(&list);
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].soid ? varBindPtr[i].soid : "");
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].syntax ? varBindPtr[i].syntax : "");
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].value ? varBindPtr[i].value : "");
	Tcl_DStringEndSublist(&list);
    }

    return ckstrdup(Tcl_DStringValue(&list));
}
Esempio n. 7
0
char *
TnmGetIPName(Tcl_Interp *interp, struct sockaddr_in *addr)
{
    static Tcl_HashTable *hostTable = NULL;
    Tcl_HashEntry *hostEntry;
    struct hostent *host;

    Tcl_MutexLock(&utilMutex);

    if (hostTable == NULL) {
	hostTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hostTable, TCL_ONE_WORD_KEYS);
    }

    hostEntry = Tcl_FindHashEntry(hostTable, (char *) addr->sin_addr.s_addr);
    if (hostEntry) {
	Tcl_MutexUnlock(&utilMutex);
	return (char *) Tcl_GetHashValue(hostEntry);
    }
    
    host = gethostbyaddr((char *) &addr->sin_addr, 4, AF_INET);
    if (host) {
	int isnew;
	char *name = ckstrdup(host->h_name);
	hostEntry = Tcl_CreateHashEntry(hostTable,
					(char *) addr->sin_addr.s_addr,
					&isnew);
	Tcl_SetHashValue(hostEntry, (ClientData) name);
	Tcl_MutexUnlock(&utilMutex);
	return name;
    }

    if (interp) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "unknown IP address \"", 
			 inet_ntoa(addr->sin_addr), "\"", (char *) NULL);
    }
    Tcl_MutexUnlock(&utilMutex);
    return NULL;
}
Esempio n. 8
0
int
TnmSnmpEvalCallback(Tcl_Interp *interp, TnmSnmp *session, TnmSnmpPdu *pdu, char *cmd, char *instance, char *oid, char *value, char *last)
{
    char buf[20];
    int	code;
    Tcl_DString tclCmd;
    char *startPtr, *scanPtr, *name;

    Tcl_DStringInit(&tclCmd);
    startPtr = cmd;
    for (scanPtr = startPtr; *scanPtr != '\0'; scanPtr++) {
	if (*scanPtr != '%') {
	    continue;
	}
	Tcl_DStringAppend(&tclCmd, startPtr, scanPtr - startPtr);
	scanPtr++;
	startPtr = scanPtr + 1;
	switch (*scanPtr) {
	  case 'R':  
	    sprintf(buf, "%d", pdu->requestId);
	    Tcl_DStringAppend(&tclCmd, buf, -1);
	    break;
	  case 'S':
	    if (session && session->interp && session->token) {
		Tcl_DStringAppend(&tclCmd, 
		  Tcl_GetCommandName(session->interp, session->token), -1);
	    }
	    break;
	  case 'V':
	    Tcl_DStringAppend(&tclCmd, Tcl_DStringValue(&pdu->varbind), -1);
	    break;
	  case 'E':
	    name = TnmGetTableValue(tnmSnmpErrorTable, (unsigned) pdu->errorStatus);
	    if (name == NULL) {
		name = "unknown";
	    }
	    Tcl_DStringAppend(&tclCmd, name, -1);
	    break;
	  case 'I':
	    sprintf(buf, "%d", pdu->errorIndex - 1);
	    Tcl_DStringAppend(&tclCmd, buf, -1);
	    break;
	  case 'A':
	    Tcl_DStringAppend(&tclCmd, inet_ntoa(pdu->addr.sin_addr), -1);
	    break;
	  case 'P':
	    sprintf(buf, "%u", ntohs((unsigned short) pdu->addr.sin_port));
	    Tcl_DStringAppend(&tclCmd, buf, -1);
	    break;
#ifdef TNM_SNMPv3
	  case 'C':
	    if (pdu->context && pdu->contextLength) {
		Tcl_DStringAppend(&tclCmd, pdu->context, pdu->contextLength);
	    }
	    break;
	  case 'G':
	    if (pdu->engineID && pdu->engineIDLength) {
		Tcl_DStringAppend(&tclCmd, pdu->engineID, pdu->engineIDLength);
	    }
	    break;
#endif
	  case 'T':
	    name = TnmGetTableValue(tnmSnmpPDUTable, (unsigned) pdu->type);
	    if (name == NULL) {
		name = "unknown";
	    }
	    Tcl_DStringAppend(&tclCmd, name, -1);
            break;
	  case 'o':
	    if (instance) {
		Tcl_DStringAppend(&tclCmd, instance, -1);
	    }
	    break;
	  case 'i':
	    if (oid) {
		Tcl_DStringAppend(&tclCmd, oid, -1);
	    }
	    break;
	  case 'v':
	    if (value) {
		Tcl_DStringAppend(&tclCmd, value, -1);
	    }
	    break;
	  case 'p':
	    if (last) {
		Tcl_DStringAppend(&tclCmd, last, -1);
	    }
	    break;
	  case '%':
	    Tcl_DStringAppend(&tclCmd, "%", -1);
	    break;
	  default:
	    sprintf(buf, "%%%c", *scanPtr);
	    Tcl_DStringAppend(&tclCmd, buf, -1);
	}
    }
    Tcl_DStringAppend(&tclCmd, startPtr, scanPtr - startPtr);
    
    /*
     * Now evaluate the callback function and issue a background
     * error if the callback fails for some reason. Return the
     * original error message and code to the caller.
     */
    
    Tcl_AllowExceptions(interp);
    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&tclCmd));
    Tcl_DStringFree(&tclCmd);

    /*
     * Call the usual error handling proc if we have evaluated
     * a binding not bound to a specific instance. Bindings 
     * bound to an instance are usually called during PDU 
     * processing where it is important to get the error message
     * back.
     */

    if (code == TCL_ERROR && oid == NULL) {
	char *errorMsg = ckstrdup(Tcl_GetStringResult(interp));
	Tcl_AddErrorInfo(interp, "\n    (snmp callback)");
	Tcl_BackgroundError(interp);
	Tcl_SetResult(interp, errorMsg, TCL_DYNAMIC);
    }
    
    return code;
}
Esempio n. 9
0
/*-----------------------------------------------------------------------------
 * FormatSignalListEntry --
 *     
 *    Retrieve a signal's state and format a keyed list entry used to describe
 * a that state.
 *
 * Parameters::
 *   o interp - Error messages are returned here.
 *   o signalNum - The signal to get the state for.
 *   o sigStatesObjPtr - Keyed list to add entry to.
 * Returns:
 *   TCL_OK or TCL_ERROR.
 *-----------------------------------------------------------------------------
 */
static int
FormatSignalListEntry (Tcl_Interp *interp,
                       int         signalNum,
                       Tcl_Obj    *sigStatesObjPtr)
{
    Tcl_Obj *stateObjv [4], *stateObjPtr;
    signalProcPtr_t  actionFunc;
    char *actionStr, *idStr;
    int restart;

    if (GetSignalState (signalNum, &actionFunc, &restart) == TCL_ERROR)
        goto unixSigError;

    if (actionFunc == SIG_DFL) {
        actionStr = SIGACT_DEFAULT;
    } else if (actionFunc == SIG_IGN) {
        actionStr = SIGACT_IGNORE;
    } else if (actionFunc == SignalTrap) {
        if (signalTrapCmds [signalNum] == NULL) {
            actionStr = SIGACT_ERROR;
        } else {
            actionStr = SIGACT_TRAP;
        }
    } else {
        actionStr = SIGACT_UNKNOWN;
    }

    stateObjv [1] = SignalBlocked (signalNum);
    if (stateObjv [1] == NULL)
        goto unixSigError;
    stateObjv [0] = Tcl_NewStringObj (actionStr, -1);
    if (signalTrapCmds [signalNum] != NULL) {
        stateObjv [2] = Tcl_NewStringObj (signalTrapCmds [signalNum], -1);
    } else {
        stateObjv [2] = Tcl_NewStringObj ("", -1);
    }
    stateObjv [3] = Tcl_NewBooleanObj(restart);

    stateObjPtr = Tcl_NewListObj (4, stateObjv);
    Tcl_IncrRefCount (stateObjPtr);

    /*
     * Dup the string so we don't pass a const char to KLSet.
     */
    idStr = ckstrdup(Tcl_SignalId(signalNum));
    if (TclX_KeyedListSet (interp, sigStatesObjPtr, idStr,
		stateObjPtr) != TCL_OK) {
	ckfree(idStr);
        Tcl_DecrRefCount (stateObjPtr);
        return TCL_ERROR;
    }
    ckfree(idStr);
    Tcl_DecrRefCount (stateObjPtr);

    return TCL_OK;

  unixSigError:
    TclX_AppendObjResult (interp, Tcl_PosixError (interp),
                          " while getting ", Tcl_SignalId (signalNum),
                          (char *) NULL);
    return TCL_ERROR;
}
Esempio n. 10
0
static void
InitVars(Tcl_Interp *interp)
{
    const char *machine, *os, *vers, *user;
    char *tmp, *p;
    char buffer[20];
    Tcl_DString arch;
    Tcl_Obj *path;

    TnmInitPath(interp);

    Tcl_SetVar2(interp, "tnm", "version", TNM_VERSION, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tnm", "url", TNM_URL, TCL_GLOBAL_ONLY);

    /*
     * Get the startup time of the Tnm extension.
     */

    if (! tnmStartTime.sec && ! tnmStartTime.usec) {
	Tcl_GetTime(&tnmStartTime);
    }
    sprintf(buffer, "%ld", tnmStartTime.sec);
    Tcl_SetVar2(interp, "tnm", "start", buffer, TCL_GLOBAL_ONLY);

    /*
     * Check if the current version of the Tnm extension is still valid
     * or if it has expired. Note, this is only useful in distribution
     * demos or test versions. This check should be turned off on all
     * stable and final releases.
     */

#ifdef TNM_EXPIRE_TIME
    if (tnmStartTime.sec > TNM_EXPIRE_TIME) {
	Tcl_Panic("Tnm Tcl extension expired. Please upgrade to a newer version.");
    }
    sprintf(buffer, "%ld", TNM_EXPIRE_TIME);
    Tcl_SetVar2(interp, "tnm", "expire", buffer, TCL_GLOBAL_ONLY);
#endif

    /*
     * Set the host name. We are only interested in the name and not
     * in a fully qualified domain name. This makes the result
     * predictable and thus portable.
     */

    tmp = ckstrdup(Tcl_GetHostName());
    p = strchr(tmp, '.');
    if (p) *p = '\0';
    Tcl_SetVar2(interp, "tnm", "host", tmp, TCL_GLOBAL_ONLY);
    ckfree(tmp);
    
    /*
     * Get the user name. We try a sequence of different environment
     * variables in the hope to find something which works on all
     * systems.
     */

    user = getenv("USER");
    if (user == NULL) {
	user = getenv("USERNAME");
	if (user == NULL) {
	    user = getenv("LOGNAME");
	    if (user == NULL) {
		user = "******";
	    }
	}
    }
    Tcl_SetVar2(interp, "tnm", "user", user, TCL_GLOBAL_ONLY);

    /*
     * Search for a directory which allows to hold temporary files.
     * Save the directory name in the tnm(tmp) variable.
     */

    tmp = getenv("TEMP");
    if (! tmp) {
	tmp = getenv("TMP");
	if (! tmp) {
	    tmp = "/tmp";
	    if (access(tmp, W_OK) != 0) {
		tmp = ".";
	    }
	}
    }
    for (p = tmp; *p; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    Tcl_SetVar2(interp, "tnm", "tmp", tmp, TCL_GLOBAL_ONLY);

    /*
     * Determine the architecture string which is used to store 
     * machine dependend files in the Tnm cache area.
     */

    machine = Tcl_GetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
    os = Tcl_GetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
    vers = Tcl_GetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);

    Tcl_DStringInit(&arch);
    if (machine && os && vers) {
	Tcl_DStringAppend(&arch, machine, -1);
	Tcl_DStringAppend(&arch, "-", 1);
	Tcl_DStringAppend(&arch, os, -1);
	Tcl_DStringAppend(&arch, "-", 1);
	Tcl_DStringAppend(&arch, vers, -1);
    } else {
	Tcl_DStringAppend(&arch, "unknown-os", -1);
    }

    /*
     * Initialize the tnm(cache) variable which points to a directory
     * where we can cache shared data between different instantiations
     * of the Tnm extension. We usually locate the cache in the users
     * home directory. However, if this fails (because the user does
     * not have a home), we locate the cache in the tmp file area.
     */

    path = Tcl_NewObj();
    Tcl_AppendStringsToObj(path, "~/.tnm", TNM_VERSION, NULL);
    if (Tcl_FSConvertToPathType(interp, path) == TCL_ERROR) {
	Tcl_SetStringObj(path, tmp, -1);
	Tcl_AppendStringsToObj(path, "/tnm", TNM_VERSION, NULL);
    }
    if (Tcl_FSConvertToPathType(interp, path) == TCL_OK) {
	(void) TnmMkDir(interp, path);
    }
    Tcl_SetVar2(interp, "tnm", "cache",
		Tcl_GetStringFromObj(path, NULL), TCL_GLOBAL_ONLY);
    Tcl_DecrRefCount(path);

    /*
     * Remove all white spaces and slashes from the architecture string 
     * because these characters are a potential source of problems and 
     * I really do not like white spaces in a directory name.
     */

    {
	char *d = Tcl_DStringValue(&arch);
	char *s = Tcl_DStringValue(&arch);

	while (*s) {
	    *d = *s;
	    if ((!isspace((int) *s)) && (*s != '/')) d++;
	    s++;
	}
	*d = '\0';
    } 

    Tcl_SetVar2(interp, "tnm", "arch", 
		Tcl_DStringValue(&arch), TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&arch);
}