New setting: failInfo.

[ir-tcl-moved-to-github.git] / ir-tcl.c

diff --git a/ir-tcl.c b/ir-tcl.c
index 5569990..d2c1881 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,22 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.41  1995-06-16 12:28:16  adam
+ * Revision 1.45  1995-06-20 08:07:30  adam
+ * New setting: failInfo.
+ * Working on better cancel mechanism.
+ *
+ * Revision 1.44  1995/06/19  17:01:20  adam
+ * Minor changes.
+ *
+ * Revision 1.43  1995/06/19  13:06:08  adam
+ * New define: IR_TCL_VERSION.
+ *
+ * Revision 1.42  1995/06/19  08:08:52  adam
+ * client.tcl: hotTargets now contain both database and target name.
+ * ir-tcl.c: setting protocol edited. Errors in callbacks are logged
+ * by logf(LOG_WARN, ...) calls.
+ *
+ * Revision 1.41  1995/06/16  12:28:16  adam
  * Implemented preferredRecordSyntax.
  * Minor changes in diagnostic handling.
  * Record list deleted when connection closes.
@@ -158,6 +173,8 @@ typedef struct {
     IrTcl_Method *tab;
 } IrTcl_Methods;
 
+static Tcl_Interp *irTcl_interp;
+
 static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
 static int do_disconnect (void *obj, Tcl_Interp *interp, 
                           int argc, char **argv);
@@ -235,6 +252,10 @@ int IrTcl_eval (Tcl_Interp *interp, const char *command)
     }
     strcpy (tmp, command);
     r = Tcl_Eval (interp, tmp);
+    if (r == TCL_ERROR)
+        logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, 
+              interp->result);
+    Tcl_FreeResult (interp);
     free (tmp);
     return r;
 }
@@ -564,13 +585,8 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
                                int argc, char **argv)
 {
-    static struct ir_named_entry version_tab[] = {
-    { "1", 0 },
-    { "2", 1 },
-    { "3", 2 },
-    { "4", 3 },
-    { NULL,0}
-    };
+    int version, i;
+    char buf[10];
     IrTcl_Obj *p = obj;
 
     if (argc <= 0)
@@ -580,8 +596,20 @@ static int do_protocolVersion (void *obj, Tcl_Interp *interp,
        ODR_MASK_SET (&p->protocolVersion, 1);
         return TCL_OK;
     }
-    return ir_named_bits (version_tab, &p->protocolVersion,
-                          interp, argc-2, argv+2);
+    if (argc == 3)
+    {
+        if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR)
+            return TCL_ERROR;
+        ODR_MASK_ZERO (&p->protocolVersion);
+        for (i = 0; i<version; i++)
+            ODR_MASK_SET (&p->protocolVersion, i);
+    }
+    for (i = 4; --i >= 0; )
+        if (ODR_MASK_GET (&p->protocolVersion, i))
+            break;
+    sprintf (buf, "%d", i+1);
+    interp->result = buf;
+    return TCL_OK;
 }
 
 /*
@@ -600,7 +628,7 @@ static int do_options (void *obj, Tcl_Interp *interp,
     { "accessCtrl", 6},
     { "scan", 7},
     { "sort", 8},
-    { "extentedServices", 10},
+    { "extendedServices", 10},
     { "level-1Segmentation", 11},
     { "level-2Segmentation", 12},
     { "concurrentOperations", 13},
@@ -622,6 +650,48 @@ static int do_options (void *obj, Tcl_Interp *interp,
 }
 
 /*
+ * do_failInfo: Get fail information
+ */
+static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv)
+{
+    char buf[16], *cp;
+    IrTcl_Obj *p = obj;
+
+    if (argc <= 0)
+    {
+        p->failInfo = 0;
+       return TCL_OK;
+    }
+    sprintf (buf, "%d", p->failInfo);
+    switch (p->failInfo)
+    {
+    case 0:
+        cp = "ok";
+        break;
+    case IR_TCL_FAIL_CONNECT:
+        cp = "connect failed";
+        break;
+    case IR_TCL_FAIL_READ:
+        cp = "connection closed";
+        break;
+    case IR_TCL_FAIL_WRITE:
+        cp = "connection closed";
+        break;
+    case IR_TCL_FAIL_IN_APDU:
+        cp = "failed to decode incoming APDU";
+        break;
+    case IR_TCL_FAIL_UNKNOWN_APDU:
+        cp = "unknown APDU";
+        break;
+    default:
+        cp = "";
+    } 
+    Tcl_AppendElement (interp, buf);
+    Tcl_AppendElement (interp, cp);
+    return TCL_OK;
+}
+
+/*
  * do_preferredMessageSize: Set/get preferred message size
  */
 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
@@ -631,7 +701,7 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
     {
-        p->preferredMessageSize = 4096;
+        p->preferredMessageSize = 30000;
        return TCL_OK;
     }
     return get_set_int (&p->preferredMessageSize, interp, argc, argv);
@@ -647,7 +717,7 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
     {
-        p->maximumRecordSize = 32768;
+        p->maximumRecordSize = 30000;
        return TCL_OK;
     }
     return get_set_int (&p->maximumRecordSize, interp, argc, argv);
@@ -677,7 +747,7 @@ static int do_implementationName (void *obj, Tcl_Interp *interp,
 
     if (argc == 0)
         return ir_strdup (interp, &p->implementationName,
-                          "Index Data/TCL/TK on YAZ");
+                          "Index Data/IrTcl on YAZ");
     else if (argc == -1)
         return ir_strdel (interp, &p->implementationName);
     if (argc == 3)
@@ -716,7 +786,8 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationVersion, YAZ_VERSION);
+        return ir_strdup (interp, &p->implementationVersion, 
+                          "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
     else if (argc == -1)
         return ir_strdel (interp, &p->implementationVersion);
     Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
@@ -730,7 +801,7 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp,
                                         int argc, char **argv)
 {
     IrTcl_Obj *p = obj;
-
+    
     if (argc == 0)
     {
         p->targetImplementationName = NULL;
@@ -892,7 +963,7 @@ static int do_connect (void *obj, Tcl_Interp *interp,
             return TCL_ERROR;
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
-            interp->result = "cs_connect fail";
+            interp->result = "connect fail";
             do_disconnect (p, NULL, 2, NULL);
             return TCL_ERROR;
         }
@@ -945,6 +1016,10 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
        ODR_MASK_SET (&p->options, 1);
        ODR_MASK_SET (&p->options, 7);
        ODR_MASK_SET (&p->options, 14);
+
+        ODR_MASK_ZERO (&p->protocolVersion);
+       ODR_MASK_SET (&p->protocolVersion, 0);
+       ODR_MASK_SET (&p->protocolVersion, 1);
     }
     assert (!p->cs_link);
     return TCL_OK;
@@ -1047,7 +1122,7 @@ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     else if (argc == 3)
     {
-        if (!strcmp (argv[2], "Z3950"))
+        if (!strcmp (argv[2], "Z39"))
             p->protocol_type = PROTO_Z3950;
         else if (!strcmp (argv[2], "SR"))
             p->protocol_type = PROTO_SR;
@@ -1061,7 +1136,7 @@ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv)
     switch (p->protocol_type)
     {
     case PROTO_Z3950:
-        Tcl_AppendElement (interp, "Z3950");
+        Tcl_AppendElement (interp, "Z39");
         break;
     case PROTO_SR:
         Tcl_AppendElement (interp, "SR");
@@ -1280,6 +1355,7 @@ static IrTcl_Method ir_method_tab[] = {
 { 1, "comstack",                    do_comstack },
 { 1, "protocol",                    do_protocol },
 { 0, "failback",                    do_failback },
+{ 0, "failInfo",                    do_failInfo },
 
 { 1, "connect",                     do_connect },
 { 0, "protocolVersion",             do_protocolVersion },
@@ -2778,14 +2854,20 @@ void ir_select_read (ClientData clientData)
     {
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
+        {
+            logf (LOG_WARN, "cs_rcvconnect returned 1");
             return;
+        }
         p->connectFlag = 0;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         if (r < 0)
         {
             logf (LOG_DEBUG, "cs_rcvconnect error");
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_CONNECT;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
             return;
         }
@@ -2803,7 +2885,10 @@ void ir_select_read (ClientData clientData)
             logf (LOG_DEBUG, "cs_get failed, code %d", r);
             ir_select_remove (cs_fileno (p->cs_link), p);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_READ;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
 
            /* relase ir object now if callback deleted it */
@@ -2818,7 +2903,10 @@ void ir_select_read (ClientData clientData)
         {
             logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_IN_APDU;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
 
            /* release ir object now if failback deleted it */
@@ -2842,7 +2930,10 @@ void ir_select_read (ClientData clientData)
         default:
             logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
         }
         odr_reset (p->odr_in);
@@ -2877,7 +2968,10 @@ void ir_select_write (ClientData clientData)
             logf (LOG_DEBUG, "cs_rcvconnect error");
             ir_select_remove_write (cs_fileno (p->cs_link), p);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_CONNECT;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
             return;
         }
@@ -2890,7 +2984,10 @@ void ir_select_write (ClientData clientData)
     {   
         logf (LOG_DEBUG, "select write fail");
         if (p->failback)
+        {
+            p->failInfo = IR_TCL_FAIL_WRITE;
             IrTcl_eval (p->interp, p->failback);
+        }
         do_disconnect (p, NULL, 2, NULL);
     }
     else if (r == 0)            /* remove select bit */
@@ -2912,6 +3009,7 @@ int ir_tcl_init (Tcl_Interp *interp)
                       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk,
                       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    irTcl_interp = interp;
     return TCL_OK;
 }