X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=21e810028a581f2d16822d8a0731b19e44f6cd6c;hb=534e39b7986d6cbbfac1c99bcca97d8d1fb5e990;hp=e52a1c02f0f3aab8caaaede837f6c941da3f3f79;hpb=3add7ff834c7a01f3bf1e9c8a74dc3199d1970e6;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index e52a1c0..21e8100 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,72 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.66 1995-11-28 17:26:39 adam + * Revision 1.83 1996-03-05 09:21:09 adam + * Bug fix: memory used by GRS records wasn't freed. + * Rewrote some of the error handling code - the connection is always + * closed before failback is called. + * If failback is defined the send APDU methods (init, search, ...) will + * return OK but invoke failback (as is the case if the write operation + * fails). + * Bug fix: ref_count in assoc object could grow if fraction of PDU was + * read. + * + * Revision 1.82 1996/02/29 15:30:21 adam + * Export of IrTcl functionality to extensions. + * + * Revision 1.81 1996/02/26 18:38:32 adam + * Work on export of set methods. + * + * Revision 1.80 1996/02/23 17:31:39 adam + * More functions made available to the wais tcl extension. + * + * Revision 1.79 1996/02/23 13:41:38 adam + * Work on public access to simple ir class system. + * + * Revision 1.78 1996/02/21 10:16:08 adam + * Simplified select handling. Only one function ir_tcl_select_set has + * to be externally defined. + * + * Revision 1.77 1996/02/20 17:52:58 adam + * Uses the YAZ oid system to name record syntax object identifiers. + * + * Revision 1.76 1996/02/20 16:09:51 adam + * Bug fix: didn't set element set names stamp correctly on result + * set records when element set names were set to the empty string. + * + * Revision 1.75 1996/02/19 15:41:53 adam + * Better log messages. + * Minor improvement of connect method. + * + * Revision 1.74 1996/02/05 17:58:03 adam + * Ported ir-tcl to use the beta releases of tcl7.5/tk4.1. + * + * Revision 1.73 1996/01/29 11:35:19 adam + * Bug fix: cs_type member renamed to comstackType to avoid conflict with + * cs_type macro defined by YAZ. + * + * Revision 1.72 1996/01/19 17:45:34 quinn + * Added debugging output + * + * Revision 1.71 1996/01/19 16:22:38 adam + * New method: apduDump - returns information about last incoming APDU. + * + * Revision 1.70 1996/01/10 09:18:34 adam + * PDU specific callbacks implemented: initRespnse, searchResponse, + * presentResponse and scanResponse. + * Bug fix in the command line shell (tclmain.c) - discovered on OSF/1. + * + * Revision 1.69 1996/01/04 16:12:12 adam + * Setting PDUType renamed to eventType. + * + * Revision 1.68 1996/01/04 11:05:22 adam + * New setting: PDUType - returns type of last PDU returned from the target. + * Fixed a bug in configure/Makefile. + * + * Revision 1.67 1996/01/03 09:00:51 adam + * Updated to use new version of Yaz (names changed to avoid C++ conflict). + * + * Revision 1.66 1995/11/28 17:26:39 adam * Removed Carriage return from ir-tcl.c! * Removed misc. debug logs. * @@ -236,31 +301,61 @@ #include #include -#ifdef WINDOWS +#include #include -#else -#include -#endif #include #define CS_BLOCK 0 +#define IRTCL_GENERIC_FILES 0 + #include "ir-tclp.h" -typedef struct { - int type; - char *name; - int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv); -} IrTcl_Method; +static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num); -typedef struct { - void *obj; - IrTcl_Method *tab; -} IrTcl_Methods; +static void ir_select_notify (ClientData clientData, int r, int w, int e); -static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num); -static int do_disconnect (void *obj, Tcl_Interp *interp, - int argc, char **argv); +void ir_select_add (int fd, void *obj) +{ + ir_tcl_select_set (ir_select_notify, fd, obj, 1, 0, 0); +} + +void ir_select_add_write (int fd, void *obj) +{ + ir_tcl_select_set (ir_select_notify, fd, obj, 1, 1, 0); +} + +void ir_select_remove (int fd, void *obj) +{ + ir_tcl_select_set (NULL, fd, obj, 0, 0, 0); +} + +void ir_select_remove_write (int fd, void *obj) +{ + ir_tcl_select_set (ir_select_notify, fd, obj, 1, 0, 0); +} + +static void delete_IR_record (IrTcl_RecordList *rl) +{ + switch (rl->which) + { + case Z_NamePlusRecord_databaseRecord: + switch (rl->u.dbrec.type) + { + case VAL_GRS1: + ir_tcl_grs_del (&rl->u.dbrec.u.grs1); + break; + default: + } + free (rl->u.dbrec.buf); + break; + case Z_NamePlusRecord_surrogateDiagnostic: + ir_deleteDiags (&rl->u.surrogateDiagnostics.list, + &rl->u.surrogateDiagnostics.num); + break; + } + free (rl->elements); +} static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, int no, int which, @@ -268,23 +363,14 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, { IrTcl_RecordList *rl; + if (elements && !*elements) + elements = NULL; for (rl = setobj->record_list; rl; rl = rl->next) { if (no == rl->no && (!rl->elements || !elements || !strcmp(elements, rl->elements))) { - free (rl->elements); - switch (rl->which) - { - case Z_NamePlusRecord_databaseRecord: - free (rl->u.dbrec.buf); - rl->u.dbrec.buf = NULL; - break; - case Z_NamePlusRecord_surrogateDiagnostic: - ir_deleteDiags (&rl->u.surrogateDiagnostics.list, - &rl->u.surrogateDiagnostics.num); - break; - } + delete_IR_record (rl); break; } } @@ -300,38 +386,15 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, return rl; } -static struct { - enum oid_value value; - const char *name; -} IrTcl_recordSyntaxTab[] = { -{ VAL_UNIMARC, "UNIMARC" }, -{ VAL_INTERMARC, "INTERMARC" }, -{ VAL_CCF, "CCF" }, -{ VAL_USMARC, "USMARC" }, -{ VAL_UKMARC, "UKMARC" }, -{ VAL_NORMARC, "NORMARC" }, -{ VAL_LIBRISMARC, "LIBRISMARC" }, -{ VAL_DANMARC, "DANMARC" }, -{ VAL_FINMARC, "FINMARC" }, -{ VAL_MAB, "MAB" }, -{ VAL_CANMARC, "CANMARC" }, -{ VAL_SBN, "SBN" }, -{ VAL_PICAMARC, "PICAMARC" }, -{ VAL_AUSMARC, "AUSMARC" }, -{ VAL_IBERMARC, "IBERMARC" }, -{ VAL_SUTRS, "SUTRS" }, -{ VAL_GRS1, "GRS1" }, -{ 0, NULL } -}; - /* - * IrTcl_eval + * ir_tcl_eval */ -int IrTcl_eval (Tcl_Interp *interp, const char *command) +int ir_tcl_eval (Tcl_Interp *interp, const char *command) { char *tmp = ir_tcl_malloc (strlen(command)+1); int r; + logf (LOG_DEBUG, "Invoking %.17s ...", command); strcpy (tmp, command); r = Tcl_Eval (interp, tmp); if (r == TCL_ERROR) @@ -345,13 +408,21 @@ int IrTcl_eval (Tcl_Interp *interp, const char *command) /* * IrTcl_getRecordSyntaxStr: Return record syntax name of object id */ -static const char *IrTcl_getRecordSyntaxStr (enum oid_value value) +static char *IrTcl_getRecordSyntaxStr (enum oid_value value) { - int i; - for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) - if (IrTcl_recordSyntaxTab[i].value == value) - return IrTcl_recordSyntaxTab[i].name; - return "USMARC"; + int *o; + struct oident ent, *entp; + + ent.proto = PROTO_Z3950; + ent.oclass = CLASS_RECSYN; + ent.value = value; + + o = oid_getoidbyent (&ent); + entp = oid_getentbyoid (o); + + if (!entp) + return ""; + return entp->desc; } /* @@ -359,11 +430,7 @@ static const char *IrTcl_getRecordSyntaxStr (enum oid_value value) */ static enum oid_value IrTcl_getRecordSyntaxVal (const char *name) { - int i; - for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) - if (!strcmp (IrTcl_recordSyntaxTab[i].name, name)) - return IrTcl_recordSyntaxTab[i].value; - return 0; + return oid_getvalbyname (name); } static IrTcl_RecordList *find_IR_record (IrTcl_SetObj *setobj, int no) @@ -384,16 +451,7 @@ static void delete_IR_records (IrTcl_SetObj *setobj) for (rl = setobj->record_list; rl; rl = rl1) { - switch (rl->which) - { - case Z_NamePlusRecord_databaseRecord: - free (rl->u.dbrec.buf); - break; - case Z_NamePlusRecord_surrogateDiagnostic: - ir_deleteDiags (&rl->u.surrogateDiagnostics.list, - &rl->u.surrogateDiagnostics.num); - break; - } + delete_IR_record (rl); rl1 = rl->next; free (rl); } @@ -401,9 +459,9 @@ static void delete_IR_records (IrTcl_SetObj *setobj) } /* - * get_set_int: Set/get integer value + * ir_tcl_get_set_int: Set/get integer value */ -static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) +int ir_tcl_get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) { char buf[20]; @@ -418,9 +476,10 @@ static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) } /* - * ir_method: Search for method in table and invoke method handler + * ir_tcl_method: Search for method in table and invoke method handler */ -int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) +int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, + IrTcl_Methods *tab, int *ret) { IrTcl_Methods *tab_i = tab; IrTcl_Method *t; @@ -434,45 +493,29 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) } else if (!strcmp (t->name, argv[1])) - return (*t->method)(tab_i->obj, interp, argc, argv); + { + *ret = (*t->method)(tab_i->obj, interp, argc, argv); + return TCL_OK; + } if (argc <= 0) return TCL_OK; +#if 0 Tcl_AppendResult (interp, "Bad method: ", argv[1], ". Possible methods:", NULL); for (tab_i = tab; tab_i->tab; tab_i++) for (t = tab_i->tab; t->name; t++) Tcl_AppendResult (interp, " ", t->name, NULL); +#endif + *ret = TCL_ERROR; return TCL_ERROR; } /* - * ir_method_r: Get status for all readable elements + * ir_tcl_named_bits: get/set named bits */ -int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv, - IrTcl_Method *tab) -{ - char *argv_n[3]; - int argc_n; - - argv_n[0] = argv[0]; - argc_n = 2; - for (; tab->name; tab++) - if (tab->type) - { - argv_n[1] = tab->name; - Tcl_AppendResult (interp, "{", NULL); - (*tab->method)(obj, interp, argc_n, argv_n); - Tcl_AppendResult (interp, "} ", NULL); - } - return TCL_OK; -} - -/* - * ir_named_bits: get/set named bits - */ -int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, - Tcl_Interp *interp, int argc, char **argv) +int ir_tcl_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, + Tcl_Interp *interp, int argc, char **argv) { struct ir_named_entry *ti; if (argc > 0) @@ -594,7 +637,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, req->implementationVersion = p->implementationVersion; req->userInformationField = 0; - return ir_tcl_send_APDU (interp, p, apdu, "init", argv[0]); + return ir_tcl_send_APDU (interp, p, apdu, "init", *argv); } /* @@ -665,7 +708,55 @@ static int do_options (void *obj, Tcl_Interp *interp, ODR_MASK_SET (&p->options, 14); return TCL_OK; } - return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2); + return ir_tcl_named_bits (options_tab, &p->options, interp, argc-2, argv+2); +} + +/* + * do_apduInfo: Get APDU information + */ +static int do_apduInfo (void *obj, Tcl_Interp *interp, int argc, char **argv) +{ + char buf[16]; + FILE *apduf; + IrTcl_Obj *p = obj; + + if (argc <= 0) + return TCL_OK; + sprintf (buf, "%d", p->apduLen); + Tcl_AppendElement (interp, buf); + sprintf (buf, "%d", p->apduOffset); + Tcl_AppendElement (interp, buf); + if (!p->buf_in) + { + Tcl_AppendElement (interp, ""); + return TCL_OK; + } + apduf = fopen ("apdu.tmp", "w"); + if (!apduf) + { + Tcl_AppendElement (interp, ""); + return TCL_OK; + } + odr_dumpBER (apduf, p->buf_in, p->apduLen); + fclose (apduf); + if (!(apduf = fopen ("apdu.tmp", "r"))) + Tcl_AppendElement (interp, ""); + else + { + int c; + + Tcl_AppendResult (interp, " {", NULL); + while ((c = getc (apduf)) != EOF) + { + buf[0] = c; + buf[1] = '\0'; + Tcl_AppendResult (interp, buf, NULL); + } + fclose (apduf); + Tcl_AppendResult (interp, "}", NULL); + } + unlink ("apdu.tmp"); + return TCL_OK; } /* @@ -723,7 +814,7 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, p->preferredMessageSize = 30000; return TCL_OK; } - return get_set_int (&p->preferredMessageSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->preferredMessageSize, interp, argc, argv); } /* @@ -739,7 +830,7 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp, p->maximumRecordSize = 30000; return TCL_OK; } - return get_set_int (&p->maximumRecordSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->maximumRecordSize, interp, argc, argv); } /* @@ -752,7 +843,7 @@ static int do_initResult (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->initResult, interp, argc, argv); + return ir_tcl_get_set_int (&p->initResult, interp, argc, argv); } @@ -949,9 +1040,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, interp->result = "already connected"; return TCL_ERROR; } - if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) - return TCL_ERROR; - if (!strcmp (p->cs_type, "tcpip")) + if (!strcmp (p->comstackType, "tcpip")) { p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type); addr = tcpip_strtoaddr (argv[2]); @@ -962,7 +1051,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, } logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]); } - else if (!strcmp (p->cs_type, "mosi")) + else if (!strcmp (p->comstackType, "mosi")) { #if MOSI p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type); @@ -981,26 +1070,46 @@ static int do_connect (void *obj, Tcl_Interp *interp, else { Tcl_AppendResult (interp, "Bad comstack type: ", - p->cs_type, NULL); + p->comstackType, NULL); return TCL_ERROR; } + if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) + return TCL_ERROR; +#if IRTCL_GENERIC_FILES +#ifdef WINDOWS + p->csFile = Tcl_GetFile (cs_fileno(p->cs_link), TCL_WIN_SOCKET); +#else + p->csFile = Tcl_GetFile (cs_fileno(p->cs_link), TCL_UNIX_FD); +#endif +#endif if ((r=cs_connect (p->cs_link, addr)) < 0) { interp->result = "connect fail"; - do_disconnect (p, NULL, 2, NULL); + ir_tcl_disconnect (p); return TCL_ERROR; } + logf(LOG_DEBUG, "cs_connect() returned %d fd=%d", r, + cs_fileno(p->cs_link)); + p->eventType = "connect"; +#if IRTCL_GENERIC_FILES + ir_select_add (p->csFile, p); +#else ir_select_add (cs_fileno (p->cs_link), p); +#endif if (r == 1) { +#if IRTCL_GENERIC_FILES + ir_select_add_write (p->csFile, p); +#else ir_select_add_write (cs_fileno (p->cs_link), p); +#endif p->state = IR_TCL_R_Connecting; } else { p->state = IR_TCL_R_Idle; if (p->callback) - IrTcl_eval (p->interp, p->callback); + ir_tcl_eval (p->interp, p->callback); } } else @@ -1008,33 +1117,33 @@ static int do_connect (void *obj, Tcl_Interp *interp, return TCL_OK; } -/* - * do_disconnect: disconnect method on IR object +/* + * ir_tcl_disconnect: close connection */ -static int do_disconnect (void *obj, Tcl_Interp *interp, - int argc, char **argv) +void ir_tcl_disconnect (IrTcl_Obj *p) { - IrTcl_Obj *p = obj; - - if (argc == 0) - { - p->state = IR_TCL_R_Idle; - p->hostname = NULL; - p->cs_link = NULL; - return TCL_OK; - } if (p->hostname) { + logf(LOG_DEBUG, "Closing connection to %s", p->hostname); free (p->hostname); p->hostname = NULL; +#if IRTCL_GENERIC_FILES + ir_select_remove_write (p->csFile, p); + ir_select_remove (p->csFile, p); +#else ir_select_remove_write (cs_fileno (p->cs_link), p); ir_select_remove (cs_fileno (p->cs_link), p); +#endif odr_reset (p->odr_in); assert (p->cs_link); cs_close (p->cs_link); p->cs_link = NULL; +#if IRTCL_GENERIC_FILES + Tcl_FreeFile (p->csFile); + p->csFile = NULL; +#endif ODR_MASK_ZERO (&p->options); ODR_MASK_SET (&p->options, 0); @@ -1049,6 +1158,28 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, ir_tcl_del_q (p); } assert (!p->cs_link); +} + +/* + * do_disconnect: disconnect method on IR object + */ +static int do_disconnect (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->state = IR_TCL_R_Idle; + p->eventType = NULL; + p->hostname = NULL; + p->cs_link = NULL; +#if IRTCL_GENERIC_FILES + p->csFile = 0; +#endif + return TCL_OK; + } + ir_tcl_disconnect (p); return TCL_OK; } @@ -1061,16 +1192,16 @@ static int do_comstack (void *o, Tcl_Interp *interp, IrTcl_Obj *obj = o; if (argc == 0) - return ir_tcl_strdup (interp, &obj->cs_type, "tcpip"); + return ir_tcl_strdup (interp, &obj->comstackType, "tcpip"); else if (argc == -1) - return ir_tcl_strdel (interp, &obj->cs_type); + return ir_tcl_strdel (interp, &obj->comstackType); else if (argc == 3) { - free (obj->cs_type); - if (ir_tcl_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR) + free (obj->comstackType); + if (ir_tcl_strdup (interp, &obj->comstackType, argv[2]) == TCL_ERROR) return TCL_ERROR; } - Tcl_AppendElement (interp, obj->cs_type); + Tcl_AppendElement (interp, obj->comstackType); return TCL_OK; } @@ -1093,10 +1224,28 @@ static int do_logLevel (void *o, Tcl_Interp *interp, /* + * do_eventType: Return type of last event + */ +static int do_eventType (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + + if (argc <= 0) + { + p->eventType = NULL; + return TCL_OK; + } + Tcl_AppendElement (interp, p->eventType ? p->eventType : ""); + return TCL_OK; +} + + +/* * do_callback: add callback */ static int do_callback (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_Obj *p = obj; @@ -1151,6 +1300,34 @@ static int do_failback (void *obj, Tcl_Interp *interp, } /* + * do_initResponse: add init response handler + */ +static int do_initResponse (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->initResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->initResponse); + if (argc == 3) + { + free (p->initResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &p->initResponse, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + else + p->initResponse = NULL; + } + return TCL_OK; +} +/* * do_protocol: Set/get protocol method on IR object */ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv) @@ -1249,13 +1426,14 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, } p->num_databaseNames = argc - 2; p->databaseNames = - ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames); + ir_tcl_malloc (sizeof(*p->databaseNames) * (1+p->num_databaseNames)); for (i=0; inum_databaseNames; i++) { if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i]) == TCL_ERROR) return TCL_ERROR; } + p->databaseNames[i] = NULL; return TCL_OK; } @@ -1272,7 +1450,7 @@ static int do_replaceIndicator (void *obj, Tcl_Interp *interp, p->replaceIndicator = 1; return TCL_OK; } - return get_set_int (&p->replaceIndicator, interp, argc, argv); + return ir_tcl_get_set_int (&p->replaceIndicator, interp, argc, argv); } /* @@ -1329,7 +1507,7 @@ static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, p->smallSetUpperBound = 0; return TCL_OK; } - return get_set_int (&p->smallSetUpperBound, interp, argc, argv); + return ir_tcl_get_set_int (&p->smallSetUpperBound, interp, argc, argv); } /* @@ -1345,7 +1523,7 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, p->largeSetLowerBound = 2; return TCL_OK; } - return get_set_int (&p->largeSetLowerBound, interp, argc, argv); + return ir_tcl_get_set_int (&p->largeSetLowerBound, interp, argc, argv); } /* @@ -1361,7 +1539,7 @@ static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp, p->mediumSetPresentNumber = 0; return TCL_OK; } - return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); + return ir_tcl_get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); } /* @@ -1416,6 +1594,11 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, ir_tcl_malloc (sizeof(*p->preferredRecordSyntax)))) *p->preferredRecordSyntax = IrTcl_getRecordSyntaxVal (argv[2]); } + else if (argc == 2) + { + Tcl_AppendElement (interp, IrTcl_getRecordSyntaxStr + (*p->preferredRecordSyntax)); + } return TCL_OK; } @@ -1497,48 +1680,51 @@ static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp, return TCL_OK; } - static IrTcl_Method ir_method_tab[] = { -{ 1, "comstack", do_comstack }, -{ 1, "protocol", do_protocol }, -{ 0, "failback", do_failback }, -{ 0, "failInfo", do_failInfo }, -{ 0, "logLevel", do_logLevel }, - -{ 1, "connect", do_connect }, -{ 0, "protocolVersion", do_protocolVersion }, -{ 1, "preferredMessageSize", do_preferredMessageSize }, -{ 1, "maximumRecordSize", do_maximumRecordSize }, -{ 1, "implementationName", do_implementationName }, -{ 1, "implementationId", do_implementationId }, -{ 1, "implementationVersion", do_implementationVersion }, -{ 0, "targetImplementationName", do_targetImplementationName }, -{ 0, "targetImplementationId", do_targetImplementationId }, -{ 0, "targetImplementationVersion", do_targetImplementationVersion }, -{ 0, "userInformationField", do_userInformationField }, -{ 1, "idAuthentication", do_idAuthentication }, -{ 0, "options", do_options }, -{ 0, "init", do_init_request }, -{ 0, "initResult", do_initResult }, -{ 0, "disconnect", do_disconnect }, -{ 0, "callback", do_callback }, -{ 0, "triggerResourceControl", do_triggerResourceControl }, -{ 0, NULL, NULL} +{ "comstack", do_comstack, NULL }, +{ "protocol", do_protocol, NULL }, +{ "failback", do_failback, NULL }, +{ "failInfo", do_failInfo, NULL }, +{ "apduInfo", do_apduInfo, NULL }, +{ "logLevel", do_logLevel, NULL }, + +{ "eventType", do_eventType, NULL }, +{ "connect", do_connect, NULL }, +{ "protocolVersion", do_protocolVersion, NULL }, +{ "preferredMessageSize", do_preferredMessageSize, NULL }, +{ "maximumRecordSize", do_maximumRecordSize, NULL }, +{ "implementationName", do_implementationName, NULL }, +{ "implementationId", do_implementationId, NULL }, +{ "implementationVersion", do_implementationVersion, NULL }, +{ "targetImplementationName", do_targetImplementationName, NULL }, +{ "targetImplementationId", do_targetImplementationId, NULL }, +{ "targetImplementationVersion", do_targetImplementationVersion, NULL}, +{ "userInformationField", do_userInformationField, NULL}, +{ "idAuthentication", do_idAuthentication, NULL}, +{ "options", do_options, NULL}, +{ "init", do_init_request, NULL}, +{ "initResult", do_initResult, NULL}, +{ "disconnect", do_disconnect, NULL}, +{ "callback", do_callback, NULL}, +{ "initResponse", do_initResponse, NULL}, +{ "triggerResourceControl", do_triggerResourceControl, NULL}, +{ "initResponse", do_initResponse, NULL}, +{ NULL, NULL} }; static IrTcl_Method ir_set_c_method_tab[] = { -{ 0, "databaseNames", do_databaseNames}, -{ 0, "replaceIndicator", do_replaceIndicator}, -{ 0, "queryType", do_queryType }, -{ 0, "preferredRecordSyntax", do_preferredRecordSyntax }, -{ 0, "smallSetUpperBound", do_smallSetUpperBound}, -{ 0, "largeSetLowerBound", do_largeSetLowerBound}, -{ 0, "mediumSetPresentNumber", do_mediumSetPresentNumber}, -{ 0, "referenceId", do_referenceId }, -{ 0, "elementSetNames", do_elementSetNames }, -{ 0, "smallSetElementSetNames", do_smallSetElementSetNames }, -{ 0, "mediumSetElementSetNames", do_mediumSetElementSetNames }, -{ 0, NULL, NULL} +{ "databaseNames", do_databaseNames, NULL}, +{ "replaceIndicator", do_replaceIndicator, NULL}, +{ "queryType", do_queryType, NULL}, +{ "preferredRecordSyntax", do_preferredRecordSyntax, NULL}, +{ "smallSetUpperBound", do_smallSetUpperBound, NULL}, +{ "largeSetLowerBound", do_largeSetLowerBound, NULL}, +{ "mediumSetPresentNumber", do_mediumSetPresentNumber, NULL}, +{ "referenceId", do_referenceId, NULL}, +{ "elementSetNames", do_elementSetNames, NULL}, +{ "smallSetElementSetNames", do_smallSetElementSetNames, NULL}, +{ "mediumSetElementSetNames", do_mediumSetElementSetNames, NULL}, +{ NULL, NULL} }; /* @@ -1549,17 +1735,19 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, { IrTcl_Methods tab[3]; IrTcl_Obj *p = clientData; + int r; if (argc < 2) - return ir_method_r (clientData, interp, argc, argv, ir_method_tab); - + return TCL_ERROR; + tab[0].tab = ir_method_tab; tab[0].obj = p; tab[1].tab = ir_set_c_method_tab; tab[1].obj = &p->set_inher; tab[2].tab = NULL; - - return ir_method (interp, argc, argv, tab); + + ir_tcl_method (interp, argc, argv, tab, &r); + return r; } /* @@ -1582,7 +1770,7 @@ static void ir_obj_delete (ClientData clientData) tab[1].obj = &obj->set_inher; tab[2].tab = NULL; - ir_method (NULL, -1, NULL, tab); + ir_tcl_method (NULL, -1, NULL, tab, NULL); ir_tcl_del_q (obj); odr_destroy (obj->odr_in); @@ -1592,10 +1780,11 @@ static void ir_obj_delete (ClientData clientData) } /* - * ir_obj_mk: IR Object creation + * ir_obj_init: IR Object initialization */ -static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +int ir_obj_init (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) { IrTcl_Methods tab[3]; IrTcl_Obj *obj; @@ -1619,7 +1808,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } #endif - logf (LOG_DEBUG, "ir object create"); + logf (LOG_DEBUG, "ir object create %s", argv[1]); obj->odr_in = odr_createmem (ODR_DECODE); obj->odr_out = odr_createmem (ODR_ENCODE); obj->odr_pr = odr_createmem (ODR_PRINT); @@ -1636,13 +1825,40 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, tab[1].obj = &obj->set_inher; tab[2].tab = NULL; - if (ir_method (interp, 0, NULL, tab) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR) + { + Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL); + return TCL_ERROR; + } + *subData = obj; + return TCL_OK; +} + + +/* + * ir_obj_mk: IR Object creation + */ +static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + ClientData subData; + int r = ir_obj_init (clientData, interp, argc, argv, &subData, 0); + + if (r == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_obj_method, - (ClientData) obj, ir_obj_delete); + subData, ir_obj_delete); return TCL_OK; } +IrTcl_Class ir_obj_class = { + "ir", + ir_obj_init, + ir_obj_method, + ir_obj_delete +}; + + /* ------------------------------------------------------- */ /* * do_search: Do search request @@ -1683,7 +1899,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) obj->start = 1; bib1.proto = p->protocol_type; - bib1.class = CLASS_ATTSET; + bib1.oclass = CLASS_ATTSET; bib1.value = VAL_BIB1; set_referenceId (p->odr_out, &req->referenceId, @@ -1704,7 +1920,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) struct oident ident; ident.proto = p->protocol_type; - ident.class = CLASS_RECSYN; + ident.oclass = CLASS_RECSYN; ident.value = *obj->set_inher.preferredRecordSyntax; logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value); req->preferredRecordSyntax = odr_oiddup (p->odr_out, @@ -1791,7 +2007,67 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) interp->result = "unknown query method"; return TCL_ERROR; } - return ir_tcl_send_APDU (interp, p, apdu, "search", argv[0]); + return ir_tcl_send_APDU (interp, p, apdu, "search", *argv); +} + +/* + * do_searchResponse: add search response handler + */ +static int do_searchResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->searchResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->searchResponse); + if (argc == 3) + { + free (obj->searchResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->searchResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->searchResponse = NULL; + } + return TCL_OK; +} + +/* + * do_presentResponse: add present response handler + */ +static int do_presentResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->presentResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->presentResponse); + if (argc == 3) + { + free (obj->presentResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->presentResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->presentResponse = NULL; + } + return TCL_OK; } /* @@ -1803,8 +2079,11 @@ static int do_resultCount (void *o, Tcl_Interp *interp, IrTcl_SetObj *obj = o; if (argc <= 0) + { + obj->resultCount = 0; return TCL_OK; - return get_set_int (&obj->resultCount, interp, argc, argv); + } + return ir_tcl_get_set_int (&obj->resultCount, interp, argc, argv); } /* @@ -1817,7 +2096,7 @@ static int do_searchStatus (void *o, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&obj->searchStatus, interp, argc, argv); + return ir_tcl_get_set_int (&obj->searchStatus, interp, argc, argv); } /* @@ -1830,7 +2109,7 @@ static int do_presentStatus (void *o, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&obj->presentStatus, interp, argc, argv); + return ir_tcl_get_set_int (&obj->presentStatus, interp, argc, argv); } /* @@ -1847,7 +2126,8 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp, obj->nextResultSetPosition = 0; return TCL_OK; } - return get_set_int (&obj->nextResultSetPosition, interp, argc, argv); + return ir_tcl_get_set_int (&obj->nextResultSetPosition, interp, + argc, argv); } /* @@ -1886,7 +2166,8 @@ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp, obj->numberOfRecordsReturned = 0; return TCL_OK; } - return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv); + return ir_tcl_get_set_int (&obj->numberOfRecordsReturned, interp, + argc, argv); } /* @@ -2257,7 +2538,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) struct oident ident; ident.proto = p->protocol_type; - ident.class = CLASS_RECSYN; + ident.oclass = CLASS_RECSYN; ident.value = *obj->set_inher.preferredRecordSyntax; logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value); req->preferredRecordSyntax = odr_oiddup (p->odr_out, @@ -2280,7 +2561,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) } else req->recordComposition = NULL; - return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]); + return ir_tcl_send_APDU (interp, p, apdu, "present", *argv); } /* @@ -2325,24 +2606,26 @@ static int do_loadFile (void *o, Tcl_Interp *interp, } static IrTcl_Method ir_set_method_tab[] = { - { 0, "search", do_search }, - { 0, "searchStatus", do_searchStatus }, - { 0, "presentStatus", do_presentStatus }, - { 0, "nextResultSetPosition", do_nextResultSetPosition }, - { 0, "setName", do_setName }, - { 0, "resultCount", do_resultCount }, - { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned }, - { 0, "present", do_present }, - { 0, "type", do_type }, - { 0, "getMarc", do_getMarc }, - { 0, "getSutrs", do_getSutrs }, - { 0, "getGrs", do_getGrs }, - { 0, "recordType", do_recordType }, - { 0, "recordElements", do_recordElements }, - { 0, "diag", do_diag }, - { 0, "responseStatus", do_responseStatus }, - { 0, "loadFile", do_loadFile }, - { 0, NULL, NULL} + { "search", do_search, NULL}, + { "searchResponse", do_searchResponse, NULL}, + { "presentResponse", do_presentResponse, NULL}, + { "searchStatus", do_searchStatus, NULL}, + { "presentStatus", do_presentStatus, NULL}, + { "nextResultSetPosition", do_nextResultSetPosition, NULL}, + { "setName", do_setName, NULL}, + { "resultCount", do_resultCount, NULL}, + { "numberOfRecordsReturned", do_numberOfRecordsReturned, NULL}, + { "present", do_present, NULL}, + { "type", do_type, NULL}, + { "getMarc", do_getMarc, NULL}, + { "getSutrs", do_getSutrs, NULL}, + { "getGrs", do_getGrs, NULL}, + { "recordType", do_recordType, NULL}, + { "recordElements", do_recordElements, NULL}, + { "diag", do_diag, NULL}, + { "responseStatus", do_responseStatus, NULL}, + { "loadFile", do_loadFile, NULL}, + { NULL, NULL} }; /* @@ -2353,6 +2636,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, { IrTcl_Methods tabs[3]; IrTcl_SetObj *p = clientData; + int r; if (argc < 2) { @@ -2365,7 +2649,8 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, tabs[1].obj = &p->set_inher; tabs[2].tab = NULL; - return ir_method (interp, argc, argv, tabs); + ir_tcl_method (interp, argc, argv, tabs, &r); + return r; } /* @@ -2384,16 +2669,17 @@ static void ir_set_obj_delete (ClientData clientData) tabs[1].obj = &p->set_inher; tabs[2].tab = NULL; - ir_method (NULL, -1, NULL, tabs); + ir_tcl_method (NULL, -1, NULL, tabs, NULL); free (p); } /* - * ir_set_obj_mk: IR Set Object creation + * ir_set_obj_init: IR Set Object initialization */ -static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) { IrTcl_Methods tabs[3]; IrTcl_SetObj *obj; @@ -2405,33 +2691,30 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, } obj = ir_tcl_malloc (sizeof(*obj)); logf (LOG_DEBUG, "ir set create"); - if (argc == 3) + if (parentData) { - Tcl_CmdInfo parent_info; int i; IrTcl_SetCObj *dst; IrTcl_SetCObj *src; - if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) - { - interp->result = "No parent"; - return TCL_ERROR; - } - obj->parent = (IrTcl_Obj *) parent_info.clientData; + obj->parent = (IrTcl_Obj *) parentData; dst = &obj->set_inher; src = &obj->parent->set_inher; if ((dst->num_databaseNames = src->num_databaseNames)) + { dst->databaseNames = ir_tcl_malloc (sizeof (*dst->databaseNames) - * dst->num_databaseNames); + * (1+dst->num_databaseNames)); + for (i = 0; i < dst->num_databaseNames; i++) + if (ir_tcl_strdup (interp, &dst->databaseNames[i], + src->databaseNames[i]) == TCL_ERROR) + return TCL_ERROR; + dst->databaseNames[i] = NULL; + } else dst->databaseNames = NULL; - for (i = 0; i < dst->num_databaseNames; i++) - if (ir_tcl_strdup (interp, &dst->databaseNames[i], - src->databaseNames[i]) == TCL_ERROR) - return TCL_ERROR; if (ir_tcl_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; @@ -2472,14 +2755,48 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = obj; tabs[1].tab = NULL; - if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; + *subData = obj; + return TCL_OK; +} + +/* + * ir_set_obj_mk: IR Set Object creation + */ +static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + ClientData subData; + ClientData parentData = 0; + int r; + + if (argc == 3) + { + Tcl_CmdInfo parent_info; + if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) + { + interp->result = "No parent"; + return TCL_ERROR; + } + parentData = parent_info.clientData; + } + r = ir_set_obj_init (clientData, interp, argc, argv, &subData, parentData); + if (r == TCL_ERROR) + return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_set_obj_method, - (ClientData) obj, ir_set_obj_delete); + subData, ir_set_obj_delete); return TCL_OK; } +IrTcl_Class ir_set_obj_class = { + "ir-set", + ir_set_obj_init, + ir_set_obj_method, + ir_set_obj_delete +}; + /* ------------------------------------------------------- */ /* @@ -2516,7 +2833,7 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) } bib1.proto = p->protocol_type; - bib1.class = CLASS_ATTSET; + bib1.oclass = CLASS_ATTSET; bib1.value = VAL_BIB1; apdu = zget_APDU (p->odr_out, Z_APDU_scanRequest); @@ -2554,7 +2871,37 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) logf (LOG_DEBUG, "preferredPositionInResponse=%d", *req->preferredPositionInResponse); - return ir_tcl_send_APDU (interp, p, apdu, "scan", argv[0]); + return ir_tcl_send_APDU (interp, p, apdu, "scan", *argv); +} + +/* + * do_scanResponse: add scan response handler + */ +static int do_scanResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_ScanObj *obj = o; + + if (argc == 0) + { + obj->scanResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->scanResponse); + if (argc == 3) + { + free (obj->scanResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->scanResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->scanResponse = NULL; + } + return TCL_OK; } /* @@ -2569,7 +2916,7 @@ static int do_stepSize (void *obj, Tcl_Interp *interp, p->stepSize = 0; return TCL_OK; } - return get_set_int (&p->stepSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->stepSize, interp, argc, argv); } /* @@ -2585,7 +2932,7 @@ static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp, p->numberOfTermsRequested = 20; return TCL_OK; } - return get_set_int (&p->numberOfTermsRequested, interp, argc, argv); + return ir_tcl_get_set_int (&p->numberOfTermsRequested, interp, argc, argv); } @@ -2602,7 +2949,8 @@ static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp, p->preferredPositionInResponse = 1; return TCL_OK; } - return get_set_int (&p->preferredPositionInResponse, interp, argc, argv); + return ir_tcl_get_set_int (&p->preferredPositionInResponse, interp, + argc, argv); } /* @@ -2615,7 +2963,7 @@ static int do_scanStatus (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->scanStatus, interp, argc, argv); + return ir_tcl_get_set_int (&p->scanStatus, interp, argc, argv); } /* @@ -2628,7 +2976,8 @@ static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv); + return ir_tcl_get_set_int (&p->numberOfEntriesReturned, interp, + argc, argv); } /* @@ -2641,7 +2990,7 @@ static int do_positionOfTerm (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->positionOfTerm, interp, argc, argv); + return ir_tcl_get_set_int (&p->positionOfTerm, interp, argc, argv); } /* @@ -2702,15 +3051,16 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv) } static IrTcl_Method ir_scan_method_tab[] = { - { 0, "scan", do_scan }, - { 0, "stepSize", do_stepSize }, - { 0, "numberOfTermsRequested", do_numberOfTermsRequested }, - { 0, "preferredPositionInResponse", do_preferredPositionInResponse }, - { 0, "scanStatus", do_scanStatus }, - { 0, "numberOfEntriesReturned", do_numberOfEntriesReturned }, - { 0, "positionOfTerm", do_positionOfTerm }, - { 0, "scanLine", do_scanLine }, - { 0, NULL, NULL} + { "scan", do_scan, NULL}, + { "scanResponse", do_scanResponse, NULL}, + { "stepSize", do_stepSize, NULL}, + { "numberOfTermsRequested", do_numberOfTermsRequested, NULL}, + { "preferredPositionInResponse", do_preferredPositionInResponse, NULL}, + { "scanStatus", do_scanStatus, NULL}, + { "numberOfEntriesReturned", do_numberOfEntriesReturned, NULL}, + { "positionOfTerm", do_positionOfTerm, NULL}, + { "scanLine", do_scanLine, NULL}, + { NULL, NULL} }; /* @@ -2720,6 +3070,7 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tabs[2]; + int r; if (argc < 2) { @@ -2730,7 +3081,8 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = clientData; tabs[1].tab = NULL; - return ir_method (interp, argc, argv, tabs); + ir_tcl_method (interp, argc, argv, tabs, &r); + return r; } /* @@ -2745,7 +3097,7 @@ static void ir_scan_obj_delete (ClientData clientData) tabs[0].obj = obj; tabs[1].tab = NULL; - ir_method (NULL, -1, NULL, tabs); + ir_tcl_method (NULL, -1, NULL, tabs, NULL); free (obj); } @@ -2776,7 +3128,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = obj; tabs[1].tab = NULL; - if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method, (ClientData) obj, ir_scan_obj_delete); @@ -2939,7 +3291,7 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, else if (rl->u.dbrec.type == VAL_GRS1 && oe->which == Z_External_grs1) { - ir_tcl_read_grs (oe->u.grs1, &rl->u.dbrec.u.grs1); + ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1); rl->u.dbrec.buf = NULL; } else @@ -3119,7 +3471,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs, /* * ir_select_read: handle incoming packages */ -void ir_select_read (ClientData clientData) +static void ir_select_read (ClientData clientData) { IrTcl_Obj *p = clientData; Z_APDU *apdu; @@ -3127,9 +3479,12 @@ void ir_select_read (ClientData clientData) IrTcl_Request *rq; char *object_name; Tcl_CmdInfo cmd_info; + const char *apdu_call; + logf(LOG_DEBUG, "Read handler fd=%d", cs_fileno(p->cs_link)); if (p->state == IR_TCL_R_Connecting) { + logf(LOG_DEBUG, "Connect handler"); r = cs_rcvconnect (p->cs_link); if (r == 1) { @@ -3137,65 +3492,84 @@ void ir_select_read (ClientData clientData) return; } p->state = IR_TCL_R_Idle; + p->ref_count = 2; +#if IRTCL_GENERIC_FILES + ir_select_remove_write (p->csFile, p); +#else ir_select_remove_write (cs_fileno (p->cs_link), p); +#endif if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_CONNECT; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); + ir_obj_delete (p); return; } - p->state = IR_TCL_R_Idle; if (p->callback) - IrTcl_eval (p->interp, p->callback); - if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle) + ir_tcl_eval (p->interp, p->callback); + if (p->ref_count == 2 && p->cs_link && p->request_queue + && p->state == IR_TCL_R_Idle) ir_tcl_send_q (p, p->request_queue, "x"); + ir_obj_delete (p); return; } do { - /* signal one more use of ir object - callbacks must not - release the ir memory (p pointer) */ p->state = IR_TCL_R_Reading; - ++(p->ref_count); /* read incoming APDU */ - if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0) + if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) == 1) + { + logf(LOG_DEBUG, "PDU Fraction read"); + return ; + } + /* signal one more use of ir object - callbacks must not + release the ir memory (p pointer) */ + p->ref_count = 2; + if (r <= 0) { logf (LOG_DEBUG, "cs_get failed, code %d", r); +#if IRTCL_GENERIC_FILES + ir_select_remove (p->csFile, p); +#else ir_select_remove (cs_fileno (p->cs_link), p); - do_disconnect (p, NULL, 2, NULL); +#endif + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_READ; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } /* release ir object now if callback deleted it */ ir_obj_delete (p); return; } - if (r == 1) - return ; /* got complete APDU. Now decode */ + p->apduLen = r; + p->apduOffset = -1; odr_setbuf (p->odr_in, p->buf_in, r, 0); - logf (LOG_DEBUG, "cs_get ok, got %d", r); + logf (LOG_DEBUG, "cs_get ok, total size %d", r); if (!z_APDU (p->odr_in, &apdu, 0)) { - logf (LOG_DEBUG, "%s", odr_errmsg (odr_geterror (p->odr_in))); - do_disconnect (p, NULL, 2, NULL); + logf (LOG_DEBUG, "cs_get failed: %s", + odr_errmsg (odr_geterror (p->odr_in))); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_IN_APDU; - IrTcl_eval (p->interp, p->failback); + p->apduOffset = odr_offset (p->odr_in); + ir_tcl_eval (p->interp, p->failback); } /* release ir object now if failback deleted it */ ir_obj_delete (p); return; } + logf(LOG_DEBUG, "Decoded ok"); /* handle APDU and invoke callback */ rq = p->request_queue; if (!rq) @@ -3205,42 +3579,56 @@ void ir_select_read (ClientData clientData) } object_name = rq->object_name; logf (LOG_DEBUG, "getCommandInfo (%s)", object_name); + apdu_call = NULL; if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info)) { switch(apdu->which) { case Z_APDU_initResponse: + p->eventType = "init"; ir_initResponse (p, apdu->u.initResponse); + apdu_call = p->initResponse; break; case Z_APDU_searchResponse: + p->eventType = "search"; ir_searchResponse (p, apdu->u.searchResponse, (IrTcl_SetObj *) cmd_info.clientData); + apdu_call = ((IrTcl_SetObj *) + cmd_info.clientData)->searchResponse; break; case Z_APDU_presentResponse: + p->eventType = "present"; ir_presentResponse (p, apdu->u.presentResponse, (IrTcl_SetObj *) cmd_info.clientData); + apdu_call = ((IrTcl_SetObj *) + cmd_info.clientData)->presentResponse; break; case Z_APDU_scanResponse: + p->eventType = "scan"; ir_scanResponse (p, apdu->u.scanResponse, (IrTcl_ScanObj *) cmd_info.clientData); + apdu_call = ((IrTcl_ScanObj *) + cmd_info.clientData)->scanResponse; break; default: logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); - do_disconnect (p, NULL, 2, NULL); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } return; } } p->request_queue = rq->next; p->state = IR_TCL_R_Idle; - - if (rq->callback) - IrTcl_eval (p->interp, rq->callback); + + if (apdu_call) + ir_tcl_eval (p->interp, apdu_call); + else if (rq->callback) + ir_tcl_eval (p->interp, rq->callback); free (rq->buf_out); free (rq->callback); free (rq->object_name); @@ -3251,7 +3639,7 @@ void ir_select_read (ClientData clientData) ir_obj_delete (p); return; } - --(p->ref_count); + ir_obj_delete (p); } while (p->cs_link && cs_more (p->cs_link)); if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle) ir_tcl_send_q (p, p->request_queue, "x"); @@ -3260,34 +3648,44 @@ void ir_select_read (ClientData clientData) /* * ir_select_write: handle outgoing packages - not yet written. */ -void ir_select_write (ClientData clientData) +static void ir_select_write (ClientData clientData) { IrTcl_Obj *p = clientData; int r; IrTcl_Request *rq; - logf (LOG_DEBUG, "In write handler"); + logf (LOG_DEBUG, "Write handler fd=%d", cs_fileno(p->cs_link)); if (p->state == IR_TCL_R_Connecting) { + logf(LOG_DEBUG, "Connect handler"); r = cs_rcvconnect (p->cs_link); if (r == 1) + { + logf (LOG_DEBUG, "cs_rcvconnect returned 1"); return; + } p->state = IR_TCL_R_Idle; + p->ref_count = 2; +#if IRTCL_GENERIC_FILES + ir_select_remove_write (p->csFile, p); +#else + ir_select_remove_write (cs_fileno (p->cs_link), p); +#endif if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); - ir_select_remove_write (cs_fileno (p->cs_link), p); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_CONNECT; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); + ir_obj_delete (p); return; } - ir_select_remove_write (cs_fileno (p->cs_link), p); if (p->callback) - IrTcl_eval (p->interp, p->callback); + ir_tcl_eval (p->interp, p->callback); + ir_obj_delete (p); return; } rq = p->request_queue; @@ -3296,25 +3694,40 @@ void ir_select_write (ClientData clientData) assert (rq); if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0) { - logf (LOG_DEBUG, "select write fail"); + logf (LOG_DEBUG, "cs_put write fail"); + p->ref_count = 2; + free (rq->buf_out); + rq->buf_out = NULL; + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_WRITE; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - free (rq->buf_out); - rq->buf_out = NULL; - do_disconnect (p, NULL, 2, NULL); + ir_obj_delete (p); } else if (r == 0) /* remove select bit */ { + logf (LOG_DEBUG, "Write completed"); p->state = IR_TCL_R_Waiting; +#if IRTCL_GENERIC_FILES + ir_select_remove_write (p->csFile, p); +#else ir_select_remove_write (cs_fileno (p->cs_link), p); +#endif free (rq->buf_out); rq->buf_out = NULL; } } +static void ir_select_notify (ClientData clientData, int r, int w, int e) +{ + if (r) + ir_select_read (clientData); + if (w) + ir_select_write (clientData); +} + /* ------------------------------------------------------- */ /*