static SEXP makeRTclObject(Tcl_Obj *tclobj)
{
SEXP obj;
PROTECT(obj = R_MakeExternalPtr(tclobj, R_NilValue, R_NilValue));
Tcl_IncrRefCount(tclobj);
R_RegisterCFinalizer(obj, RTcl_dec_refcount);
UNPROTECT(1);
return obj;
}
static Tcl_Obj *
FileBasename(
Tcl_Interp *interp, /* Interp, for error return. */
Tcl_Obj *pathPtr) /* Path whose basename to extract. */
{
int objc;
Tcl_Obj *splitPtr;
Tcl_Obj *resultPtr = NULL;
splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
Tcl_IncrRefCount(splitPtr);
if (objc != 0) {
if ((objc == 1) && (*TclGetString(pathPtr) == '~')) {
Tcl_DecrRefCount(splitPtr);
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
return NULL;
}
splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
Tcl_IncrRefCount(splitPtr);
}
/*
* Return the last component, unless it is the only component, and it
* is the root of an absolute path.
*/
if (objc > 0) {
Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
if ((objc == 1) &&
(Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
resultPtr = NULL;
}
}
}
if (resultPtr == NULL) {
resultPtr = Tcl_NewObj();
}
Tcl_IncrRefCount(resultPtr);
Tcl_DecrRefCount(splitPtr);
return resultPtr;
}
/* attach_connection DBCONN */
static int AttachConnectionObjCmd(void *clientdata,
Tcl_Interp *interp,
int objc,
Tcl_Obj * const *objv)
{
VTableInterpContext *vticP = (VTableInterpContext *)clientdata;
VTableDB *vtdbP;
sqlite3 *sqliteP;
int new_entry;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, " DBCONN");
return TCL_ERROR;
}
/* Map the db connection command to the connection pointer */
if (GetSqliteConnPtr(interp, Tcl_GetString(objv[1]), &sqliteP) != TCL_OK)
return TCL_ERROR;
/* Check if already registered the virtual table module for this conn. */
if (Tcl_FindHashEntry(&vticP->dbconns, sqliteP) != NULL)
return TCL_OK;
/* Need to register for this db conn */
vtdbP = VTDBNew();
Tcl_IncrRefCount(objv[1]);
vtdbP->dbcmd_objP = objv[1];
/* Find out the NULL value representation this DB is using */
if (InitNullValueForDB(interp, vtdbP)) {
VTDBUnref(vtdbP, 1);
return TCL_ERROR;
}
if (sqlite3_create_module_v2(sqliteP, PACKAGE_NAME, &sqlite_vtable_methods,
vtdbP, VTDBDetachSqliteCallback)
!= SQLITE_OK) {
VTDBUnref(vtdbP, 1);
return ReturnSqliteError(interp, sqliteP, NULL);
}
/* Now add to the table of connections for this interpreter */
Tcl_SetHashValue(Tcl_CreateHashEntry(&vticP->dbconns, sqliteP, &new_entry),
vtdbP);
/* Link up various structures */
vtdbP->sqliteP = sqliteP;
vtdbP->vticP = vticP;
VTICRef(vticP, 1); /* Since dbP refers to it. TBD - circular dependency? */
VTDBRef(vtdbP, 2); /* Hash table ref + ref from sqlite */
return TCL_OK;
}
static VTableDB *VTDBNew(void)
{
VTableDB *vtdbP = (VTableDB *) ckalloc(sizeof(*vtdbP));
vtdbP->sqliteP = NULL;
vtdbP->vticP = NULL;
vtdbP->dbcmd_objP = NULL;
vtdbP->null_objP = Tcl_NewObj();
Tcl_IncrRefCount(vtdbP->null_objP);
vtdbP->nrefs = 0;
return vtdbP;
}
static Tcl_Obj*
rcBuildCmdList(ReflectingChannel* chan_, Tcl_Obj* cmd_)
{
Tcl_Obj* vec = Tcl_DuplicateObj(chan_->_context);
Tcl_IncrRefCount(vec);
Tcl_ListObjAppendElement(chan_->_interp, vec, cmd_);
Tcl_ListObjAppendElement(chan_->_interp, vec, chan_->_name);
return vec; /* with refcount 1 */
}
TnmSnmp*
TnmSnmpCreateSession(Tcl_Interp *interp, char type)
{
TnmSnmp *session;
const char *user;
session = (TnmSnmp *) ckalloc(sizeof(TnmSnmp));
memset((char *) session, 0, sizeof(TnmSnmp));
session->interp = interp;
session->maddr.sin_family = AF_INET;
if (type == TNM_SNMP_GENERATOR || type == TNM_SNMP_NOTIFIER) {
session->maddr.sin_addr.s_addr = htonl(INADDR_LOOPBACK);
} else {
session->maddr.sin_addr.s_addr = htonl(INADDR_ANY);
}
if (type == TNM_SNMP_LISTENER || type == TNM_SNMP_NOTIFIER) {
session->maddr.sin_port = htons((unsigned short) TNM_SNMP_TRAPPORT);
} else {
session->maddr.sin_port = htons((unsigned short) TNM_SNMP_PORT);
}
session->version = TNM_SNMPv1;
session->domain = TNM_SNMP_UDP_DOMAIN;
session->type = type;
session->community = Tcl_NewStringObj("public", 6);
Tcl_IncrRefCount(session->community);
session->context = Tcl_NewStringObj("", 0);
Tcl_IncrRefCount(session->context);
user = Tcl_GetVar2(interp, "tnm", "user", TCL_GLOBAL_ONLY);
if (! user) {
user = "******";
}
session->user = Tcl_NewStringObj(user, (int) strlen(user));
Tcl_IncrRefCount(session->user);
session->engineID = Tcl_NewStringObj("", 0);
Tcl_IncrRefCount(session->engineID);
session->maxSize = TNM_SNMP_MAXSIZE;
session->securityLevel = TNM_SNMP_AUTH_NONE | TNM_SNMP_PRIV_NONE;
session->maxSize = TNM_SNMP_MAXSIZE;
session->authPassWord = Tcl_NewStringObj("public", 6);
Tcl_IncrRefCount(session->authPassWord);
session->privPassWord = Tcl_NewStringObj("private", 6);
Tcl_IncrRefCount(session->privPassWord);
session->retries = TNM_SNMP_RETRIES;
session->timeout = TNM_SNMP_TIMEOUT;
session->window = TNM_SNMP_WINDOW;
session->delay = TNM_SNMP_DELAY;
session->tagList = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(session->tagList);
TnmOidInit(&session->enterpriseOid);
TnmOidFromString(&session->enterpriseOid, "1.3.6.1.4.1.1575");
return session;
}
static OSErr
OpenLibraryResource(
struct CFragInitBlock* initBlkPtr)
{
/*
* The 3.0 version of the Universal headers changed CFragInitBlock
* to an opaque pointer type. CFragSystem7InitBlock is now the
* real pointer.
*/
#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
struct CFragInitBlock *realInitBlkPtr = initBlkPtr;
#else
CFragSystem7InitBlock *realInitBlkPtr = (CFragSystem7InitBlock *) initBlkPtr;
#endif
FSSpec* fileSpec = NULL;
OSErr err = noErr;
if (realInitBlkPtr->fragLocator.where == kDataForkCFragLocator) {
fileSpec = realInitBlkPtr->fragLocator.u.onDisk.fileSpec;
} else if (realInitBlkPtr->fragLocator.where == kResourceCFragLocator) {
fileSpec = realInitBlkPtr->fragLocator.u.inSegs.fileSpec;
} else {
err = resFNotFound;
}
/*
* Open the resource fork for this library in read-only mode.
* This will make it the current res file, ahead of the
* application's own resources.
*/
if (fileSpec != NULL) {
ourResFile = FSpOpenResFile(fileSpec, fsRdPerm);
if (ourResFile == kResFileNotOpened) {
err = ResError();
} else {
#ifdef TCL_REGISTER_LIBRARY
ourResToken = Tcl_NewObj();
Tcl_IncrRefCount(ourResToken);
p2cstr(realInitBlkPtr->libName);
Tcl_SetStringObj(ourResToken, (char *) realInitBlkPtr->libName, -1);
c2pstr((char *) realInitBlkPtr->libName);
TclMacRegisterResourceFork(ourResFile, ourResToken,
TCL_RESOURCE_DONT_CLOSE);
#endif
SetResFileAttrs(ourResFile, mapReadOnly);
}
}
return err;
}
TclObject &
TclObject::lappend (Tcl_Obj *pElement)
{
if (Tcl_IsShared(m_pObj)) {
Tcl_DecrRefCount(m_pObj);
m_pObj = Tcl_DuplicateObj(m_pObj);
Tcl_IncrRefCount(m_pObj);
}
Tcl_ListObjAppendElement(NULL, m_pObj, pElement);
// TODO: Should check for error result if conversion to list failed.
return *this;
}
/*************************************************************************
* FUNCTION : RPMTransaction_Set::RPM_callback *
* ARGUMENTS : none *
* RETURNS : TCL_OK or TCL_ERROR *
* EXCEPTIONS : none *
* PURPOSE : Set or get problem mask flags *
*************************************************************************/
void *RPMTransaction_Set::RPM_callback( const void * h,
const rpmCallbackType what,
const unsigned long amount,
const unsigned long total,
fnpyKey key
)
{
// Build up the list of call back bits
Tcl_Obj *bitstring = Tcl_NewObj();
for (unsigned i = 0; i < sizeof(bits)/sizeof(bits[0]); ++i)
{
if (what & bits[i].bit)
{
Tcl_ListObjAppendElement(_interp,bitstring,Tcl_NewStringObj(bits[i].msg,-1));
}
}
RPMHeader_Obj *hdr = (RPMHeader_Obj *)key;
Tcl_Obj *cmd[] =
{
Tcl_NewStringObj("::RPM::Callback",-1),
bitstring,
Tcl_NewLongObj(amount),
Tcl_NewLongObj(total),
hdr?hdr->Get_obj():Tcl_NewObj()
};
Tcl_Obj *script = Tcl_NewListObj(sizeof(cmd)/sizeof(cmd[0]),cmd);
Tcl_IncrRefCount(script);
Tcl_EvalObj(_interp,script);
Tcl_DecrRefCount(script);
// Now, handle any special operations here
if (what & RPMCALLBACK_INST_OPEN_FILE)
{
assert(hdr);
FD_t fd = hdr->Open();
if (!fd || Ferror(fd))
{
if (fd)
{
Fclose(fd);
fd = 0;
}
}
return (void *)fd;
}
if (what & RPMCALLBACK_INST_CLOSE_FILE)
{
assert(hdr);
hdr->Close();
return 0;
}
return 0;
}
/* assign a var from a var */
Tcl_Obj*
TSP_Util_lang_assign_var_var(Tcl_Obj* targetVarName, Tcl_Obj* sourceVarName) {
if (targetVarName != NULL) {
Tcl_DecrRefCount(targetVarName);
}
/* targetVarName = Tcl_DuplicateObj(sourceVarName); */
targetVarName = sourceVarName;
Tcl_IncrRefCount(targetVarName);
return targetVarName;
}
int NS(SendEND_AND_CALLBACK) (NS_ARGS)
{
SETUP_mqctx
MQ_STR token;
Tcl_Obj *callback;
CHECK_C(token)
CHECK_OBJ(callback)
CHECK_NOARGS
Tcl_IncrRefCount(callback);
ErrorMqToTclWithCheck(MqSendEND_AND_CALLBACK(mqctx, token, NS(ProcCall), callback, NS(ProcFree)));
RETURN_TCL
}
static int
resolveTypes(Tcl_Interp *interp) {
Tcl_Obj *objv[6];
Tcl_Obj *list;
Tcl_Obj *dict;
// определение типа lambdaExpr
objv[0]=Tcl_NewStringObj("apply",-1);
objv[1]=Tcl_NewStringObj("x { expr $x + 1}",-1);
objv[2]=Tcl_NewIntObj(1),-1;
Tcl_IncrRefCount(objv[0]);
Tcl_IncrRefCount(objv[1]);
Tcl_IncrRefCount(objv[2]);
if (Tcl_EvalObjv(interp,3,objv,0)!=TCL_OK) {
ERR("in call apply");
INSPECT_ARRAY(-1,3,objv,"command");
return TCL_ERROR;
}
cmdNameType=objv[0]->typePtr;
lambdaExprType=objv[1]->typePtr;
// определение типа List
list=Tcl_NewListObj(3,objv);
listType=list->typePtr;
if (listType==NULL || listType->name==NULL || listType->name[0]=='\0') {
ERR("in resolve listType");
return TCL_ERROR;
}
Tcl_DecrRefCount(list);
Tcl_DecrRefCount(objv[0]);
Tcl_DecrRefCount(objv[1]);
Tcl_DecrRefCount(objv[2]);
// определение типа dict
dict=Tcl_NewDictObj();
if (dict==NULL || dict->typePtr==NULL) {
ERR("in resolve dictType");
return TCL_ERROR;
}
dictType=dict->typePtr;
return TCL_OK;
}
/* + style configure $style -option ?value...
*/
static int StyleConfigureCmd(
ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
StylePackageData *pkgPtr = clientData;
Ttk_Theme theme = pkgPtr->currentTheme;
const char *styleName;
Style *stylePtr;
int i;
if (objc < 3) {
usage:
Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??");
return TCL_ERROR;
}
styleName = Tcl_GetString(objv[2]);
stylePtr = Ttk_GetStyle(theme, styleName);
if (objc == 3) { /* style default $styleName */
Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->defaultsTable));
return TCL_OK;
} else if (objc == 4) { /* style default $styleName -option */
const char *optionName = Tcl_GetString(objv[3]);
Tcl_HashEntry *entryPtr =
Tcl_FindHashEntry(&stylePtr->defaultsTable, optionName);
if (entryPtr) {
Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr));
}
return TCL_OK;
} else if (objc % 2 != 1) {
goto usage;
}
for (i = 3; i < objc; i += 2) {
const char *optionName = Tcl_GetString(objv[i]);
Tcl_Obj *value = objv[i+1];
Tcl_HashEntry *entryPtr;
int newEntry;
entryPtr = Tcl_CreateHashEntry(
&stylePtr->defaultsTable,optionName,&newEntry);
Tcl_IncrRefCount(value);
if (!newEntry) {
Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr));
}
Tcl_SetHashValue(entryPtr, value);
}
ThemeChanged(pkgPtr);
return TCL_OK;
}
static int
Ta4r_PackageInit (Tcl_Interp *interp) {
Tcl_Namespace *ns;
Ta4r_Cmd *c;
Tcl_Obj *o;
Tcl_Obj *m;
Tcl_Obj *f;
if ((ns = Tcl_FindNamespace(interp, Ta4r, NULL, TCL_LEAVE_ERR_MSG)) == NULL) { return TCL_ERROR; }
m = Tcl_NewDictObj();
for (c = &Ta4r_Cmds[0]; c->name != NULL; c++) {
/* Put commands into sub-namespace so as not to conflict with ensemble name */
/* This will also create the sub-namespace. Slightly cheap? */
o = Tcl_ObjPrintf("%s::commands::%s", Ta4r, c->name);
Tcl_IncrRefCount(o);
f = Tcl_ObjPrintf("::tcl::mathfunc::%s", c->name);
Tcl_IncrRefCount(f);
if (Tcl_CreateObjCommand(interp, Tcl_GetString(o), c->proc, NULL, NULL) == NULL) {
Tcl_DecrRefCount(o);
Tcl_DecrRefCount(f);
return TCL_ERROR;
}
if (Tcl_CreateAlias(interp, Tcl_GetString(f), interp, Tcl_GetString(o), 0, NULL) != TCL_OK) {
Tcl_DecrRefCount(o);
Tcl_DecrRefCount(f);
return TCL_ERROR;
}
Tcl_DictObjPut(interp, m, Tcl_NewStringObj(c->name+4, -1), o);
Tcl_DecrRefCount(o);
Tcl_DecrRefCount(f);
}
if (Tcl_SetEnsembleMappingDict(interp,
Tcl_CreateEnsemble(interp, (Ta4r+2), ns, TCL_ENSEMBLE_PREFIX), m) != TCL_OK) { return TCL_ERROR; };
if (Tcl_Export(interp, ns, (Ta4r+2), 0) != TCL_OK) { return TCL_ERROR; }
return TCL_OK;
}
static void
SetVarToObj(
int varIndex, /* Designates the assignment variable. */
Tcl_Obj *objPtr) /* Points to object to assign to var. */
{
if (varPtr[varIndex] != NULL) {
Tcl_DecrRefCount(varPtr[varIndex]);
}
varPtr[varIndex] = objPtr;
if (objPtr != NULL) {
Tcl_IncrRefCount(objPtr);
}
}
/*
* ------------------------------------------------------------------------
* AddClassUnknowMethod()
*
* ------------------------------------------------------------------------
*/
static int
AddClassUnknowMethod(
Tcl_Interp *interp,
ItclObjectInfo *infoPtr,
Tcl_Class clsPtr)
{
ClientData tmPtr, pmPtr;
infoPtr->unknownNamePtr = Tcl_NewStringObj("unknown", -1);
Tcl_IncrRefCount(infoPtr->unknownNamePtr);
infoPtr->unknownArgumentPtr = Tcl_NewStringObj("m args", -1);
Tcl_IncrRefCount(infoPtr->unknownArgumentPtr);
infoPtr->unknownBodyPtr = Tcl_NewStringObj(clazzUnknownBody, -1);
Tcl_IncrRefCount(infoPtr->unknownBodyPtr);
tmPtr = (ClientData)Itcl_NewProcClassMethod(interp,
clsPtr, NULL, NULL, NULL, NULL, infoPtr->unknownNamePtr,
infoPtr->unknownArgumentPtr, infoPtr->unknownBodyPtr, &pmPtr);
if (tmPtr == NULL) {
Tcl_Panic("cannot add class method unknown");
}
return TCL_OK;
}
stf_status tpm_call_out(const char *name
, struct state *st
, struct connection *conn
, struct msg_digest *md)
{
Tcl_Obj **objv;
int objc=0, ret;
char *res;
Tcl_Obj *to;
passert(name != NULL);
objv = alloc_bytes(sizeof(Tcl_Obj *)*4, "tcl objv");
objv[0]=Tcl_NewStringObj(name, -1);
objv[1]=tpm_StateToInstanceObj(st);
objv[2]=tpm_ConnectionToInstanceObj(conn);
objv[3]=tpm_MessageDigestToInstanceObj(md);
Tcl_IncrRefCount(objv[0]);
Tcl_IncrRefCount(objv[1]);
Tcl_IncrRefCount(objv[2]);
Tcl_IncrRefCount(objv[3]);
objc=4;
ret = tpm_call_it(objv, objc);
while(objc > 0) {
objc--;
if(objv[objc]!=NULL) {
Tcl_DecrRefCount(objv[objc]);
objv[objc]=NULL;
}
}
pfree(objv);
passert(name != NULL);
return ret;
}
static void
CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr)
{
Checkbutton *checkPtr = recordPtr;
Tcl_Obj *variableObj;
/* default -variable is the widget name:
*/
variableObj = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1);
Tcl_IncrRefCount(variableObj);
checkPtr->checkbutton.variableObj = variableObj;
BaseInitialize(interp, recordPtr);
}
static int InitNullValueForDB(Tcl_Interp *interp, VTableDB *vtdbP)
{
Tcl_Obj *objv[2];
int status;
objv[0] = vtdbP->dbcmd_objP; /* No need to IncrRef this as vtdbP
already ensures that */
objv[1] = Tcl_NewStringObj("nullvalue", -1);
Tcl_IncrRefCount(objv[1]);
status = Tcl_EvalObjv(interp, 2, objv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objv[1]);
if (status == TCL_ERROR)
return TCL_ERROR;
if (vtdbP->null_objP)
Tcl_DecrRefCount(vtdbP->null_objP);
vtdbP->null_objP = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(vtdbP->null_objP);
return TCL_OK;
}
static void tvfsExecTcl(
Testvfs *p,
const char *zMethod,
Tcl_Obj *arg1,
Tcl_Obj *arg2,
Tcl_Obj *arg3
){
int rc; /* Return code from Tcl_EvalObj() */
int nArg; /* Elements in eval'd list */
int nScript;
Tcl_Obj ** ap;
assert( p->pScript );
if( !p->apScript ){
int nByte;
int i;
if( TCL_OK!=Tcl_ListObjGetElements(p->interp, p->pScript, &nScript, &ap) ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
return;
}
p->nScript = nScript;
nByte = (nScript+TESTVFS_MAX_ARGS)*sizeof(Tcl_Obj *);
p->apScript = (Tcl_Obj **)ckalloc(nByte);
memset(p->apScript, 0, nByte);
for(i=0; i<nScript; i++){
p->apScript[i] = ap[i];
}
}
p->apScript[p->nScript] = Tcl_NewStringObj(zMethod, -1);
p->apScript[p->nScript+1] = arg1;
p->apScript[p->nScript+2] = arg2;
p->apScript[p->nScript+3] = arg3;
for(nArg=p->nScript; p->apScript[nArg]; nArg++){
Tcl_IncrRefCount(p->apScript[nArg]);
}
rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
if( rc!=TCL_OK ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
}
for(nArg=p->nScript; p->apScript[nArg]; nArg++){
Tcl_DecrRefCount(p->apScript[nArg]);
p->apScript[nArg] = 0;
}
}
static int
ConsoleOutput(
ClientData instanceData, /* Indicates which device to use. */
const char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
ChannelData *data = instanceData;
ConsoleInfo *info = data->info;
*errorCode = 0;
Tcl_SetErrno(0);
if (info) {
Tcl_Interp *consoleInterp = info->consoleInterp;
if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
Tcl_DString ds;
Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8");
/*
* Not checking for utf8 == NULL. Did not check for TCL_ERROR
* from Tcl_SetChannelOption() in Tk_InitConsoleChannels() either.
* Assumption is utf-8 Tcl_Encoding is reliably present.
*/
const char *bytes
= Tcl_ExternalToUtfDString(utf8, buf, toWrite, &ds);
int numBytes = Tcl_DStringLength(&ds);
Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);
Tcl_FreeEncoding(utf8);
if (data->type == TCL_STDERR) {
Tcl_ListObjAppendElement(NULL, cmd,
Tcl_NewStringObj("stderr", -1));
} else {
Tcl_ListObjAppendElement(NULL, cmd,
Tcl_NewStringObj("stdout", -1));
}
Tcl_ListObjAppendElement(NULL, cmd,
Tcl_NewStringObj(bytes, numBytes));
Tcl_DStringFree(&ds);
Tcl_IncrRefCount(cmd);
Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
}
}
return toWrite;
}
/*
** This is the callback from a quota-over-limit.
*/
static void tclQuotaCallback(
const char *zFilename, /* Name of file whose size increases */
sqlite3_int64 *piLimit, /* IN/OUT: The current limit */
sqlite3_int64 iSize, /* Total size of all files in the group */
void *pArg /* Client data */
){
TclQuotaCallback *p; /* Callback script object */
Tcl_Obj *pEval; /* Script to evaluate */
Tcl_Obj *pVarname; /* Name of variable to pass as 2nd arg */
unsigned int rnd; /* Random part of pVarname */
int rc; /* Tcl error code */
p = (TclQuotaCallback *)pArg;
if( p==0 ) return;
pVarname = Tcl_NewStringObj("::piLimit_", -1);
Tcl_IncrRefCount(pVarname);
sqlite3_randomness(sizeof(rnd), (void *)&rnd);
Tcl_AppendObjToObj(pVarname, Tcl_NewIntObj((int)(rnd&0x7FFFFFFF)));
Tcl_ObjSetVar2(p->interp, pVarname, 0, Tcl_NewWideIntObj(*piLimit), 0);
pEval = Tcl_DuplicateObj(p->pScript);
Tcl_IncrRefCount(pEval);
Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zFilename, -1));
Tcl_ListObjAppendElement(0, pEval, pVarname);
Tcl_ListObjAppendElement(0, pEval, Tcl_NewWideIntObj(iSize));
rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
if( rc==TCL_OK ){
Tcl_Obj *pLimit = Tcl_ObjGetVar2(p->interp, pVarname, 0, 0);
rc = Tcl_GetWideIntFromObj(p->interp, pLimit, piLimit);
Tcl_UnsetVar(p->interp, Tcl_GetString(pVarname), 0);
}
Tcl_DecrRefCount(pEval);
Tcl_DecrRefCount(pVarname);
if( rc!=TCL_OK ) Tcl_BackgroundError(p->interp);
}
ClientData
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
char *nativePathPtr;
const char *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
size_t len;
if (TclFSCwdIsNative()) {
/*
* The cwd is native, which means we can use the translated path
* without worrying about normalization (this will also usually be
* shorter so the utf-to-external conversion will be somewhat faster).
*/
validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
if (validPathPtr == NULL) {
return NULL;
}
} else {
/*
* Make sure the normalized path is set.
*/
validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (validPathPtr == NULL) {
return NULL;
}
Tcl_IncrRefCount(validPathPtr);
}
str = TclGetString(validPathPtr);
len = validPathPtr->length;
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
/* See bug [3118489]: NUL in filenames */
Tcl_DecrRefCount(validPathPtr);
Tcl_DStringFree(&ds);
return NULL;
}
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
return nativePathPtr;
}
static Tcl_Obj *
GetConfigDict(
Tcl_Interp *interp)
{
Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
if (pDB == NULL) {
pDB = Tcl_NewDictObj();
Tcl_IncrRefCount(pDB);
Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
}
return pDB;
}
static int
resolveCommands(Tcl_Interp *interp,struct CommandEntry *table)
{
struct CommandEntry *entry;
if (table==NULL) return TCL_ERROR;
for(entry=table+0;entry->name!=NULL;entry++) {
entry->nameObj=Tcl_NewStringObj(entry->name,-1);
Tcl_IncrRefCount(entry->nameObj);
entry->token=Tcl_GetCommandFromObj(interp,entry->nameObj);
if (entry->token==NULL) {
ERR("Unresolved %s",entry->name);
return TCL_ERROR;
}
if (entry->saveNamePtr!=NULL) {
*entry->saveNamePtr=entry->nameObj;
Tcl_IncrRefCount(entry->nameObj);
}
if (entry->saveTokenPtr!=NULL) {
*entry->saveTokenPtr=entry->token;
}
}
return TCL_OK;
}
//
// Return a list of ctable quote type names (cache it, too)
//
CTABLE_INTERNAL Tcl_Obj *ctable_quoteTypeList(Tcl_Interp *interp)
{
static Tcl_Obj *result = NULL;
if (!result) {
int index;
result = Tcl_NewObj();
for(index = 0; ctable_quote_names[index]; index++) {
Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(ctable_quote_names[index], -1));
}
Tcl_IncrRefCount(result);
}
return result;
}
stf_status tpm_call_out_crypt(const char *name
, struct state *st
, pb_stream *pbs, int off, int len)
{
Tcl_Obj **objv;
int objc=0, ret;
char *res;
Tcl_Obj *to;
objv = alloc_bytes(sizeof(Tcl_Obj *)*5, "tcl objv");
objv[0]=Tcl_NewStringObj(name, -1);
objv[1]=tpm_StateToInstanceObj(st);
objv[2]=tpm_PbStreamToInstanceObj(pbs);
objv[3]=Tcl_NewIntObj(off);
objv[4]=Tcl_NewIntObj(len);
Tcl_IncrRefCount(objv[0]);
Tcl_IncrRefCount(objv[1]);
Tcl_IncrRefCount(objv[2]);
Tcl_IncrRefCount(objv[3]);
Tcl_IncrRefCount(objv[4]);
objc=5;
ret = tpm_call_it(objv, objc);
while(objc > 0) {
objc--;
if(objv[objc]!=NULL) {
Tcl_DecrRefCount(objv[objc]);
objv[objc]=NULL;
}
}
pfree(objv);
return ret;
}
/*
*---------------------------------------------------------------------------
*
* HtmlImagePixmap --
*
* Results:
* Pixmap. Or zero.
*
* Side effects:
* May change the image storage to pixmap.
*
*---------------------------------------------------------------------------
*/
Pixmap
HtmlImagePixmap(HtmlImage2 *pImage)
{
if (!pImage->pImageServer->pTree->options.imagepixmapify ||
!pImage->pImageName ||
!getImageCompressed(pImage) ||
pImage->width<=0 ||
pImage->height<=0
) {
return 0;
}
if (!pImage->isValid) {
HtmlImageImage(pImage);
}
if (!pImage->pixmap && !HtmlImageAlphaChannel(pImage)) {
Tk_Window win = pImage->pImageServer->pTree->tkwin;
Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
Pixmap pix;
int rc;
Tcl_Obj *pGetData;
#if 0
printf("Pixmapifying - nData = %d\n", nData);
#endif
pix = Tk_GetPixmap(Tk_Display(win), Tk_WindowId(win),
pImage->width, pImage->height, Tk_Depth(win)
);
Tk_RedrawImage(
pImage->image, 0, 0, pImage->width, pImage->height, pix, 0, 0
);
pImage->pixmap = pix;
pGetData = Tcl_NewObj();
Tcl_IncrRefCount(pGetData);
Tcl_ListObjAppendElement(0, pGetData, Tcl_NewStringObj("image",-1));
Tcl_ListObjAppendElement(0, pGetData, Tcl_NewStringObj("create",-1));
Tcl_ListObjAppendElement(0, pGetData, Tcl_NewStringObj("photo",-1));
Tcl_ListObjAppendElement(0, pGetData, pImage->pImageName);
pImage->nIgnoreChange++;
rc = Tcl_EvalObjEx(interp, pGetData, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
pImage->nIgnoreChange--;
Tcl_DecrRefCount(pGetData);
assert(rc==TCL_OK);
}
return pImage->pixmap;
}
stf_status tpm_call_out_notify(const char *name
, struct state *st
, pb_stream *pbs
, struct isakmp_hdr *hdr)
{
Tcl_Obj **objv;
int objc=0, ret;
char *res;
Tcl_Obj *to;
objv = alloc_bytes(sizeof(Tcl_Obj *)*4, "tcl objv");
objv[0]=Tcl_NewStringObj(name, -1);
objv[1]=tpm_StateToInstanceObj(st);
objv[2]=tpm_PbStreamToInstanceObj(pbs);
objv[3]=tpm_IsakmpHdrToInstanceObj(hdr);
Tcl_IncrRefCount(objv[0]);
Tcl_IncrRefCount(objv[1]);
Tcl_IncrRefCount(objv[2]);
Tcl_IncrRefCount(objv[3]);
objc=4;
ret = tpm_call_it(objv, objc);
while(objc > 0) {
objc--;
if(objv[objc]!=NULL) {
Tcl_DecrRefCount(objv[objc]);
objv[objc]=NULL;
}
}
pfree(objv);
return ret;
}
static int tclvarFilter(
sqlite3_vtab_cursor *pVtabCursor,
int idxNum, const char *idxStr,
int argc, sqlite3_value **argv
){
tclvar_cursor *pCur = (tclvar_cursor *)pVtabCursor;
Tcl_Interp *interp = ((tclvar_vtab *)(pVtabCursor->pVtab))->interp;
Tcl_Obj *p = Tcl_NewStringObj("info vars", -1);
Tcl_IncrRefCount(p);
assert( argc==0 || argc==1 );
if( argc==1 ){
Tcl_Obj *pArg = Tcl_NewStringObj((char*)sqlite3_value_text(argv[0]), -1);
Tcl_ListObjAppendElement(0, p, pArg);
}
Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
pCur->pList1 = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(pCur->pList1);
assert( pCur->i1==0 && pCur->i2==0 && pCur->pList2==0 );
Tcl_DecrRefCount(p);
return tclvarNext(pVtabCursor);
}