--- /dev/null
+/*
+ openisis - an open implementation of the CDS/ISIS database
+ Version 0.8.x (patchlevel see file Version)
+ Copyright (C) 2001-2003 by Erik Grziwotz, erik@openisis.org
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+ see README for more information
+EOH */
+
+/*
+ $Id: openisistcl.c,v 1.77 2003/06/24 11:01:53 mawag Exp $
+ tcl/tk binding
+*/
+
+
+#include "openisis.h"
+#include "openisistcl.h"
+#include "luti.h"
+/* luti_getembed,
+ * luti_ptrincr,
+ * luti_parse_path,
+ * luti_free,
+ * luti_append
+*/
+#include "ldsp.h" /* openIsisEnc2Utf8,openIsisEval */
+#include "lses.h" /* SESGET() */
+
+/*
+include this after the Tcl stuff for the benefit of those
+who use the 150% braindead gcc 2.96
+which barfs on
+ declaration of `index' shadows global declaration
+in generic/tclDecls.h
+cause string.h declares
+char *index(const char *s, int c)
+*/
+#include <errno.h>
+#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef WIN32
+#define snprintf _snprintf
+#endif
+
+/*
+#ifdef _REENTRANT
+unusable because of POSIX stdfoo.h braindamage
+-- they mix up MT with reentrant.
+
+Hmm, actually, _REENTRANT *is* the wrong flag for threads.
+But, unfortunately, the *thread* thing #define errno *errnolocation()
+is bound to this flag by POSIX (mas o menos).
+You need the reentrant functions in every stupid single threaded signal handler.
+Therefore, it's a pretty poor idea of Solaris (albeit very POSIX compliant)
+to not define them unless _REENTRANT.
+
+*sigh*
+
+from /opt/TclTk/tcl8.3.5/unix/configure:
+ SunOS-5.[0-6]*)
+
+ # Note: If _REENTRANT isn't defined, then Solaris
+ # won't define thread-safe library routines.
+
+ cat >> confdefs.h <<\EOF
+#define _REENTRANT 1
+EOF
+*/
+#ifdef TCL_THREADS
+extern int openisis_threaded;
+static int *link_dummy = &openisis_threaded; /* force correct linkage */
+#endif
+
+
+/* ============================ types ==================================
+*/
+
+/* name of local schema */
+#define OIT_STB0 "openIsisRoot"
+
+typedef enum {
+ /* record commands */
+ RC_ADD,
+ RC_CLON,
+ RC_COPY,
+ RC_DB, /* stub, too */
+ RC_DEL,
+ RC_DESER,
+ RC_DO,
+ RC_DONE, /* stub, too */
+ RC_FDT, /* stub, too */
+ RC_FMT,
+ RC_GET,
+ RC_ROW,
+ RC_LEN,
+ RC_SERI,
+ RC_SET,
+ RC_WRAP,
+ RC_LAST = RC_WRAP, /* used for checking last rec cmd */
+ /* stub commands */
+ SC_NEW,
+ SC_RECV,
+ SC_RQS,
+ SC_ARQS,
+ SC_ARSP
+} OITCmd;
+
+static const char *OITOpts[] = {
+ /* record commands */
+ "add",
+ "clone",
+ "copy",
+ "db",
+ "delete",
+ "deserialize",
+ "do",
+ "done",
+ "fdt",
+ "format",
+ "get",
+ "rowid",
+ "length",
+ "serialize",
+ "set",
+ "wrap",
+ /* stub commands */
+ "new",
+ "recv",
+ "request",
+ ".req",
+ ".res",
+ 0
+};
+
+#define OIT_RS_SZM 0x000FF /* size mask */
+#define OIT_RS_RQS 0x00100 /* schemas request rec */
+#define OIT_RS_RSP 0x00200 /* schemas response rec */
+#define OIT_RS_STC 0x00400 /* schemas config rec */
+#define OIT_RS_DBC 0x00800 /* db config rec */
+#define OIT_RS_DBF 0x01000 /* db fdt rec */
+#define OIT_RS_USED 0x10000 /* rec is in use */
+#define OIT_RS_FRE 0x20000 /* free associated memory */
+#define OIT_RS_OWNF 0x40000 /* record has own fdt that must be freed */
+
+#define RecType(r) (0x01F00 & (r)->stat)
+#define NonWritable(r) (0x01A00 & (r)->stat)
+#define NonDeletable(r) (0x00700 & (r)->stat)
+
+typedef struct OITSess OITSess;
+
+typedef struct {
+ OpenIsisRec *rec;
+ OpenIsisDb *db; /* own db; tmp set to target db in rqs */
+ const OpenIsisFdt *fdt; /* own fdt */
+ const char *cmd; /* associated tcl ip cmd */
+ int sid; /* allocator */
+ int stat;
+} OITRec;
+
+#define RecSess(r) \
+ (0 <= ((OITRec*)(r))->sid && NumSessions > ((OITRec*)(r))->sid ? \
+ Sessions + ((OITRec*)(r))->sid : 0)
+
+typedef struct {
+ OITRec env;
+ OpenIsisStub stb;
+ OITRec **recs; /* embedded recs */
+ int numr;
+} OITCont;
+
+#define OIT_ST_ROOT 0x0001
+#define OIT_ST_TCL 0x0002
+#define OIT_ST_OINIT 0x0004
+
+typedef struct {
+ OpenIsisStub stb;
+ OITRec cfg; /* direct schema copy allocated by ses0 */
+ OITCont *rqs;
+ OITCont *rsp;
+ const char *cmd; /* associated tcl ip cmd */
+ Tcl_Obj *dfltproc;
+ Tcl_Obj *actproc;
+ int ases; /* act session of rqs and rsp */
+ int stat;
+} OITStub;
+
+#define StbSess(s) (0 <= (s)->ases && NumSessions > (s)->ases ? \
+ Sessions + (s)->ases : 0)
+
+struct OITSess {
+ Tcl_Interp *ip;
+ OITRec **recs;
+ int numr;
+ int six;
+};
+
+static OITSess *Sessions = 0;
+static int NumSessions = 0;
+
+/* ============================ records ================================
+*/
+
+#define OIT_RECINCR 32
+#define OIT_MAXRECS 65535
+#define OIT_SESSINCR 1
+#define OIT_MAXSESS 255
+
+static void CtorRec (OITRec *that, int sid, int siz) {
+ memset (that, 0, (unsigned)siz);
+ that->stat = siz;
+ that->sid = sid;
+}
+
+static int AllcRec (OITSess *ois, int siz, int type) {
+ int j;
+ if (siz > OIT_RS_SZM) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] AllcRec: unexpected size %d", siz);
+ }
+ for (j = ois->numr; 0 <= --j; ) {
+ if (! ois->recs[j]) {
+ goto allcj;
+ }
+ if (! (OIT_RS_USED & ois->recs[j]->stat) &&
+ siz == (OIT_RS_SZM & ois->recs[j]->stat) /* may be <= */
+ ) {
+ goto done;
+ }
+ }
+ j = luti_ptrincr (
+ &ois->recs, &ois->numr, OIT_RECINCR, sizeof (OITRec*), OIT_MAXRECS);
+ if (0 > j) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] AllcRec: out of memory");
+ }
+allcj:
+ ois->recs[j] = (OITRec*) openIsisMAlloc (siz);
+ if (! ois->recs[j]) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] AllcRec: out of memory");
+ }
+ CtorRec (ois->recs[j], ois->six, siz);
+done:
+ ois->recs[j]->stat |= type | OIT_RS_USED;
+ return j;
+}
+
+static int NewRec (
+ OITSess *ois, OpenIsisDb *db, const OpenIsisFdt *fdt, int type
+) {
+ int j = AllcRec (ois, sizeof (OITRec), type);
+ if (0 <= j) {
+ ois->recs[j]->db = db;
+ ois->recs[j]->fdt = fdt;
+ }
+ return j;
+}
+
+static int NewCont (OITSess *ois, const OpenIsisFdt *fdt, int type) {
+ int j = AllcRec (ois, sizeof (OITCont), type);
+ if (0 <= j) {
+ ois->recs[j]->fdt = fdt;
+ }
+ return j;
+}
+
+static void DtorRecs (OITRec **recs, int numr, int frmem);
+
+static void DtorRec (OITRec *that, int frmem) {
+ if (that) {
+ OITCont *con;
+ OITSess *ois;
+ int siz, type;
+ ois = RecSess (that);
+ if (! ois) {
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] DtorRec: illegal sid %d(%d)",
+ that->sid, NumSessions);
+ return;
+ }
+ if (that->cmd) {
+ if (frmem) {
+ that->stat |= OIT_RS_FRE;
+ }
+ Tcl_DeleteCommand (ois->ip, (char*)that->cmd);
+ return;
+ }
+ type = RecType (that);
+ siz = OIT_RS_SZM & that->stat;
+ switch (type) {
+ case 0:
+ case OIT_RS_DBF:
+ if (that->rec) {
+ openIsisMFree (that->rec);
+ }
+ break;
+ case OIT_RS_DBC:
+ /* that->rec = 0; readonly cfg handled by db */
+ break;
+ case OIT_RS_RQS:
+ if (that->rec) {
+ openIsisMFree (that->rec);
+ }
+ /* fall thru */
+ case OIT_RS_RSP:
+ /* that->rec = 0; response record handled by stub */
+ con = (OITCont*)that;
+ DtorRecs (con->recs, con->numr, 0);
+ break;
+ default:
+ /* OIT_RS_STC embedded in OITStub and handled by stub */
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] DtorRec: unexpected type %x", type);
+ return;
+ }
+ if ((OIT_RS_OWNF & that->stat)) {
+ openIsisFFree ((OpenIsisFdt*)that->fdt);
+ }
+ if (frmem || (OIT_RS_FRE & that->stat)) {
+ openIsisMFree (that);
+ }
+ else {
+ CtorRec (that, ois->six, siz);
+ }
+ }
+}
+
+static void DtorRecs (OITRec **recs, int numr, int frmem) {
+ if (recs) {
+ while (0 <= --numr) {
+ DtorRec (recs[numr], frmem);
+ }
+ openIsisMFree (recs);
+ }
+}
+
+static int CtorSess (Tcl_Interp *ip) {
+ int j = luti_ptrincr (
+ &Sessions, &NumSessions, OIT_SESSINCR, sizeof (OITSess), OIT_MAXSESS);
+ if (0 > j) {
+ return -1;
+ }
+ Sessions[j].ip = ip;
+ Sessions[j].six = j;
+ return j;
+}
+
+static void DtorSess (OITSess *that) {
+ DtorRecs (that->recs, that->numr, !0);
+}
+
+static void ExitSess () {
+ int j;
+ if (NumSessions) {
+ for (j = NumSessions; 0 <= --j; ) {
+ DtorSess (Sessions + j);
+ }
+ openIsisMFree (Sessions);
+ Sessions = 0;
+ NumSessions = 0;
+ }
+}
+
+/* ---------------------------------------------------------------------
+*/
+
+static unsigned _RecId = 0;
+
+static char* NewRecId (char *buf) {
+ sprintf (buf, "openIsisRec%u", ++_RecId);
+ return buf;
+}
+
+static void TclDelRec (ClientData cld) {
+ OITRec *that = (OITRec*)cld;
+ if (that->cmd) {
+ openIsisMFree ((void*)that->cmd);
+ that->cmd = 0;
+ }
+ DtorRec ((OITRec*)cld, 0);
+}
+
+static int CmdRec (
+ ClientData rid, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
+);
+
+static int CrtRecCmd (OITSess *ois, const char *name, OITRec *rec, int srst) {
+ char buf[64];
+ if (! name || ! *name) {
+ name = NewRecId (buf);
+ }
+ rec->cmd = (const char*) openIsisMDup (name, -1);
+ if (! rec->cmd) {
+ Tcl_AppendResult (ois->ip, "CrtRecCmd: out of memory", 0);
+ return TCL_ERROR;
+ }
+ Tcl_CreateObjCommand (ois->ip, (char*)name, &CmdRec, rec, &TclDelRec);
+ if (srst) {
+ Tcl_SetResult (ois->ip, (char*)name, TCL_VOLATILE);
+ }
+ return TCL_OK;
+}
+
+static char **ToArgv (
+ Tcl_Obj* const objv[], int objc, char* buf, int siz
+) {
+ char *str, *nb;
+ char *res = buf;
+ int posp = 0;
+ int stav = objc * sizeof (char*);
+ int posv = stav;
+ int j, len, nsz;
+ for (j = 0; objc > j; ++j) {
+ str = Tcl_GetStringFromObj (objv[j], &len);
+ nsz = posv + 1 + len;
+ if (siz < nsz) {
+ char **S, **T;
+ int k, diff;
+ nsz *= 2;
+ nb = (char*) openIsisMAlloc (nsz);
+ if (! nb) {
+ openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] ToArgv: out of memory");
+ return 0;
+ }
+ diff = nb - res;
+ for (k = j, S = (char**)res, T = (char**)nb ; 0 <= --k; ) {
+ *T++ = *S++ + diff;
+ }
+ memcpy (nb + stav, res + stav, (unsigned)(posv - stav));
+ if (res != buf) {
+ openIsisMFree (res);
+ }
+ siz = nsz;
+ res = nb;
+ }
+ *(char**)(res + posp) = res + posv;
+ ((char*) memcpy (res + posv, str, len)) [len] = 0;
+ posp += sizeof (char*);
+ posv += 1 + len;
+ }
+ return (char**)res;
+}
+
+static OITRec* TclCmd2Rec (
+ Tcl_Interp *ip, const char *cmd, const char *arg0
+) {
+ Tcl_CmdInfo info;
+ if (! cmd) {
+ if (arg0) {
+ Tcl_AppendResult (ip, arg0, ": record command not given", 0);
+ }
+ return 0;
+ }
+ if (! Tcl_GetCommandInfo (ip, cmd, &info)) {
+ if (arg0) {
+ Tcl_AppendResult (ip, arg0, ": no such record: ", cmd, 0);
+ }
+ return 0;
+ }
+ if (info.objProc != &CmdRec) {
+ if (arg0) {
+ Tcl_AppendResult (ip, arg0, ": ", cmd, " is not a record", 0);
+ }
+ return 0;
+ }
+ if (! info.objClientData) {
+ if (arg0) {
+ Tcl_AppendResult (ip, arg0, ": ", cmd, " is corrupted", 0);
+ }
+ return 0;
+ }
+ return (OITRec*) info.objClientData;
+}
+
+static int BuildEmbRecs (
+ OITCont *that, OpenIsisRec **recs, int numr, int frr
+) {
+ OITSess *ois;
+ OITRec **oirs;
+ int buf[1000];
+ int *idx = buf;
+ int j;
+ ois = RecSess (that);
+ if (! ois) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] BuildEmbRecs: illegal sid %d(%d)",
+ that->env.sid, NumSessions);
+ }
+ oirs = (OITRec**) openIsisMAlloc ( (int) (numr * sizeof (OITRec*)));
+ if (! oirs) {
+ if (frr) {
+ luti_free ((void**)recs, numr);
+ }
+ return openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
+ }
+ if (1000 < numr) {
+ idx = (int*) openIsisMAlloc ( (int) (numr * sizeof (int)));
+ if (! idx) {
+ if (frr) {
+ luti_free ((void**)recs, numr);
+ }
+ openIsisMFree (oirs);
+ return openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
+ }
+ }
+ for (j = numr; 0 <= --j; ) {
+ idx[j] = NewRec (ois, 0, 0, 0);
+ if (0 > idx[j]) {
+ if (frr) {
+ luti_free ((void**)recs, numr);
+ }
+ openIsisMFree (oirs);
+ if (idx != buf) {
+ openIsisMFree (idx);
+ }
+ return openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
+ }
+ }
+ for (j = numr; 0 <= --j; ) {
+ oirs[j] = ois->recs[idx[j]];
+ oirs[j]->rec = recs[j];
+ }
+ that->recs = oirs;
+ that->numr = numr;
+ if (idx != buf) {
+ openIsisMFree (idx);
+ }
+ if (frr) {
+ openIsisMFree (recs);
+ }
+ return numr;
+}
+
+static int BuildRqsRecs (OITCont *that) {
+ OpenIsisRec *recs[4] = { 0, 0, 0, 0 }; /* REC, IDX, CFG, fdt */
+ int numr;
+ numr = BuildEmbRecs (that, recs, 4, 0);
+ if (4 == numr) {
+ if ((that->recs[0]->db = that->env.db)) {
+ that->recs[0]->fdt = that->env.db->fdt;
+ }
+ that->recs[2]->fdt = openIsisFdtDbpar;
+ that->recs[3]->fdt = openIsisFdtFdt;
+ }
+ return numr;
+}
+
+static int BuildRspRecs (OITCont *that, Tcl_Interp *ip, const char *arg0) {
+ OpenIsisRec **recs;
+ OpenIsisDb *db;
+ int *rows; /* save rowid in recs */
+ int numr, j;
+ numr = openIsisNGetResult (that->stb, &rows, &recs, &db, 0);
+ if (0 > numr) {
+ Tcl_AppendResult (ip, arg0,
+ ": child allocation failure", 0);
+ return numr;
+ }
+ if (rows) {
+ openIsisMFree (rows);
+ }
+ if (0 == numr || ! recs) {
+ return 0;
+ }
+ j = BuildEmbRecs (that, recs, numr, !0);
+ if (j != numr) {
+ Tcl_AppendResult (ip, arg0,
+ ": child allocation failure", 0);
+ return j;
+ }
+ if (db) {
+ for (j = numr; 0 <= --j; ) {
+ that->recs[j]->db = db;
+ that->recs[j]->fdt = db->fdt;
+ }
+ }
+ return numr;
+}
+
+static int UsageRec (Tcl_Interp *ip, const char *arg0) {
+ if (! arg0) {
+ arg0 = "<openIsisRecord>";
+ }
+ Tcl_AppendResult (ip,
+ "usage: ", arg0,
+ " add field value ?field value ...? |",
+ " clone ?options? newname ?field value ...? |",
+ " copy source |",
+ " db ?options? |",
+ " delete ?field ...? |",
+ " deserialize line |",
+ " do ?tagvar? valvar body |",
+ " done |",
+ " fdt ?options? |",
+ " format ?options? format |",
+ " get ?-tags | -tagnames | field ...? |",
+ " rowid |",
+ " serialize |",
+ " set field ?value field value ...? |",
+ " wrap ?options? recname |",
+ " .path ?option arg ...?",
+ 0);
+ return TCL_ERROR;
+}
+
+static int OpPath (
+ OITRec *that, Tcl_Interp *ip, const char *arg0,
+ Tcl_Obj *arg1, int argc, Tcl_Obj* const argv[]
+);
+
+static int OpDb (Tcl_Interp *ip,
+ OITSess *ois, OpenIsisDb *db, int argc, Tcl_Obj* const argv[]
+) {
+ OITRec *oir;
+ int rt;
+ rt = NewRec (ois, 0, openIsisFdtDbpar, OIT_RS_DBC);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, "openIsisDb: out of memory", 0);
+ return TCL_ERROR;
+ }
+ oir = ois->recs[rt];
+ oir->rec = db->cfg;
+ if (argc) {
+ rt = OpPath (oir, ip, "openIsisDb", argv[0], argc - 1, argv + 1);
+ DtorRec (oir, 0);
+ return rt;
+ }
+ return CrtRecCmd (ois, 0, oir, !0);
+}
+
+static int OpFdt (Tcl_Interp *ip,
+ OITSess *ois, const OpenIsisFdt *fdt, int argc, Tcl_Obj* const argv[]
+) {
+ OITRec *oir;
+ int rt;
+ rt = NewRec (ois, 0, openIsisFdtFdt, OIT_RS_DBF);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, "openIsisFdt: out of memory", 0);
+ return TCL_ERROR;
+ }
+ oir = ois->recs[rt];
+ oir->rec = openIsisFFdt2Rec (fdt, 0, 0);
+ if (argc) {
+ rt = OpPath (oir, ip, "openIsisFdt", argv[0], argc - 1, argv + 1);
+ DtorRec (oir, 0);
+ return rt;
+ }
+ return CrtRecCmd (ois, 0, oir, !0);
+}
+
+#define FldObj( f ) Tcl_NewStringObj( (f)->val, (f)->len )
+
+static Tcl_Obj* FdObj (OpenIsisField *fld, const OpenIsisFdt *fdt) {
+ if (fdt) {
+ OpenIsisFd *fd = openIsisFById (fdt, fld->tag, 0);
+ if (fd) {
+ return Tcl_NewStringObj (fd->name, -1);
+ }
+ }
+ return Tcl_NewIntObj (fld->tag);
+}
+
+static int OpRec (
+ OITRec *that, Tcl_Interp *ip, const char *arg0,
+ const OITCmd cmd, int argc, Tcl_Obj* const argv[]
+) {
+ OITSess *ois = RecSess (that);
+ if (! ois) {
+ Tcl_AppendResult (ip, arg0, ": record corrupted", 0);
+ return TCL_ERROR;
+ }
+
+ switch (cmd) {
+
+ case RC_SET:
+ case RC_ADD: {
+ char buf[2048];
+ OpenIsisRec *oldrec;
+ char **argp = 0;
+ char **args = 0;
+ int setf = 0;
+ int len;
+ if (0 == argc) {
+ return UsageRec (ip, arg0);
+ }
+ if (RC_SET == cmd) {
+ if (1 == argc) {
+ goto op_get;
+ }
+ if ( that->rec ) {
+ setf = OPENISIS_RCHG;
+ }
+ }
+ if (NonWritable (that)) {
+ Tcl_AppendResult (ip, arg0, ": readonly record", 0);
+ return TCL_ERROR;
+ }
+ args = argp = ToArgv (argv, argc, buf, sizeof (buf));
+ if (! argp) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ while (argc) {
+ if ('-' != args[0][0]) {
+ break;
+ }
+ len = strlen (args[0]);
+ if (1 == len || '-' == args[0][1]) {
+ break;
+ }
+ if (0 == strncmp ("-ignore", args[0], len)) {
+ setf |= OPENISIS_RIGN;
+ ++args;
+ --argc;
+ continue;
+ }
+ if (RC_SET != cmd) {
+ break;
+ }
+ if (0 == strncmp ("-default", args[0], len)) {
+ setf = OPENISIS_RDFLT | (OPENISIS_RIGN & setf);
+ ++args;
+ --argc;
+ continue;
+ }
+ break;
+ }
+ oldrec = that->rec;
+ that->rec = openIsisRSet (oldrec,
+ OPENISIS_RARGV | OPENISIS_RFDT | OPENISIS_RDIS | setf | argc,
+ that->fdt, args);
+ if (argp != (char**)buf) {
+ openIsisMFree (argp);
+ }
+ if (! that->rec && (oldrec || (argc && !(OPENISIS_RIGN & setf)))) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ } /* RC_SET, RC_ADD */
+
+ case RC_CLON: {
+ char buf[64];
+ OITRec *nrec;
+ char *opt = 0;
+ char *name = 0;
+ int empty = 0;
+ int nn = 0;
+ int j, len, rt, id;
+ if ((OIT_RS_RQS | OIT_RS_RSP) & that->stat) {
+ Tcl_AppendResult (ip, arg0,
+ ": container cloning not allowed", 0);
+ return TCL_ERROR;
+ }
+ for (j = 0; argc > j; ++j) {
+ opt = Tcl_GetStringFromObj (argv[j], &len);
+ if (0 == len) {
+ return UsageRec (ip, arg0);
+ }
+ if ('-' != *opt) {
+ break;
+ }
+ if (0 == opt[1]) {
+ nn = !0;
+ ++j;
+ break;
+ }
+ if (0 == strncmp ("-empty", opt, len)) {
+ empty = !0;
+ continue;
+ }
+ return UsageRec (ip, arg0);
+ }
+ if (argc > j && ! nn) {
+ name = Tcl_GetStringFromObj (argv[j], &len);
+ if (0 == len) {
+ return UsageRec (ip, arg0);
+ }
+ ++j;
+ }
+ if (! name) {
+ name = NewRecId (buf);
+ }
+ id = NewRec (ois, that->db, that->fdt, 0);
+ if (0 > id) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ nrec = ois->recs[id];
+ if (! empty) {
+ nrec->rec = openIsisRDup (that->rec, 0, 0);
+ }
+ if (argc > j) {
+ rt = OpRec (nrec,
+ ip, name, RC_SET, argc - j, argv + j);
+ if (TCL_OK != rt) {
+ return rt;
+ }
+ }
+ rt = CrtRecCmd (ois, name, ois->recs[id], !0);
+ return rt;
+ } /* RC_CLON */
+
+ case RC_COPY: {
+ char buf[64];
+ OITRec *src;
+ Field *fld;
+ int j;
+ if (1 != argc) {
+ return UsageRec (ip, arg0);
+ }
+ src = TclCmd2Rec (ip, Tcl_GetStringFromObj (argv[0], 0), arg0);
+ if (! src) {
+ return TCL_ERROR;
+ }
+ if (! src->rec || ! src->rec->len) {
+ Tcl_SetResult (ip, "0", TCL_STATIC);
+ return TCL_OK;
+ }
+ fld = src->rec->field;
+ j = src->rec->len;
+ sprintf (buf, "%d", j);
+ Tcl_SetResult (ip, buf, TCL_VOLATILE);
+ while (j) {
+ OPENISIS_RADD (that->rec, fld->tag, fld->val, fld->len, !0);
+ ++fld;
+ --j;
+ }
+ return TCL_OK;
+ } /* RC_COPY */
+
+ case RC_DB:
+ if (! that->db) {
+ Tcl_AppendResult (ip, arg0, ": no db", 0);
+ return TCL_ERROR;
+ }
+ return OpDb (ip, ois, that->db, argc, argv);
+
+ case RC_DEL: {
+ if (NonWritable (that)) {
+ Tcl_AppendResult (ip, arg0, ": readonly record", 0);
+ return TCL_ERROR;
+ }
+ if (argc) {
+ char buf[2048];
+ char **argp = ToArgv (argv, argc, buf, sizeof (buf));
+ if (! argp) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ that->rec = openIsisRSet (that->rec,
+ OPENISIS_RARGV | OPENISIS_RFDT | OPENISIS_RDEL | argc,
+ that->fdt, argp);
+ if (argp != (char**)buf) {
+ openIsisMFree (argp);
+ }
+ return TCL_OK;
+ }
+ if (that->rec) {
+ OPENISIS_CLRREC( that->rec );
+ }
+ if (OIT_RS_RQS == RecType (that)) {
+ OITCont *con = (OITCont*)that;
+ if (con->numr) {
+ DtorRecs (con->recs, con->numr, 0);
+ con->numr = 0;
+ con->recs = 0;
+ }
+ }
+ return TCL_OK;
+ } /* RC_DEL */
+
+ case RC_DO: {
+ Tcl_Obj *tagvar = 0;
+ Tcl_Obj *valvar;
+ Tcl_Obj *tag = 0;
+ Tcl_Obj *val;
+ Tcl_Obj *body;
+ OpenIsisField *f;
+ int i, rt;
+ if ( 2 > argc )
+ return UsageRec (ip, arg0);
+ body = argv[--argc];
+ valvar = argv[--argc];
+ if ( 1 == argc )
+ tagvar = argv[0];
+#ifndef DONTREUSE
+ /* prepare object for var */
+ if ( ! Tcl_ObjSetVar2( ip, valvar, 0,
+ val = Tcl_NewObj(), TCL_LEAVE_ERR_MSG )
+ )
+ return TCL_ERROR;
+ if ( tagvar && ! Tcl_ObjSetVar2( ip, tagvar, 0,
+ tag = Tcl_NewIntObj(0), TCL_LEAVE_ERR_MSG )
+ )
+ return TCL_ERROR;
+#endif
+
+ /* go loop */
+ rt = TCL_OK;
+ for ( i = that->rec->len, f = that->rec->field; i--; f++ ) {
+#ifndef DONTREUSE
+ /*
+ if somebody shares the object, we have to set a new one
+ (or Tcl_SetStringObj will panic).
+ if it's not owned by the var, it's either owned by someone else
+ or nobody, i.e. deleted
+ */
+ if ( val == Tcl_ObjGetVar2( ip, valvar, 0, TCL_LEAVE_ERR_MSG )
+ && !Tcl_IsShared( val )
+ )
+ Tcl_SetStringObj( val, (char*)f->val, f->len );
+ else
+#endif
+ if ( !Tcl_ObjSetVar2( ip, valvar, 0,
+ val = FldObj( f ), TCL_LEAVE_ERR_MSG )
+ )
+ return TCL_ERROR;
+ if ( tagvar ) {
+#ifndef DONTREUSE
+ if ( tag == Tcl_ObjGetVar2( ip, tagvar, 0, TCL_LEAVE_ERR_MSG )
+ && !Tcl_IsShared( tag )
+ )
+ Tcl_SetIntObj( tag, f->tag );
+ else
+#endif
+ if ( !Tcl_ObjSetVar2( ip, tagvar, 0,
+ tag = Tcl_NewIntObj( f->tag ), TCL_LEAVE_ERR_MSG )
+ )
+ return TCL_ERROR;
+ } /* tagvar */
+ switch (rt = Tcl_EvalObjEx( ip, body, 0 )) {
+ case TCL_CONTINUE:
+ rt = TCL_OK;
+ case TCL_OK:
+ continue;
+ case TCL_BREAK:
+ rt = TCL_OK;
+ case TCL_RETURN:
+ case TCL_ERROR:
+ default:
+ return rt;
+ }
+ }
+ return rt;
+ } /* RC_DO */
+
+ case RC_DONE: {
+ if (! that->cmd) {
+ Tcl_AppendResult (ip, arg0, ": no command bound to rec", 0);
+ return TCL_ERROR;
+ }
+ if (strcmp (that->cmd, arg0)) {
+ Tcl_AppendResult (ip, arg0, ": command mismatch: ", that->cmd, 0);
+ return TCL_ERROR;
+ }
+ if (NonDeletable (that)) {
+ Tcl_AppendResult (ip, arg0, ": record not deletable", 0);
+ return TCL_ERROR;
+ }
+ Tcl_DeleteCommand (ip, (char*)arg0);
+ return TCL_OK;
+ } /* RC_DONE */
+
+ case RC_FDT:
+ if (! that->fdt) {
+ Tcl_AppendResult (ip, arg0, ": no fdt", 0);
+ return TCL_ERROR;
+ }
+ return OpFdt (ip, ois, that->fdt, argc, argv);
+
+ case RC_FMT: {
+ Tcl_AppendResult (ip, arg0, ": sorry, format not implemented yet", 0);
+ return TCL_ERROR;
+ } /* RC_FMT */
+
+ case RC_GET:
+ op_get: {
+ OpenIsisField *fld;
+ const char *path, *rem;
+ int tag, occ, i, j, objc, len, reclen;
+ int witht = 0;
+ int usedf = !0;
+ Tcl_Obj *list, *dflt, *val;
+ Tcl_Obj **objv;
+
+ Tcl_ResetResult (ip);
+ reclen = that->rec ? that->rec->len : 0;
+ list = val = 0;
+ if (1 == argc) {
+ path = Tcl_GetStringFromObj (argv[0], &i);
+ if (3 < i && *path == '-') {
+ if (0 == strncmp ("-tags", path, i)) {
+ --argc;
+ witht = 1;
+ }
+ else if (0 == strncmp ("-tagnames", path, i)) {
+ --argc;
+ witht = 2;
+ }
+ }
+ }
+ if (! argc) {
+ list = Tcl_NewListObj( 0, 0 );
+ if (reclen) {
+ for (i = reclen, fld = that->rec->field; i--; fld++) {
+ if (witht) {
+ if (TCL_OK != Tcl_ListObjAppendElement (ip, list,
+ FdObj (fld, 2 == witht ? that->fdt : 0))) {
+ goto geterr;
+ }
+ }
+ if (TCL_OK != Tcl_ListObjAppendElement (ip, list,
+ FldObj (fld))) {
+ goto geterr;
+ }
+ }
+ }
+ Tcl_SetObjResult( ip, list );
+ return TCL_OK;
+ }
+ for (j = 0; argc > j; ) {
+ path = Tcl_GetStringFromObj (argv[j], &len);
+ if (3 <= len &&
+ '-' == *path &&
+ 0 == strncmp ("-nodefaults", path, len)) {
+ usedf = 0;
+ ++j;
+ continue;
+ }
+ val = dflt = 0;
+ if (usedf &&
+ TCL_OK ==
+ Tcl_ListObjGetElements (0, argv[j], &objc, &objv) &&
+ 2 == objc
+ ) {
+ path = Tcl_GetStringFromObj (objv[0], 0);
+ dflt = objv[1];
+ }
+ rem = luti_parse_path (path, that->fdt, 0, &tag, &occ);
+ if (! rem || *rem) {
+ Tcl_ResetResult (ip);
+ Tcl_AppendResult (ip, arg0,
+ ": no such path: ", path, 0);
+ goto geterr;
+ }
+ if (reclen) {
+ if ( 0 > occ ) {
+ for ( i = reclen, fld = that->rec->field;
+ i--;
+ fld++ ) {
+ if ( tag == fld->tag ) {
+ if (! val) {
+ val = Tcl_NewListObj (0, 0);
+ }
+ if (TCL_OK != Tcl_ListObjAppendElement (
+ ip, val, FldObj(fld))) {
+ goto geterr;
+ }
+ }
+ }
+ }
+ else { /* specific occ wanted */
+ fld = openIsisROccurence (that->rec, tag, occ);
+ if (fld) {
+ val = FldObj(fld);
+ }
+ }
+ }
+ if (! val) {
+ if (! dflt) {
+ Tcl_ResetResult (ip);
+ Tcl_AppendResult (ip, arg0,
+ ": no such field: ", path, 0);
+ goto geterr;
+ }
+ /* don't force a list even for empty default
+ -- take the default as list.
+ A literal default foo IS the list containing foo.
+ If you REALLY wan't a list with one empty element as default,
+ you can explicitly specify one.
+ if (0 > occ) {
+ Tcl_Obj *tmp[1];
+ tmp[0] = dflt;
+ val = Tcl_NewListObj (1, tmp);
+ } else
+ */
+ val = dflt;
+ }
+ if (++j >= argc) {
+ if (! list) {
+ Tcl_SetObjResult( ip, val );
+ return TCL_OK;
+ }
+ if (TCL_OK != Tcl_ListObjAppendElement(ip, list, val)) {
+ goto geterr;
+ }
+ break;
+ }
+ if (! list) {
+ list = Tcl_NewListObj( 0, 0 );
+ }
+ if (TCL_OK != Tcl_ListObjAppendElement(ip, list, val)) {
+ goto geterr;
+ }
+ }
+ if (! list) {
+ return UsageRec (ip, arg0);
+ }
+ Tcl_SetObjResult( ip, list );
+ return TCL_OK;
+ geterr:
+ /* free */
+ if (val) {
+ Tcl_DecrRefCount (val);
+ }
+ if (list) {
+ Tcl_DecrRefCount( list );
+ }
+ return TCL_ERROR;
+ } /* RC_GET */
+
+ case RC_ROW:
+ Tcl_SetObjResult( ip, Tcl_NewIntObj(
+ (that->rec && 0<that->rec->rowid) ? that->rec->rowid : 0
+ ) );
+ return TCL_OK;
+
+ case RC_LEN:
+ Tcl_SetObjResult( ip, Tcl_NewIntObj(
+ (that->rec && 0<that->rec->len) ? that->rec->len : 0
+ ) );
+ return TCL_OK;
+
+ case RC_SERI: {
+ char buf[2048];
+ char *b;
+ int len;
+
+ if (! that->rec) {
+ Tcl_ResetResult (ip);
+ return TCL_OK;
+ }
+ len = sizeof (buf);
+ b = openIsisRSerializeAlloc (that->rec, buf, &len);
+ if (! b) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ /* do NOT include the final blankline */
+ Tcl_SetObjResult( ip, Tcl_NewStringObj( b, len-1 ) );
+ /*
+ faster, but not allowed :(
+ Tcl_Obj *ret = Tcl_NewStringObj(0,0);
+ Tcl_SetObjLength( ret, that->rec->used );
+ Tcl_SetObjLength( ret, openIsisRSerialize( ret->bytes, that->rec ) );
+ */
+ if ( buf != b )
+ mFree( b );
+ return TCL_OK;
+ } /* RC_SERI */
+
+ case RC_DESER: {
+ char *b;
+ int len;
+
+ if ( 1 != argc )
+ return UsageRec (ip, arg0);
+ if (NonWritable (that)) {
+ Tcl_AppendResult (ip, arg0, ": readonly record", 0);
+ return TCL_ERROR;
+ }
+ b = Tcl_GetStringFromObj( argv[0], &len );
+ if ( ! b )
+ Tcl_ResetResult (ip);
+ else {
+ int ret = openIsisRDeserialize( &that->rec,
+ b, len, OPENISIS_RDIS|OPENISIS_STOPONEMPTY );
+ Tcl_SetObjResult( ip, Tcl_NewIntObj( ret ) );
+ }
+
+ return TCL_OK;
+ } /* RC_DESER */
+
+ case RC_WRAP: {
+ char buf[2048];
+ OITRec *emb = 0;
+ char **argp = (char**)buf;
+ char *name = 0;
+ char *tgnm = 0;
+ int tag = -1;
+ int num = -1;
+ int del = 0;
+ int len, j;
+
+ if (NonWritable (that)) {
+ Tcl_AppendResult (ip, arg0, ": readonly record", 0);
+ return TCL_ERROR;
+ }
+ argp = ToArgv (argv, argc, buf, sizeof(buf));
+ if (! argp) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ for (j = 0; argc > j; ++j) {
+ if (! *argp[j]) {
+ goto wuserr;
+ }
+ if ('-' == *argp[j]) {
+ len = strlen (argp[j]);
+ if (2 > len) {
+ goto wuserr;
+ }
+ if (0 == strncmp ("-done", argp[j], len)) {
+ del = !0;
+ continue;
+ }
+ if (0 == strncmp ("-number", argp[j], len)) {
+ if (argc <= ++j) {
+ goto wuserr;
+ }
+ num = openIsisA2id (argp[j], -1, -1);
+ if (0 > num) {
+ goto wuserr;
+ }
+ continue;
+ }
+ if (0 == strncmp ("-tag", argp[j], len)) {
+ if (argc <= ++j) {
+ goto wuserr;
+ }
+ tag = openIsisA2id (argp[j], -1, 0);
+ if (0 >= tag) {
+ goto wuserr;
+ }
+ continue;
+ }
+ goto wuserr;
+ }
+ if (0 > tag && 0 == tgnm) {
+ tgnm = argp[j];
+ continue;
+ }
+ if (name) {
+ goto wuserr;
+ }
+ name = argp[j];
+ emb = TclCmd2Rec (ip, name, arg0);
+ if (! emb) {
+ goto wrperr;
+ }
+ } /* for argc */
+
+ if (tgnm) {
+ OpenIsisFd *fd = openIsisFByName (that->fdt, tgnm);
+ if (! fd) {
+ Tcl_AppendResult (ip, arg0,
+ ": no such field description: ", tgnm, 0);
+ goto wrperr;
+ }
+ tag = fd->id;
+ }
+ if (0 > tag) {
+ goto wuserr;
+ }
+ if (num && ! emb) {
+ Tcl_AppendResult (ip, arg0, ": record to embed not given", 0);
+ goto wrperr;
+ }
+
+ if (0 <= num) {
+ that->rec = openIsisRAddI (that->rec, tag, num, !0);
+ if (num) {
+ if (! emb->rec || ! (len = emb->rec->len)) {
+ Tcl_AppendResult (ip, arg0,
+ ": record to embed is empty", 0);
+ goto wrperr;
+ }
+ that->rec = luti_append (that->rec, emb->rec);
+ }
+ if (! that->rec) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ goto wrperr;
+ }
+ }
+ else {
+ len = that->rec || emb->rec;
+ that->rec = luti_wrap (that->rec, emb->rec, tag);
+ if (len && ! that->rec) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ goto wrperr;
+ }
+ }
+
+ if (del && emb) {
+ len = OpRec (emb, ip, name, RC_DONE, 0, 0);
+ if (TCL_OK != len) {
+ goto wrperr;
+ }
+ }
+ if (argp != (char**)buf) {
+ openIsisMFree (argp);
+ }
+ return TCL_OK;
+
+ wuserr:
+ Tcl_AppendResult (ip, "usage: " , arg0, " wrap [-done] ",
+ "[-number <numsubrecs>] {-tag <tag> | <tagname>} recname", 0);
+ wrperr:
+ if (argp != (char**)buf) {
+ openIsisMFree (argp);
+ }
+ return TCL_ERROR;
+ } /* RC_WRAP */
+
+ default: {
+ char buf[654];
+ openIsisI2a (buf, cmd);
+ Tcl_AppendResult (ip, arg0, ": unrecognized command ", buf, 0);
+ return TCL_ERROR;
+ } /* default */
+
+ } /* switch */
+}
+
+static int OpPath (
+ OITRec *that, Tcl_Interp *ip, const char *arg0,
+ Tcl_Obj *arg1, int argc, Tcl_Obj* const argv[]
+) {
+ char buf[128];
+ OITSess *ois;
+ const char *path;
+ int cmd, rt;
+
+ if (! arg1) {
+ return UsageRec (ip, arg0);
+ }
+ if (! arg0) {
+ arg0 = "<openIsisRecord>";
+ }
+ if (! that || ! (ois = RecSess (that))) {
+ Tcl_AppendResult (ip, arg0, ": record corrupted", 0);
+ return TCL_ERROR;
+ }
+ if (ip != ois->ip) {
+ Tcl_AppendResult (ip, arg0, ": session corrupted", 0);
+ return TCL_ERROR;
+ }
+
+ path = Tcl_GetStringFromObj (arg1, 0);
+
+ /* path to embedded rec */
+ if ('.' == *path) {
+ int type = RecType (that);
+ switch (type) {
+ case OIT_RS_RQS:
+ { OITCont *con;
+ OITRec *rec;
+ const char *p2;
+ int tag, occ;
+ con = (OITCont*) that;
+ if (strncmp (".fdt", path, 4)) {
+ p2 = luti_parse_path (path, openIsisFdtRqs,
+ 0, &tag, &occ);
+ if (0 == p2 || 0 < occ) {
+ Tcl_AppendResult (ip, arg0,
+ ": no such child: ", path, 0);
+ return TCL_ERROR;
+ }
+ }
+ else {
+ p2 = path + 4;
+ tag = -42;
+ occ = 0;
+ }
+ if (! con->numr) {
+ rt = BuildRqsRecs (con);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, arg0,
+ ": child allocation failure", 0);
+ return TCL_ERROR;
+ }
+ }
+ switch (tag) {
+ case OPENISIS_COM_REC: rec = con->recs[0]; break;
+ case OPENISIS_RQS_IDX: rec = con->recs[1]; break;
+ case OPENISIS_COM_CFG: rec = con->recs[2]; break;
+ case -42: rec = con->recs[3]; break;
+ default:
+ Tcl_AppendResult (ip, arg0,
+ ": no such child: ", path, 0);
+ return TCL_ERROR;
+ }
+ NewRecId (buf);
+ if (*p2) {
+ Tcl_Obj *obj = Tcl_NewStringObj (p2, (int) strlen (p2));
+ if (obj) {
+ Tcl_IncrRefCount (obj);
+ rt = OpPath (rec, ip, buf, obj, argc, argv);
+ Tcl_DecrRefCount (obj);
+ return rt;
+ }
+ return TCL_ERROR;
+ }
+ if (! argc) {
+ return CrtRecCmd (ois, buf, rec, !0);
+ }
+ return OpPath (rec, ip, buf, argv[0], argc - 1, argv + 1);
+ }
+ case OIT_RS_RSP:
+ { OITCont *con;
+ OITRec *rec;
+ const char *p2;
+ int tag, occ;
+ con = (OITCont*) that;
+ p2 = luti_parse_path (path, openIsisFdtRsp,
+ 0, &tag, &occ);
+ if (0 == p2 ||
+ OPENISIS_COM_REC != tag
+ ) {
+ Tcl_AppendResult (ip, arg0,
+ ": no such child: ", path, 0);
+ return TCL_ERROR;
+ }
+ if (!(rt = con->numr)) {
+ rt = BuildRspRecs (con, ip, arg0);
+ if (0 > rt) {
+ return TCL_ERROR;
+ }
+ }
+ if (0 > occ) {
+ occ = 0;
+ }
+ if (rt <= occ) {
+ sprintf (buf, "%d", rt);
+ Tcl_AppendResult (ip, arg0, ": no such child: ", path,
+ ", have ", buf, " childs", 0);
+ return TCL_ERROR;
+ }
+ rec = con->recs[occ];
+ NewRecId (buf);
+ if (*p2) {
+ Tcl_Obj *obj = Tcl_NewStringObj (p2, (int) strlen (p2));
+ if (obj) {
+ Tcl_IncrRefCount (obj);
+ rt = OpPath (rec, ip, buf, obj, argc, argv);
+ Tcl_DecrRefCount (obj);
+ return rt;
+ }
+ return TCL_ERROR;
+ }
+ if (! argc) {
+ return CrtRecCmd (ois, buf, rec, !0);
+ }
+ return OpPath (rec, ip, buf, argv[0], argc - 1, argv + 1);
+ }
+ default:
+ { OpenIsisRec *rec;
+ OITRec *oir;
+ rec = luti_getembed (that->rec, path, that->fdt);
+ if (! rec) {
+ Tcl_AppendResult (ip, arg0,
+ ": no such child: ", path, 0);
+ return TCL_ERROR;
+ }
+ rt = NewRec (ois, 0,
+ OIT_RS_DBF == RecType(that) ? openIsisFdtFd : 0,
+ 0);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, "OpPath: out of memory", 0);
+ return TCL_ERROR;
+ }
+ oir = ois->recs[rt];
+ oir->rec = rec;
+ NewRecId (buf);
+ if (! argc) {
+ return CrtRecCmd (ois, buf, oir, !0);
+ }
+ rt = OpPath (oir, ip, buf, argv[0], argc - 1, argv + 1);
+ DtorRec (oir, 0);
+ return rt;
+ }
+ }
+ } /* path */
+
+ rt = Tcl_GetIndexFromObj (ip, arg1, OITOpts, "option", 0, &cmd);
+ if (TCL_OK != rt) {
+ return TCL_ERROR;
+ }
+ if (RC_LAST < cmd) {
+ return UsageRec (ip, arg0);
+ }
+
+ return OpRec (that, ip, arg0, (OITCmd)cmd, argc, argv);
+}
+
+static int CmdRec (
+ ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
+) {
+ const char *arg0 = 0 >= argc ? 0 : Tcl_GetStringFromObj (argv[0], 0);
+ if (1 >= argc) {
+ return UsageRec (ip, arg0);
+ }
+ return OpPath ((OITRec*)cld, ip, arg0, argv[1], argc - 2, argv + 2);
+}
+
+/* ============================== stubs ================================
+*/
+
+static int RspCb (
+ void *cld, OpenIsisStub stb, OpenIsisRec *rsp, OpenIsisDb *db
+) {
+ OITStub *that = (OITStub*) cld;
+ OITSess *ois;
+ const char *res;
+ int rt;
+
+ (void)db;
+ if (! that) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] RspCb: response without stub");
+ }
+ if (stb != that->stb) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] RspCb: stub changed");
+ }
+ ois = StbSess (that);
+ if (! ois) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] RspCb: response without session");
+ }
+ if (! that->rqs) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] RspCb: response without request");
+ }
+ if (that->rsp) {
+ if (that->rsp->env.rec) {
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] RspCb: multiple responses");
+ DtorRec ((OITRec*)that->rsp, 0);
+ }
+ }
+
+ rt = NewCont (ois, openIsisFdtRsp, OIT_RS_RSP);
+ if (0 > rt) {
+ return rt;
+ }
+ that->rsp = (OITCont*) ois->recs[rt];
+ that->rsp->env.rec = rsp;
+ that->rsp->stb = that->stb;
+
+ if (! that->actproc) {
+ if (! that->dfltproc) {
+ return 0;
+ }
+ rt = Tcl_EvalObj (ois->ip, that->dfltproc);
+ }
+ else {
+ rt = Tcl_EvalObj (ois->ip, that->actproc);
+ }
+ res = Tcl_GetStringResult (ois->ip);
+ if (! res) {
+ res = "<null>";
+ }
+ if (TCL_ERROR == rt) {
+ return openIsisSMsg (OPENISIS_ERR_IDIOT,
+ "[openIsisTcl] callback eval: %s", res);
+ }
+ if (TCL_OK != rt) {
+ openIsisSMsg (OPENISIS_LOG_WARN,
+ "[openIsisTcl] callback eval = %d, %s", rt, res);
+ return 0;
+ }
+ openIsisSMsg (OPENISIS_LOG_INFO,
+ "[openIsisTcl] callback eval : %s", res);
+ return 0;
+}
+
+static void StbDelCb (void *cld, OpenIsisStub stb, void *cbd);
+static void TclDelStb (ClientData cld);
+static int CmdStub (
+ ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
+);
+
+static OITStub* CtorStub (Tcl_Interp *ip,
+ const char *name, int argc, const char **argv, const char *proc
+) {
+ OpenIsisStubCbData scd;
+ OpenIsisSchema *sch;
+ OITStub *that;
+ int stat = 0;
+
+ if (! name) {
+ name = OIT_STB0;
+ stat = OIT_ST_ROOT;
+ }
+ if (! NumSessions) {
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] CtorStub(%s): no root session", name);
+ return 0;
+ }
+ if (ip != Sessions->ip) {
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] CtorStub(%s): must not create stub in derived session",
+ name);
+ return 0;
+ }
+ that = (OITStub*) openIsisMAlloc (sizeof (OITStub));
+ if (! that) {
+ openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] CtorStub(%s): out of memory", name);
+ return 0;
+ }
+ that->cmd = openIsisMDup (name, -1);
+ if (! that->cmd) {
+ openIsisMFree (that);
+ openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] CtorStub(%s): out of memory", name);
+ return 0;
+ }
+ that->ases = -1;
+
+ memset (&scd, 0, sizeof (OpenIsisStubCbData));
+ scd.dfltcb = &RspCb;
+ scd.delcb = &StbDelCb;
+ scd.dfltcld = scd.delcld = that;
+
+ if (OIT_ST_ROOT & stat) {
+ that->cfg.fdt = openIsisFdtSyspar;
+ that->stb = openIsisNInit (argc, argv, &scd);
+ }
+ else {
+ that->cfg.fdt = openIsisFdtScheme;
+ that->stb = openIsisNOpen (name, argc, argv, &scd);
+ }
+ if (! that->stb) {
+ openIsisMFree ((void*)that->cmd);
+ openIsisMFree (that);
+ openIsisSMsg (OPENISIS_ERR_IDIOT,
+ "[openIsisTcl] CtorStub(%s): deficient configuration", name);
+ return 0;
+ }
+
+ sch = openIsisNSchema (that->stb);
+ that->cfg.rec = sch->cfg;
+ that->cfg.sid = 0;
+ that->cfg.stat = OIT_RS_USED | OIT_RS_STC;
+
+ if (proc) {
+ that->dfltproc = Tcl_NewStringObj (proc, (int) strlen (proc));
+ if (that->dfltproc) {
+ Tcl_IncrRefCount (that->dfltproc);
+ }
+ }
+
+ that->stat = stat | OIT_ST_TCL | OIT_ST_OINIT;
+
+ Tcl_CreateObjCommand (ip, (char*)that->cmd, &CmdStub, that, &TclDelStb);
+ Tcl_SetResult (ip, (char*)that->cmd, TCL_VOLATILE);
+ return that;
+}
+
+static void DtorStub (OITStub *that, int where) {
+ const char *cmd = that->cmd;
+ if (! cmd) {
+ cmd = "<<NULL>>";
+ }
+ if (! NumSessions) {
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] DtorStub(%s): no root session", cmd);
+ return;
+ }
+ that->stat &= ~where;
+ if (OIT_ST_TCL & that->stat) {
+ if (! that->cmd) {
+ openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] DtorStub: no command");
+ return;
+ }
+ Tcl_DeleteCommand (Sessions->ip, (char*)that->cmd);
+ return;
+ }
+ if (OIT_ST_OINIT & that->stat) {
+ if (OIT_ST_ROOT & that->stat) {
+ openIsisNDeinit ();
+ }
+ else {
+ openIsisNClose (that->stb);
+ }
+ return;
+ }
+ if (that->dfltproc) {
+ Tcl_DecrRefCount (that->dfltproc);
+ }
+ if (that->actproc) {
+ Tcl_DecrRefCount (that->actproc);
+ }
+ if (that->rqs) {
+ DtorRec ((OITRec*)that->rqs, 0);
+ }
+ if (that->rsp) {
+ DtorRec ((OITRec*)that->rsp, 0);
+ }
+/* that->cfg.rec holds the same ref as stub->cfg,
+ which is freed in openIsisNClose
+*/
+ if (that->cmd) {
+ openIsisMFree ((void*)that->cmd);
+ }
+ openIsisMFree (that);
+}
+
+static void TclDelStb (ClientData cld) {
+ DtorStub ((OITStub*)cld, OIT_ST_TCL);
+}
+
+static void StbDelCb (void *cld, OpenIsisStub stb, void *cbd) {
+ (void) stb;
+ if (cbd) {
+ if (((OITStub*)cbd)->actproc) {
+ Tcl_DecrRefCount (((OITStub*)cbd)->actproc);
+ ((OITStub*)cbd)->actproc = 0;
+ }
+ return;
+ }
+ DtorStub ((OITStub*)cld, OIT_ST_OINIT);
+}
+
+static int BuildRqsCont (OITStub *that, Tcl_Interp *ip,
+ const char *arg0, OITSess *ois, int *argc, Tcl_Obj* const **argv
+) {
+ OpenIsisDb *db;
+ char *dbn;
+ int rt;
+ if (! that->rqs) {
+ rt = NewCont (ois, openIsisFdtRqs, OIT_RS_RQS);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return 0;
+ }
+ that->rqs = (OITCont*) ois->recs[rt];
+ }
+ if (1 < *argc &&
+ 0 == strcmp ("-db", Tcl_GetStringFromObj ((*argv)[0], 0))) {
+ dbn = Tcl_GetStringFromObj ((*argv)[1], 0);
+ db = openIsisNDbByName (that->stb, dbn);
+ if (! db) {
+ Tcl_AppendResult (ip, arg0, ": no such db: ", dbn, 0);
+ return 0;
+ }
+ that->rqs->env.db = db;
+ *argc -= 2;
+ *argv += 2;
+ }
+ return !0;
+}
+
+static const OpenIsisFdt* SysFdtFromName (const char *dbn, int len) {
+ switch (dbn[1]) {
+ case 'd':
+ if (0 == strncmp (dbn, "-dbpar", len)) {
+ return openIsisFdtDbpar;
+ }
+ return 0;
+ case 'f':
+ if ('d' == dbn[2]) {
+ if (0 == dbn[3]) {
+ return openIsisFdtFd;
+ }
+ if ('t' == dbn[3] && 0 == dbn[4]) {
+ return openIsisFdtFdt;
+ }
+ }
+ return 0;
+ case 'r':
+ if (3 < len) {
+ if (0 == strncmp (dbn, "-request", len)) {
+ return openIsisFdtRqs;
+ }
+ if (0 == strncmp (dbn, "-response", len)) {
+ return openIsisFdtRsp;
+ }
+ }
+ return 0;
+ case 's':
+ if (2 < len) {
+ if (0 == strncmp (dbn, "-syspar", len)) {
+ return openIsisFdtSyspar;
+ }
+ if (0 == strncmp (dbn, "-scheme", len)) {
+ return openIsisFdtScheme;
+ }
+ }
+ return 0;
+ }
+ return 0;
+}
+
+static int UsageStub (Tcl_Interp *ip, const char *argv0) {
+ Tcl_AppendResult (ip,
+ "usage: ",
+ (argv0 ? argv0 : "<openIsisStub>"),
+ " db db ?option ...? |",
+ " fdt db ?option ...? |",
+ " new -schema name ?-cfg val ...? |",
+ " new ?-db db? ?name? |",
+ " recv |",
+ " request ?-db db? ?-param val? |",
+ " .req ?-db db? ?option ...? |",
+ " .res ?option ...?",
+ 0);
+ return TCL_ERROR;
+}
+
+static int CmdStub (
+ ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
+) {
+ OITStub *that = (OITStub*) cld;
+ OITSess *ois;
+ const char *arg0;
+ OITCmd cmd;
+ int rt;
+
+ if (1 > argc) {
+ return TCL_ERROR;
+ }
+ arg0 = Tcl_GetStringFromObj (argv[0], 0);
+ if (2 > argc) {
+ return UsageStub (ip, arg0);
+ }
+
+ ois = StbSess (that);
+ if (! ois) {
+ if (! NumSessions) {
+ Tcl_AppendResult (ip, arg0, ": no session", 0);
+ return TCL_ERROR;
+ }
+ ois = Sessions;
+ that->ases = 0;
+ }
+ if (ip != ois->ip) {
+ Tcl_AppendResult (ip, arg0, ": session changed", 0);
+ return TCL_ERROR;
+ }
+
+ rt = Tcl_GetIndexFromObj (ip, argv[1], OITOpts, "option", 0, (int*)&cmd);
+ if (TCL_OK != rt) {
+ return UsageStub (ip, arg0);
+ }
+
+ argc -= 2;
+ argv += 2;
+
+ switch (cmd) {
+
+ case RC_DB: {
+ OpenIsisDb *db;
+ char *dbn;
+ if (! argc) {
+ return UsageStub (ip, arg0);
+ }
+ dbn = Tcl_GetStringFromObj (argv[0], 0);
+ db = openIsisNDbByName (that->stb, dbn);
+ if (! db) {
+ Tcl_AppendResult (ip, arg0, ": no such db <", dbn, ">", 0);
+ return TCL_ERROR;
+ }
+ return OpDb (ip, ois, db, argc - 1, argv + 1);
+ } /* RC_DB */
+
+ case RC_DONE:
+ Tcl_DeleteCommand (ip, (char*)arg0);
+ return TCL_OK;
+
+ case RC_FDT: {
+ const OpenIsisFdt *fdt = 0;
+ OpenIsisDb *db;
+ char *dbn;
+ int len;
+ if (! argc) {
+ return UsageStub (ip, arg0);
+ }
+ dbn = Tcl_GetStringFromObj (argv[0], &len);
+ if (1 < len && '-' == *dbn) {
+ fdt = SysFdtFromName (dbn, len);
+ }
+ if (! fdt) {
+ db = openIsisNDbByName (that->stb, dbn);
+ if (! db) {
+ Tcl_AppendResult (ip, arg0, ": no such db <", dbn, ">", 0);
+ return TCL_ERROR;
+ }
+ fdt = db->fdt;
+ if (! fdt) {
+ Tcl_AppendResult (ip, arg0, ": ", dbn, " has no fdt", 0);
+ return TCL_ERROR;
+ }
+ }
+ return OpFdt (ip, ois, fdt, argc - 1, argv + 1);
+ } /* RC_FDT */
+
+ case SC_NEW: {
+ char buf[2048];
+ OITStub *nstb = 0;
+ const OpenIsisFdt *fdt = 0;
+ OpenIsisDb *db = 0;
+ const char *arg2 = 0;
+ const char *dbn = 0;
+ const char *proc = 0;
+ char *name = 0;
+ char **argp = 0;
+ int len = 0;
+ int dbl = 0;
+
+ switch (argc) {
+ /* new record */
+ case 0:
+ goto newrec;
+ case 1:
+ name = Tcl_GetStringFromObj (argv[0], 0);
+ goto newrec;
+ case 3:
+ arg2 = Tcl_GetStringFromObj (argv[0], &len);
+ if (2 > len || 0 != strncmp ("-db", arg2, len)) {
+ return UsageStub (ip, arg0);
+ }
+ dbn = Tcl_GetStringFromObj (argv[1], &dbl);
+ name = Tcl_GetStringFromObj (argv[2], 0);
+ newrec:
+ if (1 < dbl && '-' == *dbn) {
+ fdt = SysFdtFromName (dbn, dbl);
+ }
+ if (! fdt) {
+ if (! dbn) {
+ dbn = openIsisRString (that->cfg.rec,
+ OPENISIS_SC_DFLTDB, 0, buf, sizeof(buf));
+ if (! dbn) {
+ Tcl_AppendResult (ip, arg0,
+ ": no db specified", 0);
+ return TCL_ERROR;
+ }
+ }
+ db = openIsisNDbByName (that->stb, dbn);
+ if (! db) {
+ Tcl_AppendResult (ip, arg0,
+ ": no such db <", dbn, ">", 0);
+ return TCL_ERROR;
+ }
+ fdt = db->fdt;
+ }
+ rt = NewRec (ois, db, fdt, 0);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ rt = CrtRecCmd (ois, name, ois->recs[rt], !0);
+ return rt;
+
+ /* new stub */
+ default:
+ arg2 = Tcl_GetStringFromObj (argv[0], &len);
+ if (2 > len) {
+ return UsageStub (ip, arg0);
+ }
+ if (2 == argc && 0 == strncmp ("-db", arg2, len)) {
+ dbn = Tcl_GetStringFromObj (argv[1], &dbl);
+ goto newrec;
+ }
+ if (strncmp ("-schema", arg2, len) &&
+ strncmp ("schema", arg2, len)) {
+ return UsageStub (ip, arg0);
+ }
+ name = Tcl_GetStringFromObj (argv[1], 0);
+ argc -= 2;
+ argv += 2;
+ if (0 < argc) {
+ int j;
+ argp = ToArgv (argv, argc, buf, sizeof (buf));
+ if (! argp) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ for (j = 0; argc > j; ++j) {
+ if (0 == strcmp ("-async", argp[j]) &&
+ argc > ++j) {
+ proc = argp[j];
+ }
+ }
+ }
+ nstb = CtorStub (ip, name, argc, (const char**)argp, proc);
+ if (argp && argp != (char**)buf) {
+ openIsisMFree (argp);
+ }
+ if (! nstb) {
+ Tcl_AppendResult (ip, arg0,
+ ": deficient configuration for ", name,
+ " or out of memory", 0);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+
+ } /* switch (argc) */
+ } /* SC_NEW */
+
+ case SC_RECV: {
+ if (that->rsp && that->rsp->env.rec) {
+ return TCL_OK;
+ }
+ Tcl_AppendResult (ip, arg0,
+ ": waiting for response in async mode not implemented yet", 0);
+ return TCL_ERROR;
+ } /* SC_RECV */
+
+ case SC_RQS: {
+ OpenIsisRec *rqs;
+ if (that->rsp) {
+ DtorRec ((OITRec*) that->rsp, 0);
+ }
+ if (! BuildRqsCont (that, ip, arg0, ois, &argc, &argv)) {
+ return TCL_ERROR;
+ }
+ if (0 < argc) {
+ Tcl_Obj *setcmd = Tcl_NewStringObj ("set", 3);
+ if (! setcmd) {
+ Tcl_AppendResult (ip, arg0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount (setcmd);
+ rt = OpPath (
+ (OITRec*)that->rqs, ip, 0, setcmd, argc, argv);
+ Tcl_DecrRefCount (setcmd);
+ if (TCL_OK != rt) {
+ return rt;
+ }
+ }
+ rqs = that->rqs->env.rec;
+ if (that->rqs->numr) {
+ OpenIsisRec *rec;
+ if ((rec = that->rqs->recs[0]->rec)) {
+ rqs = luti_wrap (rqs, rec, OPENISIS_COM_REC);
+ }
+ if ((rec = that->rqs->recs[1]->rec)) {
+ rqs = luti_wrap (rqs, rec, OPENISIS_RQS_IDX);
+ }
+ if ((rec = that->rqs->recs[2]->rec)) {
+ rqs = luti_wrap (rqs, rec, OPENISIS_COM_CFG);
+ }
+ if ((rec = that->rqs->recs[3]->rec)) {
+ rqs = luti_append (rqs, rec);
+ }
+ }
+ if (! openIsisRGet (rqs, OPENISIS_COM_DBN, 0) && that->rqs->env.db) {
+ OPENISIS_RADDS (rqs, OPENISIS_COM_DBN, that->rqs->env.db->name, !0);
+ }
+ rt = openIsisNSend (that->stb, that->rqs->env.rec = rqs, 0, 0, !0);
+ that->rqs->env.db = 0; /* do never remember */
+ if (0 != rt) {
+ char buf[64];
+ sprintf (buf, "%x", rt);
+ Tcl_AppendResult (ip, arg0, ": error ", buf,
+ " sending request", 0);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ } /* SC_RQS */
+
+ case SC_ARQS: {
+ if (! BuildRqsCont (that, ip, arg0, ois, &argc, &argv)) {
+ return TCL_ERROR;
+ }
+ if (1 > argc) {
+ return UsageStub (ip, arg0);
+ }
+ rt = OpPath (
+ (OITRec*)that->rqs, ip, 0, argv[0], argc - 1, argv + 1);
+ return rt;
+ } /* SC_ARQS */
+
+ case SC_ARSP: {
+ int hasrsp = that->rsp && that->rsp->env.rec;
+ if (1 > argc) {
+ Tcl_SetObjResult (ip, Tcl_NewBooleanObj (hasrsp));
+ return TCL_OK;
+ }
+ if (! hasrsp) {
+ Tcl_AppendResult (ip, arg0, ": no response available", 0);
+ return TCL_ERROR;
+ }
+ rt = OpPath (
+ (OITRec*)that->rsp, ip, 0, argv[0], argc - 1, argv + 1);
+ return rt;
+ } /* SC_ARSP */
+
+ default: {
+ /* record commands */
+ OpenIsisSchema *sch;
+ rt = OpRec (&that->cfg, ip, arg0, cmd, argc, argv);
+ sch = openIsisNSchema (that->stb);
+/* sch->cfg is a reference to our cfg at every time,
+ OpRec changes with RDIS, so we dont free the old rec here
+*/
+ sch->cfg = that->cfg.rec;
+ return rt;
+ } /* default */
+
+ } /* switch cmd */
+}
+
+static int CmdInit (
+ ClientData cld, Tcl_Interp *ip, int argc, const char *argv[]
+) {
+ OITStub *news;
+ const char *proc = 0;
+ int j, len;
+
+ (void)cld;
+
+ if (openisis_stub0) {
+ Tcl_CmdInfo info;
+ if (Tcl_GetCommandInfo (ip, OIT_STB0, &info)) {
+ Tcl_SetResult (ip, OIT_STB0, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+
+ for (j = 1; argc > j; ++j) {
+ if (! argv[j] || ! (len = strlen (argv[j]))) {
+ goto usage;
+ }
+ if ('-' == *argv[j]) {
+ if (! strncmp ("-async", argv[j], (unsigned) len)) {
+ if (argc <= ++j) {
+ goto usage;
+ }
+ proc = argv[j];
+ continue;
+ }
+ }
+ break;
+ }
+
+ /* openIsisNInit can be called multiple times */
+ news = CtorStub (ip, 0, argc - j, argv + j, proc);
+ if (! news) {
+ Tcl_AppendResult (ip, OIT_STB0, ": out of memory", 0);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+
+usage:
+ Tcl_AppendResult (ip,
+ "usage: ", argv[0], " ?-async <cb>? ?options?", 0);
+ return TCL_ERROR;
+}
+
+static int CmdOIR (
+ ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
+) {
+ OITSess *ois;
+ OITRec *rec, *rfdt;
+ const OpenIsisFdt *fdt;
+ char *fname;
+ const char *rname;
+ char buf[64];
+ int j, rt, len, ownf;
+
+ (void)cld;
+ if (! NumSessions) {
+ Tcl_AppendResult (ip, "session not initialized", 0);
+ return TCL_ERROR;
+ }
+ ois = Sessions;
+
+ rec = 0;
+ rname = 0;
+ fdt = 0;
+ ownf = 0;
+ for (j = 1; argc > j; ++j) {
+ fname = Tcl_GetStringFromObj (argv[j], &len);
+ if (! fdt && 2 <= len && 0 == strncmp ("-fdt", fname, len)) {
+ if (argc <= ++j) {
+ Tcl_AppendResult (ip,
+ "usage: openIsisRec ?-fdt name? ?options...?", 0);
+ return TCL_ERROR;
+ }
+ fname = Tcl_GetStringFromObj (argv[j], &len);
+ if (len && '-' == *fname) {
+ fdt = SysFdtFromName (fname, len);
+ }
+ if (! fdt) {
+ rfdt = TclCmd2Rec (ip, fname, "openIsisRec");
+ if (! rfdt) {
+ return TCL_ERROR;
+ }
+ fdt = openIsisFRec2Fdt (rfdt->rec);
+ if (! fdt) {
+ Tcl_AppendResult (ip, fname, " is an illegal fdt", 0);
+ return TCL_ERROR;
+ }
+ ownf = !0;
+ }
+ if (rname) {
+ ++j;
+ break;
+ }
+ continue;
+ }
+ if (rname) {
+ break;
+ }
+ rname = fname;
+ }
+
+ if (! rname || ! *rname) {
+ rname = NewRecId (buf);
+ }
+
+ rt = NewRec (ois, 0, fdt, ownf ? OIT_RS_OWNF : 0);
+ if (0 > rt) {
+ Tcl_AppendResult (ip, Tcl_GetStringFromObj (argv[0], 0),
+ ": out of memory", 0);
+ goto error;
+ }
+ rec = ois->recs[rt];
+
+ if (j < argc - 1) {
+ rt = OpPath (rec, ip, rname, argv[j], argc - (j+1), argv + (j+1));
+ if (TCL_OK != rt) {
+ goto error;
+ }
+ }
+
+ rt = CrtRecCmd (ois, rname, rec, !0);
+ if (TCL_OK == rt) {
+ return TCL_OK;
+ }
+error:
+ if (rec) {
+ DtorRec (rec, 0);
+ }
+ else if (ownf) {
+ openIsisFFree ((OpenIsisFdt*)fdt);
+ }
+ return TCL_ERROR;
+}
+
+static void FreeEnc ();
+static void AtExit (ClientData cld) {
+ (void)cld;
+ openIsisNDeinit ();
+ ExitSess ();
+ FreeEnc ();
+}
+
+static void AddCmds (Tcl_Interp *ip, int root) {
+ Tcl_CreateCommand (ip, "openIsis",
+ (Tcl_CmdProc*)CmdInit, 0, root ? &AtExit : 0);
+ Tcl_CreateObjCommand (ip, "openIsisRec", &CmdOIR, 0, 0);
+}
+
+/* ===================== command evaluation ============================
+*/
+
+static int CmdEval (OpenIsisRec *cmd, OpenIsisRec **rsp) {
+ Tcl_DString ds;
+ OpenIsisField *F, *E;
+ OpenIsisSession ois;
+ OpenIsisRec *recs[1] = { 0 };
+ int rid[1];
+ int rt;
+
+ ois = SESGET ();
+ if (NumSessions <= ois->id) {
+ return openIsisSMsg (OPENISIS_ERR_TRASH,
+ "[openIsisTcl] CmdEval: no ip for ses %d[%d]",
+ ois->id, NumSessions);
+ }
+
+ rid[0] = openIsisTclCreateRecCmd (ois->id, "result", 0, 0);
+ if (0 > rid[0]) {
+ return openIsisSMsg (OPENISIS_ERR_NOMEM,
+ "[openIsisTcl] CmdEval: cannot allocate result cmd");
+ }
+
+ rt = 0;
+ Tcl_DStringInit (&ds);
+ for (E = (F = cmd->field) + cmd->len; E > F; ++F) {
+ if (rt) {
+ Tcl_DStringAppend (&ds, ";", 1);
+ }
+ rt = !0;
+ Tcl_DStringAppend (&ds, F->val, F->len);
+ }
+ rt = openIsisTclEval (ois->id, 1, rid, recs, Tcl_DStringValue (&ds));
+ Tcl_DStringFree (&ds);
+
+ /* record freed in ldsp */
+ Sessions[ois->id].recs[rid[0]]->rec = 0;
+ *rsp = recs[0];
+
+ return rt;
+}
+
+OpenIsisEvalFunc *openIsisEval = &CmdEval;
+
+/* =========================== encoding ================================
+*/
+
+static Tcl_HashTable Encodings;
+static int InitEnc = 0;
+
+static Tcl_Encoding GetEnc (Tcl_Interp *ip, const char *name, int *frs) {
+ Tcl_HashEntry *he;
+ Tcl_Encoding enc;
+ int nw;
+ if (! InitEnc) {
+ Tcl_InitHashTable (&Encodings, TCL_STRING_KEYS);
+ InitEnc = !0;
+ }
+ he = Tcl_FindHashEntry (&Encodings, name);
+ if (he) {
+ return (Tcl_Encoding) Tcl_GetHashValue (he);
+ }
+ enc = Tcl_GetEncoding (ip, name);
+ he = Tcl_CreateHashEntry (&Encodings, name, &nw);
+ Tcl_SetHashValue (he, enc);
+ if (frs && ! enc) {
+ *frs = !0;
+ }
+ return enc;
+}
+
+static void FreeEnc () {
+ if (InitEnc) {
+ Tcl_Encoding enc;
+ Tcl_HashSearch hs;
+ Tcl_HashEntry *he;
+ for (he = Tcl_FirstHashEntry (&Encodings, &hs);
+ he;
+ he = Tcl_NextHashEntry (&hs)
+ ) {
+ enc = (Tcl_Encoding) Tcl_GetHashValue (he);
+ if (enc) {
+ Tcl_FreeEncoding (enc);
+ }
+ }
+ Tcl_DeleteHashTable (&Encodings);
+ InitEnc = 0;
+ }
+}
+
+static const char* TrfEnc (const char *ename,
+ const char *src, int slen, char *dst, int dlen, int invert
+) {
+ Tcl_Encoding enc;
+ Tcl_DString str;
+ char *tgt;
+ int tlen, frs;
+
+ if (! ename) {
+ if (src) {
+ openIsisMFree ((void*)src);
+ }
+ return 0;
+ }
+
+ if (! src || 0 >= slen) {
+ return src;
+ }
+ /* tclEncoding.c says that a null interp is ok */
+ frs = 0;
+ enc = GetEnc (0, ename, &frs);
+ if (frs) {
+ openIsisSMsg (OPENISIS_ERR_INVAL,
+ "[openIsisTcl] TrfEnc: no such encoding <%s>", ename);
+ return src;
+ }
+
+ Tcl_DStringInit (&str);
+ if (invert) {
+ tgt = Tcl_UtfToExternalDString (enc, src, slen, &str);
+ }
+ else {
+ tgt = Tcl_ExternalToUtfDString (enc, src, slen, &str);
+ }
+ tlen = Tcl_DStringLength (&str);
+ if (! dst || tlen >= dlen) {
+ dst = (char*) openIsisMAlloc (1 + tlen);
+ if (! dst) {
+ return 0;
+ }
+ }
+ memcpy (dst, tgt, tlen);
+ dst[tlen] = 0;
+ Tcl_DStringFree (&str);
+ return dst;
+}
+
+OpenIsisEnc2Utf8Func *openIsisEnc2Utf8 = &TrfEnc;
+
+/* ************************************************************
+ public functions
+*/
+
+int openIsisTclNewSession (Tcl_Interp *ip) {
+ int id;
+ for (id = 0; NumSessions > id; ++id) {
+ if (ip == Sessions[id].ip) {
+ return id;
+ }
+ }
+ id = CtorSess (ip);
+ if (0 <= id) {
+ AddCmds (ip, 0 == id);
+ }
+ return id;
+}
+
+int openIsisTclGetSession (int sid, Tcl_Interp **ip) {
+ if (0 > sid || NumSessions <= sid) {
+ return 0;
+ }
+ if (ip) {
+ *ip = Sessions[sid].ip;
+ }
+ return !0;
+}
+
+/*
+void openIsisTclDelSession (int sid) {
+ if (! sid) {
+ ExitSess ();
+ return;
+ }
+ if (0 < sid && NumSessions > sid) {
+ DtorSess (Sessions + sid);
+ }
+}
+*/
+
+
+int openIsisTclCreateRecCmd (
+ int sid, const char *nam, const char *fn, int flg
+) {
+ OITSess *ois = Sessions+sid;
+ OpenIsisFdt *fdt = 0;
+ int rid;
+ (void)flg; /* TODO: set readonly */
+ if (fn) {
+ OITRec *oitf = TclCmd2Rec (ois->ip, fn, 0);
+ if (! oitf) {
+ openIsisSMsg (OPENISIS_ERR_INVAL,
+ "[openIsisTcl] createRecCmd: no such fdt %s", fn);
+ }
+ fdt = openIsisFRec2Fdt (oitf->rec);
+ if (! fdt) {
+ openIsisSMsg (OPENISIS_ERR_INVAL,
+ "[openIsisTcl] createRecCmd: illegal fdt %s", fn);
+ }
+ }
+ rid = NewRec( ois, 0, fdt, fdt ? OIT_RS_OWNF : 0 );
+ if ( 0 <= rid ) {
+ CrtRecCmd( ois, nam, ois->recs[rid], 0 );
+ }
+ return rid;
+} /* openIsisTclCreateRecCmd */
+
+
+int openIsisTclEval ( int sid,
+ int cnt, const int *ids, OpenIsisRec **recs, char *script )
+{
+ OITSess *ois = Sessions+sid;
+ int ret, i;
+
+ if ( recs )
+ for ( i=cnt; i--; )
+ ois->recs[ ids[i] ]->rec = recs[i];
+ ret = Tcl_Eval( ois->ip, script );
+ if ( recs )
+ for ( i=cnt; i--; )
+ recs[i] = ois->recs[ ids[i] ]->rec;
+ return ret;
+} /* openIsisTclEval */
+
+
+int openIsisTclInit (Tcl_Interp *ip) {
+ if (! NumSessions) {
+ CtorSess (ip);
+ }
+ AddCmds (ip, !0);
+ Tcl_CreateExitHandler (&AtExit, 0);
+ return TCL_OK;
+}
+