X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=3cc11494ae091d28a30265cca07b1e277b173917;hb=6587da870cbefb34e9d7c05ed4b42ffedfab1750;hp=e52a1c02f0f3aab8caaaede837f6c941da3f3f79;hpb=3add7ff834c7a01f3bf1e9c8a74dc3199d1970e6;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index e52a1c0..3cc1149 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,35 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.66 1995-11-28 17:26:39 adam + * 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,11 +264,8 @@ #include #include -#ifdef WINDOWS +#include #include -#else -#include -#endif #include #define CS_BLOCK 0 @@ -594,7 +619,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); } /* @@ -669,6 +694,54 @@ static int do_options (void *obj, Tcl_Interp *interp, } /* + * 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; +} + +/* * do_failInfo: Get fail information */ static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv) @@ -951,7 +1024,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, } 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 +1035,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,19 +1054,36 @@ 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 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); return TCL_ERROR; } + logf(LOG_DEBUG, "cs_connect() returned %d", r); + 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 @@ -1019,22 +1109,36 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, 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; } if (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); + logf(LOG_DEBUG, "Closing connection"); 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); @@ -1061,16 +1165,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 +1197,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 +1273,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) @@ -1497,14 +1647,15 @@ 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, "apduInfo", do_apduInfo }, { 0, "logLevel", do_logLevel }, +{ 0, "eventType", do_eventType }, { 1, "connect", do_connect }, { 0, "protocolVersion", do_protocolVersion }, { 1, "preferredMessageSize", do_preferredMessageSize }, @@ -1522,7 +1673,9 @@ static IrTcl_Method ir_method_tab[] = { { 0, "initResult", do_initResult }, { 0, "disconnect", do_disconnect }, { 0, "callback", do_callback }, +{ 0, "initResponse", do_initResponse }, { 0, "triggerResourceControl", do_triggerResourceControl }, +{ 0, "initResponse", do_initResponse }, { 0, NULL, NULL} }; @@ -1683,7 +1836,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 +1857,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 +1944,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; } /* @@ -2257,7 +2470,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 +2493,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); } /* @@ -2326,6 +2539,8 @@ static int do_loadFile (void *o, Tcl_Interp *interp, static IrTcl_Method ir_set_method_tab[] = { { 0, "search", do_search }, + { 0, "searchResponse", do_searchResponse }, + { 0, "presentResponse", do_presentResponse }, { 0, "searchStatus", do_searchStatus }, { 0, "presentStatus", do_presentStatus }, { 0, "nextResultSetPosition", do_nextResultSetPosition }, @@ -2516,7 +2731,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 +2769,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; } /* @@ -2703,6 +2948,7 @@ 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, "scanResponse", do_scanResponse }, { 0, "stepSize", do_stepSize }, { 0, "numberOfTermsRequested", do_numberOfTermsRequested }, { 0, "preferredPositionInResponse", do_preferredPositionInResponse }, @@ -3127,9 +3373,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"); if (p->state == IR_TCL_R_Connecting) { + logf(LOG_DEBUG, "Connect handler"); r = cs_rcvconnect (p->cs_link); if (r == 1) { @@ -3137,7 +3386,11 @@ void ir_select_read (ClientData clientData) return; } p->state = IR_TCL_R_Idle; +#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"); @@ -3167,7 +3420,11 @@ void ir_select_read (ClientData clientData) if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 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); +#endif do_disconnect (p, NULL, 2, NULL); if (p->failback) { @@ -3179,23 +3436,31 @@ void ir_select_read (ClientData clientData) return; } if (r == 1) + { + logf(LOG_DEBUG, "PDU Fraction read"); 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))); + logf (LOG_DEBUG, "cs_get failed: %s", + odr_errmsg (odr_geterror (p->odr_in))); do_disconnect (p, NULL, 2, NULL); if (p->failback) { p->failInfo = IR_TCL_FAIL_IN_APDU; + p->apduOffset = odr_offset (p->odr_in); IrTcl_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,24 +3470,36 @@ 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)", @@ -3238,8 +3515,10 @@ void ir_select_read (ClientData clientData) } p->request_queue = rq->next; p->state = IR_TCL_R_Idle; - - if (rq->callback) + + if (apdu_call) + IrTcl_eval (p->interp, apdu_call); + else if (rq->callback) IrTcl_eval (p->interp, rq->callback); free (rq->buf_out); free (rq->callback); @@ -3266,9 +3545,10 @@ void ir_select_write (ClientData clientData) int r; IrTcl_Request *rq; - logf (LOG_DEBUG, "In write handler"); + logf (LOG_DEBUG, "Write handler"); if (p->state == IR_TCL_R_Connecting) { + logf(LOG_DEBUG, "Connect handler"); r = cs_rcvconnect (p->cs_link); if (r == 1) return; @@ -3276,7 +3556,11 @@ void ir_select_write (ClientData clientData) if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); +#if IRTCL_GENERIC_FILES + ir_select_remove_write (p->csFile, p); +#else ir_select_remove_write (cs_fileno (p->cs_link), p); +#endif if (p->failback) { p->failInfo = IR_TCL_FAIL_CONNECT; @@ -3285,7 +3569,11 @@ void ir_select_write (ClientData clientData) do_disconnect (p, NULL, 2, NULL); return; } +#if IRTCL_GENERIC_FILES + ir_select_remove_write (p->csFile, p); +#else ir_select_remove_write (cs_fileno (p->cs_link), p); +#endif if (p->callback) IrTcl_eval (p->interp, p->callback); return; @@ -3296,7 +3584,7 @@ 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"); if (p->failback) { p->failInfo = IR_TCL_FAIL_WRITE; @@ -3308,8 +3596,13 @@ void ir_select_write (ClientData clientData) } 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; }