New method: apduDump - returns information about last incoming APDU.

diff --git a/CHANGELOG b/CHANGELOG
index 9a43e32..c1fbebf 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 <stdlib.h>
 #include <stdio.h>
+#include <unistd.h>
 #ifdef WINDOWS
 #include <time.h>
 #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 (file)
--- 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