ir-tcl.c

   1 /*
   2  * IR toolkit for tcl/tk
   3  * (c) Index Data 1995
   4  *
   5  * $Id: ir-tcl.c,v 1.3 1995-03-09 08:35:53 adam Exp $
   6  */
   7
   8 #include <stdlib.h>
   9 #include <stdio.h>
  10 #include <sys/time.h>
  11 #include <assert.h>
  12
  13 #include <comstack.h>
  14 #include <tcpip.h>
  15 #include <xmosi.h>
  16
  17 #include <odr.h>
  18 #include <proto.h>
  19
  20 #include <tcl.h>
  21
  22 #include "ir-tcl.h"
  23
  24 typedef struct {
  25     COMSTACK cs_link;
  26
  27     int preferredMessageSize;
  28     int maximumMessageSize;
  29     Odr_bitmask options;
  30     Odr_bitmask protocolVersion;
  31     char *idAuthentication;
  32     char *implementationName;
  33     char *implementationId;
  34
  35     char *buf_out;
  36     int  len_out;
  37
  38     char *buf_in;
  39     int  len_in;
  40
  41     ODR odr_in;
  42     ODR odr_out;
  43     ODR odr_pr;
  44
  45     Tcl_Interp *interp;
  46     char *callback;
  47
  48     int smallSetUpperBound;
  49     int largeSetLowerBound;
  50     int mediumSetPresentNumber;
  51     int replaceIndicator;
  52     char **databaseNames;
  53     int num_databaseNames;
  54 } IRObj;
  55
  56 typedef struct {
  57     IRObj *parent;
  58 } IRSetObj;
  59
  60 typedef struct {
  61     char *name;
  62     int (*method) (void * obj, Tcl_Interp *interp, int argc, char **argv);
  63 } IRMethod;
  64
  65 static int do_disconnect (void *obj,Tcl_Interp *interp, int argc, char **argv);
  66
  67 /*
  68  * get_parent_info: Returns information about parent object.
  69  */
  70 static int get_parent_info (Tcl_Interp *interp, const char *name,
  71                             Tcl_CmdInfo *parent_info)
  72 {
  73     char parent_name[128];
  74     const char *csep = strrchr (name, '.');
  75     int pos;
  76
  77     if (!csep)
  78     {
  79         interp->result = "missing .";
  80         return TCL_ERROR;
  81     }
  82     pos = csep-name;
  83     if (pos > 127)
  84         pos = 127;
  85     memcpy (parent_name, name, pos);
  86     parent_name[pos] = '\0';
  87     if (!Tcl_GetCommandInfo (interp, parent_name, parent_info))
  88         return TCL_ERROR;
  89     return TCL_OK;
  90 }
  91
  92 /*
  93  * ir_method: Search for method in table and invoke method handler
  94  */
  95 int ir_method (void *obj, Tcl_Interp *interp, int argc, char **argv,
  96                    IRMethod *tab)
  97 {
  98     while (tab->name)
  99     {
 100         if (!strcmp (tab->name, argv[1]))
 101             return (*tab->method)(obj, interp, argc, argv);
 102         tab++;
 103     }
 104     Tcl_AppendResult (interp, "unknown method: ", argv[1], NULL);
 105     return TCL_ERROR;
 106 }
 107
 108 /*
 109  * ir_asc2bitmask: Ascii to ODR bitmask conversion
 110  */
 111 int ir_asc2bitmask (const char *asc, Odr_bitmask *ob)
 112 {
 113     const char *cp = asc + strlen(asc);
 114     int bitno = 0;
 115
 116     ODR_MASK_ZERO (ob);
 117     do
 118     {
 119         if (*--cp == '1')
 120             ODR_MASK_SET (ob, bitno);
 121         bitno++;
 122     } while (cp != asc);
 123     return bitno;
 124 }
 125
 126 /*
 127  * ir_strdup: Duplicate string
 128  */
 129 int ir_strdup (Tcl_Interp *interp, char** p, char *s)
 130 {
 131     *p = malloc (strlen(s)+1);
 132     if (!*p)
 133     {
 134         interp->result = "malloc fail";
 135         return TCL_ERROR;
 136     }
 137     strcpy (*p, s);
 138     return TCL_OK;
 139 }
 140
 141 /* ------------------------------------------------------- */
 142
 143 /*
 144  * do_init_request: init method on IR object
 145  */
 146 static int do_init_request (void *obj, Tcl_Interp *interp,
 147                        int argc, char **argv)
 148 {
 149     Z_APDU apdu, *apdup;
 150     IRObj *p = obj;
 151     Z_InitRequest req;
 152     char *sbuf;
 153     int slen;
 154
 155     req.referenceId = 0;
 156     req.options = &p->options;
 157     req.protocolVersion = &p->protocolVersion;
 158     req.preferredMessageSize = &p->preferredMessageSize;
 159     req.maximumRecordSize = &p->maximumMessageSize;
 160
 161     req.idAuthentication = p->idAuthentication;
 162     req.implementationId = p->implementationId;
 163     req.implementationName = p->implementationName;
 164     req.implementationVersion = "0.1";
 165     req.userInformationField = 0;
 166
 167     apdu.u.initRequest = &req;
 168     apdu.which = Z_APDU_initRequest;
 169     apdup = &apdu;
 170
 171     if (!z_APDU (p->odr_out, &apdup, 0))
 172     {
 173         interp->result = odr_errlist [odr_geterror (p->odr_out)];
 174         odr_reset (p->odr_out);
 175         return TCL_ERROR;
 176     }
 177     sbuf = odr_getbuf (p->odr_out, &slen);
 178     if (cs_put (p->cs_link, sbuf, slen) < 0)
 179     {
 180         interp->result = "cs_put failed in init";
 181         return TCL_ERROR;
 182     }
 183     printf("Sent initializeRequest (%d bytes).\n", slen);
 184     return TCL_OK;
 185 }
 186
 187 /*
 188  * do_protocolVersion: Set protocol Version
 189  */
 190 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
 191                                int argc, char **argv)
 192 {
 193     if (argc == 3)
 194         ir_asc2bitmask (argv[2], &((IRObj *) obj)->protocolVersion);
 195     return TCL_OK;
 196 }
 197
 198 /*
 199  * do_options: Set options
 200  */
 201 static int do_options (void *obj, Tcl_Interp *interp,
 202                        int argc, char **argv)
 203 {
 204     if (argc == 3)
 205         ir_asc2bitmask (argv[2], &((IRObj *) obj)->options);
 206     return TCL_OK;
 207 }
 208
 209 /*
 210  * do_preferredMessageSize: Set preferred message size
 211  */
 212 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 213                                     int argc, char **argv)
 214 {
 215     if (argc == 3)
 216     {
 217         if (Tcl_GetInt (interp, argv[2],
 218                         &((IRObj *)obj)->preferredMessageSize)==TCL_ERROR)
 219             return TCL_ERROR;
 220     }
 221     sprintf (interp->result, "%d", ((IRObj *)obj)->preferredMessageSize);
 222     return TCL_OK;
 223 }
 224
 225 /*
 226  * do_maximumMessageSize: Set maximum message size
 227  */
 228 static int do_maximumMessageSize (void *obj, Tcl_Interp *interp,
 229                                     int argc, char **argv)
 230 {
 231     if (argc == 3)
 232     {
 233         if (Tcl_GetInt (interp, argv[2],
 234                         &((IRObj *)obj)->maximumMessageSize)==TCL_ERROR)
 235             return TCL_ERROR;
 236     }
 237     sprintf (interp->result, "%d", ((IRObj *)obj)->maximumMessageSize);
 238     return TCL_OK;
 239 }
 240
 241
 242 /*
 243  * do_implementationName: Set Implementation Name.
 244  */
 245 static int do_implementationName (void *obj, Tcl_Interp *interp,
 246                                     int argc, char **argv)
 247 {
 248     if (argc == 3)
 249     {
 250         free (((IRObj*)obj)->implementationName);
 251         if (ir_strdup (interp, &((IRObj*) obj)->implementationName, argv[2])
 252             == TCL_ERROR)
 253             return TCL_ERROR;
 254     }
 255     Tcl_AppendResult (interp, ((IRObj*)obj)->implementationName,
 256                       (char*) NULL);
 257     return TCL_OK;
 258 }
 259
 260 /*
 261  * do_implementationId: Set Implementation Name.
 262  */
 263 static int do_implementationId (void *obj, Tcl_Interp *interp,
 264                                 int argc, char **argv)
 265 {
 266     if (argc == 3)
 267     {
 268         free (((IRObj*)obj)->implementationId);
 269         if (ir_strdup (interp, &((IRObj*) obj)->implementationId, argv[2])
 270             == TCL_ERROR)
 271             return TCL_ERROR;
 272     }
 273     Tcl_AppendResult (interp, ((IRObj*)obj)->implementationId,
 274                       (char*) NULL);
 275     return TCL_OK;
 276 }
 277
 278 /*
 279  * do_idAuthentication: Set id Authentication
 280  */
 281 static int do_idAuthentication (void *obj, Tcl_Interp *interp,
 282                                 int argc, char **argv)
 283 {
 284     if (argc == 3)
 285     {
 286         free (((IRObj*)obj)->idAuthentication);
 287         if (ir_strdup (interp, &((IRObj*) obj)->idAuthentication, argv[2])
 288             == TCL_ERROR)
 289             return TCL_ERROR;
 290     }
 291     Tcl_AppendResult (interp, ((IRObj*)obj)->idAuthentication,
 292                       (char*) NULL);
 293     return TCL_OK;
 294 }
 295
 296 /*
 297  * do_connect: connect method on IR object
 298  */
 299 static int do_connect (void *obj, Tcl_Interp *interp,
 300                        int argc, char **argv)
 301 {
 302     void *addr;
 303     IRObj *p = obj;
 304
 305     if (argc < 3)
 306     {
 307         interp->result = "missing hostname";
 308         return TCL_ERROR;
 309     }
 310     if (cs_type(p->cs_link) == tcpip_type)
 311     {
 312         addr = tcpip_strtoaddr (argv[2]);
 313         if (!addr)
 314         {
 315             interp->result = "tcpip_strtoaddr fail";
 316             return TCL_ERROR;
 317         }
 318         printf ("tcp/ip connect %s\n", argv[2]);
 319     }
 320     else if (cs_type (p->cs_link) == mosi_type)
 321     {
 322         addr = mosi_strtoaddr (argv[2]);
 323         if (!addr)
 324         {
 325             interp->result = "mosi_strtoaddr fail";
 326             return TCL_ERROR;
 327         }
 328         printf ("mosi connect %s\n", argv[2]);
 329     }
 330     if (cs_connect (p->cs_link, addr) < 0)
 331     {
 332         interp->result = "cs_connect fail";
 333         do_disconnect (p, interp, argc, argv);
 334         return TCL_ERROR;
 335     }
 336     ir_select_add (cs_fileno (p->cs_link), p);
 337     return TCL_OK;
 338 }
 339
 340 /*
 341  * do_disconnect: disconnect method on IR object
 342  */
 343 static int do_disconnect (void *obj, Tcl_Interp *interp,
 344                           int argc, char **argv)
 345 {
 346     IRObj *p = obj;
 347
 348     ir_select_remove (cs_fileno (p->cs_link), p);
 349     if (cs_type (p->cs_link) == tcpip_type)
 350     {
 351         cs_close (p->cs_link);
 352         p->cs_link = cs_create (tcpip_type);
 353     }
 354     else if (cs_type (p->cs_link) == mosi_type)
 355     {
 356         cs_close (p->cs_link);
 357         p->cs_link = cs_create (mosi_type);
 358     }
 359     else
 360     {
 361         interp->result = "unknown comstack type";
 362         return TCL_ERROR;
 363     }
 364     return TCL_OK;
 365 }
 366
 367 /*
 368  * do_comstack: comstack method on IR object
 369  */
 370 static int do_comstack (void *obj, Tcl_Interp *interp,
 371                         int argc, char **argv)
 372 {
 373     if (argc == 3)
 374     {
 375         if (!strcmp (argv[2], "tcpip"))
 376             ((IRObj *)obj)->cs_link = cs_create (tcpip_type);
 377         else if (!strcmp (argv[2], "mosi"))
 378             ((IRObj *)obj)->cs_link = cs_create (mosi_type);
 379         else
 380         {
 381             interp->result = "wrong comstack type";
 382             return TCL_ERROR;
 383         }
 384     }
 385     if (cs_type(((IRObj *)obj)->cs_link) == tcpip_type)
 386         interp->result = "tcpip";
 387     else if (cs_type(((IRObj *)obj)->cs_link) == mosi_type)
 388         interp->result = "comstack";
 389     return TCL_OK;
 390 }
 391
 392 /*
 393  * do_callback: add callback
 394  */
 395 static int do_callback (void *obj, Tcl_Interp *interp,
 396                           int argc, char **argv)
 397 {
 398     IRObj *p = obj;
 399
 400     if (argc == 3)
 401     {
 402         free (p->callback);
 403         if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
 404             return TCL_ERROR;
 405         p->interp = interp;
 406     }
 407     return TCL_OK;
 408 }
 409
 410 /*
 411  * do_databaseNames: specify database names
 412  */
 413 static int do_databaseNames (void *obj, Tcl_Interp *interp,
 414                           int argc, char **argv)
 415 {
 416     int i;
 417     IRObj *p = obj;
 418
 419     if (argc < 3)
 420     {
 421         interp->result = "wrong # args";
 422         return TCL_ERROR;
 423     }
 424     if (p->databaseNames)
 425     {
 426         for (i=0; i<p->num_databaseNames; i++)
 427             free (p->databaseNames[i]);
 428         free (p->databaseNames);
 429     }
 430     p->num_databaseNames = argc - 2;
 431     if (!(p->databaseNames = malloc (sizeof(*p->databaseNames) *
 432                                p->num_databaseNames)))
 433     {
 434         interp->result = "malloc fail";
 435         return TCL_ERROR;
 436     }
 437     for (i=0; i<p->num_databaseNames; i++)
 438     {
 439         if (ir_strdup (interp, &p->databaseNames[i], argv[2+i])
 440             == TCL_ERROR)
 441             return TCL_ERROR;
 442     }
 443     return TCL_OK;
 444 }
 445
 446 /*
 447  * ir_obj_method: IR Object methods
 448  */
 449 static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
 450                           int argc, char **argv)
 451 {
 452     static IRMethod tab[] = {
 453     { "comstack", do_comstack },
 454     { "connect", do_connect },
 455     { "protocolVersion", do_protocolVersion },
 456     { "options", do_options },
 457     { "preferredMessageSize", do_preferredMessageSize },
 458     { "maximumMessageSize",   do_maximumMessageSize },
 459     { "implementationName", do_implementationName },
 460     { "implementationId",   do_implementationId },
 461     { "idAuthentication",   do_idAuthentication },
 462     { "init", do_init_request },
 463     { "disconnect", do_disconnect },
 464     { "callback", do_callback },
 465     { "databaseNames", do_databaseNames},
 466     { NULL, NULL}
 467     };
 468     if (argc < 2)
 469     {
 470         interp->result = "wrong # args";
 471         return TCL_ERROR;
 472     }
 473     return ir_method (clientData, interp, argc, argv, tab);
 474 }
 475
 476 /*
 477  * ir_obj_delete: IR Object disposal
 478  */
 479 static void ir_obj_delete (ClientData clientData)
 480 {
 481     free ( (void*) clientData);
 482 }
 483
 484 /*
 485  * ir_obj_mk: IR Object creation
 486  */
 487 static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
 488               int argc, char **argv)
 489 {
 490     IRObj *obj;
 491
 492     if (argc != 2)
 493     {
 494         interp->result = "wrong # args";
 495         return TCL_ERROR;
 496     }
 497     obj = malloc (sizeof(*obj));
 498     if (!obj)
 499     {
 500         interp->result = "malloc fail";
 501         return TCL_ERROR;
 502     }
 503     obj->cs_link = cs_create (tcpip_type);
 504
 505     obj->maximumMessageSize = 10000;
 506     obj->preferredMessageSize = 4096;
 507
 508     obj->idAuthentication = NULL;
 509
 510     if (ir_strdup (interp, &obj->implementationName, "TCL/TK on YAZ")
 511         == TCL_ERROR)
 512         return TCL_ERROR;
 513
 514     if (ir_strdup (interp, &obj->implementationId, "TCL/TK/YAZ")
 515         == TCL_ERROR)
 516         return TCL_ERROR;
 517
 518     obj->smallSetUpperBound = 0;
 519     obj->largeSetLowerBound = 2;
 520     obj->mediumSetPresentNumber = 0;
 521     obj->replaceIndicator = 1;
 522     obj->databaseNames = NULL;
 523     obj->num_databaseNames = 0;
 524
 525     ODR_MASK_ZERO (&obj->protocolVersion);
 526     ODR_MASK_SET (&obj->protocolVersion, 0);
 527     ODR_MASK_SET (&obj->protocolVersion, 1);
 528
 529     ODR_MASK_ZERO (&obj->options);
 530     ODR_MASK_SET (&obj->options, 0);
 531
 532     obj->odr_in = odr_createmem (ODR_DECODE);
 533     obj->odr_out = odr_createmem (ODR_ENCODE);
 534     obj->odr_pr = odr_createmem (ODR_PRINT);
 535
 536     obj->len_out = 10000;
 537     obj->buf_out = malloc (obj->len_out);
 538     if (!obj->buf_out)
 539     {
 540         interp->result = "malloc fail";
 541         return TCL_ERROR;
 542     }
 543     odr_setbuf (obj->odr_out, obj->buf_out, obj->len_out);
 544
 545     obj->len_in = 0;
 546     obj->buf_in = NULL;
 547
 548     obj->callback = NULL;
 549
 550     Tcl_CreateCommand (interp, argv[1], ir_obj_method,
 551                        (ClientData) obj, ir_obj_delete);
 552     return TCL_OK;
 553 }
 554
 555 /* ------------------------------------------------------- */
 556 /*
 557  * do_search: Do search request
 558  */
 559 static int do_search (void *o, Tcl_Interp *interp,
 560                        int argc, char **argv)
 561 {
 562     Z_SearchRequest req;
 563     Z_Query query;
 564     Z_APDU apdu, *apdup;
 565     static Odr_oid bib1[] = {1, 2, 840, 10003, 3, 1, -1};
 566     Odr_oct ccl_query;
 567     IRSetObj *obj = o;
 568     IRObj *p = obj->parent;
 569     char *sbuf;
 570     int slen;
 571
 572     if (argc != 3)
 573     {
 574         interp->result = "wrong # args";
 575         return TCL_ERROR;
 576     }
 577     if (!p->num_databaseNames)
 578     {
 579         interp->result = "no databaseNames";
 580         return TCL_ERROR;
 581     }
 582     apdu.which = Z_APDU_searchRequest;
 583     apdu.u.searchRequest = &req;
 584     apdup = &apdu;
 585
 586     req.referenceId = 0;
 587     req.smallSetUpperBound = &p->smallSetUpperBound;
 588     req.largeSetLowerBound = &p->largeSetLowerBound;
 589     req.mediumSetPresentNumber = &p->mediumSetPresentNumber;
 590     req.replaceIndicator = &p->replaceIndicator;
 591     req.resultSetName = "Default";
 592     req.num_databaseNames = p->num_databaseNames;
 593     req.databaseNames = p->databaseNames;
 594     req.smallSetElementSetNames = 0;
 595     req.mediumSetElementSetNames = 0;
 596     req.preferredRecordSyntax = 0;
 597     req.query = &query;
 598
 599     query.which = Z_Query_type_2;
 600     query.u.type_2 = &ccl_query;
 601     ccl_query.buf = argv[2];
 602     ccl_query.len = strlen (argv[2]);
 603
 604     if (!z_APDU (p->odr_out, &apdup, 0))
 605     {
 606         interp->result = odr_errlist [odr_geterror (p->odr_out)];
 607         odr_reset (p->odr_out);
 608         return TCL_ERROR;
 609     }
 610     sbuf = odr_getbuf (p->odr_out, &slen);
 611     if (cs_put (p->cs_link, sbuf, slen) < 0)
 612     {
 613         interp->result = "cs_put failed in init";
 614         return TCL_ERROR;
 615     }
 616     return TCL_OK;
 617 }
 618
 619 /*
 620  * do_query: Set query for a Set Object
 621  */
 622 static int do_query (void *obj, Tcl_Interp *interp,
 623                        int argc, char **argv)
 624 {
 625     return TCL_OK;
 626 }
 627
 628
 629 /*
 630  * ir_set_obj_method: IR Set Object methods
 631  */
 632 static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
 633                           int argc, char **argv)
 634 {
 635     static IRMethod tab[] = {
 636     { "query", do_query },
 637     { "search", do_search },
 638     { NULL, NULL}
 639     };
 640
 641     if (argc < 2)
 642     {
 643         interp->result = "wrong # args";
 644         return TCL_ERROR;
 645     }
 646     return ir_method (clientData, interp, argc, argv, tab);
 647 }
 648
 649 /*
 650  * ir_set_obj_delete: IR Set Object disposal
 651  */
 652 static void ir_set_obj_delete (ClientData clientData)
 653 {
 654     free ( (void*) clientData);
 655 }
 656
 657 /*
 658  * ir_set_obj_mk: IR Set Object creation
 659  */
 660 static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
 661                              int argc, char **argv)
 662 {
 663     Tcl_CmdInfo parent_info;
 664     IRSetObj *obj;
 665
 666     if (argc != 2)
 667     {
 668         interp->result = "wrong # args";
 669         return TCL_ERROR;
 670     }
 671     if (get_parent_info (interp, argv[1], &parent_info) == TCL_ERROR)
 672     {
 673         interp->result = "No parent";
 674         return TCL_ERROR;
 675     }
 676     obj = malloc (sizeof(*obj));
 677     if (!obj)
 678     {
 679         interp->result = "malloc fail";
 680         return TCL_ERROR;
 681     }
 682     obj->parent = (IRObj *) parent_info.clientData;
 683     Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
 684                        (ClientData) obj, ir_set_obj_delete);
 685     return TCL_OK;
 686 }
 687
 688 /* ------------------------------------------------------- */
 689
 690 static void ir_searchResponse (void *obj, Z_SearchResponse *searchrs)
 691 {
 692     if (searchrs->searchStatus)
 693         printf("Search was a success.\n");
 694     else
 695         printf("Search was a bloomin' failure.\n");
 696     printf("Number of hits: %d, setno %d\n", *searchrs->resultCount, 1);
 697 #if 0
 698     if (searchrs->records)
 699         display_records(searchrs->records);
 700 #endif
 701 }
 702
 703 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
 704 {
 705     if (!*initrs->result)
 706         printf("Connection rejected by target.\n");
 707     else
 708         printf("Connection accepted by target.\n");
 709     if (initrs->implementationId)
 710             printf("ID     : %s\n", initrs->implementationId);
 711     if (initrs->implementationName)
 712         printf("Name   : %s\n", initrs->implementationName);
 713     if (initrs->implementationVersion)
 714         printf("Version: %s\n", initrs->implementationVersion);
 715 #if 0
 716     if (initrs->userInformationField)
 717     {
 718         printf("UserInformationfield:\n");
 719         odr_external(&print, (Odr_external**)&initrs->
 720                          userInformationField, 0);
 721     }
 722 #endif
 723 }
 724
 725 static void ir_presentResponse (void *obj, Z_PresentResponse *presrs)
 726 {
 727     printf("Received presentResponse.\n");
 728     if (presrs->records)
 729         printf ("Got records\n");
 730     else
 731         printf("No records\n");
 732 }
 733
 734 void ir_select_proc (ClientData clientData)
 735 {
 736     IRObj *p = clientData;
 737     Z_APDU *apdu;
 738     int r;
 739
 740     do
 741     {
 742         if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in))  < 0)
 743         {
 744             printf ("cs_get failed\n");
 745             return;
 746         }
 747         odr_setbuf (p->odr_in, p->buf_in, r);
 748         printf ("cs_get ok, got %d\n", r);
 749         if (!z_APDU (p->odr_in, &apdu, 0))
 750         {
 751             printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]);
 752             return;
 753         }
 754         if (p->callback)
 755         {
 756             Tcl_Eval (p->interp, p->callback);
 757         }
 758         switch(apdu->which)
 759         {
 760         case Z_APDU_initResponse:
 761             ir_initResponse (NULL, apdu->u.initResponse);
 762             break;
 763         case Z_APDU_searchResponse:
 764             ir_searchResponse (NULL, apdu->u.searchResponse);
 765             break;
 766         case Z_APDU_presentResponse:
 767             ir_presentResponse (NULL, apdu->u.presentResponse);
 768             break;
 769         default:
 770             printf("Received unknown APDU type (%d).\n",
 771                    apdu->which);
 772         }
 773     } while (cs_more (p->cs_link));
 774 }
 775
 776 /* ------------------------------------------------------- */
 777
 778 /*
 779  * ir_tcl_init: Registration of TCL commands.
 780  */
 781 int ir_tcl_init (Tcl_Interp *interp)
 782 {
 783     Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL,
 784                        (Tcl_CmdDeleteProc *) NULL);
 785     Tcl_CreateCommand (interp, "ir-set", ir_set_obj_mk,
 786                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
 787     return TCL_OK;
 788 }
 789
 790