From 71da3253847dfb239e28a7bb760d259ff3611ee7 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Fri, 19 Jan 1996 16:22:36 +0000 Subject: [PATCH] New method: apduDump - returns information about last incoming APDU. --- CHANGELOG | 8 ++++++- client.tcl | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++++------- ir-tcl.c | 58 +++++++++++++++++++++++++++++++++++++++++++++- ir-tclp.h | 8 ++++++- 4 files changed, 138 insertions(+), 11 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index 9a43e32..c1fbebf 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,4 @@ -$Id: CHANGELOG,v 1.11 1996-01-11 11:41:13 adam Exp $ +$Id: CHANGELOG,v 1.12 1996-01-19 16:22:36 adam Exp $ 06/19/95 Release of ir-tcl-1.0b ------------------------------------------------------ @@ -66,3 +66,9 @@ $Id: CHANGELOG,v 1.11 1996-01-11 11:41:13 adam Exp $ searchResponse, presentResponse and scanResponse. 11/01/96 Release of ir-tcl-1.1 +------------------------------------------------------ + +19/01/96 New feature: apduInfo - returns information about last incoming + APDU. Three elements returned: length offset dump. + + diff --git a/client.tcl b/client.tcl index 3269aa7..d4a10f4 100644 --- a/client.tcl +++ b/client.tcl @@ -4,7 +4,10 @@ # Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.84 1996-01-11 13:12:10 adam +# Revision 1.85 1996-01-19 16:22:36 adam +# New method: apduDump - returns information about last incoming APDU. +# +# Revision 1.84 1996/01/11 13:12:10 adam # Bug fix. # # Revision 1.83 1995/11/28 17:26:36 adam @@ -361,6 +364,7 @@ set textWrap word set recordSyntax None set elementSetNames None set delayRequest {} +set debugMode 0 set queryTypes {Simple} set queryButtons { { {I 0} {I 1} {I 2} } } @@ -409,18 +413,19 @@ set queryInfoFind [lindex $queryInfo 0] proc read-formats {} { global displayFormats global libdir - if {[catch {set formats [glob -nocomplain ${libdir}/formats/*.tcl]}]} { - set formats ./formats/raw.tcl - } + + set oldDir [pwd] + cd ${libdir}/formats + set formats [glob {*.[tT][cC][lL]}] foreach f $formats { if {[file readable $f]} { source $f set l [string length $f] - set f [string range $f [string length "${libdir}/formats/"] \ - [expr $l - 5]] + set f [string tolower [string range $f 0 [expr $l - 5]]] lappend displayFormats $f } } + cd $oldDir } proc set-wrap {m} { @@ -431,9 +436,53 @@ proc set-wrap {m} { } proc dputs {m} { -# puts $m + global debugMode + if {$debugMode} { + puts $m + } } +proc apduDump {} { + global debugMode + + set w .apdu + + if {$debugMode == 0} return + set x [z39 apduInfo] + + set offset [lindex $x 1] + set length [lindex $x 0] + + if {![winfo exists $w]} { + catch {destroy $w} + toplevelG $w + + wm title $w "APDU information" + + wm minsize $w 0 0 + + top-down-window $w + + text $w.top.t -width 60 -height 12 -wrap word -relief flat \ + -borderwidth 0 \ + -yscrollcommand [list $w.top.s set] + scrollbar $w.top.s -command [list $w.top.t yview] + + pack $w.top.s -side right -fill y + pack $w.top.t -expand yes -fill both + + bottom-buttons $w [list {Close} [list destroy $w]] 0 + } + $w.top.t insert end "Length: ${length}\n" + if {$offset != -1} { + $w.top.t insert end "Offset: ${offset}\n" + } + $w.top.t insert end [lindex $x 2] + $w.top.t insert end "---------------------------------\n" + +} + + proc set-display-format {f} { global displayFormat global setNo @@ -970,8 +1019,14 @@ proc define-target-action {} { } proc fail-response {target} { + global debugMode + set c [lindex [z39 failInfo] 0] set m [lindex [z39 failInfo] 1] + if {$c == 4 || $c == 5} { + set debugMode 1 + apduDump + } close-target tkerror "$m ($c)" } @@ -1131,6 +1186,7 @@ proc init-response {} { global scanEnable dputs {init-reponse} + apduDump if {$cancelFlag} { close-target return @@ -1332,6 +1388,7 @@ proc scan-response {attr start toget} { set w .scan-window dputs "In scan-response" + apduDump set m [z39.scan numberOfEntriesReturned] dputs $m dputs attr=$attr @@ -1502,7 +1559,7 @@ proc search-response {} { global delayRequest global presentChunk - + apduDump dputs "In search-response" if {$cancelFlag} { dputs "Handling cancel" @@ -1662,6 +1719,7 @@ proc present-response {} { global presentChunk dputs "In present-response" + apduDump set no [z39.$setNo numberOfRecordsReturned] dputs "Returned $no records, setOffset $setOffset" add-title-lines $setNo $no $setOffset @@ -3212,6 +3270,7 @@ menu .top.options.m .top.options.m add cascade -label "Wrap" -menu .top.options.m.wrap .top.options.m add cascade -label "Syntax" -menu .top.options.m.syntax .top.options.m add cascade -label "Elements" -menu .top.options.m.elements +.top.options.m add radiobutton -label "Debug" -variable debugMode -value 1 menu .top.options.m.query .top.options.m.query add cascade -label "Select" \ diff --git a/ir-tcl.c b/ir-tcl.c index 50cf918..ac51f66 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.70 1996-01-10 09:18:34 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. @@ -251,6 +254,7 @@ #include #include +#include #ifdef WINDOWS #include #else @@ -684,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) @@ -1565,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 }, @@ -3340,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)) @@ -3349,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 */ diff --git a/ir-tclp.h b/ir-tclp.h index 0af255e..a2c6b89 100644 --- a/ir-tclp.h +++ b/ir-tclp.h @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tclp.h,v $ - * Revision 1.22 1996-01-10 09:18:44 adam + * Revision 1.23 1996-01-19 16:22:40 adam + * New method: apduDump - returns information about last incoming APDU. + * + * Revision 1.22 1996/01/10 09:18:44 adam * PDU specific callbacks implemented: initRespnse, searchResponse, * presentResponse and scanResponse. * Bug fix in the command line shell (tclmain.c) - discovered on OSF/1. @@ -175,6 +178,9 @@ typedef struct { char *failback; char *initResponse; + int apduLen; + int apduOffset; + #if CCL2RPN CCL_bibset bibset; #endif -- 1.7.10.4