* 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.
*
#include <stdlib.h>
#include <stdio.h>
-#ifdef WINDOWS
+#include <unistd.h>
#include <time.h>
-#else
-#include <sys/time.h>
-#endif
#include <assert.h>
#define CS_BLOCK 0
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);
}
/*
}
/*
+ * 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)
}
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]);
}
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);
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
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);
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;
}
/*
+ * 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;
}
/*
+ * 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)
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 },
{ 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}
};
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,
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,
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;
}
/*
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,
}
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);
}
/*
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 },
}
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);
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;
}
/*
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 },
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)
{
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");
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)
{
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)
}
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)",
}
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);
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;
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;
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;
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;
}
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;
}
projects / ir-tcl-moved-to-github.git / blobdiff