New method: apduDump - returns information about last incoming APDU.
[ir-tcl-moved-to-github.git] / ir-tcl.c
index 7f07d79..ac51f66 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,15 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.69  1996-01-04 16:12:12  adam
+ * 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
 
 #include <stdlib.h>
 #include <stdio.h>
+#include <unistd.h>
 #ifdef WINDOWS
 #include <time.h>
 #else
@@ -604,7 +613,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);
 }
 
 /*
@@ -679,6 +688,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)
@@ -1181,6 +1238,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)
@@ -1532,6 +1617,7 @@ static IrTcl_Method ir_method_tab[] = {
 { 1, "protocol",                    do_protocol },
 { 0, "failback",                    do_failback },
 { 0, "failInfo",                    do_failInfo },
+{ 0, "apduInfo",                    do_apduInfo },
 { 0, "logLevel",                    do_logLevel },
 
 { 0, "eventType",                   do_eventType },
@@ -1552,7 +1638,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}
 };
 
@@ -1821,7 +1909,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;
 }
 
 /*
@@ -2310,7 +2458,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);
 }
 
 /*
@@ -2356,6 +2504,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 },
@@ -2584,7 +2734,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;
 }
 
 /*
@@ -2733,6 +2913,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 },
@@ -3157,6 +3338,7 @@ void ir_select_read (ClientData clientData)
     IrTcl_Request *rq;
     char *object_name;
     Tcl_CmdInfo cmd_info;
+    const char *apdu_call;
 
     if (p->state == IR_TCL_R_Connecting)
     {
@@ -3211,6 +3393,8 @@ void ir_select_read (ClientData clientData)
         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);
         if (!z_APDU (p->odr_in, &apdu, 0))
@@ -3220,6 +3404,7 @@ void ir_select_read (ClientData clientData)
             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 */
@@ -3235,6 +3420,7 @@ 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)
@@ -3242,21 +3428,28 @@ void ir_select_read (ClientData clientData)
             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)",
@@ -3272,8 +3465,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);