git.rot13.org Git - webpac/blob - openisis/tcl/openisistcl.c

   1 /*
   2         openisis - an open implementation of the CDS/ISIS database
   3         Version 0.8.x (patchlevel see file Version)
   4         Copyright (C) 2001-2003 by Erik Grziwotz, erik@openisis.org
   5
   6         This library is free software; you can redistribute it and/or
   7         modify it under the terms of the GNU Lesser General Public
   8         License as published by the Free Software Foundation; either
   9         version 2.1 of the License, or (at your option) any later version.
  10
  11         This library is distributed in the hope that it will be useful,
  12         but WITHOUT ANY WARRANTY; without even the implied warranty of
  13         MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14         Lesser General Public License for more details.
  15
  16         You should have received a copy of the GNU Lesser General Public
  17         License along with this library; if not, write to the Free Software
  18         Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20         see README for more information
  21 EOH */
  22
  23 /*
  24         $Id: openisistcl.c,v 1.77 2003/06/24 11:01:53 mawag Exp $
  25         tcl/tk binding
  26 */
  27
  28
  29 #include "openisis.h"
  30 #include "openisistcl.h"
  31 #include "luti.h"
  32 /* luti_getembed,
  33  * luti_ptrincr,
  34  * luti_parse_path,
  35  * luti_free,
  36  * luti_append
  37 */
  38 #include "ldsp.h" /* openIsisEnc2Utf8,openIsisEval */
  39 #include "lses.h" /* SESGET() */
  40
  41 /*
  42 include this after the Tcl stuff for the benefit of those
  43 who use the 150% braindead gcc 2.96
  44 which barfs on
  45  declaration of `index' shadows global declaration
  46 in generic/tclDecls.h
  47 cause string.h declares
  48 char *index(const char *s, int c)
  49 */
  50 #include <errno.h>
  51 #include <limits.h>
  52 #include <stdio.h>
  53 #include <stdlib.h>
  54 #include <string.h>
  55
  56 #ifdef WIN32
  57 #define snprintf _snprintf
  58 #endif
  59
  60 /*
  61 #ifdef _REENTRANT
  62 unusable because of POSIX stdfoo.h braindamage
  63 -- they mix up MT with reentrant.
  64
  65 Hmm, actually, _REENTRANT *is* the wrong flag for threads.
  66 But, unfortunately, the *thread* thing #define errno *errnolocation()
  67 is bound to this flag by POSIX (mas o menos).
  68 You need the reentrant functions in every stupid single threaded signal handler.
  69 Therefore, it's a pretty poor idea of Solaris (albeit very POSIX compliant)
  70 to not define them unless _REENTRANT.
  71
  72 *sigh*
  73
  74 from /opt/TclTk/tcl8.3.5/unix/configure:
  75         SunOS-5.[0-6]*)
  76
  77             # Note: If _REENTRANT isn't defined, then Solaris
  78             # won't define thread-safe library routines.
  79
  80             cat >> confdefs.h <<\EOF
  81 #define _REENTRANT 1
  82 EOF
  83 */
  84 #ifdef TCL_THREADS
  85 extern int openisis_threaded;
  86 static int *link_dummy = &openisis_threaded; /* force correct linkage */
  87 #endif
  88
  89
  90 /*      ============================ types ==================================
  91 */
  92
  93 /* name of local schema */
  94 #define OIT_STB0  "openIsisRoot"
  95
  96 typedef enum {
  97         /*      record commands */
  98         RC_ADD,
  99         RC_CLON,
 100         RC_COPY,
 101         RC_DB, /* stub, too */
 102         RC_DEL,
 103         RC_DESER,
 104         RC_DO,
 105         RC_DONE, /* stub, too */
 106         RC_FDT, /* stub, too */
 107         RC_FMT,
 108         RC_GET,
 109         RC_ROW,
 110         RC_LEN,
 111         RC_SERI,
 112         RC_SET,
 113         RC_WRAP,
 114         RC_LAST = RC_WRAP, /* used for checking last rec cmd */
 115         /*      stub commands */
 116         SC_NEW,
 117         SC_RECV,
 118         SC_RQS,
 119         SC_ARQS,
 120         SC_ARSP
 121 } OITCmd;
 122
 123 static const char *OITOpts[] = {
 124         /*      record commands */
 125         "add",
 126         "clone",
 127         "copy",
 128         "db",
 129         "delete",
 130         "deserialize",
 131         "do",
 132         "done",
 133         "fdt",
 134         "format",
 135         "get",
 136         "rowid",
 137         "length",
 138         "serialize",
 139         "set",
 140         "wrap",
 141         /*      stub commands */
 142         "new",
 143         "recv",
 144         "request",
 145         ".req",
 146         ".res",
 147         0
 148 };
 149
 150 #define OIT_RS_SZM         0x000FF  /* size mask */
 151 #define OIT_RS_RQS         0x00100  /* schemas request rec */
 152 #define OIT_RS_RSP         0x00200  /* schemas response rec */
 153 #define OIT_RS_STC         0x00400  /* schemas config rec */
 154 #define OIT_RS_DBC         0x00800  /* db config rec */
 155 #define OIT_RS_DBF         0x01000  /* db fdt rec */
 156 #define OIT_RS_USED        0x10000  /* rec is in use */
 157 #define OIT_RS_FRE         0x20000  /* free associated memory */
 158 #define OIT_RS_OWNF        0x40000  /* record has own fdt that must be freed */
 159
 160 #define RecType(r)        (0x01F00 & (r)->stat)
 161 #define NonWritable(r)    (0x01A00 & (r)->stat)
 162 #define NonDeletable(r)   (0x00700 & (r)->stat)
 163
 164 typedef struct OITSess OITSess;
 165
 166 typedef struct {
 167         OpenIsisRec       *rec;
 168         OpenIsisDb        *db;   /* own db; tmp set to target db in rqs */
 169         const OpenIsisFdt *fdt;  /* own fdt */
 170         const char        *cmd;  /* associated tcl ip cmd */
 171         int                sid;  /* allocator */
 172         int                stat;
 173 } OITRec;
 174
 175 #define RecSess(r) \
 176         (0 <= ((OITRec*)(r))->sid && NumSessions > ((OITRec*)(r))->sid ? \
 177         Sessions + ((OITRec*)(r))->sid : 0)
 178
 179 typedef struct {
 180         OITRec          env;
 181         OpenIsisStub    stb;
 182         OITRec        **recs;   /* embedded recs */
 183         int             numr;
 184 } OITCont;
 185
 186 #define OIT_ST_ROOT      0x0001
 187 #define OIT_ST_TCL       0x0002
 188 #define OIT_ST_OINIT     0x0004
 189
 190 typedef struct {
 191         OpenIsisStub      stb;
 192         OITRec            cfg;  /* direct schema copy allocated by ses0 */
 193         OITCont          *rqs;
 194         OITCont          *rsp;
 195         const char       *cmd;  /* associated tcl ip cmd */
 196         Tcl_Obj          *dfltproc;
 197         Tcl_Obj          *actproc;
 198         int               ases; /* act session of rqs and rsp */
 199         int               stat;
 200 } OITStub;
 201
 202 #define StbSess(s) (0 <= (s)->ases && NumSessions > (s)->ases ? \
 203         Sessions + (s)->ases : 0)
 204
 205 struct OITSess {
 206         Tcl_Interp       *ip;
 207         OITRec          **recs;
 208         int               numr;
 209         int               six;
 210 };
 211
 212 static OITSess *Sessions = 0;
 213 static int      NumSessions = 0;
 214
 215 /*      ============================ records ================================
 216 */
 217
 218 #define OIT_RECINCR   32
 219 #define OIT_MAXRECS   65535
 220 #define OIT_SESSINCR  1
 221 #define OIT_MAXSESS   255
 222
 223 static void CtorRec (OITRec *that, int sid, int siz) {
 224         memset (that, 0, (unsigned)siz);
 225         that->stat = siz;
 226         that->sid  = sid;
 227 }
 228
 229 static int AllcRec (OITSess *ois, int siz, int type) {
 230         int j;
 231         if (siz > OIT_RS_SZM) {
 232                 return openIsisSMsg (OPENISIS_ERR_TRASH,
 233                         "[openIsisTcl] AllcRec: unexpected size %d", siz);
 234         }
 235         for (j = ois->numr; 0 <= --j;  ) {
 236                 if (! ois->recs[j]) {
 237                         goto allcj;
 238                 }
 239                 if (! (OIT_RS_USED & ois->recs[j]->stat) &&
 240                         siz == (OIT_RS_SZM & ois->recs[j]->stat)  /* may be <= */
 241                 ) {
 242                         goto done;
 243                 }
 244         }
 245         j = luti_ptrincr (
 246                 &ois->recs, &ois->numr, OIT_RECINCR, sizeof (OITRec*), OIT_MAXRECS);
 247         if (0 > j) {
 248                 return openIsisSMsg (OPENISIS_ERR_TRASH,
 249                         "[openIsisTcl] AllcRec: out of memory");
 250         }
 251 allcj:
 252         ois->recs[j] = (OITRec*) openIsisMAlloc (siz);
 253         if (! ois->recs[j]) {
 254                 return openIsisSMsg (OPENISIS_ERR_TRASH,
 255                         "[openIsisTcl] AllcRec: out of memory");
 256         }
 257         CtorRec (ois->recs[j], ois->six, siz);
 258 done:
 259         ois->recs[j]->stat |= type | OIT_RS_USED;
 260         return j;
 261 }
 262
 263 static int NewRec (
 264         OITSess *ois, OpenIsisDb *db, const OpenIsisFdt *fdt, int type
 265 ) {
 266         int j = AllcRec (ois, sizeof (OITRec), type);
 267         if (0 <= j) {
 268                 ois->recs[j]->db = db;
 269                 ois->recs[j]->fdt = fdt;
 270         }
 271         return j;
 272 }
 273
 274 static int NewCont (OITSess *ois, const OpenIsisFdt *fdt, int type) {
 275         int j = AllcRec (ois, sizeof (OITCont), type);
 276         if (0 <= j) {
 277                 ois->recs[j]->fdt = fdt;
 278         }
 279         return j;
 280 }
 281
 282 static void DtorRecs (OITRec **recs, int numr, int frmem);
 283
 284 static void DtorRec (OITRec *that, int frmem) {
 285         if (that) {
 286                 OITCont    *con;
 287                 OITSess    *ois;
 288                 int         siz, type;
 289                 ois = RecSess (that);
 290                 if (! ois) {
 291                         openIsisSMsg (OPENISIS_ERR_TRASH,
 292                                 "[openIsisTcl] DtorRec: illegal sid %d(%d)",
 293                                 that->sid, NumSessions);
 294                         return;
 295                 }
 296                 if (that->cmd) {
 297                         if (frmem) {
 298                                 that->stat |= OIT_RS_FRE;
 299                         }
 300                         Tcl_DeleteCommand (ois->ip, (char*)that->cmd);
 301                         return;
 302                 }
 303                 type = RecType (that);
 304                 siz = OIT_RS_SZM & that->stat;
 305                 switch (type) {
 306                 case 0:
 307                 case OIT_RS_DBF:
 308                         if (that->rec) {
 309                                 openIsisMFree (that->rec);
 310                         }
 311                         break;
 312                 case OIT_RS_DBC:
 313                         /* that->rec = 0; readonly cfg handled by db */
 314                         break;
 315                 case OIT_RS_RQS:
 316                         if (that->rec) {
 317                                 openIsisMFree (that->rec);
 318                         }
 319                         /* fall thru */
 320                 case OIT_RS_RSP:
 321                         /* that->rec = 0; response record handled by stub */
 322                         con = (OITCont*)that;
 323                         DtorRecs (con->recs, con->numr, 0);
 324                         break;
 325                 default:
 326                         /* OIT_RS_STC embedded in OITStub and handled by stub */
 327                         openIsisSMsg (OPENISIS_ERR_TRASH,
 328                                 "[openIsisTcl] DtorRec: unexpected type %x", type);
 329                         return;
 330                 }
 331                 if ((OIT_RS_OWNF & that->stat)) {
 332                         openIsisFFree ((OpenIsisFdt*)that->fdt);
 333                 }
 334                 if (frmem || (OIT_RS_FRE & that->stat)) {
 335                         openIsisMFree (that);
 336                 }
 337                 else {
 338                         CtorRec (that, ois->six, siz);
 339                 }
 340         }
 341 }
 342
 343 static void DtorRecs (OITRec **recs, int numr, int frmem) {
 344         if (recs) {
 345                 while (0 <= --numr) {
 346                         DtorRec (recs[numr], frmem);
 347                 }
 348                 openIsisMFree (recs);
 349         }
 350 }
 351
 352 static int CtorSess (Tcl_Interp *ip) {
 353         int j = luti_ptrincr (
 354                 &Sessions, &NumSessions, OIT_SESSINCR, sizeof (OITSess), OIT_MAXSESS);
 355         if (0 > j) {
 356                 return -1;
 357         }
 358         Sessions[j].ip  = ip;
 359         Sessions[j].six = j;
 360         return j;
 361 }
 362
 363 static void DtorSess (OITSess *that) {
 364         DtorRecs (that->recs, that->numr, !0);
 365 }
 366
 367 static void ExitSess () {
 368         int j;
 369         if (NumSessions) {
 370                 for (j = NumSessions; 0 <= --j;  ) {
 371                         DtorSess (Sessions + j);
 372                 }
 373                 openIsisMFree (Sessions);
 374                 Sessions = 0;
 375                 NumSessions = 0;
 376         }
 377 }
 378
 379 /*      ---------------------------------------------------------------------
 380 */
 381
 382 static unsigned _RecId = 0;
 383
 384 static char* NewRecId (char *buf) {
 385         sprintf (buf, "openIsisRec%u", ++_RecId);
 386         return buf;
 387 }
 388
 389 static void TclDelRec (ClientData cld) {
 390         OITRec *that = (OITRec*)cld;
 391         if (that->cmd) {
 392                 openIsisMFree ((void*)that->cmd);
 393                 that->cmd = 0;
 394         }
 395         DtorRec ((OITRec*)cld, 0);
 396 }
 397
 398 static int CmdRec (
 399         ClientData rid, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
 400 );
 401
 402 static int CrtRecCmd (OITSess *ois, const char *name, OITRec *rec, int srst) {
 403         char buf[64];
 404         if (! name || ! *name) {
 405                 name = NewRecId (buf);
 406         }
 407         rec->cmd = (const char*) openIsisMDup (name, -1);
 408         if (! rec->cmd) {
 409                 Tcl_AppendResult (ois->ip, "CrtRecCmd: out of memory", 0);
 410                 return TCL_ERROR;
 411         }
 412         Tcl_CreateObjCommand (ois->ip, (char*)name, &CmdRec, rec, &TclDelRec);
 413         if (srst) {
 414                 Tcl_SetResult (ois->ip, (char*)name, TCL_VOLATILE);
 415         }
 416         return TCL_OK;
 417 }
 418
 419 static char **ToArgv (
 420         Tcl_Obj* const objv[], int objc, char* buf, int siz
 421 ) {
 422         char *str, *nb;
 423         char *res  = buf;
 424         int   posp = 0;
 425         int   stav = objc * sizeof (char*);
 426         int   posv = stav;
 427         int   j, len, nsz;
 428         for (j = 0; objc > j; ++j) {
 429                 str = Tcl_GetStringFromObj (objv[j], &len);
 430                 nsz = posv + 1 + len;
 431                 if (siz < nsz) {
 432                         char **S, **T;
 433                         int    k, diff;
 434                         nsz *= 2;
 435                         nb = (char*) openIsisMAlloc (nsz);
 436                         if (! nb) {
 437                                 openIsisSMsg (OPENISIS_ERR_NOMEM,
 438                                         "[openIsisTcl] ToArgv: out of memory");
 439                                 return 0;
 440                         }
 441                         diff = nb - res;
 442                         for (k = j, S = (char**)res, T = (char**)nb ; 0 <= --k;  ) {
 443                                 *T++ = *S++ + diff;
 444                         }
 445                         memcpy (nb + stav, res + stav, (unsigned)(posv - stav));
 446                         if (res != buf) {
 447                                 openIsisMFree (res);
 448                         }
 449                         siz = nsz;
 450                         res = nb;
 451                 }
 452                 *(char**)(res + posp) = res + posv;
 453                 ((char*) memcpy (res + posv, str, len)) [len] = 0;
 454                 posp += sizeof (char*);
 455                 posv += 1 + len;
 456         }
 457         return (char**)res;
 458 }
 459
 460 static OITRec* TclCmd2Rec (
 461         Tcl_Interp *ip, const char *cmd, const char *arg0
 462 ) {
 463         Tcl_CmdInfo info;
 464         if (! cmd) {
 465                 if (arg0) {
 466                         Tcl_AppendResult (ip, arg0, ": record command not given", 0);
 467                 }
 468                 return 0;
 469         }
 470         if (! Tcl_GetCommandInfo (ip, cmd, &info)) {
 471                 if (arg0) {
 472                         Tcl_AppendResult (ip, arg0, ": no such record: ", cmd, 0);
 473                 }
 474                 return 0;
 475         }
 476         if (info.objProc != &CmdRec) {
 477                 if (arg0) {
 478                         Tcl_AppendResult (ip, arg0, ": ", cmd, " is not a record", 0);
 479                 }
 480                 return 0;
 481         }
 482         if (! info.objClientData) {
 483                 if (arg0) {
 484                         Tcl_AppendResult (ip, arg0, ": ", cmd, " is corrupted", 0);
 485                 }
 486                 return 0;
 487         }
 488         return (OITRec*) info.objClientData;
 489 }
 490
 491 static int BuildEmbRecs (
 492         OITCont *that, OpenIsisRec **recs, int numr, int frr
 493 ) {
 494         OITSess      *ois;
 495         OITRec      **oirs;
 496         int           buf[1000];
 497         int          *idx = buf;
 498         int           j;
 499         ois = RecSess (that);
 500         if (! ois) {
 501                 return openIsisSMsg (OPENISIS_ERR_TRASH,
 502                         "[openIsisTcl] BuildEmbRecs: illegal sid %d(%d)",
 503                         that->env.sid, NumSessions);
 504         }
 505         oirs = (OITRec**) openIsisMAlloc ( (int) (numr * sizeof (OITRec*)));
 506         if (! oirs) {
 507                 if (frr) {
 508                         luti_free ((void**)recs, numr);
 509                 }
 510                 return openIsisSMsg (OPENISIS_ERR_NOMEM,
 511                         "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
 512         }
 513         if (1000 < numr) {
 514                 idx = (int*) openIsisMAlloc ( (int) (numr * sizeof (int)));
 515                 if (! idx) {
 516                         if (frr) {
 517                                 luti_free ((void**)recs, numr);
 518                         }
 519                         openIsisMFree (oirs);
 520                         return openIsisSMsg (OPENISIS_ERR_NOMEM,
 521                                 "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
 522                 }
 523         }
 524         for (j = numr; 0 <= --j;  ) {
 525                 idx[j] = NewRec (ois, 0, 0, 0);
 526                 if (0 > idx[j]) {
 527                         if (frr) {
 528                                 luti_free ((void**)recs, numr);
 529                         }
 530                         openIsisMFree (oirs);
 531                         if (idx != buf) {
 532                                 openIsisMFree (idx);
 533                         }
 534                         return openIsisSMsg (OPENISIS_ERR_NOMEM,
 535                                 "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
 536                 }
 537         }
 538         for (j = numr; 0 <= --j;  ) {
 539                 oirs[j] = ois->recs[idx[j]];
 540                 oirs[j]->rec = recs[j];
 541         }
 542         that->recs = oirs;
 543         that->numr = numr;
 544         if (idx != buf) {
 545                 openIsisMFree (idx);
 546         }
 547         if (frr) {
 548                 openIsisMFree (recs);
 549         }
 550         return numr;
 551 }
 552
 553 static int BuildRqsRecs (OITCont *that) {
 554         OpenIsisRec *recs[4] = { 0, 0, 0, 0 }; /* REC, IDX, CFG, fdt */
 555         int          numr;
 556         numr = BuildEmbRecs (that, recs, 4, 0);
 557         if (4 == numr) {
 558                 if ((that->recs[0]->db = that->env.db)) {
 559                         that->recs[0]->fdt = that->env.db->fdt;
 560                 }
 561                 that->recs[2]->fdt = openIsisFdtDbpar;
 562                 that->recs[3]->fdt = openIsisFdtFdt;
 563         }
 564         return numr;
 565 }
 566
 567 static int BuildRspRecs (OITCont *that, Tcl_Interp *ip, const char *arg0) {
 568         OpenIsisRec **recs;
 569         OpenIsisDb   *db;
 570         int          *rows; /* save rowid in recs */
 571         int           numr, j;
 572         numr = openIsisNGetResult (that->stb, &rows, &recs, &db, 0);
 573         if (0 > numr) {
 574                 Tcl_AppendResult (ip, arg0,
 575                         ": child allocation failure", 0);
 576                 return numr;
 577         }
 578         if (rows) {
 579                 openIsisMFree (rows);
 580         }
 581         if (0 == numr || ! recs) {
 582                 return 0;
 583         }
 584         j = BuildEmbRecs (that, recs, numr, !0);
 585         if (j != numr) {
 586                 Tcl_AppendResult (ip, arg0,
 587                         ": child allocation failure", 0);
 588                 return j;
 589         }
 590         if (db) {
 591                 for (j = numr; 0 <= --j;  ) {
 592                         that->recs[j]->db = db;
 593                         that->recs[j]->fdt = db->fdt;
 594                 }
 595         }
 596         return numr;
 597 }
 598
 599 static int UsageRec (Tcl_Interp *ip, const char *arg0) {
 600         if (! arg0) {
 601                 arg0 = "<openIsisRecord>";
 602         }
 603         Tcl_AppendResult (ip,
 604                 "usage: ", arg0,
 605                 " add field value ?field value ...? |",
 606                 " clone ?options? newname ?field value ...? |",
 607                 " copy source |",
 608                 " db ?options? |",
 609                 " delete ?field ...? |",
 610                 " deserialize line |",
 611                 " do ?tagvar? valvar body |",
 612                 " done |",
 613                 " fdt ?options? |",
 614                 " format ?options? format |",
 615                 " get ?-tags | -tagnames | field ...? |",
 616                 " rowid |",
 617                 " serialize |",
 618                 " set field ?value field value ...? |",
 619                 " wrap ?options? recname |",
 620                 " .path ?option arg ...?",
 621                 0);
 622         return TCL_ERROR;
 623 }
 624
 625 static int OpPath (
 626         OITRec *that, Tcl_Interp *ip, const char *arg0,
 627         Tcl_Obj *arg1, int argc, Tcl_Obj* const argv[]
 628 );
 629
 630 static int OpDb (Tcl_Interp *ip,
 631         OITSess *ois, OpenIsisDb *db, int argc, Tcl_Obj* const argv[]
 632 ) {
 633         OITRec *oir;
 634         int     rt;
 635         rt = NewRec (ois, 0, openIsisFdtDbpar, OIT_RS_DBC);
 636         if (0 > rt) {
 637                 Tcl_AppendResult (ip, "openIsisDb: out of memory", 0);
 638                 return TCL_ERROR;
 639         }
 640         oir = ois->recs[rt];
 641         oir->rec = db->cfg;
 642         if (argc) {
 643                 rt = OpPath (oir, ip, "openIsisDb", argv[0], argc - 1, argv + 1);
 644                 DtorRec (oir, 0);
 645                 return rt;
 646         }
 647         return CrtRecCmd (ois, 0, oir, !0);
 648 }
 649
 650 static int OpFdt (Tcl_Interp *ip,
 651         OITSess *ois, const OpenIsisFdt *fdt, int argc, Tcl_Obj* const argv[]
 652 ) {
 653         OITRec *oir;
 654         int     rt;
 655         rt = NewRec (ois, 0, openIsisFdtFdt, OIT_RS_DBF);
 656         if (0 > rt) {
 657                 Tcl_AppendResult (ip, "openIsisFdt: out of memory", 0);
 658                 return TCL_ERROR;
 659         }
 660         oir = ois->recs[rt];
 661         oir->rec = openIsisFFdt2Rec (fdt, 0, 0);
 662         if (argc) {
 663                 rt = OpPath (oir, ip, "openIsisFdt", argv[0], argc - 1, argv + 1);
 664                 DtorRec (oir, 0);
 665                 return rt;
 666         }
 667         return CrtRecCmd (ois, 0, oir, !0);
 668 }
 669
 670 #define FldObj( f ) Tcl_NewStringObj( (f)->val, (f)->len )
 671
 672 static Tcl_Obj* FdObj (OpenIsisField *fld, const OpenIsisFdt *fdt)  {
 673         if (fdt) {
 674                 OpenIsisFd *fd = openIsisFById (fdt, fld->tag, 0);
 675                 if (fd) {
 676                         return Tcl_NewStringObj (fd->name, -1);
 677                 }
 678         }
 679         return Tcl_NewIntObj (fld->tag);
 680 }
 681
 682 static int OpRec (
 683         OITRec *that, Tcl_Interp *ip, const char *arg0,
 684         const OITCmd cmd, int argc, Tcl_Obj* const argv[]
 685 ) {
 686         OITSess *ois = RecSess (that);
 687         if (! ois) {
 688                 Tcl_AppendResult (ip, arg0, ": record corrupted", 0);
 689                 return TCL_ERROR;
 690         }
 691
 692         switch (cmd) {
 693
 694         case RC_SET:
 695         case RC_ADD: {
 696                 char         buf[2048];
 697                 OpenIsisRec *oldrec;
 698                 char       **argp  =  0;
 699                 char       **args  =  0;
 700                 int          setf  =  0;
 701                 int          len;
 702                 if (0 == argc) {
 703                         return UsageRec (ip, arg0);
 704                 }
 705                 if (RC_SET == cmd) {
 706                         if (1 == argc) {
 707                                 goto op_get;
 708                         }
 709                         if ( that->rec ) {
 710                                 setf = OPENISIS_RCHG;
 711                         }
 712                 }
 713                 if (NonWritable (that)) {
 714                         Tcl_AppendResult (ip, arg0, ": readonly record", 0);
 715                         return TCL_ERROR;
 716                 }
 717                 args = argp = ToArgv (argv, argc, buf, sizeof (buf));
 718                 if (! argp) {
 719                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
 720                         return TCL_ERROR;
 721                 }
 722                 while (argc) {
 723                         if ('-' != args[0][0]) {
 724                                 break;
 725                         }
 726                         len = strlen (args[0]);
 727                         if (1 == len || '-' == args[0][1]) {
 728                                 break;
 729                         }
 730                         if (0 == strncmp ("-ignore", args[0], len)) {
 731                                 setf |= OPENISIS_RIGN;
 732                                 ++args;
 733                                 --argc;
 734                                 continue;
 735                         }
 736                         if (RC_SET != cmd) {
 737                                 break;
 738                         }
 739                         if (0 == strncmp ("-default", args[0], len)) {
 740                                 setf = OPENISIS_RDFLT | (OPENISIS_RIGN & setf);
 741                                 ++args;
 742                                 --argc;
 743                                 continue;
 744                         }
 745                         break;
 746                 }
 747                 oldrec = that->rec;
 748                 that->rec = openIsisRSet (oldrec,
 749                         OPENISIS_RARGV | OPENISIS_RFDT | OPENISIS_RDIS | setf | argc,
 750                         that->fdt, args);
 751                 if (argp != (char**)buf) {
 752                         openIsisMFree (argp);
 753                 }
 754                 if (! that->rec && (oldrec || (argc && !(OPENISIS_RIGN & setf)))) {
 755                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
 756                         return TCL_ERROR;
 757                 }
 758                 return TCL_OK;
 759         } /* RC_SET, RC_ADD */
 760
 761         case RC_CLON: {
 762                 char    buf[64];
 763                 OITRec *nrec;
 764                 char   *opt   = 0;
 765                 char   *name  = 0;
 766                 int     empty = 0;
 767                 int     nn    = 0;
 768                 int     j, len, rt, id;
 769                 if ((OIT_RS_RQS | OIT_RS_RSP) & that->stat) {
 770                         Tcl_AppendResult (ip, arg0,
 771                                 ": container cloning not allowed", 0);
 772                         return TCL_ERROR;
 773                 }
 774                 for (j = 0; argc > j; ++j) {
 775                         opt = Tcl_GetStringFromObj (argv[j], &len);
 776                         if (0 == len) {
 777                                 return UsageRec (ip, arg0);
 778                         }
 779                         if ('-' != *opt) {
 780                                 break;
 781                         }
 782                         if (0 == opt[1]) {
 783                                 nn = !0;
 784                                 ++j;
 785                                 break;
 786                         }
 787                         if (0 == strncmp ("-empty", opt, len)) {
 788                                 empty = !0;
 789                                 continue;
 790                         }
 791                         return UsageRec (ip, arg0);
 792                 }
 793                 if (argc > j && ! nn) {
 794                         name = Tcl_GetStringFromObj (argv[j], &len);
 795                         if (0 == len) {
 796                                 return UsageRec (ip, arg0);
 797                         }
 798                         ++j;
 799                 }
 800                 if (! name) {
 801                         name = NewRecId (buf);
 802                 }
 803                 id = NewRec (ois, that->db, that->fdt, 0);
 804                 if (0 > id) {
 805                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
 806                         return TCL_ERROR;
 807                 }
 808                 nrec = ois->recs[id];
 809                 if (! empty) {
 810                         nrec->rec = openIsisRDup (that->rec, 0, 0);
 811                 }
 812                 if (argc > j) {
 813                         rt = OpRec (nrec,
 814                                 ip, name, RC_SET, argc - j, argv + j);
 815                         if (TCL_OK != rt) {
 816                                 return rt;
 817                         }
 818                 }
 819                 rt = CrtRecCmd (ois, name, ois->recs[id], !0);
 820                 return rt;
 821         } /* RC_CLON */
 822
 823         case RC_COPY: {
 824                 char    buf[64];
 825                 OITRec *src;
 826                 Field  *fld;
 827                 int     j;
 828                 if (1 != argc) {
 829                         return UsageRec (ip, arg0);
 830                 }
 831                 src = TclCmd2Rec (ip, Tcl_GetStringFromObj (argv[0], 0), arg0);
 832                 if (! src) {
 833                         return TCL_ERROR;
 834                 }
 835                 if (! src->rec || ! src->rec->len) {
 836                         Tcl_SetResult (ip, "0", TCL_STATIC);
 837                         return TCL_OK;
 838                 }
 839                 fld = src->rec->field;
 840                 j = src->rec->len;
 841                 sprintf (buf, "%d", j);
 842                 Tcl_SetResult (ip, buf, TCL_VOLATILE);
 843                 while (j) {
 844                         OPENISIS_RADD (that->rec, fld->tag, fld->val, fld->len, !0);
 845                         ++fld;
 846                         --j;
 847                 }
 848                 return TCL_OK;
 849         } /* RC_COPY */
 850
 851         case RC_DB:
 852                 if (! that->db) {
 853                         Tcl_AppendResult (ip, arg0, ": no db", 0);
 854                         return TCL_ERROR;
 855                 }
 856                 return OpDb (ip, ois, that->db, argc, argv);
 857
 858         case RC_DEL: {
 859                 if (NonWritable (that)) {
 860                         Tcl_AppendResult (ip, arg0, ": readonly record", 0);
 861                         return TCL_ERROR;
 862                 }
 863                 if (argc) {
 864                         char    buf[2048];
 865                         char  **argp = ToArgv (argv, argc, buf, sizeof (buf));
 866                         if (! argp) {
 867                                 Tcl_AppendResult (ip, arg0, ": out of memory", 0);
 868                                 return TCL_ERROR;
 869                         }
 870                         that->rec = openIsisRSet (that->rec,
 871                                 OPENISIS_RARGV | OPENISIS_RFDT | OPENISIS_RDEL | argc,
 872                                 that->fdt, argp);
 873                         if (argp != (char**)buf) {
 874                                 openIsisMFree (argp);
 875                         }
 876                         return TCL_OK;
 877                 }
 878                 if (that->rec) {
 879                         OPENISIS_CLRREC( that->rec );
 880                 }
 881                 if (OIT_RS_RQS == RecType (that)) {
 882                         OITCont *con = (OITCont*)that;
 883                         if (con->numr) {
 884                                 DtorRecs (con->recs, con->numr, 0);
 885                                 con->numr = 0;
 886                                 con->recs = 0;
 887                         }
 888                 }
 889                 return TCL_OK;
 890         } /* RC_DEL */
 891
 892         case RC_DO: {
 893                 Tcl_Obj *tagvar = 0;
 894                 Tcl_Obj *valvar;
 895                 Tcl_Obj *tag = 0;
 896                 Tcl_Obj *val;
 897                 Tcl_Obj *body;
 898                 OpenIsisField *f;
 899                 int i, rt;
 900                 if ( 2 > argc )
 901                         return UsageRec (ip, arg0);
 902                 body = argv[--argc];
 903                 valvar = argv[--argc];
 904                 if ( 1 == argc )
 905                         tagvar = argv[0];
 906 #ifndef DONTREUSE
 907                 /* prepare object for var */
 908                 if ( ! Tcl_ObjSetVar2( ip, valvar, 0,
 909                         val = Tcl_NewObj(), TCL_LEAVE_ERR_MSG )
 910                 )
 911                         return TCL_ERROR;
 912                 if ( tagvar && ! Tcl_ObjSetVar2( ip, tagvar, 0,
 913                         tag = Tcl_NewIntObj(0), TCL_LEAVE_ERR_MSG )
 914                 )
 915                         return TCL_ERROR;
 916 #endif
 917
 918                 /* go loop */
 919                 rt = TCL_OK;
 920                 for ( i = that->rec->len, f = that->rec->field; i--; f++ ) {
 921 #ifndef DONTREUSE
 922                         /*
 923                                 if somebody shares the object, we have to set a new one
 924                                 (or Tcl_SetStringObj will panic).
 925                                 if it's not owned by the var, it's either owned by someone else
 926                                 or nobody, i.e. deleted
 927                         */
 928                         if ( val == Tcl_ObjGetVar2( ip, valvar, 0, TCL_LEAVE_ERR_MSG )
 929                                 && !Tcl_IsShared( val )
 930                         )
 931                                 Tcl_SetStringObj( val, (char*)f->val, f->len );
 932                         else
 933 #endif
 934                                 if ( !Tcl_ObjSetVar2( ip, valvar, 0,
 935                                         val = FldObj( f ), TCL_LEAVE_ERR_MSG )
 936                                 )
 937                                         return TCL_ERROR;
 938                         if ( tagvar ) {
 939 #ifndef DONTREUSE
 940                                 if ( tag == Tcl_ObjGetVar2( ip, tagvar, 0, TCL_LEAVE_ERR_MSG )
 941                                         && !Tcl_IsShared( tag )
 942                                 )
 943                                         Tcl_SetIntObj( tag, f->tag );
 944                                 else
 945 #endif
 946                                         if ( !Tcl_ObjSetVar2( ip, tagvar, 0,
 947                                                 tag = Tcl_NewIntObj( f->tag ), TCL_LEAVE_ERR_MSG )
 948                                         )
 949                                                 return TCL_ERROR;
 950                         }       /* tagvar */
 951                         switch (rt = Tcl_EvalObjEx( ip, body, 0 )) {
 952                         case TCL_CONTINUE:
 953                                 rt = TCL_OK;
 954                         case TCL_OK:
 955                                 continue;
 956                         case TCL_BREAK:
 957                                 rt = TCL_OK;
 958                         case TCL_RETURN:
 959                         case TCL_ERROR:
 960                         default:
 961                                 return rt;
 962                         }
 963                 }
 964                 return rt;
 965         } /* RC_DO */
 966
 967         case RC_DONE: {
 968                 if (! that->cmd) {
 969                         Tcl_AppendResult (ip, arg0, ": no command bound to rec", 0);
 970                         return TCL_ERROR;
 971                 }
 972                 if (strcmp (that->cmd, arg0)) {
 973                         Tcl_AppendResult (ip, arg0, ": command mismatch: ", that->cmd, 0);
 974                         return TCL_ERROR;
 975                 }
 976                 if (NonDeletable (that)) {
 977                         Tcl_AppendResult (ip, arg0, ": record not deletable", 0);
 978                         return TCL_ERROR;
 979                 }
 980                 Tcl_DeleteCommand (ip, (char*)arg0);
 981                 return TCL_OK;
 982         } /* RC_DONE */
 983
 984         case RC_FDT:
 985                 if (! that->fdt) {
 986                         Tcl_AppendResult (ip, arg0, ": no fdt", 0);
 987                         return TCL_ERROR;
 988                 }
 989                 return OpFdt (ip, ois, that->fdt, argc, argv);
 990
 991         case RC_FMT: {
 992                 Tcl_AppendResult (ip, arg0, ": sorry, format not implemented yet", 0);
 993                 return TCL_ERROR;
 994         } /* RC_FMT */
 995
 996         case RC_GET:
 997         op_get: {
 998                 OpenIsisField *fld;
 999                 const char *path, *rem;
1000                 int tag, occ, i, j, objc, len, reclen;
1001                 int witht  =  0;
1002                 int usedf  =  !0;
1003                 Tcl_Obj *list, *dflt, *val;
1004                 Tcl_Obj **objv;
1005
1006                 Tcl_ResetResult (ip);
1007                 reclen = that->rec ? that->rec->len : 0;
1008                 list = val = 0;
1009                 if (1 == argc) {
1010                         path = Tcl_GetStringFromObj (argv[0], &i);
1011                         if (3 < i && *path == '-') {
1012                                 if (0 == strncmp ("-tags", path, i)) {
1013                                         --argc;
1014                                         witht = 1;
1015                                 }
1016                                 else if (0 == strncmp ("-tagnames", path, i)) {
1017                                         --argc;
1018                                         witht = 2;
1019                                 }
1020                         }
1021                 }
1022                 if (! argc) {
1023                         list = Tcl_NewListObj( 0, 0 );
1024                         if (reclen) {
1025                                 for (i = reclen, fld = that->rec->field; i--; fld++) {
1026                                         if (witht) {
1027                                                 if (TCL_OK != Tcl_ListObjAppendElement (ip, list,
1028                                                         FdObj (fld, 2 == witht ? that->fdt : 0))) {
1029                                                         goto geterr;
1030                                                 }
1031                                         }
1032                                         if (TCL_OK != Tcl_ListObjAppendElement (ip, list,
1033                                                 FldObj (fld))) {
1034                                                 goto geterr;
1035                                         }
1036                                 }
1037                         }
1038                         Tcl_SetObjResult( ip, list );
1039                         return TCL_OK;
1040                 }
1041                 for (j = 0; argc > j;  ) {
1042                         path = Tcl_GetStringFromObj (argv[j], &len);
1043                         if (3 <= len &&
1044                                 '-' == *path &&
1045                                 0 == strncmp ("-nodefaults", path, len)) {
1046                                 usedf = 0;
1047                                 ++j;
1048                                 continue;
1049                         }
1050                         val = dflt = 0;
1051                         if (usedf &&
1052                                 TCL_OK ==
1053                                 Tcl_ListObjGetElements (0, argv[j], &objc, &objv) &&
1054                                 2 == objc
1055                         ) {
1056                                 path = Tcl_GetStringFromObj (objv[0], 0);
1057                                 dflt = objv[1];
1058                         }
1059                         rem = luti_parse_path (path, that->fdt, 0, &tag, &occ);
1060                         if (! rem || *rem) {
1061                                 Tcl_ResetResult (ip);
1062                                 Tcl_AppendResult (ip, arg0,
1063                                         ": no such path: ", path, 0);
1064                                 goto geterr;
1065                         }
1066                         if (reclen) {
1067                                 if ( 0 > occ ) {
1068                                         for ( i = reclen, fld = that->rec->field;
1069                                                 i--;
1070                                                 fld++ ) {
1071                                                 if ( tag == fld->tag ) {
1072                                                         if (! val) {
1073                                                                 val = Tcl_NewListObj (0, 0);
1074                                                         }
1075                                                         if (TCL_OK != Tcl_ListObjAppendElement (
1076                                                                 ip, val, FldObj(fld))) {
1077                                                                 goto geterr;
1078                                                         }
1079                                                 }
1080                                         }
1081                                 }
1082                                 else { /* specific occ wanted */
1083                                         fld = openIsisROccurence (that->rec, tag, occ);
1084                                         if (fld) {
1085                                                 val = FldObj(fld);
1086                                         }
1087                                 }
1088                         }
1089                         if (! val) {
1090                                 if (! dflt) {
1091                                         Tcl_ResetResult (ip);
1092                                         Tcl_AppendResult (ip, arg0,
1093                                                 ": no such field: ", path, 0);
1094                                         goto geterr;
1095                                 }
1096                                 /* don't force a list even for empty default
1097                                 -- take the default as list.
1098                                 A literal default foo IS the list containing foo.
1099                                 If you REALLY wan't a list with one empty element as default,
1100                                 you can explicitly specify one.
1101                                 if (0 > occ) {
1102                                         Tcl_Obj *tmp[1];
1103                                         tmp[0] = dflt;
1104                                         val = Tcl_NewListObj (1, tmp);
1105                                 } else
1106                                 */
1107                                         val = dflt;
1108                         }
1109                         if (++j >= argc) {
1110                                 if (! list) {
1111                                         Tcl_SetObjResult( ip, val );
1112                                         return TCL_OK;
1113                                 }
1114                                 if (TCL_OK != Tcl_ListObjAppendElement(ip, list, val)) {
1115                                         goto geterr;
1116                                 }
1117                                 break;
1118                         }
1119                         if (! list) {
1120                                 list = Tcl_NewListObj( 0, 0 );
1121                         }
1122                         if (TCL_OK != Tcl_ListObjAppendElement(ip, list, val)) {
1123                                 goto geterr;
1124                         }
1125                 }
1126                 if (! list) {
1127                         return UsageRec (ip, arg0);
1128                 }
1129                 Tcl_SetObjResult( ip, list );
1130                 return TCL_OK;
1131         geterr:
1132                 /* free */
1133                 if (val) {
1134                         Tcl_DecrRefCount (val);
1135                 }
1136                 if (list) {
1137                         Tcl_DecrRefCount( list );
1138                 }
1139                 return TCL_ERROR;
1140         } /* RC_GET */
1141
1142         case RC_ROW:
1143                 Tcl_SetObjResult( ip, Tcl_NewIntObj(
1144                         (that->rec && 0<that->rec->rowid) ? that->rec->rowid : 0
1145                 ) );
1146                 return TCL_OK;
1147
1148         case RC_LEN:
1149                 Tcl_SetObjResult( ip, Tcl_NewIntObj(
1150                         (that->rec && 0<that->rec->len) ? that->rec->len : 0
1151                 ) );
1152                 return TCL_OK;
1153
1154         case RC_SERI: {
1155                 char buf[2048];
1156                 char *b;
1157                 int len;
1158
1159                 if (! that->rec) {
1160                         Tcl_ResetResult (ip);
1161                         return TCL_OK;
1162                 }
1163                 len = sizeof (buf);
1164                 b = openIsisRSerializeAlloc (that->rec, buf, &len);
1165                 if (! b) {
1166                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1167                         return TCL_ERROR;
1168                 }
1169                 /* do NOT include the final blankline */
1170                 Tcl_SetObjResult( ip, Tcl_NewStringObj( b, len-1 ) );
1171                 /*
1172                 faster, but not allowed :(
1173                 Tcl_Obj *ret = Tcl_NewStringObj(0,0);
1174                 Tcl_SetObjLength( ret, that->rec->used );
1175                 Tcl_SetObjLength( ret, openIsisRSerialize( ret->bytes, that->rec ) );
1176                 */
1177                 if ( buf != b )
1178                         mFree( b );
1179                 return TCL_OK;
1180         } /* RC_SERI */
1181
1182         case RC_DESER: {
1183                 char *b;
1184                 int len;
1185
1186                 if ( 1 != argc )
1187                         return UsageRec (ip, arg0);
1188                 if (NonWritable (that)) {
1189                         Tcl_AppendResult (ip, arg0, ": readonly record", 0);
1190                         return TCL_ERROR;
1191                 }
1192                 b = Tcl_GetStringFromObj( argv[0], &len );
1193                 if ( ! b )
1194                         Tcl_ResetResult (ip);
1195                 else {
1196                         int ret = openIsisRDeserialize( &that->rec,
1197                                 b, len, OPENISIS_RDIS|OPENISIS_STOPONEMPTY );
1198                         Tcl_SetObjResult( ip, Tcl_NewIntObj( ret ) );
1199                 }
1200
1201                 return TCL_OK;
1202         } /* RC_DESER */
1203
1204         case RC_WRAP: {
1205                 char    buf[2048];
1206                 OITRec *emb  = 0;
1207                 char  **argp = (char**)buf;
1208                 char   *name = 0;
1209                 char   *tgnm = 0;
1210                 int     tag  = -1;
1211                 int     num  = -1;
1212                 int     del  = 0;
1213                 int     len, j;
1214
1215                 if (NonWritable (that)) {
1216                         Tcl_AppendResult (ip, arg0, ": readonly record", 0);
1217                         return TCL_ERROR;
1218                 }
1219                 argp = ToArgv (argv, argc, buf, sizeof(buf));
1220                 if (! argp) {
1221                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1222                         return TCL_ERROR;
1223                 }
1224                 for (j = 0; argc > j; ++j) {
1225                         if (! *argp[j]) {
1226                                 goto wuserr;
1227                         }
1228                         if ('-' == *argp[j]) {
1229                                 len = strlen (argp[j]);
1230                                 if (2 > len) {
1231                                         goto wuserr;
1232                                 }
1233                                 if (0 == strncmp ("-done", argp[j], len)) {
1234                                         del = !0;
1235                                         continue;
1236                                 }
1237                                 if (0 == strncmp ("-number", argp[j], len)) {
1238                                         if (argc <= ++j) {
1239                                                 goto wuserr;
1240                                         }
1241                                         num = openIsisA2id (argp[j], -1, -1);
1242                                         if (0 > num) {
1243                                                 goto wuserr;
1244                                         }
1245                                         continue;
1246                                 }
1247                                 if (0 == strncmp ("-tag", argp[j], len)) {
1248                                         if (argc <= ++j) {
1249                                                 goto wuserr;
1250                                         }
1251                                         tag = openIsisA2id (argp[j], -1, 0);
1252                                         if (0 >= tag) {
1253                                                 goto wuserr;
1254                                         }
1255                                         continue;
1256                                 }
1257                                 goto wuserr;
1258                         }
1259                         if (0 > tag && 0 == tgnm) {
1260                                 tgnm = argp[j];
1261                                 continue;
1262                         }
1263                         if (name) {
1264                                 goto wuserr;
1265                         }
1266                         name = argp[j];
1267                         emb = TclCmd2Rec (ip, name, arg0);
1268                         if (! emb) {
1269                                 goto wrperr;
1270                         }
1271                 } /* for argc */
1272
1273                 if (tgnm) {
1274                         OpenIsisFd *fd = openIsisFByName (that->fdt, tgnm);
1275                         if (! fd) {
1276                                 Tcl_AppendResult (ip, arg0,
1277                                         ": no such field description: ", tgnm, 0);
1278                                 goto wrperr;
1279                         }
1280                         tag = fd->id;
1281                 }
1282                 if (0 > tag) {
1283                         goto wuserr;
1284                 }
1285                 if (num && ! emb) {
1286                         Tcl_AppendResult (ip, arg0, ": record to embed not given", 0);
1287                         goto wrperr;
1288                 }
1289
1290                 if (0 <= num) {
1291                         that->rec = openIsisRAddI (that->rec, tag, num, !0);
1292                         if (num) {
1293                                 if (! emb->rec || ! (len = emb->rec->len)) {
1294                                         Tcl_AppendResult (ip, arg0,
1295                                                 ": record to embed is empty", 0);
1296                                         goto wrperr;
1297                                 }
1298                                 that->rec = luti_append (that->rec, emb->rec);
1299                         }
1300                         if (! that->rec) {
1301                                 Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1302                                 goto wrperr;
1303                         }
1304                 }
1305                 else {
1306                         len = that->rec || emb->rec;
1307                         that->rec = luti_wrap (that->rec, emb->rec, tag);
1308                         if (len && ! that->rec) {
1309                                 Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1310                                 goto wrperr;
1311                         }
1312                 }
1313
1314                 if (del && emb) {
1315                         len = OpRec (emb, ip, name, RC_DONE, 0, 0);
1316                         if (TCL_OK != len) {
1317                                 goto wrperr;
1318                         }
1319                 }
1320                 if (argp != (char**)buf) {
1321                         openIsisMFree (argp);
1322                 }
1323                 return TCL_OK;
1324
1325         wuserr:
1326                 Tcl_AppendResult (ip, "usage: " , arg0, " wrap [-done] ",
1327                         "[-number <numsubrecs>] {-tag <tag> | <tagname>} recname", 0);
1328         wrperr:
1329                 if (argp != (char**)buf) {
1330                         openIsisMFree (argp);
1331                 }
1332                 return TCL_ERROR;
1333         } /* RC_WRAP */
1334
1335         default: {
1336                 char buf[654];
1337                 openIsisI2a (buf, cmd);
1338                 Tcl_AppendResult (ip, arg0, ": unrecognized command ", buf, 0);
1339                 return TCL_ERROR;
1340         } /* default */
1341
1342         } /* switch */
1343 }
1344
1345 static int OpPath (
1346         OITRec *that, Tcl_Interp *ip, const char *arg0,
1347         Tcl_Obj *arg1, int argc, Tcl_Obj* const argv[]
1348 ) {
1349         char        buf[128];
1350         OITSess    *ois;
1351         const char *path;
1352         int         cmd, rt;
1353
1354         if (! arg1) {
1355                 return UsageRec (ip, arg0);
1356         }
1357         if (! arg0) {
1358                 arg0 = "<openIsisRecord>";
1359         }
1360         if (! that || ! (ois = RecSess (that))) {
1361                 Tcl_AppendResult (ip, arg0, ": record corrupted", 0);
1362                 return TCL_ERROR;
1363         }
1364         if (ip != ois->ip) {
1365                 Tcl_AppendResult (ip, arg0, ": session corrupted", 0);
1366                 return TCL_ERROR;
1367         }
1368
1369         path = Tcl_GetStringFromObj (arg1, 0);
1370
1371         /* path to embedded rec */
1372         if ('.' == *path) {
1373                 int type = RecType (that);
1374                 switch (type) {
1375                 case OIT_RS_RQS:
1376                         {       OITCont    *con;
1377                                 OITRec     *rec;
1378                                 const char *p2;
1379                                 int         tag, occ;
1380                                 con = (OITCont*) that;
1381                                 if (strncmp (".fdt", path, 4)) {
1382                                         p2 = luti_parse_path (path, openIsisFdtRqs,
1383                                                 0, &tag, &occ);
1384                                         if (0 == p2 || 0 < occ) {
1385                                                 Tcl_AppendResult (ip, arg0,
1386                                                         ": no such child: ", path, 0);
1387                                                 return TCL_ERROR;
1388                                         }
1389                                 }
1390                                 else {
1391                                         p2 = path + 4;
1392                                         tag = -42;
1393                                         occ = 0;
1394                                 }
1395                                 if (! con->numr) {
1396                                         rt = BuildRqsRecs (con);
1397                                         if (0 > rt) {
1398                                                 Tcl_AppendResult (ip, arg0,
1399                                                         ": child allocation failure", 0);
1400                                                 return TCL_ERROR;
1401                                         }
1402                                 }
1403                                 switch (tag) {
1404                                 case OPENISIS_COM_REC: rec = con->recs[0]; break;
1405                                 case OPENISIS_RQS_IDX: rec = con->recs[1]; break;
1406                                 case OPENISIS_COM_CFG: rec = con->recs[2]; break;
1407                                 case -42: rec = con->recs[3]; break;
1408                                 default:
1409                                         Tcl_AppendResult (ip, arg0,
1410                                                 ": no such child: ", path, 0);
1411                                         return TCL_ERROR;
1412                                 }
1413                                 NewRecId (buf);
1414                                 if (*p2) {
1415                                         Tcl_Obj *obj = Tcl_NewStringObj (p2, (int) strlen (p2));
1416                                         if (obj) {
1417                                                 Tcl_IncrRefCount (obj);
1418                                                 rt = OpPath (rec, ip, buf, obj, argc, argv);
1419                                                 Tcl_DecrRefCount (obj);
1420                                                 return rt;
1421                                         }
1422                                         return TCL_ERROR;
1423                                 }
1424                                 if (! argc) {
1425                                         return CrtRecCmd (ois, buf, rec, !0);
1426                                 }
1427                                 return OpPath (rec, ip, buf, argv[0], argc - 1, argv + 1);
1428                         }
1429                 case OIT_RS_RSP:
1430                         {       OITCont    *con;
1431                                 OITRec     *rec;
1432                                 const char *p2;
1433                                 int         tag, occ;
1434                                 con = (OITCont*) that;
1435                                 p2 = luti_parse_path (path, openIsisFdtRsp,
1436                                         0, &tag, &occ);
1437                                 if (0 == p2 ||
1438                                         OPENISIS_COM_REC != tag
1439                                 ) {
1440                                         Tcl_AppendResult (ip, arg0,
1441                                                 ": no such child: ", path, 0);
1442                                         return TCL_ERROR;
1443                                 }
1444                                 if (!(rt = con->numr)) {
1445                                         rt = BuildRspRecs (con, ip, arg0);
1446                                         if (0 > rt) {
1447                                                 return TCL_ERROR;
1448                                         }
1449                                 }
1450                                 if (0 > occ) {
1451                                         occ = 0;
1452                                 }
1453                                 if (rt <= occ) {
1454                                         sprintf (buf, "%d", rt);
1455                                         Tcl_AppendResult (ip, arg0, ": no such child: ", path,
1456                                                 ", have ", buf, " childs", 0);
1457                                         return TCL_ERROR;
1458                                 }
1459                                 rec = con->recs[occ];
1460                                 NewRecId (buf);
1461                                 if (*p2) {
1462                                         Tcl_Obj *obj = Tcl_NewStringObj (p2, (int) strlen (p2));
1463                                         if (obj) {
1464                                                 Tcl_IncrRefCount (obj);
1465                                                 rt = OpPath (rec, ip, buf, obj, argc, argv);
1466                                                 Tcl_DecrRefCount (obj);
1467                                                 return rt;
1468                                         }
1469                                         return TCL_ERROR;
1470                                 }
1471                                 if (! argc) {
1472                                         return CrtRecCmd (ois, buf, rec, !0);
1473                                 }
1474                                 return OpPath (rec, ip, buf, argv[0], argc - 1, argv + 1);
1475                         }
1476                 default:
1477                         {       OpenIsisRec *rec;
1478                                 OITRec      *oir;
1479                                 rec = luti_getembed (that->rec, path, that->fdt);
1480                                 if (! rec) {
1481                                         Tcl_AppendResult (ip, arg0,
1482                                                 ": no such child: ", path, 0);
1483                                         return TCL_ERROR;
1484                                 }
1485                                 rt = NewRec (ois, 0,
1486                                         OIT_RS_DBF == RecType(that) ? openIsisFdtFd : 0,
1487                                         0);
1488                                 if (0 > rt) {
1489                                         Tcl_AppendResult (ip, "OpPath: out of memory", 0);
1490                                         return TCL_ERROR;
1491                                 }
1492                                 oir = ois->recs[rt];
1493                                 oir->rec = rec;
1494                                 NewRecId (buf);
1495                                 if (! argc) {
1496                                         return CrtRecCmd (ois, buf, oir, !0);
1497                                 }
1498                                 rt = OpPath (oir, ip, buf, argv[0], argc - 1, argv + 1);
1499                                 DtorRec (oir, 0);
1500                                 return rt;
1501                         }
1502                 }
1503         } /* path */
1504
1505         rt = Tcl_GetIndexFromObj (ip, arg1, OITOpts, "option", 0, &cmd);
1506         if (TCL_OK != rt) {
1507                 return TCL_ERROR;
1508         }
1509         if (RC_LAST < cmd) {
1510                 return UsageRec (ip, arg0);
1511         }
1512
1513         return OpRec (that, ip, arg0, (OITCmd)cmd, argc, argv);
1514 }
1515
1516 static int CmdRec (
1517         ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
1518 ) {
1519         const char *arg0 = 0 >= argc ? 0 : Tcl_GetStringFromObj (argv[0], 0);
1520         if (1 >= argc) {
1521                 return UsageRec (ip, arg0);
1522         }
1523         return OpPath ((OITRec*)cld, ip, arg0, argv[1], argc - 2, argv + 2);
1524 }
1525
1526 /*      ============================== stubs ================================
1527 */
1528
1529 static int RspCb (
1530         void *cld, OpenIsisStub stb, OpenIsisRec *rsp, OpenIsisDb *db
1531 ) {
1532         OITStub    *that = (OITStub*) cld;
1533         OITSess    *ois;
1534         const char *res;
1535         int         rt;
1536
1537         (void)db;
1538         if (! that) {
1539                 return openIsisSMsg (OPENISIS_ERR_TRASH,
1540                         "[openIsisTcl] RspCb: response without stub");
1541         }
1542         if (stb != that->stb) {
1543                 return openIsisSMsg (OPENISIS_ERR_TRASH,
1544                         "[openIsisTcl] RspCb: stub changed");
1545         }
1546         ois = StbSess (that);
1547         if (! ois) {
1548                 return openIsisSMsg (OPENISIS_ERR_TRASH,
1549                         "[openIsisTcl] RspCb: response without session");
1550         }
1551         if (! that->rqs) {
1552                 return openIsisSMsg (OPENISIS_ERR_TRASH,
1553                         "[openIsisTcl] RspCb: response without request");
1554         }
1555         if (that->rsp) {
1556                 if (that->rsp->env.rec) {
1557                         openIsisSMsg (OPENISIS_ERR_TRASH,
1558                                 "[openIsisTcl] RspCb: multiple responses");
1559                         DtorRec ((OITRec*)that->rsp, 0);
1560                 }
1561         }
1562
1563         rt = NewCont (ois, openIsisFdtRsp, OIT_RS_RSP);
1564         if (0 > rt) {
1565                 return rt;
1566         }
1567         that->rsp = (OITCont*) ois->recs[rt];
1568         that->rsp->env.rec = rsp;
1569         that->rsp->stb = that->stb;
1570
1571         if (! that->actproc) {
1572                 if (! that->dfltproc) {
1573                         return 0;
1574                 }
1575                 rt = Tcl_EvalObj (ois->ip, that->dfltproc);
1576         }
1577         else {
1578                 rt = Tcl_EvalObj (ois->ip, that->actproc);
1579         }
1580         res = Tcl_GetStringResult (ois->ip);
1581         if (! res) {
1582                 res = "<null>";
1583         }
1584         if (TCL_ERROR == rt) {
1585                 return openIsisSMsg (OPENISIS_ERR_IDIOT,
1586                         "[openIsisTcl] callback eval: %s", res);
1587         }
1588         if (TCL_OK != rt) {
1589                 openIsisSMsg (OPENISIS_LOG_WARN,
1590                         "[openIsisTcl] callback eval = %d, %s", rt, res);
1591                 return 0;
1592         }
1593         openIsisSMsg (OPENISIS_LOG_INFO,
1594                 "[openIsisTcl] callback eval : %s", res);
1595         return 0;
1596 }
1597
1598 static void StbDelCb (void *cld, OpenIsisStub stb, void *cbd);
1599 static void TclDelStb (ClientData cld);
1600 static int CmdStub (
1601         ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
1602 );
1603
1604 static OITStub* CtorStub (Tcl_Interp *ip,
1605         const char *name, int argc, const char **argv, const char *proc
1606 ) {
1607         OpenIsisStubCbData  scd;
1608         OpenIsisSchema     *sch;
1609         OITStub            *that;
1610         int                 stat  =  0;
1611
1612         if (! name) {
1613                 name = OIT_STB0;
1614                 stat = OIT_ST_ROOT;
1615         }
1616         if (! NumSessions) {
1617                 openIsisSMsg (OPENISIS_ERR_TRASH,
1618                         "[openIsisTcl] CtorStub(%s): no root session", name);
1619                 return 0;
1620         }
1621         if (ip != Sessions->ip) {
1622                 openIsisSMsg (OPENISIS_ERR_TRASH,
1623                 "[openIsisTcl] CtorStub(%s): must not create stub in derived session",
1624                         name);
1625                 return 0;
1626         }
1627         that = (OITStub*) openIsisMAlloc (sizeof (OITStub));
1628         if (! that) {
1629                 openIsisSMsg (OPENISIS_ERR_NOMEM,
1630                         "[openIsisTcl] CtorStub(%s): out of memory", name);
1631                 return 0;
1632         }
1633         that->cmd = openIsisMDup (name, -1);
1634         if (! that->cmd) {
1635                 openIsisMFree (that);
1636                 openIsisSMsg (OPENISIS_ERR_NOMEM,
1637                         "[openIsisTcl] CtorStub(%s): out of memory", name);
1638                 return 0;
1639         }
1640         that->ases = -1;
1641
1642         memset (&scd, 0, sizeof (OpenIsisStubCbData));
1643         scd.dfltcb = &RspCb;
1644         scd.delcb  = &StbDelCb;
1645         scd.dfltcld = scd.delcld = that;
1646
1647         if (OIT_ST_ROOT & stat) {
1648                 that->cfg.fdt = openIsisFdtSyspar;
1649                 that->stb = openIsisNInit (argc, argv, &scd);
1650         }
1651         else {
1652                 that->cfg.fdt = openIsisFdtScheme;
1653                 that->stb = openIsisNOpen (name, argc, argv, &scd);
1654         }
1655         if (! that->stb) {
1656                 openIsisMFree ((void*)that->cmd);
1657                 openIsisMFree (that);
1658                 openIsisSMsg (OPENISIS_ERR_IDIOT,
1659                         "[openIsisTcl] CtorStub(%s): deficient configuration", name);
1660                 return 0;
1661         }
1662
1663         sch = openIsisNSchema (that->stb);
1664         that->cfg.rec = sch->cfg;
1665         that->cfg.sid = 0;
1666         that->cfg.stat = OIT_RS_USED | OIT_RS_STC;
1667
1668         if (proc) {
1669                 that->dfltproc = Tcl_NewStringObj (proc, (int) strlen (proc));
1670                 if (that->dfltproc) {
1671                         Tcl_IncrRefCount (that->dfltproc);
1672                 }
1673         }
1674
1675         that->stat = stat | OIT_ST_TCL | OIT_ST_OINIT;
1676
1677         Tcl_CreateObjCommand (ip, (char*)that->cmd, &CmdStub, that, &TclDelStb);
1678         Tcl_SetResult (ip, (char*)that->cmd, TCL_VOLATILE);
1679         return that;
1680 }
1681
1682 static void DtorStub (OITStub *that, int where) {
1683         const char *cmd = that->cmd;
1684         if (! cmd) {
1685                 cmd = "<<NULL>>";
1686         }
1687         if (! NumSessions) {
1688                 openIsisSMsg (OPENISIS_ERR_TRASH,
1689                         "[openIsisTcl] DtorStub(%s): no root session", cmd);
1690                 return;
1691         }
1692         that->stat &= ~where;
1693         if (OIT_ST_TCL & that->stat) {
1694                 if (! that->cmd) {
1695                         openIsisSMsg (OPENISIS_ERR_TRASH,
1696                                 "[openIsisTcl] DtorStub: no command");
1697                         return;
1698                 }
1699                 Tcl_DeleteCommand (Sessions->ip, (char*)that->cmd);
1700                 return;
1701         }
1702         if (OIT_ST_OINIT & that->stat) {
1703                 if (OIT_ST_ROOT & that->stat) {
1704                         openIsisNDeinit ();
1705                 }
1706                 else {
1707                         openIsisNClose (that->stb);
1708                 }
1709                 return;
1710         }
1711         if (that->dfltproc) {
1712                 Tcl_DecrRefCount (that->dfltproc);
1713         }
1714         if (that->actproc) {
1715                 Tcl_DecrRefCount (that->actproc);
1716         }
1717         if (that->rqs) {
1718                 DtorRec ((OITRec*)that->rqs, 0);
1719         }
1720         if (that->rsp) {
1721                 DtorRec ((OITRec*)that->rsp, 0);
1722         }
1723 /*      that->cfg.rec holds the same ref as stub->cfg,
1724         which is freed in openIsisNClose
1725 */
1726         if (that->cmd) {
1727                 openIsisMFree ((void*)that->cmd);
1728         }
1729         openIsisMFree (that);
1730 }
1731
1732 static void TclDelStb (ClientData cld) {
1733         DtorStub ((OITStub*)cld, OIT_ST_TCL);
1734 }
1735
1736 static void StbDelCb (void *cld, OpenIsisStub stb, void *cbd) {
1737         (void) stb;
1738         if (cbd) {
1739                 if (((OITStub*)cbd)->actproc) {
1740                         Tcl_DecrRefCount (((OITStub*)cbd)->actproc);
1741                         ((OITStub*)cbd)->actproc = 0;
1742                 }
1743                 return;
1744         }
1745         DtorStub ((OITStub*)cld, OIT_ST_OINIT);
1746 }
1747
1748 static int BuildRqsCont (OITStub *that, Tcl_Interp *ip,
1749         const char *arg0, OITSess *ois, int *argc, Tcl_Obj* const **argv
1750 ) {
1751         OpenIsisDb *db;
1752         char       *dbn;
1753         int         rt;
1754         if (! that->rqs) {
1755                 rt = NewCont (ois, openIsisFdtRqs, OIT_RS_RQS);
1756                 if (0 > rt) {
1757                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1758                         return 0;
1759                 }
1760                 that->rqs = (OITCont*) ois->recs[rt];
1761         }
1762         if (1 < *argc &&
1763                 0 == strcmp ("-db", Tcl_GetStringFromObj ((*argv)[0], 0))) {
1764                 dbn = Tcl_GetStringFromObj ((*argv)[1], 0);
1765                 db = openIsisNDbByName (that->stb, dbn);
1766                 if (! db) {
1767                         Tcl_AppendResult (ip, arg0, ": no such db: ", dbn, 0);
1768                         return 0;
1769                 }
1770                 that->rqs->env.db = db;
1771                 *argc -= 2;
1772                 *argv += 2;
1773         }
1774         return !0;
1775 }
1776
1777 static const OpenIsisFdt* SysFdtFromName (const char *dbn, int len) {
1778         switch (dbn[1]) {
1779         case 'd':
1780                 if (0 == strncmp (dbn, "-dbpar", len)) {
1781                         return openIsisFdtDbpar;
1782                 }
1783                 return 0;
1784         case 'f':
1785                 if ('d' == dbn[2]) {
1786                         if (0 == dbn[3]) {
1787                                 return openIsisFdtFd;
1788                         }
1789                         if ('t' == dbn[3] && 0 == dbn[4]) {
1790                                 return openIsisFdtFdt;
1791                         }
1792                 }
1793                 return 0;
1794         case 'r':
1795                 if (3 < len) {
1796                         if (0 == strncmp (dbn, "-request", len)) {
1797                                 return openIsisFdtRqs;
1798                         }
1799                         if (0 == strncmp (dbn, "-response", len)) {
1800                                 return openIsisFdtRsp;
1801                         }
1802                 }
1803                 return 0;
1804         case 's':
1805                 if (2 < len) {
1806                         if (0 == strncmp (dbn, "-syspar", len)) {
1807                                 return openIsisFdtSyspar;
1808                         }
1809                         if (0 == strncmp (dbn, "-scheme", len)) {
1810                                 return openIsisFdtScheme;
1811                         }
1812                 }
1813                 return 0;
1814         }
1815         return 0;
1816 }
1817
1818 static int UsageStub (Tcl_Interp *ip, const char *argv0) {
1819         Tcl_AppendResult (ip,
1820                 "usage: ",
1821                 (argv0 ? argv0 : "<openIsisStub>"),
1822                 " db db ?option ...? |",
1823                 " fdt db ?option ...? |",
1824                 " new -schema name ?-cfg val ...? |",
1825                 " new ?-db db? ?name? |",
1826                 " recv |",
1827                 " request ?-db db? ?-param val? |",
1828                 " .req ?-db db? ?option ...? |",
1829                 " .res ?option ...?",
1830                 0);
1831         return TCL_ERROR;
1832 }
1833
1834 static int CmdStub (
1835         ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
1836 ) {
1837         OITStub     *that   =   (OITStub*) cld;
1838         OITSess     *ois;
1839         const char  *arg0;
1840         OITCmd       cmd;
1841         int          rt;
1842
1843         if (1 > argc) {
1844                 return TCL_ERROR;
1845         }
1846         arg0 = Tcl_GetStringFromObj (argv[0], 0);
1847         if (2 > argc) {
1848                 return UsageStub (ip, arg0);
1849         }
1850
1851         ois = StbSess (that);
1852         if (! ois) {
1853                 if (! NumSessions) {
1854                         Tcl_AppendResult (ip, arg0, ": no session", 0);
1855                         return TCL_ERROR;
1856                 }
1857                 ois = Sessions;
1858                 that->ases = 0;
1859         }
1860         if (ip != ois->ip) {
1861                 Tcl_AppendResult (ip, arg0, ": session changed", 0);
1862                 return TCL_ERROR;
1863         }
1864
1865         rt = Tcl_GetIndexFromObj (ip, argv[1], OITOpts, "option", 0, (int*)&cmd);
1866         if (TCL_OK != rt) {
1867                 return UsageStub (ip, arg0);
1868         }
1869
1870         argc -= 2;
1871         argv += 2;
1872
1873         switch (cmd) {
1874
1875         case RC_DB: {
1876                 OpenIsisDb  *db;
1877                 char        *dbn;
1878                 if (! argc) {
1879                         return UsageStub (ip, arg0);
1880                 }
1881                 dbn = Tcl_GetStringFromObj (argv[0], 0);
1882                 db = openIsisNDbByName (that->stb, dbn);
1883                 if (! db) {
1884                         Tcl_AppendResult (ip, arg0, ": no such db <", dbn, ">", 0);
1885                         return TCL_ERROR;
1886                 }
1887                 return OpDb (ip, ois, db, argc - 1, argv + 1);
1888         } /* RC_DB */
1889
1890         case RC_DONE:
1891                 Tcl_DeleteCommand (ip, (char*)arg0);
1892                 return TCL_OK;
1893
1894         case RC_FDT: {
1895                 const OpenIsisFdt *fdt = 0;
1896                 OpenIsisDb        *db;
1897                 char              *dbn;
1898                 int                len;
1899                 if (! argc) {
1900                         return UsageStub (ip, arg0);
1901                 }
1902                 dbn = Tcl_GetStringFromObj (argv[0], &len);
1903                 if (1 < len && '-' == *dbn) {
1904                         fdt = SysFdtFromName (dbn, len);
1905                 }
1906                 if (! fdt) {
1907                         db = openIsisNDbByName (that->stb, dbn);
1908                         if (! db) {
1909                                 Tcl_AppendResult (ip, arg0, ": no such db <", dbn, ">", 0);
1910                                 return TCL_ERROR;
1911                         }
1912                         fdt = db->fdt;
1913                         if (! fdt) {
1914                                 Tcl_AppendResult (ip, arg0, ": ", dbn, " has no fdt", 0);
1915                                 return TCL_ERROR;
1916                         }
1917                 }
1918                 return OpFdt (ip, ois, fdt, argc - 1, argv + 1);
1919         } /* RC_FDT */
1920
1921         case SC_NEW: {
1922                 char buf[2048];
1923                 OITStub           *nstb = 0;
1924                 const OpenIsisFdt *fdt  = 0;
1925                 OpenIsisDb        *db   = 0;
1926                 const char        *arg2 = 0;
1927                 const char        *dbn  = 0;
1928                 const char        *proc = 0;
1929                 char              *name = 0;
1930                 char             **argp = 0;
1931                 int                len  = 0;
1932                 int                dbl  = 0;
1933
1934                 switch (argc) {
1935                 /* new record */
1936                 case 0:
1937                         goto newrec;
1938                 case 1:
1939                         name = Tcl_GetStringFromObj (argv[0], 0);
1940                         goto newrec;
1941                 case 3:
1942                         arg2 = Tcl_GetStringFromObj (argv[0], &len);
1943                         if (2 > len || 0 != strncmp ("-db", arg2, len)) {
1944                                 return UsageStub (ip, arg0);
1945                         }
1946                         dbn = Tcl_GetStringFromObj (argv[1], &dbl);
1947                         name = Tcl_GetStringFromObj (argv[2], 0);
1948                 newrec:
1949                         if (1 < dbl && '-' == *dbn) {
1950                                 fdt = SysFdtFromName (dbn, dbl);
1951                         }
1952                         if (! fdt) {
1953                                 if (! dbn) {
1954                                         dbn = openIsisRString (that->cfg.rec,
1955                                                 OPENISIS_SC_DFLTDB, 0, buf, sizeof(buf));
1956                                         if (! dbn) {
1957                                                 Tcl_AppendResult (ip, arg0,
1958                                                         ": no db specified", 0);
1959                                                 return TCL_ERROR;
1960                                         }
1961                                 }
1962                                 db = openIsisNDbByName (that->stb, dbn);
1963                                 if (! db) {
1964                                         Tcl_AppendResult (ip, arg0,
1965                                                 ": no such db <", dbn, ">", 0);
1966                                         return TCL_ERROR;
1967                                 }
1968                                 fdt = db->fdt;
1969                         }
1970                         rt = NewRec (ois, db, fdt, 0);
1971                         if (0 > rt) {
1972                                 Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1973                                 return TCL_ERROR;
1974                         }
1975                         rt = CrtRecCmd (ois, name, ois->recs[rt], !0);
1976                         return rt;
1977
1978                 /* new stub */
1979                 default:
1980                         arg2 = Tcl_GetStringFromObj (argv[0], &len);
1981                         if (2 > len) {
1982                                 return UsageStub (ip, arg0);
1983                         }
1984                         if (2 == argc && 0 == strncmp ("-db", arg2, len)) {
1985                                 dbn = Tcl_GetStringFromObj (argv[1], &dbl);
1986                                 goto newrec;
1987                         }
1988                         if (strncmp ("-schema", arg2, len) &&
1989                                 strncmp ("schema", arg2, len)) {
1990                                 return UsageStub (ip, arg0);
1991                         }
1992                         name = Tcl_GetStringFromObj (argv[1], 0);
1993                         argc -= 2;
1994                         argv += 2;
1995                         if (0 < argc) {
1996                                 int j;
1997                                 argp = ToArgv (argv, argc, buf, sizeof (buf));
1998                                 if (! argp) {
1999                                         Tcl_AppendResult (ip, arg0, ": out of memory", 0);
2000                                         return TCL_ERROR;
2001                                 }
2002                                 for (j = 0; argc > j; ++j) {
2003                                         if (0 == strcmp ("-async", argp[j]) &&
2004                                                 argc > ++j) {
2005                                                 proc = argp[j];
2006                                         }
2007                                 }
2008                         }
2009                         nstb = CtorStub (ip, name, argc, (const char**)argp, proc);
2010                         if (argp && argp != (char**)buf) {
2011                                 openIsisMFree (argp);
2012                         }
2013                         if (! nstb) {
2014                                 Tcl_AppendResult (ip, arg0,
2015                                         ": deficient configuration for ", name,
2016                                         " or out of memory", 0);
2017                                 return TCL_ERROR;
2018                         }
2019                         return TCL_OK;
2020
2021                 } /* switch (argc) */
2022         } /* SC_NEW */
2023
2024         case SC_RECV: {
2025                 if (that->rsp && that->rsp->env.rec) {
2026                         return TCL_OK;
2027                 }
2028                 Tcl_AppendResult (ip, arg0,
2029                         ": waiting for response in async mode not implemented yet", 0);
2030                 return TCL_ERROR;
2031         } /* SC_RECV */
2032
2033         case SC_RQS: {
2034                 OpenIsisRec *rqs;
2035                 if (that->rsp) {
2036                         DtorRec ((OITRec*) that->rsp, 0);
2037                 }
2038                 if (! BuildRqsCont (that, ip, arg0, ois, &argc, &argv)) {
2039                         return TCL_ERROR;
2040                 }
2041                 if (0 < argc) {
2042                         Tcl_Obj *setcmd = Tcl_NewStringObj ("set", 3);
2043                         if (! setcmd) {
2044                                 Tcl_AppendResult (ip, arg0, ": out of memory", 0);
2045                                 return TCL_ERROR;
2046                         }
2047                         Tcl_IncrRefCount (setcmd);
2048                         rt = OpPath (
2049                                 (OITRec*)that->rqs, ip, 0, setcmd, argc, argv);
2050                         Tcl_DecrRefCount (setcmd);
2051                         if (TCL_OK != rt) {
2052                                 return rt;
2053                         }
2054                 }
2055                 rqs = that->rqs->env.rec;
2056                 if (that->rqs->numr) {
2057                         OpenIsisRec *rec;
2058                         if ((rec = that->rqs->recs[0]->rec)) {
2059                                 rqs = luti_wrap (rqs, rec, OPENISIS_COM_REC);
2060                         }
2061                         if ((rec = that->rqs->recs[1]->rec)) {
2062                                 rqs = luti_wrap (rqs, rec, OPENISIS_RQS_IDX);
2063                         }
2064                         if ((rec = that->rqs->recs[2]->rec)) {
2065                                 rqs = luti_wrap (rqs, rec, OPENISIS_COM_CFG);
2066                         }
2067                         if ((rec = that->rqs->recs[3]->rec)) {
2068                                 rqs = luti_append (rqs, rec);
2069                         }
2070                 }
2071                 if (! openIsisRGet (rqs, OPENISIS_COM_DBN, 0) && that->rqs->env.db) {
2072                         OPENISIS_RADDS (rqs, OPENISIS_COM_DBN, that->rqs->env.db->name, !0);
2073                 }
2074                 rt = openIsisNSend (that->stb, that->rqs->env.rec = rqs, 0, 0, !0);
2075                 that->rqs->env.db = 0; /* do never remember */
2076                 if (0 != rt) {
2077                         char buf[64];
2078                         sprintf (buf, "%x", rt);
2079                         Tcl_AppendResult (ip, arg0, ": error ", buf,
2080                                 " sending request", 0);
2081                         return TCL_ERROR;
2082                 }
2083                 return TCL_OK;
2084         } /* SC_RQS */
2085
2086         case SC_ARQS: {
2087                 if (! BuildRqsCont (that, ip, arg0, ois, &argc, &argv)) {
2088                         return TCL_ERROR;
2089                 }
2090                 if (1 > argc) {
2091                         return UsageStub (ip, arg0);
2092                 }
2093                 rt = OpPath (
2094                         (OITRec*)that->rqs, ip, 0, argv[0], argc - 1, argv + 1);
2095                 return rt;
2096         } /* SC_ARQS */
2097
2098         case SC_ARSP: {
2099                 int hasrsp = that->rsp && that->rsp->env.rec;
2100                 if (1 > argc) {
2101                         Tcl_SetObjResult (ip, Tcl_NewBooleanObj (hasrsp));
2102                         return TCL_OK;
2103                 }
2104                 if (! hasrsp) {
2105                         Tcl_AppendResult (ip, arg0, ": no response available", 0);
2106                         return TCL_ERROR;
2107                 }
2108                 rt = OpPath (
2109                         (OITRec*)that->rsp, ip, 0, argv[0], argc - 1, argv + 1);
2110                 return rt;
2111         } /* SC_ARSP */
2112
2113         default: {
2114                 /* record commands */
2115                 OpenIsisSchema *sch;
2116                 rt = OpRec (&that->cfg, ip, arg0, cmd, argc, argv);
2117                 sch = openIsisNSchema (that->stb);
2118 /*              sch->cfg is a reference to our cfg at every time,
2119                 OpRec changes with RDIS, so we dont free the old rec here
2120 */
2121                 sch->cfg = that->cfg.rec;
2122                 return rt;
2123         } /* default */
2124
2125         } /* switch cmd */
2126 }
2127
2128 static int CmdInit (
2129         ClientData cld, Tcl_Interp *ip, int argc, const char *argv[]
2130 ) {
2131         OITStub     *news;
2132         const char  *proc  =  0;
2133         int          j, len;
2134
2135         (void)cld;
2136
2137         if (openisis_stub0) {
2138                 Tcl_CmdInfo info;
2139                 if (Tcl_GetCommandInfo (ip, OIT_STB0, &info)) {
2140                         Tcl_SetResult (ip, OIT_STB0, TCL_STATIC);
2141                         return TCL_OK;
2142                 }
2143         }
2144
2145         for (j = 1; argc > j; ++j) {
2146                 if (! argv[j] || ! (len = strlen (argv[j]))) {
2147                         goto usage;
2148                 }
2149                 if ('-' == *argv[j]) {
2150                         if (! strncmp ("-async", argv[j], (unsigned) len)) {
2151                                 if (argc <= ++j) {
2152                                         goto usage;
2153                                 }
2154                                 proc = argv[j];
2155                                 continue;
2156                         }
2157                 }
2158                 break;
2159         }
2160
2161         /* openIsisNInit can be called multiple times */
2162         news = CtorStub (ip, 0, argc - j, argv + j, proc);
2163         if (! news) {
2164                 Tcl_AppendResult (ip, OIT_STB0, ": out of memory", 0);
2165                 return TCL_ERROR;
2166         }
2167         return TCL_OK;
2168
2169 usage:
2170         Tcl_AppendResult (ip,
2171                 "usage: ", argv[0], " ?-async <cb>? ?options?", 0);
2172         return TCL_ERROR;
2173 }
2174
2175 static int CmdOIR (
2176         ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
2177 ) {
2178         OITSess            *ois;
2179         OITRec             *rec, *rfdt;
2180         const OpenIsisFdt  *fdt;
2181         char               *fname;
2182         const char         *rname;
2183         char                buf[64];
2184         int                 j, rt, len, ownf;
2185
2186         (void)cld;
2187         if (! NumSessions) {
2188                 Tcl_AppendResult (ip, "session not initialized", 0);
2189                 return TCL_ERROR;
2190         }
2191         ois = Sessions;
2192
2193         rec = 0;
2194         rname = 0;
2195         fdt = 0;
2196         ownf = 0;
2197         for (j = 1; argc > j; ++j) {
2198                 fname = Tcl_GetStringFromObj (argv[j], &len);
2199                 if (! fdt && 2 <= len && 0 == strncmp ("-fdt", fname, len)) {
2200                         if (argc <= ++j) {
2201                                 Tcl_AppendResult (ip,
2202                                         "usage: openIsisRec ?-fdt name? ?options...?", 0);
2203                                 return TCL_ERROR;
2204                         }
2205                         fname = Tcl_GetStringFromObj (argv[j], &len);
2206                         if (len && '-' == *fname) {
2207                                 fdt = SysFdtFromName (fname, len);
2208                         }
2209                         if (! fdt) {
2210                                 rfdt = TclCmd2Rec (ip, fname, "openIsisRec");
2211                                 if (! rfdt) {
2212                                         return TCL_ERROR;
2213                                 }
2214                                 fdt = openIsisFRec2Fdt (rfdt->rec);
2215                                 if (! fdt) {
2216                                         Tcl_AppendResult (ip, fname, " is an illegal fdt", 0);
2217                                         return TCL_ERROR;
2218                                 }
2219                                 ownf = !0;
2220                         }
2221                         if (rname) {
2222                                 ++j;
2223                                 break;
2224                         }
2225                         continue;
2226                 }
2227                 if (rname) {
2228                         break;
2229                 }
2230                 rname = fname;
2231         }
2232
2233         if (! rname || ! *rname) {
2234                 rname = NewRecId (buf);
2235         }
2236
2237         rt = NewRec (ois, 0, fdt, ownf ? OIT_RS_OWNF : 0);
2238         if (0 > rt) {
2239                 Tcl_AppendResult (ip, Tcl_GetStringFromObj (argv[0], 0),
2240                         ": out of memory", 0);
2241                 goto error;
2242         }
2243         rec = ois->recs[rt];
2244
2245         if (j < argc - 1) {
2246                 rt = OpPath (rec, ip, rname, argv[j], argc - (j+1), argv + (j+1));
2247                 if (TCL_OK != rt) {
2248                         goto error;
2249                 }
2250         }
2251
2252         rt = CrtRecCmd (ois, rname, rec, !0);
2253         if (TCL_OK == rt) {
2254                 return TCL_OK;
2255         }
2256 error:
2257         if (rec) {
2258                 DtorRec (rec, 0);
2259         }
2260         else if (ownf) {
2261                 openIsisFFree ((OpenIsisFdt*)fdt);
2262         }
2263         return TCL_ERROR;
2264 }
2265
2266 static void FreeEnc ();
2267 static void AtExit (ClientData cld) {
2268         (void)cld;
2269         openIsisNDeinit ();
2270         ExitSess ();
2271         FreeEnc ();
2272 }
2273
2274 static void AddCmds (Tcl_Interp *ip, int root) {
2275         Tcl_CreateCommand (ip, "openIsis",
2276                 (Tcl_CmdProc*)CmdInit, 0, root ? &AtExit : 0);
2277         Tcl_CreateObjCommand (ip, "openIsisRec", &CmdOIR, 0, 0);
2278 }
2279
2280 /*      ===================== command evaluation ============================
2281 */
2282
2283 static int CmdEval (OpenIsisRec *cmd, OpenIsisRec **rsp) {
2284         Tcl_DString      ds;
2285         OpenIsisField   *F, *E;
2286         OpenIsisSession  ois;
2287         OpenIsisRec     *recs[1] = { 0 };
2288         int              rid[1];
2289         int              rt;
2290
2291         ois = SESGET ();
2292         if (NumSessions <= ois->id) {
2293                 return openIsisSMsg (OPENISIS_ERR_TRASH,
2294                         "[openIsisTcl] CmdEval: no ip for ses %d[%d]",
2295                         ois->id, NumSessions);
2296         }
2297
2298         rid[0] = openIsisTclCreateRecCmd (ois->id, "result", 0, 0);
2299         if (0 > rid[0]) {
2300                 return openIsisSMsg (OPENISIS_ERR_NOMEM,
2301                         "[openIsisTcl] CmdEval: cannot allocate result cmd");
2302         }
2303
2304         rt = 0;
2305         Tcl_DStringInit (&ds);
2306         for (E = (F = cmd->field) + cmd->len; E > F; ++F) {
2307                 if (rt) {
2308                         Tcl_DStringAppend (&ds, ";", 1);
2309                 }
2310                 rt = !0;
2311                 Tcl_DStringAppend (&ds, F->val, F->len);
2312         }
2313         rt = openIsisTclEval (ois->id, 1, rid, recs, Tcl_DStringValue (&ds));
2314         Tcl_DStringFree (&ds);
2315
2316         /* record freed in ldsp */
2317         Sessions[ois->id].recs[rid[0]]->rec = 0;
2318         *rsp = recs[0];
2319
2320         return rt;
2321 }
2322
2323 OpenIsisEvalFunc *openIsisEval = &CmdEval;
2324
2325 /*      =========================== encoding ================================
2326 */
2327
2328 static Tcl_HashTable Encodings;
2329 static int InitEnc = 0;
2330
2331 static Tcl_Encoding GetEnc (Tcl_Interp *ip, const char *name, int *frs) {
2332         Tcl_HashEntry *he;
2333         Tcl_Encoding   enc;
2334         int            nw;
2335         if (! InitEnc) {
2336                 Tcl_InitHashTable (&Encodings, TCL_STRING_KEYS);
2337                 InitEnc = !0;
2338         }
2339         he = Tcl_FindHashEntry (&Encodings, name);
2340         if (he) {
2341                 return (Tcl_Encoding) Tcl_GetHashValue (he);
2342         }
2343         enc = Tcl_GetEncoding (ip, name);
2344         he = Tcl_CreateHashEntry (&Encodings, name, &nw);
2345         Tcl_SetHashValue (he, enc);
2346         if (frs && ! enc) {
2347                 *frs = !0;
2348         }
2349         return enc;
2350 }
2351
2352 static void FreeEnc () {
2353         if (InitEnc) {
2354                 Tcl_Encoding   enc;
2355                 Tcl_HashSearch hs;
2356                 Tcl_HashEntry *he;
2357                 for (he = Tcl_FirstHashEntry (&Encodings, &hs);
2358                         he;
2359                         he = Tcl_NextHashEntry (&hs)
2360                 ) {
2361                         enc = (Tcl_Encoding) Tcl_GetHashValue (he);
2362                         if (enc) {
2363                                 Tcl_FreeEncoding (enc);
2364                         }
2365                 }
2366                 Tcl_DeleteHashTable (&Encodings);
2367                 InitEnc = 0;
2368         }
2369 }
2370
2371 static const char* TrfEnc (const char *ename,
2372         const char *src, int slen, char *dst, int dlen, int invert
2373 ) {
2374         Tcl_Encoding enc;
2375         Tcl_DString  str;
2376         char *tgt;
2377         int   tlen, frs;
2378
2379         if (! ename) {
2380                 if (src) {
2381                         openIsisMFree ((void*)src);
2382                 }
2383                 return 0;
2384         }
2385
2386         if (! src || 0 >= slen) {
2387                 return src;
2388         }
2389         /* tclEncoding.c says that a null interp is ok */
2390         frs = 0;
2391         enc = GetEnc (0, ename, &frs);
2392         if (frs) {
2393                 openIsisSMsg (OPENISIS_ERR_INVAL,
2394                         "[openIsisTcl] TrfEnc: no such encoding <%s>", ename);
2395                 return src;
2396         }
2397
2398         Tcl_DStringInit (&str);
2399         if (invert) {
2400                 tgt = Tcl_UtfToExternalDString (enc, src, slen, &str);
2401         }
2402         else {
2403                 tgt = Tcl_ExternalToUtfDString (enc, src, slen, &str);
2404         }
2405         tlen = Tcl_DStringLength (&str);
2406         if (! dst || tlen >= dlen) {
2407                 dst = (char*) openIsisMAlloc (1 + tlen);
2408                 if (! dst) {
2409                         return 0;
2410                 }
2411         }
2412         memcpy (dst, tgt, tlen);
2413         dst[tlen] = 0;
2414         Tcl_DStringFree (&str);
2415         return dst;
2416 }
2417
2418 OpenIsisEnc2Utf8Func *openIsisEnc2Utf8 = &TrfEnc;
2419
2420 /* ************************************************************
2421         public functions
2422 */
2423
2424 int openIsisTclNewSession (Tcl_Interp *ip) {
2425         int id;
2426         for (id = 0; NumSessions > id; ++id) {
2427                 if (ip == Sessions[id].ip) {
2428                         return id;
2429                 }
2430         }
2431         id = CtorSess (ip);
2432         if (0 <= id) {
2433                 AddCmds (ip, 0 == id);
2434         }
2435         return id;
2436 }
2437
2438 int openIsisTclGetSession (int sid, Tcl_Interp **ip) {
2439         if (0 > sid || NumSessions <= sid) {
2440                 return 0;
2441         }
2442         if (ip) {
2443                 *ip = Sessions[sid].ip;
2444         }
2445         return !0;
2446 }
2447
2448 /*
2449 void openIsisTclDelSession (int sid) {
2450         if (! sid) {
2451                 ExitSess ();
2452                 return;
2453         }
2454         if (0 < sid && NumSessions > sid) {
2455                 DtorSess (Sessions + sid);
2456         }
2457 }
2458 */
2459
2460
2461 int openIsisTclCreateRecCmd (
2462         int sid, const char *nam, const char *fn, int flg
2463 ) {
2464         OITSess *ois = Sessions+sid;
2465         OpenIsisFdt *fdt = 0;
2466         int rid;
2467         (void)flg; /* TODO: set readonly */
2468         if (fn) {
2469                 OITRec *oitf = TclCmd2Rec (ois->ip, fn, 0);
2470                 if (! oitf) {
2471                         openIsisSMsg (OPENISIS_ERR_INVAL,
2472                                 "[openIsisTcl] createRecCmd: no such fdt %s", fn);
2473                 }
2474                 fdt = openIsisFRec2Fdt (oitf->rec);
2475                 if (! fdt) {
2476                         openIsisSMsg (OPENISIS_ERR_INVAL,
2477                                 "[openIsisTcl] createRecCmd: illegal fdt %s", fn);
2478                 }
2479         }
2480         rid = NewRec( ois, 0, fdt, fdt ? OIT_RS_OWNF : 0 );
2481         if ( 0 <= rid ) {
2482                 CrtRecCmd( ois, nam, ois->recs[rid], 0 );
2483         }
2484         return rid;
2485 }       /* openIsisTclCreateRecCmd */
2486
2487
2488 int openIsisTclEval ( int sid,
2489         int cnt, const int *ids, OpenIsisRec **recs, char *script )
2490 {
2491         OITSess *ois = Sessions+sid;
2492         int ret, i;
2493
2494         if ( recs )
2495                 for ( i=cnt; i--; )
2496                         ois->recs[ ids[i] ]->rec = recs[i];
2497         ret = Tcl_Eval( ois->ip, script );
2498         if ( recs )
2499                 for ( i=cnt; i--; )
2500                         recs[i] = ois->recs[ ids[i] ]->rec;
2501         return ret;
2502 }       /* openIsisTclEval */
2503
2504
2505 int openIsisTclInit (Tcl_Interp *ip) {
2506         if (! NumSessions) {
2507                 CtorSess (ip);
2508         }
2509         AddCmds (ip, !0);
2510         Tcl_CreateExitHandler (&AtExit, 0);
2511         return TCL_OK;
2512 }
2513