linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
499af282987474f90afbe26630addeefcab5b9a6
sics/macro.c
cvs 499af28298 1.) Modified macro system as to use only Sicsunknown for resolving unknown 
Tcl commands. Removed the broken obTcl object system and replaced it by
    the object.tcl system from sntl. Redid the scan command with this. The
    end of this is that SICS is now independent of the tcl version and
    works with tcl 8.0 thus giving a factor of up to 10 in script execution
    speed.
2.) Added driving an angle through a translation table (object lin2ang)
2000-02-25 16:21:41 +00:00

845 lines
23 KiB
C
Raw Blame History

/*--------------------------------------------------------------------------
All you need to evaluate macros with SICS.
The implmentation fo the macro stuff is complex and non intuitive.
This is the price to pay for adding the extremly powerful and
strong Tcl-interpreter to SICS. The problem is that Tcl does not
know anything about connections and our error handling. We have
to transport this around it. This is done via the unknown mechanism.
The unknown-command is called any time Tcl does not find a command
in its command list. Our unknown calls Sics-objects than and
provides proper connection and Sics-information. As this unknown is
going to hold the connection info, we need one interpreter per
connection. In order to transport interrupt conditions (motor
going bang) we need an interrupt code field in Connection.
Mark Koennecke, November 1996
Mark Koennecke, April 1999
where code added.
Mark Koennecke, December 1999
InternalFileEval added
Copyright:
Labor fuer Neutronenstreuung
Paul Scherrer Institut
CH-5423 Villigen-PSI
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.
IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.
--------------------------------------------------------------------------*/
#include "fortify.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include <stdio.h>
#include <tcl.h>
#include "SCinter.h"
#include "conman.h"
#include "macro.h"
#include "status.h"
#include "obdes.h"
#include "splitter.h"
#include "ifile.h"
#include "Dbg.h"
#include "servlog.h"
#define SICSERROR "005567SICS"
/* in SCinter.c, but only used here */
extern Tcl_Interp *InterpGetTcl(SicsInterp *pSics);
/*----------------------------------------------------------------------------
SICS Macro uses the Tcl "unknown" mechanism to access the Sics-objects.
The Tcl algorithm is to call a command called unknown when it cannot
match a command with the Tcl-built ins. Sics will now define the unknown
to call the Sics object invocation mechanism. In order to do this
properly the unknown needs to know about the connection invoking the
command and the SicsInterpreter to use. A suitable datastructure will
be defined below. And a function which be planted into Tcl to do the
trick.
-----------------------------------------------------------------------------*/
#define MAXSTACK 50
struct __SicsUnknown {
SConnection *pCon[MAXSTACK];
char *lastUnknown[MAXSTACK];
int iStack;
SicsInterp *pInter;
};
static struct __SicsUnknown *pUnbekannt = NULL;
/*---------------------------------------------------------------------------*/
int MacroPush(SConnection *pCon)
{
assert(pUnbekannt);
pUnbekannt->iStack++;
if(pUnbekannt->iStack >= MAXSTACK)
{
SCWrite(pCon,"ERROR: Out of Stack in macro.c",eError);
return 0;
}
pUnbekannt->pCon[pUnbekannt->iStack] = pCon;
return 1;
}
/*-------------------------------------------------------------------------*/
int MacroPop(void)
{
assert(pUnbekannt);
pUnbekannt->iStack--;
if(pUnbekannt->iStack < 1)
{
pUnbekannt->iStack = 0;
}
return 1;
}
/*---------------------------------------------------------------------------*/
static int SicsUnknownProc(ClientData pData, Tcl_Interp *pInter,
int argc, char *argv[])
{
struct __SicsUnknown *pSics = NULL;
char **myarg = NULL;
int margc;
SicsInterp *pSinter = NULL;
SConnection *pCon = NULL;
CommandList *pCommand = NULL;
char *lastCommand = NULL, comBuffer[132];
int iRet,i;
int iMacro;
/* get the datastructures */
pSics = (struct __SicsUnknown *)pData;
assert(pSics);
pSinter = pSics->pInter;
pCon = pSics->pCon[pSics->iStack];
lastCommand = pSics->lastUnknown[pSics->iStack];
assert(pSinter);
assert(pCon);
/* shorten the argc, argv by one and invoke */
margc = argc -1;
myarg = &argv[1];
/* find object */
if(margc < 1)
{
Tcl_SetResult(pInter,"No command found",TCL_VOLATILE);
return TCL_ERROR;
}
pCommand = FindCommand(pSinter,myarg[0]);
if(!pCommand)
{
Tcl_AppendResult(pInter,"Object ",myarg[0]," not found",NULL);
return TCL_ERROR;
}
/* check for endless loop */
Arg2Text(margc, myarg, comBuffer,131);
if(lastCommand != NULL)
{
if(strcmp(lastCommand,comBuffer) == 0)
{
Tcl_AppendResult(pInter,"ERROR: Never ending loop in unknown\n",
"Offending command: ",comBuffer,
"Probably Tcl command not found",NULL);
SCSetInterrupt(pCon,eAbortBatch);
return TCL_ERROR;
}
}
pSics->lastUnknown[pSics->iStack] = strdup(comBuffer);
/* invoke */
iMacro = SCinMacro(pCon);
SCsetMacro(pCon,1);
iRet = pCommand->OFunc(pCon,pSinter,pCommand->pData,margc, myarg);
SCsetMacro(pCon,iMacro);
free(pSics->lastUnknown[pSics->iStack]);
pSics->lastUnknown[pSics->iStack] = NULL;
/* finish */
if(iRet)
{
return TCL_OK;
}
else
{
Tcl_SetVar(pInter,SICSERROR,"yes",TCL_GLOBAL_ONLY);
return TCL_ERROR;
}
}
/*-----------------------------------------------------------------------*/
static void UnknownKill(ClientData pData)
{
struct __SicsUnknown *pU = NULL;
pU = (struct __SicsUnknown *)pData;
if(pU->pCon[0])
{
SCDeleteConnection(pU->pCon[0]);
}
free(pData);
pUnbekannt = NULL;
}
/*--------------------------------------------------------------------------
initialises a Tcl-Interpreter, installs SICS unknown mechanism and kills
a few dangerous commands from the normal Tcl command set
*/
Tcl_Interp *MacroInit(SicsInterp *pSics)
{
Tcl_Interp *pInter = NULL;
struct __SicsUnknown *pUnknown = NULL;
char *pPtr = NULL;
char *pPtr2 = NULL;
FILE *fp = NULL;
char pBueffel[512];
int iRet;
assert(pSics);
/* create interpreter and unknown */
pInter = Tcl_CreateInterp();
pUnknown = (struct __SicsUnknown *)malloc(sizeof(struct __SicsUnknown));
if( (!pInter) || (!pUnknown) )
{
return NULL;
}
/* install unknown command */
memset(pUnknown,0,sizeof(struct __SicsUnknown));
pUnknown->pCon[0] = SCCreateDummyConnection(pSics);
pUnknown->iStack = 0;
pUnknown->pInter = pSics;
pUnbekannt = pUnknown;
Tcl_CreateCommand(pInter,"unknown",SicsUnknownProc,
pUnknown, UnknownKill);
/* delete dangers */
Tcl_DeleteCommand(pInter,"exit");
Tcl_DeleteCommand(pInter,"socket");
Tcl_DeleteCommand(pInter,"vwait");
Tcl_DeleteCommand(pInter,"exec");
return pInter;
}
/*--------------------------------------------------------------------------*/
void MacroDelete(Tcl_Interp *pInter)
{
Tcl_DeleteInterp(pInter);
}
/*-------------------------------------------------------------------------
Find the first word of a command string
*/
static void FirstWord(char *pSource, char *pTarget)
{
int i, iLength, iStart, iPos;
iLength = strlen(pSource);
/* find start */
for(i = 0, iStart = 0; i < iLength; i++)
{
if(pSource[i] != ' ')
{
break;
}
else
{
iStart++;
}
}
/* do a quick check */
if(iStart >= iLength - 2)
{
pTarget[0] = '\0';
return;
}
/* do the copy */
for(i = iStart, iPos = 0; i < iLength; i++)
{
if(pSource[i] != ' ')
{
pTarget[iPos] = pSource[i];
iPos++;
}
else
{
pTarget[iPos] = '\0';
return;
}
}
pTarget[iPos] = '\0';
return;
}
/*-------------------------------------------------------------------------*/
static char *pWhere = NULL;
static char *pFile = NULL;
int MacroWhere(SConnection *pCon, SicsInterp *pInter, void *pData,
int argc, char *argv[])
{
assert(pCon);
if(pWhere)
{
SCWrite(pCon,pWhere,eValue);
}
return 1;
}
/*-------------------------------------------------------------------------*/
void WhereKill(void *pData)
{
if(pWhere)
{
free(pWhere);
pWhere = NULL;
}
if(pFile)
{
free(pFile);
pFile = NULL;
}
if(pData)
KillDummy(pData);
}
/*--------------------------------------------------------------------------*/
int MacroFileEval(SConnection *pCon, SicsInterp *pInter, void *pData,
int argc, char *argv[])
{
FILE *fp = NULL;
char pBueffel[512];
int iChar;
int i, iRun;
Tcl_DString command;
char *pCom = NULL;
int iRet;
Status eOld;
Tcl_Interp *pTcl = NULL;
int iLine = 0;
assert(pCon);
assert(pInter);
pTcl = InterpGetTcl(pInter);
/* check authorisation: only users permitted here */
if(!SCMatchRights(pCon,usUser))
{
SCWrite(pCon,"ERROR: Insufficient Privilege to do FileEval",eError);
return 0;
}
/* open filename */
if( argc < 2)
{
SCWrite(pCon,"ERROR: No filename specified ",eError);
return 0;
}
fp = fopen(argv[1],"r");
if(!fp)
{
sprintf(pBueffel," Failed to open file -> %s <- ",argv[1]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
/* handle status first */
eOld = GetStatus();
SetStatus(eBatch);
SICSLogWrite("Evaluating in MacroFileEval",eValue);
SICSLogWrite(argv[1],eValue);
if(pFile)
{
free(pFile);
}
pFile = strdup(argv[1]);
/* cycle through file and execute complete commands */
i = 0;
Tcl_DStringInit(&command);
iRun = 1;
while(iRun)
{
iChar = fgetc(fp);
if(iChar == EOF)
{
iChar = (int)'\n';
iRun = 0;
}
if( iChar == (int)'\n' )
{
pBueffel[i] = (char)iChar;
pBueffel[i+1] = '\0';
Tcl_DStringAppend(&command,pBueffel,-1);
pCom = Tcl_DStringValue(&command);
if(Tcl_CommandComplete(pCom))
{
SetStatus(eEager);
FirstWord(pCom,pBueffel);
if(FindCommand(pInter,pBueffel) != NULL)
{
sprintf(pBueffel,"%s:%d>> %s",pFile,iLine,pCom);
SCWrite(pCon,pBueffel,eValue);
if(pWhere != NULL)
{
free(pWhere);
}
pWhere = strdup(pBueffel);
iLine++;
}
iRet = Tcl_Eval(pTcl,pCom);
SetStatus(eBatch);
if(iRet != TCL_OK)
{
/* write TCL error and check for total interrupt */
if(Tcl_GetVar(pTcl,SICSERROR,TCL_GLOBAL_ONLY) == NULL)
{ /* Tcl error */
if(strlen(pTcl->result) > 2)
{
SCWrite(pCon,pTcl->result,eError);
}
pCom = Tcl_DStringValue(&command);
sprintf(pBueffel,"ERROR: in Tcl line: %s",pCom);
SCWrite(pCon,pBueffel,eError);
}
else /* SICS error */
{
Tcl_UnsetVar(pTcl,SICSERROR,TCL_GLOBAL_ONLY);
/* SCWrite(pCon,pTcl->result,eError); */
}
}
if(SCGetInterrupt(pCon) >= eAbortBatch)
{
fclose(fp);
Tcl_DStringFree(&command);
SCWrite(pCon,"ERROR: batch processing interrupted",eError);
SetStatus(eOld);
return 0;
}
else
{
SCSetInterrupt(pCon,eContinue);
SCSetError(pCon,OKOK);
}
Tcl_DStringFree(&command);
}
i = 0;
}
else
{
pBueffel[i] = (char)iChar;
i++;
}
} /* end while */
/* clean up */
fclose(fp);
Tcl_DStringFree(&command);
SetStatus(eOld);
SCSendOK(pCon);
return 1;
}
/*----------------------------------------------------------------------
InternalFileEval evaluates a file but on a dummy connection which
only writes log files. It also configures a log file for output
which will be the name of the input file but with .log appended.
This is here in order to support the evaluation of command files
generated in a specific directory from the WWW-interface. If the latter
does not get through, this can safely be deleted.
*/
int InternalFileEval(SConnection *pCon, SicsInterp *pInter, void *pData,
int argc, char *argv[])
{
SConnection *pIntern = NULL;
int iRet;
char *pFil = NULL, *pExt = NULL;
/* we need a filename */
if( argc < 2)
{
SCWrite(pCon,"ERROR: No filename specified ",eError);
return 0;
}
/* allocate a dummy connection for this */
pIntern = SCCreateDummyConnection(pInter);
if(!pInter)
{
SCWrite(pCon,"ERROR: out of memory in InternalFileEval",eError);
return NULL;
}
SCnoSock(pIntern);
/* configure the log file */
pFil = strdup(argv[1]);
pExt = strrchr(pFil,(int)'.');
if(!pExt)
{
SCWrite(pCon,"ERROR: no extension found in InternalFileEval",
eError);
return 0;
}
else
{
strcpy(pExt,".log");
SCAddLogFile(pIntern,pFil);
free(pFil);
}
/* invoke the fileeval */
MacroPush(pIntern);
iRet = MacroFileEval(pIntern,pInter,pData,argc,argv);
MacroPop();
/* remove our internal connection */
SCDeleteConnection(pIntern);
return iRet;
}
/*--------------------------------------------------------------------------
ClientPut is installed as a command to write data to the client from
a server script. Syntax:
ClientPut text outputcode
The output code is optional and and defaults to eStatus.
---------------------------------------------------------------------------*/
#include "outcode.c"
int ClientPut(SConnection *pCon, SicsInterp *pInter, void *pData,
int argc, char *argv[])
{
OutCode eOut = eStatus;
int i = 0, iCode, iLen;
int iMacro;
char *ppCode;
char *pMessage = NULL;
assert(pCon);
assert(pInter);
if(argc < 2)
{
SCWrite(pCon,"Insufficient arguments to ClientPut",eError);
return 0;
}
/* handle optional I/O codes */
if(argc > 2)
{
/* the last one must be the code */
iCode = argc - 1;
ppCode = strdup(argv[iCode]);
strtolower(ppCode);
while(pCode[i] != NULL)
{
if(strcmp(pCode[i],ppCode)== NULL)
{
break;
}
i++;
}
if(ppCode)
{
free(ppCode);
}
}
else
{
i = 10;
iCode = argc;
}
switch(i)
{
case 0:
eOut = eInternal;
break;
case 1:
eOut = eCommand;
break;
case 2:
eOut = eHWError;
break;
case 3:
eOut = eInError;
break;
case 4:
eOut = eStatus;
break;
case 5:
eOut = eValue;
break;
case 6:
eOut = eWarning;
break;
case 7:
eOut = eError;
break;
default:
eOut = eStatus;
iCode = argc;
break;
}
/* recombine the message */
/* find length */
iLen = 0;
for(i = 1; i < iCode; i++)
{
iLen += strlen(argv[i]);
}
pMessage = (char *)malloc((iLen+100)*sizeof(char));
if(!pMessage)
{
SCWrite(pCon,"ERROR: out of memory in clientput",eError);
return 0;
}
memset(pMessage,0,(iLen+100)*sizeof(char));
Arg2Text(iCode-1,&argv[1],pMessage,(iLen+100)*sizeof(char));
/* now write, thereby tunneling macro flag in order to get proper
write to client and not into interpreter
*/
iMacro = SCinMacro(pCon);
SCsetMacro(pCon,0);
SCWrite(pCon,pMessage,eOut);
SCsetMacro(pCon,iMacro);
if(pMessage)
{
free(pMessage);
}
return 1;
}
/*---------------------------------------------------------------------------
This implements a scheme to provide Tcl commands to Tcl. The Tcl commands
(either procedures or objects) must be defined in a separate file. Than
you call:
Publish command UserRights
This will make the command known to Sics, and user with user rights matching
the rights initialized may use it.
Below the datastructure to hold for each command
----------------------------------------------------------------------------*/
typedef struct {
pObjectDescriptor pDes;
char *command;
int iUser;
} PubTcl, *pPubTcl;
/*--------------------------------------------------------------------------*/
static pPubTcl CreatePublish(char *name, int iUser)
{
pPubTcl pRes = NULL;
pRes = (pPubTcl)malloc(sizeof(PubTcl));
if(!pRes)
{
return NULL;
}
pRes->pDes = CreateDescriptor("Macro");
if(!pRes->pDes)
{
free(pRes);
return NULL;
}
pRes->command = strdup(name);
pRes->iUser = iUser;
return pRes;
}
/*-------------------------------------------------------------------------*/
static void DeletePublish(void *pData)
{
pPubTcl self = NULL;
self = (pPubTcl)pData;
assert(self);
if(self->pDes)
{
DeleteDescriptor(self->pDes);
}
if(self->command)
{
free(self->command);
}
free(self);
}
/*--------------------------------------------------------------------------
TclAction checks the user rights and than invokes the arguments as a Tcl
command
*/
static int TclAction(SConnection *pCon,SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
char pBueffel[1024];
pPubTcl self = NULL;
int iRet;
char *pPtr;
Tcl_Interp *pTcl = NULL;
self = (pPubTcl)pData;
assert(pCon);
assert(pSics);
assert(self);
pTcl = InterpGetTcl(pSics);
if(!SCMatchRights(pCon,self->iUser))
{
sprintf(pBueffel,"ERROR: you are not authorised to invoke %s",
argv[0]);
SCWrite(pCon,pBueffel,eError);
return 1;
}
/* make a string */
Arg2Text(argc,argv,pBueffel,1023);
iRet = Tcl_Eval(pTcl,pBueffel);
if(iRet == TCL_OK)
{ /* possibly a bug here */
SCWrite(pCon,pTcl->result,eStatus);
return 1;
}
else
{
if(Tcl_GetVar(pTcl,SICSERROR,TCL_GLOBAL_ONLY) == NULL)
{
pPtr = strdup(pTcl->result);
SCWrite(pCon,pPtr,eError);
free(pPtr);
}
else
{
Tcl_UnsetVar(pTcl,SICSERROR,TCL_GLOBAL_ONLY);
SCWrite(pCon,pTcl->result,eError);
}
return 0;
}
return 1; /* not reached */
}
#include "access.c"
/*--------------------------------------------------------------------------*/
int TclPublish(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
pPubTcl pNew = NULL;
char pBueffel[132];
int iUser, i, iRet;
/* check no of args */
if(argc < 3)
{
sprintf(pBueffel,"ERROR: Insufficient no of arguments to %s",
argv[0]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
/* check user rights */
if(!SCMatchRights(pCon,usMugger))
{
sprintf(pBueffel,"ERROR: you are not authorised to use %s",
argv[0]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
/* try convert last parameter to user code */
iUser = 0;
strtolower(argv[2]);
while(aCode[iUser] != NULL)
{
if(strcmp(aCode[iUser],argv[2]) == 0)
{
break;
}
iUser++;
}
if(iUser > iCodes)
{
sprintf(pBueffel,"ERROR: cannot identify %s as a valid user code",
argv[2]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
/* do a job !*/
pNew = CreatePublish(argv[1],iUser);
if(!pNew)
{
sprintf(pBueffel,"ERROR: memory error in %s",argv[0]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
iRet = AddCommand(pSics,argv[1],TclAction,DeletePublish,(void *)pNew);
if(!iRet)
{
sprintf(pBueffel,"ERROR: duplicate command %s not created",argv[1]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
return 1;
}
/*-------------------------------------------------------------------------
Transact executes a command and sends a TRANSACTIONFINISHED string
at the end. This is to permit clients to search for this string in
order to find out when a command has finished.
*/
int TransactAction(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
char pCommand[1024];
int iRet;
Arg2Text(argc-1,&argv[1],pCommand,1023);
iRet = InterpExecute(pSics,pCon,pCommand);
SCWrite(pCon,"TRANSACTIONFINISHED",eError);
return iRet;
}
Reference in New Issue View Git Blame Copy Permalink