From d96c455efaab3a585c3ba93a924856a4a6ee2ddb Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Tue, 17 Oct 1995 12:18:57 +0000 Subject: [PATCH] Bug fix: when target connection closed, the connection was not properly reestablished. --- client.tcl | 71 +++++++++++++++++++++++++++--------------------------------- ir-tcl.c | 22 ++++++++++++------- queue.c | 9 +++++++- 3 files changed, 54 insertions(+), 48 deletions(-) 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 [list add-database $target] - bind $w.top.$sub.entry [list delete-database $target] + bind $w.top.$sub.entry [list add-database $target $w] + bind $w.top.$sub.entry [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; } -- 1.7.10.4