/*-----------------------------------------------------------------------------
* 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;
}
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;
}
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;
}
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;
}
}
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;
}
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));
}
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;
}
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;
}
/*-----------------------------------------------------------------------------
* 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;
}
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);
}