SecuritySNACCRuntime/tcl-asn/tclasn.c

   1 /*
   2  * Copyright (c) 2000-2001 Apple Computer, Inc. All Rights Reserved.
   3  *
   4  * The contents of this file constitute Original Code as defined in and are
   5  * subject to the Apple Public Source License Version 1.2 (the 'License').
   6  * You may not use this file except in compliance with the License. Please obtain
   7  * a copy of the License at http://www.apple.com/publicsource and read it before
   8  * using this file.
   9  *
  10  * This Original Code and all software distributed under the License are
  11  * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS
  12  * OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, INCLUDING WITHOUT
  13  * LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
  14  * PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT. Please see the License for the
  15  * specific language governing rights and limitations under the License.
  16  */
  17
  18
  19 /*
  20  * Wishes:
  21  * Allow spec of PDU to decode in asn<n> decode
  22  * (Prefixing tp during decoding with PDU is not necessary)
  23  *
  24  *
  25  */
  26
  27 #include "tk.h"
  28 #include "tbl-gen.h"
  29 #include "tbl-dbg.h"
  30 #include "sbuf.h"
  31 #include "exp-buf.h"
  32 #include <netinet/in.h>
  33
  34 typedef struct ChannelBuf {
  35     Tcl_Channel chan;
  36     int readError;
  37 } ChannelBuf;
  38
  39 static void PutChannelBufInGenBuf _ANSI_ARGS_((Tcl_Channel chan, GenBuf* gb));
  40
  41 static unsigned char
  42 ChanGetByte (cb)
  43     ChannelBuf* cb;
  44 {
  45     unsigned char result = 0;
  46     if (!cb->readError)
  47         if (Tcl_Read(cb->chan,&result,1)!=1)
  48             cb->readError = TRUE;
  49     return result;
  50 }
  51
  52 static char*
  53 ChanGetSeg (cb, len)
  54     ChannelBuf* cb;
  55     unsigned long* len;
  56 {
  57     static char result[100];
  58     if (cb->readError) {
  59         *len = 0;
  60         return NULL;
  61     }
  62     if (*len>sizeof(result))
  63         *len = sizeof(result);
  64     *len = Tcl_Read(cb->chan,result,*len);
  65     if (*len<0) {
  66         cb->readError = TRUE;
  67         *len = 0;
  68         return NULL;
  69     }
  70     return result;
  71 }
  72
  73 static unsigned long
  74 ChanCopy (dst, cb, len)
  75     char* dst;
  76     ChannelBuf* cb;
  77     unsigned long len;
  78 {
  79     unsigned long result;
  80     if (cb->readError) {
  81         return 0;
  82     }
  83     result = Tcl_Read(cb->chan,dst,len);
  84     if (result!=len) {
  85         cb->readError = TRUE;
  86         if (result<0)
  87             result = 0;
  88     }
  89     return result;
  90 }
  91
  92 static unsigned long
  93 ChanPeekCopy (dst, cb, len)
  94     char* dst;
  95     ChannelBuf* cb;
  96     unsigned long len;
  97 {
  98     unsigned long result, result2;
  99     if (cb->readError) {
 100         return 0;
 101     }
 102     result = ChanCopy(dst,cb,len);
 103     result2 = Tcl_Ungets(cb->chan,dst,result,0);
 104     if (result2!=result) {
 105         cb->readError = TRUE;
 106     }
 107     return result;
 108 }
 109
 110 static unsigned char
 111 ChanPeekByte (cb)
 112     ChannelBuf* cb;
 113 {
 114     unsigned char result = 0;
 115     ChanPeekCopy(&result,cb,1);
 116     return result;
 117 }
 118
 119 static int
 120 ChanReadError (cb)
 121     ChannelBuf* cb;
 122 {
 123     return cb->readError;
 124 }
 125
 126 static void
 127 PutChannelBufInGenBuf (cb, gb)
 128     ChannelBuf* cb;
 129     GenBuf* gb;
 130 {
 131     gb->bufInfo = cb;
 132     cb->readError = FALSE;
 133     gb->getByte = (BufGetByteFcn) ChanGetByte;
 134     gb->getSeg = (BufGetSegFcn) ChanGetSeg;
 135     gb->copy = (BufCopyFcn) ChanCopy;
 136     gb->peekByte = (BufPeekByteFcn) ChanPeekByte;
 137     gb->peekCopy = (BufPeekCopyFcn) ChanPeekCopy;
 138     gb->readError = (BufReadErrorFcn) ChanReadError;
 139 }
 140
 141 #if TCL_MAJORVERSION<8
 142 #define Tcl_GetStringResult(interp) (interp->result)
 143 #endif
 144
 145 #define max(a,b) ((a)>(b)?(a):(b))
 146 #define min(a,b) ((a)<(b)?(a):(b))
 147
 148 extern int matherr();
 149 int *tclDummyMathPtr = (int *) matherr;
 150
 151 Tcl_Interp* interpG;
 152 int interpResultG;
 153 char* tblvalcmdG;
 154 char* tbltypecmdG;
 155
 156 void myAsn1ErrorHandler (str, severity)
 157     char* str;
 158     int severity;
 159 {
 160     Tcl_AppendResult(interpG,"ASN.1 error: ",str,NULL);
 161     interpResultG = TCL_ERROR;
 162 }
 163
 164 int equal (char* s1, char* s2)
 165 {
 166     return s1==s2 || (s1 && s2 && !strcmp(s1,s2));
 167 }
 168
 169 int contained (char* in, char* el)
 170 {
 171     int argc;
 172     char** argv;
 173     if (Tcl_SplitList(interpG,in,&argc,&argv)!=TCL_OK)
 174         return FALSE;
 175     while (argc--)
 176         if (equal(*argv++,el))
 177             return TRUE;
 178     return FALSE;
 179 }
 180
 181 static struct TypePath
 182     {
 183     char* typename;
 184     char* fieldname;
 185     int index;
 186     } tp[20];
 187 static int ntp;
 188
 189 int TblDbgCallProc (cmdstart, value)
 190     char* cmdstart;
 191     char* value;
 192 {
 193     int i;
 194     Tcl_DString cmd, type;
 195     if (ntp<=1 || !cmdstart)
 196         return TCL_OK;
 197     Tcl_DStringInit(&cmd);
 198     Tcl_DStringAppend(&cmd,cmdstart,-1);
 199     Tcl_DStringInit(&type);
 200     for (i=1; i<ntp; i++)
 201     {
 202         Tcl_DStringAppendElement(&type,tp[i].fieldname?tp[i].fieldname:tp[i].typename);
 203         if (tp[i].index)
 204         {
 205             char fmt[20];
 206             sprintf(fmt,"%d",tp[i].index);
 207             Tcl_DStringAppendElement(&type,fmt);
 208             i++; /* BAD HACK */
 209         }
 210     }
 211     Tcl_DStringAppendElement(&cmd,Tcl_DStringValue(&type));
 212     Tcl_DStringFree(&type);
 213     Tcl_DStringAppendElement(&cmd,value);
 214     interpResultG = Tcl_Eval(interpG,Tcl_DStringValue(&cmd));
 215     Tcl_DStringFree(&cmd);
 216     return interpResultG;
 217
 218 }
 219
 220 static char* TIN [] = { "BOOLEAN", "INTEGER", "BIT STRING", "OCTET STRING",
 221     "NULL", "OBJECT IDENTIFIER", "REAL", "ENUMERATED", "SEQUENCE", "SET",
 222     "SEQUENCE OF", "SET OF", "CHOICE", "TYPEREF" };
 223
 224 #define SPECIALID_STR -1
 225
 226 int
 227 TblEncAsk (tid, v, precmd)
 228     int tid;
 229     AVal* v;
 230     char* precmd;
 231 {
 232     int i;
 233     int result;
 234     Tcl_DString cmd, type;
 235     char fmt[20];
 236     char* iresult;
 237     Tcl_DStringInit(&cmd);
 238     Tcl_DStringAppend(&cmd,precmd,-1);
 239     Tcl_DStringInit(&type);
 240     for (i=1; i<ntp; i++)
 241     {
 242         Tcl_DStringAppendElement(&type,tp[i].fieldname?tp[i].fieldname:tp[i].typename);
 243         if (tp[i].index)
 244         {
 245             sprintf(fmt,"%d",tp[i].index);
 246             Tcl_DStringAppendElement(&type,fmt);
 247             i++; /* BAD HACK */
 248         }
 249     }
 250     Tcl_DStringAppendElement(&cmd,Tcl_DStringValue(&type));
 251     Tcl_DStringFree(&type);
 252     result = Tcl_Eval(interpG,Tcl_DStringValue(&cmd));
 253     Tcl_DStringFree(&cmd);
 254     if (result!=TCL_OK)
 255         return result;
 256     iresult = Tcl_GetStringResult(interpG);
 257     switch (tid)
 258     {
 259         case TBL_BOOLEAN:
 260             *(AsnBool*)v = !(!strcmp(iresult,"0") || toupper(*iresult)=='F' || !*iresult);
 261             break;
 262         case TBL_INTEGER:
 263         case TBL_ENUMERATED:
 264             *(AsnInt*)v = atoi(iresult);
 265             break;
 266         case TBL_REAL:
 267             sscanf(iresult,"%lf",(AsnReal*)v);
 268             break;
 269         case TBL_BITSTRING:
 270             ((AsnBits*)v)->bitLen = strlen(iresult);
 271             ((AsnBits*)v)->bits = Asn1Alloc(((AsnBits*)v)->bitLen?(((AsnBits*)v)->bitLen-1)/8+1:0);
 272             for (i=0; iresult[i]; i++)
 273                 if (iresult[i]!='0')
 274                     SetAsnBit((AsnBits*)v,i);
 275             break;
 276         case TBL_OCTETSTRING:
 277         case TBL_OID:
 278             ((AsnOcts*)v)->octs = Asn1Alloc(strlen(iresult)); /* Might be too much, but don't care */
 279             for (i=((AsnOcts*)v)->octetLen=0; iresult[i]; i++,((AsnOcts*)v)->octetLen++)
 280                 if (iresult[i]=='\\')
 281                     {
 282                     char* skipto;
 283                     strncpy(fmt,iresult+i+1,3);
 284                     fmt[3] = '\0';
 285                     ((AsnOcts*)v)->octs[((AsnOcts*)v)->octetLen] = strtol(fmt,&skipto,8);
 286                     i += skipto-fmt;
 287                     }
 288                  else
 289                     ((AsnOcts*)v)->octs[((AsnOcts*)v)->octetLen] = iresult[i];
 290             break;
 291         case SPECIALID_STR:
 292             *(char**)v = Asn1Alloc(strlen(iresult)+1);
 293             strcpy(*(char**)v,iresult);
 294             break;
 295         default:
 296             break;
 297     }
 298     Tcl_ResetResult(interpG);
 299     return TCL_OK;
 300 }
 301
 302 int
 303 TblEncType PARAMS ((type, b, implicit, bytesEncoded),
 304     TBLType *type _AND_
 305     BUF_TYPE b _AND_
 306     int implicit _AND_
 307     unsigned long int *bytesEncoded)
 308 {
 309     int result = TCL_OK;
 310     unsigned long int tmpBytesEncoded = 0;
 311     unsigned int currElmt;
 312     TBLType *elmt;
 313     TBLType* choice;
 314     int implicitRef;
 315     void *tmp;
 316     AsnBits optavail;
 317     char* elmtname;
 318     union {
 319         AsnBool bo;
 320         AsnInt in;
 321         AsnBits bi;
 322         AsnOcts oc;
 323         AsnReal re;
 324         } unival;
 325
 326     if (type->typeId==TBL_TYPEREF && !tp[ntp-1].typename)
 327         tp[ntp-1].typename = type->content->a.typeRef->typeDefPtr->typeName.octs;
 328     if (type->typeId!=TBL_TYPEREF && !tp[ntp-1].typename)
 329         tp[ntp-1].typename = TIN[type->typeId];
 330     if (!tp[ntp-1].fieldname)
 331         tp[ntp-1].fieldname = type->fieldName.octs;
 332
 333     switch (type->typeId)
 334     {
 335       case TBL_TYPEREF:
 336
 337           /*
 338            * carry over implicit ref if goes
 339            * through typeref with no tags
 340            */
 341           implicitRef = type->content->a.typeRef->implicit ||
 342               (implicit &&
 343                ((type->tagList == NULL) || LIST_EMPTY (type->tagList)));
 344
 345           result = TblEncType (type->content->a.typeRef->typeDefPtr->type, b, implicitRef,
 346                 &tmpBytesEncoded);
 347           if (result!=TCL_OK)
 348               return result;
 349           break;
 350
 351       case TBL_SEQUENCE:
 352       case TBL_SET:
 353           /* rvs though list value and list type def */
 354           currElmt = LIST_COUNT (type->content->a.elmts);
 355           tmp = CURR_LIST_NODE (type->content->a.elmts);
 356           result = TblEncAsk(SPECIALID_STR,&elmtname,tbltypecmdG);
 357           if (result!=TCL_OK)
 358               return result;
 359            FOR_EACH_LIST_ELMT_RVS (elmt, type->content->a.elmts)
 360           {
 361               if (!elmt->optional
 362                     || contained(elmtname,elmt->fieldName.octs)
 363                     || !elmt->fieldName.octetLen &&
 364                     (elmt->typeId==TBL_TYPEREF && contained(elmtname,
 365                     elmt->content->a.typeRef->typeDefPtr->typeName.octs)
 366                     || elmt->typeId!=TBL_TYPEREF && contained(elmtname,
 367                     TIN[elmt->typeId])))
 368               {
 369                  tp[ntp].typename = tp[ntp].fieldname = NULL;
 370                  tp[ntp].index = 0;
 371                  ntp++;
 372                    result = TblEncType (elmt, b, FALSE, &tmpBytesEncoded);
 373                   if (result!=TCL_OK)
 374                       {
 375                       Asn1Free(optavail.bits);
 376                       return result;
 377                       }
 378                  ntp--;
 379               }
 380           }
 381           Asn1Free(elmtname);
 382           /* restore list curr in case recursive type */
 383           SET_CURR_LIST_NODE (type->content->a.elmts, tmp);
 384           break;
 385
 386       case TBL_SEQUENCEOF:
 387       case TBL_SETOF:
 388           result = TblEncAsk(TBL_INTEGER,&tp[ntp-1].index,tbltypecmdG);
 389           if (result!=TCL_OK)
 390               return result;
 391            elmt = FIRST_LIST_ELMT (type->content->a.elmts);
 392           for (;tp[ntp-1].index>=1;tp[ntp-1].index--)
 393           {
 394              tp[ntp].typename = tp[ntp].fieldname = NULL;
 395              tp[ntp].index = 0;
 396              ntp++;
 397              result = TblEncType (elmt, b, FALSE, &tmpBytesEncoded);
 398              if (result!=TCL_OK)
 399                  return result;
 400              ntp--;
 401           }
 402         break;
 403
 404       case TBL_CHOICE:
 405           result = TblEncAsk(SPECIALID_STR,&elmtname,tbltypecmdG);
 406           if (result!=TCL_OK)
 407               return result;
 408           tmp = CURR_LIST_NODE (type->content->a.elmts);
 409           choice = NULL;
 410           FOR_EACH_LIST_ELMT(elmt, type->content->a.elmts)
 411             if (equal(elmtname,elmt->fieldName.octs))
 412                 {
 413                 choice = elmt;
 414                 break;
 415                 }
 416           if (!choice)
 417             FOR_EACH_LIST_ELMT(elmt, type->content->a.elmts)
 418               if (!elmt->fieldName.octetLen)
 419                 {
 420                 if (elmt->typeId==TBL_TYPEREF)
 421                     {
 422                     if (equal(elmtname,elmt->content->a.typeRef->typeDefPtr->typeName.octs))
 423                         {
 424                         choice = elmt;
 425                         break;
 426                         }
 427                     }
 428                 else if (equal(elmtname,TIN[elmt->typeId]))
 429                         {
 430                         choice = elmt;
 431                         break;
 432                         }
 433                 }
 434             Asn1Free(elmtname);
 435             SET_CURR_LIST_NODE (type->content->a.elmts, tmp);
 436             if (choice)
 437               {
 438                  tp[ntp].typename = tp[ntp].fieldname = NULL;
 439                  tp[ntp].index = 0;
 440                  ntp++;
 441                 result = TblEncType(choice,b,FALSE,&tmpBytesEncoded);
 442                   if (result!=TCL_OK)
 443                       return result;
 444                  ntp--;
 445               }
 446         break;
 447
 448       case TBL_BOOLEAN:
 449           result = TblEncAsk(type->typeId,&unival,tblvalcmdG);
 450           if (result!=TCL_OK)
 451               return result;
 452           tmpBytesEncoded += BEncAsnBoolContent (b, &unival.bo);
 453           if (interpResultG!=TCL_OK)
 454             return interpResultG;
 455         break;
 456
 457       case TBL_INTEGER:
 458       case TBL_ENUMERATED:
 459           result = TblEncAsk(type->typeId,&unival,tblvalcmdG);
 460           if (result!=TCL_OK)
 461               return result;
 462           tmpBytesEncoded += BEncAsnIntContent (b, &unival.in);
 463           if (interpResultG!=TCL_OK)
 464             return interpResultG;
 465         break;
 466
 467       case TBL_BITSTRING:
 468           result = TblEncAsk(type->typeId,&unival,tblvalcmdG);
 469           if (result!=TCL_OK)
 470               return result;
 471           tmpBytesEncoded += BEncAsnBitsContent (b, &unival.bi);
 472           Asn1Free(unival.bi.bits);
 473           if (interpResultG!=TCL_OK)
 474             return interpResultG;
 475         break;
 476
 477       case TBL_OCTETSTRING:
 478           result = TblEncAsk(type->typeId,&unival,tblvalcmdG);
 479           if (result!=TCL_OK)
 480               return result;
 481           tmpBytesEncoded += BEncAsnOctsContent (b, &unival.oc);
 482           Asn1Free(unival.oc.octs);
 483           if (interpResultG!=TCL_OK)
 484             return interpResultG;
 485         break;
 486
 487       case TBL_NULL:
 488           tmpBytesEncoded += BEncAsnNullContent (b, NULL);
 489           if (interpResultG!=TCL_OK)
 490             return interpResultG;
 491         break;
 492
 493       case TBL_OID:
 494           result = TblEncAsk(type->typeId,&unival,tblvalcmdG);
 495           if (result!=TCL_OK)
 496               return result;
 497           tmpBytesEncoded += BEncAsnOidContent (b, &unival.oc);
 498           Asn1Free(unival.oc.octs);
 499           if (interpResultG!=TCL_OK)
 500             return interpResultG;
 501         break;
 502
 503       case TBL_REAL:
 504           result = TblEncAsk(type->typeId,&unival,tblvalcmdG);
 505           if (result!=TCL_OK)
 506               return result;
 507           tmpBytesEncoded += BEncAsnRealContent (b, &unival.re);
 508           if (interpResultG!=TCL_OK)
 509             return interpResultG;
 510         break;
 511
 512       default:
 513          Tcl_AppendResult(interpG,"strange type",NULL);
 514          return TCL_ERROR;
 515
 516     }
 517
 518     TblEncodeTagsAndLens (type, b, implicit, &tmpBytesEncoded);
 519     (*bytesEncoded) += tmpBytesEncoded;
 520
 521     return TCL_OK;
 522
 523 }
 524
 525 int
 526 TblEnc PARAMS (( type, b),
 527     TBLType *type _AND_
 528     BUF_TYPE b)
 529 {
 530     unsigned long int bytesEncoded = 0;
 531     int result;
 532     ntp = 1;
 533     result = TblEncType (type, b, FALSE, &bytesEncoded);
 534     if (result==TCL_OK && BufWriteError (b))
 535         {
 536         Tcl_AppendResult(interpG,"error writing buffer",NULL);
 537         result = TCL_ERROR;
 538         }
 539     interpResultG = result;
 540     if (result==TCL_OK)
 541         return bytesEncoded;
 542     else
 543         return -1;
 544 }
 545
 546
 547 void
 548 TblDbgValue (type, val, pvalue)
 549     TBLType* type;
 550     AVal* val;
 551     Tcl_DString* pvalue;
 552 {
 553     char fmt[20];
 554     switch (type->typeId)
 555     {
 556         case TBL_BOOLEAN:
 557             Tcl_DStringAppend(pvalue,*(AsnBool*)val? "TRUE" :"FALSE", -1);
 558             break;
 559         case TBL_INTEGER:
 560         case TBL_ENUMERATED:
 561             sprintf(fmt,"%d",*(AsnInt*)val);
 562             Tcl_DStringAppend(pvalue,fmt, -1);
 563             break;
 564         case TBL_BITSTRING:
 565             {
 566             AsnBits* v = (AsnBits*)val;
 567             unsigned long i;
 568             for (i=0; i<v->bitLen; i++)
 569                 Tcl_DStringAppend(pvalue,GetAsnBit(v,i)?"1":"0", -1);
 570             }
 571             break;
 572         case TBL_OCTETSTRING:
 573         case TBL_OID:
 574             {
 575             AsnOcts* v = (AsnOcts*)val;
 576             unsigned long i;
 577             for (i=0; i<v->octetLen; i++)
 578                 if (v->octs[i]=='\\' || !isprint(v->octs[i]))
 579                     {
 580                     sprintf(fmt,"\\%03o",v->octs[i]);
 581                     Tcl_DStringAppend(pvalue,fmt,-1);
 582                     }
 583                 else
 584                     Tcl_DStringAppend(pvalue,v->octs+i,1);
 585             }
 586             break;
 587         case TBL_NULL:
 588             Tcl_DStringAppend(pvalue,"NULL", -1);
 589             break;
 590         case TBL_REAL:
 591             sprintf(fmt,"%G",*(AsnReal*)val);
 592             Tcl_DStringAppend(pvalue,fmt, -1);
 593             break;
 594         default:
 595             break;
 596     }
 597 }
 598
 599
 600 int
 601 TblDbgType PARAMS ((type, val, begin),
 602     TBLType* type _AND_
 603     AVal* val _AND_
 604     int begin)
 605 {
 606     int result = TCL_OK;
 607     if (begin)
 608     {
 609         if (type->typeId==TBL_TYPEREF && !tp[ntp-1].typename)
 610             tp[ntp-1].typename = type->content->a.typeRef->typeDefPtr->typeName.octs;
 611         if (type->typeId!=TBL_TYPEREF && !tp[ntp-1].typename)
 612             tp[ntp-1].typename = TIN[type->typeId];
 613         if (!tp[ntp-1].fieldname)
 614             tp[ntp-1].fieldname = type->fieldName.octs;
 615         if (type->typeId >= TBL_SEQUENCE && type->typeId <= TBL_CHOICE)
 616         {
 617             result = TblDbgCallProc(tbltypecmdG,"1");
 618             if (type->typeId == TBL_SEQUENCEOF || type->typeId == TBL_SETOF)
 619                 tp[ntp-1].index = 1;
 620             tp[ntp].typename = tp[ntp].fieldname = NULL;
 621             tp[ntp].index = 0;
 622             ntp++;
 623         }
 624     }
 625     else if (type->typeId!=TBL_TYPEREF)
 626     {
 627         if (type->typeId < TBL_SEQUENCE)
 628         {
 629             Tcl_DString value;
 630             Tcl_DStringInit(&value);
 631             TblDbgValue(type,val,&value);
 632             result = TblDbgCallProc(tblvalcmdG,Tcl_DStringValue(&value));
 633             Tcl_DStringFree(&value);
 634         } else {
 635             ntp--;
 636             if (type->typeId == TBL_SEQUENCEOF || type->typeId == TBL_SETOF)
 637                 tp[ntp-1].index = 0;
 638             result = TblDbgCallProc(tbltypecmdG,"-1");
 639         }
 640         tp[ntp-1].typename = tp[ntp-1].fieldname = NULL;
 641         if (ntp>=2)
 642             if (tp[ntp-2].index)
 643                 tp[ntp-2].index++;
 644     }
 645     return result;
 646 }
 647
 648 TBLType* TblFindType (type, argv, followref, ptr, ptnnl)
 649     TBLType* type;
 650     char** argv;
 651     int followref;
 652     TBLRange** ptr;
 653     TBLNamedNumberList** ptnnl;
 654 {
 655     TBLType* elmt;
 656     TBLType* result;
 657     void *tmp;
 658     if (!*argv)
 659         {
 660         if (ptr && !*ptr && type->constraint)
 661             *ptr = type->constraint;
 662         if (ptnnl && !*ptnnl && type->values)
 663             *ptnnl = type->values;
 664         if (!followref || type->typeId!=TBL_TYPEREF)
 665             return type;
 666         }
 667     switch (type->typeId)
 668         {
 669         case TBL_TYPEREF:
 670             return TblFindType(type->content->a.typeRef->typeDefPtr->type,argv,followref,ptr,ptnnl);
 671         case TBL_CHOICE:
 672         case TBL_SET:
 673         case TBL_SEQUENCE:
 674             tmp = CURR_LIST_NODE (type->content->a.elmts);
 675             result = NULL;
 676             FOR_EACH_LIST_ELMT(elmt,type->content->a.elmts)
 677                 if (equal(*argv,elmt->fieldName.octs))
 678                     {
 679                     result = TblFindType(elmt,argv+1,followref,ptr,ptnnl);
 680                     break;
 681                     }
 682             if (!result) {
 683             FOR_EACH_LIST_ELMT(elmt,type->content->a.elmts)
 684                 if (!elmt->fieldName.octetLen)
 685                     {
 686                     if (elmt->typeId==TBL_TYPEREF)
 687                         {
 688                         if (equal(*argv,elmt->content->a.typeRef->typeDefPtr->typeName.octs)) {
 689                             result = TblFindType(elmt->content->a.typeRef->typeDefPtr->type,argv+1,followref,ptr,ptnnl);
 690                             break;
 691                             }
 692                         }
 693                     else if (equal(*argv,TIN[elmt->typeId])) {
 694                         result = TblFindType(elmt,argv+1,followref,ptr,ptnnl);
 695                         break;
 696                         }
 697                     }
 698             }
 699             SET_CURR_LIST_NODE (type->content->a.elmts, tmp);
 700             return result;
 701         case TBL_SETOF:
 702         case TBL_SEQUENCEOF:
 703             if (**argv>='0'&&**argv<='9')
 704                 argv++;
 705             return TblFindType(FIRST_LIST_ELMT(type->content->a.elmts),argv,followref,ptr,ptnnl);
 706         default:
 707             return NULL;
 708         }
 709 }
 710
 711
 712 TBLType* TblTypeOfPath (interp, tbl, path, followref, ptd, ptr, ptnnl)
 713     TBL* tbl;
 714     char* path;
 715     int followref;
 716     TBLTypeDef** ptd;
 717     TBLRange** ptr;
 718     TBLNamedNumberList** ptnnl;
 719 {
 720     TBLModule* tm = NULL;
 721     TBLTypeDef* td;
 722     TBLType* type = NULL;
 723     int argc;
 724     char** argv;
 725     if (Tcl_SplitList(interp,path,&argc,&argv)!=TCL_OK)
 726         return NULL;
 727     if (argc>=2 && (tm = TblFindModule(tbl,argv[0])))
 728         {
 729         argv++;
 730         argc--;
 731         }
 732     if (argc<1 || !(td=TblFindTypeDef(tbl,tm?tm->name.octs:NULL,argv[0],&tm))
 733             || !(type=TblFindType(td->type,argv+1,followref,ptr,ptnnl)))
 734         Tcl_AppendResult(interp,"wrong typepath \"",path,
 735                 "\", should be ?module? typedef ?subtype? ...", NULL);
 736     else if (ptd)
 737         *ptd = td;
 738     Tcl_Free((char*)argv);
 739     return type;
 740 }
 741
 742 int dowrite (Tcl_Channel chan, char* buffer, int n)
 743     {
 744     int written = 0;
 745     int onewrite;
 746     while (written<n)
 747         {
 748         onewrite = Tcl_Write(chan,buffer+written,n-written);
 749         if (onewrite<0)
 750             return onewrite;
 751         written += onewrite;
 752         }
 753     return written;
 754     }
 755
 756
 757 int TblCmdEncode (interp, tbl, chan, path, valcmd, typecmd)
 758     Tcl_Interp* interp;
 759     TBL* tbl;
 760     Tcl_Channel chan;
 761     char* path;
 762     char* valcmd;
 763     char* typecmd;
 764 {
 765     int write;
 766     ExpBuf *ep;
 767     ExpBuf* b;
 768     GenBuf gb;
 769
 770     TBLType* type = TblTypeOfPath (interp, tbl, path, FALSE, NULL, NULL, NULL);
 771     if (!type)
 772         {
 773         Tcl_AppendResult(interp,"wrong typepath \"",path,"\"",NULL);
 774         return TCL_ERROR;
 775         }
 776
 777     interpG = interp;
 778     interpResultG = TCL_OK;
 779     tblvalcmdG = valcmd;
 780     tbltypecmdG = typecmd?typecmd:valcmd;
 781
 782     ep = ExpBufAllocBufAndData();
 783     ExpBufResetInWriteRvsMode (ep); /* set up to hold encoding (= writing) */
 784     PutExpBufInGenBuf (ep, &gb);
 785     write = TblEnc(type,&gb);
 786     ep = ExpBufListFirstBuf(ep);
 787
 788     for (b=ep;interpResultG==TCL_OK && b;b=ExpBufNext(b))
 789     {
 790         if (dowrite(chan,ExpBufDataPtr(b),ExpBufDataSize(b))!=ExpBufDataSize(b))
 791             {
 792             Asn1Error("Error during writing");
 793             break;
 794             }
 795     }
 796     ExpBufFreeBufAndDataList (ep);
 797     return interpResultG;
 798 }
 799
 800 int doread (Tcl_Channel chan, char* buffer, int n, int checkeof)
 801     {
 802     int oneread = 0;
 803     int haveread = 0;
 804     while (haveread<n)
 805         {
 806         oneread = Tcl_Read(chan,buffer+haveread,n-haveread);
 807         if (oneread<0)
 808             {
 809             haveread = oneread;
 810             break;
 811             }
 812         if (checkeof && oneread==0 && haveread==0)
 813             /* Nothing there although select sais readable -> EOF */
 814             break;
 815         haveread += oneread;
 816         }
 817     return haveread;
 818     }
 819
 820
 821 int TblCmdDecode (interp, tbl, chan, path, valcmd, typecmd)
 822     Tcl_Interp* interp;
 823     TBL* tbl;
 824     Tcl_Channel chan;
 825     char* path;
 826     char* valcmd;
 827     char* typecmd;
 828 {
 829     int result;
 830     ChannelBuf cb;
 831     GenBuf gb;
 832     unsigned long bytesDecoded;
 833     char test;
 834
 835     TBLType* type = TblTypeOfPath (interp, tbl, path, FALSE, NULL, NULL, NULL);
 836     if (!type)
 837         {
 838         Tcl_AppendResult(interp,"wrong typepath \"",path,"\"",NULL);
 839         return TCL_ERROR;
 840         }
 841
 842     result = Tcl_Read(chan,&test,1);
 843     if (result<0) {
 844         Tcl_AppendResult(interp,"read failed",NULL);
 845         return TCL_ERROR;
 846     }
 847     if (result==0) {
 848         Tcl_AppendResult(interp,"0",NULL);
 849         return TCL_OK;
 850     }
 851     result = Tcl_Ungets(chan,&test,1,0);
 852     if (result!=1) {
 853         Tcl_AppendResult(interp,"ungets failed",NULL);
 854         return TCL_ERROR;
 855     }
 856
 857     cb.chan = chan;
 858     PutChannelBufInGenBuf(&cb,&gb);
 859
 860     interpG = interp;
 861     interpResultG = TCL_OK;
 862     tblvalcmdG = valcmd;
 863     tbltypecmdG = typecmd;
 864     ntp = 1;
 865
 866     result = TdeDecodeSpecific(tbl,&gb,type,&bytesDecoded,TblDbgType,NULL,NULL);
 867     if (interpResultG==TCL_OK)
 868         {
 869         if (!result)
 870             Asn1Error("TdeDecodeSpecific failed");
 871         }
 872     if (interpResultG==TCL_OK)
 873         {
 874         char buffer[11];
 875         sprintf(buffer,"%u",(int)bytesDecoded);
 876         Tcl_SetResult(interp,buffer,TCL_VOLATILE);
 877         }
 878     return interpResultG;
 879 }
 880
 881 int TblRealType (type)
 882     TBLType* type;
 883 {
 884     if (type->typeId==TBL_TYPEREF)
 885         return TblRealType(type->content->a.typeRef->typeDefPtr->type);
 886     else
 887         return type->typeId;
 888 }
 889
 890 TBLModule* TblModuleOfTypeDef (tbl, td)
 891     TBL* tbl;
 892     TBLTypeDef* td;
 893 {
 894     TBLModule* tm;
 895     TBLTypeDef* td2;
 896     void *tmp1;
 897     void *tmp2;
 898
 899      /* look in all modules and return typedef with given id */
 900     tmp1 = CURR_LIST_NODE (tbl->modules);
 901     FOR_EACH_LIST_ELMT (tm, tbl->modules)
 902     {
 903         tmp2 = CURR_LIST_NODE (tm->typeDefs);
 904         FOR_EACH_LIST_ELMT (td2, tm->typeDefs)
 905             if (td2==td)
 906             {
 907                 SET_CURR_LIST_NODE (tm->typeDefs, tmp2);
 908                 SET_CURR_LIST_NODE (tbl->modules, tmp1);
 909                 return tm;
 910             }
 911         SET_CURR_LIST_NODE (tm->typeDefs, tmp2);
 912     }
 913     SET_CURR_LIST_NODE (tbl->modules, tmp1);
 914     return NULL;
 915 }
 916
 917 void TblDescType (ps, tbl, tm, td, type, tr, tnnl)
 918     Tcl_DString* ps;
 919     TBL* tbl;
 920     TBLModule* tm;
 921     TBLTypeDef* td;
 922     TBLType* type;
 923     TBLRange* tr;
 924     TBLNamedNumberList* tnnl;
 925 {
 926     if (td) {
 927         Tcl_DStringStartSublist(ps);
 928         Tcl_DStringAppendElement(ps,tm->name.octs);
 929         Tcl_DStringAppendElement(ps,td->typeName.octs);
 930         Tcl_DStringAppendElement(ps,td->isPdu?"pdu":"sub");
 931         Tcl_DStringEndSublist(ps);
 932     } else {
 933         Tcl_DStringAppendElement(ps,type->fieldName.octs);
 934     }
 935     Tcl_DStringAppendElement(ps,TIN[type->typeId]);
 936     Tcl_DStringStartSublist(ps);
 937     if (!tr)
 938         tr = type->constraint;
 939     if (tr) {
 940         char fmt[20];
 941         sprintf(fmt,"%d",tr->from);
 942         Tcl_DStringAppendElement(ps,fmt);
 943         if (tr->to!=tr->from) {
 944             sprintf(fmt,"%d",tr->to);
 945             Tcl_DStringAppendElement(ps,fmt);
 946         }
 947     }
 948     Tcl_DStringEndSublist(ps);
 949     Tcl_DStringStartSublist(ps);
 950     if (!tnnl)
 951         tnnl = type->values;
 952     if (tnnl) {
 953         TBLNamedNumber* tnn;
 954         FOR_EACH_LIST_ELMT(tnn,tnnl)
 955             {
 956             char fmt[20];
 957             Tcl_DStringStartSublist(ps);
 958             sprintf(fmt,"%d",tnn->value);
 959             Tcl_DStringAppendElement(ps,fmt);
 960             if (tnn->name.octetLen)
 961                 Tcl_DStringAppendElement(ps,tnn->name.octs);
 962             Tcl_DStringEndSublist(ps);
 963             }
 964     }
 965     Tcl_DStringEndSublist(ps);
 966     if (type->content)
 967         switch (type->content->choiceId) {
 968         case TBLTYPECONTENT_ELMTS:
 969             {
 970             TBLType* elmt;
 971             void* tmp = CURR_LIST_NODE (type->content->a.elmts);
 972             Tcl_DStringStartSublist(ps);
 973             FOR_EACH_LIST_ELMT(elmt,type->content->a.elmts)
 974                 {
 975                 Tcl_DStringStartSublist(ps);
 976                 TblDescType(ps,tbl,tm,NULL,elmt,NULL,NULL);
 977                 Tcl_DStringEndSublist(ps);
 978                 Tcl_DStringAppendElement(ps,elmt->optional?"0":"1");
 979                 }
 980             Tcl_DStringEndSublist(ps);
 981             SET_CURR_LIST_NODE (type->content->a.elmts, tmp);
 982             }
 983             break;
 984         case TBLTYPECONTENT_TYPEREF:
 985             {
 986             TBLTypeDef* td = type->content->a.typeRef->typeDefPtr;
 987             Tcl_DStringStartSublist(ps);
 988             Tcl_DStringAppendElement(ps,TblModuleOfTypeDef(tbl,td)->name.octs);
 989             Tcl_DStringAppendElement(ps,td->typeName.octs);
 990             Tcl_DStringEndSublist(ps);
 991             }
 992             break;
 993         default:
 994             break;
 995         }
 996 }
 997
 998 typedef struct TblCmdData {
 999     char name[20];
1000     TBL* tbl;
1001     } TblCmdData;
1002
1003 int TblCmd (tcd, interp, argc, argv)
1004     TblCmdData* tcd;
1005     Tcl_Interp* interp;
1006     int argc;
1007     char* argv[];
1008 {
1009     int c;
1010     size_t l;
1011     if (argc>=2) {
1012         c = *argv[1];
1013         l = strlen(argv[1]);
1014
1015         if (argc==2 && !strncmp(argv[1],"close",l)) {
1016             Tcl_DeleteCommand(interp,tcd->name);
1017             return TCL_OK;
1018         } else if (!strncmp(argv[1],"decode",l) && (argc>=5 && argc<=6)) {
1019             int mode;
1020             Tcl_Channel chan = Tcl_GetChannel(interp,argv[2],&mode);
1021             if (!chan)
1022                 return TCL_ERROR;
1023             if (!(mode & TCL_READABLE)) {
1024                 Tcl_AppendResult(interp, "channel \"", argv[2],
1025                         "\" wasn't opened for reading", NULL);
1026                 return TCL_ERROR;
1027             }
1028             return TblCmdDecode(interp,tcd->tbl,chan,argv[3],argv[4],argv[5]);
1029         } else if (!strncmp(argv[1],"encode",l) && (argc>=5 && argc<=6)) {
1030             int mode;
1031             Tcl_Channel chan = Tcl_GetChannel(interp,argv[2],&mode);
1032             if (!chan)
1033                 return TCL_ERROR;
1034             if (!(mode & TCL_WRITABLE)) {
1035                 Tcl_AppendResult(interp, "channel \"", argv[2],
1036                         "\" wasn't opened for writing", NULL);
1037                 return TCL_ERROR;
1038             }
1039             return TblCmdEncode(interp,tcd->tbl,chan,argv[3],argv[4],argv[5]);
1040         } else if (argc==2 && !strncmp(argv[1],"modules",l)) {
1041             TBLModule *tm;
1042             FOR_EACH_LIST_ELMT (tm, tcd->tbl->modules)
1043                 Tcl_AppendElement(interp,tm->name.octs);
1044             return TCL_OK;
1045         } else if (!strncmp(argv[1],"type",l) && (argc==3
1046                 || argc==4 && !strncmp(argv[2],"-followref",max(strlen(argv[2]),2)))) {
1047             TBLTypeDef* td;
1048             TBLRange* tr = NULL;
1049             TBLNamedNumberList* tnnl = NULL;
1050             TBLType* type = TblTypeOfPath(interp,tcd->tbl,argv[argc-1],argc==4,
1051                     &td,&tr,&tnnl);
1052             if (!type)
1053                 return TCL_ERROR;
1054             else
1055                 {
1056                 Tcl_DString ds;
1057                 Tcl_DStringInit(&ds);
1058                 TblDescType(&ds,tcd->tbl,TblModuleOfTypeDef(tcd->tbl,td),
1059                         type==td->type?td:NULL,type,tr,tnnl);
1060                 Tcl_DStringResult(interp,&ds);
1061                 Tcl_DStringFree(&ds);
1062                 return TCL_OK;
1063                 }
1064
1065         } else if (argc>=2 && argc<=3 && !strncmp(argv[1],"types",l)) {
1066             TBLModule *tm;
1067             TBLTypeDef* td;
1068             int moduleFound = 0;
1069             Tcl_DString ds;
1070             Tcl_DStringInit(&ds);
1071             FOR_EACH_LIST_ELMT (tm, tcd->tbl->modules)
1072                 if (argc==2 || equal(tm->name.octs,argv[2])) {
1073                     moduleFound = 1;
1074                 FOR_EACH_LIST_ELMT (td, tm->typeDefs) {
1075                     Tcl_DStringStartSublist(&ds);
1076                     Tcl_DStringAppendElement(&ds,tm->name.octs);
1077                     Tcl_DStringAppendElement(&ds,td->typeName.octs);
1078                     Tcl_DStringEndSublist(&ds);
1079                     }
1080                 }
1081             Tcl_DStringResult(interp,&ds);
1082             Tcl_DStringFree(&ds);
1083             if (argc==3 && !moduleFound) {
1084                 Tcl_AppendResult(interp,argv[0]," ",argv[1],": module \"",argv[2],
1085                         "\" unknown",NULL);
1086                 return TCL_ERROR;
1087                 }
1088             return TCL_OK;
1089         }
1090     }
1091     Tcl_AppendResult(interp, "wrong # args:  should be \"",
1092             argv[0],
1093             " modules",
1094             " | types ?module?",
1095             " | type ?-followref? {?module? typedef ?subtype? ...}",
1096             " | decode channel {?module? typedef ?subtype? ...} valcmd ?typecmd?",
1097             " | encode channel {?module? typedef ?subtype? ...} valcmd ?typecmd?",
1098             " | close\"",
1099             NULL);
1100     return TCL_ERROR;
1101 }
1102
1103 void TblCmdFree (tcd)
1104     TblCmdData* tcd;
1105 {
1106     FreeTBL(tcd->tbl);
1107     ckfree(tcd);
1108 }
1109
1110 int TableCmd (clientData, interp, argc, argv)
1111     ClientData clientData;
1112     Tcl_Interp* interp;
1113     int argc;
1114     char* argv[];
1115 {
1116     static int ntbl = 0;
1117     TBL* tbl;
1118     TblCmdData* tcd;
1119
1120     if (argc != 2) {
1121         Tcl_AppendResult(interp, "wrong # args:  should be \"",
1122                 argv[0], " path\"", NULL);
1123         return TCL_ERROR;
1124     }
1125
1126     interpG = interp;
1127     interpResultG = TCL_OK;
1128     tbl = LoadTblFile(argv[1]);
1129     if (!tbl && interpResultG==TCL_OK) {
1130         Asn1Error("Can't load grammar table");
1131     }
1132
1133     if (interpResultG!=TCL_OK)
1134         return interpResultG;
1135
1136     tcd = (TblCmdData*) ckalloc(sizeof(*tcd));
1137     sprintf(tcd->name,"asn%d",++ntbl);
1138     tcd->tbl = tbl;
1139     Tcl_CreateCommand(interp,tcd->name,TblCmd,tcd,TblCmdFree);
1140     Tcl_AppendResult(interp,tcd->name,NULL);
1141     return TCL_OK;
1142     }
1143 \f
1144 /*
1145  *----------------------------------------------------------------------
1146  *
1147  * Tcl_AppInit --
1148  *
1149  *      This procedure performs application-specific initialization.
1150  *      Most applications, especially those that incorporate additional
1151  *      packages, will have their own version of this procedure.
1152  *
1153  * Results:
1154  *      Returns a standard Tcl completion code, and leaves an error
1155  *      message in interp->result if an error occurs.
1156  *
1157  * Side effects:
1158  *      Depends on the startup script.
1159  *
1160  *----------------------------------------------------------------------
1161  */
1162
1163
1164 int
1165 Tbl_AppInit(interp)
1166     Tcl_Interp *interp;         /* Interpreter for application. */
1167 {
1168     if (Tcl_Init(interp) == TCL_ERROR) {
1169         return TCL_ERROR;
1170     }
1171     if (Tk_Init(interp) == TCL_ERROR) {
1172         return TCL_ERROR;
1173     }
1174
1175     /*
1176      * Call Tcl_CreateCommand for application-specific commands, if
1177      * they weren't already created by the init procedures called above.
1178      */
1179
1180     Asn1InstallErrorHandler(myAsn1ErrorHandler);
1181     InitNibbleMem(1024,1024);
1182     Tcl_CreateCommand(interp, "asn", TableCmd, NULL, NULL);
1183
1184     return TCL_OK;
1185 }