Ported ir-tcl to use the beta releases of tcl7.5/tk4.1.
[ir-tcl-moved-to-github.git] / ir-tcl.c
index ac51f66..3cc1149 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,17 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.71  1996-01-19 16:22:38  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
 #include <stdlib.h>
 #include <stdio.h>
 #include <unistd.h>
-#ifdef WINDOWS
 #include <time.h>
-#else
-#include <sys/time.h>
-#endif
 #include <assert.h>
 
 #define CS_BLOCK 0
@@ -1018,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]);
@@ -1029,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);
@@ -1048,20 +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
@@ -1090,20 +1112,33 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
         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);
@@ -1130,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;
 }
 
@@ -3340,8 +3375,10 @@ void ir_select_read (ClientData clientData)
     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)
         {
@@ -3349,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");
@@ -3379,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)
             {
@@ -3391,15 +3436,19 @@ 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)
             {
@@ -3411,6 +3460,7 @@ void ir_select_read (ClientData clientData)
             ir_obj_delete (p);
             return;
         }
+       logf(LOG_DEBUG, "Decoded ok");
         /* handle APDU and invoke callback */
         rq = p->request_queue;
         if (!rq)
@@ -3495,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;
@@ -3505,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;
@@ -3514,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;
@@ -3525,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;
@@ -3537,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;
     }