From: Adam Dickmeiss <adam@indexdata.dk>
Date: Tue, 17 Oct 1995 12:18:57 +0000 (+0000)
Subject: Bug fix: when target connection closed, the connection was not
X-Git-Tag: IRTCL.1.4~200
X-Git-Url: http://lists.indexdata.dk/?a=commitdiff_plain;h=d96c455efaab3a585c3ba93a924856a4a6ee2ddb;p=ir-tcl-moved-to-github.git

Bug fix: when target connection closed, the connection was not
properly reestablished.
---

diff --git a/client.tcl b/client.tcl
index 74db9a0..80bb76a 100644
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,11 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.73  1995-10-17 10:58:06  adam
+# Revision 1.74  1995-10-17 12:18:57  adam
+# Bug fix: when target connection closed, the connection was not
+# properly reestablished.
+#
+# Revision 1.73  1995/10/17  10:58:06  adam
 # More work on presentation formats.
 #
 # Revision 1.72  1995/10/16  17:00:52  adam
@@ -381,6 +385,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
+    puts $m
 }
 
 proc set-display-format {f} {
@@ -1067,6 +1072,7 @@ proc init-response {} {
     global cancelFlag
     global scanEnable
 
+    dputs {init-reponse}
     if {$cancelFlag} {
         close-target
         return
@@ -1099,6 +1105,9 @@ proc search-request {bflag} {
 
     set target $hostid
 
+    if {[z39 connect] == ""} {
+        return
+    }
     dputs "search-request"
     show-message {}
     if {!$bflag && $busy} {
@@ -1675,15 +1684,13 @@ proc define-target-dialog {} {
     top-down-ok-cancel $w {define-target-action} 1
 }
 
-proc protocol-setup-delete {target} {
+proc protocol-setup-delete {target w} {
     global profile
     global settingsChanged
 
     set a [alert "Are you sure you want to delete the target \
 definition $target ?"]
     if {$a} {
-        set wno [lindex $profile($target) 12]
-        set w .setup-${wno}
         destroy $w
         unset profile($target)
         set settingsChanged 1
@@ -1692,7 +1699,7 @@ definition $target ?"]
     }
 }
 
-proc protocol-setup-action {target} {
+proc protocol-setup-action {target w} {
     global profile
     global csRadioType
     global protocolRadioType
@@ -1701,9 +1708,6 @@ proc protocol-setup-action {target} {
     global CCLCheck
     global ResultSetCheck
 
-    set wno [lindex $profile($target) 12]
-    set w .setup-${wno}
-    
     set b {}
     set settingsChanged 1
     set len [$w.top.databases.list size]
@@ -1741,26 +1745,22 @@ proc place-force {window parent} {
     wm geometry $window +${x}+${y}
 }
 
-proc add-database-action {target} {
+proc add-database-action {target w} {
     global profile
 
-    set wno [lindex $profile($target) 12]
-    set w .setup-${wno}
-
     $w.top.databases.list insert end \
             [.database-select.top.database.entry get]
     destroy .database-select
 }
 
-proc add-database {target} {
+proc add-database {target wp} {
     global profile
 
     set w .database-select
     toplevel $w
     set oldFocus [focus]
  
-    set wno [lindex $profile($target) 12]
-    place-force $w .setup-${wno}
+    place-force $w $wp
 
     top-down-window $w
 
@@ -1770,17 +1770,15 @@ proc add-database {target} {
     
     entry-fields $w.top {database} \
             {{Database to add:}} \
-            [list add-database-action $target] {destroy .database-select}
+            [list add-database-action $target $wp] {destroy .database-select}
 
-    top-down-ok-cancel $w [list add-database-action $target] 1
+    top-down-ok-cancel $w [list add-database-action $target $wp] 1
     focus $oldFocus
 }
 
-proc delete-database {target} {
+proc delete-database {target w} {
     global profile
 
-    set wno [lindex $profile($target) 12]
-    set w .setup-${wno}
     set l {}
     foreach i [$w.top.databases.list curselection] {
         set b [$w.top.databases.list get $i]
@@ -1803,16 +1801,11 @@ proc protocol-setup {target} {
     global CCLCheck
     global ResultSetCheck
     
-    if {1} {
-        set wno [lindex $profile($target) 12]
-        set w .setup-${wno}
-    } else {
-        set b 0
-        while {[winfo exists .setup-$b]} {
-            incr b
-        }
-        set w .setup-$b
+    set b 0
+    while {[winfo exists .setup-$b]} {
+        incr b
     }
+    set w .setup-$b
 
     toplevelG $w
 
@@ -1846,13 +1839,13 @@ proc protocol-setup {target} {
             maximumRecordSize preferredMessageSize} \
             {{Description:} {Host:} {Port:} {Id Authentication:} \
             {Maximum Record Size:} {Preferred Message Size:}} \
-            [list protocol-setup-action $target] [list destroy $w]
+            [list protocol-setup-action $target $w] [list destroy $w]
     
     foreach sub {description host port idAuthentication \
             maximumRecordSize preferredMessageSize} {
         dputs $sub
-        bind $w.top.$sub.entry <Control-a> [list add-database $target]
-        bind $w.top.$sub.entry <Control-d> [list delete-database $target]
+        bind $w.top.$sub.entry <Control-a> [list add-database $target $w]
+        bind $w.top.$sub.entry <Control-d> [list delete-database $target $w]
     }
     $w.top.description.entry insert 0 [lindex $profile($target) 0]
     $w.top.host.entry insert 0 [lindex $profile($target) 1]
@@ -1873,10 +1866,10 @@ proc protocol-setup {target} {
     pack $w.top.databases -side left -pady 2 -padx 2 -expand yes -fill both
 
     label $w.top.databases.label -text "Databases"
-    button $w.top.databases.add -text "Add" \
-            -command [list add-database $target]
-    button $w.top.databases.delete -text "Delete" \
-            -command [list delete-database $target]
+    button $w.top.databases.add -text Add \
+            -command [list add-database $target $w]
+    button $w.top.databases.delete -text Delete \
+            -command [list delete-database $target $w]
     if {! [tk4]} {
         listbox $w.top.databases.list -geometry 14x6 \
                 -yscrollcommand "$w.top.databases.scroll set"
@@ -1936,8 +1929,8 @@ proc protocol-setup {target} {
             -padx 2 -side top -fill x
 
     # Ok-cancel
-    bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \
-            {Delete} [list protocol-setup-delete $target] \
+    bottom-buttons $w [list {Ok} [list protocol-setup-action $target $w] \
+            {Delete} [list protocol-setup-delete $target $w] \
             {Cancel} [list destroy $w]] 0   
 }
 
@@ -3219,6 +3212,6 @@ if {[catch {ir z39}]} {
     ir z39
     puts "ok"
 }
-#z39 logLevel all
+z39 logLevel all
 show-logo 1
 
diff --git a/ir-tcl.c b/ir-tcl.c
index be6bba7..6aff70d 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,11 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.58  1995-10-16 17:00:55  adam
+ * Revision 1.59  1995-10-17 12:18:58  adam
+ * Bug fix: when target connection closed, the connection was not
+ * properly reestablished.
+ *
+ * Revision 1.58  1995/10/16  17:00:55  adam
  * New setting: elementSetNames.
  * Various client improvements. Medium presentation format looks better.
  *
@@ -903,6 +907,8 @@ static int do_connect (void *obj, Tcl_Interp *interp,
             interp->result = "already connected";
             return TCL_ERROR;
         }
+        if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
+            return TCL_ERROR;
         if (!strcmp (p->cs_type, "tcpip"))
         {
             p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type);
@@ -936,8 +942,6 @@ static int do_connect (void *obj, Tcl_Interp *interp,
                               p->cs_type, NULL);
             return TCL_ERROR;
         }
-        if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
-            return TCL_ERROR;
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
             interp->result = "connect fail";
@@ -957,6 +961,8 @@ static int do_connect (void *obj, Tcl_Interp *interp,
                 IrTcl_eval (p->interp, p->callback);
         }
     }
+    else
+        Tcl_AppendResult (interp, p->hostname, NULL);
     return TCL_OK;
 }
 
@@ -982,6 +988,8 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         ir_select_remove (cs_fileno (p->cs_link), p);
 
+        odr_reset (p->odr_in);
+
         assert (p->cs_link);
         cs_close (p->cs_link);
         p->cs_link = NULL;
@@ -2997,13 +3005,12 @@ void ir_select_read (ClientData clientData)
         {
             logf (LOG_DEBUG, "cs_get failed, code %d", r);
             ir_select_remove (cs_fileno (p->cs_link), p);
+            do_disconnect (p, NULL, 2, NULL);
             if (p->failback)
             {
                 p->failInfo = IR_TCL_FAIL_READ;
                 IrTcl_eval (p->interp, p->failback);
             }
-            do_disconnect (p, NULL, 2, NULL);
-
 	    /* release ir object now if callback deleted it */
 	    ir_obj_delete (p);
             return;
@@ -3016,13 +3023,12 @@ void ir_select_read (ClientData clientData)
         if (!z_APDU (p->odr_in, &apdu, 0))
         {
             logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]);
+            do_disconnect (p, NULL, 2, NULL);
             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 */
 	    ir_obj_delete (p);
             return;
@@ -3058,12 +3064,12 @@ void ir_select_read (ClientData clientData)
             default:
                 logf (LOG_WARN, "Received unknown APDU type (%d)",
                       apdu->which);
+                do_disconnect (p, NULL, 2, NULL);
                 if (p->failback)
                 {
                     p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
                     IrTcl_eval (p->interp, p->failback);
                 }
-                do_disconnect (p, NULL, 2, NULL);
                 return;
             }
         }
diff --git a/queue.c b/queue.c
index 9de4663..1435d5e 100644
--- a/queue.c
+++ b/queue.c
@@ -6,7 +6,11 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: queue.c,v $
- * Revision 1.3  1995-08-04 11:32:40  adam
+ * Revision 1.4  1995-10-17 12:18:59  adam
+ * Bug fix: when target connection closed, the connection was not
+ * properly reestablished.
+ *
+ * Revision 1.3  1995/08/04  11:32:40  adam
  * More work on output queue. Memory related routines moved
  * to mem.c
  *
@@ -53,12 +57,15 @@ int ir_tcl_send_APDU (Tcl_Interp *interp, IrTcl_Obj *p, Z_APDU *apdu,
     odr_reset (p->odr_out);
     if (p->state == IR_TCL_R_Idle)
     {
+        logf (LOG_DEBUG, "send_apdu. Sending %s", msg);
         if (ir_tcl_send_q (p, p->request_queue, msg) == TCL_ERROR)
         {
             sprintf (interp->result, "cs_put failed in %s", msg);
             return TCL_ERROR;
         } 
     }
+    else
+        logf (LOG_DEBUG, "send_apdu. Not idle (%s)", msg);
     return TCL_OK;
 }